X-Git-Url: https://git.libre-soc.org/?a=blobdiff_plain;f=gdb%2Fscm-lang.c;h=6a023146d6249f5a3b3c823f7c5fe01bed225cb2;hb=fefd0a378f5aff09fb63003bc2a6bb2e2d66ffee;hp=f651ece8880ef6d0f4cd073ac6ed15f4b551fd3c;hpb=3c02944a988ffb5ce4599a8013675a3ea49e538b;p=binutils-gdb.git diff --git a/gdb/scm-lang.c b/gdb/scm-lang.c index f651ece8880..6a023146d62 100644 --- a/gdb/scm-lang.c +++ b/gdb/scm-lang.c @@ -1,21 +1,22 @@ /* Scheme/Guile language support routines for GDB, the GNU debugger. - Copyright 1995 Free Software Foundation, Inc. + Copyright 1995, 1996, 1998, 2000 Free Software Foundation, Inc. -This file is part of GDB. + This file is part of GDB. -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or -(at your option) any later version. + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ #include "defs.h" #include "symtab.h" @@ -27,34 +28,37 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ #include "c-lang.h" #include "scm-lang.h" #include "scm-tags.h" +#include "gdb_string.h" +#include "gdbcore.h" -extern struct type ** const (c_builtin_types[]); -extern value_ptr value_allocate_space_in_inferior PARAMS ((int)); -extern value_ptr find_function_in_inferior PARAMS ((char*)); +extern void _initialize_scheme_language (void); +static value_ptr evaluate_subexp_scm (struct type *, struct expression *, + int *, enum noside); +static value_ptr scm_lookup_name (char *); +static int in_eval_c (void); +static void scm_printstr (struct ui_file * stream, char *string, + unsigned int length, int width, + int force_ellipses); + +extern struct type **CONST_PTR (c_builtin_types[]); struct type *builtin_type_scm; void -scm_printchar (c, stream) - int c; - GDB_FILE *stream; +scm_printchar (int c, struct ui_file *stream) { fprintf_filtered (stream, "#\\%c", c); } static void -scm_printstr (stream, string, length, force_ellipses) - GDB_FILE *stream; - char *string; - unsigned int length; - int force_ellipses; +scm_printstr (struct ui_file *stream, char *string, unsigned int length, + int width, int force_ellipses) { fprintf_filtered (stream, "\"%s\"", string); } int -is_scmvalue_type (type) - struct type *type; +is_scmvalue_type (struct type *type) { if (TYPE_CODE (type) == TYPE_CODE_INT && TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0) @@ -68,11 +72,8 @@ is_scmvalue_type (type) of the 0'th one. */ LONGEST -scm_get_field (svalue, index) - LONGEST svalue; - int index; +scm_get_field (LONGEST svalue, int index) { - value_ptr val; char buffer[20]; read_memory (SCM2PTR (svalue) + index * TYPE_LENGTH (builtin_type_scm), buffer, TYPE_LENGTH (builtin_type_scm)); @@ -84,10 +85,7 @@ scm_get_field (svalue, index) or Boolean (CONTEXT == TYPE_CODE_BOOL). */ LONGEST -scm_unpack (type, valaddr, context) - struct type *type; - char *valaddr; - enum type_code context; +scm_unpack (struct type *type, char *valaddr, enum type_code context) { if (is_scmvalue_type (type)) { @@ -99,16 +97,17 @@ scm_unpack (type, valaddr, context) else return 1; } - switch (7 & svalue) + switch (7 & (int) svalue) { - case 2: case 6: /* fixnum */ + case 2: + case 6: /* fixnum */ return svalue >> 2; - case 4: /* other immediate value */ - if (SCM_ICHRP (svalue)) /* character */ + case 4: /* other immediate value */ + if (SCM_ICHRP (svalue)) /* character */ return SCM_ICHR (svalue); else if (SCM_IFLAGP (svalue)) { - switch (svalue) + switch ((int) svalue) { #ifndef SICP case SCM_EOL: @@ -131,7 +130,7 @@ scm_unpack (type, valaddr, context) /* True if we're correctly in Guile's eval.c (the evaluator and apply). */ static int -in_eval_c () +in_eval_c (void) { if (current_source_symtab && current_source_symtab->filename) { @@ -147,13 +146,12 @@ in_eval_c () First lookup in Scheme context (using the scm_lookup_cstr inferior function), then try lookup_symbol for compiled variables. */ -value_ptr -scm_lookup_name (str) - char *str; +static value_ptr +scm_lookup_name (char *str) { value_ptr args[3]; int len = strlen (str); - value_ptr symval, func, val; + value_ptr func, val; struct symbol *sym; args[0] = value_allocate_space_in_inferior (len); args[1] = value_from_longest (builtin_type_int, len); @@ -184,8 +182,7 @@ scm_lookup_name (str) } value_ptr -scm_evaluate_string (str, len) - char *str; int len; +scm_evaluate_string (char *str, int len) { value_ptr func; value_ptr addr = value_allocate_space_in_inferior (len + 1); @@ -198,14 +195,12 @@ scm_evaluate_string (str, len) } static value_ptr -evaluate_subexp_scm (expect_type, exp, pos, noside) - struct type *expect_type; - register struct expression *exp; - register int *pos; - enum noside noside; +evaluate_subexp_scm (struct type *expect_type, register struct expression *exp, + register int *pos, enum noside noside) { enum exp_opcode op = exp->elts[*pos].opcode; - int len, pc; char *str; + int len, pc; + char *str; switch (op) { case OP_NAME: @@ -224,41 +219,44 @@ evaluate_subexp_scm (expect_type, exp, pos, noside) goto nosideret; str = &exp->elts[pc + 2].string; return scm_evaluate_string (str, len); - default: ; + default:; } return evaluate_subexp_standard (expect_type, exp, pos, noside); - nosideret: +nosideret: return value_from_longest (builtin_type_long, (LONGEST) 1); } -const struct language_defn scm_language_defn = { +const struct language_defn scm_language_defn = +{ "scheme", /* Language name */ language_scm, c_builtin_types, range_check_off, type_check_off, + case_sensitive_off, scm_parse, c_error, evaluate_subexp_scm, - scm_printchar, /* Print a character constant */ + scm_printchar, /* Print a character constant */ scm_printstr, /* Function to print string constant */ - NULL, /* Create fundamental type in this language */ + NULL, /* Function to print a single character */ + NULL, /* Create fundamental type in this language */ c_print_type, /* Print a type using appropriate syntax */ scm_val_print, /* Print a value using appropriate syntax */ scm_value_print, /* Print a top-level value */ - {"", "", "", ""}, /* Binary format info */ - {"#o%lo", "#o", "o", ""}, /* Octal format info */ - {"%ld", "", "d", ""}, /* Decimal format info */ - {"#x%lX", "#X", "X", ""}, /* Hex format info */ + {"", "", "", ""}, /* Binary format info */ + {"#o%lo", "#o", "o", ""}, /* Octal format info */ + {"%ld", "", "d", ""}, /* Decimal format info */ + {"#x%lX", "#X", "X", ""}, /* Hex format info */ NULL, /* expression operators for printing */ 1, /* c-style arrays */ 0, /* String lower bound */ - &builtin_type_char, /* Type of string elements */ + &builtin_type_char, /* Type of string elements */ LANG_MAGIC }; void -_initialize_scheme_language () +_initialize_scheme_language (void) { add_language (&scm_language_defn); builtin_type_scm = init_type (TYPE_CODE_INT,