+2009-06-03 Ulrich Weigand <uweigand@de.ibm.com>
+
+ * scm-lang.c (builtin_type_scm): Remove.
+ (scm_lookup_name): Add GDBARCH parameter. Use it instead of
+ objfile architecture. Use per-architecture builtin_scm_type instead
+ of builtin_type_scm.
+ (evaluate_exp): Pass expression architecture to scm_lookup_name.
+
+ (scm_get_field): Add SIZE parameter. Use it instead of
+ TYPE_LENGTH (builtin_type_scm).
+
+ (build_scm_types): New function.
+ (scm_type_data): New variable.
+ (builtin_scm_type): New function.
+ (_initialize_scheme_language): Do not initialize builtin_type_scm.
+ Register build_scm_types as post-init function for scm_type_data.
+
+ * scm-exp.c (scm_lreadr): Use per-architecture builtin_scm_type
+ instead of builtin_type_scm.
+
+ * scm-lang.h (SCM_CAR, SCM_CDR): Pass SCM_SIZE to scm_get_field.
+ (scm_get_field): Add SIZE paramter.
+ (scm_scmval_print): Remove prototype.
+ (builtin_type_scm): Remove.
+ (struct builtin_scm_type): Add structure definition.
+ (builtin_scm_type): Add prototype.
+
+ * scm-valprint.c (scm_inferior_print): Add TYPE parameter. Use it
+ instead of builtin_core_addr type; do not use objfile architecture.
+ (scm_scmlist_print): Add TYPE parameter. Use it to define SCM_SIZE.
+ Pass type to scm_scmval_print.
+ (scm_ipruk): Add TYPE parameter. Use it to define SCM_SIZE.
+ (scm_scmval_print): Make static. Add TYPE parameter. Use it to
+ define SCM_SIZE. Pass type to scm_ipruk and scm_scmlist_print.
+ (scm_val_print): Pass type to scm_inferior_print and scm_scmval_print.
+
2009-06-03 Ulrich Weigand <uweigand@de.ibm.com>
* mdebugread.c (mdebug_type_void, mdebug_type_char, mdebug_type_short,
extern void _initialize_scheme_language (void);
static struct value *evaluate_subexp_scm (struct type *, struct expression *,
int *, enum noside);
-static struct value *scm_lookup_name (char *);
+static struct value *scm_lookup_name (struct gdbarch *, char *);
static int in_eval_c (void);
-struct type *builtin_type_scm;
-
void
scm_printchar (int c, struct type *type, struct ui_file *stream)
{
of the 0'th one. */
LONGEST
-scm_get_field (LONGEST svalue, int index)
+scm_get_field (LONGEST svalue, int index, int size)
{
gdb_byte buffer[20];
- read_memory (SCM2PTR (svalue) + index * TYPE_LENGTH (builtin_type_scm),
- buffer, TYPE_LENGTH (builtin_type_scm));
- return extract_signed_integer (buffer, TYPE_LENGTH (builtin_type_scm));
+ read_memory (SCM2PTR (svalue) + index * size, buffer, size);
+ return extract_signed_integer (buffer, size);
}
/* Unpack a value of type TYPE in buffer VALADDR as an integer
function), then try lookup_symbol for compiled variables. */
static struct value *
-scm_lookup_name (char *str)
+scm_lookup_name (struct gdbarch *gdbarch, char *str)
{
- struct objfile *objf;
- struct gdbarch *gdbarch;
struct value *args[3];
int len = strlen (str);
struct value *func;
struct value *val;
struct symbol *sym;
- func = find_function_in_inferior ("scm_lookup_cstr", &objf);
- gdbarch = get_objfile_arch (objf);
+ func = find_function_in_inferior ("scm_lookup_cstr", NULL);
args[0] = value_allocate_space_in_inferior (len);
args[1] = value_from_longest (builtin_type (gdbarch)->builtin_int, len);
args[2] = value_of_variable (sym, expression_context_block);
else
/* FIXME in this case, we should try lookup_symbol first */
- args[2] = value_from_longest (builtin_type_scm, SCM_EOL);
+ args[2] = value_from_longest (builtin_scm_type (gdbarch)->builtin_scm,
+ SCM_EOL);
val = call_function_by_hand (func, 3, args);
if (!value_logical_not (val))
if (noside == EVAL_SKIP)
goto nosideret;
str = &exp->elts[pc + 2].string;
- return scm_lookup_name (str);
+ return scm_lookup_name (exp->gdbarch, str);
case OP_STRING:
pc = (*pos)++;
len = longest_to_int (exp->elts[pc + 1].longconst);
LANG_MAGIC
};
+static void *
+build_scm_types (struct gdbarch *gdbarch)
+{
+ struct builtin_scm_type *builtin_scm_type
+ = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_scm_type);
+
+ builtin_scm_type->builtin_scm =
+ init_type (TYPE_CODE_INT,
+ gdbarch_long_bit (gdbarch) / TARGET_CHAR_BIT,
+ 0, "SCM", (struct objfile *) NULL);
+
+ return builtin_scm_type;
+}
+
+static struct gdbarch_data *scm_type_data;
+
+const struct builtin_scm_type *
+builtin_scm_type (struct gdbarch *gdbarch)
+{
+ return gdbarch_data (gdbarch, scm_type_data);
+}
+
void
_initialize_scheme_language (void)
{
+ scm_type_data = gdbarch_data_register_post_init (build_scm_types);
+
add_language (&scm_language_defn);
- builtin_type_scm =
- init_type (TYPE_CODE_INT,
- gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
- 0, "SCM", (struct objfile *) NULL);
}
#define SCM_LENGTH(x) (((unsigned long)SCM_CAR(x))>>8)
#define SCM_NCONSP(x) (1 & (int)SCM_CAR(x))
#define SCM_NECONSP(x) (SCM_NCONSP(x) && (1 != SCM_TYP3(x)))
-#define SCM_CAR(x) scm_get_field (x, 0)
-#define SCM_CDR(x) scm_get_field (x, 1)
+#define SCM_CAR(x) scm_get_field (x, 0, SCM_SIZE)
+#define SCM_CDR(x) scm_get_field (x, 1, SCM_SIZE)
#define SCM_VELTS(x) ((SCM *)SCM_CDR(x))
#define SCM_CLOSCAR(x) (SCM_CAR(x)-scm_tc3_closure)
#define SCM_CODE(x) SCM_CAR(SCM_CLOSCAR (x))
struct ui_file *, int,
const struct value_print_options *);
-extern LONGEST scm_get_field (LONGEST, int);
-
-extern void scm_scmval_print (LONGEST, struct ui_file *, int,
- const struct value_print_options *);
+extern LONGEST scm_get_field (LONGEST, int, int);
extern int is_scmvalue_type (struct type *);
extern struct value *scm_evaluate_string (char *, int);
-extern struct type *builtin_type_scm;
-
extern int scm_parse (void);
extern LONGEST scm_unpack (struct type *, const gdb_byte *, enum type_code);
+
+/* Scheme types */
+
+struct builtin_scm_type
+{
+ struct type *builtin_scm;
+};
+
+/* Return the Scheme type table for the specified architecture. */
+extern const struct builtin_scm_type *builtin_scm_type (struct gdbarch *gdbarch);
+
#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);
(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))
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_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))
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));
+#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)
{
+#define SCM_SIZE (TYPE_LENGTH (type))
taloop:
switch (7 & (int) svalue)
{
goto taloop;
default:
idef:
- scm_ipruk ("immediate", svalue, stream);
+ scm_ipruk ("immediate", type, svalue, stream);
break;
case 0:
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:
{
if (i > 0)
fputs_filtered (" ", stream);
- scm_scmval_print (scm_get_field (elements, i), stream,
- recurse + 1, options);
+ scm_scmval_print (type, scm_get_field (elements, i, SCM_SIZE),
+ stream, recurse + 1, options);
}
fputs_filtered (")", stream);
}
#if 0
punk:
#endif
- scm_ipruk ("type", svalue, stream);
+ scm_ipruk ("type", type, svalue, stream);
}
break;
}
+#undef SCM_SIZE
}
int
{
LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
- 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);
projects / binutils-gdb.git / commitdiff