contrib/gcc-3.4/gcc/gengtype.c

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