X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Fp-lang.c;h=cd4285d2a06dc575f7f51e056c8b7efd51ef9312;hb=c14c28ba117dee9fd0bf17fc3437e808221a7829;hp=115bfe106fa2843f0c38d39b0615e27bf0b8e87a;hpb=f290d38e06f4f311d4fe339e50afa3fd57fc1b4b;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/p-lang.c b/gdb/p-lang.c index 115bfe106f..cd4285d2a0 100644 --- a/gdb/p-lang.c +++ b/gdb/p-lang.c @@ -1,11 +1,13 @@ /* Pascal language support routines for GDB, the GNU debugger. - Copyright 2000, 2002, 2003, 2004 Free Software Foundation, Inc. + + Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007, 2008 + 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,8 +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 . */ /* This file is derived from c-lang.c */ @@ -34,6 +35,56 @@ extern void _initialize_pascal_language (void); +/* All GPC versions until now (2007-09-27) also define a symbol called + '_p_initialize'. Check for the presence of this symbol first. */ +static const char GPC_P_INITIALIZE[] = "_p_initialize"; + +/* The name of the symbol that GPC uses as the name of the main + procedure (since version 20050212). */ +static const char GPC_MAIN_PROGRAM_NAME_1[] = "_p__M0_main_program"; + +/* Older versions of GPC (versions older than 20050212) were using + a different name for the main procedure. */ +static const char GPC_MAIN_PROGRAM_NAME_2[] = "pascal_main_program"; + +/* Function returning the special symbol name used + by GPC for the main procedure in the main program + if it is found in minimal symbol list. + This function tries to find minimal symbols generated by GPC + so that it finds the even if the program was compiled + without debugging information. + According to information supplied by Waldeck Hebisch, + this should work for all versions posterior to June 2000. */ + +const char * +pascal_main_name (void) +{ + struct minimal_symbol *msym; + + msym = lookup_minimal_symbol (GPC_P_INITIALIZE, NULL, NULL); + + /* If '_p_initialize' was not found, the main program is likely not + written in Pascal. */ + if (msym == NULL) + return NULL; + + msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_1, NULL, NULL); + if (msym != NULL) + { + return GPC_MAIN_PROGRAM_NAME_1; + } + + msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_2, NULL, NULL); + if (msym != NULL) + { + return GPC_MAIN_PROGRAM_NAME_2; + } + + /* No known entry procedure found, the main program is probably + not compiled with GPC. */ + return NULL; +} + /* Determines if type TYPE is a pascal string type. Returns 1 if the type is a known pascal type This function is used by p-valprint.c code to allow better string display. @@ -155,8 +206,9 @@ pascal_printchar (int c, struct ui_file *stream) had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */ void -pascal_printstr (struct ui_file *stream, char *string, unsigned int length, - int width, int force_ellipses) +pascal_printstr (struct ui_file *stream, const gdb_byte *string, + unsigned int length, int width, int force_ellipses, + const struct value_print_options *options) { unsigned int i; unsigned int things_printed = 0; @@ -175,7 +227,7 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, return; } - for (i = 0; i < length && things_printed < print_max; ++i) + for (i = 0; i < length && things_printed < options->print_max; ++i) { /* Position of the character we are examining to see whether it is repeated. */ @@ -199,11 +251,11 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, ++reps; } - if (reps > repeat_count_threshold) + if (reps > options->repeat_count_threshold) { if (in_quotes) { - if (inspect_it) + if (options->inspect_it) fputs_filtered ("\\', ", stream); else fputs_filtered ("', ", stream); @@ -212,7 +264,7 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, pascal_printchar (string[i], stream); fprintf_filtered (stream, " ", reps); i = rep1 - 1; - things_printed += repeat_count_threshold; + things_printed += options->repeat_count_threshold; need_comma = 1; } else @@ -220,7 +272,7 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, int c = string[i]; if ((!in_quotes) && (PRINT_LITERAL_FORM (c))) { - if (inspect_it) + if (options->inspect_it) fputs_filtered ("\\'", stream); else fputs_filtered ("'", stream); @@ -234,7 +286,7 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, /* Terminate the quotes if necessary. */ if (in_quotes) { - if (inspect_it) + if (options->inspect_it) fputs_filtered ("\\'", stream); else fputs_filtered ("'", stream); @@ -243,149 +295,6 @@ pascal_printstr (struct ui_file *stream, char *string, unsigned int length, if (force_ellipses || i < length) fputs_filtered ("...", stream); } - -/* Create a fundamental Pascal type using default reasonable for the current - target machine. - - Some object/debugging file formats (DWARF version 1, COFF, etc) do not - define fundamental types such as "int" or "double". Others (stabs or - DWARF version 2, etc) do define fundamental types. For the formats which - don't provide fundamental types, gdb can create such types using this - function. - - FIXME: Some compilers distinguish explicitly signed integral types - (signed short, signed int, signed long) from "regular" integral types - (short, int, long) in the debugging information. There is some dis- - agreement as to how useful this feature is. In particular, gcc does - not support this. Also, only some debugging formats allow the - distinction to be passed on to a debugger. For now, we always just - use "short", "int", or "long" as the type name, for both the implicit - and explicitly signed types. This also makes life easier for the - gdb test suite since we don't have to account for the differences - in output depending upon what the compiler and debugging format - support. We will probably have to re-examine the issue when gdb - starts taking it's fundamental type information directly from the - debugging information supplied by the compiler. fnf@cygnus.com */ - -/* Note there might be some discussion about the choosen correspondance - because it mainly reflects Free Pascal Compiler setup for now PM */ - - -struct type * -pascal_create_fundamental_type (struct objfile *objfile, int typeid) -{ - struct type *type = NULL; - - switch (typeid) - { - default: - /* FIXME: For now, if we are asked to produce a type not in this - language, create the equivalent of a C integer type with the - name "". When all the dust settles from the type - reconstruction work, this should probably become an error. */ - type = init_type (TYPE_CODE_INT, - TARGET_INT_BIT / TARGET_CHAR_BIT, - 0, "", objfile); - warning ("internal error: no Pascal fundamental type %d", typeid); - break; - case FT_VOID: - type = init_type (TYPE_CODE_VOID, - TARGET_CHAR_BIT / TARGET_CHAR_BIT, - 0, "void", objfile); - break; - case FT_CHAR: - type = init_type (TYPE_CODE_CHAR, - TARGET_CHAR_BIT / TARGET_CHAR_BIT, - 0, "char", objfile); - break; - case FT_SIGNED_CHAR: - type = init_type (TYPE_CODE_INT, - TARGET_CHAR_BIT / TARGET_CHAR_BIT, - 0, "shortint", objfile); - break; - case FT_UNSIGNED_CHAR: - type = init_type (TYPE_CODE_INT, - TARGET_CHAR_BIT / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "byte", objfile); - break; - case FT_SHORT: - type = init_type (TYPE_CODE_INT, - TARGET_SHORT_BIT / TARGET_CHAR_BIT, - 0, "integer", objfile); - break; - case FT_SIGNED_SHORT: - type = init_type (TYPE_CODE_INT, - TARGET_SHORT_BIT / TARGET_CHAR_BIT, - 0, "integer", objfile); /* FIXME-fnf */ - break; - case FT_UNSIGNED_SHORT: - type = init_type (TYPE_CODE_INT, - TARGET_SHORT_BIT / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "word", objfile); - break; - case FT_INTEGER: - type = init_type (TYPE_CODE_INT, - TARGET_INT_BIT / TARGET_CHAR_BIT, - 0, "longint", objfile); - break; - case FT_SIGNED_INTEGER: - type = init_type (TYPE_CODE_INT, - TARGET_INT_BIT / TARGET_CHAR_BIT, - 0, "longint", objfile); /* FIXME -fnf */ - break; - case FT_UNSIGNED_INTEGER: - type = init_type (TYPE_CODE_INT, - TARGET_INT_BIT / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "cardinal", objfile); - break; - case FT_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_BIT / TARGET_CHAR_BIT, - 0, "long", objfile); - break; - case FT_SIGNED_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_BIT / TARGET_CHAR_BIT, - 0, "long", objfile); /* FIXME -fnf */ - break; - case FT_UNSIGNED_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_BIT / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "unsigned long", objfile); - break; - case FT_LONG_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, - 0, "long long", objfile); - break; - case FT_SIGNED_LONG_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, - 0, "signed long long", objfile); - break; - case FT_UNSIGNED_LONG_LONG: - type = init_type (TYPE_CODE_INT, - TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); - break; - case FT_FLOAT: - type = init_type (TYPE_CODE_FLT, - TARGET_FLOAT_BIT / TARGET_CHAR_BIT, - 0, "float", objfile); - break; - case FT_DBL_PREC_FLOAT: - type = init_type (TYPE_CODE_FLT, - TARGET_DOUBLE_BIT / TARGET_CHAR_BIT, - 0, "double", objfile); - break; - case FT_EXT_PREC_FLOAT: - type = init_type (TYPE_CODE_FLT, - TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT, - 0, "extended", objfile); - break; - } - return (type); -} /* Table mapping opcodes into strings for printing operators @@ -421,36 +330,84 @@ const struct op_print pascal_op_print_tab[] = {NULL, 0, 0, 0} }; -struct type **const (pascal_builtin_types[]) = -{ - &builtin_type_int, - &builtin_type_long, - &builtin_type_short, - &builtin_type_char, - &builtin_type_float, - &builtin_type_double, - &builtin_type_void, - &builtin_type_long_long, - &builtin_type_signed_char, - &builtin_type_unsigned_char, - &builtin_type_unsigned_short, - &builtin_type_unsigned_int, - &builtin_type_unsigned_long, - &builtin_type_unsigned_long_long, - &builtin_type_long_double, - &builtin_type_complex, - &builtin_type_double_complex, - 0 +enum pascal_primitive_types { + pascal_primitive_type_int, + pascal_primitive_type_long, + pascal_primitive_type_short, + pascal_primitive_type_char, + pascal_primitive_type_float, + pascal_primitive_type_double, + pascal_primitive_type_void, + pascal_primitive_type_long_long, + pascal_primitive_type_signed_char, + pascal_primitive_type_unsigned_char, + pascal_primitive_type_unsigned_short, + pascal_primitive_type_unsigned_int, + pascal_primitive_type_unsigned_long, + pascal_primitive_type_unsigned_long_long, + pascal_primitive_type_long_double, + pascal_primitive_type_complex, + pascal_primitive_type_double_complex, + nr_pascal_primitive_types }; +static void +pascal_language_arch_info (struct gdbarch *gdbarch, + struct language_arch_info *lai) +{ + const struct builtin_type *builtin = builtin_type (gdbarch); + lai->string_char_type = builtin->builtin_char; + lai->primitive_type_vector + = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_pascal_primitive_types + 1, + struct type *); + lai->primitive_type_vector [pascal_primitive_type_int] + = builtin->builtin_int; + lai->primitive_type_vector [pascal_primitive_type_long] + = builtin->builtin_long; + lai->primitive_type_vector [pascal_primitive_type_short] + = builtin->builtin_short; + lai->primitive_type_vector [pascal_primitive_type_char] + = builtin->builtin_char; + lai->primitive_type_vector [pascal_primitive_type_float] + = builtin->builtin_float; + lai->primitive_type_vector [pascal_primitive_type_double] + = builtin->builtin_double; + lai->primitive_type_vector [pascal_primitive_type_void] + = builtin->builtin_void; + lai->primitive_type_vector [pascal_primitive_type_long_long] + = builtin->builtin_long_long; + lai->primitive_type_vector [pascal_primitive_type_signed_char] + = builtin->builtin_signed_char; + lai->primitive_type_vector [pascal_primitive_type_unsigned_char] + = builtin->builtin_unsigned_char; + lai->primitive_type_vector [pascal_primitive_type_unsigned_short] + = builtin->builtin_unsigned_short; + lai->primitive_type_vector [pascal_primitive_type_unsigned_int] + = builtin->builtin_unsigned_int; + lai->primitive_type_vector [pascal_primitive_type_unsigned_long] + = builtin->builtin_unsigned_long; + lai->primitive_type_vector [pascal_primitive_type_unsigned_long_long] + = builtin->builtin_unsigned_long_long; + lai->primitive_type_vector [pascal_primitive_type_long_double] + = builtin->builtin_long_double; + lai->primitive_type_vector [pascal_primitive_type_complex] + = builtin->builtin_complex; + lai->primitive_type_vector [pascal_primitive_type_double_complex] + = builtin->builtin_double_complex; + + lai->bool_type_symbol = "boolean"; + lai->bool_type_default = builtin->builtin_bool; +} + const struct language_defn pascal_language_defn = { "pascal", /* Language name */ language_pascal, - pascal_builtin_types, range_check_on, type_check_on, case_sensitive_on, + array_row_major, + macro_expansion_no, &exp_descriptor_standard, pascal_parse, pascal_error, @@ -458,26 +415,24 @@ const struct language_defn pascal_language_defn = pascal_printchar, /* Print a character constant */ pascal_printstr, /* Function to print string constant */ pascal_emit_char, /* Print a single char */ - pascal_create_fundamental_type, /* Create fundamental type in this language */ pascal_print_type, /* Print a type using appropriate syntax */ + pascal_print_typedef, /* Print a typedef using appropriate syntax */ pascal_val_print, /* Print a value using appropriate syntax */ pascal_value_print, /* Print a top-level value */ NULL, /* Language specific skip_trampoline */ - value_of_this, /* value_of_this */ + "this", /* 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 */ - {"", "%", "b", ""}, /* Binary format info */ - {"0%lo", "0", "o", ""}, /* Octal format info */ - {"%ld", "", "d", ""}, /* Decimal format info */ - {"$%lx", "$", "x", ""}, /* Hex format info */ pascal_op_print_tab, /* expression operators for printing */ 1, /* c-style arrays */ 0, /* String lower bound */ - &builtin_type_char, /* Type of string elements */ default_word_break_characters, - NULL, /* FIXME: la_language_arch_info. */ + default_make_symbol_completion_list, + pascal_language_arch_info, + default_print_array_index, + default_pass_by_reference, LANG_MAGIC };