* 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}.
rs6000-tdep.c
rom68k-rom.c
saber.suppress
+scm-exp.c
scm-lang.c
scm-lang.h
scm-tags.h
+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.
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 \
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
/* 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);
/* 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);
--- /dev/null
+/* 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;
+}
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)
if (TYPE_CODE (type) == TYPE_CODE_INT
&& TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0)
{
- SCM_TYPE = type;
return 1;
}
return 0;
{
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
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);
_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);
}
#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;
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 ();
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));
{
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)
{
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:
projects / binutils-gdb.git / commitdiff