gcc/gengtype.c

   1 /* Process source files and output type information.
   2    Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   3
   4 This file is part of GCC.
   5
   6 GCC is free software; you can redistribute it and/or modify it under
   7 the terms of the GNU General Public License as published by the Free
   8 Software Foundation; either version 2, or (at your option) any later
   9 version.
  10
  11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GCC; see the file COPYING.  If not, write to the Free
  18 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  19 02111-1307, USA.  */
  20
  21 #include "bconfig.h"
  22 #include "system.h"
  23 #include "coretypes.h"
  24 #include "tm.h"
  25 #include "gengtype.h"
  26 #include "gtyp-gen.h"
  27
  28 #define NO_GENRTL_H
  29 #include "rtl.h"
  30 #undef abort
  31
  32 /* Nonzero iff an error has occurred.  */
  33 static int hit_error = 0;
  34
  35 static void gen_rtx_next (void);
  36 static void write_rtx_next (void);
  37 static void open_base_files (void);
  38 static void close_output_files (void);
  39
  40 /* Report an error at POS, printing MSG.  */
  41
  42 void
  43 error_at_line (struct fileloc *pos, const char *msg, ...)
  44 {
  45   va_list ap;
  46
  47   va_start (ap, msg);
  48
  49   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
  50   vfprintf (stderr, msg, ap);
  51   fputc ('\n', stderr);
  52   hit_error = 1;
  53
  54   va_end (ap);
  55 }
  56
  57 /* vasprintf, but produces fatal message on out-of-memory.  */
  58 int
  59 xvasprintf (char **result, const char *format, va_list args)
  60 {
  61   int ret = vasprintf (result, format, args);
  62   if (*result == NULL || ret < 0)
  63     {
  64       fputs ("gengtype: out of memory", stderr);
  65       xexit (1);
  66     }
  67   return ret;
  68 }
  69
  70 /* Wrapper for xvasprintf.  */
  71 char *
  72 xasprintf (const char *format, ...)
  73 {
  74   char *result;
  75   va_list ap;
  76
  77   va_start (ap, format);
  78   xvasprintf (&result, format, ap);
  79   va_end (ap);
  80   return result;
  81 }
  82
  83 /* The one and only TYPE_STRING.  */
  84
  85 struct type string_type = {
  86   TYPE_STRING, NULL, NULL, GC_USED, {0}
  87 };
  88
  89 /* Lists of various things.  */
  90
  91 static pair_p typedefs;
  92 static type_p structures;
  93 static type_p param_structs;
  94 static pair_p variables;
  95
  96 static void do_scalar_typedef (const char *, struct fileloc *);
  97 static type_p find_param_structure
  98   (type_p t, type_p param[NUM_PARAM]);
  99 static type_p adjust_field_tree_exp (type_p t, options_p opt);
 100 static type_p adjust_field_rtx_def (type_p t, options_p opt);
 101
 102 /* Define S as a typedef to T at POS.  */
 103
 104 void
 105 do_typedef (const char *s, type_p t, struct fileloc *pos)
 106 {
 107   pair_p p;
 108
 109   for (p = typedefs; p != NULL; p = p->next)
 110     if (strcmp (p->name, s) == 0)
 111       {
 112         if (p->type != t)
 113           {
 114             error_at_line (pos, "type `%s' previously defined", s);
 115             error_at_line (&p->line, "previously defined here");
 116           }
 117         return;
 118       }
 119
 120   p = xmalloc (sizeof (struct pair));
 121   p->next = typedefs;
 122   p->name = s;
 123   p->type = t;
 124   p->line = *pos;
 125   typedefs = p;
 126 }
 127
 128 /* Define S as a typename of a scalar.  */
 129
 130 static void
 131 do_scalar_typedef (const char *s, struct fileloc *pos)
 132 {
 133   do_typedef (s, create_scalar_type (s, strlen (s)), pos);
 134 }
 135
 136 /* Return the type previously defined for S.  Use POS to report errors.  */
 137
 138 type_p
 139 resolve_typedef (const char *s, struct fileloc *pos)
 140 {
 141   pair_p p;
 142   for (p = typedefs; p != NULL; p = p->next)
 143     if (strcmp (p->name, s) == 0)
 144       return p->type;
 145   error_at_line (pos, "unidentified type `%s'", s);
 146   return create_scalar_type ("char", 4);
 147 }
 148
 149 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
 150    at POS with fields FIELDS and options O.  */
 151
 152 void
 153 new_structure (const char *name, int isunion, struct fileloc *pos,
 154                pair_p fields, options_p o)
 155 {
 156   type_p si;
 157   type_p s = NULL;
 158   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 159
 160   for (si = structures; si != NULL; si = si->next)
 161     if (strcmp (name, si->u.s.tag) == 0
 162         && UNION_P (si) == isunion)
 163       {
 164         type_p ls = NULL;
 165         if (si->kind == TYPE_LANG_STRUCT)
 166           {
 167             ls = si;
 168
 169             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
 170               if (si->u.s.bitmap == bitmap)
 171                 s = si;
 172           }
 173         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
 174           {
 175             ls = si;
 176             si = xcalloc (1, sizeof (struct type));
 177             memcpy (si, ls, sizeof (struct type));
 178             ls->kind = TYPE_LANG_STRUCT;
 179             ls->u.s.lang_struct = si;
 180             ls->u.s.fields = NULL;
 181             si->next = NULL;
 182             si->pointer_to = NULL;
 183             si->u.s.lang_struct = ls;
 184           }
 185         else
 186           s = si;
 187
 188         if (ls != NULL && s == NULL)
 189           {
 190             s = xcalloc (1, sizeof (struct type));
 191             s->next = ls->u.s.lang_struct;
 192             ls->u.s.lang_struct = s;
 193             s->u.s.lang_struct = ls;
 194           }
 195         break;
 196       }
 197
 198   if (s == NULL)
 199     {
 200       s = xcalloc (1, sizeof (struct type));
 201       s->next = structures;
 202       structures = s;
 203     }
 204
 205   if (s->u.s.line.file != NULL
 206       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
 207     {
 208       error_at_line (pos, "duplicate structure definition");
 209       error_at_line (&s->u.s.line, "previous definition here");
 210     }
 211
 212   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 213   s->u.s.tag = name;
 214   s->u.s.line = *pos;
 215   s->u.s.fields = fields;
 216   s->u.s.opt = o;
 217   s->u.s.bitmap = bitmap;
 218   if (s->u.s.lang_struct)
 219     s->u.s.lang_struct->u.s.bitmap |= bitmap;
 220 }
 221
 222 /* Return the previously-defined structure with tag NAME (or a union
 223    iff ISUNION is nonzero), or a new empty structure or union if none
 224    was defined previously.  */
 225
 226 type_p
 227 find_structure (const char *name, int isunion)
 228 {
 229   type_p s;
 230
 231   for (s = structures; s != NULL; s = s->next)
 232     if (strcmp (name, s->u.s.tag) == 0
 233         && UNION_P (s) == isunion)
 234       return s;
 235
 236   s = xcalloc (1, sizeof (struct type));
 237   s->next = structures;
 238   structures = s;
 239   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 240   s->u.s.tag = name;
 241   structures = s;
 242   return s;
 243 }
 244
 245 /* Return the previously-defined parameterized structure for structure
 246    T and parameters PARAM, or a new parameterized empty structure or
 247    union if none was defined previously.  */
 248
 249 static type_p
 250 find_param_structure (type_p t, type_p param[NUM_PARAM])
 251 {
 252   type_p res;
 253
 254   for (res = param_structs; res; res = res->next)
 255     if (res->u.param_struct.stru == t
 256         && memcmp (res->u.param_struct.param, param,
 257                    sizeof (type_p) * NUM_PARAM) == 0)
 258       break;
 259   if (res == NULL)
 260     {
 261       res = xcalloc (1, sizeof (*res));
 262       res->kind = TYPE_PARAM_STRUCT;
 263       res->next = param_structs;
 264       param_structs = res;
 265       res->u.param_struct.stru = t;
 266       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
 267     }
 268   return res;
 269 }
 270
 271 /* Return a scalar type with name NAME.  */
 272
 273 type_p
 274 create_scalar_type (const char *name, size_t name_len)
 275 {
 276   type_p r = xcalloc (1, sizeof (struct type));
 277   r->kind = TYPE_SCALAR;
 278   r->u.sc = xmemdup (name, name_len, name_len + 1);
 279   return r;
 280 }
 281
 282 /* Return a pointer to T.  */
 283
 284 type_p
 285 create_pointer (type_p t)
 286 {
 287   if (! t->pointer_to)
 288     {
 289       type_p r = xcalloc (1, sizeof (struct type));
 290       r->kind = TYPE_POINTER;
 291       r->u.p = t;
 292       t->pointer_to = r;
 293     }
 294   return t->pointer_to;
 295 }
 296
 297 /* Return an array of length LEN.  */
 298
 299 type_p
 300 create_array (type_p t, const char *len)
 301 {
 302   type_p v;
 303
 304   v = xcalloc (1, sizeof (*v));
 305   v->kind = TYPE_ARRAY;
 306   v->u.a.p = t;
 307   v->u.a.len = len;
 308   return v;
 309 }
 310
 311 /* Add a variable named S of type T with options O defined at POS,
 312    to `variables'.  */
 313
 314 void
 315 note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
 316 {
 317   pair_p n;
 318   n = xmalloc (sizeof (*n));
 319   n->name = s;
 320   n->type = t;
 321   n->line = *pos;
 322   n->opt = o;
 323   n->next = variables;
 324   variables = n;
 325 }
 326
 327 /* We really don't care how long a CONST_DOUBLE is.  */
 328 #define CONST_DOUBLE_FORMAT "ww"
 329 const char * const rtx_format[NUM_RTX_CODE] = {
 330 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
 331 #include "rtl.def"
 332 #undef DEF_RTL_EXPR
 333 };
 334
 335 static int rtx_next_new[NUM_RTX_CODE];
 336
 337 /* Generate the contents of the rtx_next array.  This really doesn't belong
 338    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
 339
 340 static void
 341 gen_rtx_next (void)
 342 {
 343   int i;
 344   for (i = 0; i < NUM_RTX_CODE; i++)
 345     {
 346       int k;
 347
 348       rtx_next_new[i] = -1;
 349       if (strncmp (rtx_format[i], "iuu", 3) == 0)
 350         rtx_next_new[i] = 2;
 351       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
 352         rtx_next_new[i] = 1;
 353       else
 354         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
 355           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
 356             rtx_next_new[i] = k;
 357     }
 358 }
 359
 360 /* Write out the contents of the rtx_next array.  */
 361 static void
 362 write_rtx_next (void)
 363 {
 364   outf_p f = get_output_file_with_visibility (NULL);
 365   int i;
 366
 367   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
 368   oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
 369   for (i = 0; i < NUM_RTX_CODE; i++)
 370     if (rtx_next_new[i] == -1)
 371       oprintf (f, "  0,\n");
 372     else
 373       oprintf (f,
 374                "  RTX_HDR_SIZE + %d * sizeof (rtunion),\n",
 375                rtx_next_new[i]);
 376   oprintf (f, "};\n");
 377 }
 378
 379 /* Handle `special("rtx_def")'.  This is a special case for field
 380    `fld' of struct rtx_def, which is an array of unions whose values
 381    are based in a complex way on the type of RTL.  */
 382
 383 static type_p
 384 adjust_field_rtx_def (type_p t, options_p opt ATTRIBUTE_UNUSED)
 385 {
 386   pair_p flds = NULL;
 387   options_p nodot;
 388   int i;
 389   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
 390   type_p bitmap_tp, basic_block_tp, reg_attrs_tp;
 391
 392   static const char * const rtx_name[NUM_RTX_CODE] = {
 393 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
 394 #include "rtl.def"
 395 #undef DEF_RTL_EXPR
 396   };
 397
 398   if (t->kind != TYPE_UNION)
 399     {
 400       error_at_line (&lexer_line,
 401                      "special `rtx_def' must be applied to a union");
 402       return &string_type;
 403     }
 404
 405   nodot = xmalloc (sizeof (*nodot));
 406   nodot->next = NULL;
 407   nodot->name = "dot";
 408   nodot->info = "";
 409
 410   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
 411   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
 412   tree_tp = create_pointer (find_structure ("tree_node", 1));
 413   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
 414   reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
 415   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
 416   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
 417   scalar_tp = create_scalar_type ("rtunion scalar", 14);
 418
 419   {
 420     pair_p note_flds = NULL;
 421     int c;
 422
 423     for (c = NOTE_INSN_BIAS; c <= NOTE_INSN_MAX; c++)
 424       {
 425         pair_p old_note_flds = note_flds;
 426
 427         note_flds = xmalloc (sizeof (*note_flds));
 428         note_flds->line.file = __FILE__;
 429         note_flds->line.line = __LINE__;
 430         note_flds->opt = xmalloc (sizeof (*note_flds->opt));
 431         note_flds->opt->next = nodot;
 432         note_flds->opt->name = "tag";
 433         note_flds->opt->info = xasprintf ("%d", c);
 434         note_flds->next = old_note_flds;
 435
 436         switch (c)
 437           {
 438             /* NOTE_INSN_MAX is used as the default field for line
 439                number notes.  */
 440           case NOTE_INSN_MAX:
 441             note_flds->opt->name = "default";
 442             note_flds->name = "rtstr";
 443             note_flds->type = &string_type;
 444             break;
 445
 446           case NOTE_INSN_BLOCK_BEG:
 447           case NOTE_INSN_BLOCK_END:
 448             note_flds->name = "rttree";
 449             note_flds->type = tree_tp;
 450             break;
 451
 452           case NOTE_INSN_EXPECTED_VALUE:
 453           case NOTE_INSN_VAR_LOCATION:
 454             note_flds->name = "rtx";
 455             note_flds->type = rtx_tp;
 456             break;
 457
 458           default:
 459             note_flds->name = "rtint";
 460             note_flds->type = scalar_tp;
 461             break;
 462           }
 463       }
 464     new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
 465   }
 466
 467   note_union_tp = find_structure ("rtx_def_note_subunion", 1);
 468
 469   for (i = 0; i < NUM_RTX_CODE; i++)
 470     {
 471       pair_p old_flds = flds;
 472       pair_p subfields = NULL;
 473       size_t aindex, nmindex;
 474       const char *sname;
 475       char *ftag;
 476
 477       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
 478         {
 479           pair_p old_subf = subfields;
 480           type_p t;
 481           const char *subname;
 482
 483           switch (rtx_format[i][aindex])
 484             {
 485             case '*':
 486             case 'i':
 487             case 'n':
 488             case 'w':
 489               t = scalar_tp;
 490               subname = "rtint";
 491               break;
 492
 493             case '0':
 494               if (i == MEM && aindex == 1)
 495                 t = mem_attrs_tp, subname = "rtmem";
 496               else if (i == JUMP_INSN && aindex == 9)
 497                 t = rtx_tp, subname = "rtx";
 498               else if (i == CODE_LABEL && aindex == 4)
 499                 t = scalar_tp, subname = "rtint";
 500               else if (i == CODE_LABEL && aindex == 5)
 501                 t = rtx_tp, subname = "rtx";
 502               else if (i == LABEL_REF
 503                        && (aindex == 1 || aindex == 2))
 504                 t = rtx_tp, subname = "rtx";
 505               else if (i == NOTE && aindex == 4)
 506                 t = note_union_tp, subname = "";
 507               else if (i == NOTE && aindex >= 7)
 508                 t = scalar_tp, subname = "rtint";
 509               else if (i == ADDR_DIFF_VEC && aindex == 4)
 510                 t = scalar_tp, subname = "rtint";
 511               else if (i == VALUE && aindex == 0)
 512                 t = scalar_tp, subname = "rtint";
 513               else if (i == REG && aindex == 1)
 514                 t = scalar_tp, subname = "rtint";
 515               else if (i == REG && aindex == 2)
 516                 t = reg_attrs_tp, subname = "rtreg";
 517               else if (i == SCRATCH && aindex == 0)
 518                 t = scalar_tp, subname = "rtint";
 519               else if (i == SYMBOL_REF && aindex == 1)
 520                 t = scalar_tp, subname = "rtint";
 521               else if (i == SYMBOL_REF && aindex == 2)
 522                 t = tree_tp, subname = "rttree";
 523               else if (i == BARRIER && aindex >= 3)
 524                 t = scalar_tp, subname = "rtint";
 525               else
 526                 {
 527                   error_at_line (&lexer_line,
 528                         "rtx type `%s' has `0' in position %lu, can't handle",
 529                                  rtx_name[i], (unsigned long) aindex);
 530                   t = &string_type;
 531                   subname = "rtint";
 532                 }
 533               break;
 534
 535             case 's':
 536             case 'S':
 537             case 'T':
 538               t = &string_type;
 539               subname = "rtstr";
 540               break;
 541
 542             case 'e':
 543             case 'u':
 544               t = rtx_tp;
 545               subname = "rtx";
 546               break;
 547
 548             case 'E':
 549             case 'V':
 550               t = rtvec_tp;
 551               subname = "rtvec";
 552               break;
 553
 554             case 't':
 555               t = tree_tp;
 556               subname = "rttree";
 557               break;
 558
 559             case 'b':
 560               t = bitmap_tp;
 561               subname = "rtbit";
 562               break;
 563
 564             case 'B':
 565               t = basic_block_tp;
 566               subname = "bb";
 567               break;
 568
 569             default:
 570               error_at_line (&lexer_line,
 571                      "rtx type `%s' has `%c' in position %lu, can't handle",
 572                              rtx_name[i], rtx_format[i][aindex],
 573                              (unsigned long)aindex);
 574               t = &string_type;
 575               subname = "rtint";
 576               break;
 577             }
 578
 579           subfields = xmalloc (sizeof (*subfields));
 580           subfields->next = old_subf;
 581           subfields->type = t;
 582           subfields->name = xasprintf (".fld[%lu].%s", (unsigned long)aindex,
 583                                        subname);
 584           subfields->line.file = __FILE__;
 585           subfields->line.line = __LINE__;
 586           if (t == note_union_tp)
 587             {
 588               subfields->opt = xmalloc (sizeof (*subfields->opt));
 589               subfields->opt->next = nodot;
 590               subfields->opt->name = "desc";
 591               subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
 592             }
 593           else if (t == basic_block_tp)
 594             {
 595               /* We don't presently GC basic block structures...  */
 596               subfields->opt = xmalloc (sizeof (*subfields->opt));
 597               subfields->opt->next = nodot;
 598               subfields->opt->name = "skip";
 599               subfields->opt->info = NULL;
 600             }
 601           else
 602             subfields->opt = nodot;
 603         }
 604
 605       flds = xmalloc (sizeof (*flds));
 606       flds->next = old_flds;
 607       flds->name = "";
 608       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
 609       new_structure (sname, 0, &lexer_line, subfields, NULL);
 610       flds->type = find_structure (sname, 0);
 611       flds->line.file = __FILE__;
 612       flds->line.line = __LINE__;
 613       flds->opt = xmalloc (sizeof (*flds->opt));
 614       flds->opt->next = nodot;
 615       flds->opt->name = "tag";
 616       ftag = xstrdup (rtx_name[i]);
 617       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
 618         ftag[nmindex] = TOUPPER (ftag[nmindex]);
 619       flds->opt->info = ftag;
 620     }
 621
 622   new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
 623   return find_structure ("rtx_def_subunion", 1);
 624 }
 625
 626 /* Handle `special("tree_exp")'.  This is a special case for
 627    field `operands' of struct tree_exp, which although it claims to contain
 628    pointers to trees, actually sometimes contains pointers to RTL too.
 629    Passed T, the old type of the field, and OPT its options.  Returns
 630    a new type for the field.  */
 631
 632 static type_p
 633 adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
 634 {
 635   pair_p flds;
 636   options_p nodot;
 637   size_t i;
 638   static const struct {
 639     const char *name;
 640     int first_rtl;
 641     int num_rtl;
 642   } data[] = {
 643     { "SAVE_EXPR", 2, 1 },
 644     { "GOTO_SUBROUTINE_EXPR", 0, 2 },
 645     { "RTL_EXPR", 0, 2 },
 646     { "WITH_CLEANUP_EXPR", 2, 1 },
 647   };
 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 static 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", "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.  Call D->PROCESS_FIELD on subobjects before calling it on
1485    pointers to those objects.  D->PREV_VAL lists the objects
1486    containing the current object, D->OPT is a list of options to
1487    apply, D->INDENT is the current indentation level, D->LINE is used
1488    to print error messages, D->BITMAP indicates which languages to
1489    print the structure for, and D->PARAM is the current parameter
1490    (from an enclosing param_is option).  */
1491
1492 static void
1493 walk_type (type_p t, struct walk_type_data *d)
1494 {
1495   const char *length = NULL;
1496   const char *desc = NULL;
1497   int maybe_undef_p = 0;
1498   int use_param_num = -1;
1499   int use_params_p = 0;
1500   options_p oo;
1501
1502   d->needs_cast_p = 0;
1503   for (oo = d->opt; oo; oo = oo->next)
1504     if (strcmp (oo->name, "length") == 0)
1505       length = (const char *)oo->info;
1506     else if (strcmp (oo->name, "maybe_undef") == 0)
1507       maybe_undef_p = 1;
1508     else if (strncmp (oo->name, "use_param", 9) == 0
1509              && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1510       use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
1511     else if (strcmp (oo->name, "use_params") == 0)
1512       use_params_p = 1;
1513     else if (strcmp (oo->name, "desc") == 0)
1514       desc = (const char *)oo->info;
1515     else if (strcmp (oo->name, "dot") == 0)
1516       ;
1517     else if (strcmp (oo->name, "tag") == 0)
1518       ;
1519     else if (strcmp (oo->name, "special") == 0)
1520       ;
1521     else if (strcmp (oo->name, "skip") == 0)
1522       ;
1523     else if (strcmp (oo->name, "default") == 0)
1524       ;
1525     else if (strcmp (oo->name, "descbits") == 0)
1526       ;
1527     else if (strcmp (oo->name, "param_is") == 0)
1528       ;
1529     else if (strncmp (oo->name, "param", 5) == 0
1530              && ISDIGIT (oo->name[5])
1531              && strcmp (oo->name + 6, "_is") == 0)
1532       ;
1533     else if (strcmp (oo->name, "chain_next") == 0)
1534       ;
1535     else if (strcmp (oo->name, "chain_prev") == 0)
1536       ;
1537     else if (strcmp (oo->name, "reorder") == 0)
1538       ;
1539     else
1540       error_at_line (d->line, "unknown option `%s'\n", oo->name);
1541
1542   if (d->used_length)
1543     length = NULL;
1544
1545   if (use_params_p)
1546     {
1547       int pointer_p = t->kind == TYPE_POINTER;
1548
1549       if (pointer_p)
1550         t = t->u.p;
1551       if (! UNION_OR_STRUCT_P (t))
1552         error_at_line (d->line, "`use_params' option on unimplemented type");
1553       else
1554         t = find_param_structure (t, d->param);
1555       if (pointer_p)
1556         t = create_pointer (t);
1557     }
1558
1559   if (use_param_num != -1)
1560     {
1561       if (d->param != NULL && d->param[use_param_num] != NULL)
1562         {
1563           type_p nt = d->param[use_param_num];
1564
1565           if (t->kind == TYPE_ARRAY)
1566             nt = create_array (nt, t->u.a.len);
1567           else if (length != NULL && t->kind == TYPE_POINTER)
1568             nt = create_pointer (nt);
1569           d->needs_cast_p = (t->kind != TYPE_POINTER
1570                              && (nt->kind == TYPE_POINTER
1571                                  || nt->kind == TYPE_STRING));
1572           t = nt;
1573         }
1574       else
1575         error_at_line (d->line, "no parameter defined for `%s'",
1576                        d->val);
1577     }
1578
1579   if (maybe_undef_p
1580       && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
1581     {
1582       error_at_line (d->line,
1583                      "field `%s' has invalid option `maybe_undef_p'\n",
1584                      d->val);
1585       return;
1586     }
1587
1588   switch (t->kind)
1589     {
1590     case TYPE_SCALAR:
1591     case TYPE_STRING:
1592       d->process_field (t, d);
1593       break;
1594
1595     case TYPE_POINTER:
1596       {
1597         if (maybe_undef_p
1598             && t->u.p->u.s.line.file == NULL)
1599           {
1600             oprintf (d->of, "%*sif (%s) abort();\n", d->indent, "", d->val);
1601             break;
1602           }
1603
1604         if (! length)
1605           {
1606             if (! UNION_OR_STRUCT_P (t->u.p)
1607                 && t->u.p->kind != TYPE_PARAM_STRUCT)
1608               {
1609                 error_at_line (d->line,
1610                                "field `%s' is pointer to unimplemented type",
1611                                d->val);
1612                 break;
1613               }
1614
1615             d->process_field (t->u.p, d);
1616           }
1617         else
1618           {
1619             int loopcounter = d->counter++;
1620             const char *oldval = d->val;
1621             const char *oldprevval3 = d->prev_val[3];
1622             char *newval;
1623
1624             oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
1625             d->indent += 2;
1626             oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
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->process_field(t, d);
1643             d->indent -= 2;
1644             oprintf (d->of, "%*s}\n", d->indent, "");
1645           }
1646       }
1647       break;
1648
1649     case TYPE_ARRAY:
1650       {
1651         int loopcounter = d->counter++;
1652         const char *oldval = d->val;
1653         char *newval;
1654
1655         /* If it's an array of scalars, we optimize by not generating
1656            any code.  */
1657         if (t->u.a.p->kind == TYPE_SCALAR)
1658           break;
1659
1660         oprintf (d->of, "%*s{\n", d->indent, "");
1661         d->indent += 2;
1662         oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1663         oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1664                  loopcounter, loopcounter);
1665         if (length)
1666           output_escaped_param (d, length, "length");
1667         else
1668           oprintf (d->of, "%s", t->u.a.len);
1669         oprintf (d->of, "); i%d++) {\n", loopcounter);
1670         d->indent += 2;
1671         d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1672         d->used_length = 1;
1673         walk_type (t->u.a.p, d);
1674         free (newval);
1675         d->used_length = 0;
1676         d->val = oldval;
1677         d->indent -= 2;
1678         oprintf (d->of, "%*s}\n", d->indent, "");
1679         d->indent -= 2;
1680         oprintf (d->of, "%*s}\n", d->indent, "");
1681       }
1682       break;
1683
1684     case TYPE_STRUCT:
1685     case TYPE_UNION:
1686       {
1687         pair_p f;
1688         const char *oldval = d->val;
1689         const char *oldprevval1 = d->prev_val[1];
1690         const char *oldprevval2 = d->prev_val[2];
1691         const int union_p = t->kind == TYPE_UNION;
1692         int seen_default_p = 0;
1693         options_p o;
1694
1695         if (! t->u.s.line.file)
1696           error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
1697
1698         if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
1699           {
1700             error_at_line (d->line,
1701                            "structure `%s' defined for mismatching languages",
1702                            t->u.s.tag);
1703             error_at_line (&t->u.s.line, "one structure defined here");
1704           }
1705
1706         /* Some things may also be defined in the structure's options.  */
1707         for (o = t->u.s.opt; o; o = o->next)
1708           if (! desc && strcmp (o->name, "desc") == 0)
1709             desc = (const char *)o->info;
1710
1711         d->prev_val[2] = oldval;
1712         d->prev_val[1] = oldprevval2;
1713         if (union_p)
1714           {
1715             if (desc == NULL)
1716               {
1717                 error_at_line (d->line, "missing `desc' option for union `%s'",
1718                                t->u.s.tag);
1719                 desc = "1";
1720               }
1721             oprintf (d->of, "%*sswitch (", d->indent, "");
1722             output_escaped_param (d, desc, "desc");
1723             oprintf (d->of, ")\n");
1724             d->indent += 2;
1725             oprintf (d->of, "%*s{\n", d->indent, "");
1726           }
1727         for (f = t->u.s.fields; f; f = f->next)
1728           {
1729             options_p oo;
1730             const char *dot = ".";
1731             const char *tagid = NULL;
1732             int skip_p = 0;
1733             int default_p = 0;
1734             int use_param_p = 0;
1735             char *newval;
1736
1737             d->reorder_fn = NULL;
1738             for (oo = f->opt; oo; oo = oo->next)
1739               if (strcmp (oo->name, "dot") == 0)
1740                 dot = (const char *)oo->info;
1741               else if (strcmp (oo->name, "tag") == 0)
1742                 tagid = (const char *)oo->info;
1743               else if (strcmp (oo->name, "skip") == 0)
1744                 skip_p = 1;
1745               else if (strcmp (oo->name, "default") == 0)
1746                 default_p = 1;
1747               else if (strcmp (oo->name, "reorder") == 0)
1748                 d->reorder_fn = (const char *)oo->info;
1749               else if (strncmp (oo->name, "use_param", 9) == 0
1750                        && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1751                 use_param_p = 1;
1752
1753             if (skip_p)
1754               continue;
1755
1756             if (union_p && tagid)
1757               {
1758                 oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
1759                 d->indent += 2;
1760               }
1761             else if (union_p && default_p)
1762               {
1763                 oprintf (d->of, "%*sdefault:\n", d->indent, "");
1764                 d->indent += 2;
1765                 seen_default_p = 1;
1766               }
1767             else if (! union_p && (default_p || tagid))
1768               error_at_line (d->line,
1769                              "can't use `%s' outside a union on field `%s'",
1770                              default_p ? "default" : "tag", f->name);
1771             else if (union_p && ! (default_p || tagid)
1772                      && f->type->kind == TYPE_SCALAR)
1773               {
1774                 fprintf (stderr,
1775         "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
1776                          d->line->file, d->line->line, f->name);
1777                 continue;
1778               }
1779             else if (union_p && ! (default_p || tagid))
1780               error_at_line (d->line,
1781                              "field `%s' is missing `tag' or `default' option",
1782                              f->name);
1783
1784             d->line = &f->line;
1785             d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
1786             d->opt = f->opt;
1787
1788             if (union_p && use_param_p && d->param == NULL)
1789               oprintf (d->of, "%*sabort();\n", d->indent, "");
1790             else
1791               walk_type (f->type, d);
1792
1793             free (newval);
1794
1795             if (union_p)
1796               {
1797                 oprintf (d->of, "%*sbreak;\n", d->indent, "");
1798                 d->indent -= 2;
1799               }
1800           }
1801         d->reorder_fn = NULL;
1802
1803         d->val = oldval;
1804         d->prev_val[1] = oldprevval1;
1805         d->prev_val[2] = oldprevval2;
1806
1807         if (union_p && ! seen_default_p)
1808           {
1809             oprintf (d->of, "%*sdefault:\n", d->indent, "");
1810             oprintf (d->of, "%*s  break;\n", d->indent, "");
1811           }
1812         if (union_p)
1813           {
1814             oprintf (d->of, "%*s}\n", d->indent, "");
1815             d->indent -= 2;
1816           }
1817       }
1818       break;
1819
1820     case TYPE_LANG_STRUCT:
1821       {
1822         type_p nt;
1823         for (nt = t->u.s.lang_struct; nt; nt = nt->next)
1824           if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
1825             break;
1826         if (nt == NULL)
1827           error_at_line (d->line, "structure `%s' differs between languages",
1828                          t->u.s.tag);
1829         else
1830           walk_type (nt, d);
1831       }
1832       break;
1833
1834     case TYPE_PARAM_STRUCT:
1835       {
1836         type_p *oldparam = d->param;
1837
1838         d->param = t->u.param_struct.param;
1839         walk_type (t->u.param_struct.stru, d);
1840         d->param = oldparam;
1841       }
1842       break;
1843
1844     default:
1845       abort ();
1846     }
1847 }
1848
1849 /* process_field routine for marking routines.  */
1850
1851 static void
1852 write_types_process_field (type_p f, const struct walk_type_data *d)
1853 {
1854   const struct write_types_data *wtd;
1855   const char *cast = d->needs_cast_p ? "(void *)" : "";
1856   wtd = (const struct write_types_data *) d->cookie;
1857
1858   switch (f->kind)
1859     {
1860     case TYPE_POINTER:
1861       oprintf (d->of, "%*s%s (%s%s", d->indent, "",
1862                wtd->subfield_marker_routine, cast, d->val);
1863       if (wtd->param_prefix)
1864         {
1865           oprintf (d->of, ", %s", d->prev_val[3]);
1866           if (d->orig_s)
1867             {
1868               oprintf (d->of, ", gt_%s_", wtd->param_prefix);
1869               output_mangled_typename (d->of, d->orig_s);
1870             }
1871           else
1872             oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
1873         }
1874       oprintf (d->of, ");\n");
1875       if (d->reorder_fn && wtd->reorder_note_routine)
1876         oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
1877                  wtd->reorder_note_routine, cast, d->val,
1878                  d->prev_val[3], d->reorder_fn);
1879       break;
1880
1881     case TYPE_STRING:
1882       if (wtd->param_prefix == NULL)
1883         break;
1884
1885     case TYPE_STRUCT:
1886     case TYPE_UNION:
1887     case TYPE_LANG_STRUCT:
1888     case TYPE_PARAM_STRUCT:
1889       oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
1890       output_mangled_typename (d->of, f);
1891       oprintf (d->of, " (%s%s);\n", cast, d->val);
1892       if (d->reorder_fn && wtd->reorder_note_routine)
1893         oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
1894                  wtd->reorder_note_routine, cast, d->val, cast, d->val,
1895                  d->reorder_fn);
1896       break;
1897
1898     case TYPE_SCALAR:
1899       break;
1900
1901     default:
1902       abort ();
1903     }
1904 }
1905
1906 /* For S, a structure that's part of ORIG_S, and using parameters
1907    PARAM, write out a routine that:
1908    - Takes a parameter, a void * but actually of type *S
1909    - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
1910      field of S or its substructures and (in some cases) things
1911      that are pointed to by S.
1912 */
1913
1914 static void
1915 write_func_for_structure (type_p orig_s, type_p s, type_p *param,
1916                           const struct write_types_data *wtd)
1917 {
1918   const char *fn = s->u.s.line.file;
1919   int i;
1920   const char *chain_next = NULL;
1921   const char *chain_prev = NULL;
1922   options_p opt;
1923   struct walk_type_data d;
1924
1925   /* This is a hack, and not the good kind either.  */
1926   for (i = NUM_PARAM - 1; i >= 0; i--)
1927     if (param && param[i] && param[i]->kind == TYPE_POINTER
1928         && UNION_OR_STRUCT_P (param[i]->u.p))
1929       fn = param[i]->u.p->u.s.line.file;
1930
1931   memset (&d, 0, sizeof (d));
1932   d.of = get_output_file_with_visibility (fn);
1933
1934   for (opt = s->u.s.opt; opt; opt = opt->next)
1935     if (strcmp (opt->name, "chain_next") == 0)
1936       chain_next = (const char *) opt->info;
1937     else if (strcmp (opt->name, "chain_prev") == 0)
1938       chain_prev = (const char *) opt->info;
1939
1940   if (chain_prev != NULL && chain_next == NULL)
1941     error_at_line (&s->u.s.line, "chain_prev without chain_next");
1942
1943   d.process_field = write_types_process_field;
1944   d.cookie = wtd;
1945   d.orig_s = orig_s;
1946   d.opt = s->u.s.opt;
1947   d.line = &s->u.s.line;
1948   d.bitmap = s->u.s.bitmap;
1949   d.param = param;
1950   d.prev_val[0] = "*x";
1951   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
1952   d.prev_val[3] = "x";
1953   d.val = "(*x)";
1954
1955   oprintf (d.of, "\n");
1956   oprintf (d.of, "void\n");
1957   if (param == NULL)
1958     oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
1959   else
1960     {
1961       oprintf (d.of, "gt_%s_", wtd->prefix);
1962       output_mangled_typename (d.of, orig_s);
1963     }
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, " (void *this_obj ATTRIBUTE_UNUSED,\n\tvoid *x_p,\n\tgt_pointer_operator op ATTRIBUTE_UNUSED,\n\tvoid *cookie ATTRIBUTE_UNUSED)\n");
2213   oprintf (d.of, "{\n");
2214   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2215            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2216            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2217   d.indent = 2;
2218   walk_type (s, &d);
2219   oprintf (d.of, "}\n");
2220 }
2221
2222 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2223
2224 static void
2225 write_local (type_p structures, type_p param_structs)
2226 {
2227   type_p s;
2228
2229   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2230   for (s = structures; s; s = s->next)
2231     if (s->gc_used == GC_POINTED_TO
2232         || s->gc_used == GC_MAYBE_POINTED_TO)
2233       {
2234         options_p opt;
2235
2236         if (s->u.s.line.file == NULL)
2237           continue;
2238
2239         for (opt = s->u.s.opt; opt; opt = opt->next)
2240           if (strcmp (opt->name, "ptr_alias") == 0)
2241             {
2242               type_p t = (type_p) opt->info;
2243               if (t->kind == TYPE_STRUCT
2244                   || t->kind == TYPE_UNION
2245                   || t->kind == TYPE_LANG_STRUCT)
2246                 {
2247                   oprintf (header_file, "#define gt_pch_p_");
2248                   output_mangled_typename (header_file, s);
2249                   oprintf (header_file, " gt_pch_p_");
2250                   output_mangled_typename (header_file, t);
2251                   oprintf (header_file, "\n");
2252                 }
2253               else
2254                 error_at_line (&s->u.s.line,
2255                                "structure alias is not a structure");
2256               break;
2257             }
2258         if (opt)
2259           continue;
2260
2261         /* Declare the marker procedure only once.  */
2262         oprintf (header_file, "extern void gt_pch_p_");
2263         output_mangled_typename (header_file, s);
2264         oprintf (header_file,
2265          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2266
2267         if (s->kind == TYPE_LANG_STRUCT)
2268           {
2269             type_p ss;
2270             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2271               write_local_func_for_structure (s, ss, NULL);
2272           }
2273         else
2274           write_local_func_for_structure (s, s, NULL);
2275       }
2276
2277   for (s = param_structs; s; s = s->next)
2278     if (s->gc_used == GC_POINTED_TO)
2279       {
2280         type_p * param = s->u.param_struct.param;
2281         type_p stru = s->u.param_struct.stru;
2282
2283         /* Declare the marker procedure.  */
2284         oprintf (header_file, "extern void gt_pch_p_");
2285         output_mangled_typename (header_file, s);
2286         oprintf (header_file,
2287          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2288
2289         if (stru->u.s.line.file == NULL)
2290           {
2291             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2292                      s->u.s.tag);
2293             continue;
2294           }
2295
2296         if (stru->kind == TYPE_LANG_STRUCT)
2297           {
2298             type_p ss;
2299             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2300               write_local_func_for_structure (s, ss, param);
2301           }
2302         else
2303           write_local_func_for_structure (s, stru, param);
2304       }
2305 }
2306
2307 /* Write out the 'enum' definition for gt_types_enum.  */
2308
2309 static void
2310 write_enum_defn (type_p structures, type_p param_structs)
2311 {
2312   type_p s;
2313
2314   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2315   oprintf (header_file, "enum gt_types_enum {\n");
2316   for (s = structures; s; s = s->next)
2317     if (s->gc_used == GC_POINTED_TO
2318         || s->gc_used == GC_MAYBE_POINTED_TO)
2319       {
2320         if (s->gc_used == GC_MAYBE_POINTED_TO
2321             && s->u.s.line.file == NULL)
2322           continue;
2323
2324         oprintf (header_file, " gt_ggc_e_");
2325         output_mangled_typename (header_file, s);
2326         oprintf (header_file, ", \n");
2327       }
2328   for (s = param_structs; s; s = s->next)
2329     if (s->gc_used == GC_POINTED_TO)
2330       {
2331         oprintf (header_file, " gt_e_");
2332         output_mangled_typename (header_file, s);
2333         oprintf (header_file, ", \n");
2334       }
2335   oprintf (header_file, " gt_types_enum_last\n");
2336   oprintf (header_file, "};\n");
2337 }
2338
2339 /* Might T contain any non-pointer elements?  */
2340
2341 static int
2342 contains_scalar_p (type_p t)
2343 {
2344   switch (t->kind)
2345     {
2346     case TYPE_STRING:
2347     case TYPE_POINTER:
2348       return 0;
2349     case TYPE_ARRAY:
2350       return contains_scalar_p (t->u.a.p);
2351     default:
2352       /* Could also check for structures that have no non-pointer
2353          fields, but there aren't enough of those to worry about.  */
2354       return 1;
2355     }
2356 }
2357
2358 /* Mangle FN and print it to F.  */
2359
2360 static void
2361 put_mangled_filename (outf_p f, const char *fn)
2362 {
2363   const char *name = get_output_file_name (fn);
2364   for (; *name != 0; name++)
2365     if (ISALNUM (*name))
2366       oprintf (f, "%c", *name);
2367     else
2368       oprintf (f, "%c", '_');
2369 }
2370
2371 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2372    LASTNAME, and NAME are all strings to insert in various places in
2373    the resulting code.  */
2374
2375 static void
2376 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2377                    const char *tname, const char *name)
2378 {
2379   struct flist *fli2;
2380
2381   for (fli2 = flp; fli2; fli2 = fli2->next)
2382     if (fli2->started_p)
2383       {
2384         oprintf (fli2->f, "  %s\n", lastname);
2385         oprintf (fli2->f, "};\n\n");
2386       }
2387
2388   for (fli2 = flp; fli2; fli2 = fli2->next)
2389     if (fli2->started_p)
2390       {
2391         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2392         int fnum;
2393
2394         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2395           if (bitmap & 1)
2396             {
2397               oprintf (base_files[fnum],
2398                        "extern const struct %s gt_%s_",
2399                        tname, pfx);
2400               put_mangled_filename (base_files[fnum], fli2->name);
2401               oprintf (base_files[fnum], "[];\n");
2402             }
2403       }
2404
2405   {
2406     size_t fnum;
2407     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2408       oprintf (base_files [fnum],
2409                "const struct %s * const %s[] = {\n",
2410                tname, name);
2411   }
2412
2413
2414   for (fli2 = flp; fli2; fli2 = fli2->next)
2415     if (fli2->started_p)
2416       {
2417         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2418         int fnum;
2419
2420         fli2->started_p = 0;
2421
2422         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2423           if (bitmap & 1)
2424             {
2425               oprintf (base_files[fnum], "  gt_%s_", pfx);
2426               put_mangled_filename (base_files[fnum], fli2->name);
2427               oprintf (base_files[fnum], ",\n");
2428             }
2429       }
2430
2431   {
2432     size_t fnum;
2433     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2434       {
2435         oprintf (base_files[fnum], "  NULL\n");
2436         oprintf (base_files[fnum], "};\n");
2437       }
2438   }
2439 }
2440
2441 /* Write out to F the table entry and any marker routines needed to
2442    mark NAME as TYPE.  The original variable is V, at LINE.
2443    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2444    is nonzero iff we are building the root table for hash table caches.  */
2445
2446 static void
2447 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2448             struct fileloc *line, const char *if_marked)
2449 {
2450   switch (type->kind)
2451     {
2452     case TYPE_STRUCT:
2453       {
2454         pair_p fld;
2455         for (fld = type->u.s.fields; fld; fld = fld->next)
2456           {
2457             int skip_p = 0;
2458             const char *desc = NULL;
2459             options_p o;
2460
2461             for (o = fld->opt; o; o = o->next)
2462               if (strcmp (o->name, "skip") == 0)
2463                 skip_p = 1;
2464               else if (strcmp (o->name, "desc") == 0)
2465                 desc = (const char *)o->info;
2466               else
2467                 error_at_line (line,
2468                        "field `%s' of global `%s' has unknown option `%s'",
2469                                fld->name, name, o->name);
2470
2471             if (skip_p)
2472               continue;
2473             else if (desc && fld->type->kind == TYPE_UNION)
2474               {
2475                 pair_p validf = NULL;
2476                 pair_p ufld;
2477
2478                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2479                   {
2480                     const char *tag = NULL;
2481                     options_p oo;
2482
2483                     for (oo = ufld->opt; oo; oo = oo->next)
2484                       if (strcmp (oo->name, "tag") == 0)
2485                         tag = (const char *)oo->info;
2486                     if (tag == NULL || strcmp (tag, desc) != 0)
2487                       continue;
2488                     if (validf != NULL)
2489                       error_at_line (line,
2490                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2491                                      name, fld->name, validf->name,
2492                                      name, fld->name, ufld->name,
2493                                      tag);
2494                     validf = ufld;
2495                   }
2496                 if (validf != NULL)
2497                   {
2498                     char *newname;
2499                     newname = xasprintf ("%s.%s.%s",
2500                                          name, fld->name, validf->name);
2501                     write_root (f, v, validf->type, newname, 0, line,
2502                                 if_marked);
2503                     free (newname);
2504                   }
2505               }
2506             else if (desc)
2507               error_at_line (line,
2508                      "global `%s.%s' has `desc' option but is not union",
2509                              name, fld->name);
2510             else
2511               {
2512                 char *newname;
2513                 newname = xasprintf ("%s.%s", name, fld->name);
2514                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2515                 free (newname);
2516               }
2517           }
2518       }
2519       break;
2520
2521     case TYPE_ARRAY:
2522       {
2523         char *newname;
2524         newname = xasprintf ("%s[0]", name);
2525         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2526         free (newname);
2527       }
2528       break;
2529
2530     case TYPE_POINTER:
2531       {
2532         type_p ap, tp;
2533
2534         oprintf (f, "  {\n");
2535         oprintf (f, "    &%s,\n", name);
2536         oprintf (f, "    1");
2537
2538         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2539           if (ap->u.a.len[0])
2540             oprintf (f, " * (%s)", ap->u.a.len);
2541           else if (ap == v->type)
2542             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2543         oprintf (f, ",\n");
2544         oprintf (f, "    sizeof (%s", v->name);
2545         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2546           oprintf (f, "[0]");
2547         oprintf (f, "),\n");
2548
2549         tp = type->u.p;
2550
2551         if (! has_length && UNION_OR_STRUCT_P (tp))
2552           {
2553             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2554             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2555           }
2556         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2557           {
2558             oprintf (f, "    &gt_ggc_m_");
2559             output_mangled_typename (f, tp);
2560             oprintf (f, ",\n    &gt_pch_n_");
2561             output_mangled_typename (f, tp);
2562           }
2563         else if (has_length
2564                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2565           {
2566             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2567             oprintf (f, "    &gt_pch_na_%s", name);
2568           }
2569         else
2570           {
2571             error_at_line (line,
2572                            "global `%s' is pointer to unimplemented type",
2573                            name);
2574           }
2575         if (if_marked)
2576           oprintf (f, ",\n    &%s", if_marked);
2577         oprintf (f, "\n  },\n");
2578       }
2579       break;
2580
2581     case TYPE_STRING:
2582       {
2583         oprintf (f, "  {\n");
2584         oprintf (f, "    &%s,\n", name);
2585         oprintf (f, "    1, \n");
2586         oprintf (f, "    sizeof (%s),\n", v->name);
2587         oprintf (f, "    &gt_ggc_m_S,\n");
2588         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2589         oprintf (f, "  },\n");
2590       }
2591       break;
2592
2593     case TYPE_SCALAR:
2594       break;
2595
2596     default:
2597       error_at_line (line,
2598                      "global `%s' is unimplemented type",
2599                      name);
2600     }
2601 }
2602
2603 /* This generates a routine to walk an array.  */
2604
2605 static void
2606 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2607 {
2608   struct walk_type_data d;
2609   char *prevval3;
2610
2611   memset (&d, 0, sizeof (d));
2612   d.of = f;
2613   d.cookie = wtd;
2614   d.indent = 2;
2615   d.line = &v->line;
2616   d.opt = v->opt;
2617   d.bitmap = get_base_file_bitmap (v->line.file);
2618   d.param = NULL;
2619
2620   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2621
2622   if (wtd->param_prefix)
2623     {
2624       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2625       oprintf (f,
2626        "    (void *, void *, gt_pointer_operator, void *);\n");
2627       oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
2628                wtd->param_prefix, v->name);
2629       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
2630       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
2631       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
2632       oprintf (d.of, "{\n");
2633       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2634       d.process_field = write_types_local_process_field;
2635       walk_type (v->type, &d);
2636       oprintf (f, "}\n\n");
2637     }
2638
2639   d.opt = v->opt;
2640   oprintf (f, "static void gt_%sa_%s (void *);\n",
2641            wtd->prefix, v->name);
2642   oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
2643            wtd->prefix, v->name);
2644   oprintf (f, "{\n");
2645   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2646   d.process_field = write_types_process_field;
2647   walk_type (v->type, &d);
2648   free (prevval3);
2649   oprintf (f, "}\n\n");
2650 }
2651
2652 /* Output a table describing the locations and types of VARIABLES.  */
2653
2654 static void
2655 write_roots (pair_p variables)
2656 {
2657   pair_p v;
2658   struct flist *flp = NULL;
2659
2660   for (v = variables; v; v = v->next)
2661     {
2662       outf_p f = get_output_file_with_visibility (v->line.file);
2663       struct flist *fli;
2664       const char *length = NULL;
2665       int deletable_p = 0;
2666       options_p o;
2667
2668       for (o = v->opt; o; o = o->next)
2669         if (strcmp (o->name, "length") == 0)
2670           length = (const char *)o->info;
2671         else if (strcmp (o->name, "deletable") == 0)
2672           deletable_p = 1;
2673         else if (strcmp (o->name, "param_is") == 0)
2674           ;
2675         else if (strncmp (o->name, "param", 5) == 0
2676                  && ISDIGIT (o->name[5])
2677                  && strcmp (o->name + 6, "_is") == 0)
2678           ;
2679         else if (strcmp (o->name, "if_marked") == 0)
2680           ;
2681         else
2682           error_at_line (&v->line,
2683                          "global `%s' has unknown option `%s'",
2684                          v->name, o->name);
2685
2686       for (fli = flp; fli; fli = fli->next)
2687         if (fli->f == f)
2688           break;
2689       if (fli == NULL)
2690         {
2691           fli = xmalloc (sizeof (*fli));
2692           fli->f = f;
2693           fli->next = flp;
2694           fli->started_p = 0;
2695           fli->name = v->line.file;
2696           flp = fli;
2697
2698           oprintf (f, "\n/* GC roots.  */\n\n");
2699         }
2700
2701       if (! deletable_p
2702           && length
2703           && v->type->kind == TYPE_POINTER
2704           && (v->type->u.p->kind == TYPE_POINTER
2705               || v->type->u.p->kind == TYPE_STRUCT))
2706         {
2707           write_array (f, v, &ggc_wtd);
2708           write_array (f, v, &pch_wtd);
2709         }
2710     }
2711
2712   for (v = variables; v; v = v->next)
2713     {
2714       outf_p f = get_output_file_with_visibility (v->line.file);
2715       struct flist *fli;
2716       int skip_p = 0;
2717       int length_p = 0;
2718       options_p o;
2719
2720       for (o = v->opt; o; o = o->next)
2721         if (strcmp (o->name, "length") == 0)
2722           length_p = 1;
2723         else if (strcmp (o->name, "deletable") == 0
2724                  || strcmp (o->name, "if_marked") == 0)
2725           skip_p = 1;
2726
2727       if (skip_p)
2728         continue;
2729
2730       for (fli = flp; fli; fli = fli->next)
2731         if (fli->f == f)
2732           break;
2733       if (! fli->started_p)
2734         {
2735           fli->started_p = 1;
2736
2737           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2738           put_mangled_filename (f, v->line.file);
2739           oprintf (f, "[] = {\n");
2740         }
2741
2742       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2743     }
2744
2745   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2746                      "gt_ggc_rtab");
2747
2748   for (v = variables; v; v = v->next)
2749     {
2750       outf_p f = get_output_file_with_visibility (v->line.file);
2751       struct flist *fli;
2752       int skip_p = 1;
2753       options_p o;
2754
2755       for (o = v->opt; o; o = o->next)
2756         if (strcmp (o->name, "deletable") == 0)
2757           skip_p = 0;
2758         else if (strcmp (o->name, "if_marked") == 0)
2759           skip_p = 1;
2760
2761       if (skip_p)
2762         continue;
2763
2764       for (fli = flp; fli; fli = fli->next)
2765         if (fli->f == f)
2766           break;
2767       if (! fli->started_p)
2768         {
2769           fli->started_p = 1;
2770
2771           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2772           put_mangled_filename (f, v->line.file);
2773           oprintf (f, "[] = {\n");
2774         }
2775
2776       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2777                v->name, v->name);
2778     }
2779
2780   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2781                      "gt_ggc_deletable_rtab");
2782
2783   for (v = variables; v; v = v->next)
2784     {
2785       outf_p f = get_output_file_with_visibility (v->line.file);
2786       struct flist *fli;
2787       const char *if_marked = NULL;
2788       int length_p = 0;
2789       options_p o;
2790
2791       for (o = v->opt; o; o = o->next)
2792         if (strcmp (o->name, "length") == 0)
2793           length_p = 1;
2794         else if (strcmp (o->name, "if_marked") == 0)
2795           if_marked = (const char *) o->info;
2796
2797       if (if_marked == NULL)
2798         continue;
2799
2800       if (v->type->kind != TYPE_POINTER
2801           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2802           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2803         {
2804           error_at_line (&v->line, "if_marked option used but not hash table");
2805           continue;
2806         }
2807
2808       for (fli = flp; fli; fli = fli->next)
2809         if (fli->f == f)
2810           break;
2811       if (! fli->started_p)
2812         {
2813           fli->started_p = 1;
2814
2815           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2816           put_mangled_filename (f, v->line.file);
2817           oprintf (f, "[] = {\n");
2818         }
2819
2820       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2821                      v->name, length_p, &v->line, if_marked);
2822     }
2823
2824   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2825                      "gt_ggc_cache_rtab");
2826
2827   for (v = variables; v; v = v->next)
2828     {
2829       outf_p f = get_output_file_with_visibility (v->line.file);
2830       struct flist *fli;
2831       int length_p = 0;
2832       int if_marked_p = 0;
2833       options_p o;
2834
2835       for (o = v->opt; o; o = o->next)
2836         if (strcmp (o->name, "length") == 0)
2837           length_p = 1;
2838         else if (strcmp (o->name, "if_marked") == 0)
2839           if_marked_p = 1;
2840
2841       if (! if_marked_p)
2842         continue;
2843
2844       for (fli = flp; fli; fli = fli->next)
2845         if (fli->f == f)
2846           break;
2847       if (! fli->started_p)
2848         {
2849           fli->started_p = 1;
2850
2851           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2852           put_mangled_filename (f, v->line.file);
2853           oprintf (f, "[] = {\n");
2854         }
2855
2856       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2857     }
2858
2859   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2860                      "gt_pch_cache_rtab");
2861
2862   for (v = variables; v; v = v->next)
2863     {
2864       outf_p f = get_output_file_with_visibility (v->line.file);
2865       struct flist *fli;
2866       int skip_p = 0;
2867       options_p o;
2868
2869       for (o = v->opt; o; o = o->next)
2870         if (strcmp (o->name, "deletable") == 0
2871             || strcmp (o->name, "if_marked") == 0)
2872           skip_p = 1;
2873
2874       if (skip_p)
2875         continue;
2876
2877       if (! contains_scalar_p (v->type))
2878         continue;
2879
2880       for (fli = flp; fli; fli = fli->next)
2881         if (fli->f == f)
2882           break;
2883       if (! fli->started_p)
2884         {
2885           fli->started_p = 1;
2886
2887           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2888           put_mangled_filename (f, v->line.file);
2889           oprintf (f, "[] = {\n");
2890         }
2891
2892       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2893                v->name, v->name);
2894     }
2895
2896   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2897                      "gt_pch_scalar_rtab");
2898 }
2899
2900 \f
2901 extern int main (int argc, char **argv);
2902 int
2903 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2904 {
2905   unsigned i;
2906   static struct fileloc pos = { __FILE__, __LINE__ };
2907   unsigned j;
2908
2909   gen_rtx_next ();
2910
2911   srcdir_len = strlen (srcdir);
2912
2913   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2914   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2915   do_scalar_typedef ("uint8", &pos);
2916   do_scalar_typedef ("jword", &pos);
2917   do_scalar_typedef ("JCF_u2", &pos);
2918   do_scalar_typedef ("void", &pos);
2919
2920   do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
2921
2922   do_typedef ("HARD_REG_SET", create_array (
2923               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2924               "2"), &pos);
2925
2926   for (i = 0; i < NUM_GT_FILES; i++)
2927     {
2928       int dupflag = 0;
2929       /* Omit if already seen.  */
2930       for (j = 0; j < i; j++)
2931         {
2932           if (!strcmp (all_files[i], all_files[j]))
2933             {
2934               dupflag = 1;
2935               break;
2936             }
2937         }
2938       if (!dupflag)
2939         parse_file (all_files[i]);
2940     }
2941
2942   if (hit_error != 0)
2943     exit (1);
2944
2945   set_gc_used (variables);
2946
2947   open_base_files ();
2948   write_enum_defn (structures, param_structs);
2949   write_types (structures, param_structs, &ggc_wtd);
2950   write_types (structures, param_structs, &pch_wtd);
2951   write_local (structures, param_structs);
2952   write_roots (variables);
2953   write_rtx_next ();
2954   close_output_files ();
2955
2956   return (hit_error != 0);
2957 }