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", "reload.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   const struct nested_ptr_data *nested_ptr_d = NULL;
1513
1514   d->needs_cast_p = 0;
1515   for (oo = d->opt; oo; oo = oo->next)
1516     if (strcmp (oo->name, "length") == 0)
1517       length = (const char *)oo->info;
1518     else if (strcmp (oo->name, "maybe_undef") == 0)
1519       maybe_undef_p = 1;
1520     else if (strncmp (oo->name, "use_param", 9) == 0
1521              && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1522       use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
1523     else if (strcmp (oo->name, "use_params") == 0)
1524       use_params_p = 1;
1525     else if (strcmp (oo->name, "desc") == 0)
1526       desc = (const char *)oo->info;
1527     else if (strcmp (oo->name, "nested_ptr") == 0)
1528       nested_ptr_d = (const struct nested_ptr_data *)oo->info ;
1529     else if (strcmp (oo->name, "dot") == 0)
1530       ;
1531     else if (strcmp (oo->name, "tag") == 0)
1532       ;
1533     else if (strcmp (oo->name, "special") == 0)
1534       ;
1535     else if (strcmp (oo->name, "skip") == 0)
1536       ;
1537     else if (strcmp (oo->name, "default") == 0)
1538       ;
1539     else if (strcmp (oo->name, "descbits") == 0)
1540       ;
1541     else if (strcmp (oo->name, "param_is") == 0)
1542       ;
1543     else if (strncmp (oo->name, "param", 5) == 0
1544              && ISDIGIT (oo->name[5])
1545              && strcmp (oo->name + 6, "_is") == 0)
1546       ;
1547     else if (strcmp (oo->name, "chain_next") == 0)
1548       ;
1549     else if (strcmp (oo->name, "chain_prev") == 0)
1550       ;
1551     else if (strcmp (oo->name, "reorder") == 0)
1552       ;
1553     else
1554       error_at_line (d->line, "unknown option `%s'\n", oo->name);
1555
1556   if (d->used_length)
1557     length = NULL;
1558
1559   if (use_params_p)
1560     {
1561       int pointer_p = t->kind == TYPE_POINTER;
1562
1563       if (pointer_p)
1564         t = t->u.p;
1565       if (! UNION_OR_STRUCT_P (t))
1566         error_at_line (d->line, "`use_params' option on unimplemented type");
1567       else
1568         t = find_param_structure (t, d->param);
1569       if (pointer_p)
1570         t = create_pointer (t);
1571     }
1572
1573   if (use_param_num != -1)
1574     {
1575       if (d->param != NULL && d->param[use_param_num] != NULL)
1576         {
1577           type_p nt = d->param[use_param_num];
1578
1579           if (t->kind == TYPE_ARRAY)
1580             nt = create_array (nt, t->u.a.len);
1581           else if (length != NULL && t->kind == TYPE_POINTER)
1582             nt = create_pointer (nt);
1583           d->needs_cast_p = (t->kind != TYPE_POINTER
1584                              && (nt->kind == TYPE_POINTER
1585                                  || nt->kind == TYPE_STRING));
1586           t = nt;
1587         }
1588       else
1589         error_at_line (d->line, "no parameter defined for `%s'",
1590                        d->val);
1591     }
1592
1593   if (maybe_undef_p
1594       && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
1595     {
1596       error_at_line (d->line,
1597                      "field `%s' has invalid option `maybe_undef_p'\n",
1598                      d->val);
1599       return;
1600     }
1601
1602   switch (t->kind)
1603     {
1604     case TYPE_SCALAR:
1605     case TYPE_STRING:
1606       d->process_field (t, d);
1607       break;
1608
1609     case TYPE_POINTER:
1610       {
1611         if (maybe_undef_p
1612             && t->u.p->u.s.line.file == NULL)
1613           {
1614             oprintf (d->of, "%*sif (%s) abort();\n", d->indent, "", d->val);
1615             break;
1616           }
1617
1618         if (! length)
1619           {
1620             if (! UNION_OR_STRUCT_P (t->u.p)
1621                 && t->u.p->kind != TYPE_PARAM_STRUCT)
1622               {
1623                 error_at_line (d->line,
1624                                "field `%s' is pointer to unimplemented type",
1625                                d->val);
1626                 break;
1627               }
1628
1629             if (nested_ptr_d)
1630               {
1631                 const char *oldprevval2 = d->prev_val[2];
1632
1633                 if (! UNION_OR_STRUCT_P (nested_ptr_d->type))
1634                   {
1635                     error_at_line (d->line,
1636                                    "field `%s' has invalid "
1637                                    "option `nested_ptr'\n",
1638                                    d->val);
1639                     return;
1640                   }
1641
1642                 d->prev_val[2] = d->val;
1643                 oprintf (d->of, "%*s{\n", d->indent, "");
1644                 d->indent += 2;
1645                 d->val = xasprintf ("x%d", d->counter++);
1646                 oprintf (d->of, "%*s%s %s * %s =\n", d->indent, "",
1647                          (nested_ptr_d->type->kind == TYPE_UNION
1648                           ? "union" : "struct"),
1649                          nested_ptr_d->type->u.s.tag, d->val);
1650                 oprintf (d->of, "%*s", d->indent + 2, "");
1651                 output_escaped_param (d, nested_ptr_d->convert_from,
1652                                       "nested_ptr");
1653                 oprintf (d->of, ";\n");
1654
1655                 d->process_field (nested_ptr_d->type, d);
1656
1657                 oprintf (d->of, "%*s%s = ", d->indent, "",
1658                          d->prev_val[2]);
1659                 d->prev_val[2] = d->val;
1660                 output_escaped_param (d, nested_ptr_d->convert_to,
1661                                       "nested_ptr");
1662                 oprintf (d->of, ";\n");
1663
1664                 d->indent -= 2;
1665                 oprintf (d->of, "%*s}\n", d->indent, "");
1666                 d->val = d->prev_val[2];
1667                 d->prev_val[2] = oldprevval2;
1668               }
1669             else
1670               d->process_field (t->u.p, d);
1671           }
1672         else
1673           {
1674             int loopcounter = d->counter++;
1675             const char *oldval = d->val;
1676             const char *oldprevval3 = d->prev_val[3];
1677             char *newval;
1678
1679             oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
1680             d->indent += 2;
1681             oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1682             oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1683                      loopcounter, loopcounter);
1684             output_escaped_param (d, length, "length");
1685             oprintf (d->of, "); i%d++) {\n", loopcounter);
1686             d->indent += 2;
1687             d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1688             d->used_length = 1;
1689             d->prev_val[3] = oldval;
1690             walk_type (t->u.p, d);
1691             free (newval);
1692             d->val = oldval;
1693             d->prev_val[3] = oldprevval3;
1694             d->used_length = 0;
1695             d->indent -= 2;
1696             oprintf (d->of, "%*s}\n", d->indent, "");
1697             d->process_field(t, d);
1698             d->indent -= 2;
1699             oprintf (d->of, "%*s}\n", d->indent, "");
1700           }
1701       }
1702       break;
1703
1704     case TYPE_ARRAY:
1705       {
1706         int loopcounter = d->counter++;
1707         const char *oldval = d->val;
1708         char *newval;
1709
1710         /* If it's an array of scalars, we optimize by not generating
1711            any code.  */
1712         if (t->u.a.p->kind == TYPE_SCALAR)
1713           break;
1714
1715         oprintf (d->of, "%*s{\n", d->indent, "");
1716         d->indent += 2;
1717         oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1718         oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1719                  loopcounter, loopcounter);
1720         if (length)
1721           output_escaped_param (d, length, "length");
1722         else
1723           oprintf (d->of, "%s", t->u.a.len);
1724         oprintf (d->of, "); i%d++) {\n", loopcounter);
1725         d->indent += 2;
1726         d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1727         d->used_length = 1;
1728         walk_type (t->u.a.p, d);
1729         free (newval);
1730         d->used_length = 0;
1731         d->val = oldval;
1732         d->indent -= 2;
1733         oprintf (d->of, "%*s}\n", d->indent, "");
1734         d->indent -= 2;
1735         oprintf (d->of, "%*s}\n", d->indent, "");
1736       }
1737       break;
1738
1739     case TYPE_STRUCT:
1740     case TYPE_UNION:
1741       {
1742         pair_p f;
1743         const char *oldval = d->val;
1744         const char *oldprevval1 = d->prev_val[1];
1745         const char *oldprevval2 = d->prev_val[2];
1746         const int union_p = t->kind == TYPE_UNION;
1747         int seen_default_p = 0;
1748         options_p o;
1749
1750         if (! t->u.s.line.file)
1751           error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
1752
1753         if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
1754           {
1755             error_at_line (d->line,
1756                            "structure `%s' defined for mismatching languages",
1757                            t->u.s.tag);
1758             error_at_line (&t->u.s.line, "one structure defined here");
1759           }
1760
1761         /* Some things may also be defined in the structure's options.  */
1762         for (o = t->u.s.opt; o; o = o->next)
1763           if (! desc && strcmp (o->name, "desc") == 0)
1764             desc = (const char *)o->info;
1765
1766         d->prev_val[2] = oldval;
1767         d->prev_val[1] = oldprevval2;
1768         if (union_p)
1769           {
1770             if (desc == NULL)
1771               {
1772                 error_at_line (d->line, "missing `desc' option for union `%s'",
1773                                t->u.s.tag);
1774                 desc = "1";
1775               }
1776             oprintf (d->of, "%*sswitch (", d->indent, "");
1777             output_escaped_param (d, desc, "desc");
1778             oprintf (d->of, ")\n");
1779             d->indent += 2;
1780             oprintf (d->of, "%*s{\n", d->indent, "");
1781           }
1782         for (f = t->u.s.fields; f; f = f->next)
1783           {
1784             options_p oo;
1785             const char *dot = ".";
1786             const char *tagid = NULL;
1787             int skip_p = 0;
1788             int default_p = 0;
1789             int use_param_p = 0;
1790             char *newval;
1791
1792             d->reorder_fn = NULL;
1793             for (oo = f->opt; oo; oo = oo->next)
1794               if (strcmp (oo->name, "dot") == 0)
1795                 dot = (const char *)oo->info;
1796               else if (strcmp (oo->name, "tag") == 0)
1797                 tagid = (const char *)oo->info;
1798               else if (strcmp (oo->name, "skip") == 0)
1799                 skip_p = 1;
1800               else if (strcmp (oo->name, "default") == 0)
1801                 default_p = 1;
1802               else if (strcmp (oo->name, "reorder") == 0)
1803                 d->reorder_fn = (const char *)oo->info;
1804               else if (strncmp (oo->name, "use_param", 9) == 0
1805                        && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1806                 use_param_p = 1;
1807
1808             if (skip_p)
1809               continue;
1810
1811             if (union_p && tagid)
1812               {
1813                 oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
1814                 d->indent += 2;
1815               }
1816             else if (union_p && default_p)
1817               {
1818                 oprintf (d->of, "%*sdefault:\n", d->indent, "");
1819                 d->indent += 2;
1820                 seen_default_p = 1;
1821               }
1822             else if (! union_p && (default_p || tagid))
1823               error_at_line (d->line,
1824                              "can't use `%s' outside a union on field `%s'",
1825                              default_p ? "default" : "tag", f->name);
1826             else if (union_p && ! (default_p || tagid)
1827                      && f->type->kind == TYPE_SCALAR)
1828               {
1829                 fprintf (stderr,
1830         "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
1831                          d->line->file, d->line->line, f->name);
1832                 continue;
1833               }
1834             else if (union_p && ! (default_p || tagid))
1835               error_at_line (d->line,
1836                              "field `%s' is missing `tag' or `default' option",
1837                              f->name);
1838
1839             d->line = &f->line;
1840             d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
1841             d->opt = f->opt;
1842
1843             if (union_p && use_param_p && d->param == NULL)
1844               oprintf (d->of, "%*sabort();\n", d->indent, "");
1845             else
1846               walk_type (f->type, d);
1847
1848             free (newval);
1849
1850             if (union_p)
1851               {
1852                 oprintf (d->of, "%*sbreak;\n", d->indent, "");
1853                 d->indent -= 2;
1854               }
1855           }
1856         d->reorder_fn = NULL;
1857
1858         d->val = oldval;
1859         d->prev_val[1] = oldprevval1;
1860         d->prev_val[2] = oldprevval2;
1861
1862         if (union_p && ! seen_default_p)
1863           {
1864             oprintf (d->of, "%*sdefault:\n", d->indent, "");
1865             oprintf (d->of, "%*s  break;\n", d->indent, "");
1866           }
1867         if (union_p)
1868           {
1869             oprintf (d->of, "%*s}\n", d->indent, "");
1870             d->indent -= 2;
1871           }
1872       }
1873       break;
1874
1875     case TYPE_LANG_STRUCT:
1876       {
1877         type_p nt;
1878         for (nt = t->u.s.lang_struct; nt; nt = nt->next)
1879           if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
1880             break;
1881         if (nt == NULL)
1882           error_at_line (d->line, "structure `%s' differs between languages",
1883                          t->u.s.tag);
1884         else
1885           walk_type (nt, d);
1886       }
1887       break;
1888
1889     case TYPE_PARAM_STRUCT:
1890       {
1891         type_p *oldparam = d->param;
1892
1893         d->param = t->u.param_struct.param;
1894         walk_type (t->u.param_struct.stru, d);
1895         d->param = oldparam;
1896       }
1897       break;
1898
1899     default:
1900       abort ();
1901     }
1902 }
1903
1904 /* process_field routine for marking routines.  */
1905
1906 static void
1907 write_types_process_field (type_p f, const struct walk_type_data *d)
1908 {
1909   const struct write_types_data *wtd;
1910   const char *cast = d->needs_cast_p ? "(void *)" : "";
1911   wtd = (const struct write_types_data *) d->cookie;
1912
1913   switch (f->kind)
1914     {
1915     case TYPE_POINTER:
1916       oprintf (d->of, "%*s%s (%s%s", d->indent, "",
1917                wtd->subfield_marker_routine, cast, d->val);
1918       if (wtd->param_prefix)
1919         {
1920           oprintf (d->of, ", %s", d->prev_val[3]);
1921           if (d->orig_s)
1922             {
1923               oprintf (d->of, ", gt_%s_", wtd->param_prefix);
1924               output_mangled_typename (d->of, d->orig_s);
1925             }
1926           else
1927             oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
1928         }
1929       oprintf (d->of, ");\n");
1930       if (d->reorder_fn && wtd->reorder_note_routine)
1931         oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
1932                  wtd->reorder_note_routine, cast, d->val,
1933                  d->prev_val[3], d->reorder_fn);
1934       break;
1935
1936     case TYPE_STRING:
1937       if (wtd->param_prefix == NULL)
1938         break;
1939
1940     case TYPE_STRUCT:
1941     case TYPE_UNION:
1942     case TYPE_LANG_STRUCT:
1943     case TYPE_PARAM_STRUCT:
1944       oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
1945       output_mangled_typename (d->of, f);
1946       oprintf (d->of, " (%s%s);\n", cast, d->val);
1947       if (d->reorder_fn && wtd->reorder_note_routine)
1948         oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
1949                  wtd->reorder_note_routine, cast, d->val, cast, d->val,
1950                  d->reorder_fn);
1951       break;
1952
1953     case TYPE_SCALAR:
1954       break;
1955
1956     default:
1957       abort ();
1958     }
1959 }
1960
1961 /* For S, a structure that's part of ORIG_S, and using parameters
1962    PARAM, write out a routine that:
1963    - Takes a parameter, a void * but actually of type *S
1964    - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
1965      field of S or its substructures and (in some cases) things
1966      that are pointed to by S.
1967 */
1968
1969 static void
1970 write_func_for_structure (type_p orig_s, type_p s, type_p *param,
1971                           const struct write_types_data *wtd)
1972 {
1973   const char *fn = s->u.s.line.file;
1974   int i;
1975   const char *chain_next = NULL;
1976   const char *chain_prev = NULL;
1977   options_p opt;
1978   struct walk_type_data d;
1979
1980   /* This is a hack, and not the good kind either.  */
1981   for (i = NUM_PARAM - 1; i >= 0; i--)
1982     if (param && param[i] && param[i]->kind == TYPE_POINTER
1983         && UNION_OR_STRUCT_P (param[i]->u.p))
1984       fn = param[i]->u.p->u.s.line.file;
1985
1986   memset (&d, 0, sizeof (d));
1987   d.of = get_output_file_with_visibility (fn);
1988
1989   for (opt = s->u.s.opt; opt; opt = opt->next)
1990     if (strcmp (opt->name, "chain_next") == 0)
1991       chain_next = (const char *) opt->info;
1992     else if (strcmp (opt->name, "chain_prev") == 0)
1993       chain_prev = (const char *) opt->info;
1994
1995   if (chain_prev != NULL && chain_next == NULL)
1996     error_at_line (&s->u.s.line, "chain_prev without chain_next");
1997
1998   d.process_field = write_types_process_field;
1999   d.cookie = wtd;
2000   d.orig_s = orig_s;
2001   d.opt = s->u.s.opt;
2002   d.line = &s->u.s.line;
2003   d.bitmap = s->u.s.bitmap;
2004   d.param = param;
2005   d.prev_val[0] = "*x";
2006   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2007   d.prev_val[3] = "x";
2008   d.val = "(*x)";
2009
2010   oprintf (d.of, "\n");
2011   oprintf (d.of, "void\n");
2012   if (param == NULL)
2013     oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
2014   else
2015     {
2016       oprintf (d.of, "gt_%s_", wtd->prefix);
2017       output_mangled_typename (d.of, orig_s);
2018     }
2019   oprintf (d.of, " (void *x_p)\n");
2020   oprintf (d.of, "{\n");
2021   oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
2022            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2023            chain_next == NULL ? "const " : "",
2024            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2025   if (chain_next != NULL)
2026     oprintf (d.of, "  %s %s * xlimit = x;\n",
2027              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2028   if (chain_next == NULL)
2029     {
2030       oprintf (d.of, "  if (%s (x", wtd->marker_routine);
2031       if (wtd->param_prefix)
2032         {
2033           oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
2034           output_mangled_typename (d.of, orig_s);
2035         }
2036       oprintf (d.of, "))\n");
2037     }
2038   else
2039     {
2040       oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
2041       if (wtd->param_prefix)
2042         {
2043           oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
2044           output_mangled_typename (d.of, orig_s);
2045         }
2046       oprintf (d.of, "))\n");
2047       oprintf (d.of, "   xlimit = (");
2048       d.prev_val[2] = "*xlimit";
2049       output_escaped_param (&d, chain_next, "chain_next");
2050       oprintf (d.of, ");\n");
2051       if (chain_prev != NULL)
2052         {
2053           oprintf (d.of, "  if (x != xlimit)\n");
2054           oprintf (d.of, "    for (;;)\n");
2055           oprintf (d.of, "      {\n");
2056           oprintf (d.of, "        %s %s * const xprev = (",
2057                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2058
2059           d.prev_val[2] = "*x";
2060           output_escaped_param (&d, chain_prev, "chain_prev");
2061           oprintf (d.of, ");\n");
2062           oprintf (d.of, "        if (xprev == NULL) break;\n");
2063           oprintf (d.of, "        x = xprev;\n");
2064           oprintf (d.of, "        (void) %s (xprev",
2065                    wtd->marker_routine);
2066           if (wtd->param_prefix)
2067             {
2068               oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
2069               output_mangled_typename (d.of, orig_s);
2070             }
2071           oprintf (d.of, ");\n");
2072           oprintf (d.of, "      }\n");
2073         }
2074       oprintf (d.of, "  while (x != xlimit)\n");
2075     }
2076   oprintf (d.of, "    {\n");
2077
2078   d.prev_val[2] = "*x";
2079   d.indent = 6;
2080   walk_type (s, &d);
2081
2082   if (chain_next != NULL)
2083     {
2084       oprintf (d.of, "      x = (");
2085       output_escaped_param (&d, chain_next, "chain_next");
2086       oprintf (d.of, ");\n");
2087     }
2088
2089   oprintf (d.of, "    }\n");
2090   oprintf (d.of, "}\n");
2091 }
2092
2093 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
2094
2095 static void
2096 write_types (type_p structures, type_p param_structs,
2097              const struct write_types_data *wtd)
2098 {
2099   type_p s;
2100
2101   oprintf (header_file, "\n/* %s*/\n", wtd->comment);
2102   for (s = structures; s; s = s->next)
2103     if (s->gc_used == GC_POINTED_TO
2104         || s->gc_used == GC_MAYBE_POINTED_TO)
2105       {
2106         options_p opt;
2107
2108         if (s->gc_used == GC_MAYBE_POINTED_TO
2109             && s->u.s.line.file == NULL)
2110           continue;
2111
2112         oprintf (header_file, "#define gt_%s_", wtd->prefix);
2113         output_mangled_typename (header_file, s);
2114         oprintf (header_file, "(X) do { \\\n");
2115         oprintf (header_file,
2116                  "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
2117                  s->u.s.tag);
2118         oprintf (header_file,
2119                  "  } while (0)\n");
2120
2121         for (opt = s->u.s.opt; opt; opt = opt->next)
2122           if (strcmp (opt->name, "ptr_alias") == 0)
2123             {
2124               type_p t = (type_p) opt->info;
2125               if (t->kind == TYPE_STRUCT
2126                   || t->kind == TYPE_UNION
2127                   || t->kind == TYPE_LANG_STRUCT)
2128                 oprintf (header_file,
2129                          "#define gt_%sx_%s gt_%sx_%s\n",
2130                          wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
2131               else
2132                 error_at_line (&s->u.s.line,
2133                                "structure alias is not a structure");
2134               break;
2135             }
2136         if (opt)
2137           continue;
2138
2139         /* Declare the marker procedure only once.  */
2140         oprintf (header_file,
2141                  "extern void gt_%sx_%s (void *);\n",
2142                  wtd->prefix, s->u.s.tag);
2143
2144         if (s->u.s.line.file == NULL)
2145           {
2146             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2147                      s->u.s.tag);
2148             continue;
2149           }
2150
2151         if (s->kind == TYPE_LANG_STRUCT)
2152           {
2153             type_p ss;
2154             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2155               write_func_for_structure (s, ss, NULL, wtd);
2156           }
2157         else
2158           write_func_for_structure (s, s, NULL, wtd);
2159       }
2160
2161   for (s = param_structs; s; s = s->next)
2162     if (s->gc_used == GC_POINTED_TO)
2163       {
2164         type_p * param = s->u.param_struct.param;
2165         type_p stru = s->u.param_struct.stru;
2166
2167         /* Declare the marker procedure.  */
2168         oprintf (header_file, "extern void gt_%s_", wtd->prefix);
2169         output_mangled_typename (header_file, s);
2170         oprintf (header_file, " (void *);\n");
2171
2172         if (stru->u.s.line.file == NULL)
2173           {
2174             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2175                      s->u.s.tag);
2176             continue;
2177           }
2178
2179         if (stru->kind == TYPE_LANG_STRUCT)
2180           {
2181             type_p ss;
2182             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2183               write_func_for_structure (s, ss, param, wtd);
2184           }
2185         else
2186           write_func_for_structure (s, stru, param, wtd);
2187       }
2188 }
2189
2190 static const struct write_types_data ggc_wtd =
2191 {
2192   "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
2193   "GC marker procedures.  "
2194 };
2195
2196 static const struct write_types_data pch_wtd =
2197 {
2198   "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
2199   "gt_pch_note_reorder",
2200   "PCH type-walking procedures.  "
2201 };
2202
2203 /* Write out the local pointer-walking routines.  */
2204
2205 /* process_field routine for local pointer-walking.  */
2206
2207 static void
2208 write_types_local_process_field (type_p f, const struct walk_type_data *d)
2209 {
2210   switch (f->kind)
2211     {
2212     case TYPE_POINTER:
2213     case TYPE_STRUCT:
2214     case TYPE_UNION:
2215     case TYPE_LANG_STRUCT:
2216     case TYPE_PARAM_STRUCT:
2217     case TYPE_STRING:
2218       oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
2219                d->prev_val[3]);
2220       oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
2221       break;
2222
2223     case TYPE_SCALAR:
2224       break;
2225
2226     default:
2227       abort ();
2228     }
2229 }
2230
2231 /* For S, a structure that's part of ORIG_S, and using parameters
2232    PARAM, write out a routine that:
2233    - Is of type gt_note_pointers
2234    - If calls PROCESS_FIELD on each field of S or its substructures.
2235 */
2236
2237 static void
2238 write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
2239 {
2240   const char *fn = s->u.s.line.file;
2241   int i;
2242   struct walk_type_data d;
2243
2244   /* This is a hack, and not the good kind either.  */
2245   for (i = NUM_PARAM - 1; i >= 0; i--)
2246     if (param && param[i] && param[i]->kind == TYPE_POINTER
2247         && UNION_OR_STRUCT_P (param[i]->u.p))
2248       fn = param[i]->u.p->u.s.line.file;
2249
2250   memset (&d, 0, sizeof (d));
2251   d.of = get_output_file_with_visibility (fn);
2252
2253   d.process_field = write_types_local_process_field;
2254   d.opt = s->u.s.opt;
2255   d.line = &s->u.s.line;
2256   d.bitmap = s->u.s.bitmap;
2257   d.param = param;
2258   d.prev_val[0] = d.prev_val[2] = "*x";
2259   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2260   d.prev_val[3] = "x";
2261   d.val = "(*x)";
2262
2263   oprintf (d.of, "\n");
2264   oprintf (d.of, "void\n");
2265   oprintf (d.of, "gt_pch_p_");
2266   output_mangled_typename (d.of, orig_s);
2267   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");
2268   oprintf (d.of, "{\n");
2269   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2270            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2271            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2272   d.indent = 2;
2273   walk_type (s, &d);
2274   oprintf (d.of, "}\n");
2275 }
2276
2277 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2278
2279 static void
2280 write_local (type_p structures, type_p param_structs)
2281 {
2282   type_p s;
2283
2284   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2285   for (s = structures; s; s = s->next)
2286     if (s->gc_used == GC_POINTED_TO
2287         || s->gc_used == GC_MAYBE_POINTED_TO)
2288       {
2289         options_p opt;
2290
2291         if (s->u.s.line.file == NULL)
2292           continue;
2293
2294         for (opt = s->u.s.opt; opt; opt = opt->next)
2295           if (strcmp (opt->name, "ptr_alias") == 0)
2296             {
2297               type_p t = (type_p) opt->info;
2298               if (t->kind == TYPE_STRUCT
2299                   || t->kind == TYPE_UNION
2300                   || t->kind == TYPE_LANG_STRUCT)
2301                 {
2302                   oprintf (header_file, "#define gt_pch_p_");
2303                   output_mangled_typename (header_file, s);
2304                   oprintf (header_file, " gt_pch_p_");
2305                   output_mangled_typename (header_file, t);
2306                   oprintf (header_file, "\n");
2307                 }
2308               else
2309                 error_at_line (&s->u.s.line,
2310                                "structure alias is not a structure");
2311               break;
2312             }
2313         if (opt)
2314           continue;
2315
2316         /* Declare the marker procedure only once.  */
2317         oprintf (header_file, "extern void gt_pch_p_");
2318         output_mangled_typename (header_file, s);
2319         oprintf (header_file,
2320          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2321
2322         if (s->kind == TYPE_LANG_STRUCT)
2323           {
2324             type_p ss;
2325             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2326               write_local_func_for_structure (s, ss, NULL);
2327           }
2328         else
2329           write_local_func_for_structure (s, s, NULL);
2330       }
2331
2332   for (s = param_structs; s; s = s->next)
2333     if (s->gc_used == GC_POINTED_TO)
2334       {
2335         type_p * param = s->u.param_struct.param;
2336         type_p stru = s->u.param_struct.stru;
2337
2338         /* Declare the marker procedure.  */
2339         oprintf (header_file, "extern void gt_pch_p_");
2340         output_mangled_typename (header_file, s);
2341         oprintf (header_file,
2342          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2343
2344         if (stru->u.s.line.file == NULL)
2345           {
2346             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2347                      s->u.s.tag);
2348             continue;
2349           }
2350
2351         if (stru->kind == TYPE_LANG_STRUCT)
2352           {
2353             type_p ss;
2354             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2355               write_local_func_for_structure (s, ss, param);
2356           }
2357         else
2358           write_local_func_for_structure (s, stru, param);
2359       }
2360 }
2361
2362 /* Write out the 'enum' definition for gt_types_enum.  */
2363
2364 static void
2365 write_enum_defn (type_p structures, type_p param_structs)
2366 {
2367   type_p s;
2368
2369   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2370   oprintf (header_file, "enum gt_types_enum {\n");
2371   for (s = structures; s; s = s->next)
2372     if (s->gc_used == GC_POINTED_TO
2373         || s->gc_used == GC_MAYBE_POINTED_TO)
2374       {
2375         if (s->gc_used == GC_MAYBE_POINTED_TO
2376             && s->u.s.line.file == NULL)
2377           continue;
2378
2379         oprintf (header_file, " gt_ggc_e_");
2380         output_mangled_typename (header_file, s);
2381         oprintf (header_file, ", \n");
2382       }
2383   for (s = param_structs; s; s = s->next)
2384     if (s->gc_used == GC_POINTED_TO)
2385       {
2386         oprintf (header_file, " gt_e_");
2387         output_mangled_typename (header_file, s);
2388         oprintf (header_file, ", \n");
2389       }
2390   oprintf (header_file, " gt_types_enum_last\n");
2391   oprintf (header_file, "};\n");
2392 }
2393
2394 /* Might T contain any non-pointer elements?  */
2395
2396 static int
2397 contains_scalar_p (type_p t)
2398 {
2399   switch (t->kind)
2400     {
2401     case TYPE_STRING:
2402     case TYPE_POINTER:
2403       return 0;
2404     case TYPE_ARRAY:
2405       return contains_scalar_p (t->u.a.p);
2406     default:
2407       /* Could also check for structures that have no non-pointer
2408          fields, but there aren't enough of those to worry about.  */
2409       return 1;
2410     }
2411 }
2412
2413 /* Mangle FN and print it to F.  */
2414
2415 static void
2416 put_mangled_filename (outf_p f, const char *fn)
2417 {
2418   const char *name = get_output_file_name (fn);
2419   for (; *name != 0; name++)
2420     if (ISALNUM (*name))
2421       oprintf (f, "%c", *name);
2422     else
2423       oprintf (f, "%c", '_');
2424 }
2425
2426 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2427    LASTNAME, and NAME are all strings to insert in various places in
2428    the resulting code.  */
2429
2430 static void
2431 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2432                    const char *tname, const char *name)
2433 {
2434   struct flist *fli2;
2435
2436   for (fli2 = flp; fli2; fli2 = fli2->next)
2437     if (fli2->started_p)
2438       {
2439         oprintf (fli2->f, "  %s\n", lastname);
2440         oprintf (fli2->f, "};\n\n");
2441       }
2442
2443   for (fli2 = flp; fli2; fli2 = fli2->next)
2444     if (fli2->started_p)
2445       {
2446         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2447         int fnum;
2448
2449         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2450           if (bitmap & 1)
2451             {
2452               oprintf (base_files[fnum],
2453                        "extern const struct %s gt_%s_",
2454                        tname, pfx);
2455               put_mangled_filename (base_files[fnum], fli2->name);
2456               oprintf (base_files[fnum], "[];\n");
2457             }
2458       }
2459
2460   {
2461     size_t fnum;
2462     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2463       oprintf (base_files [fnum],
2464                "const struct %s * const %s[] = {\n",
2465                tname, name);
2466   }
2467
2468
2469   for (fli2 = flp; fli2; fli2 = fli2->next)
2470     if (fli2->started_p)
2471       {
2472         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2473         int fnum;
2474
2475         fli2->started_p = 0;
2476
2477         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2478           if (bitmap & 1)
2479             {
2480               oprintf (base_files[fnum], "  gt_%s_", pfx);
2481               put_mangled_filename (base_files[fnum], fli2->name);
2482               oprintf (base_files[fnum], ",\n");
2483             }
2484       }
2485
2486   {
2487     size_t fnum;
2488     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2489       {
2490         oprintf (base_files[fnum], "  NULL\n");
2491         oprintf (base_files[fnum], "};\n");
2492       }
2493   }
2494 }
2495
2496 /* Write out to F the table entry and any marker routines needed to
2497    mark NAME as TYPE.  The original variable is V, at LINE.
2498    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2499    is nonzero iff we are building the root table for hash table caches.  */
2500
2501 static void
2502 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2503             struct fileloc *line, const char *if_marked)
2504 {
2505   switch (type->kind)
2506     {
2507     case TYPE_STRUCT:
2508       {
2509         pair_p fld;
2510         for (fld = type->u.s.fields; fld; fld = fld->next)
2511           {
2512             int skip_p = 0;
2513             const char *desc = NULL;
2514             options_p o;
2515
2516             for (o = fld->opt; o; o = o->next)
2517               if (strcmp (o->name, "skip") == 0)
2518                 skip_p = 1;
2519               else if (strcmp (o->name, "desc") == 0)
2520                 desc = (const char *)o->info;
2521               else
2522                 error_at_line (line,
2523                        "field `%s' of global `%s' has unknown option `%s'",
2524                                fld->name, name, o->name);
2525
2526             if (skip_p)
2527               continue;
2528             else if (desc && fld->type->kind == TYPE_UNION)
2529               {
2530                 pair_p validf = NULL;
2531                 pair_p ufld;
2532
2533                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2534                   {
2535                     const char *tag = NULL;
2536                     options_p oo;
2537
2538                     for (oo = ufld->opt; oo; oo = oo->next)
2539                       if (strcmp (oo->name, "tag") == 0)
2540                         tag = (const char *)oo->info;
2541                     if (tag == NULL || strcmp (tag, desc) != 0)
2542                       continue;
2543                     if (validf != NULL)
2544                       error_at_line (line,
2545                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2546                                      name, fld->name, validf->name,
2547                                      name, fld->name, ufld->name,
2548                                      tag);
2549                     validf = ufld;
2550                   }
2551                 if (validf != NULL)
2552                   {
2553                     char *newname;
2554                     newname = xasprintf ("%s.%s.%s",
2555                                          name, fld->name, validf->name);
2556                     write_root (f, v, validf->type, newname, 0, line,
2557                                 if_marked);
2558                     free (newname);
2559                   }
2560               }
2561             else if (desc)
2562               error_at_line (line,
2563                      "global `%s.%s' has `desc' option but is not union",
2564                              name, fld->name);
2565             else
2566               {
2567                 char *newname;
2568                 newname = xasprintf ("%s.%s", name, fld->name);
2569                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2570                 free (newname);
2571               }
2572           }
2573       }
2574       break;
2575
2576     case TYPE_ARRAY:
2577       {
2578         char *newname;
2579         newname = xasprintf ("%s[0]", name);
2580         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2581         free (newname);
2582       }
2583       break;
2584
2585     case TYPE_POINTER:
2586       {
2587         type_p ap, tp;
2588
2589         oprintf (f, "  {\n");
2590         oprintf (f, "    &%s,\n", name);
2591         oprintf (f, "    1");
2592
2593         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2594           if (ap->u.a.len[0])
2595             oprintf (f, " * (%s)", ap->u.a.len);
2596           else if (ap == v->type)
2597             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2598         oprintf (f, ",\n");
2599         oprintf (f, "    sizeof (%s", v->name);
2600         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2601           oprintf (f, "[0]");
2602         oprintf (f, "),\n");
2603
2604         tp = type->u.p;
2605
2606         if (! has_length && UNION_OR_STRUCT_P (tp))
2607           {
2608             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2609             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2610           }
2611         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2612           {
2613             oprintf (f, "    &gt_ggc_m_");
2614             output_mangled_typename (f, tp);
2615             oprintf (f, ",\n    &gt_pch_n_");
2616             output_mangled_typename (f, tp);
2617           }
2618         else if (has_length
2619                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2620           {
2621             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2622             oprintf (f, "    &gt_pch_na_%s", name);
2623           }
2624         else
2625           {
2626             error_at_line (line,
2627                            "global `%s' is pointer to unimplemented type",
2628                            name);
2629           }
2630         if (if_marked)
2631           oprintf (f, ",\n    &%s", if_marked);
2632         oprintf (f, "\n  },\n");
2633       }
2634       break;
2635
2636     case TYPE_STRING:
2637       {
2638         oprintf (f, "  {\n");
2639         oprintf (f, "    &%s,\n", name);
2640         oprintf (f, "    1, \n");
2641         oprintf (f, "    sizeof (%s),\n", v->name);
2642         oprintf (f, "    &gt_ggc_m_S,\n");
2643         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2644         oprintf (f, "  },\n");
2645       }
2646       break;
2647
2648     case TYPE_SCALAR:
2649       break;
2650
2651     default:
2652       error_at_line (line,
2653                      "global `%s' is unimplemented type",
2654                      name);
2655     }
2656 }
2657
2658 /* This generates a routine to walk an array.  */
2659
2660 static void
2661 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2662 {
2663   struct walk_type_data d;
2664   char *prevval3;
2665
2666   memset (&d, 0, sizeof (d));
2667   d.of = f;
2668   d.cookie = wtd;
2669   d.indent = 2;
2670   d.line = &v->line;
2671   d.opt = v->opt;
2672   d.bitmap = get_base_file_bitmap (v->line.file);
2673   d.param = NULL;
2674
2675   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2676
2677   if (wtd->param_prefix)
2678     {
2679       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2680       oprintf (f,
2681        "    (void *, void *, gt_pointer_operator, void *);\n");
2682       oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
2683                wtd->param_prefix, v->name);
2684       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
2685       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
2686       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
2687       oprintf (d.of, "{\n");
2688       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2689       d.process_field = write_types_local_process_field;
2690       walk_type (v->type, &d);
2691       oprintf (f, "}\n\n");
2692     }
2693
2694   d.opt = v->opt;
2695   oprintf (f, "static void gt_%sa_%s (void *);\n",
2696            wtd->prefix, v->name);
2697   oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
2698            wtd->prefix, v->name);
2699   oprintf (f, "{\n");
2700   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2701   d.process_field = write_types_process_field;
2702   walk_type (v->type, &d);
2703   free (prevval3);
2704   oprintf (f, "}\n\n");
2705 }
2706
2707 /* Output a table describing the locations and types of VARIABLES.  */
2708
2709 static void
2710 write_roots (pair_p variables)
2711 {
2712   pair_p v;
2713   struct flist *flp = NULL;
2714
2715   for (v = variables; v; v = v->next)
2716     {
2717       outf_p f = get_output_file_with_visibility (v->line.file);
2718       struct flist *fli;
2719       const char *length = NULL;
2720       int deletable_p = 0;
2721       options_p o;
2722
2723       for (o = v->opt; o; o = o->next)
2724         if (strcmp (o->name, "length") == 0)
2725           length = (const char *)o->info;
2726         else if (strcmp (o->name, "deletable") == 0)
2727           deletable_p = 1;
2728         else if (strcmp (o->name, "param_is") == 0)
2729           ;
2730         else if (strncmp (o->name, "param", 5) == 0
2731                  && ISDIGIT (o->name[5])
2732                  && strcmp (o->name + 6, "_is") == 0)
2733           ;
2734         else if (strcmp (o->name, "if_marked") == 0)
2735           ;
2736         else
2737           error_at_line (&v->line,
2738                          "global `%s' has unknown option `%s'",
2739                          v->name, o->name);
2740
2741       for (fli = flp; fli; fli = fli->next)
2742         if (fli->f == f)
2743           break;
2744       if (fli == NULL)
2745         {
2746           fli = xmalloc (sizeof (*fli));
2747           fli->f = f;
2748           fli->next = flp;
2749           fli->started_p = 0;
2750           fli->name = v->line.file;
2751           flp = fli;
2752
2753           oprintf (f, "\n/* GC roots.  */\n\n");
2754         }
2755
2756       if (! deletable_p
2757           && length
2758           && v->type->kind == TYPE_POINTER
2759           && (v->type->u.p->kind == TYPE_POINTER
2760               || v->type->u.p->kind == TYPE_STRUCT))
2761         {
2762           write_array (f, v, &ggc_wtd);
2763           write_array (f, v, &pch_wtd);
2764         }
2765     }
2766
2767   for (v = variables; v; v = v->next)
2768     {
2769       outf_p f = get_output_file_with_visibility (v->line.file);
2770       struct flist *fli;
2771       int skip_p = 0;
2772       int length_p = 0;
2773       options_p o;
2774
2775       for (o = v->opt; o; o = o->next)
2776         if (strcmp (o->name, "length") == 0)
2777           length_p = 1;
2778         else if (strcmp (o->name, "deletable") == 0
2779                  || strcmp (o->name, "if_marked") == 0)
2780           skip_p = 1;
2781
2782       if (skip_p)
2783         continue;
2784
2785       for (fli = flp; fli; fli = fli->next)
2786         if (fli->f == f)
2787           break;
2788       if (! fli->started_p)
2789         {
2790           fli->started_p = 1;
2791
2792           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2793           put_mangled_filename (f, v->line.file);
2794           oprintf (f, "[] = {\n");
2795         }
2796
2797       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2798     }
2799
2800   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2801                      "gt_ggc_rtab");
2802
2803   for (v = variables; v; v = v->next)
2804     {
2805       outf_p f = get_output_file_with_visibility (v->line.file);
2806       struct flist *fli;
2807       int skip_p = 1;
2808       options_p o;
2809
2810       for (o = v->opt; o; o = o->next)
2811         if (strcmp (o->name, "deletable") == 0)
2812           skip_p = 0;
2813         else if (strcmp (o->name, "if_marked") == 0)
2814           skip_p = 1;
2815
2816       if (skip_p)
2817         continue;
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_root_tab gt_ggc_rd_");
2827           put_mangled_filename (f, v->line.file);
2828           oprintf (f, "[] = {\n");
2829         }
2830
2831       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2832                v->name, v->name);
2833     }
2834
2835   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2836                      "gt_ggc_deletable_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       const char *if_marked = NULL;
2843       int length_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 = (const char *) o->info;
2851
2852       if (if_marked == NULL)
2853         continue;
2854
2855       if (v->type->kind != TYPE_POINTER
2856           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2857           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2858         {
2859           error_at_line (&v->line, "if_marked option used but not hash table");
2860           continue;
2861         }
2862
2863       for (fli = flp; fli; fli = fli->next)
2864         if (fli->f == f)
2865           break;
2866       if (! fli->started_p)
2867         {
2868           fli->started_p = 1;
2869
2870           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2871           put_mangled_filename (f, v->line.file);
2872           oprintf (f, "[] = {\n");
2873         }
2874
2875       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2876                      v->name, length_p, &v->line, if_marked);
2877     }
2878
2879   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2880                      "gt_ggc_cache_rtab");
2881
2882   for (v = variables; v; v = v->next)
2883     {
2884       outf_p f = get_output_file_with_visibility (v->line.file);
2885       struct flist *fli;
2886       int length_p = 0;
2887       int if_marked_p = 0;
2888       options_p o;
2889
2890       for (o = v->opt; o; o = o->next)
2891         if (strcmp (o->name, "length") == 0)
2892           length_p = 1;
2893         else if (strcmp (o->name, "if_marked") == 0)
2894           if_marked_p = 1;
2895
2896       if (! if_marked_p)
2897         continue;
2898
2899       for (fli = flp; fli; fli = fli->next)
2900         if (fli->f == f)
2901           break;
2902       if (! fli->started_p)
2903         {
2904           fli->started_p = 1;
2905
2906           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2907           put_mangled_filename (f, v->line.file);
2908           oprintf (f, "[] = {\n");
2909         }
2910
2911       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2912     }
2913
2914   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2915                      "gt_pch_cache_rtab");
2916
2917   for (v = variables; v; v = v->next)
2918     {
2919       outf_p f = get_output_file_with_visibility (v->line.file);
2920       struct flist *fli;
2921       int skip_p = 0;
2922       options_p o;
2923
2924       for (o = v->opt; o; o = o->next)
2925         if (strcmp (o->name, "deletable") == 0
2926             || strcmp (o->name, "if_marked") == 0)
2927           skip_p = 1;
2928
2929       if (skip_p)
2930         continue;
2931
2932       if (! contains_scalar_p (v->type))
2933         continue;
2934
2935       for (fli = flp; fli; fli = fli->next)
2936         if (fli->f == f)
2937           break;
2938       if (! fli->started_p)
2939         {
2940           fli->started_p = 1;
2941
2942           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2943           put_mangled_filename (f, v->line.file);
2944           oprintf (f, "[] = {\n");
2945         }
2946
2947       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2948                v->name, v->name);
2949     }
2950
2951   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2952                      "gt_pch_scalar_rtab");
2953 }
2954
2955 \f
2956 extern int main (int argc, char **argv);
2957 int
2958 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2959 {
2960   unsigned i;
2961   static struct fileloc pos = { __FILE__, __LINE__ };
2962   unsigned j;
2963
2964   gen_rtx_next ();
2965
2966   srcdir_len = strlen (srcdir);
2967
2968   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2969   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2970   do_scalar_typedef ("uint8", &pos);
2971   do_scalar_typedef ("jword", &pos);
2972   do_scalar_typedef ("JCF_u2", &pos);
2973   do_scalar_typedef ("void", &pos);
2974
2975   do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
2976
2977   do_typedef ("HARD_REG_SET", create_array (
2978               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2979               "2"), &pos);
2980
2981   for (i = 0; i < NUM_GT_FILES; i++)
2982     {
2983       int dupflag = 0;
2984       /* Omit if already seen.  */
2985       for (j = 0; j < i; j++)
2986         {
2987           if (!strcmp (all_files[i], all_files[j]))
2988             {
2989               dupflag = 1;
2990               break;
2991             }
2992         }
2993       if (!dupflag)
2994         parse_file (all_files[i]);
2995     }
2996
2997   if (hit_error != 0)
2998     exit (1);
2999
3000   set_gc_used (variables);
3001
3002   open_base_files ();
3003   write_enum_defn (structures, param_structs);
3004   write_types (structures, param_structs, &ggc_wtd);
3005   write_types (structures, param_structs, &pch_wtd);
3006   write_local (structures, param_structs);
3007   write_roots (variables);
3008   write_rtx_next ();
3009   close_output_files ();
3010
3011   return (hit_error != 0);
3012 }