gcc/gengtype.c

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