mirror of
https://github.com/darlinghq/darling-gdb.git
synced 2024-11-28 14:30:48 +00:00
197e01b6dc
* arm-tdep.c: * ia64-tdep.c: * i386-tdep.c: * hpread.c: * hppa-tdep.c: * hppa-hpux-tdep.c: * gnu-nat.c: * gdbtypes.c: * gdbarch.h: * gdbarch.c: * eval.c: * dwarf2read.c: * dbxread.c: * copying: * symfile.c: * stabsread.c: * sh64-tdep.c: * sh-tdep.c: * s390-tdep.c: * rs6000-tdep.c: * remote.c: * remote-mips.c: * mips-tdep.c: * mdebugread.c: * linux-nat.c: * infrun.c: * xcoffread.c: * win32-nat.c: * valops.c: * utils.c: * tracepoint.c: * target.c: * symtab.c: * c-exp.y: * ada-valprint.c: * ada-typeprint.c: * ada-lex.l: * ada-lang.h: * ada-lang.c: * ada-exp.y: * alphafbsd-tdep.c: * alphabsd-tdep.h: * alphabsd-tdep.c: * alphabsd-nat.c: * alpha-tdep.h: * alpha-tdep.c: * alpha-osf1-tdep.c: * alpha-nat.c: * alpha-mdebug-tdep.c: * alpha-linux-tdep.c: * alpha-linux-nat.c: * aix-thread.c: * abug-rom.c: * arch-utils.c: * annotate.h: * annotate.c: * amd64obsd-tdep.c: * amd64obsd-nat.c: * amd64nbsd-tdep.c: * amd64nbsd-nat.c: * amd64fbsd-tdep.c: * amd64fbsd-nat.c: * amd64bsd-nat.c: * amd64-tdep.h: * amd64-tdep.c: * amd64-sol2-tdep.c: * amd64-nat.h: * amd64-nat.c: * amd64-linux-tdep.c: * amd64-linux-nat.c: * alphanbsd-tdep.c: * block.h: * block.c: * bfd-target.h: * bfd-target.c: * bcache.h: * bcache.c: * ax.h: * ax-general.c: * ax-gdb.h: * ax-gdb.c: * avr-tdep.c: * auxv.h: * auxv.c: * armnbsd-tdep.c: * armnbsd-nat.c: * arm-tdep.h: * arm-linux-nat.c: * arch-utils.h: * charset.c: * call-cmds.h: * c-valprint.c: * c-typeprint.c: * c-lang.h: * c-lang.c: * buildsym.h: * buildsym.c: * bsd-uthread.h: * bsd-uthread.c: * bsd-kvm.h: * bsd-kvm.c: * breakpoint.h: * core-regset.c: * core-aout.c: * completer.h: * completer.c: * complaints.h: * complaints.c: * command.h: * coffread.c: * coff-solib.h: * coff-solib.c: * coff-pe-read.h: * coff-pe-read.c: * cli-out.h: * cli-out.c: * charset.h: * dink32-rom.c: * dictionary.h: * dictionary.c: * demangle.c: * defs.h: * dcache.h: * dcache.c: * d10v-tdep.c: * cpu32bug-rom.c: * cp-valprint.c: * cp-support.h: * cp-support.c: * cp-namespace.c: * cp-abi.h: * cp-abi.c: * corelow.c: * corefile.c: * environ.c: * elfread.c: * dwarfread.c: * dwarf2loc.c: * dwarf2expr.h: * dwarf2expr.c: * dwarf2-frame.h: * dwarf2-frame.c: * dve3900-rom.c: * dummy-frame.h: * dummy-frame.c: * dsrec.c: * doublest.h: * doublest.c: * disasm.h: * disasm.c: * fork-child.c: * findvar.c: * fbsd-nat.h: * fbsd-nat.c: * f-valprint.c: * f-typeprint.c: * f-lang.h: * f-lang.c: * expression.h: * expprint.c: * exec.h: * exec.c: * exceptions.h: * exceptions.c: * event-top.h: * event-top.c: * event-loop.h: * event-loop.c: * gdb.c: * gdb-stabs.h: * gdb-events.h: * gdb-events.c: * gcore.c: * frv-tdep.h: * frv-tdep.c: * frv-linux-tdep.c: * frame.h: * frame.c: * frame-unwind.h: * frame-unwind.c: * frame-base.h: * frame-base.c: * gdb_vfork.h: * gdb_thread_db.h: * gdb_string.h: * gdb_stat.h: * gdb_regex.h: * gdb_ptrace.h: * gdb_proc_service.h: * gdb_obstack.h: * gdb_locale.h: * gdb_dirent.h: * gdb_curses.h: * gdb_assert.h: * gdbarch.sh: * gdb.h: * hpux-thread.c: * hppabsd-nat.c: * hppa-tdep.h: * hpacc-abi.c: * h8300-tdep.c: * gregset.h: * go32-nat.c: * gnu-v3-abi.c: * gnu-v2-abi.h: * gnu-v2-abi.c: * gnu-nat.h: * glibc-tdep.c: * gdbtypes.h: * gdbcore.h: * gdbcmd.h: * i386nbsd-tdep.c: * i386nbsd-nat.c: * i386gnu-tdep.c: * i386gnu-nat.c: * i386fbsd-tdep.c: * i386fbsd-nat.c: * i386bsd-tdep.c: * i386bsd-nat.h: * i386bsd-nat.c: * i386-tdep.h: * i386-sol2-nat.c: * i386-nto-tdep.c: * i386-nat.c: * i386-linux-tdep.h: * i386-linux-tdep.c: * i386-linux-nat.c: * i386-cygwin-tdep.c: * inf-ttrace.c: * inf-ptrace.h: * inf-ptrace.c: * inf-loop.h: * inf-loop.c: * inf-child.h: * inf-child.c: * ia64-tdep.h: * ia64-linux-nat.c: * i387-tdep.h: * i387-tdep.c: * i386v4-nat.c: * i386v-nat.c: * i386obsd-tdep.c: * i386obsd-nat.c: * kod.c: * jv-valprint.c: * jv-typeprint.c: * jv-lang.h: * jv-lang.c: * irix5-nat.c: * iq2000-tdep.c: * interps.h: * interps.c: * inftarg.c: * inflow.h: * inflow.c: * inferior.h: * infcmd.c: * infcall.h: * infcall.c: * inf-ttrace.h: * m32r-tdep.h: * m32r-tdep.c: * m32r-rom.c: * m32r-linux-tdep.c: * m32r-linux-nat.c: * m2-valprint.c: * m2-typeprint.c: * m2-lang.h: * m2-lang.c: * lynx-nat.c: * linux-thread-db.c: * linux-nat.h: * linespec.c: * libunwind-frame.h: * libunwind-frame.c: * language.h: * language.c: * macroexp.c: * macrocmd.c: * m88kbsd-nat.c: * m88k-tdep.h: * m88k-tdep.c: * m68klinux-tdep.c: * m68klinux-nat.c: * m68kbsd-tdep.c: * m68kbsd-nat.c: * m68k-tdep.h: * m68k-tdep.c: * mips-linux-nat.c: * mips-irix-tdep.c: * minsyms.c: * memattr.h: * memattr.c: * mem-break.c: * mdebugread.h: * main.h: * main.c: * macrotab.h: * macrotab.c: * macroscope.h: * macroscope.c: * macroexp.h: * nbsd-tdep.c: * mt-tdep.c: * monitor.h: * monitor.c: * mn10300-tdep.h: * mn10300-tdep.c: * mn10300-linux-tdep.c: * mipsv4-nat.c: * mipsread.c: * mipsnbsd-tdep.h: * mipsnbsd-tdep.c: * mipsnbsd-nat.c: * mips64obsd-tdep.c: * mips64obsd-nat.c: * mips-tdep.h: * mips-mdebug-tdep.c: * mips-linux-tdep.c: * osabi.h: * osabi.c: * ocd.h: * ocd.c: * observer.c: * objfiles.h: * objfiles.c: * objc-lang.h: * objc-lang.c: * objc-exp.y: * nto-tdep.h: * nto-tdep.c: * nto-procfs.c: * nlmread.c: * nbsd-tdep.h: * ppcobsd-tdep.c: * ppcobsd-nat.c: * ppcnbsd-tdep.h: * ppcnbsd-tdep.c: * ppcnbsd-nat.c: * ppcbug-rom.c: * ppc-tdep.h: * ppc-sysv-tdep.c: * ppc-linux-tdep.c: * ppc-linux-nat.c: * ppc-bdm.c: * parser-defs.h: * parse.c: * p-valprint.c: * p-typeprint.c: * p-lang.h: * p-lang.c: * remote-fileio.h: * remote-fileio.c: * remote-est.c: * remote-e7000.c: * regset.h: * regset.c: * reggroups.h: * reggroups.c: * regcache.h: * regcache.c: * proc-why.c: * proc-service.c: * proc-events.c: * printcmd.c: * ppcobsd-tdep.h: * sentinel-frame.h: * sentinel-frame.c: * scm-valprint.c: * scm-tags.h: * scm-lang.h: * scm-lang.c: * scm-exp.c: * s390-tdep.h: * rom68k-rom.c: * remote.h: * remote-utils.c: * remote-st.c: * remote-sim.c: * remote-sds.c: * remote-rdp.c: * remote-rdi.c: * remote-hms.c: * sim-regno.h: * shnbsd-tdep.h: * shnbsd-tdep.c: * shnbsd-nat.c: * sh-tdep.h: * serial.h: * serial.c: * ser-unix.h: * ser-unix.c: * ser-tcp.c: * ser-pipe.c: * ser-go32.c: * ser-e7kpc.c: * ser-base.h: * ser-base.c: * solib.c: * solib-svr4.h: * solib-svr4.c: * solib-sunos.c: * solib-som.h: * solib-som.c: * solib-pa64.h: * solib-pa64.c: * solib-osf.c: * solib-null.c: * solib-legacy.c: * solib-irix.c: * solib-frv.c: * solib-aix5.c: * sol-thread.c: * sparc64-linux-tdep.c: * sparc64-linux-nat.c: * sparc-tdep.h: * sparc-tdep.c: * sparc-sol2-tdep.c: * sparc-sol2-nat.c: * sparc-nat.h: * sparc-nat.c: * sparc-linux-tdep.c: * sparc-linux-nat.c: * source.h: * source.c: * somread.c: * solist.h: * solib.h: * std-regs.c: * stack.h: * stack.c: * stabsread.h: * sparcobsd-tdep.c: * sparcnbsd-tdep.c: * sparcnbsd-nat.c: * sparc64obsd-tdep.c: * sparc64nbsd-tdep.c: * sparc64nbsd-nat.c: * sparc64fbsd-tdep.c: * sparc64fbsd-nat.c: * sparc64-tdep.h: * sparc64-tdep.c: * sparc64-sol2-tdep.c: * sparc64-nat.c: * ui-file.c: * typeprint.h: * typeprint.c: * tramp-frame.h: * tramp-frame.c: * trad-frame.h: * trad-frame.c: * tracepoint.h: * top.c: * tobs.inc: * thread.c: * terminal.h: * target.h: * symfile.h: * stop-gdb.c: * vaxbsd-nat.c: * vax-tdep.h: * vax-tdep.c: * vax-nat.c: * varobj.h: * varobj.c: * value.h: * value.c: * valprint.h: * valprint.c: * v850-tdep.c: * uw-thread.c: * user-regs.c: * ui-out.h: * ui-out.c: * ui-file.h: * xcoffsolib.h: * xcoffsolib.c: * wrapper.c: * wince.c: * wince-stub.h: * wince-stub.c: * vaxobsd-tdep.c: * vaxnbsd-tdep.c: * gdb_gcore.sh: * copying.c: * configure.ac: * aclocal.m4: * acinclude.m4: * reply_mig_hack.awk: * observer.sh: * gdb_mbuild.sh: * arm-linux-tdep.c: * blockframe.c: * dbug-rom.c: * environ.h: * dwarf2loc.h: * gdb-events.sh: * glibc-tdep.h: * gdb_wait.h: * gdbthread.h: * i386-sol2-tdep.c: * hppabsd-tdep.c: * hppa-linux-nat.c: * hppa-hpux-nat.c: * ia64-linux-tdep.c: * infptrace.c: * linespec.h: * maint.c: * mips-mdebug-tdep.h: * remote-m32r-sdi.c: * s390-nat.c: * rs6000-nat.c: * remote-utils.h: * sh3-rom.c: * sh-linux-tdep.c: * top.h: * symtab.h: * symmisc.c: * symfile-mem.c: * srec.h: * user-regs.h: * version.h: * valarith.c: * xstormy16-tdep.c: * wrapper.h: * Makefile.in: * f-exp.y: * cris-tdep.c: * cp-name-parser.y: * procfs.c: * proc-utils.h: * proc-flags.c: * proc-api.c: * p-exp.y: * m68hc11-tdep.c: * m2-exp.y: * kod.h: * kod-cisco.c: * jv-exp.y: * hppa-linux-tdep.c: Add (c) after Copyright. Update the FSF address.
396 lines
9.4 KiB
C
396 lines
9.4 KiB
C
/* Scheme/Guile language support routines for GDB, the GNU debugger.
|
|
|
|
Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005 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., 51 Franklin Street, Fifth Floor,
|
|
Boston, MA 02110-1301, USA. */
|
|
|
|
#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"
|
|
|
|
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 succes; retunr -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)
|
|
{
|
|
return -1;
|
|
}
|
|
|
|
/* {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));
|
|
}
|