gcc/gengtype.c

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