X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Fp-lang.c;h=cd4285d2a06dc575f7f51e056c8b7efd51ef9312;hb=c14c28ba117dee9fd0bf17fc3437e808221a7829;hp=8e13b6e860aa03479d3ffc535594132ae4d61870;hpb=0004e5a2cf40bcf4485a7b552b5d19ed69d11eba;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/p-lang.c b/gdb/p-lang.c index 8e13b6e860..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 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,12 +16,12 @@ 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 */ #include "defs.h" +#include "gdb_string.h" #include "symtab.h" #include "gdbtypes.h" #include "expression.h" @@ -27,11 +29,62 @@ #include "language.h" #include "p-lang.h" #include "valprint.h" +#include "value.h" #include 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. @@ -97,7 +150,7 @@ static void pascal_one_char (int, struct ui_file *, int *); In_quotes is reset to 0 if a char is written with #4 notation */ static void -pascal_one_char (register int c, struct ui_file *stream, int *in_quotes) +pascal_one_char (int c, struct ui_file *stream, int *in_quotes) { c &= 0xFF; /* Avoid sign bit follies */ @@ -130,7 +183,7 @@ static void pascal_emit_char (int c, struct ui_file *stream, int quoter); characters and strings is language specific. */ static void -pascal_emit_char (register int c, struct ui_file *stream, int quoter) +pascal_emit_char (int c, struct ui_file *stream, int quoter) { int in_quotes = 0; pascal_one_char (c, stream, &in_quotes); @@ -153,14 +206,14 @@ 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) { - register unsigned int i; + unsigned int i; unsigned int things_printed = 0; int in_quotes = 0; int need_comma = 0; - extern int inspect_it; /* If the string was not truncated due to `set print elements', and the last byte of it is a null, we don't print that, in traditional C @@ -174,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. */ @@ -198,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); @@ -211,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 @@ -219,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); @@ -233,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); @@ -242,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) -{ - register 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 @@ -420,54 +330,109 @@ 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, - evaluate_subexp_standard, + null_post_parser, 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 */ - {"", "%", "b", ""}, /* Binary format info */ - {"0%lo", "0", "o", ""}, /* Octal format info */ - {"%ld", "", "d", ""}, /* Decimal format info */ - {"$%lx", "$", "x", ""}, /* Hex format info */ + NULL, /* Language specific skip_trampoline */ + "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 */ 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, + default_make_symbol_completion_list, + pascal_language_arch_info, + default_print_array_index, + default_pass_by_reference, LANG_MAGIC };