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