diff options
author | Tom Tromey <tromey@redhat.com> | 2010-11-02 18:55:54 +0000 |
---|---|---|
committer | Tom Tromey <tromey@redhat.com> | 2010-11-02 18:55:54 +0000 |
commit | 50c97f3812a233c6d201d3de555ffffee8ae7cb0 (patch) | |
tree | 41879269bc296800984272804e75885ab1b9c0d2 | |
parent | 9dea9163560f26f9adddd13254ad32f4aea3b1d6 (diff) | |
download | gdb-50c97f3812a233c6d201d3de555ffffee8ae7cb0.zip gdb-50c97f3812a233c6d201d3de555ffffee8ae7cb0.tar.gz gdb-50c97f3812a233c6d201d3de555ffffee8ae7cb0.tar.bz2 |
gdb
* NEWS: Mention Guile removal.
* defs.h (enum language) <language_scm>: Remove.
* Makefile.in (SFILES): Remove scm-exp.c, scm-lang.c,
scm-valprint.c.
(HFILES_NO_SRCDIR): Remove scm-lang.h, scm-tags.h.
(COMMON_OBS): Remove scm-exp.o, scm-lang.o, scm-valprint.o.
* scm-exp.c, scm-lang.c, scm-valprint.c, scm-lang.h, scm-tags.h:
Remove.
gdb/testsuite
* gdb.base/default.exp: Remove "scheme" from language list.
-rw-r--r-- | gdb/ChangeLog | 11 | ||||
-rw-r--r-- | gdb/Makefile.in | 6 | ||||
-rw-r--r-- | gdb/NEWS | 2 | ||||
-rw-r--r-- | gdb/defs.h | 1 | ||||
-rw-r--r-- | gdb/scm-exp.c | 502 | ||||
-rw-r--r-- | gdb/scm-lang.c | 308 | ||||
-rw-r--r-- | gdb/scm-lang.h | 77 | ||||
-rw-r--r-- | gdb/scm-tags.h | 378 | ||||
-rw-r--r-- | gdb/scm-valprint.c | 462 | ||||
-rw-r--r-- | gdb/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gdb/testsuite/gdb.base/default.exp | 2 |
11 files changed, 20 insertions, 1733 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 197a708..1e764df 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,14 @@ +2010-11-02 Tom Tromey <tromey@redhat.com> + + * NEWS: Mention Guile removal. + * defs.h (enum language) <language_scm>: Remove. + * Makefile.in (SFILES): Remove scm-exp.c, scm-lang.c, + scm-valprint.c. + (HFILES_NO_SRCDIR): Remove scm-lang.h, scm-tags.h. + (COMMON_OBS): Remove scm-exp.o, scm-lang.o, scm-valprint.o. + * scm-exp.c, scm-lang.c, scm-valprint.c, scm-lang.h, scm-tags.h: + Remove. + 2010-11-02 Doug Evans <dje@google.com> * top.c: #include "python/python.h". diff --git a/gdb/Makefile.in b/gdb/Makefile.in index f735532..568fdb5 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -693,7 +693,6 @@ SFILES = ada-exp.y ada-lang.c ada-typeprint.c ada-valprint.c ada-tasks.c \ proc-service.list progspace.c \ prologue-value.c psymtab.c \ regcache.c reggroups.c remote.c remote-fileio.c reverse.c \ - scm-exp.c scm-lang.c scm-valprint.c \ sentinel-frame.c \ serial.c ser-base.c ser-unix.c \ solib.c solib-target.c source.c \ @@ -747,7 +746,7 @@ gdbserver/regcache.h gdbthread.h dwarf2-frame.h nbsd-nat.h dcache.h \ amd64-nat.h s390-tdep.h arm-linux-tdep.h exceptions.h macroscope.h \ gdbarch.h bsd-uthread.h gdb_thread_db.h gdb_stat.h memory-map.h \ mdebugread.h m88k-tdep.h stabsread.h hppa-linux-offsets.h linux-fork.h \ -ser-unix.h scm-lang.h inf-ptrace.h terminal.h ui-out.h frame-base.h \ +ser-unix.h inf-ptrace.h terminal.h ui-out.h frame-base.h \ f-lang.h dwarf2loc.h value.h sparc-tdep.h defs.h target-descriptions.h \ objfiles.h vec.h disasm.h mips-tdep.h ser-base.h \ gdb_curses.h bfd-target.h memattr.h inferior.h ax.h dummy-frame.h \ @@ -773,7 +772,7 @@ doublest.h regset.h hppa-tdep.h ppc-linux-tdep.h rs6000-tdep.h \ gdb_locale.h gdb_dirent.h arch-utils.h trad-frame.h gnu-nat.h \ language.h nbsd-tdep.h wrapper.h solib-svr4.h \ macroexp.h ui-file.h regcache.h gdb_string.h tracepoint.h i386-tdep.h \ -inf-child.h p-lang.h event-top.h gdbtypes.h scm-tags.h user-regs.h \ +inf-child.h p-lang.h event-top.h gdbtypes.h user-regs.h \ regformats/regdef.h config/alpha/nm-osf3.h config/i386/nm-i386gnu.h \ config/i386/nm-fbsd.h \ config/nm-nto.h config/sparc/nm-sol2.h config/nm-linux.h \ @@ -847,7 +846,6 @@ COMMON_OBS = $(DEPFILES) $(CONFIG_OBS) $(YYOBJ) \ varobj.o vec.o wrapper.o \ jv-lang.o jv-valprint.o jv-typeprint.o \ m2-lang.o p-lang.o p-typeprint.o p-valprint.o \ - scm-exp.o scm-lang.o scm-valprint.o \ sentinel-frame.o \ complaints.o typeprint.o \ ada-typeprint.o c-typeprint.o f-typeprint.o m2-typeprint.o \ @@ -76,6 +76,8 @@ see the "Tasking Support when using the Ravenscar Profile" section in the GDB user manual. +* Guile support was removed. + *** Changes in GDB 7.2 * Shared library support for remote targets by default @@ -201,7 +201,6 @@ enum language language_asm, /* Assembly language */ language_pascal, /* Pascal */ language_ada, /* Ada */ - language_scm, /* Guile Scheme */ language_minimal, /* All other languages, minimal support only */ nr_languages }; diff --git a/gdb/scm-exp.c b/gdb/scm-exp.c deleted file mode 100644 index 69eb249..0000000 --- a/gdb/scm-exp.c +++ /dev/null @@ -1,502 +0,0 @@ -/* Scheme/Guile language support routines for GDB, the GNU debugger. - - Copyright (C) 1995, 1996, 2000, 2003, 2005, 2008, 2009, 2010 - 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 3 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, see <http://www.gnu.org/licenses/>. */ - -#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_lreadparen (int); -static int scm_skip_ws (void); -static void scm_read_token (int, int); -static LONGEST scm_istring2number (char *, int, int); -static LONGEST scm_istr2int (char *, int, int); -static void scm_lreadr (int); - -static LONGEST -scm_istr2int (char *str, int len, int radix) -{ - 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); -} - -static LONGEST -scm_istring2number (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 */ -#if 0 - SCM res; -#endif - - 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 (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 (void) -{ - 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 (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 (int skipping) -{ - int c, j; - struct stoken str; - LONGEST svalue = 0; - -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) - { - struct value *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)), - gdbarch_byte_order (parse_gdbarch)); - 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: -#if 0 - callshrp: -#endif - 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; -#if 0 - do_symbol: -#endif - default: - str.ptr = lexptr - 1; - scm_read_token (c, 0); - tok: - if (!skipping) - { - str.length = lexptr - str.ptr; - if (str.ptr[0] == '$') - { - write_dollar_variable (str); - return; - } - 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_scm_type (parse_gdbarch)->builtin_scm); - write_exp_elt_longcst (svalue); - write_exp_elt_opcode (OP_LONG); - } -} - -int -scm_parse (void) -{ - char *start; - - 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 deleted file mode 100644 index 870b1e4..0000000 --- a/gdb/scm-lang.c +++ /dev/null @@ -1,308 +0,0 @@ -/* Scheme/Guile language support routines for GDB, the GNU debugger. - - Copyright (C) 1995, 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2007, - 2008, 2009, 2010 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 3 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, see <http://www.gnu.org/licenses/>. */ - -#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" -#include "source.h" -#include "gdb_string.h" -#include "gdbcore.h" -#include "infcall.h" -#include "objfiles.h" - -extern void _initialize_scheme_language (void); -static struct value *scm_lookup_name (struct gdbarch *, char *); -static int in_eval_c (void); - -void -scm_printchar (int c, struct type *type, struct ui_file *stream) -{ - fprintf_filtered (stream, "#\\%c", c); -} - -static void -scm_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string, - unsigned int length, const char *encoding, int force_ellipses, - const struct value_print_options *options) -{ - fprintf_filtered (stream, "\"%s\"", string); -} - -int -is_scmvalue_type (struct type *type) -{ - if (TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0) - { - return 1; - } - return 0; -} - -/* Get the INDEX'th SCM value, assuming SVALUE is the address - of the 0'th one. */ - -LONGEST -scm_get_field (LONGEST svalue, int index, int size, - enum bfd_endian byte_order) -{ - gdb_byte buffer[20]; - - read_memory (SCM2PTR (svalue) + index * size, buffer, size); - return extract_signed_integer (buffer, size, byte_order); -} - -/* 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 (struct type *type, const gdb_byte *valaddr, enum type_code context) -{ - if (is_scmvalue_type (type)) - { - enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type)); - LONGEST svalue - = extract_signed_integer (valaddr, TYPE_LENGTH (type), byte_order); - - if (context == TYPE_CODE_BOOL) - { - if (svalue == SCM_BOOL_F) - return 0; - else - return 1; - } - switch (7 & (int) 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 ((int) 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 (void) -{ - struct symtab_and_line cursal = get_current_source_symtab_and_line (); - - if (cursal.symtab && cursal.symtab->filename) - { - char *filename = cursal.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. */ - -static struct value * -scm_lookup_name (struct gdbarch *gdbarch, char *str) -{ - struct value *args[3]; - int len = strlen (str); - struct value *func; - struct value *val; - struct symbol *sym; - - func = find_function_in_inferior ("scm_lookup_cstr", NULL); - - args[0] = value_allocate_space_in_inferior (len); - args[1] = value_from_longest (builtin_type (gdbarch)->builtin_int, len); - write_memory (value_as_long (args[0]), (gdb_byte *) str, len); - - if (in_eval_c () - && (sym = lookup_symbol ("env", - expression_context_block, - VAR_DOMAIN, (int *) 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_scm_type (gdbarch)->builtin_scm, - SCM_EOL); - - 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_DOMAIN, (int *) NULL); - if (sym) - return value_of_variable (sym, NULL); - error (_("No symbol \"%s\" in current context."), str); -} - -struct value * -scm_evaluate_string (char *str, int len) -{ - struct value *func; - struct value *addr = value_allocate_space_in_inferior (len + 1); - LONGEST iaddr = value_as_long (addr); - - write_memory (iaddr, (gdb_byte *) str, len); - /* FIXME - should find and pass env */ - write_memory (iaddr + len, (gdb_byte *) "", 1); - func = find_function_in_inferior ("scm_evstr", NULL); - return call_function_by_hand (func, 1, &addr); -} - -static struct value * -evaluate_exp (struct type *expect_type, struct expression *exp, - int *pos, enum noside noside) -{ - enum exp_opcode op = exp->elts[*pos].opcode; - 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 (exp->gdbarch, str); - case OP_STRING: - 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_evaluate_string (str, len); - default:; - } - return evaluate_subexp_standard (expect_type, exp, pos, noside); -nosideret: - return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1); -} - -const struct exp_descriptor exp_descriptor_scm = -{ - print_subexp_standard, - operator_length_standard, - operator_check_standard, - op_name_standard, - dump_subexp_body_standard, - evaluate_exp -}; - -const struct language_defn scm_language_defn = -{ - "scheme", /* Language name */ - language_scm, - range_check_off, - type_check_off, - case_sensitive_off, - array_row_major, - macro_expansion_no, - &exp_descriptor_scm, - scm_parse, - c_error, - null_post_parser, - scm_printchar, /* Print a character constant */ - scm_printstr, /* Function to print string constant */ - NULL, /* Function to print a single character */ - c_print_type, /* Print a type using appropriate syntax */ - default_print_typedef, /* Print a typedef using appropriate syntax */ - scm_val_print, /* Print a value using appropriate syntax */ - scm_value_print, /* Print a top-level value */ - NULL, /* Language specific skip_trampoline */ - NULL, /* name_of_this */ - basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */ - basic_lookup_transparent_type,/* lookup_transparent_type */ - NULL, /* Language specific symbol demangler */ - NULL, /* Language specific class_name_from_physname */ - NULL, /* expression operators for printing */ - 1, /* c-style arrays */ - 0, /* String lower bound */ - default_word_break_characters, - default_make_symbol_completion_list, - c_language_arch_info, - default_print_array_index, - default_pass_by_reference, - default_get_string, - LANG_MAGIC -}; - -static void * -build_scm_types (struct gdbarch *gdbarch) -{ - struct builtin_scm_type *builtin_scm_type - = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_scm_type); - - builtin_scm_type->builtin_scm - = arch_integer_type (gdbarch, gdbarch_long_bit (gdbarch), 0, "SCM"); - - return builtin_scm_type; -} - -static struct gdbarch_data *scm_type_data; - -const struct builtin_scm_type * -builtin_scm_type (struct gdbarch *gdbarch) -{ - return gdbarch_data (gdbarch, scm_type_data); -} - -void -_initialize_scheme_language (void) -{ - scm_type_data = gdbarch_data_register_post_init (build_scm_types); - - add_language (&scm_language_defn); -} diff --git a/gdb/scm-lang.h b/gdb/scm-lang.h deleted file mode 100644 index 1adeee5..0000000 --- a/gdb/scm-lang.h +++ /dev/null @@ -1,77 +0,0 @@ -/* Scheme/Guile language support routines for GDB, the GNU debugger. - - Copyright (C) 1995, 1996, 1998, 1999, 2000, 2003, 2005, 2008, 2009, 2010 - 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 3 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, see <http://www.gnu.org/licenses/>. */ - -#define SICP -#include "scm-tags.h" -#undef SCM_NCELLP -#define SCM_NCELLP(x) ((SCM_SIZE-1) & (int)(x)) -#define SCM_ITAG8_DATA(X) ((X)>>8) -#define SCM_ICHR(x) ((unsigned char)SCM_ITAG8_DATA(x)) -#define SCM_ICHRP(x) (SCM_ITAG8(x) == scm_tc8_char) -#define scm_tc8_char 0xf4 -#define SCM_IFLAGP(n) ((0x87 & (int)(n))==4) -#define SCM_ISYMNUM(n) ((int)((n)>>9)) -#define SCM_ISYMCHARS(n) (scm_isymnames[SCM_ISYMNUM(n)]) -#define SCM_ILOCP(n) ((0xff & (int)(n))==0xfc) -#define SCM_ITAG8(X) ((int)(X) & 0xff) -#define SCM_TYP7(x) (0x7f & (int)SCM_CAR(x)) -#define SCM_LENGTH(x) (((unsigned long)SCM_CAR(x))>>8) -#define SCM_NCONSP(x) (1 & (int)SCM_CAR(x)) -#define SCM_NECONSP(x) (SCM_NCONSP(x) && (1 != SCM_TYP3(x))) -#define SCM_CAR(x) scm_get_field (x, 0, SCM_SIZE, SCM_BYTE_ORDER) -#define SCM_CDR(x) scm_get_field (x, 1, SCM_SIZE, SCM_BYTE_ORDER) -#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) - -/* Forward decls for prototypes */ -struct value; - -extern int scm_value_print (struct value *, struct ui_file *, - const struct value_print_options *); - -extern int scm_val_print (struct type *, const gdb_byte *, int, CORE_ADDR, - struct ui_file *, int, - const struct value *, - const struct value_print_options *); - -extern LONGEST scm_get_field (LONGEST, int, int, enum bfd_endian); - -extern int is_scmvalue_type (struct type *); - -extern void scm_printchar (int, struct type *, struct ui_file *); - -extern struct value *scm_evaluate_string (char *, int); - -extern int scm_parse (void); - -extern LONGEST scm_unpack (struct type *, const gdb_byte *, enum type_code); - -/* Scheme types */ - -struct builtin_scm_type -{ - struct type *builtin_scm; -}; - -/* Return the Scheme type table for the specified architecture. */ -extern const struct builtin_scm_type *builtin_scm_type (struct gdbarch *gdbarch); - diff --git a/gdb/scm-tags.h b/gdb/scm-tags.h deleted file mode 100644 index 1019d6f..0000000 --- a/gdb/scm-tags.h +++ /dev/null @@ -1,378 +0,0 @@ -/* This is a minimally edited version of Guile's tags.h. */ -/* classes: h_files */ - -#ifndef TAGSH -#define TAGSH -/* Copyright (C) 1995, 1999, 2008, 2009, 2010 -Free Software Foundation, Inc. - - 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 3 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, see <http://www.gnu.org/licenses/>. - - As a special exception, the Free Software Foundation gives permission - for additional uses of the text contained in its release of GUILE. - - The exception is that, if you link the GUILE library with other files - to produce an executable, this does not by itself cause the - resulting executable to be covered by the GNU General Public License. - Your use of that executable is in no way restricted on account of - linking the GUILE library code into it. - - This exception does not however invalidate any other reasons why - the executable file might be covered by the GNU General Public License. - - This exception applies only to the code released by the - Free Software Foundation under the name GUILE. If you copy - code from other Free Software Foundation releases into a copy of - GUILE, as the General Public License permits, the exception does - not apply to the code that you add in this way. To avoid misleading - anyone as to the status of such modified files, you must delete - this exception notice from them. - - If you write modifications of your own for GUILE, it is your choice - whether to permit this exception to apply to your modifications. - If you do not wish that, delete this exception notice. */ - - -/** This file defines the format of SCM values and cons pairs. - ** It is here that tag bits are assigned for various purposes. - **/ - - -/* Three Bit Tags - - * 000 -- a non-immediate value. Points into the pair heap. - * - * 001 -- a gloc (i.e., a resolved global variable in a CAR in a code graph) - * or the CAR of an object handle (i.e., the tagged pointer to the - * vtable part of a user-defined object). - * - * If X has this tag, the value at CDAR(X - 1) distinguishes - * glocs from object handles. The distinction only needs - * to be made in a few places. Only a few parts of the code know - * about glocs. In most cases, when a value in the CAR of a pair - * has the tag 001, it means that the pair is an object handle. - * - * 010 -- the tag for immediate, exact integers. - * - * 011 -- in the CAR of a pair, this tag indicates that the pair is a closure. - * The remaining bits of the CAR are a pointer into the pair heap - * to the code graph for the closure. - * - * 1xy -- an extension tag which means that there is a five or six bit - * tag to the left of the low three bits. See the nice diagrams - * in ../doc/code.doc if you want to know what the bits mean. - */ - - - - - -#define scm_tc3_cons 0 -#define scm_tc3_cons_gloc 1 -#define scm_tc3_closure 3 - -#define scm_tc7_ssymbol 5 -#define scm_tc7_msymbol 7 -#define scm_tc7_string 13 -#define scm_tc7_bvect 15 -#define scm_tc7_vector 21 -#define scm_tc7_lvector 23 -#define scm_tc7_ivect 29 -#define scm_tc7_uvect 31 -/* spare 37 39 */ -#define scm_tc7_fvect 45 -#define scm_tc7_dvect 47 -#define scm_tc7_cvect 53 -#define scm_tc7_port 55 -#define scm_tc7_contin 61 -#define scm_tc7_cclo 63 -/* spare 69 71 77 79 */ -#define scm_tc7_subr_0 85 -#define scm_tc7_subr_1 87 -#define scm_tc7_cxr 93 -#define scm_tc7_subr_3 95 -#define scm_tc7_subr_2 101 -#define scm_tc7_asubr 103 -#define scm_tc7_subr_1o 109 -#define scm_tc7_subr_2o 111 -#define scm_tc7_lsubr_2 117 -#define scm_tc7_lsubr 119 -#define scm_tc7_rpsubr 125 - -#define scm_tc7_smob 127 -#define scm_tc_free_cell 127 - -#define scm_tc16_flo 0x017f -#define scm_tc_flo 0x017fL - -#define SCM_REAL_PART (1L<<16) -#define SCM_IMAG_PART (2L<<16) -#define scm_tc_dblr (scm_tc16_flo|REAL_PART) -#define scm_tc_dblc (scm_tc16_flo|REAL_PART|IMAG_PART) - -#define scm_tc16_bigpos 0x027f -#define scm_tc16_bigneg 0x037f - -#define scm_tc16_fport (scm_tc7_port + 0*256L) -#define scm_tc16_pipe (scm_tc7_port + 1*256L) -#define scm_tc16_strport (scm_tc7_port + 2*256L) -#define scm_tc16_sfport (scm_tc7_port + 3*256L) - - - -/* For cons pairs with immediate values in the CAR */ -#define scm_tcs_cons_imcar 2:case 4:case 6:case 10:\ - case 12:case 14:case 18:case 20:\ - case 22:case 26:case 28:case 30:\ - case 34:case 36:case 38:case 42:\ - case 44:case 46:case 50:case 52:\ - case 54:case 58:case 60:case 62:\ - case 66:case 68:case 70:case 74:\ - case 76:case 78:case 82:case 84:\ - case 86:case 90:case 92:case 94:\ - case 98:case 100:case 102:case 106:\ - case 108:case 110:case 114:case 116:\ - case 118:case 122:case 124:case 126 - -/* For cons pairs with non-immediate values in the CAR */ -#define scm_tcs_cons_nimcar 0:case 8:case 16:case 24:\ - case 32:case 40:case 48:case 56:\ - case 64:case 72:case 80:case 88:\ - case 96:case 104:case 112:case 120 - -/* A CONS_GLOC occurs in code. It's CAR is a pointer to the - * CDR of a variable. The low order bits of the CAR are 001. - * The CDR of the gloc is the code continuation. - */ -#define scm_tcs_cons_gloc 1:case 9:case 17:case 25:\ - case 33:case 41:case 49:case 57:\ - case 65:case 73:case 81:case 89:\ - case 97:case 105:case 113:case 121 - -#define scm_tcs_closures 3:case 11:case 19:case 27:\ - case 35:case 43:case 51:case 59:\ - case 67:case 75:case 83:case 91:\ - case 99:case 107:case 115:case 123 - -#define scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case scm_tc7_subr_1:case scm_tc7_cxr:\ - case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\ - case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr - -#define scm_tcs_symbols scm_tc7_ssymbol:case scm_tc7_msymbol - -#define scm_tcs_bignums tc16_bigpos:case tc16_bigneg - - - -/* References to objects are of type SCM. Values may be non-immediate - * (pointers) or immediate (encoded, immutable, scalar values that fit - * in an SCM variable). - */ - -typedef long SCM; - -/* Cray machines have pointers that are incremented once for each word, - * rather than each byte, the 3 most significant bits encode the byte - * within the word. The following macros deal with this by storing the - * native Cray pointers like the ones that looks like scm expects. This - * is done for any pointers that might appear in the car of a scm_cell, pointers - * to scm_vector elts, functions, &c are not munged. - */ -#ifdef _UNICOS -#define SCM2PTR(x) ((int)(x) >> 3) -#define PTR2SCM(x) (((SCM)(x)) << 3) -#define SCM_POINTERS_MUNGED -#else -#define SCM2PTR(x) (x) -#define PTR2SCM(x) ((SCM)(x)) -#endif /* def _UNICOS */ - - - -/* Immediate? Predicates - */ -#define SCM_IMP(x) (6 & (int)(x)) -#define SCM_NIMP(x) (!SCM_IMP(x)) - - - -enum scm_tags - { - scm_tc8_char = 0xf4 - }; - -#define SCM_ITAG8(X) ((int)(X) & 0xff) -#define SCM_MAKE_ITAG8(X, TAG) (((X)<<8) + TAG) -#define SCM_ITAG8_DATA(X) ((X)>>8) - - - -/* Local Environment Structure - */ -#define SCM_ILOCP(n) ((0xff & (int)(n))==0xfc) -#define SCM_ILOC00 (0x000000fcL) -#define SCM_IDINC (0x00100000L) -#define SCM_ICDR (0x00080000L) -#define SCM_IFRINC (0x00000100L) -#define SCM_IDSTMSK (-SCM_IDINC) -#define SCM_IFRAME(n) ((int)((SCM_ICDR-SCM_IFRINC)>>8) & ((int)(n)>>8)) -#define SCM_IDIST(n) (((unsigned long)(n))>>20) -#define SCM_ICDRP(n) (SCM_ICDR & (n)) - - -/* Immediate Symbols, Special Symbols, Flags (various constants). - */ - -/* ISYMP tests for ISPCSYM and ISYM */ -#define SCM_ISYMP(n) ((0x187 & (int)(n))==4) - -/* IFLAGP tests for ISPCSYM, ISYM and IFLAG */ -#define SCM_IFLAGP(n) ((0x87 & (int)(n))==4) -#define SCM_ISYMNUM(n) ((int)((n)>>9)) -#define SCM_ISYMCHARS(n) (scm_isymnames[SCM_ISYMNUM(n)]) -#define SCM_MAKSPCSYM(n) (((n)<<9)+((n)<<3)+4L) -#define SCM_MAKISYM(n) (((n)<<9)+0x74L) -#define SCM_MAKIFLAG(n) (((n)<<9)+0x174L) - -/* This table must agree with the declarations - * in repl.c: {Names of immediate symbols}. - * - * These are used only in eval but their values - * have to be allocated here. - * - */ - -#define SCM_IM_AND SCM_MAKSPCSYM(0) -#define SCM_IM_BEGIN SCM_MAKSPCSYM(1) -#define SCM_IM_CASE SCM_MAKSPCSYM(2) -#define SCM_IM_COND SCM_MAKSPCSYM(3) -#define SCM_IM_DO SCM_MAKSPCSYM(4) -#define SCM_IM_IF SCM_MAKSPCSYM(5) -#define SCM_IM_LAMBDA SCM_MAKSPCSYM(6) -#define SCM_IM_LET SCM_MAKSPCSYM(7) -#define SCM_IM_LETSTAR SCM_MAKSPCSYM(8) -#define SCM_IM_LETREC SCM_MAKSPCSYM(9) -#define SCM_IM_OR SCM_MAKSPCSYM(10) -#define SCM_IM_QUOTE SCM_MAKSPCSYM(11) -#define SCM_IM_SET SCM_MAKSPCSYM(12) -#define SCM_IM_DEFINE SCM_MAKSPCSYM(13) -#define SCM_IM_APPLY SCM_MAKISYM(14) -#define SCM_IM_CONT SCM_MAKISYM(15) -#define SCM_NUM_ISYMS 16 - -/* Important immediates - */ - -#define SCM_BOOL_F SCM_MAKIFLAG(SCM_NUM_ISYMS+0) -#define SCM_BOOL_T SCM_MAKIFLAG(SCM_NUM_ISYMS+1) -#define SCM_UNDEFINED SCM_MAKIFLAG(SCM_NUM_ISYMS+2) -#define SCM_EOF_VAL SCM_MAKIFLAG(SCM_NUM_ISYMS+3) - -#ifdef SICP -#define SCM_EOL SCM_BOOL_F -#else -#define SCM_EOL SCM_MAKIFLAG(SCM_NUM_ISYMS+4) -#endif - -#define SCM_UNSPECIFIED SCM_MAKIFLAG(SCM_NUM_ISYMS+5) - - - -/* Heap Pairs and the Empty List Predicates - */ -#define SCM_NULLP(x) (SCM_EOL == (x)) -#define SCM_NNULLP(x) (SCM_EOL != (x)) -#define SCM_CELLP(x) (!SCM_NCELLP(x)) -#define SCM_NCELLP(x) ((sizeof(scm_cell)-1) & (int)(x)) - - - -#define SCM_UNBNDP(x) (SCM_UNDEFINED==(x)) - - - -/* Testing and Changing GC Marks in Various Standard Positions - */ -#define SCM_GCMARKP(x) (1 & (int)SCM_CDR(x)) -#define SCM_GC8MARKP(x) (0x80 & (int)SCM_CAR(x)) -#define SCM_SETGCMARK(x) (SCM_CDR(x) |= 1) -#define SCM_CLRGCMARK(x) (SCM_CDR(x) &= ~1L) -#define SCM_SETGC8MARK(x) (SCM_CAR(x) |= 0x80) -#define SCM_CLRGC8MARK(x) (SCM_CAR(x) &= ~0x80L) - - -/* Extracting Tag Bits, With or Without GC Safety and Optional Bits - */ -#define SCM_TYP3(x) (7 & (int)SCM_CAR(x)) -#define SCM_TYP7(x) (0x7f & (int)SCM_CAR(x)) -#define SCM_TYP7S(x) (0x7d & (int)SCM_CAR(x)) -#define SCM_TYP16(x) (0xffff & (int)SCM_CAR(x)) -#define SCM_TYP16S(x) (0xfeff & (int)SCM_CAR(x)) -#define SCM_GCTYP16(x) (0xff7f & (int)SCM_CAR(x)) - - -/* Two slightly extensible types: smobs and ptobs. - - */ -#define SCM_SMOBNUM(x) (0x0ff & (CAR(x)>>8)); -#define SCM_PTOBNUM(x) (0x0ff & (CAR(x)>>8)); - - - - -#define SCM_DIRP(x) (SCM_NIMP(x) && (TYP16(x)==(scm_tc16_dir))) -#define SCM_OPDIRP(x) (SCM_NIMP(x) && (CAR(x)==(scm_tc16_dir | OPN))) - - - -/* Lvectors - */ -#define SCM_LVECTORP(x) (TYP7(x)==tc7_lvector) - - -#if 0 - -/* Sockets - */ -#define tc_socket (tc7_port | OPN) -#define SCM_SOCKP(x) (((0x7f | OPN | RDNG | WRTNG) & CAR(x))==(tc_socket)) -#define SCM_SOCKTYP(x) (CAR(x)>>24) - - - -extern int scm_tc16_key_vector; -#define SCM_KEYVECP(X) (scm_tc16_key_vector == TYP16 (X)) -#define SCM_KEYVECLEN(OBJ) (((unsigned long)CAR (obj)) >> 16) - - -#define SCM_MALLOCDATA(obj) ((char *)CDR(obj)) -#define SCM_MALLOCLEN(obj) (((unsigned long)CAR (obj)) >> 16) -#define SCM_WORDDATA(obj) (CDR (obj)) - - -#define SCM_BYTECODEP(X) ((TYP7 (X) == tc7_cclo) && (CCLO_SUBR (X) == rb_proc)) -#define SCM_BYTECODE_CONSTANTS(X) (VELTS(X)[1]) -#define SCM_BYTECODE_CODE(X) (VELTS(X)[2]) -#define SCM_BYTECODE_NAME(X) (VELTS(X)[3]) -#define SCM_BYTECODE_BCODE(X) (VELTS(X)[4]) -#define SCM_BYTECODE_ELTS 5 - - -#define SCM_FREEP(x) (CAR(x)==tc_free_cell) -#define SCM_NFREEP(x) (!FREEP(x)) - -#endif /* 0 */ - - -#endif /* TAGSH */ diff --git a/gdb/scm-valprint.c b/gdb/scm-valprint.c deleted file mode 100644 index c5e1ce1..0000000 --- a/gdb/scm-valprint.c +++ /dev/null @@ -1,462 +0,0 @@ -/* Scheme/Guile language support routines for GDB, the GNU debugger. - - Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008, 2009, - 2010 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 3 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, see <http://www.gnu.org/licenses/>. */ - -#include "defs.h" -#include "symtab.h" -#include "gdbtypes.h" -#include "expression.h" -#include "parser-defs.h" -#include "language.h" -#include "value.h" -#include "scm-lang.h" -#include "valprint.h" -#include "gdbcore.h" -#include "c-lang.h" -#include "infcall.h" -#include "objfiles.h" - -static void scm_ipruk (char *, struct type *, LONGEST, struct ui_file *); -static void scm_scmval_print (struct type *, LONGEST, struct ui_file *, - int, const struct value_print_options *); -static void scm_scmlist_print (struct type *, LONGEST, struct ui_file *, - int, const struct value_print_options *); -static int scm_inferior_print (struct type *, LONGEST, struct ui_file *, - int, const struct value_print_options *); - -/* Prints the SCM value VALUE by invoking the inferior, if appropraite. - Returns >= 0 on success; return -1 if the inferior cannot/should not - print VALUE. */ - -static int -scm_inferior_print (struct type *type, LONGEST value, struct ui_file *stream, - int recurse, const struct value_print_options *options) -{ - struct value *func, *arg, *result; - struct symbol *gdb_output_sym, *gdb_output_len_sym; - char *output; - int ret, output_len; - - func = find_function_in_inferior ("gdb_print", NULL); - arg = value_from_longest (type, value); - - result = call_function_by_hand (func, 1, &arg); - ret = (int) value_as_long (result); - if (ret == 0) - { - /* XXX: Should we cache these symbols? */ - gdb_output_sym = - lookup_symbol_global ("gdb_output", NULL, VAR_DOMAIN); - gdb_output_len_sym = - lookup_symbol_global ("gdb_output_length", NULL, VAR_DOMAIN); - - if ((gdb_output_sym == NULL) || (gdb_output_len_sym == NULL)) - ret = -1; - else - { - struct value *remote_buffer; - - read_memory (SYMBOL_VALUE_ADDRESS (gdb_output_len_sym), - (char *) &output_len, sizeof (output_len)); - - output = (char *) alloca (output_len); - remote_buffer = value_at (type, - SYMBOL_VALUE_ADDRESS (gdb_output_sym)); - read_memory (value_as_address (remote_buffer), - output, output_len); - - ui_file_write (stream, output, output_len); - } - } - - return ret; -} - -/* {Names of immediate symbols} - * This table must agree with the declarations in scm.h: {Immediate Symbols}.*/ - -static char *scm_isymnames[] = -{ - /* This table must agree with the declarations */ - "and", - "begin", - "case", - "cond", - "do", - "if", - "lambda", - "let", - "let*", - "letrec", - "or", - "quote", - "set!", - "define", -#if 0 - "literal-variable-ref", - "literal-variable-set!", -#endif - "apply", - "call-with-current-continuation", - - /* user visible ISYMS */ - /* other keywords */ - /* Flags */ - - "#f", - "#t", - "#<undefined>", - "#<eof>", - "()", - "#<unspecified>" -}; - -static void -scm_scmlist_print (struct type *type, LONGEST svalue, - struct ui_file *stream, int recurse, - const struct value_print_options *options) -{ -#define SCM_SIZE (TYPE_LENGTH (type)) -#define SCM_BYTE_ORDER (gdbarch_byte_order (get_type_arch (type))) - unsigned int more = options->print_max; - - if (recurse > 6) - { - fputs_filtered ("...", stream); - return; - } - scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options); - svalue = SCM_CDR (svalue); - for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue)) - { - if (SCM_NECONSP (svalue)) - break; - fputs_filtered (" ", stream); - if (--more == 0) - { - fputs_filtered ("...", stream); - return; - } - scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options); - } - if (SCM_NNULLP (svalue)) - { - fputs_filtered (" . ", stream); - scm_scmval_print (type, svalue, stream, recurse + 1, options); - } -#undef SCM_BYTE_ORDER -#undef SCM_SIZE -} - -static void -scm_ipruk (char *hdr, struct type *type, LONGEST ptr, - struct ui_file *stream) -{ -#define SCM_SIZE (TYPE_LENGTH (type)) -#define SCM_BYTE_ORDER (gdbarch_byte_order (get_type_arch (type))) - fprintf_filtered (stream, "#<unknown-%s", hdr); - if (SCM_CELLP (ptr)) - fprintf_filtered (stream, " (0x%lx . 0x%lx) @", - (long) SCM_CAR (ptr), (long) SCM_CDR (ptr)); - fprintf_filtered (stream, " 0x%s>", phex_nz (ptr, SCM_SIZE)); -#undef SCM_BYTE_ORDER -#undef SCM_SIZE -} - -static void -scm_scmval_print (struct type *type, LONGEST svalue, - struct ui_file *stream, int recurse, - const struct value_print_options *options) -{ - struct gdbarch *gdbarch = get_type_arch (type); - -#define SCM_SIZE (TYPE_LENGTH (type)) -#define SCM_BYTE_ORDER (gdbarch_byte_order (gdbarch)) -taloop: - switch (7 & (int) svalue) - { - case 2: - case 6: - print_longest (stream, - options->format ? options->format : 'd', - 1, svalue >> 2); - break; - case 4: - if (SCM_ICHRP (svalue)) - { - svalue = SCM_ICHR (svalue); - scm_printchar (svalue, builtin_type (gdbarch)->builtin_char, - stream); - break; - } - else if (SCM_IFLAGP (svalue) - && (SCM_ISYMNUM (svalue) - < (sizeof scm_isymnames / sizeof (char *)))) - { - fputs_filtered (SCM_ISYMCHARS (svalue), stream); - break; - } - else if (SCM_ILOCP (svalue)) - { - fprintf_filtered (stream, "#@%ld%c%ld", - (long) SCM_IFRAME (svalue), - SCM_ICDRP (svalue) ? '-' : '+', - (long) SCM_IDIST (svalue)); - break; - } - else - goto idef; - break; - case 1: - /* gloc */ - svalue = SCM_CAR (svalue - 1); - goto taloop; - default: - idef: - scm_ipruk ("immediate", type, svalue, stream); - break; - case 0: - - switch (SCM_TYP7 (svalue)) - { - case scm_tcs_cons_gloc: - if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0) - { -#if 0 - SCM name; -#endif - - fputs_filtered ("#<latte ", stream); -#if 1 - fputs_filtered ("???", stream); -#else - name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name]; - scm_lfwrite (CHARS (name), - (sizet) sizeof (char), - (sizet) LENGTH (name), - port); -#endif - fprintf_filtered (stream, " #X%s>", phex_nz (svalue, SCM_SIZE)); - break; - } - case scm_tcs_cons_imcar: - case scm_tcs_cons_nimcar: - fputs_filtered ("(", stream); - scm_scmlist_print (type, svalue, stream, recurse + 1, options); - fputs_filtered (")", stream); - break; - case scm_tcs_closures: - fputs_filtered ("#<CLOSURE ", stream); - scm_scmlist_print (type, SCM_CODE (svalue), stream, - recurse + 1, options); - fputs_filtered (">", stream); - break; - case scm_tc7_string: - { - int len = SCM_LENGTH (svalue); - CORE_ADDR addr = (CORE_ADDR) SCM_CDR (svalue); - int i; - int done = 0; - int buf_size; - gdb_byte buffer[64]; - int truncate = options->print_max && len > (int) options->print_max; - if (truncate) - len = options->print_max; - fputs_filtered ("\"", stream); - for (; done < len; done += buf_size) - { - buf_size = min (len - done, 64); - read_memory (addr + done, buffer, buf_size); - - for (i = 0; i < buf_size; ++i) - switch (buffer[i]) - { - case '\"': - case '\\': - fputs_filtered ("\\", stream); - default: - fprintf_filtered (stream, "%c", buffer[i]); - } - } - fputs_filtered (truncate ? "...\"" : "\"", stream); - break; - } - break; - case scm_tcs_symbols: - { - int len = SCM_LENGTH (svalue); - - char *str = alloca (len); - read_memory (SCM_CDR (svalue), (gdb_byte *) str, len + 1); - /* Should handle weird characters FIXME */ - str[len] = '\0'; - fputs_filtered (str, stream); - break; - } - case scm_tc7_vector: - { - int len = SCM_LENGTH (svalue); - int i; - LONGEST elements = SCM_CDR (svalue); - LONGEST val; - - fputs_filtered ("#(", stream); - for (i = 0; i < len; ++i) - { - if (i > 0) - fputs_filtered (" ", stream); - val = scm_get_field (elements, i, SCM_SIZE, SCM_BYTE_ORDER); - scm_scmval_print (type, val, stream, recurse + 1, options); - } - fputs_filtered (")", stream); - } - break; -#if 0 - case tc7_lvector: - { - SCM result; - SCM hook; - - hook = scm_get_lvector_hook (exp, LV_PRINT_FN); - if (hook == BOOL_F) - { - scm_puts ("#<locked-vector ", port); - scm_intprint (CDR (exp), 16, port); - scm_puts (">", port); - } - else - { - result - = scm_apply (hook, - scm_listify (exp, port, - (writing ? BOOL_T : BOOL_F), - SCM_UNDEFINED), - EOL); - if (result == BOOL_F) - goto punk; - } - break; - } - break; - case tc7_bvect: - case tc7_ivect: - case tc7_uvect: - case tc7_fvect: - case tc7_dvect: - case tc7_cvect: - scm_raprin1 (exp, port, writing); - break; -#endif - case scm_tcs_subrs: - { - int index = SCM_CAR (svalue) >> 8; -#if 1 - char str[20]; - sprintf (str, "#%d", index); -#else - char *str = index ? SCM_CHARS (scm_heap_org + index) : ""; -#define SCM_CHARS(x) ((char *)(SCM_CDR(x))) - char *str = CHARS (SNAME (exp)); -#endif - - fprintf_filtered (stream, "#<primitive-procedure %s>", - str); - } - break; -#if 0 -#ifdef CCLO - case tc7_cclo: - scm_puts ("#<compiled-closure ", port); - scm_iprin1 (CCLO_SUBR (exp), port, writing); - scm_putc ('>', port); - break; -#endif - case tc7_contin: - fprintf_filtered (stream, "#<continuation %d @ #X%lx >", - LENGTH (svalue), - (long) CHARS (svalue)); - break; - case tc7_port: - i = PTOBNUM (exp); - if (i < scm_numptob - && scm_ptobs[i].print - && (scm_ptobs[i].print) (exp, port, writing)) - break; - goto punk; - case tc7_smob: - i = SMOBNUM (exp); - if (i < scm_numsmob && scm_smobs[i].print - && (scm_smobs[i].print) (exp, port, writing)) - break; - goto punk; -#endif - default: -#if 0 - punk: -#endif - scm_ipruk ("type", type, svalue, stream); - } - break; - } -#undef SCM_BYTE_ORDER -#undef SCM_SIZE -} - -int -scm_val_print (struct type *type, const gdb_byte *valaddr, - int embedded_offset, CORE_ADDR address, - struct ui_file *stream, int recurse, - const struct value *val, - const struct value_print_options *options) -{ - if (is_scmvalue_type (type) - && value_bits_valid (val, TARGET_CHAR_BIT * embedded_offset, - TARGET_CHAR_BIT * TYPE_LENGTH (type))) - { - enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type)); - LONGEST svalue - = extract_signed_integer (valaddr, TYPE_LENGTH (type), byte_order); - - if (scm_inferior_print (type, svalue, stream, recurse, options) >= 0) - { - } - else - { - scm_scmval_print (type, svalue, stream, recurse, options); - } - - gdb_flush (stream); - return (0); - } - else - { - return c_val_print (type, valaddr, 0, address, stream, recurse, - val, options); - } -} - -int -scm_value_print (struct value *val, struct ui_file *stream, - const struct value_print_options *options) -{ - struct value_print_options opts = *options; - - opts.deref_ref = 1; - return (common_val_print (val, stream, 0, &opts, current_language)); -} diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index c70d914..da64857 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2010-11-02 Tom Tromey <tromey@redhat.com> + + * gdb.base/default.exp: Remove "scheme" from language list. + 2010-11-02 Jan Kratochvil <jan.kratochvil@redhat.com> Revert: diff --git a/gdb/testsuite/gdb.base/default.exp b/gdb/testsuite/gdb.base/default.exp index 6f83c8b..7afa865 100644 --- a/gdb/testsuite/gdb.base/default.exp +++ b/gdb/testsuite/gdb.base/default.exp @@ -527,7 +527,7 @@ gdb_test "set history size" "Argument required .integer to set it to.*" "set his #test set history gdb_test "set history" "\"set history\" must be followed by the name of a history subcommand.(\[^\r\n\]*\[\r\n\])+List of set history subcommands:(\[^\r\n\]*\[\r\n\])+set history expansion -- Set history expansion on command input(\[^\r\n\]*\[\r\n\])+set history filename -- Set the filename in which to record the command history(\[^\r\n\]*\[\r\n\])+set history save -- Set saving of the history record on exit(\[^\r\n\]*\[\r\n\])+set history size -- Set the size of the command history(\[^\r\n\]*\[\r\n\])+Type \"help set history\" followed by set history subcommand name for full documentation.(\[^\r\n\]*\[\r\n\])+Command name abbreviations are allowed if unambiguous." "set history" #test set language -gdb_test "set language" "Requires an argument. Valid arguments are auto, local, unknown, ada, c, c.., asm, minimal, d, fortran, objective-c, java, modula-2, pascal, scheme." "set language" +gdb_test "set language" "Requires an argument. Valid arguments are auto, local, unknown, ada, c, c.., asm, minimal, d, fortran, objective-c, java, modula-2, pascal." "set language" #test set listsize gdb_test "set listsize" "Argument required .integer to set it to.*" "set listsize" #test set print "p" abbreviation |