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, " (x_p)\n");
1964   oprintf (d.of, "      void *x_p;\n");
1965   oprintf (d.of, "{\n");
1966   oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
1967            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1968            chain_next == NULL ? "const " : "",
1969            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1970   if (chain_next != NULL)
1971     oprintf (d.of, "  %s %s * xlimit = x;\n",
1972              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1973   if (chain_next == NULL)
1974     {
1975       oprintf (d.of, "  if (%s (x", wtd->marker_routine);
1976       if (wtd->param_prefix)
1977         {
1978           oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
1979           output_mangled_typename (d.of, orig_s);
1980         }
1981       oprintf (d.of, "))\n");
1982     }
1983   else
1984     {
1985       oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
1986       if (wtd->param_prefix)
1987         {
1988           oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
1989           output_mangled_typename (d.of, orig_s);
1990         }
1991       oprintf (d.of, "))\n");
1992       oprintf (d.of, "   xlimit = (");
1993       d.prev_val[2] = "*xlimit";
1994       output_escaped_param (&d, chain_next, "chain_next");
1995       oprintf (d.of, ");\n");
1996       if (chain_prev != NULL)
1997         {
1998           oprintf (d.of, "  if (x != xlimit)\n");
1999           oprintf (d.of, "    for (;;)\n");
2000           oprintf (d.of, "      {\n");
2001           oprintf (d.of, "        %s %s * const xprev = (",
2002                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2003
2004           d.prev_val[2] = "*x";
2005           output_escaped_param (&d, chain_prev, "chain_prev");
2006           oprintf (d.of, ");\n");
2007           oprintf (d.of, "        if (xprev == NULL) break;\n");
2008           oprintf (d.of, "        x = xprev;\n");
2009           oprintf (d.of, "        (void) %s (xprev",
2010                    wtd->marker_routine);
2011           if (wtd->param_prefix)
2012             {
2013               oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
2014               output_mangled_typename (d.of, orig_s);
2015             }
2016           oprintf (d.of, ");\n");
2017           oprintf (d.of, "      }\n");
2018         }
2019       oprintf (d.of, "  while (x != xlimit)\n");
2020     }
2021   oprintf (d.of, "    {\n");
2022
2023   d.prev_val[2] = "*x";
2024   d.indent = 6;
2025   walk_type (s, &d);
2026
2027   if (chain_next != NULL)
2028     {
2029       oprintf (d.of, "      x = (");
2030       output_escaped_param (&d, chain_next, "chain_next");
2031       oprintf (d.of, ");\n");
2032     }
2033
2034   oprintf (d.of, "    }\n");
2035   oprintf (d.of, "}\n");
2036 }
2037
2038 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
2039
2040 static void
2041 write_types (type_p structures, type_p param_structs,
2042              const struct write_types_data *wtd)
2043 {
2044   type_p s;
2045
2046   oprintf (header_file, "\n/* %s*/\n", wtd->comment);
2047   for (s = structures; s; s = s->next)
2048     if (s->gc_used == GC_POINTED_TO
2049         || s->gc_used == GC_MAYBE_POINTED_TO)
2050       {
2051         options_p opt;
2052
2053         if (s->gc_used == GC_MAYBE_POINTED_TO
2054             && s->u.s.line.file == NULL)
2055           continue;
2056
2057         oprintf (header_file, "#define gt_%s_", wtd->prefix);
2058         output_mangled_typename (header_file, s);
2059         oprintf (header_file, "(X) do { \\\n");
2060         oprintf (header_file,
2061                  "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
2062                  s->u.s.tag);
2063         oprintf (header_file,
2064                  "  } while (0)\n");
2065
2066         for (opt = s->u.s.opt; opt; opt = opt->next)
2067           if (strcmp (opt->name, "ptr_alias") == 0)
2068             {
2069               type_p t = (type_p) opt->info;
2070               if (t->kind == TYPE_STRUCT
2071                   || t->kind == TYPE_UNION
2072                   || t->kind == TYPE_LANG_STRUCT)
2073                 oprintf (header_file,
2074                          "#define gt_%sx_%s gt_%sx_%s\n",
2075                          wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
2076               else
2077                 error_at_line (&s->u.s.line,
2078                                "structure alias is not a structure");
2079               break;
2080             }
2081         if (opt)
2082           continue;
2083
2084         /* Declare the marker procedure only once.  */
2085         oprintf (header_file,
2086                  "extern void gt_%sx_%s (void *);\n",
2087                  wtd->prefix, s->u.s.tag);
2088
2089         if (s->u.s.line.file == NULL)
2090           {
2091             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2092                      s->u.s.tag);
2093             continue;
2094           }
2095
2096         if (s->kind == TYPE_LANG_STRUCT)
2097           {
2098             type_p ss;
2099             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2100               write_func_for_structure (s, ss, NULL, wtd);
2101           }
2102         else
2103           write_func_for_structure (s, s, NULL, wtd);
2104       }
2105
2106   for (s = param_structs; s; s = s->next)
2107     if (s->gc_used == GC_POINTED_TO)
2108       {
2109         type_p * param = s->u.param_struct.param;
2110         type_p stru = s->u.param_struct.stru;
2111
2112         /* Declare the marker procedure.  */
2113         oprintf (header_file, "extern void gt_%s_", wtd->prefix);
2114         output_mangled_typename (header_file, s);
2115         oprintf (header_file, " (void *);\n");
2116
2117         if (stru->u.s.line.file == NULL)
2118           {
2119             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2120                      s->u.s.tag);
2121             continue;
2122           }
2123
2124         if (stru->kind == TYPE_LANG_STRUCT)
2125           {
2126             type_p ss;
2127             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2128               write_func_for_structure (s, ss, param, wtd);
2129           }
2130         else
2131           write_func_for_structure (s, stru, param, wtd);
2132       }
2133 }
2134
2135 static const struct write_types_data ggc_wtd =
2136 {
2137   "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
2138   "GC marker procedures.  "
2139 };
2140
2141 static const struct write_types_data pch_wtd =
2142 {
2143   "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
2144   "gt_pch_note_reorder",
2145   "PCH type-walking procedures.  "
2146 };
2147
2148 /* Write out the local pointer-walking routines.  */
2149
2150 /* process_field routine for local pointer-walking.  */
2151
2152 static void
2153 write_types_local_process_field (type_p f, const struct walk_type_data *d)
2154 {
2155   switch (f->kind)
2156     {
2157     case TYPE_POINTER:
2158     case TYPE_STRUCT:
2159     case TYPE_UNION:
2160     case TYPE_LANG_STRUCT:
2161     case TYPE_PARAM_STRUCT:
2162     case TYPE_STRING:
2163       oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
2164                d->prev_val[3]);
2165       oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
2166       break;
2167
2168     case TYPE_SCALAR:
2169       break;
2170
2171     default:
2172       abort ();
2173     }
2174 }
2175
2176 /* For S, a structure that's part of ORIG_S, and using parameters
2177    PARAM, write out a routine that:
2178    - Is of type gt_note_pointers
2179    - If calls PROCESS_FIELD on each field of S or its substructures.
2180 */
2181
2182 static void
2183 write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
2184 {
2185   const char *fn = s->u.s.line.file;
2186   int i;
2187   struct walk_type_data d;
2188
2189   /* This is a hack, and not the good kind either.  */
2190   for (i = NUM_PARAM - 1; i >= 0; i--)
2191     if (param && param[i] && param[i]->kind == TYPE_POINTER
2192         && UNION_OR_STRUCT_P (param[i]->u.p))
2193       fn = param[i]->u.p->u.s.line.file;
2194
2195   memset (&d, 0, sizeof (d));
2196   d.of = get_output_file_with_visibility (fn);
2197
2198   d.process_field = write_types_local_process_field;
2199   d.opt = s->u.s.opt;
2200   d.line = &s->u.s.line;
2201   d.bitmap = s->u.s.bitmap;
2202   d.param = param;
2203   d.prev_val[0] = d.prev_val[2] = "*x";
2204   d.prev_val[1] = "not valid postage";  /* guarantee an error */
2205   d.prev_val[3] = "x";
2206   d.val = "(*x)";
2207
2208   oprintf (d.of, "\n");
2209   oprintf (d.of, "void\n");
2210   oprintf (d.of, "gt_pch_p_");
2211   output_mangled_typename (d.of, orig_s);
2212   oprintf (d.of, " (this_obj, x_p, op, cookie)\n");
2213   oprintf (d.of, "      void *this_obj ATTRIBUTE_UNUSED;\n");
2214   oprintf (d.of, "      void *x_p;\n");
2215   oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED;\n");
2216   oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED;\n");
2217   oprintf (d.of, "{\n");
2218   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2219            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2220            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2221   d.indent = 2;
2222   walk_type (s, &d);
2223   oprintf (d.of, "}\n");
2224 }
2225
2226 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2227
2228 static void
2229 write_local (type_p structures, type_p param_structs)
2230 {
2231   type_p s;
2232
2233   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2234   for (s = structures; s; s = s->next)
2235     if (s->gc_used == GC_POINTED_TO
2236         || s->gc_used == GC_MAYBE_POINTED_TO)
2237       {
2238         options_p opt;
2239
2240         if (s->u.s.line.file == NULL)
2241           continue;
2242
2243         for (opt = s->u.s.opt; opt; opt = opt->next)
2244           if (strcmp (opt->name, "ptr_alias") == 0)
2245             {
2246               type_p t = (type_p) opt->info;
2247               if (t->kind == TYPE_STRUCT
2248                   || t->kind == TYPE_UNION
2249                   || t->kind == TYPE_LANG_STRUCT)
2250                 {
2251                   oprintf (header_file, "#define gt_pch_p_");
2252                   output_mangled_typename (header_file, s);
2253                   oprintf (header_file, " gt_pch_p_");
2254                   output_mangled_typename (header_file, t);
2255                   oprintf (header_file, "\n");
2256                 }
2257               else
2258                 error_at_line (&s->u.s.line,
2259                                "structure alias is not a structure");
2260               break;
2261             }
2262         if (opt)
2263           continue;
2264
2265         /* Declare the marker procedure only once.  */
2266         oprintf (header_file, "extern void gt_pch_p_");
2267         output_mangled_typename (header_file, s);
2268         oprintf (header_file,
2269          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2270
2271         if (s->kind == TYPE_LANG_STRUCT)
2272           {
2273             type_p ss;
2274             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2275               write_local_func_for_structure (s, ss, NULL);
2276           }
2277         else
2278           write_local_func_for_structure (s, s, NULL);
2279       }
2280
2281   for (s = param_structs; s; s = s->next)
2282     if (s->gc_used == GC_POINTED_TO)
2283       {
2284         type_p * param = s->u.param_struct.param;
2285         type_p stru = s->u.param_struct.stru;
2286
2287         /* Declare the marker procedure.  */
2288         oprintf (header_file, "extern void gt_pch_p_");
2289         output_mangled_typename (header_file, s);
2290         oprintf (header_file,
2291          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2292
2293         if (stru->u.s.line.file == NULL)
2294           {
2295             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2296                      s->u.s.tag);
2297             continue;
2298           }
2299
2300         if (stru->kind == TYPE_LANG_STRUCT)
2301           {
2302             type_p ss;
2303             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2304               write_local_func_for_structure (s, ss, param);
2305           }
2306         else
2307           write_local_func_for_structure (s, stru, param);
2308       }
2309 }
2310
2311 /* Write out the 'enum' definition for gt_types_enum.  */
2312
2313 static void
2314 write_enum_defn  (type_p structures, type_p param_structs)
2315 {
2316   type_p s;
2317
2318   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2319   oprintf (header_file, "enum gt_types_enum {\n");
2320   for (s = structures; s; s = s->next)
2321     if (s->gc_used == GC_POINTED_TO
2322         || s->gc_used == GC_MAYBE_POINTED_TO)
2323       {
2324         if (s->gc_used == GC_MAYBE_POINTED_TO
2325             && s->u.s.line.file == NULL)
2326           continue;
2327
2328         oprintf (header_file, " gt_ggc_e_");
2329         output_mangled_typename (header_file, s);
2330         oprintf (header_file, ", \n");
2331       }
2332   for (s = param_structs; s; s = s->next)
2333     if (s->gc_used == GC_POINTED_TO)
2334       {
2335         oprintf (header_file, " gt_e_");
2336         output_mangled_typename (header_file, s);
2337         oprintf (header_file, ", \n");
2338       }
2339   oprintf (header_file, " gt_types_enum_last\n");
2340   oprintf (header_file, "};\n");
2341 }
2342
2343 /* Might T contain any non-pointer elements?  */
2344
2345 static int
2346 contains_scalar_p (type_p t)
2347 {
2348   switch (t->kind)
2349     {
2350     case TYPE_STRING:
2351     case TYPE_POINTER:
2352       return 0;
2353     case TYPE_ARRAY:
2354       return contains_scalar_p (t->u.a.p);
2355     default:
2356       /* Could also check for structures that have no non-pointer
2357          fields, but there aren't enough of those to worry about.  */
2358       return 1;
2359     }
2360 }
2361
2362 /* Mangle FN and print it to F.  */
2363
2364 static void
2365 put_mangled_filename (outf_p f, const char *fn)
2366 {
2367   const char *name = get_output_file_name (fn);
2368   for (; *name != 0; name++)
2369     if (ISALNUM (*name))
2370       oprintf (f, "%c", *name);
2371     else
2372       oprintf (f, "%c", '_');
2373 }
2374
2375 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2376    LASTNAME, and NAME are all strings to insert in various places in
2377    the resulting code.  */
2378
2379 static void
2380 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2381                    const char *tname, const char *name)
2382 {
2383   struct flist *fli2;
2384
2385   for (fli2 = flp; fli2; fli2 = fli2->next)
2386     if (fli2->started_p)
2387       {
2388         oprintf (fli2->f, "  %s\n", lastname);
2389         oprintf (fli2->f, "};\n\n");
2390       }
2391
2392   for (fli2 = flp; fli2; fli2 = fli2->next)
2393     if (fli2->started_p)
2394       {
2395         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2396         int fnum;
2397
2398         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2399           if (bitmap & 1)
2400             {
2401               oprintf (base_files[fnum],
2402                        "extern const struct %s gt_%s_",
2403                        tname, pfx);
2404               put_mangled_filename (base_files[fnum], fli2->name);
2405               oprintf (base_files[fnum], "[];\n");
2406             }
2407       }
2408
2409   {
2410     size_t fnum;
2411     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2412       oprintf (base_files [fnum],
2413                "const struct %s * const %s[] = {\n",
2414                tname, name);
2415   }
2416
2417
2418   for (fli2 = flp; fli2; fli2 = fli2->next)
2419     if (fli2->started_p)
2420       {
2421         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2422         int fnum;
2423
2424         fli2->started_p = 0;
2425
2426         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2427           if (bitmap & 1)
2428             {
2429               oprintf (base_files[fnum], "  gt_%s_", pfx);
2430               put_mangled_filename (base_files[fnum], fli2->name);
2431               oprintf (base_files[fnum], ",\n");
2432             }
2433       }
2434
2435   {
2436     size_t fnum;
2437     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2438       {
2439         oprintf (base_files[fnum], "  NULL\n");
2440         oprintf (base_files[fnum], "};\n");
2441       }
2442   }
2443 }
2444
2445 /* Write out to F the table entry and any marker routines needed to
2446    mark NAME as TYPE.  The original variable is V, at LINE.
2447    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2448    is nonzero iff we are building the root table for hash table caches.  */
2449
2450 static void
2451 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2452             struct fileloc *line, const char *if_marked)
2453 {
2454   switch (type->kind)
2455     {
2456     case TYPE_STRUCT:
2457       {
2458         pair_p fld;
2459         for (fld = type->u.s.fields; fld; fld = fld->next)
2460           {
2461             int skip_p = 0;
2462             const char *desc = NULL;
2463             options_p o;
2464
2465             for (o = fld->opt; o; o = o->next)
2466               if (strcmp (o->name, "skip") == 0)
2467                 skip_p = 1;
2468               else if (strcmp (o->name, "desc") == 0)
2469                 desc = (const char *)o->info;
2470               else
2471                 error_at_line (line,
2472                        "field `%s' of global `%s' has unknown option `%s'",
2473                                fld->name, name, o->name);
2474
2475             if (skip_p)
2476               continue;
2477             else if (desc && fld->type->kind == TYPE_UNION)
2478               {
2479                 pair_p validf = NULL;
2480                 pair_p ufld;
2481
2482                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2483                   {
2484                     const char *tag = NULL;
2485                     options_p oo;
2486
2487                     for (oo = ufld->opt; oo; oo = oo->next)
2488                       if (strcmp (oo->name, "tag") == 0)
2489                         tag = (const char *)oo->info;
2490                     if (tag == NULL || strcmp (tag, desc) != 0)
2491                       continue;
2492                     if (validf != NULL)
2493                       error_at_line (line,
2494                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2495                                      name, fld->name, validf->name,
2496                                      name, fld->name, ufld->name,
2497                                      tag);
2498                     validf = ufld;
2499                   }
2500                 if (validf != NULL)
2501                   {
2502                     char *newname;
2503                     newname = xasprintf ("%s.%s.%s",
2504                                          name, fld->name, validf->name);
2505                     write_root (f, v, validf->type, newname, 0, line,
2506                                 if_marked);
2507                     free (newname);
2508                   }
2509               }
2510             else if (desc)
2511               error_at_line (line,
2512                      "global `%s.%s' has `desc' option but is not union",
2513                              name, fld->name);
2514             else
2515               {
2516                 char *newname;
2517                 newname = xasprintf ("%s.%s", name, fld->name);
2518                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2519                 free (newname);
2520               }
2521           }
2522       }
2523       break;
2524
2525     case TYPE_ARRAY:
2526       {
2527         char *newname;
2528         newname = xasprintf ("%s[0]", name);
2529         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2530         free (newname);
2531       }
2532       break;
2533
2534     case TYPE_POINTER:
2535       {
2536         type_p ap, tp;
2537
2538         oprintf (f, "  {\n");
2539         oprintf (f, "    &%s,\n", name);
2540         oprintf (f, "    1");
2541
2542         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2543           if (ap->u.a.len[0])
2544             oprintf (f, " * (%s)", ap->u.a.len);
2545           else if (ap == v->type)
2546             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2547         oprintf (f, ",\n");
2548         oprintf (f, "    sizeof (%s", v->name);
2549         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2550           oprintf (f, "[0]");
2551         oprintf (f, "),\n");
2552
2553         tp = type->u.p;
2554
2555         if (! has_length && UNION_OR_STRUCT_P (tp))
2556           {
2557             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2558             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2559           }
2560         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2561           {
2562             oprintf (f, "    &gt_ggc_m_");
2563             output_mangled_typename (f, tp);
2564             oprintf (f, ",\n    &gt_pch_n_");
2565             output_mangled_typename (f, tp);
2566           }
2567         else if (has_length
2568                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2569           {
2570             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2571             oprintf (f, "    &gt_pch_na_%s", name);
2572           }
2573         else
2574           {
2575             error_at_line (line,
2576                            "global `%s' is pointer to unimplemented type",
2577                            name);
2578           }
2579         if (if_marked)
2580           oprintf (f, ",\n    &%s", if_marked);
2581         oprintf (f, "\n  },\n");
2582       }
2583       break;
2584
2585     case TYPE_STRING:
2586       {
2587         oprintf (f, "  {\n");
2588         oprintf (f, "    &%s,\n", name);
2589         oprintf (f, "    1, \n");
2590         oprintf (f, "    sizeof (%s),\n", v->name);
2591         oprintf (f, "    &gt_ggc_m_S,\n");
2592         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2593         oprintf (f, "  },\n");
2594       }
2595       break;
2596
2597     case TYPE_SCALAR:
2598       break;
2599
2600     default:
2601       error_at_line (line,
2602                      "global `%s' is unimplemented type",
2603                      name);
2604     }
2605 }
2606
2607 /* This generates a routine to walk an array.  */
2608
2609 static void
2610 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2611 {
2612   struct walk_type_data d;
2613   char *prevval3;
2614
2615   memset (&d, 0, sizeof (d));
2616   d.of = f;
2617   d.cookie = wtd;
2618   d.indent = 2;
2619   d.line = &v->line;
2620   d.opt = v->opt;
2621   d.bitmap = get_base_file_bitmap (v->line.file);
2622   d.param = NULL;
2623
2624   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2625
2626   if (wtd->param_prefix)
2627     {
2628       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2629       oprintf (f,
2630        "    (void *, void *, gt_pointer_operator, void *);\n");
2631       oprintf (f, "static void gt_%sa_%s (this_obj, x_p, op, cookie)\n",
2632                wtd->param_prefix, v->name);
2633       oprintf (d.of, "      void *this_obj ATTRIBUTE_UNUSED;\n");
2634       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED;\n");
2635       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED;\n");
2636       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED;\n");
2637       oprintf (d.of, "{\n");
2638       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2639       d.process_field = write_types_local_process_field;
2640       walk_type (v->type, &d);
2641       oprintf (f, "}\n\n");
2642     }
2643
2644   d.opt = v->opt;
2645   oprintf (f, "static void gt_%sa_%s (void *);\n",
2646            wtd->prefix, v->name);
2647   oprintf (f, "static void\ngt_%sa_%s (x_p)\n",
2648            wtd->prefix, v->name);
2649   oprintf (f, "      void *x_p ATTRIBUTE_UNUSED;\n");
2650   oprintf (f, "{\n");
2651   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2652   d.process_field = write_types_process_field;
2653   walk_type (v->type, &d);
2654   free (prevval3);
2655   oprintf (f, "}\n\n");
2656 }
2657
2658 /* Output a table describing the locations and types of VARIABLES.  */
2659
2660 static void
2661 write_roots (pair_p variables)
2662 {
2663   pair_p v;
2664   struct flist *flp = NULL;
2665
2666   for (v = variables; v; v = v->next)
2667     {
2668       outf_p f = get_output_file_with_visibility (v->line.file);
2669       struct flist *fli;
2670       const char *length = NULL;
2671       int deletable_p = 0;
2672       options_p o;
2673
2674       for (o = v->opt; o; o = o->next)
2675         if (strcmp (o->name, "length") == 0)
2676           length = (const char *)o->info;
2677         else if (strcmp (o->name, "deletable") == 0)
2678           deletable_p = 1;
2679         else if (strcmp (o->name, "param_is") == 0)
2680           ;
2681         else if (strncmp (o->name, "param", 5) == 0
2682                  && ISDIGIT (o->name[5])
2683                  && strcmp (o->name + 6, "_is") == 0)
2684           ;
2685         else if (strcmp (o->name, "if_marked") == 0)
2686           ;
2687         else
2688           error_at_line (&v->line,
2689                          "global `%s' has unknown option `%s'",
2690                          v->name, o->name);
2691
2692       for (fli = flp; fli; fli = fli->next)
2693         if (fli->f == f)
2694           break;
2695       if (fli == NULL)
2696         {
2697           fli = xmalloc (sizeof (*fli));
2698           fli->f = f;
2699           fli->next = flp;
2700           fli->started_p = 0;
2701           fli->name = v->line.file;
2702           flp = fli;
2703
2704           oprintf (f, "\n/* GC roots.  */\n\n");
2705         }
2706
2707       if (! deletable_p
2708           && length
2709           && v->type->kind == TYPE_POINTER
2710           && (v->type->u.p->kind == TYPE_POINTER
2711               || v->type->u.p->kind == TYPE_STRUCT))
2712         {
2713           write_array (f, v, &ggc_wtd);
2714           write_array (f, v, &pch_wtd);
2715         }
2716     }
2717
2718   for (v = variables; v; v = v->next)
2719     {
2720       outf_p f = get_output_file_with_visibility (v->line.file);
2721       struct flist *fli;
2722       int skip_p = 0;
2723       int length_p = 0;
2724       options_p o;
2725
2726       for (o = v->opt; o; o = o->next)
2727         if (strcmp (o->name, "length") == 0)
2728           length_p = 1;
2729         else if (strcmp (o->name, "deletable") == 0
2730                  || strcmp (o->name, "if_marked") == 0)
2731           skip_p = 1;
2732
2733       if (skip_p)
2734         continue;
2735
2736       for (fli = flp; fli; fli = fli->next)
2737         if (fli->f == f)
2738           break;
2739       if (! fli->started_p)
2740         {
2741           fli->started_p = 1;
2742
2743           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2744           put_mangled_filename (f, v->line.file);
2745           oprintf (f, "[] = {\n");
2746         }
2747
2748       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2749     }
2750
2751   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2752                      "gt_ggc_rtab");
2753
2754   for (v = variables; v; v = v->next)
2755     {
2756       outf_p f = get_output_file_with_visibility (v->line.file);
2757       struct flist *fli;
2758       int skip_p = 1;
2759       options_p o;
2760
2761       for (o = v->opt; o; o = o->next)
2762         if (strcmp (o->name, "deletable") == 0)
2763           skip_p = 0;
2764         else if (strcmp (o->name, "if_marked") == 0)
2765           skip_p = 1;
2766
2767       if (skip_p)
2768         continue;
2769
2770       for (fli = flp; fli; fli = fli->next)
2771         if (fli->f == f)
2772           break;
2773       if (! fli->started_p)
2774         {
2775           fli->started_p = 1;
2776
2777           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2778           put_mangled_filename (f, v->line.file);
2779           oprintf (f, "[] = {\n");
2780         }
2781
2782       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2783                v->name, v->name);
2784     }
2785
2786   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2787                      "gt_ggc_deletable_rtab");
2788
2789   for (v = variables; v; v = v->next)
2790     {
2791       outf_p f = get_output_file_with_visibility (v->line.file);
2792       struct flist *fli;
2793       const char *if_marked = NULL;
2794       int length_p = 0;
2795       options_p o;
2796
2797       for (o = v->opt; o; o = o->next)
2798         if (strcmp (o->name, "length") == 0)
2799           length_p = 1;
2800         else if (strcmp (o->name, "if_marked") == 0)
2801           if_marked = (const char *) o->info;
2802
2803       if (if_marked == NULL)
2804         continue;
2805
2806       if (v->type->kind != TYPE_POINTER
2807           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2808           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2809         {
2810           error_at_line (&v->line, "if_marked option used but not hash table");
2811           continue;
2812         }
2813
2814       for (fli = flp; fli; fli = fli->next)
2815         if (fli->f == f)
2816           break;
2817       if (! fli->started_p)
2818         {
2819           fli->started_p = 1;
2820
2821           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2822           put_mangled_filename (f, v->line.file);
2823           oprintf (f, "[] = {\n");
2824         }
2825
2826       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2827                      v->name, length_p, &v->line, if_marked);
2828     }
2829
2830   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2831                      "gt_ggc_cache_rtab");
2832
2833   for (v = variables; v; v = v->next)
2834     {
2835       outf_p f = get_output_file_with_visibility (v->line.file);
2836       struct flist *fli;
2837       int length_p = 0;
2838       int if_marked_p = 0;
2839       options_p o;
2840
2841       for (o = v->opt; o; o = o->next)
2842         if (strcmp (o->name, "length") == 0)
2843           length_p = 1;
2844         else if (strcmp (o->name, "if_marked") == 0)
2845           if_marked_p = 1;
2846
2847       if (! if_marked_p)
2848         continue;
2849
2850       for (fli = flp; fli; fli = fli->next)
2851         if (fli->f == f)
2852           break;
2853       if (! fli->started_p)
2854         {
2855           fli->started_p = 1;
2856
2857           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2858           put_mangled_filename (f, v->line.file);
2859           oprintf (f, "[] = {\n");
2860         }
2861
2862       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2863     }
2864
2865   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2866                      "gt_pch_cache_rtab");
2867
2868   for (v = variables; v; v = v->next)
2869     {
2870       outf_p f = get_output_file_with_visibility (v->line.file);
2871       struct flist *fli;
2872       int skip_p = 0;
2873       options_p o;
2874
2875       for (o = v->opt; o; o = o->next)
2876         if (strcmp (o->name, "deletable") == 0
2877             || strcmp (o->name, "if_marked") == 0)
2878           skip_p = 1;
2879
2880       if (skip_p)
2881         continue;
2882
2883       if (! contains_scalar_p (v->type))
2884         continue;
2885
2886       for (fli = flp; fli; fli = fli->next)
2887         if (fli->f == f)
2888           break;
2889       if (! fli->started_p)
2890         {
2891           fli->started_p = 1;
2892
2893           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2894           put_mangled_filename (f, v->line.file);
2895           oprintf (f, "[] = {\n");
2896         }
2897
2898       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2899                v->name, v->name);
2900     }
2901
2902   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2903                      "gt_pch_scalar_rtab");
2904 }
2905
2906 \f
2907 extern int main (int argc, char **argv);
2908 int
2909 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2910 {
2911   unsigned i;
2912   static struct fileloc pos = { __FILE__, __LINE__ };
2913   unsigned j;
2914
2915   gen_rtx_next ();
2916
2917   srcdir_len = strlen (srcdir);
2918
2919   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2920   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2921   do_scalar_typedef ("uint8", &pos);
2922   do_scalar_typedef ("jword", &pos);
2923   do_scalar_typedef ("JCF_u2", &pos);
2924
2925   do_typedef ("PTR", create_pointer (create_scalar_type ("void",
2926                                                          strlen ("void"))),
2927               &pos);
2928   do_typedef ("HARD_REG_SET", create_array (
2929               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2930               "2"), &pos);
2931
2932   for (i = 0; i < NUM_GT_FILES; i++)
2933     {
2934       int dupflag = 0;
2935       /* Omit if already seen.  */
2936       for (j = 0; j < i; j++)
2937         {
2938           if (!strcmp (all_files[i], all_files[j]))
2939             {
2940               dupflag = 1;
2941               break;
2942             }
2943         }
2944       if (!dupflag)
2945         parse_file (all_files[i]);
2946     }
2947
2948   if (hit_error != 0)
2949     exit (1);
2950
2951   set_gc_used (variables);
2952
2953   open_base_files ();
2954   write_enum_defn (structures, param_structs);
2955   write_types (structures, param_structs, &ggc_wtd);
2956   write_types (structures, param_structs, &pch_wtd);
2957   write_local (structures, param_structs);
2958   write_roots (variables);
2959   write_rtx_next ();
2960   close_output_files ();
2961
2962   return (hit_error != 0);
2963 }