/* Scheme/Guile language support routines for GDB, the GNU debugger.
- Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008, 2009
- Free Software Foundation, Inc.
+ Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008, 2009,
+ 2010 Free Software Foundation, Inc.
This file is part of GDB.
#include "infcall.h"
#include "objfiles.h"
-static void scm_ipruk (char *, LONGEST, struct ui_file *);
-static void scm_scmlist_print (LONGEST, struct ui_file *, int,
- const struct value_print_options *);
-static int scm_inferior_print (LONGEST, struct ui_file *, int,
- const struct value_print_options *);
+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 (LONGEST value, struct ui_file *stream,
+scm_inferior_print (struct type *type, LONGEST value, struct ui_file *stream,
int recurse, const struct value_print_options *options)
{
- struct objfile *objf;
- struct gdbarch *gdbarch;
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", &objf);
- gdbarch = get_objfile_arch (objf);
- arg = value_from_longest (builtin_type (gdbarch)->builtin_core_addr, value);
+ 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);
{
/* XXX: Should we cache these symbols? */
gdb_output_sym =
- lookup_symbol_global ("gdb_output", NULL, NULL, VAR_DOMAIN);
+ lookup_symbol_global ("gdb_output", NULL, VAR_DOMAIN);
gdb_output_len_sym =
- lookup_symbol_global ("gdb_output_length", NULL, NULL, VAR_DOMAIN);
+ lookup_symbol_global ("gdb_output_length", NULL, VAR_DOMAIN);
if ((gdb_output_sym == NULL) || (gdb_output_len_sym == NULL))
ret = -1;
(char *) &output_len, sizeof (output_len));
output = (char *) alloca (output_len);
- remote_buffer = value_at (builtin_type (gdbarch)->builtin_core_addr,
+ remote_buffer = value_at (type,
SYMBOL_VALUE_ADDRESS (gdb_output_sym));
read_memory (value_as_address (remote_buffer),
output, output_len);
};
static void
-scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int recurse,
+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 (SCM_CAR (svalue), stream, recurse + 1, options);
+ scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options);
svalue = SCM_CDR (svalue);
for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
{
fputs_filtered ("...", stream);
return;
}
- scm_scmval_print (SCM_CAR (svalue), stream, recurse + 1, options);
+ scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options);
}
if (SCM_NNULLP (svalue))
{
fputs_filtered (" . ", stream);
- scm_scmval_print (svalue, stream, recurse + 1, options);
+ scm_scmval_print (type, svalue, stream, recurse + 1, options);
}
+#undef SCM_BYTE_ORDER
+#undef SCM_SIZE
}
static void
-scm_ipruk (char *hdr, LONGEST ptr, struct ui_file *stream)
+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);
-#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));
+ fprintf_filtered (stream, " 0x%s>", phex_nz (ptr, SCM_SIZE));
+#undef SCM_BYTE_ORDER
+#undef SCM_SIZE
}
-void
-scm_scmval_print (LONGEST svalue, struct ui_file *stream,
- int recurse, const struct value_print_options *options)
+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)
{
if (SCM_ICHRP (svalue))
{
svalue = SCM_ICHR (svalue);
- scm_printchar (svalue, stream);
+ scm_printchar (svalue, builtin_type (gdbarch)->builtin_char,
+ stream);
break;
}
else if (SCM_IFLAGP (svalue)
goto taloop;
default:
idef:
- scm_ipruk ("immediate", svalue, stream);
+ scm_ipruk ("immediate", type, svalue, stream);
break;
case 0:
#if 0
SCM name;
#endif
+
fputs_filtered ("#<latte ", stream);
#if 1
fputs_filtered ("???", stream);
(sizet) LENGTH (name),
port);
#endif
- fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));
+ 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 (svalue, stream, recurse + 1, options);
+ scm_scmlist_print (type, svalue, stream, recurse + 1, options);
fputs_filtered (")", stream);
break;
case scm_tcs_closures:
fputs_filtered ("#<CLOSURE ", stream);
- scm_scmlist_print (SCM_CODE (svalue), stream, recurse + 1, options);
+ scm_scmlist_print (type, SCM_CODE (svalue), stream,
+ recurse + 1, options);
fputs_filtered (">", stream);
break;
case scm_tc7_string:
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);
- scm_scmval_print (scm_get_field (elements, i), stream,
- recurse + 1, options);
+ val = scm_get_field (elements, i, SCM_SIZE, SCM_BYTE_ORDER);
+ scm_scmval_print (type, val, stream, recurse + 1, options);
}
fputs_filtered (")", stream);
}
{
SCM result;
SCM hook;
+
hook = scm_get_lvector_hook (exp, LV_PRINT_FN);
if (hook == BOOL_F)
{
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
char *str = CHARS (SNAME (exp));
#endif
+
fprintf_filtered (stream, "#<primitive-procedure %s>",
str);
}
#if 0
punk:
#endif
- scm_ipruk ("type", svalue, stream);
+ 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))
+ if (is_scmvalue_type (type)
+ && value_bits_valid (val, TARGET_CHAR_BIT * embedded_offset,
+ TARGET_CHAR_BIT * TYPE_LENGTH (type)))
{
- LONGEST svalue = extract_signed_integer (valaddr, 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 (svalue, stream, recurse, options) >= 0)
+ if (scm_inferior_print (type, svalue, stream, recurse, options) >= 0)
{
}
else
{
- scm_scmval_print (svalue, stream, recurse, options);
+ scm_scmval_print (type, svalue, stream, recurse, options);
}
gdb_flush (stream);
}
else
{
- return c_val_print (type, valaddr, 0, address, stream, recurse, options);
+ return c_val_print (type, valaddr, 0, address, stream, recurse,
+ val, options);
}
}
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));
}
projects / deliverable / binutils-gdb.git / blobdiff