gdb/m2-lang.c - gdb

Global variables defined

Data types defined

Functions defined

Source code

  1. /* Modula 2 language support routines for GDB, the GNU debugger.

  3.    Copyright (C) 1992-2015 Free Software Foundation, Inc.

  5.    This file is part of GDB.

  7.    This program is free software; you can redistribute it and/or modify
  8.    it under the terms of the GNU General Public License as published by
  9.    the Free Software Foundation; either version 3 of the License, or
  10.    (at your option) any later version.

  12.    This program is distributed in the hope that it will be useful,
  13.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.    GNU General Public License for more details.

  17.    You should have received a copy of the GNU General Public License
  18.    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */

  20. #include "defs.h"
  21. #include "symtab.h"
  22. #include "gdbtypes.h"
  23. #include "expression.h"
  24. #include "parser-defs.h"
  25. #include "language.h"
  26. #include "varobj.h"
  27. #include "m2-lang.h"
  28. #include "c-lang.h"
  29. #include "valprint.h"

  31. extern void _initialize_m2_language (void);
  32. static void m2_printchar (int, struct type *, struct ui_file *);
  33. static void m2_emit_char (int, struct type *, struct ui_file *, int);

  35. /* Print the character C on STREAM as part of the contents of a literal
  36.    string whose delimiter is QUOTER.  Note that that format for printing
  37.    characters and strings is language specific.
  38.    FIXME:  This is a copy of the same function from c-exp.y.  It should
  39.    be replaced with a true Modula version.  */

  41. static void
  42. ‌m2_emit_char (int c, struct type *type, struct ui_file *stream, int quoter)
  43. {

  45.   c &= 0xFF;                        /* Avoid sign bit follies.  */

  47.   if (PRINT_LITERAL_FORM (c))
  48.     {
  49.       if (c == '\\' || c == quoter)
  50.         {
  51.           fputs_filtered ("\\", stream);
  52.         }
  53.       fprintf_filtered (stream, "%c", c);
  54.     }
  55.   else
  56.     {
  57.       switch (c)
  58.         {
  59.         case '\n':
  60.           fputs_filtered ("\\n", stream);
  61.           break;
  62.         case '\b':
  63.           fputs_filtered ("\\b", stream);
  64.           break;
  65.         case '\t':
  66.           fputs_filtered ("\\t", stream);
  67.           break;
  68.         case '\f':
  69.           fputs_filtered ("\\f", stream);
  70.           break;
  71.         case '\r':
  72.           fputs_filtered ("\\r", stream);
  73.           break;
  74.         case '\033':
  75.           fputs_filtered ("\\e", stream);
  76.           break;
  77.         case '\007':
  78.           fputs_filtered ("\\a", stream);
  79.           break;
  80.         default:
  81.           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  82.           break;
  83.         }
  84.     }
  85. }

  87. /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  88.    be replaced with a true Modula version.  */

  90. static void
  91. ‌m2_printchar (int c, struct type *type, struct ui_file *stream)
  92. {
  93.   fputs_filtered ("'", stream);
  94.   LA_EMIT_CHAR (c, type, stream, '\'');
  95.   fputs_filtered ("'", stream);
  96. }

  98. /* Print the character string STRING, printing at most LENGTH characters.
  99.    Printing stops early if the number hits print_max; repeat counts
  100.    are printed as appropriate.  Print ellipses at the end if we
  101.    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
  102.    FIXME:  This is a copy of the same function from c-exp.y.  It should
  103.    be replaced with a true Modula version.  */

  105. static void
  106. ‌m2_printstr (struct ui_file *stream, struct type *type, const gdb_byte *string,
  107.              unsigned int length, const char *encoding, int force_ellipses,
  108.              const struct value_print_options *options)
  109. {
  110.   unsigned int i;
  111.   unsigned int things_printed = 0;
  112.   int in_quotes = 0;
  113.   int need_comma = 0;

  115.   if (length == 0)
  116.     {
  117.       fputs_filtered ("\"\"", gdb_stdout);
  118.       return;
  119.     }

  121.   for (i = 0; i < length && things_printed < options->print_max; ++i)
  122.     {
  123.       /* Position of the character we are examining
  124.          to see whether it is repeated.  */
  125.       unsigned int rep1;
  126.       /* Number of repetitions we have detected so far.  */
  127.       unsigned int reps;

  129.       QUIT;

  131.       if (need_comma)
  132.         {
  133.           fputs_filtered (", ", stream);
  134.           need_comma = 0;
  135.         }

  137.       rep1 = i + 1;
  138.       reps = 1;
  139.       while (rep1 < length && string[rep1] == string[i])
  140.         {
  141.           ++rep1;
  142.           ++reps;
  143.         }

  145.       if (reps > options->repeat_count_threshold)
  146.         {
  147.           if (in_quotes)
  148.             {
  149.               fputs_filtered ("\", ", stream);
  150.               in_quotes = 0;
  151.             }
  152.           m2_printchar (string[i], type, stream);
  153.           fprintf_filtered (stream, " <repeats %u times>", reps);
  154.           i = rep1 - 1;
  155.           things_printed += options->repeat_count_threshold;
  156.           need_comma = 1;
  157.         }
  158.       else
  159.         {
  160.           if (!in_quotes)
  161.             {
  162.               fputs_filtered ("\"", stream);
  163.               in_quotes = 1;
  164.             }
  165.           LA_EMIT_CHAR (string[i], type, stream, '"');
  166.           ++things_printed;
  167.         }
  168.     }

  170.   /* Terminate the quotes if necessary.  */
  171.   if (in_quotes)
  172.     fputs_filtered ("\"", stream);

  174.   if (force_ellipses || i < length)
  175.     fputs_filtered ("...", stream);
  176. }

  178. static struct value *
  179. ‌evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
  180.                          int *pos, enum noside noside)
  181. {
  182.   enum exp_opcode op = exp->elts[*pos].opcode;
  183.   struct value *arg1;
  184.   struct value *arg2;
  185.   struct type *type;

  187.   switch (op)
  188.     {
  189.     case UNOP_HIGH:
  190.       (*pos)++;
  191.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);

  193.       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
  194.         return arg1;
  195.       else
  196.         {
  197.           arg1 = coerce_ref (arg1);
  198.           type = check_typedef (value_type (arg1));

  200.           if (m2_is_unbounded_array (type))
  201.             {
  202.               struct value *temp = arg1;

  204.               type = TYPE_FIELD_TYPE (type, 1);
  205.               /* i18n: Do not translate the "_m2_high" part!  */
  206.               arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
  207.                                        _("unbounded structure "
  208.                                          "missing _m2_high field"));

  210.               if (value_type (arg1) != type)
  211.                 arg1 = value_cast (type, arg1);
  212.             }
  213.         }
  214.       return arg1;

  216.     case BINOP_SUBSCRIPT:
  217.       (*pos)++;
  218.       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
  219.       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
  220.       if (noside == EVAL_SKIP)
  221.         goto nosideret;
  222.       /* If the user attempts to subscript something that is not an
  223.          array or pointer type (like a plain int variable for example),
  224.          then report this as an error.  */

  226.       arg1 = coerce_ref (arg1);
  227.       type = check_typedef (value_type (arg1));

  229.       if (m2_is_unbounded_array (type))
  230.         {
  231.           struct value *temp = arg1;
  232.           type = TYPE_FIELD_TYPE (type, 0);
  233.           if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR))
  234.             {
  235.               warning (_("internal error: unbounded "
  236.                          "array structure is unknown"));
  237.               return evaluate_subexp_standard (expect_type, exp, pos, noside);
  238.             }
  239.           /* i18n: Do not translate the "_m2_contents" part!  */
  240.           arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
  241.                                    _("unbounded structure "
  242.                                      "missing _m2_contents field"));

  244.           if (value_type (arg1) != type)
  245.             arg1 = value_cast (type, arg1);

  247.           check_typedef (value_type (arg1));
  248.           return value_ind (value_ptradd (arg1, value_as_long (arg2)));
  249.         }
  250.       else
  251.         if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
  252.           {
  253.             if (TYPE_NAME (type))
  254.               error (_("cannot subscript something of type `%s'"),
  255.                      TYPE_NAME (type));
  256.             else
  257.               error (_("cannot subscript requested type"));
  258.           }

  260.       if (noside == EVAL_AVOID_SIDE_EFFECTS)
  261.         return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
  262.       else
  263.         return value_subscript (arg1, value_as_long (arg2));

  265.     default:
  266.       return evaluate_subexp_standard (expect_type, exp, pos, noside);
  267.     }

  269. nosideret:
  270.   return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, 1);
  271. }


  274. /* Table of operators and their precedences for printing expressions.  */

  276. ‌static const struct op_print m2_op_print_tab[] =
  277. {
  278.   {"+", BINOP_ADD, PREC_ADD, 0},
  279.   {"+", UNOP_PLUS, PREC_PREFIX, 0},
  280.   {"-", BINOP_SUB, PREC_ADD, 0},
  281.   {"-", UNOP_NEG, PREC_PREFIX, 0},
  282.   {"*", BINOP_MUL, PREC_MUL, 0},
  283.   {"/", BINOP_DIV, PREC_MUL, 0},
  284.   {"DIV", BINOP_INTDIV, PREC_MUL, 0},
  285.   {"MOD", BINOP_REM, PREC_MUL, 0},
  286.   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
  287.   {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
  288.   {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
  289.   {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
  290.   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
  291.   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
  292.   {"<=", BINOP_LEQ, PREC_ORDER, 0},
  293.   {">=", BINOP_GEQ, PREC_ORDER, 0},
  294.   {">", BINOP_GTR, PREC_ORDER, 0},
  295.   {"<", BINOP_LESS, PREC_ORDER, 0},
  296.   {"^", UNOP_IND, PREC_PREFIX, 0},
  297.   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
  298.   {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
  299.   {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
  300.   {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
  301.   {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
  302.   {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
  303.   {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
  304.   {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
  305.   {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
  306.   {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
  307.   {NULL, 0, 0, 0}
  308. };

  310. /* The built-in types of Modula-2.  */

  312. ‌enum m2_primitive_types {
  313.   m2_primitive_type_char,
  314.   m2_primitive_type_int,
  315.   m2_primitive_type_card,
  316.   m2_primitive_type_real,
  317.   m2_primitive_type_bool,
  318.   nr_m2_primitive_types
  319. };

  321. static void
  322. ‌m2_language_arch_info (struct gdbarch *gdbarch,
  323.                        struct language_arch_info *lai)
  324. {
  325.   const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);

  327.   lai->string_char_type = builtin->builtin_char;
  328.   lai->primitive_type_vector
  329.     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
  330.                               struct type *);

  332.   lai->primitive_type_vector [m2_primitive_type_char]
  333.     = builtin->builtin_char;
  334.   lai->primitive_type_vector [m2_primitive_type_int]
  335.     = builtin->builtin_int;
  336.   lai->primitive_type_vector [m2_primitive_type_card]
  337.     = builtin->builtin_card;
  338.   lai->primitive_type_vector [m2_primitive_type_real]
  339.     = builtin->builtin_real;
  340.   lai->primitive_type_vector [m2_primitive_type_bool]
  341.     = builtin->builtin_bool;

  343.   lai->bool_type_symbol = "BOOLEAN";
  344.   lai->bool_type_default = builtin->builtin_bool;
  345. }

  347. ‌const struct exp_descriptor exp_descriptor_modula2 =
  348. {
  349.   print_subexp_standard,
  350.   operator_length_standard,
  351.   operator_check_standard,
  352.   op_name_standard,
  353.   dump_subexp_body_standard,
  354.   evaluate_subexp_modula2
  355. };

  357. ‌const struct language_defn m2_language_defn =
  358. {
  359.   "modula-2",
  360.   "Modula-2",
  361.   language_m2,
  362.   range_check_on,
  363.   case_sensitive_on,
  364.   array_row_major,
  365.   macro_expansion_no,
  366.   &exp_descriptor_modula2,
  367.   m2_parse,                        /* parser */
  368.   m2_error,                        /* parser error function */
  369.   null_post_parser,
  370.   m2_printchar,                        /* Print character constant */
  371.   m2_printstr,                        /* function to print string constant */
  372.   m2_emit_char,                        /* Function to print a single character */
  373.   m2_print_type,                /* Print a type using appropriate syntax */
  374.   m2_print_typedef,                /* Print a typedef using appropriate syntax */
  375.   m2_val_print,                        /* Print a value using appropriate syntax */
  376.   c_value_print,                /* Print a top-level value */
  377.   default_read_var_value,        /* la_read_var_value */
  378.   NULL,                                /* Language specific skip_trampoline */
  379.   NULL,                                /* name_of_this */
  380.   basic_lookup_symbol_nonlocal,        /* lookup_symbol_nonlocal */
  381.   basic_lookup_transparent_type,/* lookup_transparent_type */
  382.   NULL,                                /* Language specific symbol demangler */
  383.   NULL,                                /* Language specific
  384.                                    class_name_from_physname */
  385.   m2_op_print_tab,                /* expression operators for printing */
  386.   0,                                /* arrays are first-class (not c-style) */
  387.   0,                                /* String lower bound */
  388.   default_word_break_characters,
  389.   default_make_symbol_completion_list,
  390.   m2_language_arch_info,
  391.   default_print_array_index,
  392.   default_pass_by_reference,
  393.   default_get_string,
  394.   NULL,                                /* la_get_symbol_name_cmp */
  395.   iterate_over_symbols,
  396.   &default_varobj_ops,
  397.   NULL,
  398.   NULL,
  399.   LANG_MAGIC
  400. };

  402. static void *
  403. ‌build_m2_types (struct gdbarch *gdbarch)
  404. {
  405.   struct builtin_m2_type *builtin_m2_type
  406.     = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);

  408.   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
  409.   builtin_m2_type->builtin_int
  410.     = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, "INTEGER");
  411.   builtin_m2_type->builtin_card
  412.     = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "CARDINAL");
  413.   builtin_m2_type->builtin_real
  414.     = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), "REAL", NULL);
  415.   builtin_m2_type->builtin_char
  416.     = arch_character_type (gdbarch, TARGET_CHAR_BIT, 1, "CHAR");
  417.   builtin_m2_type->builtin_bool
  418.     = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, "BOOLEAN");

  420.   return builtin_m2_type;
  421. }

  423. ‌static struct gdbarch_data *m2_type_data;

  425. const struct builtin_m2_type *
  426. ‌builtin_m2_type (struct gdbarch *gdbarch)
  427. {
  428.   return gdbarch_data (gdbarch, m2_type_data);
  429. }


  432. /* Initialization for Modula-2 */

  434. void
  435. ‌_initialize_m2_language (void)
  436. {
  437.   m2_type_data = gdbarch_data_register_post_init (build_m2_types);

  439.   add_language (&m2_language_defn);
  440. }