X-Git-Url: http://git.efficios.com/?a=blobdiff_plain;f=gdb%2Fp-lang.c;h=9654da11a8c9d83f5ac70bda41b416d0a166b655;hb=e7b430724d89288f06926999811c71400e0d1531;hp=114efbcc58f130011edd43be6180d236f1299d68;hpb=a451cb65e32f48d8b3cd71806da223c6c105cf94;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/p-lang.c b/gdb/p-lang.c index 114efbcc58..9654da11a8 100644 --- a/gdb/p-lang.c +++ b/gdb/p-lang.c @@ -1,7 +1,6 @@ /* Pascal language support routines for GDB, the GNU debugger. - Copyright (C) 2000, 2002-2005, 2007-2012 Free Software Foundation, - Inc. + Copyright (C) 2000-2021 Free Software Foundation, Inc. This file is part of GDB. @@ -21,19 +20,19 @@ /* 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. */ @@ -59,23 +58,23 @@ static const char GPC_MAIN_PROGRAM_NAME_2[] = "pascal_main_program"; const char * pascal_main_name (void) { - struct minimal_symbol *msym; + 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 == NULL) + if (msym.minsym == NULL) return NULL; msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_1, NULL, NULL); - if (msym != NULL) + if (msym.minsym != NULL) { return GPC_MAIN_PROGRAM_NAME_1; } msym = lookup_minimal_symbol (GPC_MAIN_PROGRAM_NAME_2, NULL, NULL); - if (msym != NULL) + if (msym.minsym != NULL) { return GPC_MAIN_PROGRAM_NAME_2; } @@ -85,82 +84,70 @@ pascal_main_name (void) return NULL; } -/* Determines if type TYPE is a pascal string 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 - length_pos, length_size and string_pos are given in bytes. - char_size gives the element size in bytes. - FIXME: if the position or the size of these fields - are not multiple of TARGET_CHAR_BIT then the results are wrong - but this does not happen for Free Pascal nor for GPC. */ +/* See p-lang.h. */ + int -is_pascal_string_type (struct type *type,int *length_pos, - int *length_size, int *string_pos, - struct type **char_type, +pascal_is_string_type (struct type *type,int *length_pos, int *length_size, + int *string_pos, struct type **char_type, const char **arrayname) { - if (type != NULL && 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 + 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) + { + if (length_pos) *length_pos = TYPE_FIELD_BITPOS (type, 0) / TARGET_CHAR_BIT; - if (length_size) - *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 0)); - if (string_pos) + if (length_size) + *length_size = TYPE_LENGTH (type->field (0).type ()); + if (string_pos) *string_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; - if (char_type) - *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 1)); + if (char_type) + *char_type = TYPE_TARGET_TYPE (type->field (1).type ()); if (arrayname) *arrayname = TYPE_FIELD_NAME (type, 1); - return 2; - }; + return 2; + }; /* GNU pascal strings. */ /* Three fields: Capacity, length and schema$ or _p_schema. */ - if (TYPE_NFIELDS (type) == 3 + 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) *length_pos = TYPE_FIELD_BITPOS (type, 1) / TARGET_CHAR_BIT; if (length_size) - *length_size = TYPE_LENGTH (TYPE_FIELD_TYPE (type, 1)); + *length_size = TYPE_LENGTH (type->field (1).type ()); if (string_pos) *string_pos = TYPE_FIELD_BITPOS (type, 2) / TARGET_CHAR_BIT; - /* FIXME: how can I detect wide chars in GPC ?? */ - if (char_type) + /* FIXME: how can I detect wide chars in GPC ?? */ + if (char_type) { - *char_type = TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 2)); + *char_type = TYPE_TARGET_TYPE (type->field (2).type ()); - if (TYPE_CODE (*char_type) == TYPE_CODE_ARRAY) + if ((*char_type)->code () == TYPE_CODE_ARRAY) *char_type = TYPE_TARGET_TYPE (*char_type); } if (arrayname) *arrayname = TYPE_FIELD_NAME (type, 2); - return 3; - }; + return 3; + }; } return 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. */ +/* See p-lang.h. */ -static void -pascal_one_char (int c, struct ui_file *stream, int *in_quotes) +void +pascal_language::print_one_char (int c, struct ui_file *stream, + int *in_quotes) const { if (c == '\'' || ((unsigned int) c <= 0xff && (PRINT_LITERAL_FORM (c)))) { @@ -183,61 +170,115 @@ pascal_one_char (int c, struct ui_file *stream, int *in_quotes) } } -static void pascal_emit_char (int c, struct type *type, - struct ui_file *stream, int quoter); +/* See language.h. */ -/* 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. */ - -static void -pascal_emit_char (int c, struct type *type, struct ui_file *stream, int quoter) +void +pascal_language::printchar (int c, struct type *type, + struct ui_file *stream) const { int in_quotes = 0; - pascal_one_char (c, stream, &in_quotes); + print_one_char (c, stream, &in_quotes); if (in_quotes) fputs_filtered ("'", stream); } -void -pascal_printchar (int c, struct type *type, struct ui_file *stream) + + +/* Table mapping opcodes into strings for printing operators + and precedences of the operators. */ + +const struct op_print pascal_language::op_print_tab[] = { - int in_quotes = 0; + {",", BINOP_COMMA, PREC_COMMA, 0}, + {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, + {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0}, + {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0}, + {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0}, + {"=", BINOP_EQUAL, PREC_EQUAL, 0}, + {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, + {"<=", BINOP_LEQ, PREC_ORDER, 0}, + {">=", BINOP_GEQ, PREC_ORDER, 0}, + {">", BINOP_GTR, PREC_ORDER, 0}, + {"<", BINOP_LESS, PREC_ORDER, 0}, + {"shr", BINOP_RSH, PREC_SHIFT, 0}, + {"shl", BINOP_LSH, PREC_SHIFT, 0}, + {"+", BINOP_ADD, PREC_ADD, 0}, + {"-", BINOP_SUB, PREC_ADD, 0}, + {"*", BINOP_MUL, PREC_MUL, 0}, + {"/", BINOP_DIV, PREC_MUL, 0}, + {"div", BINOP_INTDIV, PREC_MUL, 0}, + {"mod", BINOP_REM, PREC_MUL, 0}, + {"@", BINOP_REPEAT, PREC_REPEAT, 0}, + {"-", UNOP_NEG, PREC_PREFIX, 0}, + {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, + {"^", UNOP_IND, PREC_SUFFIX, 1}, + {"@", UNOP_ADDR, PREC_PREFIX, 0}, + {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0}, + {NULL, OP_NULL, PREC_PREFIX, 0} +}; + - pascal_one_char (c, stream, &in_quotes); - if (in_quotes) - fputs_filtered ("'", stream); +/* See language.h. */ + +void pascal_language::language_arch_info + (struct gdbarch *gdbarch, struct language_arch_info *lai) const +{ + const struct builtin_type *builtin = builtin_type (gdbarch); + + /* Helper function to allow shorter lines below. */ + auto add = [&] (struct type * t) + { + lai->add_primitive_type (t); + }; + + add (builtin->builtin_int); + add (builtin->builtin_long); + add (builtin->builtin_short); + add (builtin->builtin_char); + add (builtin->builtin_float); + add (builtin->builtin_double); + add (builtin->builtin_void); + add (builtin->builtin_long_long); + add (builtin->builtin_signed_char); + add (builtin->builtin_unsigned_char); + add (builtin->builtin_unsigned_short); + add (builtin->builtin_unsigned_int); + add (builtin->builtin_unsigned_long); + add (builtin->builtin_unsigned_long_long); + add (builtin->builtin_long_double); + add (builtin->builtin_complex); + add (builtin->builtin_double_complex); + + lai->set_string_char_type (builtin->builtin_char); + lai->set_bool_type (builtin->builtin_bool, "boolean"); } -/* Print the character string STRING, printing at most LENGTH characters. - Printing stops early if the number hits print_max; repeat counts - are printed as appropriate. Print ellipses at the end if we - had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */ +/* See language.h. */ void -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) +pascal_language::printstr (struct ui_file *stream, struct type *elttype, + const gdb_byte *string, unsigned int length, + const char *encoding, int force_ellipses, + const struct value_print_options *options) const { - enum bfd_endian byte_order = gdbarch_byte_order (get_type_arch (type)); + enum bfd_endian byte_order = type_byte_order (elttype); 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); + /* Preserve ELTTYPE's original type, just set its LENGTH. */ + check_typedef (elttype); + width = TYPE_LENGTH (elttype); /* 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 - && extract_unsigned_integer (string + (length - 1) * width, width, - byte_order) == 0) + && extract_unsigned_integer (string + (length - 1) * width, width, + byte_order) == 0) length--; if (length == 0) @@ -249,7 +290,7 @@ pascal_printstr (struct ui_file *stream, struct type *type, for (i = 0; i < length && things_printed < options->print_max; ++i) { /* Position of the character we are examining - to see whether it is repeated. */ + to see whether it is repeated. */ unsigned int rep1; /* Number of repetitions we have detected so far. */ unsigned int reps; @@ -280,14 +321,13 @@ pascal_printstr (struct ui_file *stream, struct type *type, { if (in_quotes) { - if (options->inspect_it) - fputs_filtered ("\\', ", stream); - else - fputs_filtered ("', ", stream); + fputs_filtered ("', ", stream); in_quotes = 0; } - pascal_printchar (current_char, type, stream); - fprintf_filtered (stream, " ", reps); + printchar (current_char, elttype, stream); + fprintf_filtered (stream, " %p[%p]", + metadata_style.style ().ptr (), + reps, nullptr); i = rep1 - 1; things_printed += options->repeat_count_threshold; need_comma = 1; @@ -296,176 +336,22 @@ pascal_printstr (struct ui_file *stream, struct type *type, { if ((!in_quotes) && (PRINT_LITERAL_FORM (current_char))) { - if (options->inspect_it) - fputs_filtered ("\\'", stream); - else - fputs_filtered ("'", stream); + fputs_filtered ("'", stream); in_quotes = 1; } - pascal_one_char (current_char, stream, &in_quotes); + print_one_char (current_char, stream, &in_quotes); ++things_printed; } } /* Terminate the quotes if necessary. */ if (in_quotes) - { - if (options->inspect_it) - fputs_filtered ("\\'", stream); - else - fputs_filtered ("'", stream); - } + fputs_filtered ("'", stream); if (force_ellipses || i < length) fputs_filtered ("...", stream); } - - -/* Table mapping opcodes into strings for printing operators - and precedences of the operators. */ - -const struct op_print pascal_op_print_tab[] = -{ - {",", BINOP_COMMA, PREC_COMMA, 0}, - {":=", BINOP_ASSIGN, PREC_ASSIGN, 1}, - {"or", BINOP_BITWISE_IOR, PREC_BITWISE_IOR, 0}, - {"xor", BINOP_BITWISE_XOR, PREC_BITWISE_XOR, 0}, - {"and", BINOP_BITWISE_AND, PREC_BITWISE_AND, 0}, - {"=", BINOP_EQUAL, PREC_EQUAL, 0}, - {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0}, - {"<=", BINOP_LEQ, PREC_ORDER, 0}, - {">=", BINOP_GEQ, PREC_ORDER, 0}, - {">", BINOP_GTR, PREC_ORDER, 0}, - {"<", BINOP_LESS, PREC_ORDER, 0}, - {"shr", BINOP_RSH, PREC_SHIFT, 0}, - {"shl", BINOP_LSH, PREC_SHIFT, 0}, - {"+", BINOP_ADD, PREC_ADD, 0}, - {"-", BINOP_SUB, PREC_ADD, 0}, - {"*", BINOP_MUL, PREC_MUL, 0}, - {"/", BINOP_DIV, PREC_MUL, 0}, - {"div", BINOP_INTDIV, PREC_MUL, 0}, - {"mod", BINOP_REM, PREC_MUL, 0}, - {"@", BINOP_REPEAT, PREC_REPEAT, 0}, - {"-", UNOP_NEG, PREC_PREFIX, 0}, - {"not", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, - {"^", UNOP_IND, PREC_SUFFIX, 1}, - {"@", UNOP_ADDR, PREC_PREFIX, 0}, - {"sizeof", UNOP_SIZEOF, PREC_PREFIX, 0}, - {NULL, 0, 0, 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, - range_check_on, - case_sensitive_on, - array_row_major, - macro_expansion_no, - &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_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 */ - default_read_var_value, /* la_read_var_value */ - 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 */ - default_word_break_characters, - default_make_symbol_completion_list, - pascal_language_arch_info, - default_print_array_index, - default_pass_by_reference, - default_get_string, - NULL, /* la_get_symbol_name_cmp */ - iterate_over_symbols, - LANG_MAGIC -}; +/* Single instance of the Pascal language class. */ -void -_initialize_pascal_language (void) -{ - add_language (&pascal_language_defn); -} +static pascal_language pascal_language_defn;