2007-08-10 01:01:17 +02:00
|
|
|
/* Scheme/Guile language support routines for GDB, the GNU debugger.
|
|
|
|
|
2008-01-01 23:53:26 +01:00
|
|
|
Copyright (C) 1995, 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2007,
|
2009-01-03 06:58:08 +01:00
|
|
|
2008, 2009 Free Software Foundation, Inc.
|
2007-08-10 01:01:17 +02:00
|
|
|
|
|
|
|
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
|
2007-08-23 20:08:50 +02:00
|
|
|
the Free Software Foundation; either version 3 of the License, or
|
2007-08-10 01:01:17 +02:00
|
|
|
(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
|
2007-08-23 20:08:50 +02:00
|
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>. */
|
2007-08-10 01:01:17 +02:00
|
|
|
|
|
|
|
#include "defs.h"
|
|
|
|
#include "symtab.h"
|
|
|
|
#include "gdbtypes.h"
|
|
|
|
#include "expression.h"
|
|
|
|
#include "parser-defs.h"
|
|
|
|
#include "language.h"
|
|
|
|
#include "value.h"
|
|
|
|
#include "c-lang.h"
|
|
|
|
#include "scm-lang.h"
|
|
|
|
#include "scm-tags.h"
|
|
|
|
#include "source.h"
|
|
|
|
#include "gdb_string.h"
|
|
|
|
#include "gdbcore.h"
|
|
|
|
#include "infcall.h"
|
2008-09-11 16:27:34 +02:00
|
|
|
#include "objfiles.h"
|
2007-08-10 01:01:17 +02:00
|
|
|
|
|
|
|
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 int in_eval_c (void);
|
|
|
|
|
|
|
|
struct type *builtin_type_scm;
|
|
|
|
|
|
|
|
void
|
|
|
|
scm_printchar (int c, struct ui_file *stream)
|
|
|
|
{
|
|
|
|
fprintf_filtered (stream, "#\\%c", c);
|
|
|
|
}
|
|
|
|
|
|
|
|
static void
|
|
|
|
scm_printstr (struct ui_file *stream, const gdb_byte *string,
|
gdb
* varobj.c (value_get_print_value): Include valprint.h.
(value_get_print_value): Use get_formatted_print_options.
* value.h (struct value_print_options): Declare.
(value_print, val_print, common_val_print, val_print_string):
Update.
* value.c: Include valprint.h.
(show_values): Use get_user_print_options.
(show_convenience): Likewise.
* valprint.h (prettyprint_arrays, prettyprint_structs): Don't
declare.
(struct value_print_options): New type.
(vtblprint, unionprint, addressprint, objectprint, print_max,
inspect_it, repeat_count_threshold, output_format,
stop_print_at_null): Don't declare.
(user_print_options, get_user_print_options,
get_raw_print_options, get_formatted_print_options): Declare.
(print_array_indexes_p): Don't declare.
(maybe_print_array_index, val_print_array_elements): Update.
* valprint.c (print_max): Remove.
(user_print_options): New global.
(get_user_print_options, get_raw_print_options,
get_formatted_print_options): New functions.
(print_array_indexes, repeat_count_threshold, stop_print_at_null,
prettyprint_structs, prettyprint_arrays, unionprint,
addressprint): Remove.
(val_print): Remove format, deref_ref, pretty arguments; add
options. Update.
(common_val_print): Likewise.
(print_array_indexes_p): Remove.
(maybe_print_array_index): Remove format, pretty arguments; add
options. Update.
(val_print_array_elements): Remove format, deref_ref, pretty
arguments; add options. Update.
(val_print_string): Add options argument. Update.
(_initialize_valprint): Use user_print_options.
(output_format): Remove.
(set_output_radix_1): Use user_print_options.
* typeprint.c: Include valprint.h.
(objectprint): Don't declare.
(whatis_exp): Use get_user_print_options.
* tui/tui-regs.c: Include valprint.h.
(tui_register_format): Use get_formatted_print_options.
* tracepoint.c: Include valprint.h.
(addressprint): Don't declare.
(trace_mention): Use get_user_print_options.
(tracepoints_info): Likewise.
* stack.c (print_frame_args): Use get_raw_print_options.
(print_frame_info): Use get_user_print_options.
(print_frame): Likewise.
* sh64-tdep.c: Include valprint.h
(sh64_do_register): Use get_formatted_print_options.
* scm-valprint.c (scm_inferior_print): Remove format, deref_ref,
pretty arguments; add options.
(scm_scmlist_print): Likewise. Update.
(scm_scmval_print): Likewise.
(scm_val_print): Likewise.
(scm_value_print): Remove format, pretty arguments; add options.
Update.
* scm-lang.h (scm_value_print, scm_val_print, scm_scmval_print):
Update.
* scm-lang.c (scm_printstr): Add options argument.
* python/python-value.c: Include valprint.h.
(valpy_str): Use get_user_print_options.
* printcmd.c: Include valprint.h.
(addressprint): Don't declare.
(inspect_it): Remove.
(print_formatted): Remove format option; add options. Update.
(print_scalar_formatted): Likewise.
(print_address_demangle): Use get_user_print_options.
(do_examine): Use get_formatted_print_options.
(print_command_1): Likewise.
(output_command): Use get_formatted_print_options.
(do_one_display): Likewise.
(print_variable_value): Use get_user_print_options.
* p-valprint.c (pascal_val_print): Remove format, deref_ref,
pretty arguments; add options. Update.
(pascal_value_print): Remove format, pretty arguments; add
options. Update.
(vtblprint, objectprint): Don't declare.
(pascal_static_field_print): Remove.
(pascal_object_print_value_fields): Remove format, pretty
arguments; add options. Update.
(pascal_object_print_static_field): Likewise.
(_initialize_pascal_valprint): Use user_print_options. Update.
* p-lang.h (pascal_val_print, pascal_value_print,
pascal_printstr, pascal_object_print_value_fields): Update.
(vtblprint, static_field_print): Don't declare.
* p-lang.c (pascal_printstr): Add options argument. Update.
* objc-lang.c (objc_printstr): Add options argument. Update.
* mt-tdep.c: Include valprint.h.
(mt_registers_info): Use get_raw_print_options.
* mips-tdep.c: Include valprint.h.
(mips_print_fp_register): Use get_formatted_print_options.
(mips_print_register): Likewise.
* mi/mi-main.c: Include valprint.h.
(get_register): Use get_user_print_options.
(mi_cmd_data_evaluate_expression): Likewise.
(mi_cmd_data_read_memory): Use get_formatted_print_options.
* mi/mi-cmd-stack.c: Include valprint.h.
(list_args_or_locals): Use get_raw_print_options.
* m2-valprint.c (print_function_pointer_address): Add addressprint
argument.
(m2_print_long_set): Remove format, pretty arguments.
(m2_print_unbounded_array): Remove format, deref_ref, pretty
arguments; add options. Update.
(print_unpacked_pointer): Remove format argument; add options.
Now static. Update.
(print_variable_at_address): Remove format, deref_ref, pretty
arguments; add options. Update.
(m2_print_array_contents): Likewise.
(m2_val_print): Likewise.
* m2-lang.h (m2_val_print): Update.
* m2-lang.c (m2_printstr): Add options argument. Update.
* language.h (struct value_print_options): Declare.
(struct language_defn) <la_printstr>: Add options argument.
<la_val_print>: Remove format, deref_ref, pretty argument; add
options.
<la_value_print>: Remove format, pretty arguments; add options.
<la_print_array_index>: Likewise.
(LA_VAL_PRINT, LA_VALUE_PRINT, LA_PRINT_STRING,
LA_PRINT_ARRAY_INDEX): Update.
(default_print_array_index): Update.
* language.c (default_print_array_index): Remove format, pretty
arguments; add options. Update.
(unk_lang_printstr): Add options argument.
(unk_lang_val_print): Remove format, deref_ref, pretty arguments;
add options.
(unk_lang_value_print): Remove format, pretty arguments; add
options.
* jv-valprint.c (java_value_print): Remove format, pretty
arguments; add options. Update.
(java_print_value_fields): Likewise.
(java_val_print): Remove format, deref_ref, pretty arguments; add
options. Update.
* jv-lang.h (java_val_print, java_value_print): Declare.
* infcmd.c: Include valprint.h.
(print_return_value): Use get_raw_print_options.
(default_print_registers_info): Use get_user_print_options,
get_formatted_print_options.
(registers_info): Use get_formatted_print_options.
* gdbtypes.h (struct value_print_options): Declare.
(print_scalar_formatted): Update.
* f-valprint.c (f77_print_array_1): Remove format, deref_ref,
pretty arguments; add options. Update.
(f77_print_array): Likewise.
(f_val_print): Likewise.
* f-lang.h (f_val_print): Update.
* f-lang.c (f_printstr): Add options argument. Update.
(c_value_print): Update declaration.
* expprint.c: Include valprint.h.
(print_subexp_standard): Use get_raw_print_options,
get_user_print_options.
* eval.c: Include valprint.h.
(objectprint): Don't declare.
(evaluate_subexp_standard): Use get_user_print_options.
* cp-valprint.c (vtblprint, objectprint, static_field_print):
Remove.
(cp_print_value_fields): Remove format, pretty arguments; add
options. Update.
(cp_print_value): Likewise.
(cp_print_static_field): Likewise.
(_initialize_cp_valprint): Use user_print_options. Update.
* c-valprint.c (print_function_pointer_address): Add addressprint
argument.
(c_val_print): Remove format, deref_ref, pretty arguments; add
options. Update.
(c_value_print): Add options argument. Update.
* c-lang.h (c_val_print, c_value_print, c_printstr): Update.
(vtblprint, static_field_print): Don't declare.
(cp_print_value_fields): Update.
* c-lang.c (c_printstr): Add options argument. Update.
* breakpoint.c: Include valprint.h.
(addressprint): Don't declare.
(watchpoint_value_print): Use get_user_print_options.
(print_one_breakpoint_location): Likewise.
(breakpoint_1, print_it_catch_fork, print_it_catch_vfork, mention,
print_exception_catchpoint): Likewise.
* auxv.c (fprint_target_auxv): Don't declare addressprint. Use
get_user_print_options.
* ada-valprint.c (struct ada_val_print_args): Remove format,
deref_ref, and pretty; add options.
(print_optional_low_bound): Add options argument.
(val_print_packed_array_elements): Remove format and pretty
arguments; add options. Update.
(printstr): Add options argument. Update.
(ada_printstr): Likewise.
(ada_val_print): Remove format, deref_ref, pretty arguments; add
options argument. Update.
(ada_val_print_stub): Update.
(ada_val_print_array): Remove format, deref_ref, pretty arguments;
add options. Update.
(ada_val_print_1): Likewise.
(print_variant_part): Likewise.
(ada_value_print): Remove format, pretty arguments; add options.
Update.
(print_record): Likewise.
(print_field_values): Likewise.
* ada-lang.h (ada_val_print, ada_value_print, ada_printstr):
Update.
* ada-lang.c (ada_print_array_index): Add options argument; remove
format and pretty arguments.
(print_one_exception): Use get_user_print_options.
gdb/testsuite
* gdb.base/exprs.exp (test_expr): Add enum formatting tests.
2008-10-28 18:19:58 +01:00
|
|
|
unsigned int length, int width, int force_ellipses,
|
|
|
|
const struct value_print_options *options)
|
2007-08-10 01:01:17 +02:00
|
|
|
{
|
|
|
|
fprintf_filtered (stream, "\"%s\"", string);
|
|
|
|
}
|
|
|
|
|
|
|
|
int
|
|
|
|
is_scmvalue_type (struct type *type)
|
|
|
|
{
|
|
|
|
if (TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0)
|
|
|
|
{
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Get the INDEX'th SCM value, assuming SVALUE is the address
|
|
|
|
of the 0'th one. */
|
|
|
|
|
|
|
|
LONGEST
|
|
|
|
scm_get_field (LONGEST svalue, int index)
|
|
|
|
{
|
|
|
|
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));
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Unpack a value of type TYPE in buffer VALADDR as an integer
|
|
|
|
(if CONTEXT == TYPE_CODE_IN), a pointer (CONTEXT == TYPE_CODE_PTR),
|
|
|
|
or Boolean (CONTEXT == TYPE_CODE_BOOL). */
|
|
|
|
|
|
|
|
LONGEST
|
|
|
|
scm_unpack (struct type *type, const gdb_byte *valaddr, enum type_code context)
|
|
|
|
{
|
|
|
|
if (is_scmvalue_type (type))
|
|
|
|
{
|
|
|
|
LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
|
|
|
|
if (context == TYPE_CODE_BOOL)
|
|
|
|
{
|
|
|
|
if (svalue == SCM_BOOL_F)
|
|
|
|
return 0;
|
|
|
|
else
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
switch (7 & (int) svalue)
|
|
|
|
{
|
|
|
|
case 2:
|
|
|
|
case 6: /* fixnum */
|
|
|
|
return svalue >> 2;
|
|
|
|
case 4: /* other immediate value */
|
|
|
|
if (SCM_ICHRP (svalue)) /* character */
|
|
|
|
return SCM_ICHR (svalue);
|
|
|
|
else if (SCM_IFLAGP (svalue))
|
|
|
|
{
|
|
|
|
switch ((int) svalue)
|
|
|
|
{
|
|
|
|
#ifndef SICP
|
|
|
|
case SCM_EOL:
|
|
|
|
#endif
|
|
|
|
case SCM_BOOL_F:
|
|
|
|
return 0;
|
|
|
|
case SCM_BOOL_T:
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
error (_("Value can't be converted to integer."));
|
|
|
|
default:
|
|
|
|
return svalue;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
else
|
|
|
|
return unpack_long (type, valaddr);
|
|
|
|
}
|
|
|
|
|
|
|
|
/* True if we're correctly in Guile's eval.c (the evaluator and apply). */
|
|
|
|
|
|
|
|
static int
|
|
|
|
in_eval_c (void)
|
|
|
|
{
|
|
|
|
struct symtab_and_line cursal = get_current_source_symtab_and_line ();
|
|
|
|
|
|
|
|
if (cursal.symtab && cursal.symtab->filename)
|
|
|
|
{
|
|
|
|
char *filename = cursal.symtab->filename;
|
|
|
|
int len = strlen (filename);
|
|
|
|
if (len >= 6 && strcmp (filename + len - 6, "eval.c") == 0)
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* Lookup a value for the variable named STR.
|
|
|
|
First lookup in Scheme context (using the scm_lookup_cstr inferior
|
|
|
|
function), then try lookup_symbol for compiled variables. */
|
|
|
|
|
|
|
|
static struct value *
|
|
|
|
scm_lookup_name (char *str)
|
|
|
|
{
|
2008-09-11 16:27:34 +02:00
|
|
|
struct objfile *objf;
|
|
|
|
struct gdbarch *gdbarch;
|
2007-08-10 01:01:17 +02:00
|
|
|
struct value *args[3];
|
|
|
|
int len = strlen (str);
|
|
|
|
struct value *func;
|
|
|
|
struct value *val;
|
|
|
|
struct symbol *sym;
|
2008-09-11 16:27:34 +02:00
|
|
|
|
|
|
|
func = find_function_in_inferior ("scm_lookup_cstr", &objf);
|
|
|
|
gdbarch = get_objfile_arch (objf);
|
|
|
|
|
2007-08-10 01:01:17 +02:00
|
|
|
args[0] = value_allocate_space_in_inferior (len);
|
2008-09-11 16:27:34 +02:00
|
|
|
args[1] = value_from_longest (builtin_type (gdbarch)->builtin_int, len);
|
2007-08-10 01:01:17 +02:00
|
|
|
write_memory (value_as_long (args[0]), (gdb_byte *) str, len);
|
|
|
|
|
|
|
|
if (in_eval_c ()
|
|
|
|
&& (sym = lookup_symbol ("env",
|
|
|
|
expression_context_block,
|
* symtab.h (lookup_symbol_in_language): Remove SYMTAB parameter.
(lookup_symbol): Likewise.
* symtab.c (lookup_symbol_in_language): Remove SYMTAB parameter.
(lookup_symbol): Likewise.
(search_symbols): Update.
* linespec.c (find_methods, collect_methods): Update.
(add_matching_methods, add_constructors): Update.
(decode_compound, decode_dollar, decode_variable): Update.
(lookup_prefix_sym): Update.
(symbol_found): Remove SYM_SYMTAB parameter.
Use SYMBOL_SYMTAB (sym) instead.
* gdbtypes.c (lookup_typename): Update.
(lookup_struct, lookup_union, lookup_enum): Update.
(lookup_template_type): Update.
(check_typedef): Update.
* language.c (lang_bool_type): Update.
* mdebugread.c (parse_procedure): Update.
* mi/mi-cmd-stack.c (list_args_or_locals): Update.
* parse.c (write_dollar_variable): Update.
* printcmd.c (address_info): Update.
* source.c (select_source_symtab): Update.
* stack.c (print_frame_args, print_frame_arg_vars): Update.
* valops.c (find_function_in_inferior): Update.
(value_struct_elt_for_reference): Update.
* value.c (value_static_field, value_fn_field): Update.
* alpha-mdebug-tdep.c (find_proc_desc): Update.
* arm-tdep.c (arm_skip_prologue): Update.
* mt-tdep.c (mt_skip_prologue): Update.
* xstormy16-tdep.c (xstormy16_skip_prologue): Update.
* ada-lang.h (struct ada_symbol_info): Remove SYMTAB member.
* ada-lang.c (ada_add_block_symbols): Remove SYMTAB parameter.
(add_defn_to_vec): Likewise.
(ada_add_block_symbols): Likewise.
(lookup_cached_symbol, cache_symbol): Likewise.
(standard_lookup): Update.
(ada_lookup_symbol_list): Update.
* c-valprint.c (c_val_print): Update.
* cp-support.c (cp_lookup_rtti_type): Update.
* jv-lang.c (java_lookup_class, get_java_object_type): Update.
* objc-lang.c (lookup_struct_typedef, find_imps): Update.
* p-valprint.c (pascal_val_print): Update.
* scm-lang.c (scm_lookup_name): Update.
* c-exp.y: Update.
* f-exp.y: Update.
* jv-exp.y: Update.
* m2-exp.y: Update.
* objc-exp.y: Update.
* p-exp.y: Update.
2008-05-19 17:50:10 +02:00
|
|
|
VAR_DOMAIN, (int *) NULL)) != NULL)
|
2007-08-10 01:01:17 +02:00
|
|
|
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);
|
|
|
|
|
|
|
|
val = call_function_by_hand (func, 3, args);
|
|
|
|
if (!value_logical_not (val))
|
|
|
|
return value_ind (val);
|
|
|
|
|
|
|
|
sym = lookup_symbol (str,
|
|
|
|
expression_context_block,
|
* symtab.h (lookup_symbol_in_language): Remove SYMTAB parameter.
(lookup_symbol): Likewise.
* symtab.c (lookup_symbol_in_language): Remove SYMTAB parameter.
(lookup_symbol): Likewise.
(search_symbols): Update.
* linespec.c (find_methods, collect_methods): Update.
(add_matching_methods, add_constructors): Update.
(decode_compound, decode_dollar, decode_variable): Update.
(lookup_prefix_sym): Update.
(symbol_found): Remove SYM_SYMTAB parameter.
Use SYMBOL_SYMTAB (sym) instead.
* gdbtypes.c (lookup_typename): Update.
(lookup_struct, lookup_union, lookup_enum): Update.
(lookup_template_type): Update.
(check_typedef): Update.
* language.c (lang_bool_type): Update.
* mdebugread.c (parse_procedure): Update.
* mi/mi-cmd-stack.c (list_args_or_locals): Update.
* parse.c (write_dollar_variable): Update.
* printcmd.c (address_info): Update.
* source.c (select_source_symtab): Update.
* stack.c (print_frame_args, print_frame_arg_vars): Update.
* valops.c (find_function_in_inferior): Update.
(value_struct_elt_for_reference): Update.
* value.c (value_static_field, value_fn_field): Update.
* alpha-mdebug-tdep.c (find_proc_desc): Update.
* arm-tdep.c (arm_skip_prologue): Update.
* mt-tdep.c (mt_skip_prologue): Update.
* xstormy16-tdep.c (xstormy16_skip_prologue): Update.
* ada-lang.h (struct ada_symbol_info): Remove SYMTAB member.
* ada-lang.c (ada_add_block_symbols): Remove SYMTAB parameter.
(add_defn_to_vec): Likewise.
(ada_add_block_symbols): Likewise.
(lookup_cached_symbol, cache_symbol): Likewise.
(standard_lookup): Update.
(ada_lookup_symbol_list): Update.
* c-valprint.c (c_val_print): Update.
* cp-support.c (cp_lookup_rtti_type): Update.
* jv-lang.c (java_lookup_class, get_java_object_type): Update.
* objc-lang.c (lookup_struct_typedef, find_imps): Update.
* p-valprint.c (pascal_val_print): Update.
* scm-lang.c (scm_lookup_name): Update.
* c-exp.y: Update.
* f-exp.y: Update.
* jv-exp.y: Update.
* m2-exp.y: Update.
* objc-exp.y: Update.
* p-exp.y: Update.
2008-05-19 17:50:10 +02:00
|
|
|
VAR_DOMAIN, (int *) NULL);
|
2007-08-10 01:01:17 +02:00
|
|
|
if (sym)
|
|
|
|
return value_of_variable (sym, NULL);
|
|
|
|
error (_("No symbol \"%s\" in current context."), str);
|
|
|
|
}
|
|
|
|
|
|
|
|
struct value *
|
|
|
|
scm_evaluate_string (char *str, int len)
|
|
|
|
{
|
|
|
|
struct value *func;
|
|
|
|
struct value *addr = value_allocate_space_in_inferior (len + 1);
|
|
|
|
LONGEST iaddr = value_as_long (addr);
|
|
|
|
write_memory (iaddr, (gdb_byte *) str, len);
|
|
|
|
/* FIXME - should find and pass env */
|
|
|
|
write_memory (iaddr + len, (gdb_byte *) "", 1);
|
2008-09-11 16:27:34 +02:00
|
|
|
func = find_function_in_inferior ("scm_evstr", NULL);
|
2007-08-10 01:01:17 +02:00
|
|
|
return call_function_by_hand (func, 1, &addr);
|
|
|
|
}
|
|
|
|
|
|
|
|
static struct value *
|
|
|
|
evaluate_exp (struct type *expect_type, struct expression *exp,
|
|
|
|
int *pos, enum noside noside)
|
|
|
|
{
|
|
|
|
enum exp_opcode op = exp->elts[*pos].opcode;
|
|
|
|
int len, pc;
|
|
|
|
char *str;
|
|
|
|
switch (op)
|
|
|
|
{
|
|
|
|
case OP_NAME:
|
|
|
|
pc = (*pos)++;
|
|
|
|
len = longest_to_int (exp->elts[pc + 1].longconst);
|
|
|
|
(*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
|
|
|
|
if (noside == EVAL_SKIP)
|
|
|
|
goto nosideret;
|
|
|
|
str = &exp->elts[pc + 2].string;
|
|
|
|
return scm_lookup_name (str);
|
|
|
|
case OP_STRING:
|
|
|
|
pc = (*pos)++;
|
|
|
|
len = longest_to_int (exp->elts[pc + 1].longconst);
|
|
|
|
(*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1);
|
|
|
|
if (noside == EVAL_SKIP)
|
|
|
|
goto nosideret;
|
|
|
|
str = &exp->elts[pc + 2].string;
|
|
|
|
return scm_evaluate_string (str, len);
|
|
|
|
default:;
|
|
|
|
}
|
|
|
|
return evaluate_subexp_standard (expect_type, exp, pos, noside);
|
|
|
|
nosideret:
|
2008-09-11 16:16:51 +02:00
|
|
|
return value_from_longest (builtin_type_int8, (LONGEST) 1);
|
2007-08-10 01:01:17 +02:00
|
|
|
}
|
|
|
|
|
|
|
|
const struct exp_descriptor exp_descriptor_scm =
|
|
|
|
{
|
|
|
|
print_subexp_standard,
|
|
|
|
operator_length_standard,
|
|
|
|
op_name_standard,
|
|
|
|
dump_subexp_body_standard,
|
|
|
|
evaluate_exp
|
|
|
|
};
|
|
|
|
|
|
|
|
const struct language_defn scm_language_defn =
|
|
|
|
{
|
|
|
|
"scheme", /* Language name */
|
|
|
|
language_scm,
|
|
|
|
range_check_off,
|
|
|
|
type_check_off,
|
|
|
|
case_sensitive_off,
|
|
|
|
array_row_major,
|
2008-09-30 19:21:28 +02:00
|
|
|
macro_expansion_no,
|
2007-08-10 01:01:17 +02:00
|
|
|
&exp_descriptor_scm,
|
|
|
|
scm_parse,
|
|
|
|
c_error,
|
|
|
|
null_post_parser,
|
|
|
|
scm_printchar, /* Print a character constant */
|
|
|
|
scm_printstr, /* Function to print string constant */
|
|
|
|
NULL, /* Function to print a single character */
|
|
|
|
c_print_type, /* Print a type using appropriate syntax */
|
2008-09-27 23:29:30 +02:00
|
|
|
default_print_typedef, /* Print a typedef using appropriate syntax */
|
2007-08-10 01:01:17 +02:00
|
|
|
scm_val_print, /* Print a value using appropriate syntax */
|
|
|
|
scm_value_print, /* Print a top-level value */
|
|
|
|
NULL, /* Language specific skip_trampoline */
|
2008-04-06 10:56:37 +02:00
|
|
|
NULL, /* name_of_this */
|
2007-08-10 01:01:17 +02:00
|
|
|
basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
|
|
|
|
basic_lookup_transparent_type,/* lookup_transparent_type */
|
|
|
|
NULL, /* Language specific symbol demangler */
|
|
|
|
NULL, /* Language specific class_name_from_physname */
|
|
|
|
NULL, /* expression operators for printing */
|
|
|
|
1, /* c-style arrays */
|
|
|
|
0, /* String lower bound */
|
|
|
|
default_word_break_characters,
|
2008-02-05 23:17:41 +01:00
|
|
|
default_make_symbol_completion_list,
|
2007-08-10 01:01:17 +02:00
|
|
|
c_language_arch_info,
|
|
|
|
default_print_array_index,
|
2007-09-23 18:25:06 +02:00
|
|
|
default_pass_by_reference,
|
2009-02-05 13:16:25 +01:00
|
|
|
default_get_string,
|
2007-08-10 01:01:17 +02:00
|
|
|
LANG_MAGIC
|
|
|
|
};
|
|
|
|
|
|
|
|
void
|
|
|
|
_initialize_scheme_language (void)
|
|
|
|
{
|
|
|
|
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);
|
|
|
|
}
|