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