gcc/gengtype.c

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