gcc/gengtype.c

   1 /* Process source files and output type information.
   2    Copyright (C) 2002, 2003 Free Software Foundation, Inc.
   3
   4 This file is part of GCC.
   5
   6 GCC is free software; you can redistribute it and/or modify it under
   7 the terms of the GNU General Public License as published by the Free
   8 Software Foundation; either version 2, or (at your option) any later
   9 version.
  10
  11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GCC; see the file COPYING.  If not, write to the Free
  18 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  19 02111-1307, USA.  */
  20
  21 #include "bconfig.h"
  22 #include "system.h"
  23 #include "coretypes.h"
  24 #include "tm.h"
  25 #include "gengtype.h"
  26 #include "gtyp-gen.h"
  27
  28 #define NO_GENRTL_H
  29 #include "rtl.h"
  30 #undef abort
  31
  32 /* Nonzero iff an error has occurred.  */
  33 static int hit_error = 0;
  34
  35 static void gen_rtx_next (void);
  36 static void write_rtx_next (void);
  37 static void open_base_files (void);
  38 static void close_output_files (void);
  39
  40 /* Report an error at POS, printing MSG.  */
  41
  42 void
  43 error_at_line (struct fileloc *pos, const char *msg, ...)
  44 {
  45   va_list ap;
  46
  47   va_start (ap, msg);
  48
  49   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
  50   vfprintf (stderr, msg, ap);
  51   fputc ('\n', stderr);
  52   hit_error = 1;
  53
  54   va_end (ap);
  55 }
  56
  57 /* vasprintf, but produces fatal message on out-of-memory.  */
  58 int
  59 xvasprintf (char **result, const char *format, va_list args)
  60 {
  61   int ret = vasprintf (result, format, args);
  62   if (*result == NULL || ret < 0)
  63     {
  64       fputs ("gengtype: out of memory", stderr);
  65       xexit (1);
  66     }
  67   return ret;
  68 }
  69
  70 /* Wrapper for xvasprintf.  */
  71 char *
  72 xasprintf (const char *format, ...)
  73 {
  74   char *result;
  75   va_list ap;
  76
  77   va_start (ap, format);
  78   xvasprintf (&result, format, ap);
  79   va_end (ap);
  80   return result;
  81 }
  82
  83 /* The one and only TYPE_STRING.  */
  84
  85 struct type string_type = {
  86   TYPE_STRING, NULL, NULL, GC_USED, {0}
  87 };
  88
  89 /* Lists of various things.  */
  90
  91 static pair_p typedefs;
  92 static type_p structures;
  93 static type_p param_structs;
  94 static pair_p variables;
  95
  96 static void do_scalar_typedef (const char *, struct fileloc *);
  97 static type_p find_param_structure
  98   (type_p t, type_p param[NUM_PARAM]);
  99 static type_p adjust_field_tree_exp (type_p t, options_p opt);
 100 static type_p adjust_field_rtx_def (type_p t, options_p opt);
 101
 102 /* Define S as a typedef to T at POS.  */
 103
 104 void
 105 do_typedef (const char *s, type_p t, struct fileloc *pos)
 106 {
 107   pair_p p;
 108
 109   for (p = typedefs; p != NULL; p = p->next)
 110     if (strcmp (p->name, s) == 0)
 111       {
 112         if (p->type != t)
 113           {
 114             error_at_line (pos, "type `%s' previously defined", s);
 115             error_at_line (&p->line, "previously defined here");
 116           }
 117         return;
 118       }
 119
 120   p = xmalloc (sizeof (struct pair));
 121   p->next = typedefs;
 122   p->name = s;
 123   p->type = t;
 124   p->line = *pos;
 125   typedefs = p;
 126 }
 127
 128 /* Define S as a typename of a scalar.  */
 129
 130 static void
 131 do_scalar_typedef (const char *s, struct fileloc *pos)
 132 {
 133   do_typedef (s, create_scalar_type (s, strlen (s)), pos);
 134 }
 135
 136 /* Return the type previously defined for S.  Use POS to report errors.  */
 137
 138 type_p
 139 resolve_typedef (const char *s, struct fileloc *pos)
 140 {
 141   pair_p p;
 142   for (p = typedefs; p != NULL; p = p->next)
 143     if (strcmp (p->name, s) == 0)
 144       return p->type;
 145   error_at_line (pos, "unidentified type `%s'", s);
 146   return create_scalar_type ("char", 4);
 147 }
 148
 149 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
 150    at POS with fields FIELDS and options O.  */
 151
 152 void
 153 new_structure (const char *name, int isunion, struct fileloc *pos,
 154                pair_p fields, options_p o)
 155 {
 156   type_p si;
 157   type_p s = NULL;
 158   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 159
 160   for (si = structures; si != NULL; si = si->next)
 161     if (strcmp (name, si->u.s.tag) == 0
 162         && UNION_P (si) == isunion)
 163       {
 164         type_p ls = NULL;
 165         if (si->kind == TYPE_LANG_STRUCT)
 166           {
 167             ls = si;
 168
 169             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
 170               if (si->u.s.bitmap == bitmap)
 171                 s = si;
 172           }
 173         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
 174           {
 175             ls = si;
 176             si = xcalloc (1, sizeof (struct type));
 177             memcpy (si, ls, sizeof (struct type));
 178             ls->kind = TYPE_LANG_STRUCT;
 179             ls->u.s.lang_struct = si;
 180             ls->u.s.fields = NULL;
 181             si->next = NULL;
 182             si->pointer_to = NULL;
 183             si->u.s.lang_struct = ls;
 184           }
 185         else
 186           s = si;
 187
 188         if (ls != NULL && s == NULL)
 189           {
 190             s = xcalloc (1, sizeof (struct type));
 191             s->next = ls->u.s.lang_struct;
 192             ls->u.s.lang_struct = s;
 193             s->u.s.lang_struct = ls;
 194           }
 195         break;
 196       }
 197
 198   if (s == NULL)
 199     {
 200       s = xcalloc (1, sizeof (struct type));
 201       s->next = structures;
 202       structures = s;
 203     }
 204
 205   if (s->u.s.line.file != NULL
 206       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
 207     {
 208       error_at_line (pos, "duplicate structure definition");
 209       error_at_line (&s->u.s.line, "previous definition here");
 210     }
 211
 212   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 213   s->u.s.tag = name;
 214   s->u.s.line = *pos;
 215   s->u.s.fields = fields;
 216   s->u.s.opt = o;
 217   s->u.s.bitmap = bitmap;
 218   if (s->u.s.lang_struct)
 219     s->u.s.lang_struct->u.s.bitmap |= bitmap;
 220 }
 221
 222 /* Return the previously-defined structure with tag NAME (or a union
 223    iff ISUNION is nonzero), or a new empty structure or union if none
 224    was defined previously.  */
 225
 226 type_p
 227 find_structure (const char *name, int isunion)
 228 {
 229   type_p s;
 230
 231   for (s = structures; s != NULL; s = s->next)
 232     if (strcmp (name, s->u.s.tag) == 0
 233         && UNION_P (s) == isunion)
 234       return s;
 235
 236   s = xcalloc (1, sizeof (struct type));
 237   s->next = structures;
 238   structures = s;
 239   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 240   s->u.s.tag = name;
 241   structures = s;
 242   return s;
 243 }
 244
 245 /* Return the previously-defined parameterized structure for structure
 246    T and parameters PARAM, or a new parameterized empty structure or
 247    union if none was defined previously.  */
 248
 249 static type_p
 250 find_param_structure (type_p t, type_p param[NUM_PARAM])
 251 {
 252   type_p res;
 253
 254   for (res = param_structs; res; res = res->next)
 255     if (res->u.param_struct.stru == t
 256         && memcmp (res->u.param_struct.param, param,
 257                    sizeof (type_p) * NUM_PARAM) == 0)
 258       break;
 259   if (res == NULL)
 260     {
 261       res = xcalloc (1, sizeof (*res));
 262       res->kind = TYPE_PARAM_STRUCT;
 263       res->next = param_structs;
 264       param_structs = res;
 265       res->u.param_struct.stru = t;
 266       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
 267     }
 268   return res;
 269 }
 270
 271 /* Return a scalar type with name NAME.  */
 272
 273 type_p
 274 create_scalar_type (const char *name, size_t name_len)
 275 {
 276   type_p r = xcalloc (1, sizeof (struct type));
 277   r->kind = TYPE_SCALAR;
 278   r->u.sc = xmemdup (name, name_len, name_len + 1);
 279   return r;
 280 }
 281
 282 /* Return a pointer to T.  */
 283
 284 type_p
 285 create_pointer (type_p t)
 286 {
 287   if (! t->pointer_to)
 288     {
 289       type_p r = xcalloc (1, sizeof (struct type));
 290       r->kind = TYPE_POINTER;
 291       r->u.p = t;
 292       t->pointer_to = r;
 293     }
 294   return t->pointer_to;
 295 }
 296
 297 /* Return an array of length LEN.  */
 298
 299 type_p
 300 create_array (type_p t, const char *len)
 301 {
 302   type_p v;
 303
 304   v = xcalloc (1, sizeof (*v));
 305   v->kind = TYPE_ARRAY;
 306   v->u.a.p = t;
 307   v->u.a.len = len;
 308   return v;
 309 }
 310
 311 /* Add a variable named S of type T with options O defined at POS,
 312    to `variables'.  */
 313
 314 void
 315 note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
 316 {
 317   pair_p n;
 318   n = xmalloc (sizeof (*n));
 319   n->name = s;
 320   n->type = t;
 321   n->line = *pos;
 322   n->opt = o;
 323   n->next = variables;
 324   variables = n;
 325 }
 326
 327 /* We really don't care how long a CONST_DOUBLE is.  */
 328 #define CONST_DOUBLE_FORMAT "ww"
 329 const char * const rtx_format[NUM_RTX_CODE] = {
 330 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
 331 #include "rtl.def"
 332 #undef DEF_RTL_EXPR
 333 };
 334
 335 static int rtx_next_new[NUM_RTX_CODE];
 336
 337 /* Generate the contents of the rtx_next array.  This really doesn't belong
 338    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
 339
 340 static void
 341 gen_rtx_next (void)
 342 {
 343   int i;
 344   for (i = 0; i < NUM_RTX_CODE; i++)
 345     {
 346       int k;
 347
 348       rtx_next_new[i] = -1;
 349       if (strncmp (rtx_format[i], "iuu", 3) == 0)
 350         rtx_next_new[i] = 2;
 351       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
 352         rtx_next_new[i] = 1;
 353       else
 354         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
 355           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
 356             rtx_next_new[i] = k;
 357     }
 358 }
 359
 360 /* Write out the contents of the rtx_next array.  */
 361 static void
 362 write_rtx_next (void)
 363 {
 364   outf_p f = get_output_file_with_visibility (NULL);
 365   int i;
 366
 367   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
 368   oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
 369   for (i = 0; i < NUM_RTX_CODE; i++)
 370     if (rtx_next_new[i] == -1)
 371       oprintf (f, "  0,\n");
 372     else
 373       oprintf (f,
 374                "  offsetof (struct rtx_def, fld) + %d * sizeof (rtunion),\n",
 375                rtx_next_new[i]);
 376   oprintf (f, "};\n");
 377 }
 378
 379 /* Handle `special("rtx_def")'.  This is a special case for field
 380    `fld' of struct rtx_def, which is an array of unions whose values
 381    are based in a complex way on the type of RTL.  */
 382
 383 static type_p
 384 adjust_field_rtx_def (type_p t, options_p opt ATTRIBUTE_UNUSED)
 385 {
 386   pair_p flds = NULL;
 387   options_p nodot;
 388   int i;
 389   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
 390   type_p bitmap_tp, basic_block_tp, reg_attrs_tp;
 391
 392   static const char * const rtx_name[NUM_RTX_CODE] = {
 393 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
 394 #include "rtl.def"
 395 #undef DEF_RTL_EXPR
 396   };
 397
 398   if (t->kind != TYPE_ARRAY)
 399     {
 400       error_at_line (&lexer_line,
 401                      "special `rtx_def' must be applied to an array");
 402       return &string_type;
 403     }
 404
 405   nodot = xmalloc (sizeof (*nodot));
 406   nodot->next = NULL;
 407   nodot->name = "dot";
 408   nodot->info = "";
 409
 410   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
 411   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
 412   tree_tp = create_pointer (find_structure ("tree_node", 1));
 413   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
 414   reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
 415   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
 416   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
 417   scalar_tp = create_scalar_type ("rtunion scalar", 14);
 418
 419   {
 420     pair_p note_flds = NULL;
 421     int c;
 422
 423     for (c = NOTE_INSN_BIAS; c <= NOTE_INSN_MAX; c++)
 424       {
 425         pair_p old_note_flds = note_flds;
 426
 427         note_flds = xmalloc (sizeof (*note_flds));
 428         note_flds->line.file = __FILE__;
 429         note_flds->line.line = __LINE__;
 430         note_flds->opt = xmalloc (sizeof (*note_flds->opt));
 431         note_flds->opt->next = nodot;
 432         note_flds->opt->name = "tag";
 433         note_flds->opt->info = xasprintf ("%d", c);
 434         note_flds->next = old_note_flds;
 435
 436         switch (c)
 437           {
 438             /* NOTE_INSN_MAX is used as the default field for line
 439                number notes.  */
 440           case NOTE_INSN_MAX:
 441             note_flds->opt->name = "default";
 442             note_flds->name = "rtstr";
 443             note_flds->type = &string_type;
 444             break;
 445
 446           case NOTE_INSN_BLOCK_BEG:
 447           case NOTE_INSN_BLOCK_END:
 448             note_flds->name = "rttree";
 449             note_flds->type = tree_tp;
 450             break;
 451
 452           case NOTE_INSN_EXPECTED_VALUE:
 453             note_flds->name = "rtx";
 454             note_flds->type = rtx_tp;
 455             break;
 456
 457           default:
 458             note_flds->name = "rtint";
 459             note_flds->type = scalar_tp;
 460             break;
 461           }
 462       }
 463     new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
 464   }
 465
 466   note_union_tp = find_structure ("rtx_def_note_subunion", 1);
 467
 468   for (i = 0; i < NUM_RTX_CODE; i++)
 469     {
 470       pair_p old_flds = flds;
 471       pair_p subfields = NULL;
 472       size_t aindex, nmindex;
 473       const char *sname;
 474       char *ftag;
 475
 476       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
 477         {
 478           pair_p old_subf = subfields;
 479           type_p t;
 480           const char *subname;
 481
 482           switch (rtx_format[i][aindex])
 483             {
 484             case '*':
 485             case 'i':
 486             case 'n':
 487             case 'w':
 488               t = scalar_tp;
 489               subname = "rtint";
 490               break;
 491
 492             case '0':
 493               if (i == MEM && aindex == 1)
 494                 t = mem_attrs_tp, subname = "rtmem";
 495               else if (i == JUMP_INSN && aindex == 9)
 496                 t = rtx_tp, subname = "rtx";
 497               else if (i == CODE_LABEL && aindex == 4)
 498                 t = scalar_tp, subname = "rtint";
 499               else if (i == CODE_LABEL && aindex == 5)
 500                 t = rtx_tp, subname = "rtx";
 501               else if (i == LABEL_REF
 502                        && (aindex == 1 || aindex == 2))
 503                 t = rtx_tp, subname = "rtx";
 504               else if (i == NOTE && aindex == 4)
 505                 t = note_union_tp, subname = "";
 506               else if (i == NOTE && aindex >= 7)
 507                 t = scalar_tp, subname = "rtint";
 508               else if (i == ADDR_DIFF_VEC && aindex == 4)
 509                 t = scalar_tp, subname = "rtint";
 510               else if (i == VALUE && aindex == 0)
 511                 t = scalar_tp, subname = "rtint";
 512               else if (i == REG && aindex == 1)
 513                 t = scalar_tp, subname = "rtint";
 514               else if (i == REG && aindex == 2)
 515                 t = reg_attrs_tp, subname = "rtreg";
 516               else if (i == SCRATCH && aindex == 0)
 517                 t = scalar_tp, subname = "rtint";
 518               else if (i == SYMBOL_REF && aindex == 1)
 519                 t = scalar_tp, subname = "rtint";
 520               else if (i == SYMBOL_REF && aindex == 2)
 521                 t = tree_tp, subname = "rttree";
 522               else if (i == BARRIER && aindex >= 3)
 523                 t = scalar_tp, subname = "rtint";
 524               else
 525                 {
 526                   error_at_line (&lexer_line,
 527                         "rtx type `%s' has `0' in position %lu, can't handle",
 528                                  rtx_name[i], (unsigned long) aindex);
 529                   t = &string_type;
 530                   subname = "rtint";
 531                 }
 532               break;
 533
 534             case 's':
 535             case 'S':
 536             case 'T':
 537               t = &string_type;
 538               subname = "rtstr";
 539               break;
 540
 541             case 'e':
 542             case 'u':
 543               t = rtx_tp;
 544               subname = "rtx";
 545               break;
 546
 547             case 'E':
 548             case 'V':
 549               t = rtvec_tp;
 550               subname = "rtvec";
 551               break;
 552
 553             case 't':
 554               t = tree_tp;
 555               subname = "rttree";
 556               break;
 557
 558             case 'b':
 559               t = bitmap_tp;
 560               subname = "rtbit";
 561               break;
 562
 563             case 'B':
 564               t = basic_block_tp;
 565               subname = "bb";
 566               break;
 567
 568             default:
 569               error_at_line (&lexer_line,
 570                      "rtx type `%s' has `%c' in position %lu, can't handle",
 571                              rtx_name[i], rtx_format[i][aindex],
 572                              (unsigned long)aindex);
 573               t = &string_type;
 574               subname = "rtint";
 575               break;
 576             }
 577
 578           subfields = xmalloc (sizeof (*subfields));
 579           subfields->next = old_subf;
 580           subfields->type = t;
 581           subfields->name = xasprintf ("[%lu].%s", (unsigned long)aindex,
 582                                        subname);
 583           subfields->line.file = __FILE__;
 584           subfields->line.line = __LINE__;
 585           if (t == note_union_tp)
 586             {
 587               subfields->opt = xmalloc (sizeof (*subfields->opt));
 588               subfields->opt->next = nodot;
 589               subfields->opt->name = "desc";
 590               subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
 591             }
 592           else if (t == basic_block_tp)
 593             {
 594               /* We don't presently GC basic block structures...  */
 595               subfields->opt = xmalloc (sizeof (*subfields->opt));
 596               subfields->opt->next = nodot;
 597               subfields->opt->name = "skip";
 598               subfields->opt->info = NULL;
 599             }
 600           else
 601             subfields->opt = nodot;
 602         }
 603
 604       flds = xmalloc (sizeof (*flds));
 605       flds->next = old_flds;
 606       flds->name = "";
 607       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
 608       new_structure (sname, 0, &lexer_line, subfields, NULL);
 609       flds->type = find_structure (sname, 0);
 610       flds->line.file = __FILE__;
 611       flds->line.line = __LINE__;
 612       flds->opt = xmalloc (sizeof (*flds->opt));
 613       flds->opt->next = nodot;
 614       flds->opt->name = "tag";
 615       ftag = xstrdup (rtx_name[i]);
 616       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
 617         ftag[nmindex] = TOUPPER (ftag[nmindex]);
 618       flds->opt->info = ftag;
 619     }
 620
 621   new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
 622   return find_structure ("rtx_def_subunion", 1);
 623 }
 624
 625 /* Handle `special("tree_exp")'.  This is a special case for
 626    field `operands' of struct tree_exp, which although it claims to contain
 627    pointers to trees, actually sometimes contains pointers to RTL too.
 628    Passed T, the old type of the field, and OPT its options.  Returns
 629    a new type for the field.  */
 630
 631 static type_p
 632 adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
 633 {
 634   pair_p flds;
 635   options_p nodot;
 636   size_t i;
 637   static const struct {
 638     const char *name;
 639     int first_rtl;
 640     int num_rtl;
 641   } data[] = {
 642     { "SAVE_EXPR", 2, 1 },
 643     { "GOTO_SUBROUTINE_EXPR", 0, 2 },
 644     { "RTL_EXPR", 0, 2 },
 645     { "WITH_CLEANUP_EXPR", 2, 1 },
 646     { "METHOD_CALL_EXPR", 3, 1 }
 647   };
 648
 649   if (t->kind != TYPE_ARRAY)
 650     {
 651       error_at_line (&lexer_line,
 652                      "special `tree_exp' must be applied to an array");
 653       return &string_type;
 654     }
 655
 656   nodot = xmalloc (sizeof (*nodot));
 657   nodot->next = NULL;
 658   nodot->name = "dot";
 659   nodot->info = "";
 660
 661   flds = xmalloc (sizeof (*flds));
 662   flds->next = NULL;
 663   flds->name = "";
 664   flds->type = t;
 665   flds->line.file = __FILE__;
 666   flds->line.line = __LINE__;
 667   flds->opt = xmalloc (sizeof (*flds->opt));
 668   flds->opt->next = nodot;
 669   flds->opt->name = "length";
 670   flds->opt->info = "TREE_CODE_LENGTH (TREE_CODE ((tree) &%0))";
 671   {
 672     options_p oldopt = flds->opt;
 673     flds->opt = xmalloc (sizeof (*flds->opt));
 674     flds->opt->next = oldopt;
 675     flds->opt->name = "default";
 676     flds->opt->info = "";
 677   }
 678
 679   for (i = 0; i < ARRAY_SIZE (data); i++)
 680     {
 681       pair_p old_flds = flds;
 682       pair_p subfields = NULL;
 683       int r_index;
 684       const char *sname;
 685
 686       for (r_index = 0;
 687            r_index < data[i].first_rtl + data[i].num_rtl;
 688            r_index++)
 689         {
 690           pair_p old_subf = subfields;
 691           subfields = xmalloc (sizeof (*subfields));
 692           subfields->next = old_subf;
 693           subfields->name = xasprintf ("[%d]", r_index);
 694           if (r_index < data[i].first_rtl)
 695             subfields->type = t->u.a.p;
 696           else
 697             subfields->type = create_pointer (find_structure ("rtx_def", 0));
 698           subfields->line.file = __FILE__;
 699           subfields->line.line = __LINE__;
 700           subfields->opt = nodot;
 701         }
 702
 703       flds = xmalloc (sizeof (*flds));
 704       flds->next = old_flds;
 705       flds->name = "";
 706       sname = xasprintf ("tree_exp_%s", data[i].name);
 707       new_structure (sname, 0, &lexer_line, subfields, NULL);
 708       flds->type = find_structure (sname, 0);
 709       flds->line.file = __FILE__;
 710       flds->line.line = __LINE__;
 711       flds->opt = xmalloc (sizeof (*flds->opt));
 712       flds->opt->next = nodot;
 713       flds->opt->name = "tag";
 714       flds->opt->info = data[i].name;
 715     }
 716
 717   new_structure ("tree_exp_subunion", 1, &lexer_line, flds, nodot);
 718   return find_structure ("tree_exp_subunion", 1);
 719 }
 720
 721 /* Perform any special processing on a type T, about to become the type
 722    of a field.  Return the appropriate type for the field.
 723    At present:
 724    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
 725    - Similarly for arrays of pointer-to-char;
 726    - Converts structures for which a parameter is provided to
 727      TYPE_PARAM_STRUCT;
 728    - Handles "special" options.
 729 */
 730
 731 type_p
 732 adjust_field_type (type_p t, options_p opt)
 733 {
 734   int length_p = 0;
 735   const int pointer_p = t->kind == TYPE_POINTER;
 736   type_p params[NUM_PARAM];
 737   int params_p = 0;
 738   int i;
 739
 740   for (i = 0; i < NUM_PARAM; i++)
 741     params[i] = NULL;
 742
 743   for (; opt; opt = opt->next)
 744     if (strcmp (opt->name, "length") == 0)
 745       length_p = 1;
 746     else if (strcmp (opt->name, "param_is") == 0
 747              || (strncmp (opt->name, "param", 5) == 0
 748                  && ISDIGIT (opt->name[5])
 749                  && strcmp (opt->name + 6, "_is") == 0))
 750       {
 751         int num = ISDIGIT (opt->name[5]) ? opt->name[5] - '0' : 0;
 752
 753         if (! UNION_OR_STRUCT_P (t)
 754             && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
 755           {
 756             error_at_line (&lexer_line,
 757    "option `%s' may only be applied to structures or structure pointers",
 758                            opt->name);
 759             return t;
 760           }
 761
 762         params_p = 1;
 763         if (params[num] != NULL)
 764           error_at_line (&lexer_line, "duplicate `%s' option", opt->name);
 765         if (! ISDIGIT (opt->name[5]))
 766           params[num] = create_pointer ((type_p) opt->info);
 767         else
 768           params[num] = (type_p) opt->info;
 769       }
 770     else if (strcmp (opt->name, "special") == 0)
 771       {
 772         const char *special_name = (const char *)opt->info;
 773         if (strcmp (special_name, "tree_exp") == 0)
 774           t = adjust_field_tree_exp (t, opt);
 775         else if (strcmp (special_name, "rtx_def") == 0)
 776           t = adjust_field_rtx_def (t, opt);
 777         else
 778           error_at_line (&lexer_line, "unknown special `%s'", special_name);
 779       }
 780
 781   if (params_p)
 782     {
 783       type_p realt;
 784
 785       if (pointer_p)
 786         t = t->u.p;
 787       realt = find_param_structure (t, params);
 788       t = pointer_p ? create_pointer (realt) : realt;
 789     }
 790
 791   if (! length_p
 792       && pointer_p
 793       && t->u.p->kind == TYPE_SCALAR
 794       && (strcmp (t->u.p->u.sc, "char") == 0
 795           || strcmp (t->u.p->u.sc, "unsigned char") == 0))
 796     return &string_type;
 797   if (t->kind == TYPE_ARRAY && t->u.a.p->kind == TYPE_POINTER
 798       && t->u.a.p->u.p->kind == TYPE_SCALAR
 799       && (strcmp (t->u.a.p->u.p->u.sc, "char") == 0
 800           || strcmp (t->u.a.p->u.p->u.sc, "unsigned char") == 0))
 801     return create_array (&string_type, t->u.a.len);
 802
 803   return t;
 804 }
 805
 806 /* Create a union for YYSTYPE, as yacc would do it, given a fieldlist FIELDS
 807    and information about the correspondence between token types and fields
 808    in TYPEINFO.  POS is used for error messages.  */
 809
 810 void
 811 note_yacc_type (options_p o, pair_p fields, pair_p typeinfo,
 812                 struct fileloc *pos)
 813 {
 814   pair_p p;
 815   pair_p *p_p;
 816
 817   for (p = typeinfo; p; p = p->next)
 818     {
 819       pair_p m;
 820
 821       if (p->name == NULL)
 822         continue;
 823
 824       if (p->type == (type_p) 1)
 825         {
 826           pair_p pp;
 827           int ok = 0;
 828
 829           for (pp = typeinfo; pp; pp = pp->next)
 830             if (pp->type != (type_p) 1
 831                 && strcmp (pp->opt->info, p->opt->info) == 0)
 832               {
 833                 ok = 1;
 834                 break;
 835               }
 836           if (! ok)
 837             continue;
 838         }
 839
 840       for (m = fields; m; m = m->next)
 841         if (strcmp (m->name, p->name) == 0)
 842           p->type = m->type;
 843       if (p->type == NULL)
 844         {
 845           error_at_line (&p->line,
 846                          "couldn't match fieldname `%s'", p->name);
 847           p->name = NULL;
 848         }
 849     }
 850
 851   p_p = &typeinfo;
 852   while (*p_p)
 853     {
 854       pair_p p = *p_p;
 855
 856       if (p->name == NULL
 857           || p->type == (type_p) 1)
 858         *p_p = p->next;
 859       else
 860         p_p = &p->next;
 861     }
 862
 863   new_structure ("yy_union", 1, pos, typeinfo, o);
 864   do_typedef ("YYSTYPE", find_structure ("yy_union", 1), pos);
 865 }
 866 \f
 867 static void process_gc_options (options_p, enum gc_used_enum,
 868                                 int *, int *, int *);
 869 static void set_gc_used_type (type_p, enum gc_used_enum, type_p *);
 870 static void set_gc_used (pair_p);
 871
 872 /* Handle OPT for set_gc_used_type.  */
 873
 874 static void
 875 process_gc_options (options_p opt, enum gc_used_enum level, int *maybe_undef,
 876                     int *pass_param, int *length)
 877 {
 878   options_p o;
 879   for (o = opt; o; o = o->next)
 880     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
 881       set_gc_used_type ((type_p) o->info, GC_POINTED_TO, NULL);
 882     else if (strcmp (o->name, "maybe_undef") == 0)
 883       *maybe_undef = 1;
 884     else if (strcmp (o->name, "use_params") == 0)
 885       *pass_param = 1;
 886     else if (strcmp (o->name, "length") == 0)
 887       *length = 1;
 888 }
 889
 890 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
 891
 892 static void
 893 set_gc_used_type (type_p t, enum gc_used_enum level, type_p param[NUM_PARAM])
 894 {
 895   if (t->gc_used >= level)
 896     return;
 897
 898   t->gc_used = level;
 899
 900   switch (t->kind)
 901     {
 902     case TYPE_STRUCT:
 903     case TYPE_UNION:
 904       {
 905         pair_p f;
 906         int dummy;
 907
 908         process_gc_options (t->u.s.opt, level, &dummy, &dummy, &dummy);
 909
 910         for (f = t->u.s.fields; f; f = f->next)
 911           {
 912             int maybe_undef = 0;
 913             int pass_param = 0;
 914             int length = 0;
 915             process_gc_options (f->opt, level, &maybe_undef, &pass_param,
 916                                 &length);
 917
 918             if (length && f->type->kind == TYPE_POINTER)
 919               set_gc_used_type (f->type->u.p, GC_USED, NULL);
 920             else if (maybe_undef && f->type->kind == TYPE_POINTER)
 921               set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO, NULL);
 922             else if (pass_param && f->type->kind == TYPE_POINTER && param)
 923               set_gc_used_type (find_param_structure (f->type->u.p, param),
 924                                 GC_POINTED_TO, NULL);
 925             else
 926               set_gc_used_type (f->type, GC_USED, pass_param ? param : NULL);
 927           }
 928         break;
 929       }
 930
 931     case TYPE_POINTER:
 932       set_gc_used_type (t->u.p, GC_POINTED_TO, NULL);
 933       break;
 934
 935     case TYPE_ARRAY:
 936       set_gc_used_type (t->u.a.p, GC_USED, param);
 937       break;
 938
 939     case TYPE_LANG_STRUCT:
 940       for (t = t->u.s.lang_struct; t; t = t->next)
 941         set_gc_used_type (t, level, param);
 942       break;
 943
 944     case TYPE_PARAM_STRUCT:
 945       {
 946         int i;
 947         for (i = 0; i < NUM_PARAM; i++)
 948           if (t->u.param_struct.param[i] != 0)
 949             set_gc_used_type (t->u.param_struct.param[i], GC_USED, NULL);
 950       }
 951       if (t->u.param_struct.stru->gc_used == GC_POINTED_TO)
 952         level = GC_POINTED_TO;
 953       else
 954         level = GC_USED;
 955       t->u.param_struct.stru->gc_used = GC_UNUSED;
 956       set_gc_used_type (t->u.param_struct.stru, level,
 957                         t->u.param_struct.param);
 958       break;
 959
 960     default:
 961       break;
 962     }
 963 }
 964
 965 /* Set the gc_used fields of all the types pointed to by VARIABLES.  */
 966
 967 static void
 968 set_gc_used (pair_p variables)
 969 {
 970   pair_p p;
 971   for (p = variables; p; p = p->next)
 972     set_gc_used_type (p->type, GC_USED, NULL);
 973 }
 974 \f
 975 /* File mapping routines.  For each input file, there is one output .c file
 976    (but some output files have many input files), and there is one .h file
 977    for the whole build.  */
 978
 979 /* The list of output files.  */
 980 static outf_p output_files;
 981
 982 /* The output header file that is included into pretty much every
 983    source file.  */
 984 outf_p header_file;
 985
 986 /* Number of files specified in gtfiles.  */
 987 #define NUM_GT_FILES (ARRAY_SIZE (all_files) - 1)
 988
 989 /* Number of files in the language files array.  */
 990 #define NUM_LANG_FILES (ARRAY_SIZE (lang_files) - 1)
 991
 992 /* Length of srcdir name.  */
 993 static int srcdir_len = 0;
 994
 995 #define NUM_BASE_FILES (ARRAY_SIZE (lang_dir_names) - 1)
 996 outf_p base_files[NUM_BASE_FILES];
 997
 998 static outf_p create_file (const char *, const char *);
 999 static const char * get_file_basename (const char *);
1000
1001 /* Create and return an outf_p for a new file for NAME, to be called
1002    ONAME.  */
1003
1004 static outf_p
1005 create_file (const char *name, const char *oname)
1006 {
1007   static const char *const hdr[] = {
1008     "   Copyright (C) 2003 Free Software Foundation, Inc.\n",
1009     "\n",
1010     "This file is part of GCC.\n",
1011     "\n",
1012     "GCC is free software; you can redistribute it and/or modify it under\n",
1013     "the terms of the GNU General Public License as published by the Free\n",
1014     "Software Foundation; either version 2, or (at your option) any later\n",
1015     "version.\n",
1016     "\n",
1017     "GCC is distributed in the hope that it will be useful, but WITHOUT ANY\n",
1018     "WARRANTY; without even the implied warranty of MERCHANTABILITY or\n",
1019     "FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License\n",
1020     "for more details.\n",
1021     "\n",
1022     "You should have received a copy of the GNU General Public License\n",
1023     "along with GCC; see the file COPYING.  If not, write to the Free\n",
1024     "Software Foundation, 59 Temple Place - Suite 330, Boston, MA\n",
1025     "02111-1307, USA.  */\n",
1026     "\n",
1027     "/* This file is machine generated.  Do not edit.  */\n"
1028   };
1029   outf_p f;
1030   size_t i;
1031
1032   f = xcalloc (sizeof (*f), 1);
1033   f->next = output_files;
1034   f->name = oname;
1035   output_files = f;
1036
1037   oprintf (f, "/* Type information for %s.\n", name);
1038   for (i = 0; i < ARRAY_SIZE (hdr); i++)
1039     oprintf (f, "%s", hdr[i]);
1040   return f;
1041 }
1042
1043 /* Print, like fprintf, to O.  */
1044 void
1045 oprintf (outf_p o, const char *format, ...)
1046 {
1047   char *s;
1048   size_t slength;
1049   va_list ap;
1050
1051   va_start (ap, format);
1052   slength = xvasprintf (&s, format, ap);
1053
1054   if (o->bufused + slength > o->buflength)
1055     {
1056       size_t new_len = o->buflength;
1057       if (new_len == 0)
1058         new_len = 1024;
1059       do {
1060         new_len *= 2;
1061       } while (o->bufused + slength >= new_len);
1062       o->buf = xrealloc (o->buf, new_len);
1063       o->buflength = new_len;
1064     }
1065   memcpy (o->buf + o->bufused, s, slength);
1066   o->bufused += slength;
1067   free (s);
1068   va_end (ap);
1069 }
1070
1071 /* Open the global header file and the language-specific header files.  */
1072
1073 static void
1074 open_base_files (void)
1075 {
1076   size_t i;
1077
1078   header_file = create_file ("GCC", "gtype-desc.h");
1079
1080   for (i = 0; i < NUM_BASE_FILES; i++)
1081     base_files[i] = create_file (lang_dir_names[i],
1082                                  xasprintf ("gtype-%s.h", lang_dir_names[i]));
1083
1084   /* gtype-desc.c is a little special, so we create it here.  */
1085   {
1086     /* The order of files here matters very much.  */
1087     static const char *const ifiles [] = {
1088       "config.h", "system.h", "coretypes.h", "tm.h", "varray.h",
1089       "hashtab.h", "splay-tree.h", "bitmap.h", "tree.h", "rtl.h",
1090       "function.h", "insn-config.h", "expr.h", "hard-reg-set.h",
1091       "basic-block.h", "cselib.h", "insn-addr.h", "ssa.h", "optabs.h",
1092       "libfuncs.h", "debug.h", "ggc.h", "cgraph.h",
1093       NULL
1094     };
1095     const char *const *ifp;
1096     outf_p gtype_desc_c;
1097
1098     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
1099     for (ifp = ifiles; *ifp; ifp++)
1100       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
1101   }
1102 }
1103
1104 /* Determine the pathname to F relative to $(srcdir).  */
1105
1106 static const char *
1107 get_file_basename (const char *f)
1108 {
1109   const char *basename;
1110   unsigned i;
1111
1112   basename = strrchr (f, '/');
1113
1114   if (!basename)
1115     return f;
1116
1117   basename++;
1118
1119   for (i = 1; i < NUM_BASE_FILES; i++)
1120     {
1121       const char * s1;
1122       const char * s2;
1123       int l1;
1124       int l2;
1125       s1 = basename - strlen (lang_dir_names [i]) - 1;
1126       s2 = lang_dir_names [i];
1127       l1 = strlen (s1);
1128       l2 = strlen (s2);
1129       if (l1 >= l2 && !memcmp (s1, s2, l2))
1130         {
1131           basename -= l2 + 1;
1132           if ((basename - f - 1) != srcdir_len)
1133             abort (); /* Match is wrong - should be preceded by $srcdir.  */
1134           break;
1135         }
1136     }
1137
1138   return basename;
1139 }
1140
1141 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
1142    INPUT_FILE is used by <lang>.
1143
1144    This function should be written to assume that a file _is_ used
1145    if the situation is unclear.  If it wrongly assumes a file _is_ used,
1146    a linker error will result.  If it wrongly assumes a file _is not_ used,
1147    some GC roots may be missed, which is a much harder-to-debug problem.  */
1148
1149 unsigned
1150 get_base_file_bitmap (const char *input_file)
1151 {
1152   const char *basename = get_file_basename (input_file);
1153   const char *slashpos = strchr (basename, '/');
1154   unsigned j;
1155   unsigned k;
1156   unsigned bitmap;
1157
1158   if (slashpos)
1159     {
1160       size_t i;
1161       for (i = 1; i < NUM_BASE_FILES; i++)
1162         if ((size_t)(slashpos - basename) == strlen (lang_dir_names [i])
1163             && memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0)
1164           {
1165             /* It's in a language directory, set that language.  */
1166             bitmap = 1 << i;
1167             return bitmap;
1168           }
1169
1170       abort (); /* Should have found the language.  */
1171     }
1172
1173   /* If it's in any config-lang.in, then set for the languages
1174      specified.  */
1175
1176   bitmap = 0;
1177
1178   for (j = 0; j < NUM_LANG_FILES; j++)
1179     {
1180       if (!strcmp(input_file, lang_files[j]))
1181         {
1182           for (k = 0; k < NUM_BASE_FILES; k++)
1183             {
1184               if (!strcmp(lang_dir_names[k], langs_for_lang_files[j]))
1185                 bitmap |= (1 << k);
1186             }
1187         }
1188     }
1189
1190   /* Otherwise, set all languages.  */
1191   if (!bitmap)
1192     bitmap = (1 << NUM_BASE_FILES) - 1;
1193
1194   return bitmap;
1195 }
1196
1197 /* An output file, suitable for definitions, that can see declarations
1198    made in INPUT_FILE and is linked into every language that uses
1199    INPUT_FILE.  */
1200
1201 outf_p
1202 get_output_file_with_visibility (const char *input_file)
1203 {
1204   outf_p r;
1205   size_t len;
1206   const char *basename;
1207   const char *for_name;
1208   const char *output_name;
1209
1210   /* This can happen when we need a file with visibility on a
1211      structure that we've never seen.  We have to just hope that it's
1212      globally visible.  */
1213   if (input_file == NULL)
1214     input_file = "system.h";
1215
1216   /* Determine the output file name.  */
1217   basename = get_file_basename (input_file);
1218
1219   len = strlen (basename);
1220   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
1221       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
1222       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
1223     {
1224       char *s;
1225
1226       output_name = s = xasprintf ("gt-%s", basename);
1227       for (; *s != '.'; s++)
1228         if (! ISALNUM (*s) && *s != '-')
1229           *s = '-';
1230       memcpy (s, ".h", sizeof (".h"));
1231       for_name = basename;
1232     }
1233   else if (strcmp (basename, "c-common.h") == 0)
1234     output_name = "gt-c-common.h", for_name = "c-common.c";
1235   else if (strcmp (basename, "c-tree.h") == 0)
1236     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1237   else
1238     {
1239       size_t i;
1240
1241       for (i = 0; i < NUM_BASE_FILES; i++)
1242         if (memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0
1243             && basename[strlen(lang_dir_names[i])] == '/')
1244           return base_files[i];
1245
1246       output_name = "gtype-desc.c";
1247       for_name = NULL;
1248     }
1249
1250   /* Look through to see if we've ever seen this output filename before.  */
1251   for (r = output_files; r; r = r->next)
1252     if (strcmp (r->name, output_name) == 0)
1253       return r;
1254
1255   /* If not, create it.  */
1256   r = create_file (for_name, output_name);
1257
1258   return r;
1259 }
1260
1261 /* The name of an output file, suitable for definitions, that can see
1262    declarations made in INPUT_FILE and is linked into every language
1263    that uses INPUT_FILE.  */
1264
1265 const char *
1266 get_output_file_name (const char *input_file)
1267 {
1268   return get_output_file_with_visibility (input_file)->name;
1269 }
1270
1271 /* Copy the output to its final destination,
1272    but don't unnecessarily change modification times.  */
1273
1274 static void
1275 close_output_files (void)
1276 {
1277   outf_p of;
1278
1279   for (of = output_files; of; of = of->next)
1280     {
1281       FILE * newfile;
1282
1283       newfile = fopen (of->name, "r");
1284       if (newfile != NULL )
1285         {
1286           int no_write_p;
1287           size_t i;
1288
1289           for (i = 0; i < of->bufused; i++)
1290             {
1291               int ch;
1292               ch = fgetc (newfile);
1293               if (ch == EOF || ch != (unsigned char) of->buf[i])
1294                 break;
1295             }
1296           no_write_p = i == of->bufused && fgetc (newfile) == EOF;
1297           fclose (newfile);
1298
1299           if (no_write_p)
1300             continue;
1301         }
1302
1303       newfile = fopen (of->name, "w");
1304       if (newfile == NULL)
1305         {
1306           perror ("opening output file");
1307           exit (1);
1308         }
1309       if (fwrite (of->buf, 1, of->bufused, newfile) != of->bufused)
1310         {
1311           perror ("writing output file");
1312           exit (1);
1313         }
1314       if (fclose (newfile) != 0)
1315         {
1316           perror ("closing output file");
1317           exit (1);
1318         }
1319     }
1320 }
1321 \f
1322 struct flist {
1323   struct flist *next;
1324   int started_p;
1325   const char *name;
1326   outf_p f;
1327 };
1328
1329 struct walk_type_data;
1330
1331 /* For scalars and strings, given the item in 'val'.
1332    For structures, given a pointer to the item in 'val'.
1333    For misc. pointers, given the item in 'val'.
1334 */
1335 typedef void (*process_field_fn)
1336      (type_p f, const struct walk_type_data *p);
1337 typedef void (*func_name_fn)
1338      (type_p s, const struct walk_type_data *p);
1339
1340 /* Parameters for write_types.  */
1341
1342 struct write_types_data
1343 {
1344   const char *prefix;
1345   const char *param_prefix;
1346   const char *subfield_marker_routine;
1347   const char *marker_routine;
1348   const char *reorder_note_routine;
1349   const char *comment;
1350 };
1351
1352 static void output_escaped_param (struct walk_type_data *d,
1353                                   const char *, const char *);
1354 static void output_mangled_typename (outf_p, type_p);
1355 static void walk_type (type_p t, struct walk_type_data *d);
1356 static void write_func_for_structure
1357      (type_p orig_s, type_p s, type_p * param,
1358       const struct write_types_data *wtd);
1359 static void write_types_process_field
1360      (type_p f, const struct walk_type_data *d);
1361 static void write_types (type_p structures,
1362                          type_p param_structs,
1363                          const struct write_types_data *wtd);
1364 static void write_types_local_process_field
1365      (type_p f, const struct walk_type_data *d);
1366 static void write_local_func_for_structure
1367      (type_p orig_s, type_p s, type_p * param);
1368 static void write_local (type_p structures,
1369                          type_p param_structs);
1370 static void write_enum_defn (type_p structures, type_p param_structs);
1371 static int contains_scalar_p (type_p t);
1372 static void put_mangled_filename (outf_p , const char *);
1373 static void finish_root_table (struct flist *flp, const char *pfx,
1374                                const char *tname, const char *lastname,
1375                                const char *name);
1376 static void write_root (outf_p , pair_p, type_p, const char *, int,
1377                         struct fileloc *, const char *);
1378 static void write_array (outf_p f, pair_p v,
1379                          const struct write_types_data *wtd);
1380 static void write_roots (pair_p);
1381
1382 /* Parameters for walk_type.  */
1383
1384 struct walk_type_data
1385 {
1386   process_field_fn process_field;
1387   const void *cookie;
1388   outf_p of;
1389   options_p opt;
1390   const char *val;
1391   const char *prev_val[4];
1392   int indent;
1393   int counter;
1394   struct fileloc *line;
1395   lang_bitmap bitmap;
1396   type_p *param;
1397   int used_length;
1398   type_p orig_s;
1399   const char *reorder_fn;
1400   int needs_cast_p;
1401 };
1402
1403 /* Print a mangled name representing T to OF.  */
1404
1405 static void
1406 output_mangled_typename (outf_p of, type_p t)
1407 {
1408   if (t == NULL)
1409     oprintf (of, "Z");
1410   else switch (t->kind)
1411     {
1412     case TYPE_POINTER:
1413       oprintf (of, "P");
1414       output_mangled_typename (of, t->u.p);
1415       break;
1416     case TYPE_SCALAR:
1417       oprintf (of, "I");
1418       break;
1419     case TYPE_STRING:
1420       oprintf (of, "S");
1421       break;
1422     case TYPE_STRUCT:
1423     case TYPE_UNION:
1424     case TYPE_LANG_STRUCT:
1425       oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
1426       break;
1427     case TYPE_PARAM_STRUCT:
1428       {
1429         int i;
1430         for (i = 0; i < NUM_PARAM; i++)
1431           if (t->u.param_struct.param[i] != NULL)
1432             output_mangled_typename (of, t->u.param_struct.param[i]);
1433         output_mangled_typename (of, t->u.param_struct.stru);
1434       }
1435       break;
1436     case TYPE_ARRAY:
1437       abort ();
1438     }
1439 }
1440
1441 /* Print PARAM to D->OF processing escapes.  D->VAL references the
1442    current object, D->PREV_VAL the object containing the current
1443    object, ONAME is the name of the option and D->LINE is used to
1444    print error messages.  */
1445
1446 static void
1447 output_escaped_param (struct walk_type_data *d, const char *param,
1448                       const char *oname)
1449 {
1450   const char *p;
1451
1452   for (p = param; *p; p++)
1453     if (*p != '%')
1454       oprintf (d->of, "%c", *p);
1455     else switch (*++p)
1456       {
1457       case 'h':
1458         oprintf (d->of, "(%s)", d->prev_val[2]);
1459         break;
1460       case '0':
1461         oprintf (d->of, "(%s)", d->prev_val[0]);
1462         break;
1463       case '1':
1464         oprintf (d->of, "(%s)", d->prev_val[1]);
1465         break;
1466       case 'a':
1467         {
1468           const char *pp = d->val + strlen (d->val);
1469           while (pp[-1] == ']')
1470             while (*pp != '[')
1471               pp--;
1472           oprintf (d->of, "%s", pp);
1473         }
1474         break;
1475       default:
1476         error_at_line (d->line, "`%s' option contains bad escape %c%c",
1477                        oname, '%', *p);
1478       }
1479 }
1480
1481 /* Call D->PROCESS_FIELD for every field (or subfield) of D->VAL,
1482    which is of type T.  Write code to D->OF to constrain execution (at
1483    the point that D->PROCESS_FIELD is called) to the appropriate
1484    cases.  D->PREV_VAL lists the objects containing the current object,
1485    D->OPT is a list of options to apply, D->INDENT is the current
1486    indentation level, D->LINE is used to print error messages,
1487    D->BITMAP indicates which languages to print the structure for, and
1488    D->PARAM is the current parameter (from an enclosing param_is
1489    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             d->process_field(t, d);
1627             oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1628                      loopcounter, loopcounter);
1629             output_escaped_param (d, length, "length");
1630             oprintf (d->of, "); i%d++) {\n", loopcounter);
1631             d->indent += 2;
1632             d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1633             d->used_length = 1;
1634             d->prev_val[3] = oldval;
1635             walk_type (t->u.p, d);
1636             free (newval);
1637             d->val = oldval;
1638             d->prev_val[3] = oldprevval3;
1639             d->used_length = 0;
1640             d->indent -= 2;
1641             oprintf (d->of, "%*s}\n", d->indent, "");
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
2918   do_typedef ("PTR", create_pointer (create_scalar_type ("void",
2919                                                          strlen ("void"))),
2920               &pos);
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 }