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