X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Fscm-lang.c;h=e2568c893856d61cf214b769c4806f4b90a6b6e8;hb=c28c63d86bd759c7595e85ef13949502e95fd58a;hp=ac09fe6aa32fb5f567a995dbe67d7578b6bf67f2;hpb=abd8680d6efd97e7ba848a6392ee3ad72be18cd0;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/scm-lang.c b/gdb/scm-lang.c index ac09fe6aa3..e2568c8938 100644 --- a/gdb/scm-lang.c +++ b/gdb/scm-lang.c @@ -1,11 +1,13 @@ /* Scheme/Guile language support routines for GDB, the GNU debugger. - Copyright 1995, 2000 Free Software Foundation, Inc. + + Copyright (C) 1995, 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005, 2007, + 2008, 2009 Free Software Foundation, Inc. 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 + the Free Software Foundation; either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, @@ -14,9 +16,7 @@ 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. */ + along with this program. If not, see . */ #include "defs.h" #include "symtab.h" @@ -28,47 +28,38 @@ #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" +#include "objfiles.h" -extern void _initialize_scheme_language PARAMS ((void)); -static value_ptr evaluate_subexp_scm PARAMS ((struct type *, struct expression *, - int *, enum noside)); -static value_ptr scm_lookup_name PARAMS ((char *)); -static int in_eval_c PARAMS ((void)); -static void scm_printstr (struct ui_file * stream, char *string, - unsigned int length, int width, - int force_ellipses); - -extern struct type **CONST_PTR (c_builtin_types[]); +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 (c, stream) - int c; - struct ui_file *stream; +scm_printchar (int c, struct type *type, struct ui_file *stream) { fprintf_filtered (stream, "#\\%c", c); } static void -scm_printstr (stream, string, length, width, force_ellipses) - struct ui_file *stream; - char *string; - unsigned int length; - int width; - int force_ellipses; +scm_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string, + unsigned int length, int force_ellipses, + const struct value_print_options *options) { fprintf_filtered (stream, "\"%s\"", string); } int -is_scmvalue_type (type) - struct type *type; +is_scmvalue_type (struct type *type) { - if (TYPE_CODE (type) == TYPE_CODE_INT - && TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0) + if (TYPE_NAME (type) && strcmp (TYPE_NAME (type), "SCM") == 0) { return 1; } @@ -79,11 +70,9 @@ is_scmvalue_type (type) of the 0'th one. */ LONGEST -scm_get_field (svalue, index) - LONGEST svalue; - int index; +scm_get_field (LONGEST svalue, int index) { - char buffer[20]; + 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)); @@ -94,10 +83,7 @@ scm_get_field (svalue, index) or Boolean (CONTEXT == TYPE_CODE_BOOL). */ LONGEST -scm_unpack (type, valaddr, context) - struct type *type; - char *valaddr; - enum type_code context; +scm_unpack (struct type *type, const gdb_byte *valaddr, enum type_code context) { if (is_scmvalue_type (type)) { @@ -130,7 +116,7 @@ scm_unpack (type, valaddr, context) return 1; } } - error ("Value can't be converted to integer."); + error (_("Value can't be converted to integer.")); default: return svalue; } @@ -142,11 +128,13 @@ scm_unpack (type, valaddr, context) /* True if we're correctly in Guile's eval.c (the evaluator and apply). */ static int -in_eval_c () +in_eval_c (void) { - if (current_source_symtab && current_source_symtab->filename) + struct symtab_and_line cursal = get_current_source_symtab_and_line (); + + if (cursal.symtab && cursal.symtab->filename) { - char *filename = current_source_symtab->filename; + char *filename = cursal.symtab->filename; int len = strlen (filename); if (len >= 6 && strcmp (filename + len - 6, "eval.c") == 0) return 1; @@ -158,63 +146,61 @@ in_eval_c () First lookup in Scheme context (using the scm_lookup_cstr inferior function), then try lookup_symbol for compiled variables. */ -static value_ptr -scm_lookup_name (str) - char *str; +static struct value * +scm_lookup_name (char *str) { - value_ptr args[3]; + struct objfile *objf; + struct gdbarch *gdbarch; + struct value *args[3]; int len = strlen (str); - value_ptr func, val; + struct value *func; + struct value *val; struct symbol *sym; + + func = find_function_in_inferior ("scm_lookup_cstr", &objf); + gdbarch = get_objfile_arch (objf); + args[0] = value_allocate_space_in_inferior (len); - args[1] = value_from_longest (builtin_type_int, len); - write_memory (value_as_long (args[0]), str, len); + args[1] = value_from_longest (builtin_type (gdbarch)->builtin_int, len); + write_memory (value_as_long (args[0]), (gdb_byte *) str, len); if (in_eval_c () && (sym = lookup_symbol ("env", expression_context_block, - VAR_NAMESPACE, (int *) NULL, - (struct symtab **) NULL)) != NULL) + VAR_DOMAIN, (int *) NULL)) != NULL) 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); - func = find_function_in_inferior ("scm_lookup_cstr"); val = call_function_by_hand (func, 3, args); if (!value_logical_not (val)) return value_ind (val); sym = lookup_symbol (str, expression_context_block, - VAR_NAMESPACE, (int *) NULL, - (struct symtab **) NULL); + VAR_DOMAIN, (int *) NULL); if (sym) return value_of_variable (sym, NULL); - error ("No symbol \"%s\" in current context."); + error (_("No symbol \"%s\" in current context."), str); } -value_ptr -scm_evaluate_string (str, len) - char *str; - int len; +struct value * +scm_evaluate_string (char *str, int len) { - value_ptr func; - value_ptr addr = value_allocate_space_in_inferior (len + 1); + struct value *func; + struct value *addr = value_allocate_space_in_inferior (len + 1); LONGEST iaddr = value_as_long (addr); - write_memory (iaddr, str, len); + write_memory (iaddr, (gdb_byte *) str, len); /* FIXME - should find and pass env */ - write_memory (iaddr + len, "", 1); - func = find_function_in_inferior ("scm_evstr"); + write_memory (iaddr + len, (gdb_byte *) "", 1); + func = find_function_in_inferior ("scm_evstr", NULL); return call_function_by_hand (func, 1, &addr); } -static value_ptr -evaluate_subexp_scm (expect_type, exp, pos, noside) - struct type *expect_type; - register struct expression *exp; - register int *pos; - enum noside noside; +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; @@ -229,7 +215,7 @@ evaluate_subexp_scm (expect_type, exp, pos, noside) goto nosideret; str = &exp->elts[pc + 2].string; return scm_lookup_name (str); - case OP_EXPRSTRING: + case OP_STRING: pc = (*pos)++; len = longest_to_int (exp->elts[pc + 1].longconst); (*pos) += 3 + BYTES_TO_EXP_ELEM (len + 1); @@ -241,42 +227,62 @@ evaluate_subexp_scm (expect_type, exp, pos, noside) } return evaluate_subexp_standard (expect_type, exp, pos, noside); nosideret: - return value_from_longest (builtin_type_long, (LONGEST) 1); + return value_from_longest (builtin_type_int8, (LONGEST) 1); } +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, - c_builtin_types, range_check_off, type_check_off, + case_sensitive_off, + array_row_major, + macro_expansion_no, + &exp_descriptor_scm, scm_parse, c_error, - evaluate_subexp_scm, + null_post_parser, scm_printchar, /* Print a character constant */ scm_printstr, /* Function to print string constant */ NULL, /* Function to print a single character */ - NULL, /* Create fundamental type in this language */ c_print_type, /* Print a type using appropriate syntax */ + default_print_typedef, /* Print a typedef using appropriate syntax */ scm_val_print, /* Print a value using appropriate syntax */ scm_value_print, /* Print a top-level value */ - {"", "", "", ""}, /* Binary format info */ - {"#o%lo", "#o", "o", ""}, /* Octal format info */ - {"%ld", "", "d", ""}, /* Decimal format info */ - {"#x%lX", "#X", "X", ""}, /* Hex format info */ + NULL, /* Language specific skip_trampoline */ + NULL, /* name_of_this */ + 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 */ - &builtin_type_char, /* Type of string elements */ + default_word_break_characters, + default_make_symbol_completion_list, + c_language_arch_info, + default_print_array_index, + default_pass_by_reference, + default_get_string, LANG_MAGIC }; void -_initialize_scheme_language () +_initialize_scheme_language (void) { add_language (&scm_language_defn); - builtin_type_scm = init_type (TYPE_CODE_INT, - TARGET_LONG_BIT / TARGET_CHAR_BIT, - 0, "SCM", (struct objfile *) NULL); + builtin_type_scm = + init_type (TYPE_CODE_INT, + gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, + 0, "SCM", (struct objfile *) NULL); }