gdb/m2-lang.c

   1 /* Modula 2 language support routines for GDB, the GNU debugger.
   2
   3    Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2002, 2003, 2004,
   4    2005, 2007 Free Software Foundation, Inc.
   5
   6    This file is part of GDB.
   7
   8    This program is free software; you can redistribute it and/or modify
   9    it under the terms of the GNU General Public License as published by
  10    the Free Software Foundation; either version 3 of the License, or
  11    (at your option) any later version.
  12
  13    This program is distributed in the hope that it will be useful,
  14    but WITHOUT ANY WARRANTY; without even the implied warranty of
  15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16    GNU General Public License for more details.
  17
  18    You should have received a copy of the GNU General Public License
  19    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  20
  21 #include "defs.h"
  22 #include "symtab.h"
  23 #include "gdbtypes.h"
  24 #include "expression.h"
  25 #include "parser-defs.h"
  26 #include "language.h"
  27 #include "m2-lang.h"
  28 #include "c-lang.h"
  29 #include "valprint.h"
  30
  31 extern void _initialize_m2_language (void);
  32 static struct type *m2_create_fundamental_type (struct objfile *, int);
  33 static void m2_printchar (int, struct ui_file *);
  34 static void m2_emit_char (int, struct ui_file *, int);
  35
  36 /* Print the character C on STREAM as part of the contents of a literal
  37    string whose delimiter is QUOTER.  Note that that format for printing
  38    characters and strings is language specific.
  39    FIXME:  This is a copy of the same function from c-exp.y.  It should
  40    be replaced with a true Modula version.  */
  41
  42 static void
  43 m2_emit_char (int c, struct ui_file *stream, int quoter)
  44 {
  45
  46   c &= 0xFF;                    /* Avoid sign bit follies */
  47
  48   if (PRINT_LITERAL_FORM (c))
  49     {
  50       if (c == '\\' || c == quoter)
  51         {
  52           fputs_filtered ("\\", stream);
  53         }
  54       fprintf_filtered (stream, "%c", c);
  55     }
  56   else
  57     {
  58       switch (c)
  59         {
  60         case '\n':
  61           fputs_filtered ("\\n", stream);
  62           break;
  63         case '\b':
  64           fputs_filtered ("\\b", stream);
  65           break;
  66         case '\t':
  67           fputs_filtered ("\\t", stream);
  68           break;
  69         case '\f':
  70           fputs_filtered ("\\f", stream);
  71           break;
  72         case '\r':
  73           fputs_filtered ("\\r", stream);
  74           break;
  75         case '\033':
  76           fputs_filtered ("\\e", stream);
  77           break;
  78         case '\007':
  79           fputs_filtered ("\\a", stream);
  80           break;
  81         default:
  82           fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
  83           break;
  84         }
  85     }
  86 }
  87
  88 /* FIXME:  This is a copy of the same function from c-exp.y.  It should
  89    be replaced with a true Modula version.  */
  90
  91 static void
  92 m2_printchar (int c, struct ui_file *stream)
  93 {
  94   fputs_filtered ("'", stream);
  95   LA_EMIT_CHAR (c, stream, '\'');
  96   fputs_filtered ("'", stream);
  97 }
  98
  99 /* Print the character string STRING, printing at most LENGTH characters.
 100    Printing stops early if the number hits print_max; repeat counts
 101    are printed as appropriate.  Print ellipses at the end if we
 102    had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
 103    FIXME:  This is a copy of the same function from c-exp.y.  It should
 104    be replaced with a true Modula version.  */
 105
 106 static void
 107 m2_printstr (struct ui_file *stream, const gdb_byte *string,
 108              unsigned int length, int width, int force_ellipses)
 109 {
 110   unsigned int i;
 111   unsigned int things_printed = 0;
 112   int in_quotes = 0;
 113   int need_comma = 0;
 114
 115   if (length == 0)
 116     {
 117       fputs_filtered ("\"\"", gdb_stdout);
 118       return;
 119     }
 120
 121   for (i = 0; i < length && things_printed < 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;
 128
 129       QUIT;
 130
 131       if (need_comma)
 132         {
 133           fputs_filtered (", ", stream);
 134           need_comma = 0;
 135         }
 136
 137       rep1 = i + 1;
 138       reps = 1;
 139       while (rep1 < length && string[rep1] == string[i])
 140         {
 141           ++rep1;
 142           ++reps;
 143         }
 144
 145       if (reps > repeat_count_threshold)
 146         {
 147           if (in_quotes)
 148             {
 149               if (inspect_it)
 150                 fputs_filtered ("\\\", ", stream);
 151               else
 152                 fputs_filtered ("\", ", stream);
 153               in_quotes = 0;
 154             }
 155           m2_printchar (string[i], stream);
 156           fprintf_filtered (stream, " <repeats %u times>", reps);
 157           i = rep1 - 1;
 158           things_printed += repeat_count_threshold;
 159           need_comma = 1;
 160         }
 161       else
 162         {
 163           if (!in_quotes)
 164             {
 165               if (inspect_it)
 166                 fputs_filtered ("\\\"", stream);
 167               else
 168                 fputs_filtered ("\"", stream);
 169               in_quotes = 1;
 170             }
 171           LA_EMIT_CHAR (string[i], stream, '"');
 172           ++things_printed;
 173         }
 174     }
 175
 176   /* Terminate the quotes if necessary.  */
 177   if (in_quotes)
 178     {
 179       if (inspect_it)
 180         fputs_filtered ("\\\"", stream);
 181       else
 182         fputs_filtered ("\"", stream);
 183     }
 184
 185   if (force_ellipses || i < length)
 186     fputs_filtered ("...", stream);
 187 }
 188
 189 static struct value *
 190 evaluate_subexp_modula2 (struct type *expect_type, struct expression *exp,
 191                          int *pos, enum noside noside)
 192 {
 193   enum exp_opcode op = exp->elts[*pos].opcode;
 194   struct value *arg1;
 195   struct value *arg2;
 196   struct type *type;
 197   switch (op)
 198     {
 199     case UNOP_HIGH:
 200       (*pos)++;
 201       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 202
 203       if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
 204         return arg1;
 205       else
 206         {
 207           arg1 = coerce_ref (arg1);
 208           type = check_typedef (value_type (arg1));
 209
 210           if (m2_is_unbounded_array (type))
 211             {
 212               struct value *temp = arg1;
 213               type = TYPE_FIELD_TYPE (type, 1);
 214               /* i18n: Do not translate the "_m2_high" part!  */
 215               arg1 = value_struct_elt (&temp, NULL, "_m2_high", NULL,
 216                                        _("unbounded structure "
 217                                          "missing _m2_high field"));
 218
 219               if (value_type (arg1) != type)
 220                 arg1 = value_cast (type, arg1);
 221             }
 222         }
 223       return arg1;
 224
 225     case BINOP_SUBSCRIPT:
 226       (*pos)++;
 227       arg1 = evaluate_subexp_with_coercion (exp, pos, noside);
 228       arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
 229       if (noside == EVAL_SKIP)
 230         goto nosideret;
 231       /* If the user attempts to subscript something that is not an
 232          array or pointer type (like a plain int variable for example),
 233          then report this as an error.  */
 234
 235       arg1 = coerce_ref (arg1);
 236       type = check_typedef (value_type (arg1));
 237
 238       if (m2_is_unbounded_array (type))
 239         {
 240           struct value *temp = arg1;
 241           type = TYPE_FIELD_TYPE (type, 0);
 242           if (type == NULL || (TYPE_CODE (type) != TYPE_CODE_PTR)) {
 243             warning (_("internal error: unbounded array structure is unknown"));
 244             return evaluate_subexp_standard (expect_type, exp, pos, noside);
 245           }
 246           /* i18n: Do not translate the "_m2_contents" part!  */
 247           arg1 = value_struct_elt (&temp, NULL, "_m2_contents", NULL,
 248                                    _("unbounded structure "
 249                                      "missing _m2_contents field"));
 250
 251           if (value_type (arg1) != type)
 252             arg1 = value_cast (type, arg1);
 253
 254           type = check_typedef (value_type (arg1));
 255           return value_ind (value_add (arg1, arg2));
 256         }
 257       else
 258         if (TYPE_CODE (type) != TYPE_CODE_ARRAY)
 259           {
 260             if (TYPE_NAME (type))
 261               error (_("cannot subscript something of type `%s'"),
 262                      TYPE_NAME (type));
 263             else
 264               error (_("cannot subscript requested type"));
 265           }
 266
 267       if (noside == EVAL_AVOID_SIDE_EFFECTS)
 268         return value_zero (TYPE_TARGET_TYPE (type), VALUE_LVAL (arg1));
 269       else
 270         return value_subscript (arg1, arg2);
 271
 272     default:
 273       return evaluate_subexp_standard (expect_type, exp, pos, noside);
 274     }
 275
 276  nosideret:
 277   return value_from_longest (builtin_type_long, (LONGEST) 1);
 278 }
 279
 280 /* FIXME:  This is a copy of c_create_fundamental_type(), before
 281    all the non-C types were stripped from it.  Needs to be fixed
 282    by an experienced Modula programmer.  */
 283
 284 static struct type *
 285 m2_create_fundamental_type (struct objfile *objfile, int typeid)
 286 {
 287   struct type *type = NULL;
 288
 289   switch (typeid)
 290     {
 291     default:
 292       /* FIXME:  For now, if we are asked to produce a type not in this
 293          language, create the equivalent of a C integer type with the
 294          name "<?type?>".  When all the dust settles from the type
 295          reconstruction work, this should probably become an error.  */
 296       type = init_type (TYPE_CODE_INT,
 297                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 298                         0, "<?type?>", objfile);
 299       warning (_("internal error: no Modula fundamental type %d"), typeid);
 300       break;
 301     case FT_VOID:
 302       type = init_type (TYPE_CODE_VOID,
 303                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 304                         0, "void", objfile);
 305       break;
 306     case FT_BOOLEAN:
 307       type = init_type (TYPE_CODE_BOOL,
 308                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 309                         TYPE_FLAG_UNSIGNED, "boolean", objfile);
 310       break;
 311     case FT_STRING:
 312       type = init_type (TYPE_CODE_STRING,
 313                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 314                         0, "string", objfile);
 315       break;
 316     case FT_CHAR:
 317       type = init_type (TYPE_CODE_INT,
 318                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 319                         0, "char", objfile);
 320       break;
 321     case FT_SIGNED_CHAR:
 322       type = init_type (TYPE_CODE_INT,
 323                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 324                         0, "signed char", objfile);
 325       break;
 326     case FT_UNSIGNED_CHAR:
 327       type = init_type (TYPE_CODE_INT,
 328                         TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 329                         TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
 330       break;
 331     case FT_SHORT:
 332       type = init_type (TYPE_CODE_INT,
 333                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 334                         0, "short", objfile);
 335       break;
 336     case FT_SIGNED_SHORT:
 337       type = init_type (TYPE_CODE_INT,
 338                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 339                         0, "short", objfile);   /* FIXME-fnf */
 340       break;
 341     case FT_UNSIGNED_SHORT:
 342       type = init_type (TYPE_CODE_INT,
 343                         gdbarch_short_bit (current_gdbarch) / TARGET_CHAR_BIT,
 344                         TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
 345       break;
 346     case FT_INTEGER:
 347       type = init_type (TYPE_CODE_INT,
 348                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 349                         0, "int", objfile);
 350       break;
 351     case FT_SIGNED_INTEGER:
 352       type = init_type (TYPE_CODE_INT,
 353                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 354                         0, "int", objfile);     /* FIXME -fnf */
 355       break;
 356     case FT_UNSIGNED_INTEGER:
 357       type = init_type (TYPE_CODE_INT,
 358                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 359                         TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
 360       break;
 361     case FT_FIXED_DECIMAL:
 362       type = init_type (TYPE_CODE_INT,
 363                         gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 364                         0, "fixed decimal", objfile);
 365       break;
 366     case FT_LONG:
 367       type = init_type (TYPE_CODE_INT,
 368                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 369                         0, "long", objfile);
 370       break;
 371     case FT_SIGNED_LONG:
 372       type = init_type (TYPE_CODE_INT,
 373                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 374                         0, "long", objfile);    /* FIXME -fnf */
 375       break;
 376     case FT_UNSIGNED_LONG:
 377       type = init_type (TYPE_CODE_INT,
 378                         gdbarch_long_bit (current_gdbarch) / TARGET_CHAR_BIT,
 379                         TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
 380       break;
 381     case FT_LONG_LONG:
 382       type = init_type (TYPE_CODE_INT,
 383                         gdbarch_long_long_bit (current_gdbarch)
 384                           / TARGET_CHAR_BIT,
 385                         0, "long long", objfile);
 386       break;
 387     case FT_SIGNED_LONG_LONG:
 388       type = init_type (TYPE_CODE_INT,
 389                         gdbarch_long_long_bit (current_gdbarch)
 390                           / TARGET_CHAR_BIT,
 391                         0, "signed long long", objfile);
 392       break;
 393     case FT_UNSIGNED_LONG_LONG:
 394       type = init_type (TYPE_CODE_INT,
 395                         gdbarch_long_long_bit (current_gdbarch)
 396                           / TARGET_CHAR_BIT,
 397                         TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
 398       break;
 399     case FT_FLOAT:
 400       type = init_type (TYPE_CODE_FLT,
 401                         gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
 402                         0, "float", objfile);
 403       break;
 404     case FT_DBL_PREC_FLOAT:
 405       type = init_type (TYPE_CODE_FLT,
 406                         gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
 407                         0, "double", objfile);
 408       break;
 409     case FT_FLOAT_DECIMAL:
 410       type = init_type (TYPE_CODE_FLT,
 411                         gdbarch_double_bit (current_gdbarch) / TARGET_CHAR_BIT,
 412                         0, "floating decimal", objfile);
 413       break;
 414     case FT_EXT_PREC_FLOAT:
 415       type = init_type (TYPE_CODE_FLT,
 416                         gdbarch_long_double_bit (current_gdbarch)
 417                           / TARGET_CHAR_BIT,
 418                         0, "long double", objfile);
 419       break;
 420     case FT_COMPLEX:
 421       type = init_type (TYPE_CODE_COMPLEX,
 422                         2 * gdbarch_float_bit (current_gdbarch)
 423                           / TARGET_CHAR_BIT,
 424                         0, "complex", objfile);
 425       TYPE_TARGET_TYPE (type)
 426         = m2_create_fundamental_type (objfile, FT_FLOAT);
 427       break;
 428     case FT_DBL_PREC_COMPLEX:
 429       type = init_type (TYPE_CODE_COMPLEX,
 430                         2 * gdbarch_double_bit (current_gdbarch)
 431                           / TARGET_CHAR_BIT,
 432                         0, "double complex", objfile);
 433       TYPE_TARGET_TYPE (type)
 434         = m2_create_fundamental_type (objfile, FT_DBL_PREC_FLOAT);
 435       break;
 436     case FT_EXT_PREC_COMPLEX:
 437       type = init_type (TYPE_CODE_COMPLEX,
 438                         2 * gdbarch_long_double_bit (current_gdbarch)
 439                           / TARGET_CHAR_BIT,
 440                         0, "long double complex", objfile);
 441       TYPE_TARGET_TYPE (type)
 442         = m2_create_fundamental_type (objfile, FT_EXT_PREC_FLOAT);
 443       break;
 444     }
 445   return (type);
 446 }
 447 \f
 448
 449 /* Table of operators and their precedences for printing expressions.  */
 450
 451 static const struct op_print m2_op_print_tab[] =
 452 {
 453   {"+", BINOP_ADD, PREC_ADD, 0},
 454   {"+", UNOP_PLUS, PREC_PREFIX, 0},
 455   {"-", BINOP_SUB, PREC_ADD, 0},
 456   {"-", UNOP_NEG, PREC_PREFIX, 0},
 457   {"*", BINOP_MUL, PREC_MUL, 0},
 458   {"/", BINOP_DIV, PREC_MUL, 0},
 459   {"DIV", BINOP_INTDIV, PREC_MUL, 0},
 460   {"MOD", BINOP_REM, PREC_MUL, 0},
 461   {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
 462   {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
 463   {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
 464   {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
 465   {"=", BINOP_EQUAL, PREC_EQUAL, 0},
 466   {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
 467   {"<=", BINOP_LEQ, PREC_ORDER, 0},
 468   {">=", BINOP_GEQ, PREC_ORDER, 0},
 469   {">", BINOP_GTR, PREC_ORDER, 0},
 470   {"<", BINOP_LESS, PREC_ORDER, 0},
 471   {"^", UNOP_IND, PREC_PREFIX, 0},
 472   {"@", BINOP_REPEAT, PREC_REPEAT, 0},
 473   {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
 474   {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
 475   {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
 476   {"FLOAT", UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
 477   {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
 478   {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
 479   {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
 480   {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
 481   {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
 482   {NULL, 0, 0, 0}
 483 };
 484 \f
 485 /* The built-in types of Modula-2.  */
 486
 487 enum m2_primitive_types {
 488   m2_primitive_type_char,
 489   m2_primitive_type_int,
 490   m2_primitive_type_card,
 491   m2_primitive_type_real,
 492   m2_primitive_type_bool,
 493   nr_m2_primitive_types
 494 };
 495
 496 static void
 497 m2_language_arch_info (struct gdbarch *gdbarch,
 498                        struct language_arch_info *lai)
 499 {
 500   const struct builtin_m2_type *builtin = builtin_m2_type (gdbarch);
 501
 502   lai->string_char_type = builtin->builtin_char;
 503   lai->primitive_type_vector
 504     = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_m2_primitive_types + 1,
 505                               struct type *);
 506
 507   lai->primitive_type_vector [m2_primitive_type_char]
 508     = builtin->builtin_char;
 509   lai->primitive_type_vector [m2_primitive_type_int]
 510     = builtin->builtin_int;
 511   lai->primitive_type_vector [m2_primitive_type_card]
 512     = builtin->builtin_card;
 513   lai->primitive_type_vector [m2_primitive_type_real]
 514     = builtin->builtin_real;
 515   lai->primitive_type_vector [m2_primitive_type_bool]
 516     = builtin->builtin_bool;
 517 }
 518
 519 const struct exp_descriptor exp_descriptor_modula2 =
 520 {
 521   print_subexp_standard,
 522   operator_length_standard,
 523   op_name_standard,
 524   dump_subexp_body_standard,
 525   evaluate_subexp_modula2
 526 };
 527
 528 const struct language_defn m2_language_defn =
 529 {
 530   "modula-2",
 531   language_m2,
 532   NULL,
 533   range_check_on,
 534   type_check_on,
 535   case_sensitive_on,
 536   array_row_major,
 537   &exp_descriptor_modula2,
 538   m2_parse,                     /* parser */
 539   m2_error,                     /* parser error function */
 540   null_post_parser,
 541   m2_printchar,                 /* Print character constant */
 542   m2_printstr,                  /* function to print string constant */
 543   m2_emit_char,                 /* Function to print a single character */
 544   m2_create_fundamental_type,   /* Create fundamental type in this language */
 545   m2_print_type,                /* Print a type using appropriate syntax */
 546   m2_val_print,                 /* Print a value using appropriate syntax */
 547   c_value_print,                /* Print a top-level value */
 548   NULL,                         /* Language specific skip_trampoline */
 549   value_of_this,                /* value_of_this */
 550   basic_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
 551   basic_lookup_transparent_type,/* lookup_transparent_type */
 552   NULL,                         /* Language specific symbol demangler */
 553   NULL,                         /* Language specific class_name_from_physname */
 554   m2_op_print_tab,              /* expression operators for printing */
 555   0,                            /* arrays are first-class (not c-style) */
 556   0,                            /* String lower bound */
 557   NULL,
 558   default_word_break_characters,
 559   m2_language_arch_info,
 560   default_print_array_index,
 561   default_pass_by_reference,
 562   LANG_MAGIC
 563 };
 564
 565 static void *
 566 build_m2_types (struct gdbarch *gdbarch)
 567 {
 568   struct builtin_m2_type *builtin_m2_type
 569     = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_m2_type);
 570
 571   /* Modula-2 "pervasive" types.  NOTE:  these can be redefined!!! */
 572   builtin_m2_type->builtin_int =
 573     init_type (TYPE_CODE_INT,
 574                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 575                0, "INTEGER", (struct objfile *) NULL);
 576   builtin_m2_type->builtin_card =
 577     init_type (TYPE_CODE_INT,
 578                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 579                TYPE_FLAG_UNSIGNED,
 580                "CARDINAL", (struct objfile *) NULL);
 581   builtin_m2_type->builtin_real =
 582     init_type (TYPE_CODE_FLT,
 583                gdbarch_float_bit (current_gdbarch) / TARGET_CHAR_BIT,
 584                0,
 585                "REAL", (struct objfile *) NULL);
 586   builtin_m2_type->builtin_char =
 587     init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
 588                TYPE_FLAG_UNSIGNED,
 589                "CHAR", (struct objfile *) NULL);
 590   builtin_m2_type->builtin_bool =
 591     init_type (TYPE_CODE_BOOL,
 592                gdbarch_int_bit (current_gdbarch) / TARGET_CHAR_BIT,
 593                TYPE_FLAG_UNSIGNED,
 594                "BOOLEAN", (struct objfile *) NULL);
 595
 596   return builtin_m2_type;
 597 }
 598
 599 static struct gdbarch_data *m2_type_data;
 600
 601 const struct builtin_m2_type *
 602 builtin_m2_type (struct gdbarch *gdbarch)
 603 {
 604   return gdbarch_data (gdbarch, m2_type_data);
 605 }
 606
 607
 608 /* Initialization for Modula-2 */
 609
 610 void
 611 _initialize_m2_language (void)
 612 {
 613   m2_type_data = gdbarch_data_register_post_init (build_m2_types);
 614
 615   add_language (&m2_language_defn);
 616 }