diff options
| -rw-r--r-- | gdb/.Sanitize | 1 | ||||
| -rw-r--r-- | gdb/ChangeLog | 15 | ||||
| -rw-r--r-- | gdb/Makefile.in | 6 | ||||
| -rw-r--r-- | gdb/parse.c | 2 | ||||
| -rw-r--r-- | gdb/scm-exp.c | 409 | ||||
| -rw-r--r-- | gdb/scm-lang.c | 394 | ||||
| -rw-r--r-- | gdb/scm-lang.h | 6 | ||||
| -rw-r--r-- | gdb/scm-valprint.c | 4 | ||||
| -rw-r--r-- | gdb/values.c | 4 |
9 files changed, 576 insertions, 265 deletions
diff --git a/gdb/.Sanitize b/gdb/.Sanitize index 6c377c3..4dc85d7 100644 --- a/gdb/.Sanitize +++ b/gdb/.Sanitize @@ -286,6 +286,7 @@ rs6000-nat.c rs6000-tdep.c rom68k-rom.c saber.suppress +scm-exp.c scm-lang.c scm-lang.h scm-tags.h diff --git a/gdb/ChangeLog b/gdb/ChangeLog index c9965a8..eb0bfff 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,18 @@ +Wed Oct 4 18:41:34 1995 Per Bothner <bothner@kalessin.cygnus.com> + + * expression.h (enum exp_code): Added OP_NAME. + * expprint.c (print_subexp): Add OP_NAME support. + * parse.c (length_of_subexp, prefixify_subexp): Likewise. + * scm-lang.c (scm_unpack, in_eval_c, scm_lookup_name): new function. + * scm-lang.h: Declare builtin_type_scm; other minor tweaks. + * values.c (unpack_long): If type is SCM, call scm_unpack. + * scm-valprint.c (scm_val_print): Use extract_signed_integer, + instead unpack_long + * scm-lang.c: More Scheme expression parsing from here ... + * scm-exp.c: ... to here. New file. + Also, provide for gdb to evaluate simple constants and names.. + * Makefile.in: Note new scm-exp.{c,o}. + Wed Oct 4 17:23:03 1995 Per Bothner <bothner@kalessin.cygnus.com> * gdbtypes.c (get_discrete_bounds): New function. diff --git a/gdb/Makefile.in b/gdb/Makefile.in index 621fc6e..0ff8423 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -355,7 +355,7 @@ SFILES = blockframe.c breakpoint.c buildsym.c callback.c c-exp.y c-lang.c \ gdbtypes.c infcmd.c inflow.c infrun.c language.c \ m2-exp.y m2-lang.c m2-typeprint.c m2-valprint.c main.c maint.c \ mem-break.c minsyms.c mipsread.c nlmread.c objfiles.c parse.c \ - printcmd.c remote.c remote-nrom.c scm-lang.c scm-valprint.c \ + printcmd.c remote.c remote-nrom.c scm-exp.c scm-lang.c scm-valprint.c \ source.c stabsread.c stack.c symfile.c symmisc.c \ symtab.c target.c thread.c top.c \ typeprint.c utils.c valarith.c valops.c \ @@ -466,8 +466,8 @@ COMMON_OBS = version.o blockframe.o breakpoint.o findvar.o stack.o thread.o \ exec.o objfiles.o minsyms.o maint.o demangle.o \ dbxread.o coffread.o elfread.o \ dwarfread.o mipsread.o stabsread.o core.o \ - c-lang.o ch-lang.o f-lang.o m2-lang.o scm-lang.o scm-valprint.o \ - complaints.o typeprint.o \ + c-lang.o ch-lang.o f-lang.o m2-lang.o \ + scm-exp.o scm-lang.o scm-valprint.o complaints.o typeprint.o \ c-typeprint.o ch-typeprint.o f-typeprint.o m2-typeprint.o \ c-valprint.o cp-valprint.o ch-valprint.o f-valprint.o m2-valprint.o \ nlmread.o serial.o mdebugread.o os9kread.o top.o utils.o callback.o diff --git a/gdb/parse.c b/gdb/parse.c index a545814..fb8793f 100644 --- a/gdb/parse.c +++ b/gdb/parse.c @@ -512,6 +512,7 @@ length_of_subexp (expr, endpos) /* fall through */ case OP_M2_STRING: case OP_STRING: + case OP_NAME: case OP_EXPRSTRING: oplen = longest_to_int (expr->elts[endpos - 2].longconst); oplen = 4 + BYTES_TO_EXP_ELEM (oplen + 1); @@ -650,6 +651,7 @@ prefixify_subexp (inexpr, outexpr, inend, outbeg) /* fall through */ case OP_M2_STRING: case OP_STRING: + case OP_NAME: case OP_EXPRSTRING: oplen = longest_to_int (inexpr->elts[inend - 2].longconst); oplen = 4 + BYTES_TO_EXP_ELEM (oplen + 1); diff --git a/gdb/scm-exp.c b/gdb/scm-exp.c new file mode 100644 index 0000000..4c98d64 --- /dev/null +++ b/gdb/scm-exp.c @@ -0,0 +1,409 @@ +/* Scheme/Guile language support routines for GDB, the GNU debugger. + Copyright 1995 Free Software Foundation, Inc. + +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 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. */ + +#include "defs.h" +#include "symtab.h" +#include "gdbtypes.h" +#include "expression.h" +#include "parser-defs.h" +#include "language.h" +#include "value.h" +#include "c-lang.h" +#include "scm-lang.h" +#include "scm-tags.h" + +#define USE_EXPRSTRING 0 + +static void scm_lreadr PARAMS ((int)); + +LONGEST +scm_istr2int(str, len, radix) + char *str; + int len; + int radix; +{ + int j; + int i = 0; + LONGEST inum = 0; + int c; + int sign = 0; + + if (0 >= len) return SCM_BOOL_F; /* zero scm_length */ + switch (str[0]) + { /* leading sign */ + case '-': + case '+': + sign = str[0]; + if (++i==len) + return SCM_BOOL_F; /* bad if lone `+' or `-' */ + } + do { + switch (c = str[i++]) { + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + c = c - '0'; + goto accumulate; + case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': + c = c-'A'+10; + goto accumulate; + case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': + c = c-'a'+10; + accumulate: + if (c >= radix) return SCM_BOOL_F; /* bad digit for radix */ + inum *= radix; + inum += c; + break; + default: + return SCM_BOOL_F; /* not a digit */ + } + } while (i < len); + if (sign == '-') + inum = -inum; + return SCM_MAKINUM (inum); +} + +LONGEST +scm_istring2number(str, len, radix) + char *str; + int len; + int radix; +{ + int i = 0; + char ex = 0; + char ex_p = 0, rx_p = 0; /* Only allow 1 exactness and 1 radix prefix */ + SCM res; + if (len==1) + if (*str=='+' || *str=='-') /* Catches lone `+' and `-' for speed */ + return SCM_BOOL_F; + + while ((len-i) >= 2 && str[i]=='#' && ++i) + switch (str[i++]) { + case 'b': case 'B': if (rx_p++) return SCM_BOOL_F; radix = 2; break; + case 'o': case 'O': if (rx_p++) return SCM_BOOL_F; radix = 8; break; + case 'd': case 'D': if (rx_p++) return SCM_BOOL_F; radix = 10; break; + case 'x': case 'X': if (rx_p++) return SCM_BOOL_F; radix = 16; break; + case 'i': case 'I': if (ex_p++) return SCM_BOOL_F; ex = 2; break; + case 'e': case 'E': if (ex_p++) return SCM_BOOL_F; ex = 1; break; + default: return SCM_BOOL_F; + } + + switch (ex) { + case 1: + return scm_istr2int(&str[i], len-i, radix); + case 0: + return scm_istr2int(&str[i], len-i, radix); +#if 0 + if NFALSEP(res) return res; +#ifdef FLOATS + case 2: return scm_istr2flo(&str[i], len-i, radix); +#endif +#endif + } + return SCM_BOOL_F; +} + +static void +scm_read_token (c, weird) + int c; + int weird; +{ + while (1) + { + c = *lexptr++; + switch (c) + { + case '[': + case ']': + case '(': + case ')': + case '\"': + case ';': + case ' ': case '\t': case '\r': case '\f': + case '\n': + if (weird) + goto default_case; + case '\0': /* End of line */ + eof_case: + --lexptr; + return; + case '\\': + if (!weird) + goto default_case; + else + { + c = *lexptr++; + if (c == '\0') + goto eof_case; + else + goto default_case; + } + case '}': + if (!weird) + goto default_case; + + c = *lexptr++; + if (c == '#') + return; + else + { + --lexptr; + c = '}'; + goto default_case; + } + + default: + default_case: + ; + } + } +} + +static int +scm_skip_ws () +{ + register int c; + while (1) + switch ((c = *lexptr++)) + { + case '\0': + goteof: + return c; + case ';': + lp: + switch ((c = *lexptr++)) + { + case '\0': + goto goteof; + default: + goto lp; + case '\n': + break; + } + case ' ': case '\t': case '\r': case '\f': case '\n': + break; + default: + return c; + } +} + +static void +scm_lreadparen (skipping) + int skipping; +{ + for (;;) + { + int c = scm_skip_ws (); + if (')' == c || ']' == c) + return; + --lexptr; + if (c == '\0') + error ("missing close paren"); + scm_lreadr (skipping); + } +} + +static void +scm_lreadr (skipping) + int skipping; +{ + int c, j; + struct stoken str; + LONGEST svalue; + tryagain: + c = *lexptr++; + switch (c) + { + case '\0': + lexptr--; + return; + case '[': + case '(': + scm_lreadparen (skipping); + return; + case ']': + case ')': + error ("unexpected #\\%c", c); + goto tryagain; + case '\'': + case '`': + str.ptr = lexptr - 1; + scm_lreadr (skipping); + if (!skipping) + { + value_ptr val = scm_evaluate_string (str.ptr, lexptr - str.ptr); + if (!is_scmvalue_type (VALUE_TYPE (val))) + error ("quoted scm form yields non-SCM value"); + svalue = extract_signed_integer (VALUE_CONTENTS (val), + TYPE_LENGTH (VALUE_TYPE (val))); + goto handle_immediate; + } + return; + case ',': + c = *lexptr++; + if ('@' != c) + lexptr--; + scm_lreadr (skipping); + return; + case '#': + c = *lexptr++; + switch (c) + { + case '[': + case '(': + scm_lreadparen (skipping); + return; + case 't': case 'T': + svalue = SCM_BOOL_T; + goto handle_immediate; + case 'f': case 'F': + svalue = SCM_BOOL_F; + goto handle_immediate; + case 'b': case 'B': + case 'o': case 'O': + case 'd': case 'D': + case 'x': case 'X': + case 'i': case 'I': + case 'e': case 'E': + lexptr--; + c = '#'; + goto num; + case '*': /* bitvector */ + scm_read_token (c, 0); + return; + case '{': + scm_read_token (c, 1); + return; + case '\\': /* character */ + c = *lexptr++; + scm_read_token (c, 0); + return; + case '|': + j = 1; /* here j is the comment nesting depth */ + lp: + c = *lexptr++; + lpc: + switch (c) + { + case '\0': + error ("unbalanced comment"); + default: + goto lp; + case '|': + if ('#' != (c = *lexptr++)) + goto lpc; + if (--j) + goto lp; + break; + case '#': + if ('|' != (c = *lexptr++)) + goto lpc; + ++j; + goto lp; + } + goto tryagain; + case '.': + default: + callshrp: + scm_lreadr (skipping); + return; + } + case '\"': + while ('\"' != (c = *lexptr++)) + { + if (c == '\\') + switch (c = *lexptr++) + { + case '\0': + error ("non-terminated string literal"); + case '\n': + continue; + case '0': + case 'f': + case 'n': + case 'r': + case 't': + case 'a': + case 'v': + break; + } + } + return; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '.': + case '-': + case '+': + num: + { + str.ptr = lexptr-1; + scm_read_token (c, 0); + if (!skipping) + { + svalue = scm_istring2number (str.ptr, lexptr - str.ptr, 10); + if (svalue != SCM_BOOL_F) + goto handle_immediate; + goto tok; + } + } + return; + case ':': + scm_read_token ('-', 0); + return; + do_symbol: + default: + str.ptr = lexptr-1; + scm_read_token (c, 0); + tok: + if (!skipping) + { + str.length = lexptr - str.ptr; + write_exp_elt_opcode (OP_NAME); + write_exp_string (str); + write_exp_elt_opcode (OP_NAME); + } + return; + } + handle_immediate: + if (!skipping) + { + write_exp_elt_opcode (OP_LONG); + write_exp_elt_type (builtin_type_scm); + write_exp_elt_longcst (svalue); + write_exp_elt_opcode (OP_LONG); + } +} + +int +scm_parse () +{ + char* start; + struct stoken str; + while (*lexptr == ' ') + lexptr++; + start = lexptr; + scm_lreadr (USE_EXPRSTRING); +#if USE_EXPRSTRING + str.length = lexptr - start; + str.ptr = start; + write_exp_elt_opcode (OP_EXPRSTRING); + write_exp_string (str); + write_exp_elt_opcode (OP_EXPRSTRING); +#endif + return 0; +} diff --git a/gdb/scm-lang.c b/gdb/scm-lang.c index 0a97c08..f651ece 100644 --- a/gdb/scm-lang.c +++ b/gdb/scm-lang.c @@ -32,253 +32,7 @@ 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*)); -static void scm_lreadr (); - -struct type *SCM_TYPE = NULL; - -static void -scm_read_token (c, weird) - int c; - int weird; -{ - while (1) - { - c = *lexptr++; - switch (c) - { - case '[': - case ']': - case '(': - case ')': - case '\"': - case ';': - case ' ': case '\t': case '\r': case '\f': - case '\n': - if (weird) - goto default_case; - case '\0': /* End of line */ - eof_case: - --lexptr; - return; - case '\\': - if (!weird) - goto default_case; - else - { - c = *lexptr++; - if (c == '\0') - goto eof_case; - else - goto default_case; - } - case '}': - if (!weird) - goto default_case; - - c = *lexptr++; - if (c == '#') - return; - else - { - --lexptr; - c = '}'; - goto default_case; - } - - default: - default_case: - ; - } - } -} - -static int -scm_skip_ws () -{ - register int c; - while (1) - switch ((c = *lexptr++)) - { - case '\0': - goteof: - return c; - case ';': - lp: - switch ((c = *lexptr++)) - { - case '\0': - goto goteof; - default: - goto lp; - case '\n': - break; - } - case ' ': case '\t': case '\r': case '\f': case '\n': - break; - default: - return c; - } -} - -static void -scm_lreadparen () -{ - for (;;) - { - int c = scm_skip_ws (); - if (')' == c || ']' == c) - return; - --lexptr; - if (c == '\0') - error ("missing close paren"); - scm_lreadr (); - } -} - -static void -scm_lreadr () -{ - int c, j; - tryagain: - c = *lexptr++; - switch (c) - { - case '\0': - lexptr--; - return; - case '[': - case '(': - scm_lreadparen (); - return; - case ']': - case ')': - error ("unexpected #\\%c", c); - goto tryagain; - case '\'': - case '`': - scm_lreadr (); - return; - case ',': - c = *lexptr++; - if ('@' != c) - lexptr--; - scm_lreadr (); - return; - case '#': - c = *lexptr++; - switch (c) - { - case '[': - case '(': - scm_lreadparen (); - return; - case 't': case 'T': - case 'f': case 'F': - return; - case 'b': case 'B': - case 'o': case 'O': - case 'd': case 'D': - case 'x': case 'X': - case 'i': case 'I': - case 'e': case 'E': - lexptr--; - c = '#'; - goto num; - case '*': /* bitvector */ - scm_read_token (c, 0); - return; - case '{': - scm_read_token (c, 1); - return; - case '\\': /* character */ - c = *lexptr++; - scm_read_token (c, 0); - return; - case '|': - j = 1; /* here j is the comment nesting depth */ - lp: - c = *lexptr++; - lpc: - switch (c) - { - case '\0': - error ("unbalanced comment"); - default: - goto lp; - case '|': - if ('#' != (c = *lexptr++)) - goto lpc; - if (--j) - goto lp; - break; - case '#': - if ('|' != (c = *lexptr++)) - goto lpc; - ++j; - goto lp; - } - goto tryagain; - case '.': - default: - callshrp: - scm_lreadr (); - return; - } - case '\"': - while ('\"' != (c = *lexptr++)) - { - if (c == '\\') - switch (c = *lexptr++) - { - case '\0': - error ("non-terminated string literal"); - case '\n': - continue; - case '0': - case 'f': - case 'n': - case 'r': - case 't': - case 'a': - case 'v': - break; - } - } - return; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - case '.': - case '-': - case '+': - num: - scm_read_token (c, 0); - return; - case ':': - scm_read_token ('-', 0); - return; - default: - scm_read_token (c, 0); - tok: - return; - } -} - -int -scm_parse () -{ - char* start; - struct stoken str; - while (*lexptr == ' ') - lexptr++; - start = lexptr; - scm_lreadr (); - str.length = lexptr - start; - str.ptr = start; - write_exp_elt_opcode (OP_EXPRSTRING); - write_exp_string (str); - write_exp_elt_opcode (OP_EXPRSTRING); - return 0; -} +struct type *builtin_type_scm; void scm_printchar (c, stream) @@ -305,7 +59,6 @@ is_scmvalue_type (type) if (TYPE_CODE (type) == TYPE_CODE_INT && TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0) { - SCM_TYPE = type; return 1; } return 0; @@ -321,11 +74,127 @@ scm_get_field (svalue, index) { value_ptr val; char buffer[20]; - if (SCM_TYPE == NULL) - error ("internal error - no SCM type"); - read_memory (SCM2PTR (svalue) + index * TYPE_LENGTH (SCM_TYPE), - buffer, TYPE_LENGTH (SCM_TYPE)); - return unpack_long (SCM_TYPE, buffer); + read_memory (SCM2PTR (svalue) + index * TYPE_LENGTH (builtin_type_scm), + buffer, TYPE_LENGTH (builtin_type_scm)); + return extract_signed_integer (buffer, TYPE_LENGTH (builtin_type_scm)); +} + +/* Unpack a value of type TYPE in buffer VALADDR as an integer + (if CONTEXT == TYPE_CODE_IN), a pointer (CONTEXT == TYPE_CODE_PTR), + or Boolean (CONTEXT == TYPE_CODE_BOOL). */ + +LONGEST +scm_unpack (type, valaddr, context) + struct type *type; + char *valaddr; + enum type_code context; +{ + if (is_scmvalue_type (type)) + { + LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type)); + if (context == TYPE_CODE_BOOL) + { + if (svalue == SCM_BOOL_F) + return 0; + else + return 1; + } + switch (7 & svalue) + { + case 2: case 6: /* fixnum */ + return svalue >> 2; + case 4: /* other immediate value */ + if (SCM_ICHRP (svalue)) /* character */ + return SCM_ICHR (svalue); + else if (SCM_IFLAGP (svalue)) + { + switch (svalue) + { +#ifndef SICP + case SCM_EOL: +#endif + case SCM_BOOL_F: + return 0; + case SCM_BOOL_T: + return 1; + } + } + error ("Value can't be converted to integer."); + default: + return svalue; + } + } + else + return unpack_long (type, valaddr); +} + +/* True if we're correctly in Guile's eval.c (the evaluator and apply). */ + +static int +in_eval_c () +{ + if (current_source_symtab && current_source_symtab->filename) + { + char *filename = current_source_symtab->filename; + int len = strlen (filename); + if (len >= 6 && strcmp (filename + len - 6, "eval.c") == 0) + return 1; + } + return 0; +} + +/* Lookup a value for the variable named STR. + 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; +{ + value_ptr args[3]; + int len = strlen (str); + value_ptr symval, func, val; + struct symbol *sym; + args[0] = value_allocate_space_in_inferior (len); + args[1] = value_from_longest (builtin_type_int, len); + write_memory (value_as_long (args[0]), str, len); + + if (in_eval_c () + && (sym = lookup_symbol ("env", + expression_context_block, + VAR_NAMESPACE, (int *) NULL, + (struct symtab **) NULL)) != NULL) + args[2] = value_of_variable (sym, expression_context_block); + else + /* FIXME in this case, we should try lookup_symbol first */ + args[2] = value_from_longest (builtin_type_scm, SCM_EOL); + + func = find_function_in_inferior ("scm_lookup_cstr"); + val = call_function_by_hand (func, 3, args); + if (!value_logical_not (val)) + return value_ind (val); + + sym = lookup_symbol (str, + expression_context_block, + VAR_NAMESPACE, (int *) NULL, + (struct symtab **) NULL); + if (sym) + return value_of_variable (sym, NULL); + error ("No symbol \"%s\" in current context."); +} + +value_ptr +scm_evaluate_string (str, len) + char *str; int len; +{ + value_ptr func; + value_ptr addr = value_allocate_space_in_inferior (len + 1); + LONGEST iaddr = value_as_long (addr); + write_memory (iaddr, str, len); + /* FIXME - should find and pass env */ + write_memory (iaddr + len, "", 1); + func = find_function_in_inferior ("scm_evstr"); + return call_function_by_hand (func, 1, &addr); } static value_ptr @@ -336,21 +205,25 @@ evaluate_subexp_scm (expect_type, exp, pos, noside) enum noside noside; { enum exp_opcode op = exp->elts[*pos].opcode; - value_ptr func, addr; int len, pc; char *str; switch (op) { + case OP_NAME: + pc = (*pos)++; + len = longest_to_int (exp->elts[pc + 1].longconst); + (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1); + if (noside == EVAL_SKIP) + goto nosideret; + str = &exp->elts[pc + 2].string; + return scm_lookup_name (str); case OP_EXPRSTRING: pc = (*pos)++; len = longest_to_int (exp->elts[pc + 1].longconst); (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1); if (noside == EVAL_SKIP) goto nosideret; - str = &exp->elts[ + 2].string; - addr = value_allocate_space_in_inferior (len); - write_memory (value_as_long (addr), str, len); - func = find_function_in_inferior ("scm_evstr"); - return call_function_by_hand (func, 1, &addr); + str = &exp->elts[pc + 2].string; + return scm_evaluate_string (str, len); default: ; } return evaluate_subexp_standard (expect_type, exp, pos, noside); @@ -388,4 +261,7 @@ void _initialize_scheme_language () { add_language (&scm_language_defn); + builtin_type_scm = init_type (TYPE_CODE_INT, + TARGET_LONG_BIT / TARGET_CHAR_BIT, + 0, "SCM", (struct objfile *) NULL); } diff --git a/gdb/scm-lang.h b/gdb/scm-lang.h index 2f3f451..73fc745 100644 --- a/gdb/scm-lang.h +++ b/gdb/scm-lang.h @@ -20,6 +20,7 @@ #define SCM_VELTS(x) ((SCM *)SCM_CDR(x)) #define SCM_CLOSCAR(x) (SCM_CAR(x)-scm_tc3_closure) #define SCM_CODE(x) SCM_CAR(SCM_CLOSCAR (x)) +#define SCM_MAKINUM(x) (((x)<<2)+2L) #ifdef __STDC__ /* Forward decls for prototypes */ struct value; @@ -40,5 +41,8 @@ extern int is_scmvalue_type PARAMS ((struct type*)); extern void scm_printchar PARAMS ((int, GDB_FILE*)); -struct type *SCM_TYPE; +extern struct value * scm_evaluate_string PARAMS ((char*, int)); +extern struct type *builtin_type_scm; + +extern int scm_parse (); diff --git a/gdb/scm-valprint.c b/gdb/scm-valprint.c index ef2ba67..de59220 100644 --- a/gdb/scm-valprint.c +++ b/gdb/scm-valprint.c @@ -128,7 +128,7 @@ scm_ipruk (hdr, ptr, stream) GDB_FILE *stream; { fprintf_filtered (stream, "#<unknown-%s", hdr); -#define SCM_SIZE (SCM_TYPE ? TYPE_LENGTH (SCM_TYPE) : sizeof (void*)) +#define SCM_SIZE TYPE_LENGTH (builtin_type_scm) if (SCM_CELLP (ptr)) fprintf_filtered (stream, " (0x%lx . 0x%lx) @", (long) SCM_CAR (ptr), (long) SCM_CDR (ptr)); @@ -372,7 +372,7 @@ scm_val_print (type, valaddr, address, stream, format, deref_ref, recurse, { if (is_scmvalue_type (type)) { - LONGEST svalue = unpack_long (type, valaddr); + LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type)); if (scm_inferior_print (svalue, stream, format, deref_ref, recurse, pretty) >= 0) { diff --git a/gdb/values.c b/gdb/values.c index 33db594..f4d01df 100644 --- a/gdb/values.c +++ b/gdb/values.c @@ -630,6 +630,10 @@ unpack_long (type, valaddr) register int len = TYPE_LENGTH (type); register int nosign = TYPE_UNSIGNED (type); + if (current_language->la_language == language_scm + && is_scmvalue_type (type)) + return scm_unpack (type, valaddr, TYPE_CODE_INT); + switch (code) { case TYPE_CODE_ENUM: |