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