X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Fp-lang.c;h=777f1ffe217a2c42325769983a354c86ea2cb599;hb=refs%2Fheads%2Fconcurrent-displaced-stepping-2020-04-01;hp=aa5545e42e911e6b366d67435b842b944779d196;hpb=ea06eb3dd8f0780ee5ffa63354e60533990a890a;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/p-lang.c b/gdb/p-lang.c index aa5545e42e..777f1ffe21 100644 --- a/gdb/p-lang.c +++ b/gdb/p-lang.c @@ -1,13 +1,12 @@ /* Pascal language support routines for GDB, the GNU debugger. - Copyright (C) 2000, 2002, 2003, 2004, 2005, 2007 - Free Software Foundation, Inc. + Copyright (C) 2000-2020 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, @@ -16,29 +15,77 @@ 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., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, 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" #include "parser-defs.h" #include "language.h" +#include "varobj.h" #include "p-lang.h" #include "valprint.h" #include "value.h" #include - -extern void _initialize_pascal_language (void); +#include "c-lang.h" +#include "gdbarch.h" +#include "cli/cli-style.h" + +/* 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 bound_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.minsym == NULL) + return NULL; + + msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_1, NULL, NULL); + if (msym.minsym != NULL) + { + return GPC_MAIN_PROGRAM_NAME_1; + } + msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_2, NULL, NULL); + if (msym.minsym != 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 + Returns a positive value if the type is a known pascal string type. This function is used by p-valprint.c code to allow better string display. If it is a pascal string type, then it also sets info needed to get the length and the data of the string @@ -49,16 +96,19 @@ extern void _initialize_pascal_language (void); but this does not happen for Free Pascal nor for GPC. */ int is_pascal_string_type (struct type *type,int *length_pos, - int *length_size, int *string_pos, int *char_size, - char **arrayname) + int *length_size, int *string_pos, + struct type **char_type, + const char **arrayname) { - if (TYPE_CODE (type) == TYPE_CODE_STRUCT) + if (type != NULL && type->code () == TYPE_CODE_STRUCT) { /* Old Borland type pascal strings from Free Pascal Compiler. */ /* Two fields: length and st. */ - if (TYPE_NFIELDS (type) == 2 - && strcmp (TYPE_FIELDS (type)[0].name, "length") == 0 - && strcmp (TYPE_FIELDS (type)[1].name, "st") == 0) + if (type->num_fields () == 2 + && TYPE_FIELD_NAME (type, 0) + && strcmp (TYPE_FIELD_NAME (type, 0), "length") == 0 + && TYPE_FIELD_NAME (type, 1) + && strcmp (TYPE_FIELD_NAME (type, 1), "st") == 0) { if (length_pos) *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT; @@ -66,48 +116,62 @@ is_pascal_string_type (struct type *type,int *length_pos, *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)); if (string_pos) *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; - if (char_size) - *char_size = 1; + if (char_type) + *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)); if (arrayname) - *arrayname = TYPE_FIELDS (type)[1].name; + *arrayname = TYPE_FIELD_NAME (type, 1); return 2; }; /* GNU pascal strings. */ /* Three fields: Capacity, length and schema$ or _p_schema. */ - if (TYPE_NFIELDS (type) == 3 - && strcmp (TYPE_FIELDS (type)[0].name, "Capacity") == 0 - && strcmp (TYPE_FIELDS (type)[1].name, "length") == 0) + if (type->num_fields () == 3 + && TYPE_FIELD_NAME (type, 0) + && strcmp (TYPE_FIELD_NAME (type, 0), "Capacity") == 0 + && TYPE_FIELD_NAME (type, 1) + && strcmp (TYPE_FIELD_NAME (type, 1), "length") == 0) { - if (length_pos) + if (length_pos) *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; - if (length_size) + if (length_size) *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1)); - if (string_pos) + if (string_pos) *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT; - /* FIXME: how can I detect wide chars in GPC ?? */ - if (char_size) - *char_size = 1; + /* FIXME: how can I detect wide chars in GPC ?? */ + if (char_type) + { + *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 2)); + + if ((*char_type)->code () == TYPE_CODE_ARRAY) + *char_type = TYPE_TARGET_TYPE (*char_type); + } if (arrayname) - *arrayname = TYPE_FIELDS (type)[2].name; + *arrayname = TYPE_FIELD_NAME (type, 2); return 3; }; } return 0; } +/* This is a wrapper around IS_PASCAL_STRING_TYPE that returns true if TYPE + is a string. */ + +static bool +pascal_is_string_type_p (struct type *type) +{ + return is_pascal_string_type (type, nullptr, nullptr, nullptr, + nullptr, nullptr) > 0; +} + static void pascal_one_char (int, struct ui_file *, int *); /* Print the character C on STREAM as part of the contents of a literal string. - In_quotes is reset to 0 if a char is written with #4 notation */ + In_quotes is reset to 0 if a char is written with #4 notation. */ static void pascal_one_char (int c, struct ui_file *stream, int *in_quotes) { - - c &= 0xFF; /* Avoid sign bit follies */ - - if ((c == '\'') || (PRINT_LITERAL_FORM (c))) + if (c == '\'' || ((unsigned int) c <= 0xff && (PRINT_LITERAL_FORM (c)))) { if (!(*in_quotes)) fputs_filtered ("'", stream); @@ -128,25 +192,28 @@ pascal_one_char (int c, struct ui_file *stream, int *in_quotes) } } -static void pascal_emit_char (int c, struct ui_file *stream, int quoter); +static void pascal_emit_char (int c, struct type *type, + struct ui_file *stream, int quoter); /* Print the character C on STREAM as part of the contents of a literal string whose delimiter is QUOTER. Note that that format for printing - characters and strings is language specific. */ + characters and strings is language specific. */ static void -pascal_emit_char (int c, struct ui_file *stream, int quoter) +pascal_emit_char (int c, struct type *type, struct ui_file *stream, int quoter) { int in_quotes = 0; + pascal_one_char (c, stream, &in_quotes); if (in_quotes) fputs_filtered ("'", stream); } void -pascal_printchar (int c, struct ui_file *stream) +pascal_printchar (int c, struct type *type, struct ui_file *stream) { int in_quotes = 0; + pascal_one_char (c, stream, &in_quotes); if (in_quotes) fputs_filtered ("'", stream); @@ -158,18 +225,28 @@ 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, const gdb_byte *string, - unsigned int length, int width, int force_ellipses) +pascal_printstr (struct ui_file *stream, struct type *type, + const gdb_byte *string, unsigned int length, + const char *encoding, int force_ellipses, + const struct value_print_options *options) { + enum bfd_endian byte_order = type_byte_order (type); unsigned int i; unsigned int things_printed = 0; int in_quotes = 0; int need_comma = 0; + int width; + + /* Preserve TYPE's original type, just set its LENGTH. */ + check_typedef (type); + width = TYPE_LENGTH (type); /* 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 style. */ - if ((!force_ellipses) && length > 0 && string[length - 1] == '\0') + if ((!force_ellipses) && length > 0 + && extract_unsigned_integer (string + (length - 1) * width, width, + byte_order) == 0) length--; if (length == 0) @@ -178,13 +255,14 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string, 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. */ unsigned int rep1; /* Number of repetitions we have detected so far. */ unsigned int reps; + unsigned long int current_char; QUIT; @@ -194,205 +272,53 @@ pascal_printstr (struct ui_file *stream, const gdb_byte *string, need_comma = 0; } + current_char = extract_unsigned_integer (string + i * width, width, + byte_order); + rep1 = i + 1; reps = 1; - while (rep1 < length && string[rep1] == string[i]) + while (rep1 < length + && extract_unsigned_integer (string + rep1 * width, width, + byte_order) == current_char) { ++rep1; ++reps; } - if (reps > repeat_count_threshold) + if (reps > options->repeat_count_threshold) { if (in_quotes) { - if (inspect_it) - fputs_filtered ("\\', ", stream); - else - fputs_filtered ("', ", stream); + fputs_filtered ("', ", stream); in_quotes = 0; } - pascal_printchar (string[i], stream); - fprintf_filtered (stream, " ", reps); + pascal_printchar (current_char, type, stream); + fprintf_filtered (stream, " %p[%p]", + metadata_style.style ().ptr (), + reps, nullptr); i = rep1 - 1; - things_printed += repeat_count_threshold; + things_printed += options->repeat_count_threshold; need_comma = 1; } else { - int c = string[i]; - if ((!in_quotes) && (PRINT_LITERAL_FORM (c))) + if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char))) { - if (inspect_it) - fputs_filtered ("\\'", stream); - else - fputs_filtered ("'", stream); + fputs_filtered ("'", stream); in_quotes = 1; } - pascal_one_char (c, stream, &in_quotes); + pascal_one_char (current_char, stream, &in_quotes); ++things_printed; } } /* Terminate the quotes if necessary. */ if (in_quotes) - { - if (inspect_it) - fputs_filtered ("\\'", stream); - else - fputs_filtered ("'", stream); - } + fputs_filtered ("'", stream); 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, - gdbarch_int_bit (current_gdbarch) / 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, - gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "integer", objfile); - break; - case FT_SIGNED_SHORT: - type = init_type (TYPE_CODE_INT, - gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "integer", objfile); /* FIXME-fnf */ - break; - case FT_UNSIGNED_SHORT: - type = init_type (TYPE_CODE_INT, - gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "word", objfile); - break; - case FT_INTEGER: - type = init_type (TYPE_CODE_INT, - gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "longint", objfile); - break; - case FT_SIGNED_INTEGER: - type = init_type (TYPE_CODE_INT, - gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "longint", objfile); /* FIXME -fnf */ - break; - case FT_UNSIGNED_INTEGER: - type = init_type (TYPE_CODE_INT, - gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "cardinal", objfile); - break; - case FT_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "long", objfile); - break; - case FT_SIGNED_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "long", objfile); /* FIXME -fnf */ - break; - case FT_UNSIGNED_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "unsigned long", objfile); - break; - case FT_LONG_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_long_bit - (current_gdbarch) / TARGET_CHAR_BIT, - 0, "long long", objfile); - break; - case FT_SIGNED_LONG_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_long_bit - (current_gdbarch) / TARGET_CHAR_BIT, - 0, "signed long long", objfile); - break; - case FT_UNSIGNED_LONG_LONG: - type = init_type (TYPE_CODE_INT, - gdbarch_long_long_bit - (current_gdbarch) / TARGET_CHAR_BIT, - TYPE_FLAG_UNSIGNED, "unsigned long long", objfile); - break; - case FT_FLOAT: - type = init_type (TYPE_CODE_FLT, - gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "float", objfile); - break; - case FT_DBL_PREC_FLOAT: - type = init_type (TYPE_CODE_FLT, - gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT, - 0, "double", objfile); - break; - case FT_EXT_PREC_FLOAT: - type = init_type (TYPE_CODE_FLT, - gdbarch_long_double_bit (current_gdbarch) - / TARGET_CHAR_BIT, - 0, "extended", objfile); - break; - } - return (type); -} /* Table mapping opcodes into strings for printing operators @@ -425,69 +351,141 @@ const struct op_print pascal_op_print_tab[] = {"^", UNOP_IND, PREC_SUFFIX, 1}, {"@", UNOP_ADDR, PREC_PREFIX, 0}, {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0}, - {NULL, 0, 0, 0} + {NULL, OP_NULL, PREC_PREFIX, 0} }; -struct type **const (pascal_builtin_types[]) = +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 const char *p_extensions[] = { - &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 + ".pas", ".p", ".pp", NULL }; -const struct language_defn pascal_language_defn = +/* Constant data representing the Pascal language. */ + +extern const struct language_data pascal_language_data = { "pascal", /* Language name */ + "Pascal", language_pascal, - pascal_builtin_types, range_check_on, - type_check_on, case_sensitive_on, array_row_major, + macro_expansion_no, + p_extensions, &exp_descriptor_standard, pascal_parse, - pascal_error, 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_val_print, /* Print a value using appropriate syntax */ + pascal_print_typedef, /* Print a typedef using appropriate syntax */ + pascal_value_print_inner, /* la_value_print_inner */ pascal_value_print, /* Print a top-level value */ - NULL, /* Language specific skip_trampoline */ - value_of_this, /* value_of_this */ + "this", /* name_of_this */ + false, /* la_store_sym_names_in_linkage_form_p */ 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, - NULL, /* FIXME: la_language_arch_info. */ - default_print_array_index, - LANG_MAGIC + default_collect_symbol_completion_matches, + c_watch_location_expression, + NULL, /* la_compare_symbol_for_completion */ + &default_varobj_ops, + NULL, + pascal_is_string_type_p, + "{...}" /* la_struct_too_deep_ellipsis */ }; -void -_initialize_pascal_language (void) +/* Class representing the Pascal language. */ + +class pascal_language : public language_defn { - add_language (&pascal_language_defn); -} +public: + pascal_language () + : language_defn (language_pascal, pascal_language_data) + { /* Nothing. */ } + + /* See language.h. */ + void language_arch_info (struct gdbarch *gdbarch, + struct language_arch_info *lai) const override + { + 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; + } + + /* See language.h. */ + + void print_type (struct type *type, const char *varstring, + struct ui_file *stream, int show, int level, + const struct type_print_options *flags) const override + { + pascal_print_type (type, varstring, stream, show, level, flags); + } +}; + +/* Single instance of the Pascal language class. */ + +static pascal_language pascal_language_defn;