/* Scheme/Guile language support routines for GDB, the GNU debugger.
- Copyright 1995 Free Software Foundation, Inc.
-This file is part of GDB.
+ Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 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 2 of the License, or
-(at your option) any later version.
+ This file is part of GDB.
-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.
+ 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.
-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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ 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 "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 succes; retunr -1 if the inferior cannot/should not
+ Returns >= 0 on success; return -1 if the inferior cannot/should not
print VALUE. */
-int
-scm_inferior_print (value, stream, format, deref_ref, recurse, pretty)
- LONGEST value;
- GDB_FILE *stream;
- int format;
- int deref_ref;
- int recurse;
- enum val_prettyprint pretty;
+static int
+scm_inferior_print (struct type *type, LONGEST value, struct ui_file *stream,
+ int recurse, const struct value_print_options *options)
{
- return -1;
+ 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}
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",
+ "and",
+ "begin",
+ "case",
+ "cond",
+ "do",
+ "if",
+ "lambda",
+ "let",
+ "let*",
+ "letrec",
+ "or",
+ "quote",
+ "set!",
+ "define",
#if 0
- "#@literal-variable-ref",
- "#@literal-variable-set!",
+ "literal-variable-ref",
+ "literal-variable-set!",
#endif
- "#@apply",
- "#@call-with-current-continuation",
+ "apply",
+ "call-with-current-continuation",
/* user visible ISYMS */
/* other keywords */
"#<unspecified>"
};
-static int
-scm_scmlist_print (svalue, stream, format, deref_ref, recurse, pretty)
- LONGEST svalue;
- GDB_FILE *stream;
- int format;
- int deref_ref;
- int recurse;
- enum val_prettyprint pretty;
+static void
+scm_scmlist_print (struct type *type, LONGEST svalue,
+ struct ui_file *stream, int recurse,
+ const struct value_print_options *options)
{
- unsigned int more = print_max;
+#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 0;
+ return;
}
- scm_scmval_print (SCM_CAR (svalue), stream, format,
- deref_ref, recurse + 1, pretty);
+ 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, format,
- deref_ref, recurse + 1, pretty);
+ scm_scmval_print (type, SCM_CAR (svalue), stream, recurse + 1, options);
}
if (SCM_NNULLP (svalue))
{
fputs_filtered (" . ", stream);
- scm_scmval_print (svalue, stream, format,
- deref_ref, recurse + 1, pretty);
+ scm_scmval_print (type, svalue, stream, recurse + 1, options);
}
+#undef SCM_BYTE_ORDER
+#undef SCM_SIZE
}
static void
-scm_ipruk (hdr, ptr, stream)
- char *hdr;
- LONGEST ptr;
- GDB_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 (SCM_TYPE ? TYPE_LENGTH (SCM_TYPE) : sizeof (void*))
if (SCM_CELLP (ptr))
fprintf_filtered (stream, " (0x%lx . 0x%lx) @",
(long) SCM_CAR (ptr), (long) SCM_CDR (ptr));
- fprintf_filtered (stream, " 0x%x>", ptr);
+ fprintf_filtered (stream, " 0x%s>", phex_nz (ptr, SCM_SIZE));
+#undef SCM_BYTE_ORDER
+#undef SCM_SIZE
}
-int
-scm_scmval_print (svalue, stream, format, deref_ref, recurse, pretty)
- LONGEST svalue;
- GDB_FILE *stream;
- int format;
- int deref_ref;
- int recurse;
- enum val_prettyprint pretty;
+static void
+scm_scmval_print (struct type *type, LONGEST svalue,
+ struct ui_file *stream, int recurse,
+ const struct value_print_options *options)
{
- taloop:
- switch (7 & svalue)
+ 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, format ? format : 'd', 1, svalue >> 2);
+ 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, stream);
+ scm_printchar (svalue, builtin_type (gdbarch)->builtin_char,
+ stream);
break;
}
else if (SCM_IFLAGP (svalue)
break;
case 1:
/* gloc */
- fputs_filtered ("#@", stream);
svalue = SCM_CAR (svalue - 1);
goto taloop;
default:
idef:
- scm_ipruk ("immediate", svalue, stream);
+ scm_ipruk ("immediate", type, svalue, stream);
break;
case 0:
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];
+ name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];
scm_lfwrite (CHARS (name),
(sizet) sizeof (char),
- (sizet) LENGTH (name),
+ (sizet) LENGTH (name),
port);
#endif
- fprintf_filtered (stream, " #X%lX>", 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, format,
- deref_ref, recurse + 1, pretty);
+ 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, format,
- deref_ref, recurse + 1, pretty);
+ scm_scmlist_print (type, SCM_CODE (svalue), stream,
+ recurse + 1, options);
fputs_filtered (">", stream);
break;
case scm_tc7_string:
int i;
int done = 0;
int buf_size;
- char buffer[64];
- int truncate = print_max && len > (int) print_max;
+ gdb_byte buffer[64];
+ int truncate = options->print_max && len > (int) options->print_max;
if (truncate)
- len = print_max;
+ 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])
{
{
int len = SCM_LENGTH (svalue);
- char * str = (char*) alloca (len);
- read_memory (SCM_CDR (svalue), str, len + 1);
+ 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);
{
int len = SCM_LENGTH (svalue);
int i;
- LONGEST elements = SCM_CDR(svalue);
+ 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, format,
- deref_ref, recurse + 1, pretty);
+ val = scm_get_field (elements, i, SCM_SIZE, SCM_BYTE_ORDER);
+ scm_scmval_print (type, val, stream, recurse + 1, options);
}
fputs_filtered (")", stream);
}
if (hook == BOOL_F)
{
scm_puts ("#<locked-vector ", port);
- scm_intprint(CDR(exp), 16, 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_listify (exp, port,
+ (writing ? BOOL_T : BOOL_F),
SCM_UNDEFINED),
EOL);
if (result == BOOL_F)
char str[20];
sprintf (str, "#%d", index);
#else
- char *str = index ? SCM_CHARS (scm_heap_org+index) : "";
+ char *str = index ? SCM_CHARS (scm_heap_org + index) : "";
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
char *str = CHARS (SNAME (exp));
#endif
break;
case tc7_port:
i = PTOBNUM (exp);
- if (i < scm_numptob && scm_ptobs[i].print && (scm_ptobs[i].print) (exp, port, writing))
+ if (i < scm_numptob
+ && scm_ptobs[i].print
+ && (scm_ptobs[i].print) (exp, port, writing))
break;
goto punk;
case tc7_smob:
goto punk;
#endif
default:
- punk:scm_ipruk ("type", svalue, stream);
+#if 0
+ punk:
+#endif
+ scm_ipruk ("type", type, svalue, stream);
}
break;
}
+#undef SCM_BYTE_ORDER
+#undef SCM_SIZE
}
int
-scm_val_print (type, valaddr, address, stream, format, deref_ref, recurse,
- pretty)
- struct type *type;
- char *valaddr;
- CORE_ADDR address;
- GDB_FILE *stream;
- int format;
- int deref_ref;
- int recurse;
- enum val_prettyprint pretty;
+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_print_options *options)
{
if (is_scmvalue_type (type))
{
- LONGEST svalue = unpack_long (type, valaddr);
- if (scm_inferior_print (svalue, stream, format,
- deref_ref, recurse, pretty) >= 0)
+ 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 (svalue, stream, format,
- deref_ref, recurse, pretty);
+ scm_scmval_print (type, svalue, stream, recurse, options);
}
gdb_flush (stream);
}
else
{
- return c_val_print (type, valaddr, address, stream, format,
- deref_ref, recurse, pretty);
+ return c_val_print (type, valaddr, 0, address, stream, recurse, options);
}
}
int
-scm_value_print (val, stream, format, pretty)
- value_ptr val;
- GDB_FILE *stream;
- int format;
- enum val_prettyprint pretty;
+scm_value_print (struct value *val, struct ui_file *stream,
+ const struct value_print_options *options)
{
- return (val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
- VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
+ 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