gcc/gengtype.c

   1 /* Process source files and output type information.
   2    Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   3
   4 This file is part of GCC.
   5
   6 GCC is free software; you can redistribute it and/or modify it under
   7 the terms of the GNU General Public License as published by the Free
   8 Software Foundation; either version 2, or (at your option) any later
   9 version.
  10
  11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
  12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GCC; see the file COPYING.  If not, write to the Free
  18 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
  19 02111-1307, USA.  */
  20
  21 #include "bconfig.h"
  22 #include "system.h"
  23 #include "coretypes.h"
  24 #include "tm.h"
  25 #include "gengtype.h"
  26 #include "gtyp-gen.h"
  27
  28 #define NO_GENRTL_H
  29 #include "rtl.h"
  30 #undef abort
  31
  32 /* Nonzero iff an error has occurred.  */
  33 static int hit_error = 0;
  34
  35 static void gen_rtx_next (void);
  36 static void write_rtx_next (void);
  37 static void open_base_files (void);
  38 static void close_output_files (void);
  39
  40 /* Report an error at POS, printing MSG.  */
  41
  42 void
  43 error_at_line (struct fileloc *pos, const char *msg, ...)
  44 {
  45   va_list ap;
  46
  47   va_start (ap, msg);
  48
  49   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
  50   vfprintf (stderr, msg, ap);
  51   fputc ('\n', stderr);
  52   hit_error = 1;
  53
  54   va_end (ap);
  55 }
  56
  57 /* vasprintf, but produces fatal message on out-of-memory.  */
  58 int
  59 xvasprintf (char **result, const char *format, va_list args)
  60 {
  61   int ret = vasprintf (result, format, args);
  62   if (*result == NULL || ret < 0)
  63     {
  64       fputs ("gengtype: out of memory", stderr);
  65       xexit (1);
  66     }
  67   return ret;
  68 }
  69
  70 /* Wrapper for xvasprintf.  */
  71 char *
  72 xasprintf (const char *format, ...)
  73 {
  74   char *result;
  75   va_list ap;
  76
  77   va_start (ap, format);
  78   xvasprintf (&result, format, ap);
  79   va_end (ap);
  80   return result;
  81 }
  82
  83 /* The one and only TYPE_STRING.  */
  84
  85 struct type string_type = {
  86   TYPE_STRING, NULL, NULL, GC_USED, {0}
  87 };
  88
  89 /* Lists of various things.  */
  90
  91 static pair_p typedefs;
  92 static type_p structures;
  93 static type_p param_structs;
  94 static pair_p variables;
  95
  96 static void do_scalar_typedef (const char *, struct fileloc *);
  97 static type_p find_param_structure
  98   (type_p t, type_p param[NUM_PARAM]);
  99 static type_p adjust_field_tree_exp (type_p t, options_p opt);
 100 static type_p adjust_field_rtx_def (type_p t, options_p opt);
 101
 102 /* Define S as a typedef to T at POS.  */
 103
 104 void
 105 do_typedef (const char *s, type_p t, struct fileloc *pos)
 106 {
 107   pair_p p;
 108
 109   for (p = typedefs; p != NULL; p = p->next)
 110     if (strcmp (p->name, s) == 0)
 111       {
 112         if (p->type != t)
 113           {
 114             error_at_line (pos, "type `%s' previously defined", s);
 115             error_at_line (&p->line, "previously defined here");
 116           }
 117         return;
 118       }
 119
 120   p = xmalloc (sizeof (struct pair));
 121   p->next = typedefs;
 122   p->name = s;
 123   p->type = t;
 124   p->line = *pos;
 125   typedefs = p;
 126 }
 127
 128 /* Define S as a typename of a scalar.  */
 129
 130 static void
 131 do_scalar_typedef (const char *s, struct fileloc *pos)
 132 {
 133   do_typedef (s, create_scalar_type (s, strlen (s)), pos);
 134 }
 135
 136 /* Return the type previously defined for S.  Use POS to report errors.  */
 137
 138 type_p
 139 resolve_typedef (const char *s, struct fileloc *pos)
 140 {
 141   pair_p p;
 142   for (p = typedefs; p != NULL; p = p->next)
 143     if (strcmp (p->name, s) == 0)
 144       return p->type;
 145   error_at_line (pos, "unidentified type `%s'", s);
 146   return create_scalar_type ("char", 4);
 147 }
 148
 149 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
 150    at POS with fields FIELDS and options O.  */
 151
 152 void
 153 new_structure (const char *name, int isunion, struct fileloc *pos,
 154                pair_p fields, options_p o)
 155 {
 156   type_p si;
 157   type_p s = NULL;
 158   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 159
 160   for (si = structures; si != NULL; si = si->next)
 161     if (strcmp (name, si->u.s.tag) == 0
 162         && UNION_P (si) == isunion)
 163       {
 164         type_p ls = NULL;
 165         if (si->kind == TYPE_LANG_STRUCT)
 166           {
 167             ls = si;
 168
 169             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
 170               if (si->u.s.bitmap == bitmap)
 171                 s = si;
 172           }
 173         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
 174           {
 175             ls = si;
 176             si = xcalloc (1, sizeof (struct type));
 177             memcpy (si, ls, sizeof (struct type));
 178             ls->kind = TYPE_LANG_STRUCT;
 179             ls->u.s.lang_struct = si;
 180             ls->u.s.fields = NULL;
 181             si->next = NULL;
 182             si->pointer_to = NULL;
 183             si->u.s.lang_struct = ls;
 184           }
 185         else
 186           s = si;
 187
 188         if (ls != NULL && s == NULL)
 189           {
 190             s = xcalloc (1, sizeof (struct type));
 191             s->next = ls->u.s.lang_struct;
 192             ls->u.s.lang_struct = s;
 193             s->u.s.lang_struct = ls;
 194           }
 195         break;
 196       }
 197
 198   if (s == NULL)
 199     {
 200       s = xcalloc (1, sizeof (struct type));
 201       s->next = structures;
 202       structures = s;
 203     }
 204
 205   if (s->u.s.line.file != NULL
 206       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
 207     {
 208       error_at_line (pos, "duplicate structure definition");
 209       error_at_line (&s->u.s.line, "previous definition here");
 210     }
 211
 212   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 213   s->u.s.tag = name;
 214   s->u.s.line = *pos;
 215   s->u.s.fields = fields;
 216   s->u.s.opt = o;
 217   s->u.s.bitmap = bitmap;
 218   if (s->u.s.lang_struct)
 219     s->u.s.lang_struct->u.s.bitmap |= bitmap;
 220 }
 221
 222 /* Return the previously-defined structure with tag NAME (or a union
 223    iff ISUNION is nonzero), or a new empty structure or union if none
 224    was defined previously.  */
 225
 226 type_p
 227 find_structure (const char *name, int isunion)
 228 {
 229   type_p s;
 230
 231   for (s = structures; s != NULL; s = s->next)
 232     if (strcmp (name, s->u.s.tag) == 0
 233         && UNION_P (s) == isunion)
 234       return s;
 235
 236   s = xcalloc (1, sizeof (struct type));
 237   s->next = structures;
 238   structures = s;
 239   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 240   s->u.s.tag = name;
 241   structures = s;
 242   return s;
 243 }
 244
 245 /* Return the previously-defined parameterized structure for structure
 246    T and parameters PARAM, or a new parameterized empty structure or
 247    union if none was defined previously.  */
 248
 249 static type_p
 250 find_param_structure (type_p t, type_p param[NUM_PARAM])
 251 {
 252   type_p res;
 253
 254   for (res = param_structs; res; res = res->next)
 255     if (res->u.param_struct.stru == t
 256         && memcmp (res->u.param_struct.param, param,
 257                    sizeof (type_p) * NUM_PARAM) == 0)
 258       break;
 259   if (res == NULL)
 260     {
 261       res = xcalloc (1, sizeof (*res));
 262       res->kind = TYPE_PARAM_STRUCT;
 263       res->next = param_structs;
 264       param_structs = res;
 265       res->u.param_struct.stru = t;
 266       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
 267     }
 268   return res;
 269 }
 270
 271 /* Return a scalar type with name NAME.  */
 272
 273 type_p
 274 create_scalar_type (const char *name, size_t name_len)
 275 {
 276   type_p r = xcalloc (1, sizeof (struct type));
 277   r->kind = TYPE_SCALAR;
 278   r->u.sc = xmemdup (name, name_len, name_len + 1);
 279   return r;
 280 }
 281
 282 /* Return a pointer to T.  */
 283
 284 type_p
 285 create_pointer (type_p t)
 286 {
 287   if (! t->pointer_to)
 288     {
 289       type_p r = xcalloc (1, sizeof (struct type));
 290       r->kind = TYPE_POINTER;
 291       r->u.p = t;
 292       t->pointer_to = r;
 293     }
 294   return t->pointer_to;
 295 }
 296
 297 /* Return an array of length LEN.  */
 298
 299 type_p
 300 create_array (type_p t, const char *len)
 301 {
 302   type_p v;
 303
 304   v = xcalloc (1, sizeof (*v));
 305   v->kind = TYPE_ARRAY;
 306   v->u.a.p = t;
 307   v->u.a.len = len;
 308   return v;
 309 }
 310
 311 /* Return an options structure with name NAME and info INFO.  */
 312 options_p
 313 create_option (const char *name, void *info)
 314 {
 315   options_p o = xmalloc (sizeof (*o));
 316   o->name = name;
 317   o->info = info;
 318   return o;
 319 }
 320
 321 /* Add a variable named S of type T with options O defined at POS,
 322    to `variables'.  */
 323
 324 void
 325 note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
 326 {
 327   pair_p n;
 328   n = xmalloc (sizeof (*n));
 329   n->name = s;
 330   n->type = t;
 331   n->line = *pos;
 332   n->opt = o;
 333   n->next = variables;
 334   variables = n;
 335 }
 336
 337 /* We really don't care how long a CONST_DOUBLE is.  */
 338 #define CONST_DOUBLE_FORMAT "ww"
 339 const char * const rtx_format[NUM_RTX_CODE] = {
 340 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
 341 #include "rtl.def"
 342 #undef DEF_RTL_EXPR
 343 };
 344
 345 static int rtx_next_new[NUM_RTX_CODE];
 346
 347 /* Generate the contents of the rtx_next array.  This really doesn't belong
 348    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
 349
 350 static void
 351 gen_rtx_next (void)
 352 {
 353   int i;
 354   for (i = 0; i < NUM_RTX_CODE; i++)
 355     {
 356       int k;
 357
 358       rtx_next_new[i] = -1;
 359       if (strncmp (rtx_format[i], "iuu", 3) == 0)
 360         rtx_next_new[i] = 2;
 361       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
 362         rtx_next_new[i] = 1;
 363       else
 364         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
 365           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
 366             rtx_next_new[i] = k;
 367     }
 368 }
 369
 370 /* Write out the contents of the rtx_next array.  */
 371 static void
 372 write_rtx_next (void)
 373 {
 374   outf_p f = get_output_file_with_visibility (NULL);
 375   int i;
 376
 377   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
 378   oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
 379   for (i = 0; i < NUM_RTX_CODE; i++)
 380     if (rtx_next_new[i] == -1)
 381       oprintf (f, "  0,\n");
 382     else
 383       oprintf (f,
 384                "  RTX_HDR_SIZE + %d * sizeof (rtunion),\n",
 385                rtx_next_new[i]);
 386   oprintf (f, "};\n");
 387 }
 388
 389 /* Handle `special("rtx_def")'.  This is a special case for field
 390    `fld' of struct rtx_def, which is an array of unions whose values
 391    are based in a complex way on the type of RTL.  */
 392
 393 static type_p
 394 adjust_field_rtx_def (type_p t, options_p opt ATTRIBUTE_UNUSED)
 395 {
 396   pair_p flds = NULL;
 397   options_p nodot;
 398   int i;
 399   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
 400   type_p bitmap_tp, basic_block_tp, reg_attrs_tp;
 401
 402   static const char * const rtx_name[NUM_RTX_CODE] = {
 403 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
 404 #include "rtl.def"
 405 #undef DEF_RTL_EXPR
 406   };
 407
 408   if (t->kind != TYPE_UNION)
 409     {
 410       error_at_line (&lexer_line,
 411                      "special `rtx_def' must be applied to a union");
 412       return &string_type;
 413     }
 414
 415   nodot = xmalloc (sizeof (*nodot));
 416   nodot->next = NULL;
 417   nodot->name = "dot";
 418   nodot->info = "";
 419
 420   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
 421   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
 422   tree_tp = create_pointer (find_structure ("tree_node", 1));
 423   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
 424   reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
 425   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
 426   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
 427   scalar_tp = create_scalar_type ("rtunion scalar", 14);
 428
 429   {
 430     pair_p note_flds = NULL;
 431     int c;
 432
 433     for (c = NOTE_INSN_BIAS; c <= NOTE_INSN_MAX; c++)
 434       {
 435         pair_p old_note_flds = note_flds;
 436
 437         note_flds = xmalloc (sizeof (*note_flds));
 438         note_flds->line.file = __FILE__;
 439         note_flds->line.line = __LINE__;
 440         note_flds->opt = xmalloc (sizeof (*note_flds->opt));
 441         note_flds->opt->next = nodot;
 442         note_flds->opt->name = "tag";
 443         note_flds->opt->info = xasprintf ("%d", c);
 444         note_flds->next = old_note_flds;
 445
 446         switch (c)
 447           {
 448             /* NOTE_INSN_MAX is used as the default field for line
 449                number notes.  */
 450           case NOTE_INSN_MAX:
 451             note_flds->opt->name = "default";
 452             note_flds->name = "rtstr";
 453             note_flds->type = &string_type;
 454             break;
 455
 456           case NOTE_INSN_BLOCK_BEG:
 457           case NOTE_INSN_BLOCK_END:
 458             note_flds->name = "rttree";
 459             note_flds->type = tree_tp;
 460             break;
 461
 462           case NOTE_INSN_EXPECTED_VALUE:
 463           case NOTE_INSN_VAR_LOCATION:
 464             note_flds->name = "rtx";
 465             note_flds->type = rtx_tp;
 466             break;
 467
 468           default:
 469             note_flds->name = "rtint";
 470             note_flds->type = scalar_tp;
 471             break;
 472           }
 473       }
 474     new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
 475   }
 476
 477   note_union_tp = find_structure ("rtx_def_note_subunion", 1);
 478
 479   for (i = 0; i < NUM_RTX_CODE; i++)
 480     {
 481       pair_p old_flds = flds;
 482       pair_p subfields = NULL;
 483       size_t aindex, nmindex;
 484       const char *sname;
 485       char *ftag;
 486
 487       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
 488         {
 489           pair_p old_subf = subfields;
 490           type_p t;
 491           const char *subname;
 492
 493           switch (rtx_format[i][aindex])
 494             {
 495             case '*':
 496             case 'i':
 497             case 'n':
 498             case 'w':
 499               t = scalar_tp;
 500               subname = "rtint";
 501               break;
 502
 503             case '0':
 504               if (i == MEM && aindex == 1)
 505                 t = mem_attrs_tp, subname = "rtmem";
 506               else if (i == JUMP_INSN && aindex == 9)
 507                 t = rtx_tp, subname = "rtx";
 508               else if (i == CODE_LABEL && aindex == 4)
 509                 t = scalar_tp, subname = "rtint";
 510               else if (i == CODE_LABEL && aindex == 5)
 511                 t = rtx_tp, subname = "rtx";
 512               else if (i == LABEL_REF
 513                        && (aindex == 1 || aindex == 2))
 514                 t = rtx_tp, subname = "rtx";
 515               else if (i == NOTE && aindex == 4)
 516                 t = note_union_tp, subname = "";
 517               else if (i == NOTE && aindex >= 7)
 518                 t = scalar_tp, subname = "rtint";
 519               else if (i == ADDR_DIFF_VEC && aindex == 4)
 520                 t = scalar_tp, subname = "rtint";
 521               else if (i == VALUE && aindex == 0)
 522                 t = scalar_tp, subname = "rtint";
 523               else if (i == REG && aindex == 1)
 524                 t = scalar_tp, subname = "rtint";
 525               else if (i == REG && aindex == 2)
 526                 t = reg_attrs_tp, subname = "rtreg";
 527               else if (i == SCRATCH && aindex == 0)
 528                 t = scalar_tp, subname = "rtint";
 529               else if (i == SYMBOL_REF && aindex == 1)
 530                 t = scalar_tp, subname = "rtint";
 531               else if (i == SYMBOL_REF && aindex == 2)
 532                 t = tree_tp, subname = "rttree";
 533               else if (i == BARRIER && aindex >= 3)
 534                 t = scalar_tp, subname = "rtint";
 535               else
 536                 {
 537                   error_at_line (&lexer_line,
 538                         "rtx type `%s' has `0' in position %lu, can't handle",
 539                                  rtx_name[i], (unsigned long) aindex);
 540                   t = &string_type;
 541                   subname = "rtint";
 542                 }
 543               break;
 544
 545             case 's':
 546             case 'S':
 547             case 'T':
 548               t = &string_type;
 549               subname = "rtstr";
 550               break;
 551
 552             case 'e':
 553             case 'u':
 554               t = rtx_tp;
 555               subname = "rtx";
 556               break;
 557
 558             case 'E':
 559             case 'V':
 560               t = rtvec_tp;
 561               subname = "rtvec";
 562               break;
 563
 564             case 't':
 565               t = tree_tp;
 566               subname = "rttree";
 567               break;
 568
 569             case 'b':
 570               t = bitmap_tp;
 571               subname = "rtbit";
 572               break;
 573
 574             case 'B':
 575               t = basic_block_tp;
 576               subname = "bb";
 577               break;
 578
 579             default:
 580               error_at_line (&lexer_line,
 581                      "rtx type `%s' has `%c' in position %lu, can't handle",
 582                              rtx_name[i], rtx_format[i][aindex],
 583                              (unsigned long)aindex);
 584               t = &string_type;
 585               subname = "rtint";
 586               break;
 587             }
 588
 589           subfields = xmalloc (sizeof (*subfields));
 590           subfields->next = old_subf;
 591           subfields->type = t;
 592           subfields->name = xasprintf (".fld[%lu].%s", (unsigned long)aindex,
 593                                        subname);
 594           subfields->line.file = __FILE__;
 595           subfields->line.line = __LINE__;
 596           if (t == note_union_tp)
 597             {
 598               subfields->opt = xmalloc (sizeof (*subfields->opt));
 599               subfields->opt->next = nodot;
 600               subfields->opt->name = "desc";
 601               subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
 602             }
 603           else if (t == basic_block_tp)
 604             {
 605               /* We don't presently GC basic block structures...  */
 606               subfields->opt = xmalloc (sizeof (*subfields->opt));
 607               subfields->opt->next = nodot;
 608               subfields->opt->name = "skip";
 609               subfields->opt->info = NULL;
 610             }
 611           else
 612             subfields->opt = nodot;
 613         }
 614
 615       flds = xmalloc (sizeof (*flds));
 616       flds->next = old_flds;
 617       flds->name = "";
 618       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
 619       new_structure (sname, 0, &lexer_line, subfields, NULL);
 620       flds->type = find_structure (sname, 0);
 621       flds->line.file = __FILE__;
 622       flds->line.line = __LINE__;
 623       flds->opt = xmalloc (sizeof (*flds->opt));
 624       flds->opt->next = nodot;
 625       flds->opt->name = "tag";
 626       ftag = xstrdup (rtx_name[i]);
 627       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
 628         ftag[nmindex] = TOUPPER (ftag[nmindex]);
 629       flds->opt->info = ftag;
 630     }
 631
 632   new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
 633   return find_structure ("rtx_def_subunion", 1);
 634 }
 635
 636 /* Handle `special("tree_exp")'.  This is a special case for
 637    field `operands' of struct tree_exp, which although it claims to contain
 638    pointers to trees, actually sometimes contains pointers to RTL too.
 639    Passed T, the old type of the field, and OPT its options.  Returns
 640    a new type for the field.  */
 641
 642 static type_p
 643 adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
 644 {
 645   pair_p flds;
 646   options_p nodot;
 647
 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 = xmalloc (sizeof (*nodot));
 656   nodot->next = NULL;
 657   nodot->name = "dot";
 658   nodot->info = "";
 659
 660   flds = xmalloc (sizeof (*flds));
 661   flds->next = NULL;
 662   flds->name = "";
 663   flds->type = t;
 664   flds->line.file = __FILE__;
 665   flds->line.line = __LINE__;
 666   flds->opt = xmalloc (sizeof (*flds->opt));
 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 = xmalloc (sizeof (*flds->opt));
 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 = (const char *)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 = xcalloc (sizeof (*f), 1);
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 = xrealloc (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 = (const char *)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 = (const char *)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 = (const char *)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 = (const char *)oo->info;
1763               else if (strcmp (oo->name, "tag") == 0)
1764                 tagid = (const char *)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 = (const char *)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 = (const char *) opt->info;
1960     else if (strcmp (opt->name, "chain_prev") == 0)
1961       chain_prev = (const char *) 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, " (void *this_obj ATTRIBUTE_UNUSED,\n\tvoid *x_p,\n\tgt_pointer_operator op ATTRIBUTE_UNUSED,\n\tvoid *cookie ATTRIBUTE_UNUSED)\n");
2237   oprintf (d.of, "{\n");
2238   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2239            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2240            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2241   d.indent = 2;
2242   walk_type (s, &d);
2243   oprintf (d.of, "}\n");
2244 }
2245
2246 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2247
2248 static void
2249 write_local (type_p structures, type_p param_structs)
2250 {
2251   type_p s;
2252
2253   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2254   for (s = structures; s; s = s->next)
2255     if (s->gc_used == GC_POINTED_TO
2256         || s->gc_used == GC_MAYBE_POINTED_TO)
2257       {
2258         options_p opt;
2259
2260         if (s->u.s.line.file == NULL)
2261           continue;
2262
2263         for (opt = s->u.s.opt; opt; opt = opt->next)
2264           if (strcmp (opt->name, "ptr_alias") == 0)
2265             {
2266               type_p t = (type_p) opt->info;
2267               if (t->kind == TYPE_STRUCT
2268                   || t->kind == TYPE_UNION
2269                   || t->kind == TYPE_LANG_STRUCT)
2270                 {
2271                   oprintf (header_file, "#define gt_pch_p_");
2272                   output_mangled_typename (header_file, s);
2273                   oprintf (header_file, " gt_pch_p_");
2274                   output_mangled_typename (header_file, t);
2275                   oprintf (header_file, "\n");
2276                 }
2277               else
2278                 error_at_line (&s->u.s.line,
2279                                "structure alias is not a structure");
2280               break;
2281             }
2282         if (opt)
2283           continue;
2284
2285         /* Declare the marker procedure only once.  */
2286         oprintf (header_file, "extern void gt_pch_p_");
2287         output_mangled_typename (header_file, s);
2288         oprintf (header_file,
2289          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2290
2291         if (s->kind == TYPE_LANG_STRUCT)
2292           {
2293             type_p ss;
2294             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2295               write_local_func_for_structure (s, ss, NULL);
2296           }
2297         else
2298           write_local_func_for_structure (s, s, NULL);
2299       }
2300
2301   for (s = param_structs; s; s = s->next)
2302     if (s->gc_used == GC_POINTED_TO)
2303       {
2304         type_p * param = s->u.param_struct.param;
2305         type_p stru = s->u.param_struct.stru;
2306
2307         /* Declare the marker procedure.  */
2308         oprintf (header_file, "extern void gt_pch_p_");
2309         output_mangled_typename (header_file, s);
2310         oprintf (header_file,
2311          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2312
2313         if (stru->u.s.line.file == NULL)
2314           {
2315             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2316                      s->u.s.tag);
2317             continue;
2318           }
2319
2320         if (stru->kind == TYPE_LANG_STRUCT)
2321           {
2322             type_p ss;
2323             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2324               write_local_func_for_structure (s, ss, param);
2325           }
2326         else
2327           write_local_func_for_structure (s, stru, param);
2328       }
2329 }
2330
2331 /* Write out the 'enum' definition for gt_types_enum.  */
2332
2333 static void
2334 write_enum_defn (type_p structures, type_p param_structs)
2335 {
2336   type_p s;
2337
2338   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2339   oprintf (header_file, "enum gt_types_enum {\n");
2340   for (s = structures; s; s = s->next)
2341     if (s->gc_used == GC_POINTED_TO
2342         || s->gc_used == GC_MAYBE_POINTED_TO)
2343       {
2344         if (s->gc_used == GC_MAYBE_POINTED_TO
2345             && s->u.s.line.file == NULL)
2346           continue;
2347
2348         oprintf (header_file, " gt_ggc_e_");
2349         output_mangled_typename (header_file, s);
2350         oprintf (header_file, ", \n");
2351       }
2352   for (s = param_structs; s; s = s->next)
2353     if (s->gc_used == GC_POINTED_TO)
2354       {
2355         oprintf (header_file, " gt_e_");
2356         output_mangled_typename (header_file, s);
2357         oprintf (header_file, ", \n");
2358       }
2359   oprintf (header_file, " gt_types_enum_last\n");
2360   oprintf (header_file, "};\n");
2361 }
2362
2363 /* Might T contain any non-pointer elements?  */
2364
2365 static int
2366 contains_scalar_p (type_p t)
2367 {
2368   switch (t->kind)
2369     {
2370     case TYPE_STRING:
2371     case TYPE_POINTER:
2372       return 0;
2373     case TYPE_ARRAY:
2374       return contains_scalar_p (t->u.a.p);
2375     default:
2376       /* Could also check for structures that have no non-pointer
2377          fields, but there aren't enough of those to worry about.  */
2378       return 1;
2379     }
2380 }
2381
2382 /* Mangle FN and print it to F.  */
2383
2384 static void
2385 put_mangled_filename (outf_p f, const char *fn)
2386 {
2387   const char *name = get_output_file_name (fn);
2388   for (; *name != 0; name++)
2389     if (ISALNUM (*name))
2390       oprintf (f, "%c", *name);
2391     else
2392       oprintf (f, "%c", '_');
2393 }
2394
2395 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2396    LASTNAME, and NAME are all strings to insert in various places in
2397    the resulting code.  */
2398
2399 static void
2400 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2401                    const char *tname, const char *name)
2402 {
2403   struct flist *fli2;
2404
2405   for (fli2 = flp; fli2; fli2 = fli2->next)
2406     if (fli2->started_p)
2407       {
2408         oprintf (fli2->f, "  %s\n", lastname);
2409         oprintf (fli2->f, "};\n\n");
2410       }
2411
2412   for (fli2 = flp; fli2; fli2 = fli2->next)
2413     if (fli2->started_p)
2414       {
2415         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2416         int fnum;
2417
2418         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2419           if (bitmap & 1)
2420             {
2421               oprintf (base_files[fnum],
2422                        "extern const struct %s gt_%s_",
2423                        tname, pfx);
2424               put_mangled_filename (base_files[fnum], fli2->name);
2425               oprintf (base_files[fnum], "[];\n");
2426             }
2427       }
2428
2429   {
2430     size_t fnum;
2431     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2432       oprintf (base_files [fnum],
2433                "const struct %s * const %s[] = {\n",
2434                tname, name);
2435   }
2436
2437
2438   for (fli2 = flp; fli2; fli2 = fli2->next)
2439     if (fli2->started_p)
2440       {
2441         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2442         int fnum;
2443
2444         fli2->started_p = 0;
2445
2446         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2447           if (bitmap & 1)
2448             {
2449               oprintf (base_files[fnum], "  gt_%s_", pfx);
2450               put_mangled_filename (base_files[fnum], fli2->name);
2451               oprintf (base_files[fnum], ",\n");
2452             }
2453       }
2454
2455   {
2456     size_t fnum;
2457     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2458       {
2459         oprintf (base_files[fnum], "  NULL\n");
2460         oprintf (base_files[fnum], "};\n");
2461       }
2462   }
2463 }
2464
2465 /* Write out to F the table entry and any marker routines needed to
2466    mark NAME as TYPE.  The original variable is V, at LINE.
2467    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2468    is nonzero iff we are building the root table for hash table caches.  */
2469
2470 static void
2471 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2472             struct fileloc *line, const char *if_marked)
2473 {
2474   switch (type->kind)
2475     {
2476     case TYPE_STRUCT:
2477       {
2478         pair_p fld;
2479         for (fld = type->u.s.fields; fld; fld = fld->next)
2480           {
2481             int skip_p = 0;
2482             const char *desc = NULL;
2483             options_p o;
2484
2485             for (o = fld->opt; o; o = o->next)
2486               if (strcmp (o->name, "skip") == 0)
2487                 skip_p = 1;
2488               else if (strcmp (o->name, "desc") == 0)
2489                 desc = (const char *)o->info;
2490               else
2491                 error_at_line (line,
2492                        "field `%s' of global `%s' has unknown option `%s'",
2493                                fld->name, name, o->name);
2494
2495             if (skip_p)
2496               continue;
2497             else if (desc && fld->type->kind == TYPE_UNION)
2498               {
2499                 pair_p validf = NULL;
2500                 pair_p ufld;
2501
2502                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2503                   {
2504                     const char *tag = NULL;
2505                     options_p oo;
2506
2507                     for (oo = ufld->opt; oo; oo = oo->next)
2508                       if (strcmp (oo->name, "tag") == 0)
2509                         tag = (const char *)oo->info;
2510                     if (tag == NULL || strcmp (tag, desc) != 0)
2511                       continue;
2512                     if (validf != NULL)
2513                       error_at_line (line,
2514                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2515                                      name, fld->name, validf->name,
2516                                      name, fld->name, ufld->name,
2517                                      tag);
2518                     validf = ufld;
2519                   }
2520                 if (validf != NULL)
2521                   {
2522                     char *newname;
2523                     newname = xasprintf ("%s.%s.%s",
2524                                          name, fld->name, validf->name);
2525                     write_root (f, v, validf->type, newname, 0, line,
2526                                 if_marked);
2527                     free (newname);
2528                   }
2529               }
2530             else if (desc)
2531               error_at_line (line,
2532                      "global `%s.%s' has `desc' option but is not union",
2533                              name, fld->name);
2534             else
2535               {
2536                 char *newname;
2537                 newname = xasprintf ("%s.%s", name, fld->name);
2538                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2539                 free (newname);
2540               }
2541           }
2542       }
2543       break;
2544
2545     case TYPE_ARRAY:
2546       {
2547         char *newname;
2548         newname = xasprintf ("%s[0]", name);
2549         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2550         free (newname);
2551       }
2552       break;
2553
2554     case TYPE_POINTER:
2555       {
2556         type_p ap, tp;
2557
2558         oprintf (f, "  {\n");
2559         oprintf (f, "    &%s,\n", name);
2560         oprintf (f, "    1");
2561
2562         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2563           if (ap->u.a.len[0])
2564             oprintf (f, " * (%s)", ap->u.a.len);
2565           else if (ap == v->type)
2566             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2567         oprintf (f, ",\n");
2568         oprintf (f, "    sizeof (%s", v->name);
2569         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2570           oprintf (f, "[0]");
2571         oprintf (f, "),\n");
2572
2573         tp = type->u.p;
2574
2575         if (! has_length && UNION_OR_STRUCT_P (tp))
2576           {
2577             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2578             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2579           }
2580         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2581           {
2582             oprintf (f, "    &gt_ggc_m_");
2583             output_mangled_typename (f, tp);
2584             oprintf (f, ",\n    &gt_pch_n_");
2585             output_mangled_typename (f, tp);
2586           }
2587         else if (has_length
2588                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2589           {
2590             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2591             oprintf (f, "    &gt_pch_na_%s", name);
2592           }
2593         else
2594           {
2595             error_at_line (line,
2596                            "global `%s' is pointer to unimplemented type",
2597                            name);
2598           }
2599         if (if_marked)
2600           oprintf (f, ",\n    &%s", if_marked);
2601         oprintf (f, "\n  },\n");
2602       }
2603       break;
2604
2605     case TYPE_STRING:
2606       {
2607         oprintf (f, "  {\n");
2608         oprintf (f, "    &%s,\n", name);
2609         oprintf (f, "    1, \n");
2610         oprintf (f, "    sizeof (%s),\n", v->name);
2611         oprintf (f, "    &gt_ggc_m_S,\n");
2612         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2613         oprintf (f, "  },\n");
2614       }
2615       break;
2616
2617     case TYPE_SCALAR:
2618       break;
2619
2620     default:
2621       error_at_line (line,
2622                      "global `%s' is unimplemented type",
2623                      name);
2624     }
2625 }
2626
2627 /* This generates a routine to walk an array.  */
2628
2629 static void
2630 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2631 {
2632   struct walk_type_data d;
2633   char *prevval3;
2634
2635   memset (&d, 0, sizeof (d));
2636   d.of = f;
2637   d.cookie = wtd;
2638   d.indent = 2;
2639   d.line = &v->line;
2640   d.opt = v->opt;
2641   d.bitmap = get_base_file_bitmap (v->line.file);
2642   d.param = NULL;
2643
2644   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2645
2646   if (wtd->param_prefix)
2647     {
2648       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2649       oprintf (f,
2650        "    (void *, void *, gt_pointer_operator, void *);\n");
2651       oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
2652                wtd->param_prefix, v->name);
2653       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
2654       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
2655       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
2656       oprintf (d.of, "{\n");
2657       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2658       d.process_field = write_types_local_process_field;
2659       walk_type (v->type, &d);
2660       oprintf (f, "}\n\n");
2661     }
2662
2663   d.opt = v->opt;
2664   oprintf (f, "static void gt_%sa_%s (void *);\n",
2665            wtd->prefix, v->name);
2666   oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
2667            wtd->prefix, v->name);
2668   oprintf (f, "{\n");
2669   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2670   d.process_field = write_types_process_field;
2671   walk_type (v->type, &d);
2672   free (prevval3);
2673   oprintf (f, "}\n\n");
2674 }
2675
2676 /* Output a table describing the locations and types of VARIABLES.  */
2677
2678 static void
2679 write_roots (pair_p variables)
2680 {
2681   pair_p v;
2682   struct flist *flp = NULL;
2683
2684   for (v = variables; v; v = v->next)
2685     {
2686       outf_p f = get_output_file_with_visibility (v->line.file);
2687       struct flist *fli;
2688       const char *length = NULL;
2689       int deletable_p = 0;
2690       options_p o;
2691
2692       for (o = v->opt; o; o = o->next)
2693         if (strcmp (o->name, "length") == 0)
2694           length = (const char *)o->info;
2695         else if (strcmp (o->name, "deletable") == 0)
2696           deletable_p = 1;
2697         else if (strcmp (o->name, "param_is") == 0)
2698           ;
2699         else if (strncmp (o->name, "param", 5) == 0
2700                  && ISDIGIT (o->name[5])
2701                  && strcmp (o->name + 6, "_is") == 0)
2702           ;
2703         else if (strcmp (o->name, "if_marked") == 0)
2704           ;
2705         else
2706           error_at_line (&v->line,
2707                          "global `%s' has unknown option `%s'",
2708                          v->name, o->name);
2709
2710       for (fli = flp; fli; fli = fli->next)
2711         if (fli->f == f)
2712           break;
2713       if (fli == NULL)
2714         {
2715           fli = xmalloc (sizeof (*fli));
2716           fli->f = f;
2717           fli->next = flp;
2718           fli->started_p = 0;
2719           fli->name = v->line.file;
2720           flp = fli;
2721
2722           oprintf (f, "\n/* GC roots.  */\n\n");
2723         }
2724
2725       if (! deletable_p
2726           && length
2727           && v->type->kind == TYPE_POINTER
2728           && (v->type->u.p->kind == TYPE_POINTER
2729               || v->type->u.p->kind == TYPE_STRUCT))
2730         {
2731           write_array (f, v, &ggc_wtd);
2732           write_array (f, v, &pch_wtd);
2733         }
2734     }
2735
2736   for (v = variables; v; v = v->next)
2737     {
2738       outf_p f = get_output_file_with_visibility (v->line.file);
2739       struct flist *fli;
2740       int skip_p = 0;
2741       int length_p = 0;
2742       options_p o;
2743
2744       for (o = v->opt; o; o = o->next)
2745         if (strcmp (o->name, "length") == 0)
2746           length_p = 1;
2747         else if (strcmp (o->name, "deletable") == 0
2748                  || strcmp (o->name, "if_marked") == 0)
2749           skip_p = 1;
2750
2751       if (skip_p)
2752         continue;
2753
2754       for (fli = flp; fli; fli = fli->next)
2755         if (fli->f == f)
2756           break;
2757       if (! fli->started_p)
2758         {
2759           fli->started_p = 1;
2760
2761           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2762           put_mangled_filename (f, v->line.file);
2763           oprintf (f, "[] = {\n");
2764         }
2765
2766       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2767     }
2768
2769   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2770                      "gt_ggc_rtab");
2771
2772   for (v = variables; v; v = v->next)
2773     {
2774       outf_p f = get_output_file_with_visibility (v->line.file);
2775       struct flist *fli;
2776       int skip_p = 1;
2777       options_p o;
2778
2779       for (o = v->opt; o; o = o->next)
2780         if (strcmp (o->name, "deletable") == 0)
2781           skip_p = 0;
2782         else if (strcmp (o->name, "if_marked") == 0)
2783           skip_p = 1;
2784
2785       if (skip_p)
2786         continue;
2787
2788       for (fli = flp; fli; fli = fli->next)
2789         if (fli->f == f)
2790           break;
2791       if (! fli->started_p)
2792         {
2793           fli->started_p = 1;
2794
2795           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2796           put_mangled_filename (f, v->line.file);
2797           oprintf (f, "[] = {\n");
2798         }
2799
2800       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2801                v->name, v->name);
2802     }
2803
2804   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2805                      "gt_ggc_deletable_rtab");
2806
2807   for (v = variables; v; v = v->next)
2808     {
2809       outf_p f = get_output_file_with_visibility (v->line.file);
2810       struct flist *fli;
2811       const char *if_marked = NULL;
2812       int length_p = 0;
2813       options_p o;
2814
2815       for (o = v->opt; o; o = o->next)
2816         if (strcmp (o->name, "length") == 0)
2817           length_p = 1;
2818         else if (strcmp (o->name, "if_marked") == 0)
2819           if_marked = (const char *) o->info;
2820
2821       if (if_marked == NULL)
2822         continue;
2823
2824       if (v->type->kind != TYPE_POINTER
2825           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2826           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2827         {
2828           error_at_line (&v->line, "if_marked option used but not hash table");
2829           continue;
2830         }
2831
2832       for (fli = flp; fli; fli = fli->next)
2833         if (fli->f == f)
2834           break;
2835       if (! fli->started_p)
2836         {
2837           fli->started_p = 1;
2838
2839           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2840           put_mangled_filename (f, v->line.file);
2841           oprintf (f, "[] = {\n");
2842         }
2843
2844       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2845                      v->name, length_p, &v->line, if_marked);
2846     }
2847
2848   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2849                      "gt_ggc_cache_rtab");
2850
2851   for (v = variables; v; v = v->next)
2852     {
2853       outf_p f = get_output_file_with_visibility (v->line.file);
2854       struct flist *fli;
2855       int length_p = 0;
2856       int if_marked_p = 0;
2857       options_p o;
2858
2859       for (o = v->opt; o; o = o->next)
2860         if (strcmp (o->name, "length") == 0)
2861           length_p = 1;
2862         else if (strcmp (o->name, "if_marked") == 0)
2863           if_marked_p = 1;
2864
2865       if (! if_marked_p)
2866         continue;
2867
2868       for (fli = flp; fli; fli = fli->next)
2869         if (fli->f == f)
2870           break;
2871       if (! fli->started_p)
2872         {
2873           fli->started_p = 1;
2874
2875           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2876           put_mangled_filename (f, v->line.file);
2877           oprintf (f, "[] = {\n");
2878         }
2879
2880       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2881     }
2882
2883   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2884                      "gt_pch_cache_rtab");
2885
2886   for (v = variables; v; v = v->next)
2887     {
2888       outf_p f = get_output_file_with_visibility (v->line.file);
2889       struct flist *fli;
2890       int skip_p = 0;
2891       options_p o;
2892
2893       for (o = v->opt; o; o = o->next)
2894         if (strcmp (o->name, "deletable") == 0
2895             || strcmp (o->name, "if_marked") == 0)
2896           skip_p = 1;
2897
2898       if (skip_p)
2899         continue;
2900
2901       if (! contains_scalar_p (v->type))
2902         continue;
2903
2904       for (fli = flp; fli; fli = fli->next)
2905         if (fli->f == f)
2906           break;
2907       if (! fli->started_p)
2908         {
2909           fli->started_p = 1;
2910
2911           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2912           put_mangled_filename (f, v->line.file);
2913           oprintf (f, "[] = {\n");
2914         }
2915
2916       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2917                v->name, v->name);
2918     }
2919
2920   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2921                      "gt_pch_scalar_rtab");
2922 }
2923
2924 \f
2925 extern int main (int argc, char **argv);
2926 int
2927 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2928 {
2929   unsigned i;
2930   static struct fileloc pos = { __FILE__, __LINE__ };
2931   unsigned j;
2932
2933   gen_rtx_next ();
2934
2935   srcdir_len = strlen (srcdir);
2936
2937   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2938   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2939   do_scalar_typedef ("uint8", &pos);
2940   do_scalar_typedef ("jword", &pos);
2941   do_scalar_typedef ("JCF_u2", &pos);
2942 #ifdef USE_MAPPED_LOCATION
2943   do_scalar_typedef ("location_t", &pos);
2944   do_scalar_typedef ("source_locus", &pos);
2945 #endif
2946   do_scalar_typedef ("void", &pos);
2947
2948   do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
2949
2950   do_typedef ("HARD_REG_SET", create_array (
2951               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2952               "2"), &pos);
2953
2954   for (i = 0; i < NUM_GT_FILES; i++)
2955     {
2956       int dupflag = 0;
2957       /* Omit if already seen.  */
2958       for (j = 0; j < i; j++)
2959         {
2960           if (!strcmp (all_files[i], all_files[j]))
2961             {
2962               dupflag = 1;
2963               break;
2964             }
2965         }
2966       if (!dupflag)
2967         parse_file (all_files[i]);
2968 #ifndef USE_MAPPED_LOCATION
2969       /* temporary kludge - gengtype doesn't handle conditionals.
2970          Manually add source_locus *after* we've processed input.h. */
2971       if (i == 0)
2972         do_typedef ("source_locus", create_pointer (resolve_typedef ("location_t", &pos)), &pos);
2973 #endif
2974     }
2975
2976   if (hit_error != 0)
2977     exit (1);
2978
2979   set_gc_used (variables);
2980
2981   open_base_files ();
2982   write_enum_defn (structures, param_structs);
2983   write_types (structures, param_structs, &ggc_wtd);
2984   write_types (structures, param_structs, &pch_wtd);
2985   write_local (structures, param_structs);
2986   write_roots (variables);
2987   write_rtx_next ();
2988   close_output_files ();
2989
2990   return (hit_error != 0);
2991 }