gcc/gengtype.c

   1 /* Process source files and output type information.
   2    Copyright (C) 2002 Free Software Foundation, Inc.
   3
   4 This file is part of GCC.
   5
   6 GCC is free software; you can redistribute it and/or modify it under
   7 the terms of the GNU General Public License as published by the Free
   8 Software Foundation; either version 2, or (at your option) any later
   9 version.
  10
  11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GCC; see the file COPYING.  If not, write to the Free
  18 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  19 02111-1307, USA.  */
  20
  21 #include "bconfig.h"
  22 #include "system.h"
  23 #include "coretypes.h"
  24 #include "tm.h"
  25 #include "gengtype.h"
  26 #include "gtyp-gen.h"
  27
  28 /* Nonzero iff an error has occurred.  */
  29 static int hit_error = 0;
  30
  31 static void gen_rtx_next PARAMS ((void));
  32 static void write_rtx_next PARAMS ((void));
  33 static void open_base_files PARAMS ((void));
  34 static void close_output_files PARAMS ((void));
  35
  36 /* Report an error at POS, printing MSG.  */
  37
  38 void
  39 error_at_line VPARAMS ((struct fileloc *pos, const char *msg, ...))
  40 {
  41   VA_OPEN (ap, msg);
  42   VA_FIXEDARG (ap, struct fileloc *, pos);
  43   VA_FIXEDARG (ap, const char *, msg);
  44
  45   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
  46   vfprintf (stderr, msg, ap);
  47   fputc ('\n', stderr);
  48   hit_error = 1;
  49
  50   VA_CLOSE (ap);
  51 }
  52
  53 /* vasprintf, but produces fatal message on out-of-memory.  */
  54 int
  55 xvasprintf (result, format, args)
  56      char ** result;
  57      const char *format;
  58      va_list args;
  59 {
  60   int ret = vasprintf (result, format, args);
  61   if (*result == NULL || ret < 0)
  62     {
  63       fputs ("gengtype: out of memory", stderr);
  64       xexit (1);
  65     }
  66   return ret;
  67 }
  68
  69 /* Wrapper for xvasprintf.  */
  70 char *
  71 xasprintf VPARAMS ((const char *format, ...))
  72 {
  73   char *result;
  74   VA_OPEN (ap, format);
  75   VA_FIXEDARG (ap, const char *, format);
  76   xvasprintf (&result, format, ap);
  77   VA_CLOSE (ap);
  78   return result;
  79 }
  80
  81 /* The one and only TYPE_STRING.  */
  82
  83 struct type string_type = {
  84   TYPE_STRING, NULL, NULL, GC_USED
  85   UNION_INIT_ZERO
  86 };
  87
  88 /* Lists of various things.  */
  89
  90 static pair_p typedefs;
  91 static type_p structures;
  92 static type_p param_structs;
  93 static pair_p variables;
  94
  95 static void do_scalar_typedef PARAMS ((const char *, struct fileloc *));
  96 static type_p find_param_structure
  97   PARAMS ((type_p t, type_p param[NUM_PARAM]));
  98 static type_p adjust_field_tree_exp PARAMS ((type_p t, options_p opt));
  99 static type_p adjust_field_rtx_def PARAMS ((type_p t, options_p opt));
 100
 101 /* Define S as a typedef to T at POS.  */
 102
 103 void
 104 do_typedef (s, t, pos)
 105      const char *s;
 106      type_p t;
 107      struct fileloc *pos;
 108 {
 109   pair_p p;
 110
 111   for (p = typedefs; p != NULL; p = p->next)
 112     if (strcmp (p->name, s) == 0)
 113       {
 114         if (p->type != t)
 115           {
 116             error_at_line (pos, "type `%s' previously defined", s);
 117             error_at_line (&p->line, "previously defined here");
 118           }
 119         return;
 120       }
 121
 122   p = xmalloc (sizeof (struct pair));
 123   p->next = typedefs;
 124   p->name = s;
 125   p->type = t;
 126   p->line = *pos;
 127   typedefs = p;
 128 }
 129
 130 /* Define S as a typename of a scalar.  */
 131
 132 static void
 133 do_scalar_typedef (s, pos)
 134      const char *s;
 135      struct fileloc *pos;
 136 {
 137   do_typedef (s, create_scalar_type (s, strlen (s)), pos);
 138 }
 139
 140 /* Return the type previously defined for S.  Use POS to report errors.  */
 141
 142 type_p
 143 resolve_typedef (s, pos)
 144      const char *s;
 145      struct fileloc *pos;
 146 {
 147   pair_p p;
 148   for (p = typedefs; p != NULL; p = p->next)
 149     if (strcmp (p->name, s) == 0)
 150       return p->type;
 151   error_at_line (pos, "unidentified type `%s'", s);
 152   return create_scalar_type ("char", 4);
 153 }
 154
 155 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
 156    at POS with fields FIELDS and options O.  */
 157
 158 void
 159 new_structure (name, isunion, pos, fields, o)
 160      const char *name;
 161      int isunion;
 162      struct fileloc *pos;
 163      pair_p fields;
 164      options_p o;
 165 {
 166   type_p si;
 167   type_p s = NULL;
 168   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 169
 170   for (si = structures; si != NULL; si = si->next)
 171     if (strcmp (name, si->u.s.tag) == 0
 172         && UNION_P (si) == isunion)
 173       {
 174         type_p ls = NULL;
 175         if (si->kind == TYPE_LANG_STRUCT)
 176           {
 177             ls = si;
 178
 179             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
 180               if (si->u.s.bitmap == bitmap)
 181                 s = si;
 182           }
 183         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
 184           {
 185             ls = si;
 186             si = xcalloc (1, sizeof (struct type));
 187             memcpy (si, ls, sizeof (struct type));
 188             ls->kind = TYPE_LANG_STRUCT;
 189             ls->u.s.lang_struct = si;
 190             ls->u.s.fields = NULL;
 191             si->next = NULL;
 192             si->pointer_to = NULL;
 193             si->u.s.lang_struct = ls;
 194           }
 195         else
 196           s = si;
 197
 198         if (ls != NULL && s == NULL)
 199           {
 200             s = xcalloc (1, sizeof (struct type));
 201             s->next = ls->u.s.lang_struct;
 202             ls->u.s.lang_struct = s;
 203             s->u.s.lang_struct = ls;
 204           }
 205         break;
 206       }
 207
 208   if (s == NULL)
 209     {
 210       s = xcalloc (1, sizeof (struct type));
 211       s->next = structures;
 212       structures = s;
 213     }
 214
 215   if (s->u.s.line.file != NULL
 216       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
 217     {
 218       error_at_line (pos, "duplicate structure definition");
 219       error_at_line (&s->u.s.line, "previous definition here");
 220     }
 221
 222   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 223   s->u.s.tag = name;
 224   s->u.s.line = *pos;
 225   s->u.s.fields = fields;
 226   s->u.s.opt = o;
 227   s->u.s.bitmap = bitmap;
 228   if (s->u.s.lang_struct)
 229     s->u.s.lang_struct->u.s.bitmap |= bitmap;
 230 }
 231
 232 /* Return the previously-defined structure with tag NAME (or a union
 233    iff ISUNION is nonzero), or a new empty structure or union if none
 234    was defined previously.  */
 235
 236 type_p
 237 find_structure (name, isunion)
 238      const char *name;
 239      int isunion;
 240 {
 241   type_p s;
 242
 243   for (s = structures; s != NULL; s = s->next)
 244     if (strcmp (name, s->u.s.tag) == 0
 245         && UNION_P (s) == isunion)
 246       return s;
 247
 248   s = xcalloc (1, sizeof (struct type));
 249   s->next = structures;
 250   structures = s;
 251   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 252   s->u.s.tag = name;
 253   structures = s;
 254   return s;
 255 }
 256
 257 /* Return the previously-defined parameterized structure for structure
 258    T and parameters PARAM, or a new parameterized empty structure or
 259    union if none was defined previously.  */
 260
 261 static type_p
 262 find_param_structure (t, param)
 263      type_p t;
 264      type_p param[NUM_PARAM];
 265 {
 266   type_p res;
 267
 268   for (res = param_structs; res; res = res->next)
 269     if (res->u.param_struct.stru == t
 270         && memcmp (res->u.param_struct.param, param,
 271                    sizeof (type_p) * NUM_PARAM) == 0)
 272       break;
 273   if (res == NULL)
 274     {
 275       res = xcalloc (1, sizeof (*res));
 276       res->kind = TYPE_PARAM_STRUCT;
 277       res->next = param_structs;
 278       param_structs = res;
 279       res->u.param_struct.stru = t;
 280       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
 281     }
 282   return res;
 283 }
 284
 285 /* Return a scalar type with name NAME.  */
 286
 287 type_p
 288 create_scalar_type (name, name_len)
 289      const char *name;
 290      size_t name_len;
 291 {
 292   type_p r = xcalloc (1, sizeof (struct type));
 293   r->kind = TYPE_SCALAR;
 294   r->u.sc = xmemdup (name, name_len, name_len + 1);
 295   return r;
 296 }
 297
 298 /* Return a pointer to T.  */
 299
 300 type_p
 301 create_pointer (t)
 302      type_p t;
 303 {
 304   if (! t->pointer_to)
 305     {
 306       type_p r = xcalloc (1, sizeof (struct type));
 307       r->kind = TYPE_POINTER;
 308       r->u.p = t;
 309       t->pointer_to = r;
 310     }
 311   return t->pointer_to;
 312 }
 313
 314 /* Return an array of length LEN.  */
 315
 316 type_p
 317 create_array (t, len)
 318      type_p t;
 319      const char *len;
 320 {
 321   type_p v;
 322
 323   v = xcalloc (1, sizeof (*v));
 324   v->kind = TYPE_ARRAY;
 325   v->u.a.p = t;
 326   v->u.a.len = len;
 327   return v;
 328 }
 329
 330 /* Add a variable named S of type T with options O defined at POS,
 331    to `variables'.  */
 332
 333 void
 334 note_variable (s, t, o, pos)
 335      const char *s;
 336      type_p t;
 337      options_p o;
 338      struct fileloc *pos;
 339 {
 340   pair_p n;
 341   n = xmalloc (sizeof (*n));
 342   n->name = s;
 343   n->type = t;
 344   n->line = *pos;
 345   n->opt = o;
 346   n->next = variables;
 347   variables = n;
 348 }
 349
 350 enum rtx_code {
 351 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   ENUM ,
 352 #include "rtl.def"
 353 #undef DEF_RTL_EXPR
 354     NUM_RTX_CODE
 355 };
 356
 357 /* We really don't care how long a CONST_DOUBLE is.  */
 358 #define CONST_DOUBLE_FORMAT "ww"
 359 static const char * const rtx_format[NUM_RTX_CODE] = {
 360 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
 361 #include "rtl.def"
 362 #undef DEF_RTL_EXPR
 363 };
 364
 365 static int rtx_next[NUM_RTX_CODE];
 366
 367 /* Generate the contents of the rtx_next array.  This really doesn't belong
 368    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
 369
 370 static void
 371 gen_rtx_next ()
 372 {
 373   int i;
 374   for (i = 0; i < NUM_RTX_CODE; i++)
 375     {
 376       int k;
 377
 378       rtx_next[i] = -1;
 379       if (strncmp (rtx_format[i], "iuu", 3) == 0)
 380         rtx_next[i] = 2;
 381       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
 382         rtx_next[i] = 1;
 383       else
 384         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
 385           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
 386             rtx_next[i] = k;
 387     }
 388 }
 389
 390 /* Write out the contents of the rtx_next array.  */
 391 static void
 392 write_rtx_next ()
 393 {
 394   outf_p f = get_output_file_with_visibility (NULL);
 395   int i;
 396
 397   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
 398   oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
 399   for (i = 0; i < NUM_RTX_CODE; i++)
 400     if (rtx_next[i] == -1)
 401       oprintf (f, "  0,\n");
 402     else
 403       oprintf (f,
 404                "  offsetof (struct rtx_def, fld) + %d * sizeof (rtunion),\n",
 405                rtx_next[i]);
 406   oprintf (f, "};\n");
 407 }
 408
 409 /* Handle `special("rtx_def")'.  This is a special case for field
 410    `fld' of struct rtx_def, which is an array of unions whose values
 411    are based in a complex way on the type of RTL.  */
 412
 413 static type_p
 414 adjust_field_rtx_def (t, opt)
 415      type_p t;
 416      options_p opt ATTRIBUTE_UNUSED;
 417 {
 418   pair_p flds = NULL;
 419   options_p nodot;
 420   int i;
 421   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
 422   type_p bitmap_tp, basic_block_tp;
 423
 424   static const char * const rtx_name[NUM_RTX_CODE] = {
 425 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
 426 #include "rtl.def"
 427 #undef DEF_RTL_EXPR
 428   };
 429
 430   if (t->kind != TYPE_ARRAY)
 431     {
 432       error_at_line (&lexer_line,
 433                      "special `rtx_def' must be applied to an array");
 434       return &string_type;
 435     }
 436
 437   nodot = xmalloc (sizeof (*nodot));
 438   nodot->next = NULL;
 439   nodot->name = "dot";
 440   nodot->info = "";
 441
 442   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
 443   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
 444   tree_tp = create_pointer (find_structure ("tree_node", 1));
 445   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
 446   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
 447   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
 448   scalar_tp = create_scalar_type ("rtunion scalar", 14);
 449
 450   {
 451     pair_p note_flds = NULL;
 452     int c;
 453
 454     for (c = 0; c < 3; c++)
 455       {
 456         pair_p old_note_flds = note_flds;
 457
 458         note_flds = xmalloc (sizeof (*note_flds));
 459         note_flds->line.file = __FILE__;
 460         note_flds->line.line = __LINE__;
 461         note_flds->name = "rttree";
 462         note_flds->type = tree_tp;
 463         note_flds->opt = xmalloc (sizeof (*note_flds->opt));
 464         note_flds->opt->next = nodot;
 465         note_flds->opt->name = "tag";
 466         note_flds->next = old_note_flds;
 467       }
 468
 469     note_flds->type = rtx_tp;
 470     note_flds->name = "rtx";
 471     note_flds->opt->info = "NOTE_INSN_EXPECTED_VALUE";
 472     note_flds->next->opt->info = "NOTE_INSN_BLOCK_BEG";
 473     note_flds->next->next->opt->info = "NOTE_INSN_BLOCK_END";
 474
 475     new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
 476   }
 477
 478   note_union_tp = find_structure ("rtx_def_note_subunion", 1);
 479
 480   for (i = 0; i < NUM_RTX_CODE; i++)
 481     {
 482       pair_p old_flds = flds;
 483       pair_p subfields = NULL;
 484       size_t aindex, nmindex;
 485       const char *sname;
 486       char *ftag;
 487
 488       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
 489         {
 490           pair_p old_subf = subfields;
 491           type_p t;
 492           const char *subname;
 493
 494           switch (rtx_format[i][aindex])
 495             {
 496             case '*':
 497             case 'i':
 498             case 'n':
 499             case 'w':
 500               t = scalar_tp;
 501               subname = "rtint";
 502               break;
 503
 504             case '0':
 505               if (i == MEM && aindex == 1)
 506                 t = mem_attrs_tp, subname = "rtmem";
 507               else if (i == JUMP_INSN && aindex == 9)
 508                 t = rtx_tp, subname = "rtx";
 509               else if (i == CODE_LABEL && aindex == 4)
 510                 t = scalar_tp, subname = "rtint";
 511               else if (i == CODE_LABEL && aindex == 5)
 512                 t = rtx_tp, subname = "rtx";
 513               else if (i == LABEL_REF
 514                        && (aindex == 1 || aindex == 2))
 515                 t = rtx_tp, subname = "rtx";
 516               else if (i == NOTE && aindex == 4)
 517                 t = note_union_tp, subname = "";
 518               else if (i == NOTE && aindex >= 7)
 519                 t = scalar_tp, subname = "rtint";
 520               else if (i == ADDR_DIFF_VEC && aindex == 4)
 521                 t = scalar_tp, subname = "rtint";
 522               else if (i == VALUE && aindex == 0)
 523                 t = scalar_tp, subname = "rtint";
 524               else if (i == REG && aindex == 1)
 525                 t = scalar_tp, subname = "rtint";
 526               else if (i == SCRATCH && aindex == 0)
 527                 t = scalar_tp, subname = "rtint";
 528               else if (i == BARRIER && aindex >= 3)
 529                 t = scalar_tp, subname = "rtint";
 530               else
 531                 {
 532                   error_at_line (&lexer_line,
 533                         "rtx type `%s' has `0' in position %lu, can't handle",
 534                                  rtx_name[i], (unsigned long) aindex);
 535                   t = &string_type;
 536                   subname = "rtint";
 537                 }
 538               break;
 539
 540             case 's':
 541             case 'S':
 542             case 'T':
 543               t = &string_type;
 544               subname = "rtstr";
 545               break;
 546
 547             case 'e':
 548             case 'u':
 549               t = rtx_tp;
 550               subname = "rtx";
 551               break;
 552
 553             case 'E':
 554             case 'V':
 555               t = rtvec_tp;
 556               subname = "rtvec";
 557               break;
 558
 559             case 't':
 560               t = tree_tp;
 561               subname = "rttree";
 562               break;
 563
 564             case 'b':
 565               t = bitmap_tp;
 566               subname = "rtbit";
 567               break;
 568
 569             case 'B':
 570               t = basic_block_tp;
 571               subname = "bb";
 572               break;
 573
 574             default:
 575               error_at_line (&lexer_line,
 576                      "rtx type `%s' has `%c' in position %lu, can't handle",
 577                              rtx_name[i], rtx_format[i][aindex],
 578                              (unsigned long)aindex);
 579               t = &string_type;
 580               subname = "rtint";
 581               break;
 582             }
 583
 584           subfields = xmalloc (sizeof (*subfields));
 585           subfields->next = old_subf;
 586           subfields->type = t;
 587           subfields->name = xasprintf ("[%lu].%s", (unsigned long)aindex,
 588                                        subname);
 589           subfields->line.file = __FILE__;
 590           subfields->line.line = __LINE__;
 591           if (t == note_union_tp)
 592             {
 593               subfields->opt = xmalloc (sizeof (*subfields->opt));
 594               subfields->opt->next = nodot;
 595               subfields->opt->name = "desc";
 596               subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
 597             }
 598           else if (t == basic_block_tp)
 599             {
 600               /* We don't presently GC basic block structures...  */
 601               subfields->opt = xmalloc (sizeof (*subfields->opt));
 602               subfields->opt->next = nodot;
 603               subfields->opt->name = "skip";
 604               subfields->opt->info = NULL;
 605             }
 606           else if ((size_t) rtx_next[i] == aindex)
 607             {
 608               /* The 'next' field will be marked by the chain_next option.  */
 609               subfields->opt = xmalloc (sizeof (*subfields->opt));
 610               subfields->opt->next = nodot;
 611               subfields->opt->name = "skip";
 612               subfields->opt->info = NULL;
 613             }
 614           else
 615             subfields->opt = nodot;
 616         }
 617
 618       flds = xmalloc (sizeof (*flds));
 619       flds->next = old_flds;
 620       flds->name = "";
 621       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
 622       new_structure (sname, 0, &lexer_line, subfields, NULL);
 623       flds->type = find_structure (sname, 0);
 624       flds->line.file = __FILE__;
 625       flds->line.line = __LINE__;
 626       flds->opt = xmalloc (sizeof (*flds->opt));
 627       flds->opt->next = nodot;
 628       flds->opt->name = "tag";
 629       ftag = xstrdup (rtx_name[i]);
 630       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
 631         ftag[nmindex] = TOUPPER (ftag[nmindex]);
 632       flds->opt->info = ftag;
 633     }
 634
 635   new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
 636   return find_structure ("rtx_def_subunion", 1);
 637 }
 638
 639 /* Handle `special("tree_exp")'.  This is a special case for
 640    field `operands' of struct tree_exp, which although it claims to contain
 641    pointers to trees, actually sometimes contains pointers to RTL too.
 642    Passed T, the old type of the field, and OPT its options.  Returns
 643    a new type for the field.  */
 644
 645 static type_p
 646 adjust_field_tree_exp (t, opt)
 647      type_p t;
 648      options_p opt ATTRIBUTE_UNUSED;
 649 {
 650   pair_p flds;
 651   options_p nodot;
 652   size_t i;
 653   static const struct {
 654     const char *name;
 655     int first_rtl;
 656     int num_rtl;
 657   } data[] = {
 658     { "SAVE_EXPR", 2, 1 },
 659     { "GOTO_SUBROUTINE_EXPR", 0, 2 },
 660     { "RTL_EXPR", 0, 2 },
 661     { "WITH_CLEANUP_EXPR", 2, 1 },
 662     { "METHOD_CALL_EXPR", 3, 1 }
 663   };
 664
 665   if (t->kind != TYPE_ARRAY)
 666     {
 667       error_at_line (&lexer_line,
 668                      "special `tree_exp' must be applied to an array");
 669       return &string_type;
 670     }
 671
 672   nodot = xmalloc (sizeof (*nodot));
 673   nodot->next = NULL;
 674   nodot->name = "dot";
 675   nodot->info = "";
 676
 677   flds = xmalloc (sizeof (*flds));
 678   flds->next = NULL;
 679   flds->name = "";
 680   flds->type = t;
 681   flds->line.file = __FILE__;
 682   flds->line.line = __LINE__;
 683   flds->opt = xmalloc (sizeof (*flds->opt));
 684   flds->opt->next = nodot;
 685   flds->opt->name = "length";
 686   flds->opt->info = "TREE_CODE_LENGTH (TREE_CODE ((tree) &%0))";
 687   {
 688     options_p oldopt = flds->opt;
 689     flds->opt = xmalloc (sizeof (*flds->opt));
 690     flds->opt->next = oldopt;
 691     flds->opt->name = "default";
 692     flds->opt->info = "";
 693   }
 694
 695   for (i = 0; i < ARRAY_SIZE (data); i++)
 696     {
 697       pair_p old_flds = flds;
 698       pair_p subfields = NULL;
 699       int r_index;
 700       const char *sname;
 701
 702       for (r_index = 0;
 703            r_index < data[i].first_rtl + data[i].num_rtl;
 704            r_index++)
 705         {
 706           pair_p old_subf = subfields;
 707           subfields = xmalloc (sizeof (*subfields));
 708           subfields->next = old_subf;
 709           subfields->name = xasprintf ("[%d]", r_index);
 710           if (r_index < data[i].first_rtl)
 711             subfields->type = t->u.a.p;
 712           else
 713             subfields->type = create_pointer (find_structure ("rtx_def", 0));
 714           subfields->line.file = __FILE__;
 715           subfields->line.line = __LINE__;
 716           subfields->opt = nodot;
 717         }
 718
 719       flds = xmalloc (sizeof (*flds));
 720       flds->next = old_flds;
 721       flds->name = "";
 722       sname = xasprintf ("tree_exp_%s", data[i].name);
 723       new_structure (sname, 0, &lexer_line, subfields, NULL);
 724       flds->type = find_structure (sname, 0);
 725       flds->line.file = __FILE__;
 726       flds->line.line = __LINE__;
 727       flds->opt = xmalloc (sizeof (*flds->opt));
 728       flds->opt->next = nodot;
 729       flds->opt->name = "tag";
 730       flds->opt->info = data[i].name;
 731     }
 732
 733   new_structure ("tree_exp_subunion", 1, &lexer_line, flds, nodot);
 734   return find_structure ("tree_exp_subunion", 1);
 735 }
 736
 737 /* Perform any special processing on a type T, about to become the type
 738    of a field.  Return the appropriate type for the field.
 739    At present:
 740    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
 741    - Similarly for arrays of pointer-to-char;
 742    - Converts structures for which a parameter is provided to
 743      TYPE_PARAM_STRUCT;
 744    - Handles "special" options.
 745 */
 746
 747 type_p
 748 adjust_field_type (t, opt)
 749      type_p t;
 750      options_p opt;
 751 {
 752   int length_p = 0;
 753   const int pointer_p = t->kind == TYPE_POINTER;
 754   type_p params[NUM_PARAM];
 755   int params_p = 0;
 756   int i;
 757
 758   for (i = 0; i < NUM_PARAM; i++)
 759     params[i] = NULL;
 760
 761   for (; opt; opt = opt->next)
 762     if (strcmp (opt->name, "length") == 0)
 763       length_p = 1;
 764     else if (strcmp (opt->name, "param_is") == 0
 765              || (strncmp (opt->name, "param", 5) == 0
 766                  && ISDIGIT (opt->name[5])
 767                  && strcmp (opt->name + 6, "_is") == 0))
 768       {
 769         int num = ISDIGIT (opt->name[5]) ? opt->name[5] - '0' : 0;
 770
 771         if (! UNION_OR_STRUCT_P (t)
 772             && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
 773           {
 774             error_at_line (&lexer_line,
 775    "option `%s' may only be applied to structures or structure pointers",
 776                            opt->name);
 777             return t;
 778           }
 779
 780         params_p = 1;
 781         if (params[num] != NULL)
 782           error_at_line (&lexer_line, "duplicate `%s' option", opt->name);
 783         if (! ISDIGIT (opt->name[5]))
 784           params[num] = create_pointer ((type_p) opt->info);
 785         else
 786           params[num] = (type_p) opt->info;
 787       }
 788     else if (strcmp (opt->name, "special") == 0)
 789       {
 790         const char *special_name = (const char *)opt->info;
 791         if (strcmp (special_name, "tree_exp") == 0)
 792           t = adjust_field_tree_exp (t, opt);
 793         else if (strcmp (special_name, "rtx_def") == 0)
 794           t = adjust_field_rtx_def (t, opt);
 795         else
 796           error_at_line (&lexer_line, "unknown special `%s'", special_name);
 797       }
 798
 799   if (params_p)
 800     {
 801       type_p realt;
 802
 803       if (pointer_p)
 804         t = t->u.p;
 805       realt = find_param_structure (t, params);
 806       t = pointer_p ? create_pointer (realt) : realt;
 807     }
 808
 809   if (! length_p
 810       && pointer_p
 811       && t->u.p->kind == TYPE_SCALAR
 812       && (strcmp (t->u.p->u.sc, "char") == 0
 813           || strcmp (t->u.p->u.sc, "unsigned char") == 0))
 814     return &string_type;
 815   if (t->kind == TYPE_ARRAY && t->u.a.p->kind == TYPE_POINTER
 816       && t->u.a.p->u.p->kind == TYPE_SCALAR
 817       && (strcmp (t->u.a.p->u.p->u.sc, "char") == 0
 818           || strcmp (t->u.a.p->u.p->u.sc, "unsigned char") == 0))
 819     return create_array (&string_type, t->u.a.len);
 820
 821   return t;
 822 }
 823
 824 /* Create a union for YYSTYPE, as yacc would do it, given a fieldlist FIELDS
 825    and information about the correspondance between token types and fields
 826    in TYPEINFO.  POS is used for error messages.  */
 827
 828 void
 829 note_yacc_type (o, fields, typeinfo, pos)
 830      options_p o;
 831      pair_p fields;
 832      pair_p typeinfo;
 833      struct fileloc *pos;
 834 {
 835   pair_p p;
 836   pair_p *p_p;
 837
 838   for (p = typeinfo; p; p = p->next)
 839     {
 840       pair_p m;
 841
 842       if (p->name == NULL)
 843         continue;
 844
 845       if (p->type == (type_p) 1)
 846         {
 847           pair_p pp;
 848           int ok = 0;
 849
 850           for (pp = typeinfo; pp; pp = pp->next)
 851             if (pp->type != (type_p) 1
 852                 && strcmp (pp->opt->info, p->opt->info) == 0)
 853               {
 854                 ok = 1;
 855                 break;
 856               }
 857           if (! ok)
 858             continue;
 859         }
 860
 861       for (m = fields; m; m = m->next)
 862         if (strcmp (m->name, p->name) == 0)
 863           p->type = m->type;
 864       if (p->type == NULL)
 865         {
 866           error_at_line (&p->line,
 867                          "couldn't match fieldname `%s'", p->name);
 868           p->name = NULL;
 869         }
 870     }
 871
 872   p_p = &typeinfo;
 873   while (*p_p)
 874     {
 875       pair_p p = *p_p;
 876
 877       if (p->name == NULL
 878           || p->type == (type_p) 1)
 879         *p_p = p->next;
 880       else
 881         p_p = &p->next;
 882     }
 883
 884   new_structure ("yy_union", 1, pos, typeinfo, o);
 885   do_typedef ("YYSTYPE", find_structure ("yy_union", 1), pos);
 886 }
 887 \f
 888 static void process_gc_options PARAMS ((options_p, enum gc_used_enum,
 889                                         int *, int *, int *));
 890 static void set_gc_used_type PARAMS ((type_p, enum gc_used_enum, type_p *));
 891 static void set_gc_used PARAMS ((pair_p));
 892
 893 /* Handle OPT for set_gc_used_type.  */
 894
 895 static void
 896 process_gc_options (opt, level, maybe_undef, pass_param, length)
 897      options_p opt;
 898      enum gc_used_enum level;
 899      int *maybe_undef;
 900      int *pass_param;
 901      int *length;
 902 {
 903   options_p o;
 904   for (o = opt; o; o = o->next)
 905     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
 906       set_gc_used_type ((type_p) o->info, GC_POINTED_TO, NULL);
 907     else if (strcmp (o->name, "maybe_undef") == 0)
 908       *maybe_undef = 1;
 909     else if (strcmp (o->name, "use_params") == 0)
 910       *pass_param = 1;
 911     else if (strcmp (o->name, "length") == 0)
 912       *length = 1;
 913 }
 914
 915 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
 916
 917 static void
 918 set_gc_used_type (t, level, param)
 919      type_p t;
 920      enum gc_used_enum level;
 921      type_p param[NUM_PARAM];
 922 {
 923   if (t->gc_used >= level)
 924     return;
 925
 926   t->gc_used = level;
 927
 928   switch (t->kind)
 929     {
 930     case TYPE_STRUCT:
 931     case TYPE_UNION:
 932       {
 933         pair_p f;
 934         int dummy;
 935
 936         process_gc_options (t->u.s.opt, level, &dummy, &dummy, &dummy);
 937
 938         for (f = t->u.s.fields; f; f = f->next)
 939           {
 940             int maybe_undef = 0;
 941             int pass_param = 0;
 942             int length = 0;
 943             process_gc_options (f->opt, level, &maybe_undef, &pass_param,
 944                                 &length);
 945
 946             if (length && f->type->kind == TYPE_POINTER)
 947               set_gc_used_type (f->type->u.p, GC_USED, NULL);
 948             else if (maybe_undef && f->type->kind == TYPE_POINTER)
 949               set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO, NULL);
 950             else if (pass_param && f->type->kind == TYPE_POINTER && param)
 951               set_gc_used_type (find_param_structure (f->type->u.p, param),
 952                                 GC_POINTED_TO, NULL);
 953             else
 954               set_gc_used_type (f->type, GC_USED, pass_param ? param : NULL);
 955           }
 956         break;
 957       }
 958
 959     case TYPE_POINTER:
 960       set_gc_used_type (t->u.p, GC_POINTED_TO, NULL);
 961       break;
 962
 963     case TYPE_ARRAY:
 964       set_gc_used_type (t->u.a.p, GC_USED, param);
 965       break;
 966
 967     case TYPE_LANG_STRUCT:
 968       for (t = t->u.s.lang_struct; t; t = t->next)
 969         set_gc_used_type (t, level, param);
 970       break;
 971
 972     case TYPE_PARAM_STRUCT:
 973       {
 974         int i;
 975         for (i = 0; i < NUM_PARAM; i++)
 976           if (t->u.param_struct.param[i] != 0)
 977             set_gc_used_type (t->u.param_struct.param[i], GC_USED, NULL);
 978       }
 979       if (t->u.param_struct.stru->gc_used == GC_POINTED_TO)
 980         level = GC_POINTED_TO;
 981       else
 982         level = GC_USED;
 983       t->u.param_struct.stru->gc_used = GC_UNUSED;
 984       set_gc_used_type (t->u.param_struct.stru, level,
 985                         t->u.param_struct.param);
 986       break;
 987
 988     default:
 989       break;
 990     }
 991 }
 992
 993 /* Set the gc_used fields of all the types pointed to by VARIABLES.  */
 994
 995 static void
 996 set_gc_used (variables)
 997      pair_p variables;
 998 {
 999   pair_p p;
1000   for (p = variables; p; p = p->next)
1001     set_gc_used_type (p->type, GC_USED, NULL);
1002 }
1003 \f
1004 /* File mapping routines.  For each input file, there is one output .c file
1005    (but some output files have many input files), and there is one .h file
1006    for the whole build.  */
1007
1008 /* The list of output files.  */
1009 static outf_p output_files;
1010
1011 /* The output header file that is included into pretty much every
1012    source file.  */
1013 outf_p header_file;
1014
1015 /* Number of files specified in gtfiles.  */
1016 #define NUM_GT_FILES (ARRAY_SIZE (all_files) - 1)
1017
1018 /* Number of files in the language files array.  */
1019 #define NUM_LANG_FILES (ARRAY_SIZE (lang_files) - 1)
1020
1021 /* Length of srcdir name.  */
1022 static int srcdir_len = 0;
1023
1024 #define NUM_BASE_FILES (ARRAY_SIZE (lang_dir_names) - 1)
1025 outf_p base_files[NUM_BASE_FILES];
1026
1027 static outf_p create_file PARAMS ((const char *, const char *));
1028 static const char * get_file_basename PARAMS ((const char *));
1029
1030 /* Create and return an outf_p for a new file for NAME, to be called
1031    ONAME.  */
1032
1033 static outf_p
1034 create_file (name, oname)
1035      const char *name;
1036      const char *oname;
1037 {
1038   static const char *const hdr[] = {
1039     "   Copyright (C) 2002 Free Software Foundation, Inc.\n",
1040     "\n",
1041     "This file is part of GCC.\n",
1042     "\n",
1043     "GCC is free software; you can redistribute it and/or modify it under\n",
1044     "the terms of the GNU General Public License as published by the Free\n",
1045     "Software Foundation; either version 2, or (at your option) any later\n",
1046     "version.\n",
1047     "\n",
1048     "GCC is distributed in the hope that it will be useful, but WITHOUT ANY\n",
1049     "WARRANTY; without even the implied warranty of MERCHANTABILITY or\n",
1050     "FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License\n",
1051     "for more details.\n",
1052     "\n",
1053     "You should have received a copy of the GNU General Public License\n",
1054     "along with GCC; see the file COPYING.  If not, write to the Free\n",
1055     "Software Foundation, 59 Temple Place - Suite 330, Boston, MA\n",
1056     "02111-1307, USA.  */\n",
1057     "\n",
1058     "/* This file is machine generated.  Do not edit.  */\n"
1059   };
1060   outf_p f;
1061   size_t i;
1062
1063   f = xcalloc (sizeof (*f), 1);
1064   f->next = output_files;
1065   f->name = oname;
1066   output_files = f;
1067
1068   oprintf (f, "/* Type information for %s.\n", name);
1069   for (i = 0; i < ARRAY_SIZE (hdr); i++)
1070     oprintf (f, "%s", hdr[i]);
1071   return f;
1072 }
1073
1074 /* Print, like fprintf, to O.  */
1075 void
1076 oprintf VPARAMS ((outf_p o, const char *format, ...))
1077 {
1078   char *s;
1079   size_t slength;
1080
1081   VA_OPEN (ap, format);
1082   VA_FIXEDARG (ap, outf_p, o);
1083   VA_FIXEDARG (ap, const char *, format);
1084   slength = xvasprintf (&s, format, ap);
1085
1086   if (o->bufused + slength > o->buflength)
1087     {
1088       size_t new_len = o->buflength;
1089       if (new_len == 0)
1090         new_len = 1024;
1091       do {
1092         new_len *= 2;
1093       } while (o->bufused + slength >= new_len);
1094       o->buf = xrealloc (o->buf, new_len);
1095       o->buflength = new_len;
1096     }
1097   memcpy (o->buf + o->bufused, s, slength);
1098   o->bufused += slength;
1099   free (s);
1100   VA_CLOSE (ap);
1101 }
1102
1103 /* Open the global header file and the language-specific header files.  */
1104
1105 static void
1106 open_base_files ()
1107 {
1108   size_t i;
1109
1110   header_file = create_file ("GCC", "gtype-desc.h");
1111
1112   for (i = 0; i < NUM_BASE_FILES; i++)
1113     base_files[i] = create_file (lang_dir_names[i],
1114                                  xasprintf ("gtype-%s.h", lang_dir_names[i]));
1115
1116   /* gtype-desc.c is a little special, so we create it here.  */
1117   {
1118     /* The order of files here matters very much.  */
1119     static const char *const ifiles [] = {
1120       "config.h", "system.h", "coretypes.h", "tm.h", "varray.h",
1121       "hashtab.h", "splay-tree.h", "bitmap.h", "tree.h", "rtl.h",
1122       "function.h", "insn-config.h", "expr.h", "hard-reg-set.h",
1123       "basic-block.h", "cselib.h", "insn-addr.h", "ssa.h", "optabs.h",
1124       "libfuncs.h", "debug.h", "ggc.h",
1125       NULL
1126     };
1127     const char *const *ifp;
1128     outf_p gtype_desc_c;
1129
1130     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
1131     for (ifp = ifiles; *ifp; ifp++)
1132       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
1133   }
1134 }
1135
1136 /* Determine the pathname to F relative to $(srcdir).  */
1137
1138 static const char *
1139 get_file_basename (f)
1140      const char *f;
1141 {
1142   const char *basename;
1143   unsigned i;
1144
1145   basename = strrchr (f, '/');
1146
1147   if (!basename)
1148     return f;
1149
1150   basename++;
1151
1152   for (i = 1; i < NUM_BASE_FILES; i++)
1153     {
1154       const char * s1;
1155       const char * s2;
1156       int l1;
1157       int l2;
1158       s1 = basename - strlen (lang_dir_names [i]) - 1;
1159       s2 = lang_dir_names [i];
1160       l1 = strlen (s1);
1161       l2 = strlen (s2);
1162       if (l1 >= l2 && !memcmp (s1, s2, l2))
1163         {
1164           basename -= l2 + 1;
1165           if ((basename - f - 1) != srcdir_len)
1166             abort (); /* Match is wrong - should be preceded by $srcdir.  */
1167           break;
1168         }
1169     }
1170
1171   return basename;
1172 }
1173
1174 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
1175    INPUT_FILE is used by <lang>.
1176
1177    This function should be written to assume that a file _is_ used
1178    if the situation is unclear.  If it wrongly assumes a file _is_ used,
1179    a linker error will result.  If it wrongly assumes a file _is not_ used,
1180    some GC roots may be missed, which is a much harder-to-debug problem.  */
1181
1182 unsigned
1183 get_base_file_bitmap (input_file)
1184      const char *input_file;
1185 {
1186   const char *basename = get_file_basename (input_file);
1187   const char *slashpos = strchr (basename, '/');
1188   unsigned j;
1189   unsigned k;
1190   unsigned bitmap;
1191
1192   if (slashpos)
1193     {
1194       size_t i;
1195       for (i = 1; i < NUM_BASE_FILES; i++)
1196         if ((size_t)(slashpos - basename) == strlen (lang_dir_names [i])
1197             && memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0)
1198           {
1199             /* It's in a language directory, set that language.  */
1200             bitmap = 1 << i;
1201             return bitmap;
1202           }
1203
1204       abort (); /* Should have found the language.  */
1205     }
1206
1207   /* If it's in any config-lang.in, then set for the languages
1208      specified.  */
1209
1210   bitmap = 0;
1211
1212   for (j = 0; j < NUM_LANG_FILES; j++)
1213     {
1214       if (!strcmp(input_file, lang_files[j]))
1215         {
1216           for (k = 0; k < NUM_BASE_FILES; k++)
1217             {
1218               if (!strcmp(lang_dir_names[k], langs_for_lang_files[j]))
1219                 bitmap |= (1 << k);
1220             }
1221         }
1222     }
1223
1224   /* Otherwise, set all languages.  */
1225   if (!bitmap)
1226     bitmap = (1 << NUM_BASE_FILES) - 1;
1227
1228   return bitmap;
1229 }
1230
1231 /* An output file, suitable for definitions, that can see declarations
1232    made in INPUT_FILE and is linked into every language that uses
1233    INPUT_FILE.  */
1234
1235 outf_p
1236 get_output_file_with_visibility (input_file)
1237      const char *input_file;
1238 {
1239   outf_p r;
1240   size_t len;
1241   const char *basename;
1242   const char *for_name;
1243   const char *output_name;
1244
1245   /* This can happen when we need a file with visibility on a
1246      structure that we've never seen.  We have to just hope that it's
1247      globally visible.  */
1248   if (input_file == NULL)
1249     input_file = "system.h";
1250
1251   /* Determine the output file name.  */
1252   basename = get_file_basename (input_file);
1253
1254   len = strlen (basename);
1255   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
1256       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
1257       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
1258     {
1259       char *s;
1260
1261       output_name = s = xasprintf ("gt-%s", basename);
1262       for (; *s != '.'; s++)
1263         if (! ISALNUM (*s) && *s != '-')
1264           *s = '-';
1265       memcpy (s, ".h", sizeof (".h"));
1266       for_name = basename;
1267     }
1268   else if (strcmp (basename, "c-common.h") == 0)
1269     output_name = "gt-c-common.h", for_name = "c-common.c";
1270   else if (strcmp (basename, "c-tree.h") == 0)
1271     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1272   else
1273     {
1274       size_t i;
1275
1276       for (i = 0; i < NUM_BASE_FILES; i++)
1277         if (memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0
1278             && basename[strlen(lang_dir_names[i])] == '/')
1279           return base_files[i];
1280
1281       output_name = "gtype-desc.c";
1282       for_name = NULL;
1283     }
1284
1285   /* Look through to see if we've ever seen this output filename before.  */
1286   for (r = output_files; r; r = r->next)
1287     if (strcmp (r->name, output_name) == 0)
1288       return r;
1289
1290   /* If not, create it.  */
1291   r = create_file (for_name, output_name);
1292
1293   return r;
1294 }
1295
1296 /* The name of an output file, suitable for definitions, that can see
1297    declarations made in INPUT_FILE and is linked into every language
1298    that uses INPUT_FILE.  */
1299
1300 const char *
1301 get_output_file_name (input_file)
1302      const char *input_file;
1303 {
1304   return get_output_file_with_visibility (input_file)->name;
1305 }
1306
1307 /* Copy the output to its final destination,
1308    but don't unnecessarily change modification times.  */
1309
1310 static void close_output_files PARAMS ((void));
1311
1312 static void
1313 close_output_files ()
1314 {
1315   outf_p of;
1316
1317   for (of = output_files; of; of = of->next)
1318     {
1319       FILE * newfile;
1320
1321       newfile = fopen (of->name, "r");
1322       if (newfile != NULL )
1323         {
1324           int no_write_p;
1325           size_t i;
1326
1327           for (i = 0; i < of->bufused; i++)
1328             {
1329               int ch;
1330               ch = fgetc (newfile);
1331               if (ch == EOF || ch != (unsigned char) of->buf[i])
1332                 break;
1333             }
1334           no_write_p = i == of->bufused && fgetc (newfile) == EOF;
1335           fclose (newfile);
1336
1337           if (no_write_p)
1338             continue;
1339         }
1340
1341       newfile = fopen (of->name, "w");
1342       if (newfile == NULL)
1343         {
1344           perror ("opening output file");
1345           exit (1);
1346         }
1347       if (fwrite (of->buf, 1, of->bufused, newfile) != of->bufused)
1348         {
1349           perror ("writing output file");
1350           exit (1);
1351         }
1352       if (fclose (newfile) != 0)
1353         {
1354           perror ("closing output file");
1355           exit (1);
1356         }
1357     }
1358 }
1359 \f
1360 struct flist {
1361   struct flist *next;
1362   int started_p;
1363   const char *name;
1364   outf_p f;
1365 };
1366
1367 static void output_escaped_param PARAMS ((outf_p , const char *, const char *,
1368                                           const char *, const char *,
1369                                           struct fileloc *));
1370 static void output_mangled_typename PARAMS ((outf_p, type_p));
1371 static void write_gc_structure_fields
1372   PARAMS ((outf_p , type_p, const char *, const char *, options_p,
1373            int, struct fileloc *, lang_bitmap, type_p *));
1374 static void write_gc_marker_routine_for_structure PARAMS ((type_p, type_p,
1375                                                            type_p *));
1376 static void write_gc_types PARAMS ((type_p structures, type_p param_structs));
1377 static void write_enum_defn PARAMS ((type_p structures, type_p param_structs));
1378 static void put_mangled_filename PARAMS ((outf_p , const char *));
1379 static void finish_root_table PARAMS ((struct flist *flp, const char *pfx,
1380                                        const char *tname, const char *lastname,
1381                                        const char *name));
1382 static void write_gc_root PARAMS ((outf_p , pair_p, type_p, const char *, int,
1383                                    struct fileloc *, const char *));
1384 static void write_gc_roots PARAMS ((pair_p));
1385
1386 static int gc_counter;
1387
1388 /* Print PARAM to OF processing escapes.  VAL references the current object,
1389    PREV_VAL the object containing the current object, ONAME is the name
1390    of the option and LINE is used to print error messages.  */
1391
1392 static void
1393 output_escaped_param (of, param, val, prev_val, oname, line)
1394      outf_p of;
1395      const char *param;
1396      const char *val;
1397      const char *prev_val;
1398      const char *oname;
1399      struct fileloc *line;
1400 {
1401   const char *p;
1402
1403   for (p = param; *p; p++)
1404     if (*p != '%')
1405       oprintf (of, "%c", *p);
1406     else switch (*++p)
1407       {
1408       case 'h':
1409         oprintf (of, "(%s)", val);
1410         break;
1411       case '0':
1412         oprintf (of, "(*x)");
1413         break;
1414       case '1':
1415         oprintf (of, "(%s)", prev_val);
1416         break;
1417       case 'a':
1418         {
1419           const char *pp = val + strlen (val);
1420           while (pp[-1] == ']')
1421             while (*pp != '[')
1422               pp--;
1423           oprintf (of, "%s", pp);
1424         }
1425         break;
1426       default:
1427         error_at_line (line, "`%s' option contains bad escape %c%c",
1428                        oname, '%', *p);
1429       }
1430 }
1431
1432 /* Print a mangled name representing T to OF.  */
1433
1434 static void
1435 output_mangled_typename (of, t)
1436      outf_p of;
1437      type_p t;
1438 {
1439   if (t == NULL)
1440     oprintf (of, "Z");
1441   else switch (t->kind)
1442     {
1443     case TYPE_POINTER:
1444       oprintf (of, "P");
1445       output_mangled_typename (of, t->u.p);
1446       break;
1447     case TYPE_SCALAR:
1448       oprintf (of, "I");
1449       break;
1450     case TYPE_STRING:
1451       oprintf (of, "S");
1452       break;
1453     case TYPE_STRUCT:
1454     case TYPE_UNION:
1455     case TYPE_LANG_STRUCT:
1456       oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
1457       break;
1458     case TYPE_PARAM_STRUCT:
1459       {
1460         int i;
1461         for (i = 0; i < NUM_PARAM; i++)
1462           if (t->u.param_struct.param[i] != NULL)
1463             output_mangled_typename (of, t->u.param_struct.param[i]);
1464         output_mangled_typename (of, t->u.param_struct.stru);
1465       }
1466       break;
1467     case TYPE_ARRAY:
1468       abort ();
1469     }
1470 }
1471
1472 /* Write out code to OF which marks the fields of S.  VAL references
1473    the current object, PREV_VAL the object containing the current
1474    object, OPTS is a list of options to apply, INDENT is the current
1475    indentation level, LINE is used to print error messages, BITMAP
1476    indicates which languages to print the structure for, and PARAM is
1477    the current parameter (from an enclosing param_is option).  */
1478
1479 static void
1480 write_gc_structure_fields (of, s, val, prev_val, opts, indent, line, bitmap,
1481                            param)
1482      outf_p of;
1483      type_p s;
1484      const char *val;
1485      const char *prev_val;
1486      options_p opts;
1487      int indent;
1488      struct fileloc *line;
1489      lang_bitmap bitmap;
1490      type_p * param;
1491 {
1492   pair_p f;
1493   int seen_default = 0;
1494
1495   if (! s->u.s.line.file)
1496     error_at_line (line, "incomplete structure `%s'", s->u.s.tag);
1497   else if ((s->u.s.bitmap & bitmap) != bitmap)
1498     {
1499       error_at_line (line, "structure defined for mismatching languages");
1500       error_at_line (&s->u.s.line, "one structure defined here");
1501     }
1502
1503   if (s->kind == TYPE_UNION)
1504     {
1505       const char *tagexpr = NULL;
1506       options_p oo;
1507
1508       for (oo = opts; oo; oo = oo->next)
1509         if (strcmp (oo->name, "desc") == 0)
1510           tagexpr = (const char *)oo->info;
1511       if (tagexpr == NULL)
1512         {
1513           tagexpr = "1";
1514           error_at_line (line, "missing `desc' option");
1515         }
1516
1517       oprintf (of, "%*sswitch (", indent, "");
1518       output_escaped_param (of, tagexpr, val, prev_val, "desc", line);
1519       oprintf (of, ")\n");
1520       indent += 2;
1521       oprintf (of, "%*s{\n", indent, "");
1522     }
1523
1524   for (f = s->u.s.fields; f; f = f->next)
1525     {
1526       const char *tagid = NULL;
1527       const char *length = NULL;
1528       int skip_p = 0;
1529       int default_p = 0;
1530       int maybe_undef_p = 0;
1531       int use_param_num = -1;
1532       int use_params_p = 0;
1533       int needs_cast_p = 0;
1534       options_p oo;
1535       type_p t = f->type;
1536       const char *dot = ".";
1537
1538       for (oo = f->opt; oo; oo = oo->next)
1539         if (strcmp (oo->name, "length") == 0)
1540           length = (const char *)oo->info;
1541         else if (strcmp (oo->name, "maybe_undef") == 0)
1542           maybe_undef_p = 1;
1543         else if (strcmp (oo->name, "tag") == 0)
1544           tagid = (const char *)oo->info;
1545         else if (strcmp (oo->name, "special") == 0)
1546           ;
1547         else if (strcmp (oo->name, "skip") == 0)
1548           skip_p = 1;
1549         else if (strcmp (oo->name, "default") == 0)
1550           default_p = 1;
1551         else if (strcmp (oo->name, "desc") == 0)
1552           ;
1553         else if (strcmp (oo->name, "descbits") == 0)
1554           ;
1555         else if (strcmp (oo->name, "param_is") == 0)
1556           ;
1557         else if (strncmp (oo->name, "use_param", 9) == 0
1558                  && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1559           use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
1560         else if (strcmp (oo->name, "use_params") == 0)
1561           use_params_p = 1;
1562         else if (strcmp (oo->name, "dot") == 0)
1563           dot = (const char *)oo->info;
1564         else
1565           error_at_line (&f->line, "unknown field option `%s'\n", oo->name);
1566
1567       if (skip_p)
1568         continue;
1569
1570       if (use_params_p)
1571         {
1572           int pointer_p = t->kind == TYPE_POINTER;
1573
1574           if (pointer_p)
1575             t = t->u.p;
1576           t = find_param_structure (t, param);
1577           if (pointer_p)
1578             t = create_pointer (t);
1579         }
1580
1581       if (use_param_num != -1)
1582         {
1583           if (param != NULL && param[use_param_num] != NULL)
1584             {
1585               type_p nt = param[use_param_num];
1586
1587               if (t->kind == TYPE_ARRAY)
1588                 nt = create_array (nt, t->u.a.len);
1589               else if (length != NULL && t->kind == TYPE_POINTER)
1590                 nt = create_pointer (nt);
1591               needs_cast_p = (t->kind != TYPE_POINTER
1592                               && nt->kind == TYPE_POINTER);
1593               t = nt;
1594             }
1595           else if (s->kind != TYPE_UNION)
1596             error_at_line (&f->line, "no parameter defined");
1597         }
1598
1599       if (t->kind == TYPE_SCALAR
1600           || (t->kind == TYPE_ARRAY
1601               && t->u.a.p->kind == TYPE_SCALAR))
1602         continue;
1603
1604       seen_default |= default_p;
1605
1606       if (maybe_undef_p
1607           && (t->kind != TYPE_POINTER
1608               || t->u.p->kind != TYPE_STRUCT))
1609         error_at_line (&f->line,
1610                        "field `%s' has invalid option `maybe_undef_p'\n",
1611                        f->name);
1612       if (s->kind == TYPE_UNION)
1613         {
1614           if (tagid)
1615             {
1616               oprintf (of, "%*scase %s:\n", indent, "", tagid);
1617
1618             }
1619           else if (default_p)
1620             {
1621               oprintf (of, "%*sdefault:\n", indent, "");
1622             }
1623           else
1624             {
1625               error_at_line (&f->line, "field `%s' has no tag", f->name);
1626               continue;
1627             }
1628           indent += 2;
1629         }
1630
1631       switch (t->kind)
1632         {
1633         case TYPE_STRING:
1634           /* Do nothing; strings go in the string pool.  */
1635           break;
1636
1637         case TYPE_LANG_STRUCT:
1638           {
1639             type_p ti;
1640             for (ti = t->u.s.lang_struct; ti; ti = ti->next)
1641               if (ti->u.s.bitmap & bitmap)
1642                 {
1643                   t = ti;
1644                   break;
1645                 }
1646             if (ti == NULL)
1647               {
1648                 error_at_line (&f->line,
1649                                "structure not defined for this language");
1650                 break;
1651               }
1652           }
1653           /* Fall through...  */
1654         case TYPE_STRUCT:
1655         case TYPE_UNION:
1656           {
1657             char *newval;
1658
1659             newval = xasprintf ("%s%s%s", val, dot, f->name);
1660             write_gc_structure_fields (of, t, newval, val, f->opt, indent,
1661                                        &f->line, bitmap, param);
1662             free (newval);
1663             break;
1664           }
1665
1666         case TYPE_POINTER:
1667           if (! length)
1668             {
1669               if (maybe_undef_p
1670                   && t->u.p->u.s.line.file == NULL)
1671                 oprintf (of, "%*sif (%s%s%s) abort();\n", indent, "",
1672                          val, dot, f->name);
1673               else if (UNION_OR_STRUCT_P (t->u.p)
1674                        || t->u.p->kind == TYPE_PARAM_STRUCT)
1675                 {
1676                   oprintf (of, "%*sgt_ggc_m_", indent, "");
1677                   output_mangled_typename (of, t->u.p);
1678                   oprintf (of, " (");
1679                   if (needs_cast_p)
1680                     oprintf (of, "(%s %s *)",
1681                              UNION_P (t->u.p) ? "union" : "struct",
1682                              t->u.p->u.s.tag);
1683                   oprintf (of, "%s%s%s);\n", val, dot, f->name);
1684                 }
1685               else
1686                 error_at_line (&f->line, "field `%s' is pointer to scalar",
1687                                f->name);
1688               break;
1689             }
1690           else if (t->u.p->kind == TYPE_SCALAR
1691                    || t->u.p->kind == TYPE_STRING)
1692             oprintf (of, "%*sggc_mark (%s%s%s);\n", indent, "",
1693                      val, dot, f->name);
1694           else
1695             {
1696               int loopcounter = ++gc_counter;
1697
1698               oprintf (of, "%*sif (%s%s%s != NULL) {\n", indent, "",
1699                        val, dot, f->name);
1700               indent += 2;
1701               oprintf (of, "%*ssize_t i%d;\n", indent, "", loopcounter);
1702               oprintf (of, "%*sggc_set_mark (%s%s%s);\n", indent, "",
1703                        val, dot, f->name);
1704               oprintf (of, "%*sfor (i%d = 0; i%d < (size_t)(", indent, "",
1705                        loopcounter, loopcounter);
1706               output_escaped_param (of, length, val, prev_val, "length", line);
1707               oprintf (of, "); i%d++) {\n", loopcounter);
1708               indent += 2;
1709               switch (t->u.p->kind)
1710                 {
1711                 case TYPE_STRUCT:
1712                 case TYPE_UNION:
1713                   {
1714                     char *newval;
1715
1716                     newval = xasprintf ("%s%s%s[i%d]", val, dot, f->name,
1717                                         loopcounter);
1718                     write_gc_structure_fields (of, t->u.p, newval, val,
1719                                                f->opt, indent, &f->line,
1720                                                bitmap, param);
1721                     free (newval);
1722                     break;
1723                   }
1724                 case TYPE_POINTER:
1725                   if (UNION_OR_STRUCT_P (t->u.p->u.p)
1726                       || t->u.p->u.p->kind == TYPE_PARAM_STRUCT)
1727                     {
1728                       oprintf (of, "%*sgt_ggc_m_", indent, "");
1729                       output_mangled_typename (of, t->u.p->u.p);
1730                       oprintf (of, " (%s%s%s[i%d]);\n", val, dot, f->name,
1731                                loopcounter);
1732                     }
1733                   else
1734                     error_at_line (&f->line,
1735                                    "field `%s' is array of pointer to scalar",
1736                                    f->name);
1737                   break;
1738                 default:
1739                   error_at_line (&f->line,
1740                                  "field `%s' is array of unimplemented type",
1741                                  f->name);
1742                   break;
1743                 }
1744               indent -= 2;
1745               oprintf (of, "%*s}\n", indent, "");
1746               indent -= 2;
1747               oprintf (of, "%*s}\n", indent, "");
1748             }
1749           break;
1750
1751         case TYPE_ARRAY:
1752           {
1753             int loopcounter = ++gc_counter;
1754             type_p ta;
1755             int i;
1756
1757             if (! length &&
1758                 (strcmp (t->u.a.len, "0") == 0
1759                  || strcmp (t->u.a.len, "1") == 0))
1760               error_at_line (&f->line,
1761                              "field `%s' is array of size %s",
1762                              f->name, t->u.a.len);
1763
1764             /* Arrays of scalars can be ignored.  */
1765             for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
1766               ;
1767             if (ta->kind == TYPE_SCALAR
1768                 || ta->kind == TYPE_STRING)
1769               break;
1770
1771             oprintf (of, "%*s{\n", indent, "");
1772             indent += 2;
1773
1774             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1775               {
1776                 oprintf (of, "%*ssize_t i%d_%d;\n",
1777                          indent, "", loopcounter, i);
1778                 oprintf (of, "%*sconst size_t ilimit%d_%d = (",
1779                          indent, "", loopcounter, i);
1780                 if (i == 0 && length != NULL)
1781                   output_escaped_param (of, length, val, prev_val,
1782                                         "length", line);
1783                 else
1784                   oprintf (of, "%s", ta->u.a.len);
1785                 oprintf (of, ");\n");
1786               }
1787
1788             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1789               {
1790                 oprintf (of,
1791                  "%*sfor (i%d_%d = 0; i%d_%d < ilimit%d_%d; i%d_%d++) {\n",
1792                          indent, "", loopcounter, i, loopcounter, i,
1793                          loopcounter, i, loopcounter, i);
1794                 indent += 2;
1795               }
1796
1797             if (ta->kind == TYPE_POINTER
1798                 && (UNION_OR_STRUCT_P (ta->u.p)
1799                     || ta->u.p->kind == TYPE_PARAM_STRUCT))
1800               {
1801                 oprintf (of, "%*sgt_ggc_m_", indent, "");
1802                 output_mangled_typename (of, ta->u.p);
1803                 oprintf (of, " (%s%s%s", val, dot, f->name);
1804                 for (ta = t, i = 0;
1805                      ta->kind == TYPE_ARRAY;
1806                      ta = ta->u.a.p, i++)
1807                   oprintf (of, "[i%d_%d]", loopcounter, i);
1808                 oprintf (of, ");\n");
1809               }
1810             else if (ta->kind == TYPE_STRUCT || ta->kind == TYPE_UNION)
1811               {
1812                 char *newval;
1813                 int len;
1814
1815                 len = strlen (val) + strlen (f->name) + 2;
1816                 for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
1817                   len += sizeof ("[i_]") + 2*6;
1818
1819                 newval = xmalloc (len);
1820                 sprintf (newval, "%s%s%s", val, dot, f->name);
1821                 for (ta = t, i = 0;
1822                      ta->kind == TYPE_ARRAY;
1823                      ta = ta->u.a.p, i++)
1824                   sprintf (newval + strlen (newval), "[i%d_%d]",
1825                            loopcounter, i);
1826                 write_gc_structure_fields (of, t->u.p, newval, val,
1827                                            f->opt, indent, &f->line, bitmap,
1828                                            param);
1829                 free (newval);
1830               }
1831             else if (ta->kind == TYPE_POINTER && ta->u.p->kind == TYPE_SCALAR
1832                      && use_param_num != -1 && param == NULL)
1833               oprintf (of, "%*sabort();\n", indent, "");
1834             else
1835               error_at_line (&f->line,
1836                              "field `%s' is array of unimplemented type",
1837                              f->name);
1838             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1839               {
1840                 indent -= 2;
1841                 oprintf (of, "%*s}\n", indent, "");
1842               }
1843
1844             indent -= 2;
1845             oprintf (of, "%*s}\n", indent, "");
1846             break;
1847           }
1848
1849         default:
1850           error_at_line (&f->line,
1851                          "field `%s' is unimplemented type",
1852                          f->name);
1853           break;
1854         }
1855
1856       if (s->kind == TYPE_UNION)
1857         {
1858           oprintf (of, "%*sbreak;\n", indent, "");
1859           indent -= 2;
1860         }
1861     }
1862   if (s->kind == TYPE_UNION)
1863     {
1864       if (! seen_default)
1865         {
1866           oprintf (of, "%*sdefault:\n", indent, "");
1867           oprintf (of, "%*s  break;\n", indent, "");
1868         }
1869       oprintf (of, "%*s}\n", indent, "");
1870       indent -= 2;
1871     }
1872 }
1873
1874 /* Write out a marker routine for S.  PARAM is the parameter from an
1875    enclosing PARAM_IS option.  */
1876
1877 static void
1878 write_gc_marker_routine_for_structure (orig_s, s, param)
1879      type_p orig_s;
1880      type_p s;
1881      type_p * param;
1882 {
1883   outf_p f;
1884   const char *fn = s->u.s.line.file;
1885   int i;
1886   const char *chain_next = NULL;
1887   const char *chain_prev = NULL;
1888   options_p opt;
1889
1890   /* This is a hack, and not the good kind either.  */
1891   for (i = NUM_PARAM - 1; i >= 0; i--)
1892     if (param && param[i] && param[i]->kind == TYPE_POINTER
1893         && UNION_OR_STRUCT_P (param[i]->u.p))
1894       fn = param[i]->u.p->u.s.line.file;
1895
1896   f = get_output_file_with_visibility (fn);
1897
1898   for (opt = s->u.s.opt; opt; opt = opt->next)
1899     if (strcmp (opt->name, "chain_next") == 0)
1900       chain_next = (const char *) opt->info;
1901     else if (strcmp (opt->name, "chain_prev") == 0)
1902       chain_prev = (const char *) opt->info;
1903
1904   if (chain_prev != NULL && chain_next == NULL)
1905     error_at_line (&s->u.s.line, "chain_prev without chain_next");
1906
1907   oprintf (f, "\n");
1908   oprintf (f, "void\n");
1909   if (param == NULL)
1910     oprintf (f, "gt_ggc_mx_%s", s->u.s.tag);
1911   else
1912     {
1913       oprintf (f, "gt_ggc_m_");
1914       output_mangled_typename (f, orig_s);
1915     }
1916   oprintf (f, " (x_p)\n");
1917   oprintf (f, "      void *x_p;\n");
1918   oprintf (f, "{\n");
1919   oprintf (f, "  %s %s * %sx = (%s %s *)x_p;\n",
1920            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1921            chain_next == NULL ? "const " : "",
1922            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1923   if (chain_next != NULL)
1924     oprintf (f, "  %s %s * xlimit = x;\n",
1925              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1926   if (chain_next == NULL)
1927     oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
1928   else
1929     {
1930       oprintf (f, "  while (ggc_test_and_set_mark (xlimit))\n");
1931       oprintf (f, "   xlimit = (");
1932       output_escaped_param (f, chain_next, "*xlimit", "*xlimit",
1933                             "chain_next", &s->u.s.line);
1934       oprintf (f, ");\n");
1935       if (chain_prev != NULL)
1936         {
1937           oprintf (f, "  if (x != xlimit)\n");
1938           oprintf (f, "    for (;;)\n");
1939           oprintf (f, "      {\n");
1940           oprintf (f, "        %s %s * const xprev = (",
1941                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1942           output_escaped_param (f, chain_prev, "*x", "*x",
1943                                 "chain_prev", &s->u.s.line);
1944           oprintf (f, ");\n");
1945           oprintf (f, "        if (xprev == NULL) break;\n");
1946           oprintf (f, "        x = xprev;\n");
1947           oprintf (f, "        ggc_set_mark (xprev);\n");
1948           oprintf (f, "      }\n");
1949         }
1950       oprintf (f, "  while (x != xlimit)\n");
1951     }
1952   oprintf (f, "    {\n");
1953
1954   gc_counter = 0;
1955   write_gc_structure_fields (f, s, "(*x)", "not valid postage",
1956                              s->u.s.opt, 6, &s->u.s.line, s->u.s.bitmap,
1957                              param);
1958
1959   if (chain_next != NULL)
1960     {
1961       oprintf (f, "      x = (");
1962       output_escaped_param (f, chain_next, "*x", "*x",
1963                             "chain_next", &s->u.s.line);
1964       oprintf (f, ");\n");
1965     }
1966
1967   oprintf (f, "  }\n");
1968   oprintf (f, "}\n");
1969 }
1970
1971 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
1972
1973 static void
1974 write_gc_types (structures, param_structs)
1975      type_p structures;
1976      type_p param_structs;
1977 {
1978   type_p s;
1979
1980   oprintf (header_file, "\n/* GC marker procedures.  */\n");
1981   for (s = structures; s; s = s->next)
1982     if (s->gc_used == GC_POINTED_TO
1983         || s->gc_used == GC_MAYBE_POINTED_TO)
1984       {
1985         options_p opt;
1986
1987         if (s->gc_used == GC_MAYBE_POINTED_TO
1988             && s->u.s.line.file == NULL)
1989           continue;
1990
1991         oprintf (header_file, "#define gt_ggc_m_");
1992         output_mangled_typename (header_file, s);
1993         oprintf (header_file, "(X) do { \\\n");
1994         oprintf (header_file,
1995                  "  if (X != NULL) gt_ggc_mx_%s (X);\\\n", s->u.s.tag);
1996         oprintf (header_file,
1997                  "  } while (0)\n");
1998
1999         for (opt = s->u.s.opt; opt; opt = opt->next)
2000           if (strcmp (opt->name, "ptr_alias") == 0)
2001             {
2002               type_p t = (type_p) opt->info;
2003               if (t->kind == TYPE_STRUCT
2004                   || t->kind == TYPE_UNION
2005                   || t->kind == TYPE_LANG_STRUCT)
2006                 oprintf (header_file,
2007                          "#define gt_ggc_mx_%s gt_ggc_mx_%s\n",
2008                          s->u.s.tag, t->u.s.tag);
2009               else
2010                 error_at_line (&s->u.s.line,
2011                                "structure alias is not a structure");
2012               break;
2013             }
2014         if (opt)
2015           continue;
2016
2017         /* Declare the marker procedure only once.  */
2018         oprintf (header_file,
2019                  "extern void gt_ggc_mx_%s PARAMS ((void *));\n",
2020                  s->u.s.tag);
2021
2022         if (s->u.s.line.file == NULL)
2023           {
2024             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2025                      s->u.s.tag);
2026             continue;
2027           }
2028
2029         if (s->kind == TYPE_LANG_STRUCT)
2030           {
2031             type_p ss;
2032             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2033               write_gc_marker_routine_for_structure (s, ss, NULL);
2034           }
2035         else
2036           write_gc_marker_routine_for_structure (s, s, NULL);
2037       }
2038
2039   for (s = param_structs; s; s = s->next)
2040     if (s->gc_used == GC_POINTED_TO)
2041       {
2042         type_p * param = s->u.param_struct.param;
2043         type_p stru = s->u.param_struct.stru;
2044
2045         /* Declare the marker procedure.  */
2046         oprintf (header_file, "extern void gt_ggc_m_");
2047         output_mangled_typename (header_file, s);
2048         oprintf (header_file, " PARAMS ((void *));\n");
2049
2050         if (stru->u.s.line.file == NULL)
2051           {
2052             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2053                      s->u.s.tag);
2054             continue;
2055           }
2056
2057         if (stru->kind == TYPE_LANG_STRUCT)
2058           {
2059             type_p ss;
2060             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2061               write_gc_marker_routine_for_structure (s, ss, param);
2062           }
2063         else
2064           write_gc_marker_routine_for_structure (s, stru, param);
2065       }
2066 }
2067
2068 /* Write out the 'enum' definition for gt_types_enum.  */
2069
2070 static void
2071 write_enum_defn (structures, param_structs)
2072      type_p structures;
2073      type_p param_structs;
2074 {
2075   type_p s;
2076
2077   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2078   oprintf (header_file, "enum gt_types_enum {\n");
2079   for (s = structures; s; s = s->next)
2080     if (s->gc_used == GC_POINTED_TO
2081         || s->gc_used == GC_MAYBE_POINTED_TO)
2082       {
2083         if (s->gc_used == GC_MAYBE_POINTED_TO
2084             && s->u.s.line.file == NULL)
2085           continue;
2086
2087         oprintf (header_file, " gt_ggc_e_");
2088         output_mangled_typename (header_file, s);
2089         oprintf (header_file, ", \n");
2090       }
2091   for (s = param_structs; s; s = s->next)
2092     if (s->gc_used == GC_POINTED_TO)
2093       {
2094         oprintf (header_file, " gt_e_");
2095         output_mangled_typename (header_file, s);
2096         oprintf (header_file, ", \n");
2097       }
2098   oprintf (header_file, " gt_types_enum_last\n");
2099   oprintf (header_file, "};\n");
2100 }
2101
2102
2103 /* Mangle FN and print it to F.  */
2104
2105 static void
2106 put_mangled_filename (f, fn)
2107      outf_p f;
2108      const char *fn;
2109 {
2110   const char *name = get_output_file_name (fn);
2111   for (; *name != 0; name++)
2112     if (ISALNUM (*name))
2113       oprintf (f, "%c", *name);
2114     else
2115       oprintf (f, "%c", '_');
2116 }
2117
2118 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2119    LASTNAME, and NAME are all strings to insert in various places in
2120    the resulting code.  */
2121
2122 static void
2123 finish_root_table (flp, pfx, lastname, tname, name)
2124      struct flist *flp;
2125      const char *pfx;
2126      const char *tname;
2127      const char *lastname;
2128      const char *name;
2129 {
2130   struct flist *fli2;
2131   unsigned started_bitmap = 0;
2132
2133   for (fli2 = flp; fli2; fli2 = fli2->next)
2134     if (fli2->started_p)
2135       {
2136         oprintf (fli2->f, "  %s\n", lastname);
2137         oprintf (fli2->f, "};\n\n");
2138       }
2139
2140   for (fli2 = flp; fli2; fli2 = fli2->next)
2141     if (fli2->started_p)
2142       {
2143         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2144         int fnum;
2145
2146         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2147           if (bitmap & 1)
2148             {
2149               oprintf (base_files[fnum],
2150                        "extern const struct %s gt_ggc_%s_",
2151                        tname, pfx);
2152               put_mangled_filename (base_files[fnum], fli2->name);
2153               oprintf (base_files[fnum], "[];\n");
2154             }
2155       }
2156
2157   for (fli2 = flp; fli2; fli2 = fli2->next)
2158     if (fli2->started_p)
2159       {
2160         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2161         int fnum;
2162
2163         fli2->started_p = 0;
2164
2165         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2166           if (bitmap & 1)
2167             {
2168               if (! (started_bitmap & (1 << fnum)))
2169                 {
2170                   oprintf (base_files [fnum],
2171                            "const struct %s * const %s[] = {\n",
2172                            tname, name);
2173                   started_bitmap |= 1 << fnum;
2174                 }
2175               oprintf (base_files[fnum], "  gt_ggc_%s_", pfx);
2176               put_mangled_filename (base_files[fnum], fli2->name);
2177               oprintf (base_files[fnum], ",\n");
2178             }
2179       }
2180
2181   {
2182     unsigned bitmap;
2183     int fnum;
2184
2185     for (bitmap = started_bitmap, fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2186       if (bitmap & 1)
2187         {
2188           oprintf (base_files[fnum], "  NULL\n");
2189           oprintf (base_files[fnum], "};\n");
2190         }
2191   }
2192 }
2193
2194 /* Write out to F the table entry and any marker routines needed to
2195    mark NAME as TYPE.  The original variable is V, at LINE.
2196    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2197    is nonzero iff we are building the root table for hash table caches.  */
2198
2199 static void
2200 write_gc_root (f, v, type, name, has_length, line, if_marked)
2201      outf_p f;
2202      pair_p v;
2203      type_p type;
2204      const char *name;
2205      int has_length;
2206      struct fileloc *line;
2207      const char *if_marked;
2208 {
2209   switch (type->kind)
2210     {
2211     case TYPE_STRUCT:
2212       {
2213         pair_p fld;
2214         for (fld = type->u.s.fields; fld; fld = fld->next)
2215           {
2216             int skip_p = 0;
2217             const char *desc = NULL;
2218             options_p o;
2219
2220             for (o = fld->opt; o; o = o->next)
2221               if (strcmp (o->name, "skip") == 0)
2222                 skip_p = 1;
2223               else if (strcmp (o->name, "desc") == 0)
2224                 desc = (const char *)o->info;
2225               else
2226                 error_at_line (line,
2227                        "field `%s' of global `%s' has unknown option `%s'",
2228                                fld->name, name, o->name);
2229
2230             if (skip_p)
2231               continue;
2232             else if (desc && fld->type->kind == TYPE_UNION)
2233               {
2234                 pair_p validf = NULL;
2235                 pair_p ufld;
2236
2237                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2238                   {
2239                     const char *tag = NULL;
2240                     options_p oo;
2241
2242                     for (oo = ufld->opt; oo; oo = oo->next)
2243                       if (strcmp (oo->name, "tag") == 0)
2244                         tag = (const char *)oo->info;
2245                     if (tag == NULL || strcmp (tag, desc) != 0)
2246                       continue;
2247                     if (validf != NULL)
2248                       error_at_line (line,
2249                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2250                                      name, fld->name, validf->name,
2251                                      name, fld->name, ufld->name,
2252                                      tag);
2253                     validf = ufld;
2254                   }
2255                 if (validf != NULL)
2256                   {
2257                     char *newname;
2258                     newname = xasprintf ("%s.%s.%s",
2259                                          name, fld->name, validf->name);
2260                     write_gc_root (f, v, validf->type, newname, 0, line,
2261                                    if_marked);
2262                     free (newname);
2263                   }
2264               }
2265             else if (desc)
2266               error_at_line (line,
2267                      "global `%s.%s' has `desc' option but is not union",
2268                              name, fld->name);
2269             else
2270               {
2271                 char *newname;
2272                 newname = xasprintf ("%s.%s", name, fld->name);
2273                 write_gc_root (f, v, fld->type, newname, 0, line, if_marked);
2274                 free (newname);
2275               }
2276           }
2277       }
2278       break;
2279
2280     case TYPE_ARRAY:
2281       {
2282         char *newname;
2283         newname = xasprintf ("%s[0]", name);
2284         write_gc_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2285         free (newname);
2286       }
2287       break;
2288
2289     case TYPE_POINTER:
2290       {
2291         type_p ap, tp;
2292
2293         oprintf (f, "  {\n");
2294         oprintf (f, "    &%s,\n", name);
2295         oprintf (f, "    1");
2296
2297         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2298           if (ap->u.a.len[0])
2299             oprintf (f, " * (%s)", ap->u.a.len);
2300           else if (ap == v->type)
2301             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2302         oprintf (f, ",\n");
2303         oprintf (f, "    sizeof (%s", v->name);
2304         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2305           oprintf (f, "[0]");
2306         oprintf (f, "),\n");
2307
2308         tp = type->u.p;
2309
2310         if (! has_length && UNION_OR_STRUCT_P (tp))
2311           {
2312             oprintf (f, "    &gt_ggc_mx_%s\n", tp->u.s.tag);
2313           }
2314         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2315           {
2316             oprintf (f, "    &gt_ggc_m_");
2317             output_mangled_typename (f, tp);
2318           }
2319         else if (has_length
2320                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2321           {
2322             oprintf (f, "    &gt_ggc_ma_%s", name);
2323           }
2324         else
2325           {
2326             error_at_line (line,
2327                            "global `%s' is pointer to unimplemented type",
2328                            name);
2329           }
2330         if (if_marked)
2331           oprintf (f, ",\n    &%s", if_marked);
2332         oprintf (f, "\n  },\n");
2333       }
2334       break;
2335
2336     case TYPE_SCALAR:
2337     case TYPE_STRING:
2338       break;
2339
2340     default:
2341       error_at_line (line,
2342                      "global `%s' is unimplemented type",
2343                      name);
2344     }
2345 }
2346
2347 /* Output a table describing the locations and types of VARIABLES.  */
2348
2349 static void
2350 write_gc_roots (variables)
2351      pair_p variables;
2352 {
2353   pair_p v;
2354   struct flist *flp = NULL;
2355
2356   for (v = variables; v; v = v->next)
2357     {
2358       outf_p f = get_output_file_with_visibility (v->line.file);
2359       struct flist *fli;
2360       const char *length = NULL;
2361       int deletable_p = 0;
2362       options_p o;
2363
2364       for (o = v->opt; o; o = o->next)
2365         if (strcmp (o->name, "length") == 0)
2366           length = (const char *)o->info;
2367         else if (strcmp (o->name, "deletable") == 0)
2368           deletable_p = 1;
2369         else if (strcmp (o->name, "param_is") == 0)
2370           ;
2371         else if (strncmp (o->name, "param", 5) == 0
2372                  && ISDIGIT (o->name[5])
2373                  && strcmp (o->name + 6, "_is") == 0)
2374           ;
2375         else if (strcmp (o->name, "if_marked") == 0)
2376           ;
2377         else
2378           error_at_line (&v->line,
2379                          "global `%s' has unknown option `%s'",
2380                          v->name, o->name);
2381
2382       for (fli = flp; fli; fli = fli->next)
2383         if (fli->f == f)
2384           break;
2385       if (fli == NULL)
2386         {
2387           fli = xmalloc (sizeof (*fli));
2388           fli->f = f;
2389           fli->next = flp;
2390           fli->started_p = 0;
2391           fli->name = v->line.file;
2392           flp = fli;
2393
2394           oprintf (f, "\n/* GC roots.  */\n\n");
2395         }
2396
2397       if (! deletable_p
2398           && length
2399           && v->type->kind == TYPE_POINTER
2400           && (v->type->u.p->kind == TYPE_POINTER
2401               || v->type->u.p->kind == TYPE_STRUCT))
2402         {
2403           oprintf (f, "static void gt_ggc_ma_%s PARAMS ((void *));\n",
2404                    v->name);
2405           oprintf (f, "static void\ngt_ggc_ma_%s (x_p)\n      void *x_p;\n",
2406                    v->name);
2407           oprintf (f, "{\n");
2408           oprintf (f, "  size_t i;\n");
2409
2410           if (v->type->u.p->kind == TYPE_POINTER)
2411             {
2412               type_p s = v->type->u.p->u.p;
2413
2414               oprintf (f, "  %s %s ** const x = (%s %s **)x_p;\n",
2415                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2416                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2417               oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
2418               oprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
2419               if (! UNION_OR_STRUCT_P (s)
2420                   && ! s->kind == TYPE_PARAM_STRUCT)
2421                 {
2422                   error_at_line (&v->line,
2423                                  "global `%s' has unsupported ** type",
2424                                  v->name);
2425                   continue;
2426                 }
2427
2428               oprintf (f, "      gt_ggc_m_");
2429               output_mangled_typename (f, s);
2430               oprintf (f, " (x[i]);\n");
2431             }
2432           else
2433             {
2434               type_p s = v->type->u.p;
2435
2436               oprintf (f, "  %s %s * const x = (%s %s *)x_p;\n",
2437                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2438                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2439               oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
2440               oprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
2441               oprintf (f, "      {\n");
2442               write_gc_structure_fields (f, s, "x[i]", "x[i]",
2443                                          v->opt, 8, &v->line, s->u.s.bitmap,
2444                                          NULL);
2445               oprintf (f, "      }\n");
2446             }
2447
2448           oprintf (f, "}\n\n");
2449         }
2450     }
2451
2452   for (v = variables; v; v = v->next)
2453     {
2454       outf_p f = get_output_file_with_visibility (v->line.file);
2455       struct flist *fli;
2456       int skip_p = 0;
2457       int length_p = 0;
2458       options_p o;
2459
2460       for (o = v->opt; o; o = o->next)
2461         if (strcmp (o->name, "length") == 0)
2462           length_p = 1;
2463         else if (strcmp (o->name, "deletable") == 0
2464                  || strcmp (o->name, "if_marked") == 0)
2465           skip_p = 1;
2466
2467       if (skip_p)
2468         continue;
2469
2470       for (fli = flp; fli; fli = fli->next)
2471         if (fli->f == f)
2472           break;
2473       if (! fli->started_p)
2474         {
2475           fli->started_p = 1;
2476
2477           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2478           put_mangled_filename (f, v->line.file);
2479           oprintf (f, "[] = {\n");
2480         }
2481
2482       write_gc_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2483     }
2484
2485   finish_root_table (flp, "r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2486                      "gt_ggc_rtab");
2487
2488   for (v = variables; v; v = v->next)
2489     {
2490       outf_p f = get_output_file_with_visibility (v->line.file);
2491       struct flist *fli;
2492       int skip_p = 1;
2493       options_p o;
2494
2495       for (o = v->opt; o; o = o->next)
2496         if (strcmp (o->name, "deletable") == 0)
2497           skip_p = 0;
2498         else if (strcmp (o->name, "if_marked") == 0)
2499           skip_p = 1;
2500
2501       if (skip_p)
2502         continue;
2503
2504       for (fli = flp; fli; fli = fli->next)
2505         if (fli->f == f)
2506           break;
2507       if (! fli->started_p)
2508         {
2509           fli->started_p = 1;
2510
2511           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2512           put_mangled_filename (f, v->line.file);
2513           oprintf (f, "[] = {\n");
2514         }
2515
2516       oprintf (f, "  { &%s, 1, sizeof (%s), NULL },\n",
2517                v->name, v->name);
2518     }
2519
2520   finish_root_table (flp, "rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2521                      "gt_ggc_deletable_rtab");
2522
2523   for (v = variables; v; v = v->next)
2524     {
2525       outf_p f = get_output_file_with_visibility (v->line.file);
2526       struct flist *fli;
2527       const char *if_marked = NULL;
2528       int length_p = 0;
2529       options_p o;
2530
2531       for (o = v->opt; o; o = o->next)
2532         if (strcmp (o->name, "length") == 0)
2533           length_p = 1;
2534         else if (strcmp (o->name, "if_marked") == 0)
2535           if_marked = (const char *) o->info;
2536
2537       if (if_marked == NULL)
2538         continue;
2539
2540       if (v->type->kind != TYPE_POINTER
2541           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2542           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2543         {
2544           error_at_line (&v->line, "if_marked option used but not hash table");
2545           continue;
2546         }
2547
2548       for (fli = flp; fli; fli = fli->next)
2549         if (fli->f == f)
2550           break;
2551       if (! fli->started_p)
2552         {
2553           fli->started_p = 1;
2554
2555           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2556           put_mangled_filename (f, v->line.file);
2557           oprintf (f, "[] = {\n");
2558         }
2559
2560       write_gc_root (f, v, v->type->u.p->u.param_struct.param[0],
2561                      v->name, length_p, &v->line, if_marked);
2562     }
2563
2564   finish_root_table (flp, "rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2565                      "gt_ggc_cache_rtab");
2566 }
2567
2568 \f
2569 extern int main PARAMS ((int argc, char **argv));
2570 int
2571 main(argc, argv)
2572      int argc ATTRIBUTE_UNUSED;
2573      char **argv ATTRIBUTE_UNUSED;
2574 {
2575   unsigned i;
2576   static struct fileloc pos = { __FILE__, __LINE__ };
2577   unsigned j;
2578
2579   gen_rtx_next ();
2580
2581   srcdir_len = strlen (srcdir);
2582
2583   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2584   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2585   do_scalar_typedef ("uint8", &pos);
2586   do_scalar_typedef ("jword", &pos);
2587   do_scalar_typedef ("JCF_u2", &pos);
2588
2589   do_typedef ("PTR", create_pointer (create_scalar_type ("void",
2590                                                          strlen ("void"))),
2591               &pos);
2592   do_typedef ("HARD_REG_SET", create_array (
2593               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2594               "2"), &pos);
2595
2596   for (i = 0; i < NUM_GT_FILES; i++)
2597     {
2598       int dupflag = 0;
2599       /* Omit if already seen.  */
2600       for (j = 0; j < i; j++)
2601         {
2602           if (!strcmp (all_files[i], all_files[j]))
2603             {
2604               dupflag = 1;
2605               break;
2606             }
2607         }
2608       if (!dupflag)
2609         parse_file (all_files[i]);
2610     }
2611
2612   if (hit_error != 0)
2613     exit (1);
2614
2615   set_gc_used (variables);
2616
2617   open_base_files ();
2618   write_enum_defn (structures, param_structs);
2619   write_gc_types (structures, param_structs);
2620   write_gc_roots (variables);
2621   write_rtx_next ();
2622   close_output_files ();
2623
2624   return (hit_error != 0);
2625 }