gcc/gengtype.c

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