gcc/gengtype.c

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