mirrors/binutils-gdb
1
0
Fork 0
mirror of https://sourceware.org/git/binutils-gdb.git synced 2024-11-25 02:53:48 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

* expression.h (enum exp_code): Added OP_NAME.

Browse Source 
* 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}.
This commit is contained in:
Per Bothner 1995-10-05 05:24:41 +00:00
parent 4caf3f7d0e
commit 3c02944a98
9 changed files with 576 additions and 265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gdb/.Sanitize
View File

@ -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

15
gdb/ChangeLog
View File

@ -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.

6
gdb/Makefile.in
View File

@ -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

2
gdb/parse.c
View File

@ -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);

409
gdb/scm-exp.c Normal file
View File

@ -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;
}

394
gdb/scm-lang.c
View File

@ -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);
}

6
gdb/scm-lang.h
View File

@ -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 ();

4
gdb/scm-valprint.c
View File

@ -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)
{

4
gdb/values.c
View File

@ -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: