URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [scm-valprint.c] - Rev 299
Go to most recent revision | Compare with Previous | Blame | View Log
/* Scheme/Guile language support routines for GDB, the GNU debugger. Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008 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" static void scm_ipruk (char *, LONGEST, struct ui_file *); static void scm_scmlist_print (LONGEST, struct ui_file *, int, int, int, enum val_prettyprint); static int scm_inferior_print (LONGEST, struct ui_file *, int, int, int, enum val_prettyprint); /* 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 (LONGEST value, struct ui_file *stream, int format, int deref_ref, int recurse, enum val_prettyprint pretty) { 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"); arg = value_from_longest (builtin_type_CORE_ADDR, 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, NULL, VAR_DOMAIN, (struct symtab **) NULL); gdb_output_len_sym = lookup_symbol_global ("gdb_output_length", NULL, NULL, VAR_DOMAIN, (struct symtab **) NULL); 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 (builtin_type_CORE_ADDR, 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 (LONGEST svalue, struct ui_file *stream, int format, int deref_ref, int recurse, enum val_prettyprint pretty) { unsigned int more = print_max; if (recurse > 6) { fputs_filtered ("...", stream); return; } scm_scmval_print (SCM_CAR (svalue), stream, format, deref_ref, recurse + 1, pretty); 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 (SCM_CAR (svalue), stream, format, deref_ref, recurse + 1, pretty); } if (SCM_NNULLP (svalue)) { fputs_filtered (" . ", stream); scm_scmval_print (svalue, stream, format, deref_ref, recurse + 1, pretty); } } static void scm_ipruk (char *hdr, LONGEST ptr, struct ui_file *stream) { fprintf_filtered (stream, "#<unknown-%s", hdr); #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)); fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr)); } void scm_scmval_print (LONGEST svalue, struct ui_file *stream, int format, int deref_ref, int recurse, enum val_prettyprint pretty) { taloop: switch (7 & (int) svalue) { case 2: case 6: print_longest (stream, format ? format : 'd', 1, svalue >> 2); break; case 4: if (SCM_ICHRP (svalue)) { svalue = SCM_ICHR (svalue); scm_printchar (svalue, 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", 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>", paddr_nz (svalue)); break; } case scm_tcs_cons_imcar: case scm_tcs_cons_nimcar: fputs_filtered ("(", stream); scm_scmlist_print (svalue, stream, format, deref_ref, recurse + 1, pretty); fputs_filtered (")", stream); break; case scm_tcs_closures: fputs_filtered ("#<CLOSURE ", stream); scm_scmlist_print (SCM_CODE (svalue), stream, format, deref_ref, recurse + 1, pretty); 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 = print_max && len > (int) print_max; if (truncate) len = 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); fputs_filtered ("#(", stream); for (i = 0; i < len; ++i) { if (i > 0) fputs_filtered (" ", stream); scm_scmval_print (scm_get_field (elements, i), stream, format, deref_ref, recurse + 1, pretty); } 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", svalue, stream); } break; } } int scm_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int format, int deref_ref, int recurse, enum val_prettyprint pretty) { if (is_scmvalue_type (type)) { LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type)); if (scm_inferior_print (svalue, stream, format, deref_ref, recurse, pretty) >= 0) { } else { scm_scmval_print (svalue, stream, format, deref_ref, recurse, pretty); } gdb_flush (stream); return (0); } else { return c_val_print (type, valaddr, 0, address, stream, format, deref_ref, recurse, pretty); } } int scm_value_print (struct value *val, struct ui_file *stream, int format, enum val_prettyprint pretty) { return (common_val_print (val, stream, format, 1, 0, pretty)); }
Go to most recent revision | Compare with Previous | Blame | View Log