gcc/gengtype.c

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