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       "tree-alias-type.h", "tree-flow.h",
1104       NULL
1105     };
1106     const char *const *ifp;
1107     outf_p gtype_desc_c;
1108
1109     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
1110     for (ifp = ifiles; *ifp; ifp++)
1111       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
1112   }
1113 }
1114
1115 /* Determine the pathname to F relative to $(srcdir).  */
1116
1117 static const char *
1118 get_file_basename (const char *f)
1119 {
1120   const char *basename;
1121   unsigned i;
1122
1123   basename = strrchr (f, '/');
1124
1125   if (!basename)
1126     return f;
1127
1128   basename++;
1129
1130   for (i = 1; i < NUM_BASE_FILES; i++)
1131     {
1132       const char * s1;
1133       const char * s2;
1134       int l1;
1135       int l2;
1136       s1 = basename - strlen (lang_dir_names [i]) - 1;
1137       s2 = lang_dir_names [i];
1138       l1 = strlen (s1);
1139       l2 = strlen (s2);
1140       if (l1 >= l2 && !memcmp (s1, s2, l2))
1141         {
1142           basename -= l2 + 1;
1143           if ((basename - f - 1) != srcdir_len)
1144             abort (); /* Match is wrong - should be preceded by $srcdir.  */
1145           break;
1146         }
1147     }
1148
1149   return basename;
1150 }
1151
1152 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
1153    INPUT_FILE is used by <lang>.
1154
1155    This function should be written to assume that a file _is_ used
1156    if the situation is unclear.  If it wrongly assumes a file _is_ used,
1157    a linker error will result.  If it wrongly assumes a file _is not_ used,
1158    some GC roots may be missed, which is a much harder-to-debug problem.  */
1159
1160 unsigned
1161 get_base_file_bitmap (const char *input_file)
1162 {
1163   const char *basename = get_file_basename (input_file);
1164   const char *slashpos = strchr (basename, '/');
1165   unsigned j;
1166   unsigned k;
1167   unsigned bitmap;
1168
1169   if (slashpos)
1170     {
1171       size_t i;
1172       for (i = 1; i < NUM_BASE_FILES; i++)
1173         if ((size_t)(slashpos - basename) == strlen (lang_dir_names [i])
1174             && memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0)
1175           {
1176             /* It's in a language directory, set that language.  */
1177             bitmap = 1 << i;
1178             return bitmap;
1179           }
1180
1181       abort (); /* Should have found the language.  */
1182     }
1183
1184   /* If it's in any config-lang.in, then set for the languages
1185      specified.  */
1186
1187   bitmap = 0;
1188
1189   for (j = 0; j < NUM_LANG_FILES; j++)
1190     {
1191       if (!strcmp(input_file, lang_files[j]))
1192         {
1193           for (k = 0; k < NUM_BASE_FILES; k++)
1194             {
1195               if (!strcmp(lang_dir_names[k], langs_for_lang_files[j]))
1196                 bitmap |= (1 << k);
1197             }
1198         }
1199     }
1200
1201   /* Otherwise, set all languages.  */
1202   if (!bitmap)
1203     bitmap = (1 << NUM_BASE_FILES) - 1;
1204
1205   return bitmap;
1206 }
1207
1208 /* An output file, suitable for definitions, that can see declarations
1209    made in INPUT_FILE and is linked into every language that uses
1210    INPUT_FILE.  */
1211
1212 outf_p
1213 get_output_file_with_visibility (const char *input_file)
1214 {
1215   outf_p r;
1216   size_t len;
1217   const char *basename;
1218   const char *for_name;
1219   const char *output_name;
1220
1221   /* This can happen when we need a file with visibility on a
1222      structure that we've never seen.  We have to just hope that it's
1223      globally visible.  */
1224   if (input_file == NULL)
1225     input_file = "system.h";
1226
1227   /* Determine the output file name.  */
1228   basename = get_file_basename (input_file);
1229
1230   len = strlen (basename);
1231   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
1232       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
1233       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
1234     {
1235       char *s;
1236
1237       output_name = s = xasprintf ("gt-%s", basename);
1238       for (; *s != '.'; s++)
1239         if (! ISALNUM (*s) && *s != '-')
1240           *s = '-';
1241       memcpy (s, ".h", sizeof (".h"));
1242       for_name = basename;
1243     }
1244   else if (strcmp (basename, "c-common.h") == 0)
1245     output_name = "gt-c-common.h", for_name = "c-common.c";
1246   else if (strcmp (basename, "c-tree.h") == 0)
1247     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1248   else
1249     {
1250       size_t i;
1251
1252       for (i = 0; i < NUM_BASE_FILES; i++)
1253         if (memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0
1254             && basename[strlen(lang_dir_names[i])] == '/')
1255           return base_files[i];
1256
1257       output_name = "gtype-desc.c";
1258       for_name = NULL;
1259     }
1260
1261   /* Look through to see if we've ever seen this output filename before.  */
1262   for (r = output_files; r; r = r->next)
1263     if (strcmp (r->name, output_name) == 0)
1264       return r;
1265
1266   /* If not, create it.  */
1267   r = create_file (for_name, output_name);
1268
1269   return r;
1270 }
1271
1272 /* The name of an output file, suitable for definitions, that can see
1273    declarations made in INPUT_FILE and is linked into every language
1274    that uses INPUT_FILE.  */
1275
1276 const char *
1277 get_output_file_name (const char *input_file)
1278 {
1279   return get_output_file_with_visibility (input_file)->name;
1280 }
1281
1282 /* Copy the output to its final destination,
1283    but don't unnecessarily change modification times.  */
1284
1285 static void
1286 close_output_files (void)
1287 {
1288   outf_p of;
1289
1290   for (of = output_files; of; of = of->next)
1291     {
1292       FILE * newfile;
1293
1294       newfile = fopen (of->name, "r");
1295       if (newfile != NULL )
1296         {
1297           int no_write_p;
1298           size_t i;
1299
1300           for (i = 0; i < of->bufused; i++)
1301             {
1302               int ch;
1303               ch = fgetc (newfile);
1304               if (ch == EOF || ch != (unsigned char) of->buf[i])
1305                 break;
1306             }
1307           no_write_p = i == of->bufused && fgetc (newfile) == EOF;
1308           fclose (newfile);
1309
1310           if (no_write_p)
1311             continue;
1312         }
1313
1314       newfile = fopen (of->name, "w");
1315       if (newfile == NULL)
1316         {
1317           perror ("opening output file");
1318           exit (1);
1319         }
1320       if (fwrite (of->buf, 1, of->bufused, newfile) != of->bufused)
1321         {
1322           perror ("writing output file");
1323           exit (1);
1324         }
1325       if (fclose (newfile) != 0)
1326         {
1327           perror ("closing output file");
1328           exit (1);
1329         }
1330     }
1331 }
1332 \f
1333 struct flist {
1334   struct flist *next;
1335   int started_p;
1336   const char *name;
1337   outf_p f;
1338 };
1339
1340 struct walk_type_data;
1341
1342 /* For scalars and strings, given the item in 'val'.
1343    For structures, given a pointer to the item in 'val'.
1344    For misc. pointers, given the item in 'val'.
1345 */
1346 typedef void (*process_field_fn)
1347      (type_p f, const struct walk_type_data *p);
1348 typedef void (*func_name_fn)
1349      (type_p s, const struct walk_type_data *p);
1350
1351 /* Parameters for write_types.  */
1352
1353 struct write_types_data
1354 {
1355   const char *prefix;
1356   const char *param_prefix;
1357   const char *subfield_marker_routine;
1358   const char *marker_routine;
1359   const char *reorder_note_routine;
1360   const char *comment;
1361 };
1362
1363 static void output_escaped_param (struct walk_type_data *d,
1364                                   const char *, const char *);
1365 static void output_mangled_typename (outf_p, type_p);
1366 static void walk_type (type_p t, struct walk_type_data *d);
1367 static void write_func_for_structure
1368      (type_p orig_s, type_p s, type_p * param,
1369       const struct write_types_data *wtd);
1370 static void write_types_process_field
1371      (type_p f, const struct walk_type_data *d);
1372 static void write_types (type_p structures,
1373                          type_p param_structs,
1374                          const struct write_types_data *wtd);
1375 static void write_types_local_process_field
1376      (type_p f, const struct walk_type_data *d);
1377 static void write_local_func_for_structure
1378      (type_p orig_s, type_p s, type_p * param);
1379 static void write_local (type_p structures,
1380                          type_p param_structs);
1381 static void write_enum_defn (type_p structures, type_p param_structs);
1382 static int contains_scalar_p (type_p t);
1383 static void put_mangled_filename (outf_p , const char *);
1384 static void finish_root_table (struct flist *flp, const char *pfx,
1385                                const char *tname, const char *lastname,
1386                                const char *name);
1387 static void write_root (outf_p , pair_p, type_p, const char *, int,
1388                         struct fileloc *, const char *);
1389 static void write_array (outf_p f, pair_p v,
1390                          const struct write_types_data *wtd);
1391 static void write_roots (pair_p);
1392
1393 /* Parameters for walk_type.  */
1394
1395 struct walk_type_data
1396 {
1397   process_field_fn process_field;
1398   const void *cookie;
1399   outf_p of;
1400   options_p opt;
1401   const char *val;
1402   const char *prev_val[4];
1403   int indent;
1404   int counter;
1405   struct fileloc *line;
1406   lang_bitmap bitmap;
1407   type_p *param;
1408   int used_length;
1409   type_p orig_s;
1410   const char *reorder_fn;
1411   int needs_cast_p;
1412 };
1413
1414 /* Print a mangled name representing T to OF.  */
1415
1416 static void
1417 output_mangled_typename (outf_p of, type_p t)
1418 {
1419   if (t == NULL)
1420     oprintf (of, "Z");
1421   else switch (t->kind)
1422     {
1423     case TYPE_POINTER:
1424       oprintf (of, "P");
1425       output_mangled_typename (of, t->u.p);
1426       break;
1427     case TYPE_SCALAR:
1428       oprintf (of, "I");
1429       break;
1430     case TYPE_STRING:
1431       oprintf (of, "S");
1432       break;
1433     case TYPE_STRUCT:
1434     case TYPE_UNION:
1435     case TYPE_LANG_STRUCT:
1436       oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
1437       break;
1438     case TYPE_PARAM_STRUCT:
1439       {
1440         int i;
1441         for (i = 0; i < NUM_PARAM; i++)
1442           if (t->u.param_struct.param[i] != NULL)
1443             output_mangled_typename (of, t->u.param_struct.param[i]);
1444         output_mangled_typename (of, t->u.param_struct.stru);
1445       }
1446       break;
1447     case TYPE_ARRAY:
1448       abort ();
1449     }
1450 }
1451
1452 /* Print PARAM to D->OF processing escapes.  D->VAL references the
1453    current object, D->PREV_VAL the object containing the current
1454    object, ONAME is the name of the option and D->LINE is used to
1455    print error messages.  */
1456
1457 static void
1458 output_escaped_param (struct walk_type_data *d, const char *param,
1459                       const char *oname)
1460 {
1461   const char *p;
1462
1463   for (p = param; *p; p++)
1464     if (*p != '%')
1465       oprintf (d->of, "%c", *p);
1466     else switch (*++p)
1467       {
1468       case 'h':
1469         oprintf (d->of, "(%s)", d->prev_val[2]);
1470         break;
1471       case '0':
1472         oprintf (d->of, "(%s)", d->prev_val[0]);
1473         break;
1474       case '1':
1475         oprintf (d->of, "(%s)", d->prev_val[1]);
1476         break;
1477       case 'a':
1478         {
1479           const char *pp = d->val + strlen (d->val);
1480           while (pp[-1] == ']')
1481             while (*pp != '[')
1482               pp--;
1483           oprintf (d->of, "%s", pp);
1484         }
1485         break;
1486       default:
1487         error_at_line (d->line, "`%s' option contains bad escape %c%c",
1488                        oname, '%', *p);
1489       }
1490 }
1491
1492 /* Call D->PROCESS_FIELD for every field (or subfield) of D->VAL,
1493    which is of type T.  Write code to D->OF to constrain execution (at
1494    the point that D->PROCESS_FIELD is called) to the appropriate
1495    cases.  Call D->PROCESS_FIELD on subobjects before calling it on
1496    pointers to those objects.  D->PREV_VAL lists the objects
1497    containing the current object, D->OPT is a list of options to
1498    apply, D->INDENT is the current indentation level, D->LINE is used
1499    to print error messages, D->BITMAP indicates which languages to
1500    print the structure for, and D->PARAM is the current parameter
1501    (from an enclosing param_is option).  */
1502
1503 static void
1504 walk_type (type_p t, struct walk_type_data *d)
1505 {
1506   const char *length = NULL;
1507   const char *desc = NULL;
1508   int maybe_undef_p = 0;
1509   int use_param_num = -1;
1510   int use_params_p = 0;
1511   options_p oo;
1512
1513   d->needs_cast_p = 0;
1514   for (oo = d->opt; oo; oo = oo->next)
1515     if (strcmp (oo->name, "length") == 0)
1516       length = (const char *)oo->info;
1517     else if (strcmp (oo->name, "maybe_undef") == 0)
1518       maybe_undef_p = 1;
1519     else if (strncmp (oo->name, "use_param", 9) == 0
1520              && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1521       use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
1522     else if (strcmp (oo->name, "use_params") == 0)
1523       use_params_p = 1;
1524     else if (strcmp (oo->name, "desc") == 0)
1525       desc = (const char *)oo->info;
1526     else if (strcmp (oo->name, "dot") == 0)
1527       ;
1528     else if (strcmp (oo->name, "tag") == 0)
1529       ;
1530     else if (strcmp (oo->name, "special") == 0)
1531       ;
1532     else if (strcmp (oo->name, "skip") == 0)
1533       ;
1534     else if (strcmp (oo->name, "default") == 0)
1535       ;
1536     else if (strcmp (oo->name, "descbits") == 0)
1537       ;
1538     else if (strcmp (oo->name, "param_is") == 0)
1539       ;
1540     else if (strncmp (oo->name, "param", 5) == 0
1541              && ISDIGIT (oo->name[5])
1542              && strcmp (oo->name + 6, "_is") == 0)
1543       ;
1544     else if (strcmp (oo->name, "chain_next") == 0)
1545       ;
1546     else if (strcmp (oo->name, "chain_prev") == 0)
1547       ;
1548     else if (strcmp (oo->name, "reorder") == 0)
1549       ;
1550     else
1551       error_at_line (d->line, "unknown option `%s'\n", oo->name);
1552
1553   if (d->used_length)
1554     length = NULL;
1555
1556   if (use_params_p)
1557     {
1558       int pointer_p = t->kind == TYPE_POINTER;
1559
1560       if (pointer_p)
1561         t = t->u.p;
1562       if (! UNION_OR_STRUCT_P (t))
1563         error_at_line (d->line, "`use_params' option on unimplemented type");
1564       else
1565         t = find_param_structure (t, d->param);
1566       if (pointer_p)
1567         t = create_pointer (t);
1568     }
1569
1570   if (use_param_num != -1)
1571     {
1572       if (d->param != NULL && d->param[use_param_num] != NULL)
1573         {
1574           type_p nt = d->param[use_param_num];
1575
1576           if (t->kind == TYPE_ARRAY)
1577             nt = create_array (nt, t->u.a.len);
1578           else if (length != NULL && t->kind == TYPE_POINTER)
1579             nt = create_pointer (nt);
1580           d->needs_cast_p = (t->kind != TYPE_POINTER
1581                              && (nt->kind == TYPE_POINTER
1582                                  || nt->kind == TYPE_STRING));
1583           t = nt;
1584         }
1585       else
1586         error_at_line (d->line, "no parameter defined for `%s'",
1587                        d->val);
1588     }
1589
1590   if (maybe_undef_p
1591       && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
1592     {
1593       error_at_line (d->line,
1594                      "field `%s' has invalid option `maybe_undef_p'\n",
1595                      d->val);
1596       return;
1597     }
1598
1599   switch (t->kind)
1600     {
1601     case TYPE_SCALAR:
1602     case TYPE_STRING:
1603       d->process_field (t, d);
1604       break;
1605
1606     case TYPE_POINTER:
1607       {
1608         if (maybe_undef_p
1609             && t->u.p->u.s.line.file == NULL)
1610           {
1611             oprintf (d->of, "%*sif (%s) abort();\n", d->indent, "", d->val);
1612             break;
1613           }
1614
1615         if (! length)
1616           {
1617             if (! UNION_OR_STRUCT_P (t->u.p)
1618                 && t->u.p->kind != TYPE_PARAM_STRUCT)
1619               {
1620                 error_at_line (d->line,
1621                                "field `%s' is pointer to unimplemented type",
1622                                d->val);
1623                 break;
1624               }
1625
1626             d->process_field (t->u.p, d);
1627           }
1628         else
1629           {
1630             int loopcounter = d->counter++;
1631             const char *oldval = d->val;
1632             const char *oldprevval3 = d->prev_val[3];
1633             char *newval;
1634
1635             oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
1636             d->indent += 2;
1637             oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1638             oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1639                      loopcounter, loopcounter);
1640             output_escaped_param (d, length, "length");
1641             oprintf (d->of, "); i%d++) {\n", loopcounter);
1642             d->indent += 2;
1643             d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1644             d->used_length = 1;
1645             d->prev_val[3] = oldval;
1646             walk_type (t->u.p, d);
1647             free (newval);
1648             d->val = oldval;
1649             d->prev_val[3] = oldprevval3;
1650             d->used_length = 0;
1651             d->indent -= 2;
1652             oprintf (d->of, "%*s}\n", d->indent, "");
1653             d->process_field(t, d);
1654             d->indent -= 2;
1655             oprintf (d->of, "%*s}\n", d->indent, "");
1656           }
1657       }
1658       break;
1659
1660     case TYPE_ARRAY:
1661       {
1662         int loopcounter = d->counter++;
1663         const char *oldval = d->val;
1664         char *newval;
1665
1666         /* If it's an array of scalars, we optimize by not generating
1667            any code.  */
1668         if (t->u.a.p->kind == TYPE_SCALAR)
1669           break;
1670
1671         oprintf (d->of, "%*s{\n", d->indent, "");
1672         d->indent += 2;
1673         oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1674         oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1675                  loopcounter, loopcounter);
1676         if (length)
1677           output_escaped_param (d, length, "length");
1678         else
1679           oprintf (d->of, "%s", t->u.a.len);
1680         oprintf (d->of, "); i%d++) {\n", loopcounter);
1681         d->indent += 2;
1682         d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1683         d->used_length = 1;
1684         walk_type (t->u.a.p, d);
1685         free (newval);
1686         d->used_length = 0;
1687         d->val = oldval;
1688         d->indent -= 2;
1689         oprintf (d->of, "%*s}\n", d->indent, "");
1690         d->indent -= 2;
1691         oprintf (d->of, "%*s}\n", d->indent, "");
1692       }
1693       break;
1694
1695     case TYPE_STRUCT:
1696     case TYPE_UNION:
1697       {
1698         pair_p f;
1699         const char *oldval = d->val;
1700         const char *oldprevval1 = d->prev_val[1];
1701         const char *oldprevval2 = d->prev_val[2];
1702         const int union_p = t->kind == TYPE_UNION;
1703         int seen_default_p = 0;
1704         options_p o;
1705
1706         if (! t->u.s.line.file)
1707           error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
1708
1709         if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
1710           {
1711             error_at_line (d->line,
1712                            "structure `%s' defined for mismatching languages",
1713                            t->u.s.tag);
1714             error_at_line (&t->u.s.line, "one structure defined here");
1715           }
1716
1717         /* Some things may also be defined in the structure's options.  */
1718         for (o = t->u.s.opt; o; o = o->next)
1719           if (! desc && strcmp (o->name, "desc") == 0)
1720             desc = (const char *)o->info;
1721
1722         d->prev_val[2] = oldval;
1723         d->prev_val[1] = oldprevval2;
1724         if (union_p)
1725           {
1726             if (desc == NULL)
1727               {
1728                 error_at_line (d->line, "missing `desc' option for union `%s'",
1729                                t->u.s.tag);
1730                 desc = "1";
1731               }
1732             oprintf (d->of, "%*sswitch (", d->indent, "");
1733             output_escaped_param (d, desc, "desc");
1734             oprintf (d->of, ")\n");
1735             d->indent += 2;
1736             oprintf (d->of, "%*s{\n", d->indent, "");
1737           }
1738         for (f = t->u.s.fields; f; f = f->next)
1739           {
1740             options_p oo;
1741             const char *dot = ".";
1742             const char *tagid = NULL;
1743             int skip_p = 0;
1744             int default_p = 0;
1745             int use_param_p = 0;
1746             char *newval;
1747
1748             d->reorder_fn = NULL;
1749             for (oo = f->opt; oo; oo = oo->next)
1750               if (strcmp (oo->name, "dot") == 0)
1751                 dot = (const char *)oo->info;
1752               else if (strcmp (oo->name, "tag") == 0)
1753                 tagid = (const char *)oo->info;
1754               else if (strcmp (oo->name, "skip") == 0)
1755                 skip_p = 1;
1756               else if (strcmp (oo->name, "default") == 0)
1757                 default_p = 1;
1758               else if (strcmp (oo->name, "reorder") == 0)
1759                 d->reorder_fn = (const char *)oo->info;
1760               else if (strncmp (oo->name, "use_param", 9) == 0
1761                        && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1762                 use_param_p = 1;
1763
1764             if (skip_p)
1765               continue;
1766
1767             if (union_p && tagid)
1768               {
1769                 oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
1770                 d->indent += 2;
1771               }
1772             else if (union_p && default_p)
1773               {
1774                 oprintf (d->of, "%*sdefault:\n", d->indent, "");
1775                 d->indent += 2;
1776                 seen_default_p = 1;
1777               }
1778             else if (! union_p && (default_p || tagid))
1779               error_at_line (d->line,
1780                              "can't use `%s' outside a union on field `%s'",
1781                              default_p ? "default" : "tag", f->name);
1782             else if (union_p && ! (default_p || tagid)
1783                      && f->type->kind == TYPE_SCALAR)
1784               {
1785                 fprintf (stderr,
1786         "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
1787                          d->line->file, d->line->line, f->name);
1788                 continue;
1789               }
1790             else if (union_p && ! (default_p || tagid))
1791               error_at_line (d->line,
1792                              "field `%s' is missing `tag' or `default' option",
1793                              f->name);
1794
1795             d->line = &f->line;
1796             d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
1797             d->opt = f->opt;
1798
1799             if (union_p && use_param_p && d->param == NULL)
1800               oprintf (d->of, "%*sabort();\n", d->indent, "");
1801             else
1802               walk_type (f->type, d);
1803
1804             free (newval);
1805
1806             if (union_p)
1807               {
1808                 oprintf (d->of, "%*sbreak;\n", d->indent, "");
1809                 d->indent -= 2;
1810               }
1811           }
1812         d->reorder_fn = NULL;
1813
1814         d->val = oldval;
1815         d->prev_val[1] = oldprevval1;
1816         d->prev_val[2] = oldprevval2;
1817
1818         if (union_p && ! seen_default_p)
1819           {
1820             oprintf (d->of, "%*sdefault:\n", d->indent, "");
1821             oprintf (d->of, "%*s  break;\n", d->indent, "");
1822           }
1823         if (union_p)
1824           {
1825             oprintf (d->of, "%*s}\n", d->indent, "");
1826             d->indent -= 2;
1827           }
1828       }
1829       break;
1830
1831     case TYPE_LANG_STRUCT:
1832       {
1833         type_p nt;
1834         for (nt = t->u.s.lang_struct; nt; nt = nt->next)
1835           if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
1836             break;
1837         if (nt == NULL)
1838           error_at_line (d->line, "structure `%s' differs between languages",
1839                          t->u.s.tag);
1840         else
1841           walk_type (nt, d);
1842       }
1843       break;
1844
1845     case TYPE_PARAM_STRUCT:
1846       {
1847         type_p *oldparam = d->param;
1848
1849         d->param = t->u.param_struct.param;
1850         walk_type (t->u.param_struct.stru, d);
1851         d->param = oldparam;
1852       }
1853       break;
1854
1855     default:
1856       abort ();
1857     }
1858 }
1859
1860 /* process_field routine for marking routines.  */
1861
1862 static void
1863 write_types_process_field (type_p f, const struct walk_type_data *d)
1864 {
1865   const struct write_types_data *wtd;
1866   const char *cast = d->needs_cast_p ? "(void *)" : "";
1867   wtd = (const struct write_types_data *) d->cookie;
1868
1869   switch (f->kind)
1870     {
1871     case TYPE_POINTER:
1872       oprintf (d->of, "%*s%s (%s%s", d->indent, "",
1873                wtd->subfield_marker_routine, cast, d->val);
1874       if (wtd->param_prefix)
1875         {
1876           oprintf (d->of, ", %s", d->prev_val[3]);
1877           if (d->orig_s)
1878             {
1879               oprintf (d->of, ", gt_%s_", wtd->param_prefix);
1880               output_mangled_typename (d->of, d->orig_s);
1881             }
1882           else
1883             oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
1884         }
1885       oprintf (d->of, ");\n");
1886       if (d->reorder_fn && wtd->reorder_note_routine)
1887         oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
1888                  wtd->reorder_note_routine, cast, d->val,
1889                  d->prev_val[3], d->reorder_fn);
1890       break;
1891
1892     case TYPE_STRING:
1893       if (wtd->param_prefix == NULL)
1894         break;
1895
1896     case TYPE_STRUCT:
1897     case TYPE_UNION:
1898     case TYPE_LANG_STRUCT:
1899     case TYPE_PARAM_STRUCT:
1900       oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
1901       output_mangled_typename (d->of, f);
1902       oprintf (d->of, " (%s%s);\n", cast, d->val);
1903       if (d->reorder_fn && wtd->reorder_note_routine)
1904         oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
1905                  wtd->reorder_note_routine, cast, d->val, cast, d->val,
1906                  d->reorder_fn);
1907       break;
1908
1909     case TYPE_SCALAR:
1910       break;
1911
1912     default:
1913       abort ();
1914     }
1915 }
1916
1917 /* For S, a structure that's part of ORIG_S, and using parameters
1918    PARAM, write out a routine that:
1919    - Takes a parameter, a void * but actually of type *S
1920    - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
1921      field of S or its substructures and (in some cases) things
1922      that are pointed to by S.
1923 */
1924
1925 static void
1926 write_func_for_structure (type_p orig_s, type_p s, type_p *param,
1927                           const struct write_types_data *wtd)
1928 {
1929   const char *fn = s->u.s.line.file;
1930   int i;
1931   const char *chain_next = NULL;
1932   const char *chain_prev = NULL;
1933   options_p opt;
1934   struct walk_type_data d;
1935
1936   /* This is a hack, and not the good kind either.  */
1937   for (i = NUM_PARAM - 1; i >= 0; i--)
1938     if (param && param[i] && param[i]->kind == TYPE_POINTER
1939         && UNION_OR_STRUCT_P (param[i]->u.p))
1940       fn = param[i]->u.p->u.s.line.file;
1941
1942   memset (&d, 0, sizeof (d));
1943   d.of = get_output_file_with_visibility (fn);
1944
1945   for (opt = s->u.s.opt; opt; opt = opt->next)
1946     if (strcmp (opt->name, "chain_next") == 0)
1947       chain_next = (const char *) opt->info;
1948     else if (strcmp (opt->name, "chain_prev") == 0)
1949       chain_prev = (const char *) opt->info;
1950
1951   if (chain_prev != NULL && chain_next == NULL)
1952     error_at_line (&s->u.s.line, "chain_prev without chain_next");
1953
1954   d.process_field = write_types_process_field;
1955   d.cookie = wtd;
1956   d.orig_s = orig_s;
1957   d.opt = s->u.s.opt;
1958   d.line = &s->u.s.line;
1959   d.bitmap = s->u.s.bitmap;
1960   d.param = param;
1961   d.prev_val[0] = "*x";
1962   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
1963   d.prev_val[3] = "x";
1964   d.val = "(*x)";
1965
1966   oprintf (d.of, "\n");
1967   oprintf (d.of, "void\n");
1968   if (param == NULL)
1969     oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
1970   else
1971     {
1972       oprintf (d.of, "gt_%s_", wtd->prefix);
1973       output_mangled_typename (d.of, orig_s);
1974     }
1975   oprintf (d.of, " (void *x_p)\n");
1976   oprintf (d.of, "{\n");
1977   oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
1978            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1979            chain_next == NULL ? "const " : "",
1980            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1981   if (chain_next != NULL)
1982     oprintf (d.of, "  %s %s * xlimit = x;\n",
1983              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1984   if (chain_next == NULL)
1985     {
1986       oprintf (d.of, "  if (%s (x", wtd->marker_routine);
1987       if (wtd->param_prefix)
1988         {
1989           oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
1990           output_mangled_typename (d.of, orig_s);
1991         }
1992       oprintf (d.of, "))\n");
1993     }
1994   else
1995     {
1996       oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
1997       if (wtd->param_prefix)
1998         {
1999           oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
2000           output_mangled_typename (d.of, orig_s);
2001         }
2002       oprintf (d.of, "))\n");
2003       oprintf (d.of, "   xlimit = (");
2004       d.prev_val[2] = "*xlimit";
2005       output_escaped_param (&d, chain_next, "chain_next");
2006       oprintf (d.of, ");\n");
2007       if (chain_prev != NULL)
2008         {
2009           oprintf (d.of, "  if (x != xlimit)\n");
2010           oprintf (d.of, "    for (;;)\n");
2011           oprintf (d.of, "      {\n");
2012           oprintf (d.of, "        %s %s * const xprev = (",
2013                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2014
2015           d.prev_val[2] = "*x";
2016           output_escaped_param (&d, chain_prev, "chain_prev");
2017           oprintf (d.of, ");\n");
2018           oprintf (d.of, "        if (xprev == NULL) break;\n");
2019           oprintf (d.of, "        x = xprev;\n");
2020           oprintf (d.of, "        (void) %s (xprev",
2021                    wtd->marker_routine);
2022           if (wtd->param_prefix)
2023             {
2024               oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
2025               output_mangled_typename (d.of, orig_s);
2026             }
2027           oprintf (d.of, ");\n");
2028           oprintf (d.of, "      }\n");
2029         }
2030       oprintf (d.of, "  while (x != xlimit)\n");
2031     }
2032   oprintf (d.of, "    {\n");
2033
2034   d.prev_val[2] = "*x";
2035   d.indent = 6;
2036   walk_type (s, &d);
2037
2038   if (chain_next != NULL)
2039     {
2040       oprintf (d.of, "      x = (");
2041       output_escaped_param (&d, chain_next, "chain_next");
2042       oprintf (d.of, ");\n");
2043     }
2044
2045   oprintf (d.of, "    }\n");
2046   oprintf (d.of, "}\n");
2047 }
2048
2049 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
2050
2051 static void
2052 write_types (type_p structures, type_p param_structs,
2053              const struct write_types_data *wtd)
2054 {
2055   type_p s;
2056
2057   oprintf (header_file, "\n/* %s*/\n", wtd->comment);
2058   for (s = structures; s; s = s->next)
2059     if (s->gc_used == GC_POINTED_TO
2060         || s->gc_used == GC_MAYBE_POINTED_TO)
2061       {
2062         options_p opt;
2063
2064         if (s->gc_used == GC_MAYBE_POINTED_TO
2065             && s->u.s.line.file == NULL)
2066           continue;
2067
2068         oprintf (header_file, "#define gt_%s_", wtd->prefix);
2069         output_mangled_typename (header_file, s);
2070         oprintf (header_file, "(X) do { \\\n");
2071         oprintf (header_file,
2072                  "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
2073                  s->u.s.tag);
2074         oprintf (header_file,
2075                  "  } while (0)\n");
2076
2077         for (opt = s->u.s.opt; opt; opt = opt->next)
2078           if (strcmp (opt->name, "ptr_alias") == 0)
2079             {
2080               type_p t = (type_p) opt->info;
2081               if (t->kind == TYPE_STRUCT
2082                   || t->kind == TYPE_UNION
2083                   || t->kind == TYPE_LANG_STRUCT)
2084                 oprintf (header_file,
2085                          "#define gt_%sx_%s gt_%sx_%s\n",
2086                          wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
2087               else
2088                 error_at_line (&s->u.s.line,
2089                                "structure alias is not a structure");
2090               break;
2091             }
2092         if (opt)
2093           continue;
2094
2095         /* Declare the marker procedure only once.  */
2096         oprintf (header_file,
2097                  "extern void gt_%sx_%s (void *);\n",
2098                  wtd->prefix, s->u.s.tag);
2099
2100         if (s->u.s.line.file == NULL)
2101           {
2102             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2103                      s->u.s.tag);
2104             continue;
2105           }
2106
2107         if (s->kind == TYPE_LANG_STRUCT)
2108           {
2109             type_p ss;
2110             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2111               write_func_for_structure (s, ss, NULL, wtd);
2112           }
2113         else
2114           write_func_for_structure (s, s, NULL, wtd);
2115       }
2116
2117   for (s = param_structs; s; s = s->next)
2118     if (s->gc_used == GC_POINTED_TO)
2119       {
2120         type_p * param = s->u.param_struct.param;
2121         type_p stru = s->u.param_struct.stru;
2122
2123         /* Declare the marker procedure.  */
2124         oprintf (header_file, "extern void gt_%s_", wtd->prefix);
2125         output_mangled_typename (header_file, s);
2126         oprintf (header_file, " (void *);\n");
2127
2128         if (stru->u.s.line.file == NULL)
2129           {
2130             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2131                      s->u.s.tag);
2132             continue;
2133           }
2134
2135         if (stru->kind == TYPE_LANG_STRUCT)
2136           {
2137             type_p ss;
2138             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2139               write_func_for_structure (s, ss, param, wtd);
2140           }
2141         else
2142           write_func_for_structure (s, stru, param, wtd);
2143       }
2144 }
2145
2146 static const struct write_types_data ggc_wtd =
2147 {
2148   "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
2149   "GC marker procedures.  "
2150 };
2151
2152 static const struct write_types_data pch_wtd =
2153 {
2154   "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
2155   "gt_pch_note_reorder",
2156   "PCH type-walking procedures.  "
2157 };
2158
2159 /* Write out the local pointer-walking routines.  */
2160
2161 /* process_field routine for local pointer-walking.  */
2162
2163 static void
2164 write_types_local_process_field (type_p f, const struct walk_type_data *d)
2165 {
2166   switch (f->kind)
2167     {
2168     case TYPE_POINTER:
2169     case TYPE_STRUCT:
2170     case TYPE_UNION:
2171     case TYPE_LANG_STRUCT:
2172     case TYPE_PARAM_STRUCT:
2173     case TYPE_STRING:
2174       oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
2175                d->prev_val[3]);
2176       oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
2177       break;
2178
2179     case TYPE_SCALAR:
2180       break;
2181
2182     default:
2183       abort ();
2184     }
2185 }
2186
2187 /* For S, a structure that's part of ORIG_S, and using parameters
2188    PARAM, write out a routine that:
2189    - Is of type gt_note_pointers
2190    - If calls PROCESS_FIELD on each field of S or its substructures.
2191 */
2192
2193 static void
2194 write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
2195 {
2196   const char *fn = s->u.s.line.file;
2197   int i;
2198   struct walk_type_data d;
2199
2200   /* This is a hack, and not the good kind either.  */
2201   for (i = NUM_PARAM - 1; i >= 0; i--)
2202     if (param && param[i] && param[i]->kind == TYPE_POINTER
2203         && UNION_OR_STRUCT_P (param[i]->u.p))
2204       fn = param[i]->u.p->u.s.line.file;
2205
2206   memset (&d, 0, sizeof (d));
2207   d.of = get_output_file_with_visibility (fn);
2208
2209   d.process_field = write_types_local_process_field;
2210   d.opt = s->u.s.opt;
2211   d.line = &s->u.s.line;
2212   d.bitmap = s->u.s.bitmap;
2213   d.param = param;
2214   d.prev_val[0] = d.prev_val[2] = "*x";
2215   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2216   d.prev_val[3] = "x";
2217   d.val = "(*x)";
2218
2219   oprintf (d.of, "\n");
2220   oprintf (d.of, "void\n");
2221   oprintf (d.of, "gt_pch_p_");
2222   output_mangled_typename (d.of, orig_s);
2223   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");
2224   oprintf (d.of, "{\n");
2225   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2226            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2227            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2228   d.indent = 2;
2229   walk_type (s, &d);
2230   oprintf (d.of, "}\n");
2231 }
2232
2233 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2234
2235 static void
2236 write_local (type_p structures, type_p param_structs)
2237 {
2238   type_p s;
2239
2240   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2241   for (s = structures; s; s = s->next)
2242     if (s->gc_used == GC_POINTED_TO
2243         || s->gc_used == GC_MAYBE_POINTED_TO)
2244       {
2245         options_p opt;
2246
2247         if (s->u.s.line.file == NULL)
2248           continue;
2249
2250         for (opt = s->u.s.opt; opt; opt = opt->next)
2251           if (strcmp (opt->name, "ptr_alias") == 0)
2252             {
2253               type_p t = (type_p) opt->info;
2254               if (t->kind == TYPE_STRUCT
2255                   || t->kind == TYPE_UNION
2256                   || t->kind == TYPE_LANG_STRUCT)
2257                 {
2258                   oprintf (header_file, "#define gt_pch_p_");
2259                   output_mangled_typename (header_file, s);
2260                   oprintf (header_file, " gt_pch_p_");
2261                   output_mangled_typename (header_file, t);
2262                   oprintf (header_file, "\n");
2263                 }
2264               else
2265                 error_at_line (&s->u.s.line,
2266                                "structure alias is not a structure");
2267               break;
2268             }
2269         if (opt)
2270           continue;
2271
2272         /* Declare the marker procedure only once.  */
2273         oprintf (header_file, "extern void gt_pch_p_");
2274         output_mangled_typename (header_file, s);
2275         oprintf (header_file,
2276          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2277
2278         if (s->kind == TYPE_LANG_STRUCT)
2279           {
2280             type_p ss;
2281             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2282               write_local_func_for_structure (s, ss, NULL);
2283           }
2284         else
2285           write_local_func_for_structure (s, s, NULL);
2286       }
2287
2288   for (s = param_structs; s; s = s->next)
2289     if (s->gc_used == GC_POINTED_TO)
2290       {
2291         type_p * param = s->u.param_struct.param;
2292         type_p stru = s->u.param_struct.stru;
2293
2294         /* Declare the marker procedure.  */
2295         oprintf (header_file, "extern void gt_pch_p_");
2296         output_mangled_typename (header_file, s);
2297         oprintf (header_file,
2298          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2299
2300         if (stru->u.s.line.file == NULL)
2301           {
2302             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2303                      s->u.s.tag);
2304             continue;
2305           }
2306
2307         if (stru->kind == TYPE_LANG_STRUCT)
2308           {
2309             type_p ss;
2310             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2311               write_local_func_for_structure (s, ss, param);
2312           }
2313         else
2314           write_local_func_for_structure (s, stru, param);
2315       }
2316 }
2317
2318 /* Write out the 'enum' definition for gt_types_enum.  */
2319
2320 static void
2321 write_enum_defn (type_p structures, type_p param_structs)
2322 {
2323   type_p s;
2324
2325   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2326   oprintf (header_file, "enum gt_types_enum {\n");
2327   for (s = structures; s; s = s->next)
2328     if (s->gc_used == GC_POINTED_TO
2329         || s->gc_used == GC_MAYBE_POINTED_TO)
2330       {
2331         if (s->gc_used == GC_MAYBE_POINTED_TO
2332             && s->u.s.line.file == NULL)
2333           continue;
2334
2335         oprintf (header_file, " gt_ggc_e_");
2336         output_mangled_typename (header_file, s);
2337         oprintf (header_file, ", \n");
2338       }
2339   for (s = param_structs; s; s = s->next)
2340     if (s->gc_used == GC_POINTED_TO)
2341       {
2342         oprintf (header_file, " gt_e_");
2343         output_mangled_typename (header_file, s);
2344         oprintf (header_file, ", \n");
2345       }
2346   oprintf (header_file, " gt_types_enum_last\n");
2347   oprintf (header_file, "};\n");
2348 }
2349
2350 /* Might T contain any non-pointer elements?  */
2351
2352 static int
2353 contains_scalar_p (type_p t)
2354 {
2355   switch (t->kind)
2356     {
2357     case TYPE_STRING:
2358     case TYPE_POINTER:
2359       return 0;
2360     case TYPE_ARRAY:
2361       return contains_scalar_p (t->u.a.p);
2362     default:
2363       /* Could also check for structures that have no non-pointer
2364          fields, but there aren't enough of those to worry about.  */
2365       return 1;
2366     }
2367 }
2368
2369 /* Mangle FN and print it to F.  */
2370
2371 static void
2372 put_mangled_filename (outf_p f, const char *fn)
2373 {
2374   const char *name = get_output_file_name (fn);
2375   for (; *name != 0; name++)
2376     if (ISALNUM (*name))
2377       oprintf (f, "%c", *name);
2378     else
2379       oprintf (f, "%c", '_');
2380 }
2381
2382 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2383    LASTNAME, and NAME are all strings to insert in various places in
2384    the resulting code.  */
2385
2386 static void
2387 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2388                    const char *tname, const char *name)
2389 {
2390   struct flist *fli2;
2391
2392   for (fli2 = flp; fli2; fli2 = fli2->next)
2393     if (fli2->started_p)
2394       {
2395         oprintf (fli2->f, "  %s\n", lastname);
2396         oprintf (fli2->f, "};\n\n");
2397       }
2398
2399   for (fli2 = flp; fli2; fli2 = fli2->next)
2400     if (fli2->started_p)
2401       {
2402         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2403         int fnum;
2404
2405         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2406           if (bitmap & 1)
2407             {
2408               oprintf (base_files[fnum],
2409                        "extern const struct %s gt_%s_",
2410                        tname, pfx);
2411               put_mangled_filename (base_files[fnum], fli2->name);
2412               oprintf (base_files[fnum], "[];\n");
2413             }
2414       }
2415
2416   {
2417     size_t fnum;
2418     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2419       oprintf (base_files [fnum],
2420                "const struct %s * const %s[] = {\n",
2421                tname, name);
2422   }
2423
2424
2425   for (fli2 = flp; fli2; fli2 = fli2->next)
2426     if (fli2->started_p)
2427       {
2428         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2429         int fnum;
2430
2431         fli2->started_p = 0;
2432
2433         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2434           if (bitmap & 1)
2435             {
2436               oprintf (base_files[fnum], "  gt_%s_", pfx);
2437               put_mangled_filename (base_files[fnum], fli2->name);
2438               oprintf (base_files[fnum], ",\n");
2439             }
2440       }
2441
2442   {
2443     size_t fnum;
2444     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2445       {
2446         oprintf (base_files[fnum], "  NULL\n");
2447         oprintf (base_files[fnum], "};\n");
2448       }
2449   }
2450 }
2451
2452 /* Write out to F the table entry and any marker routines needed to
2453    mark NAME as TYPE.  The original variable is V, at LINE.
2454    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2455    is nonzero iff we are building the root table for hash table caches.  */
2456
2457 static void
2458 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2459             struct fileloc *line, const char *if_marked)
2460 {
2461   switch (type->kind)
2462     {
2463     case TYPE_STRUCT:
2464       {
2465         pair_p fld;
2466         for (fld = type->u.s.fields; fld; fld = fld->next)
2467           {
2468             int skip_p = 0;
2469             const char *desc = NULL;
2470             options_p o;
2471
2472             for (o = fld->opt; o; o = o->next)
2473               if (strcmp (o->name, "skip") == 0)
2474                 skip_p = 1;
2475               else if (strcmp (o->name, "desc") == 0)
2476                 desc = (const char *)o->info;
2477               else
2478                 error_at_line (line,
2479                        "field `%s' of global `%s' has unknown option `%s'",
2480                                fld->name, name, o->name);
2481
2482             if (skip_p)
2483               continue;
2484             else if (desc && fld->type->kind == TYPE_UNION)
2485               {
2486                 pair_p validf = NULL;
2487                 pair_p ufld;
2488
2489                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2490                   {
2491                     const char *tag = NULL;
2492                     options_p oo;
2493
2494                     for (oo = ufld->opt; oo; oo = oo->next)
2495                       if (strcmp (oo->name, "tag") == 0)
2496                         tag = (const char *)oo->info;
2497                     if (tag == NULL || strcmp (tag, desc) != 0)
2498                       continue;
2499                     if (validf != NULL)
2500                       error_at_line (line,
2501                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2502                                      name, fld->name, validf->name,
2503                                      name, fld->name, ufld->name,
2504                                      tag);
2505                     validf = ufld;
2506                   }
2507                 if (validf != NULL)
2508                   {
2509                     char *newname;
2510                     newname = xasprintf ("%s.%s.%s",
2511                                          name, fld->name, validf->name);
2512                     write_root (f, v, validf->type, newname, 0, line,
2513                                 if_marked);
2514                     free (newname);
2515                   }
2516               }
2517             else if (desc)
2518               error_at_line (line,
2519                      "global `%s.%s' has `desc' option but is not union",
2520                              name, fld->name);
2521             else
2522               {
2523                 char *newname;
2524                 newname = xasprintf ("%s.%s", name, fld->name);
2525                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2526                 free (newname);
2527               }
2528           }
2529       }
2530       break;
2531
2532     case TYPE_ARRAY:
2533       {
2534         char *newname;
2535         newname = xasprintf ("%s[0]", name);
2536         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2537         free (newname);
2538       }
2539       break;
2540
2541     case TYPE_POINTER:
2542       {
2543         type_p ap, tp;
2544
2545         oprintf (f, "  {\n");
2546         oprintf (f, "    &%s,\n", name);
2547         oprintf (f, "    1");
2548
2549         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2550           if (ap->u.a.len[0])
2551             oprintf (f, " * (%s)", ap->u.a.len);
2552           else if (ap == v->type)
2553             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2554         oprintf (f, ",\n");
2555         oprintf (f, "    sizeof (%s", v->name);
2556         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2557           oprintf (f, "[0]");
2558         oprintf (f, "),\n");
2559
2560         tp = type->u.p;
2561
2562         if (! has_length && UNION_OR_STRUCT_P (tp))
2563           {
2564             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2565             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2566           }
2567         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2568           {
2569             oprintf (f, "    &gt_ggc_m_");
2570             output_mangled_typename (f, tp);
2571             oprintf (f, ",\n    &gt_pch_n_");
2572             output_mangled_typename (f, tp);
2573           }
2574         else if (has_length
2575                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2576           {
2577             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2578             oprintf (f, "    &gt_pch_na_%s", name);
2579           }
2580         else
2581           {
2582             error_at_line (line,
2583                            "global `%s' is pointer to unimplemented type",
2584                            name);
2585           }
2586         if (if_marked)
2587           oprintf (f, ",\n    &%s", if_marked);
2588         oprintf (f, "\n  },\n");
2589       }
2590       break;
2591
2592     case TYPE_STRING:
2593       {
2594         oprintf (f, "  {\n");
2595         oprintf (f, "    &%s,\n", name);
2596         oprintf (f, "    1, \n");
2597         oprintf (f, "    sizeof (%s),\n", v->name);
2598         oprintf (f, "    &gt_ggc_m_S,\n");
2599         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2600         oprintf (f, "  },\n");
2601       }
2602       break;
2603
2604     case TYPE_SCALAR:
2605       break;
2606
2607     default:
2608       error_at_line (line,
2609                      "global `%s' is unimplemented type",
2610                      name);
2611     }
2612 }
2613
2614 /* This generates a routine to walk an array.  */
2615
2616 static void
2617 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2618 {
2619   struct walk_type_data d;
2620   char *prevval3;
2621
2622   memset (&d, 0, sizeof (d));
2623   d.of = f;
2624   d.cookie = wtd;
2625   d.indent = 2;
2626   d.line = &v->line;
2627   d.opt = v->opt;
2628   d.bitmap = get_base_file_bitmap (v->line.file);
2629   d.param = NULL;
2630
2631   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2632
2633   if (wtd->param_prefix)
2634     {
2635       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2636       oprintf (f,
2637        "    (void *, void *, gt_pointer_operator, void *);\n");
2638       oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
2639                wtd->param_prefix, v->name);
2640       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
2641       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
2642       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
2643       oprintf (d.of, "{\n");
2644       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2645       d.process_field = write_types_local_process_field;
2646       walk_type (v->type, &d);
2647       oprintf (f, "}\n\n");
2648     }
2649
2650   d.opt = v->opt;
2651   oprintf (f, "static void gt_%sa_%s (void *);\n",
2652            wtd->prefix, v->name);
2653   oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
2654            wtd->prefix, v->name);
2655   oprintf (f, "{\n");
2656   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2657   d.process_field = write_types_process_field;
2658   walk_type (v->type, &d);
2659   free (prevval3);
2660   oprintf (f, "}\n\n");
2661 }
2662
2663 /* Output a table describing the locations and types of VARIABLES.  */
2664
2665 static void
2666 write_roots (pair_p variables)
2667 {
2668   pair_p v;
2669   struct flist *flp = NULL;
2670
2671   for (v = variables; v; v = v->next)
2672     {
2673       outf_p f = get_output_file_with_visibility (v->line.file);
2674       struct flist *fli;
2675       const char *length = NULL;
2676       int deletable_p = 0;
2677       options_p o;
2678
2679       for (o = v->opt; o; o = o->next)
2680         if (strcmp (o->name, "length") == 0)
2681           length = (const char *)o->info;
2682         else if (strcmp (o->name, "deletable") == 0)
2683           deletable_p = 1;
2684         else if (strcmp (o->name, "param_is") == 0)
2685           ;
2686         else if (strncmp (o->name, "param", 5) == 0
2687                  && ISDIGIT (o->name[5])
2688                  && strcmp (o->name + 6, "_is") == 0)
2689           ;
2690         else if (strcmp (o->name, "if_marked") == 0)
2691           ;
2692         else
2693           error_at_line (&v->line,
2694                          "global `%s' has unknown option `%s'",
2695                          v->name, o->name);
2696
2697       for (fli = flp; fli; fli = fli->next)
2698         if (fli->f == f)
2699           break;
2700       if (fli == NULL)
2701         {
2702           fli = xmalloc (sizeof (*fli));
2703           fli->f = f;
2704           fli->next = flp;
2705           fli->started_p = 0;
2706           fli->name = v->line.file;
2707           flp = fli;
2708
2709           oprintf (f, "\n/* GC roots.  */\n\n");
2710         }
2711
2712       if (! deletable_p
2713           && length
2714           && v->type->kind == TYPE_POINTER
2715           && (v->type->u.p->kind == TYPE_POINTER
2716               || v->type->u.p->kind == TYPE_STRUCT))
2717         {
2718           write_array (f, v, &ggc_wtd);
2719           write_array (f, v, &pch_wtd);
2720         }
2721     }
2722
2723   for (v = variables; v; v = v->next)
2724     {
2725       outf_p f = get_output_file_with_visibility (v->line.file);
2726       struct flist *fli;
2727       int skip_p = 0;
2728       int length_p = 0;
2729       options_p o;
2730
2731       for (o = v->opt; o; o = o->next)
2732         if (strcmp (o->name, "length") == 0)
2733           length_p = 1;
2734         else if (strcmp (o->name, "deletable") == 0
2735                  || strcmp (o->name, "if_marked") == 0)
2736           skip_p = 1;
2737
2738       if (skip_p)
2739         continue;
2740
2741       for (fli = flp; fli; fli = fli->next)
2742         if (fli->f == f)
2743           break;
2744       if (! fli->started_p)
2745         {
2746           fli->started_p = 1;
2747
2748           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2749           put_mangled_filename (f, v->line.file);
2750           oprintf (f, "[] = {\n");
2751         }
2752
2753       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2754     }
2755
2756   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2757                      "gt_ggc_rtab");
2758
2759   for (v = variables; v; v = v->next)
2760     {
2761       outf_p f = get_output_file_with_visibility (v->line.file);
2762       struct flist *fli;
2763       int skip_p = 1;
2764       options_p o;
2765
2766       for (o = v->opt; o; o = o->next)
2767         if (strcmp (o->name, "deletable") == 0)
2768           skip_p = 0;
2769         else if (strcmp (o->name, "if_marked") == 0)
2770           skip_p = 1;
2771
2772       if (skip_p)
2773         continue;
2774
2775       for (fli = flp; fli; fli = fli->next)
2776         if (fli->f == f)
2777           break;
2778       if (! fli->started_p)
2779         {
2780           fli->started_p = 1;
2781
2782           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2783           put_mangled_filename (f, v->line.file);
2784           oprintf (f, "[] = {\n");
2785         }
2786
2787       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2788                v->name, v->name);
2789     }
2790
2791   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2792                      "gt_ggc_deletable_rtab");
2793
2794   for (v = variables; v; v = v->next)
2795     {
2796       outf_p f = get_output_file_with_visibility (v->line.file);
2797       struct flist *fli;
2798       const char *if_marked = NULL;
2799       int length_p = 0;
2800       options_p o;
2801
2802       for (o = v->opt; o; o = o->next)
2803         if (strcmp (o->name, "length") == 0)
2804           length_p = 1;
2805         else if (strcmp (o->name, "if_marked") == 0)
2806           if_marked = (const char *) o->info;
2807
2808       if (if_marked == NULL)
2809         continue;
2810
2811       if (v->type->kind != TYPE_POINTER
2812           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2813           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2814         {
2815           error_at_line (&v->line, "if_marked option used but not hash table");
2816           continue;
2817         }
2818
2819       for (fli = flp; fli; fli = fli->next)
2820         if (fli->f == f)
2821           break;
2822       if (! fli->started_p)
2823         {
2824           fli->started_p = 1;
2825
2826           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2827           put_mangled_filename (f, v->line.file);
2828           oprintf (f, "[] = {\n");
2829         }
2830
2831       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2832                      v->name, length_p, &v->line, if_marked);
2833     }
2834
2835   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2836                      "gt_ggc_cache_rtab");
2837
2838   for (v = variables; v; v = v->next)
2839     {
2840       outf_p f = get_output_file_with_visibility (v->line.file);
2841       struct flist *fli;
2842       int length_p = 0;
2843       int if_marked_p = 0;
2844       options_p o;
2845
2846       for (o = v->opt; o; o = o->next)
2847         if (strcmp (o->name, "length") == 0)
2848           length_p = 1;
2849         else if (strcmp (o->name, "if_marked") == 0)
2850           if_marked_p = 1;
2851
2852       if (! if_marked_p)
2853         continue;
2854
2855       for (fli = flp; fli; fli = fli->next)
2856         if (fli->f == f)
2857           break;
2858       if (! fli->started_p)
2859         {
2860           fli->started_p = 1;
2861
2862           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2863           put_mangled_filename (f, v->line.file);
2864           oprintf (f, "[] = {\n");
2865         }
2866
2867       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2868     }
2869
2870   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2871                      "gt_pch_cache_rtab");
2872
2873   for (v = variables; v; v = v->next)
2874     {
2875       outf_p f = get_output_file_with_visibility (v->line.file);
2876       struct flist *fli;
2877       int skip_p = 0;
2878       options_p o;
2879
2880       for (o = v->opt; o; o = o->next)
2881         if (strcmp (o->name, "deletable") == 0
2882             || strcmp (o->name, "if_marked") == 0)
2883           skip_p = 1;
2884
2885       if (skip_p)
2886         continue;
2887
2888       if (! contains_scalar_p (v->type))
2889         continue;
2890
2891       for (fli = flp; fli; fli = fli->next)
2892         if (fli->f == f)
2893           break;
2894       if (! fli->started_p)
2895         {
2896           fli->started_p = 1;
2897
2898           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2899           put_mangled_filename (f, v->line.file);
2900           oprintf (f, "[] = {\n");
2901         }
2902
2903       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2904                v->name, v->name);
2905     }
2906
2907   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2908                      "gt_pch_scalar_rtab");
2909 }
2910
2911 \f
2912 extern int main (int argc, char **argv);
2913 int
2914 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2915 {
2916   unsigned i;
2917   static struct fileloc pos = { __FILE__, __LINE__ };
2918   unsigned j;
2919
2920   gen_rtx_next ();
2921
2922   srcdir_len = strlen (srcdir);
2923
2924   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2925   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2926   do_scalar_typedef ("uint8", &pos);
2927   do_scalar_typedef ("jword", &pos);
2928   do_scalar_typedef ("JCF_u2", &pos);
2929   do_scalar_typedef ("void", &pos);
2930
2931   do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
2932
2933   do_typedef ("HARD_REG_SET", create_array (
2934               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2935               "2"), &pos);
2936
2937   for (i = 0; i < NUM_GT_FILES; i++)
2938     {
2939       int dupflag = 0;
2940       /* Omit if already seen.  */
2941       for (j = 0; j < i; j++)
2942         {
2943           if (!strcmp (all_files[i], all_files[j]))
2944             {
2945               dupflag = 1;
2946               break;
2947             }
2948         }
2949       if (!dupflag)
2950         parse_file (all_files[i]);
2951     }
2952
2953   if (hit_error != 0)
2954     exit (1);
2955
2956   set_gc_used (variables);
2957
2958   open_base_files ();
2959   write_enum_defn (structures, param_structs);
2960   write_types (structures, param_structs, &ggc_wtd);
2961   write_types (structures, param_structs, &pch_wtd);
2962   write_local (structures, param_structs);
2963   write_roots (variables);
2964   write_rtx_next ();
2965   close_output_files ();
2966
2967   return (hit_error != 0);
2968 }