/* Scheme/Guile language support routines for GDB, the GNU debugger.
- Copyright 1995 Free Software Foundation, Inc.
+ Copyright 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-This file is part of GDB.
+ 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 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.
+ 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
+ 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. */
#include "defs.h"
#include "symtab.h"
#include "value.h"
#include "scm-lang.h"
#include "valprint.h"
+#include "gdbcore.h"
+
+/* FIXME: Should be in a header file that we import. */
+extern int c_val_print (struct type *, char *, int, CORE_ADDR,
+ struct ui_file *, int, int, int,
+ enum val_prettyprint);
+
+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. */
-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 (LONGEST value, struct ui_file *stream, int format,
+ int deref_ref, int recurse, enum val_prettyprint pretty)
{
return -1;
}
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 (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 0;
+ return;
}
scm_scmval_print (SCM_CAR (svalue), stream, format,
deref_ref, recurse + 1, pretty);
}
static void
-scm_ipruk (hdr, ptr, stream)
- char *hdr;
- LONGEST ptr;
- GDB_FILE *stream;
+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%x>", ptr);
+ fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));
}
-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;
+void
+scm_scmval_print (LONGEST svalue, struct ui_file *stream, int format,
+ int deref_ref, int recurse, enum val_prettyprint pretty)
{
- taloop:
- switch (7 & svalue)
+taloop:
+ switch (7 & (int) svalue)
{
case 2:
case 6:
break;
case 1:
/* gloc */
- fputs_filtered ("#@", stream);
svalue = SCM_CAR (svalue - 1);
goto taloop;
default:
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>", paddr_nz (svalue));
break;
}
case scm_tcs_cons_imcar:
{
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);
+ char *str = (char *) alloca (len);
read_memory (SCM_CDR (svalue), str, len + 1);
/* Should handle weird characters FIXME */
str[len] = '\0';
{
int len = SCM_LENGTH (svalue);
int i;
- LONGEST elements = SCM_CDR(svalue);
+ LONGEST elements = SCM_CDR (svalue);
fputs_filtered ("#(", stream);
for (i = 0; i < len; ++i)
{
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_UNDEFINED),
+ scm_listify (exp, port, (writing ? BOOL_T : BOOL_F),
+ SCM_UNDEFINED),
EOL);
if (result == BOOL_F)
goto punk;
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
goto punk;
#endif
default:
- punk:scm_ipruk ("type", svalue, stream);
+#if 0
+ punk:
+#endif
+ scm_ipruk ("type", svalue, stream);
}
break;
}
}
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, char *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))
{
else
{
scm_scmval_print (svalue, stream, format,
- deref_ref, recurse, pretty);
+ deref_ref, recurse, pretty);
}
gdb_flush (stream);
}
else
{
- return c_val_print (type, valaddr, address, stream, format,
+ return c_val_print (type, valaddr, 0, address, stream, format,
deref_ref, recurse, pretty);
}
}
int
-scm_value_print (val, stream, format, pretty)
- value_ptr val;
- GDB_FILE *stream;
- int format;
- enum val_prettyprint pretty;
+scm_value_print (value_ptr val, struct ui_file *stream, int format,
+ enum val_prettyprint pretty)
{
- return (val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
+ return (val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
}
projects / binutils.git / blobdiff