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 /gdb/scm-valprint.c | |
parent | 9dea9163560f26f9adddd13254ad32f4aea3b1d6 (diff) | |
download | binutils-gdb-50c97f3812a233c6d201d3de555ffffee8ae7cb0.tar.gz |
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.
Diffstat (limited to 'gdb/scm-valprint.c')
-rw-r--r-- | gdb/scm-valprint.c | 462 |
1 files changed, 0 insertions, 462 deletions
diff --git a/gdb/scm-valprint.c b/gdb/scm-valprint.c deleted file mode 100644 index c5e1ce105c7..00000000000 --- 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)); -} |