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
  25 /* Nonzero iff an error has occurred.  */
  26 static int hit_error = 0;
  27
  28 /* Report an error at POS, printing MSG.  */
  29
  30 void
  31 error_at_line VPARAMS ((struct fileloc *pos, const char *msg, ...))
  32 {
  33   VA_OPEN (ap, msg);
  34   VA_FIXEDARG (ap, struct fileloc *, pos);
  35   VA_FIXEDARG (ap, const char *, msg);
  36
  37   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
  38   vfprintf (stderr, msg, ap);
  39   fputc ('\n', stderr);
  40   hit_error = 1;
  41
  42   VA_CLOSE (ap);
  43 }
  44
  45 /* The one and only TYPE_STRING.  */
  46
  47 struct type string_type = {
  48   TYPE_STRING, NULL, NULL, GC_USED
  49   UNION_INIT_ZERO
  50 };
  51
  52 /* Lists of various things.  */
  53
  54 static pair_p typedefs;
  55 static type_p structures;
  56 static type_p param_structs;
  57 static pair_p variables;
  58
  59 /* Define S as a typedef to T at POS.  */
  60
  61 void
  62 do_typedef (s, t, pos)
  63      const char *s;
  64      type_p t;
  65      struct fileloc *pos;
  66 {
  67   pair_p p;
  68
  69   for (p = typedefs; p != NULL; p = p->next)
  70     if (strcmp (p->name, s) == 0)
  71       {
  72         if (p->type != t)
  73           {
  74             error_at_line (pos, "type `%s' previously defined", s);
  75             error_at_line (&p->line, "previously defined here");
  76           }
  77         return;
  78       }
  79
  80   p = xmalloc (sizeof (struct pair));
  81   p->next = typedefs;
  82   p->name = s;
  83   p->type = t;
  84   p->line = *pos;
  85   typedefs = p;
  86 }
  87
  88 /* Return the type previously defined for S.  Use POS to report errors.   */
  89
  90 type_p
  91 resolve_typedef (s, pos)
  92      const char *s;
  93      struct fileloc *pos;
  94 {
  95   pair_p p;
  96   for (p = typedefs; p != NULL; p = p->next)
  97     if (strcmp (p->name, s) == 0)
  98       return p->type;
  99   error_at_line (pos, "unidentified type `%s'", s);
 100   return create_scalar_type ("char", 4);
 101 }
 102
 103 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
 104    at POS with fields FIELDS and options O.  */
 105
 106 void
 107 new_structure (name, isunion, pos, fields, o)
 108      const char *name;
 109      int isunion;
 110      struct fileloc *pos;
 111      pair_p fields;
 112      options_p o;
 113 {
 114   type_p si;
 115   type_p s = NULL;
 116   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 117
 118   for (si = structures; si != NULL; si = si->next)
 119     if (strcmp (name, si->u.s.tag) == 0
 120         && UNION_P (si) == isunion)
 121       {
 122         type_p ls = NULL;
 123         if (si->kind == TYPE_LANG_STRUCT)
 124           {
 125             ls = si;
 126
 127             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
 128               if (si->u.s.bitmap == bitmap)
 129                 s = si;
 130           }
 131         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
 132           {
 133             ls = si;
 134             si = xcalloc (1, sizeof (struct type));
 135             memcpy (si, ls, sizeof (struct type));
 136             ls->kind = TYPE_LANG_STRUCT;
 137             ls->u.s.lang_struct = si;
 138             ls->u.s.fields = NULL;
 139             si->next = NULL;
 140             si->pointer_to = NULL;
 141             si->u.s.lang_struct = ls;
 142           }
 143         else
 144           s = si;
 145
 146         if (ls != NULL && s == NULL)
 147           {
 148             s = xcalloc (1, sizeof (struct type));
 149             s->next = ls->u.s.lang_struct;
 150             ls->u.s.lang_struct = s;
 151             s->u.s.lang_struct = ls;
 152           }
 153         break;
 154       }
 155
 156   if (s == NULL)
 157     {
 158       s = xcalloc (1, sizeof (struct type));
 159       s->next = structures;
 160       structures = s;
 161     }
 162
 163   if (s->u.s.line.file != NULL
 164       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
 165     {
 166       error_at_line (pos, "duplicate structure definition");
 167       error_at_line (&s->u.s.line, "previous definition here");
 168     }
 169
 170   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 171   s->u.s.tag = name;
 172   s->u.s.line = *pos;
 173   s->u.s.fields = fields;
 174   s->u.s.opt = o;
 175   s->u.s.bitmap = bitmap;
 176   if (s->u.s.lang_struct)
 177     s->u.s.lang_struct->u.s.bitmap |= bitmap;
 178 }
 179
 180 /* Return the previously-defined structure with tag NAME (or a union
 181    iff ISUNION is nonzero), or a new empty structure or union if none
 182    was defined previously.  */
 183
 184 type_p
 185 find_structure (name, isunion)
 186      const char *name;
 187      int isunion;
 188 {
 189   type_p s;
 190
 191   for (s = structures; s != NULL; s = s->next)
 192     if (strcmp (name, s->u.s.tag) == 0
 193         && UNION_P (s) == isunion)
 194       return s;
 195
 196   s = xcalloc (1, sizeof (struct type));
 197   s->next = structures;
 198   structures = s;
 199   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
 200   s->u.s.tag = name;
 201   structures = s;
 202   return s;
 203 }
 204
 205 /* Return a scalar type with name NAME.  */
 206
 207 type_p
 208 create_scalar_type (name, name_len)
 209      const char *name;
 210      size_t name_len;
 211 {
 212   type_p r = xcalloc (1, sizeof (struct type));
 213   r->kind = TYPE_SCALAR;
 214   r->u.sc = xmemdup (name, name_len, name_len + 1);
 215   return r;
 216 }
 217
 218 /* Return a pointer to T.  */
 219
 220 type_p
 221 create_pointer (t)
 222      type_p t;
 223 {
 224   if (! t->pointer_to)
 225     {
 226       type_p r = xcalloc (1, sizeof (struct type));
 227       r->kind = TYPE_POINTER;
 228       r->u.p = t;
 229       t->pointer_to = r;
 230     }
 231   return t->pointer_to;
 232 }
 233
 234 /* Return an array of length LEN.  */
 235
 236 type_p
 237 create_array (t, len)
 238      type_p t;
 239      const char *len;
 240 {
 241   type_p v;
 242
 243   v = xcalloc (1, sizeof (*v));
 244   v->kind = TYPE_ARRAY;
 245   v->u.a.p = t;
 246   v->u.a.len = len;
 247   return v;
 248 }
 249
 250 /* Perform any special processing on a type T, about to become the type
 251    of a field.  Return the appropriate type for the field.
 252    At present:
 253    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
 254    - Similarly for arrays of pointer-to-char;
 255    - Converts structures for which a parameter is provided to
 256    TYPE_PARAM_STRUCT.
 257 */
 258
 259 type_p
 260 adjust_field_type (t, opt)
 261      type_p t;
 262      options_p opt;
 263 {
 264   int length_p = 0;
 265   const int pointer_p = t->kind == TYPE_POINTER;
 266
 267   for (; opt; opt = opt->next)
 268     if (strcmp (opt->name, "length") == 0)
 269       length_p = 1;
 270     else if (strcmp (opt->name, "param_is") == 0)
 271       {
 272         type_p realt;
 273
 274         if (pointer_p)
 275           t = t->u.p;
 276
 277         for (realt = param_structs; realt; realt = realt->next)
 278           if (realt->u.param_struct.stru == t
 279               && realt->u.param_struct.param == (type_p) opt->info)
 280             return pointer_p ? create_pointer (realt) : realt;
 281         realt = xcalloc (1, sizeof (*realt));
 282         realt->kind = TYPE_PARAM_STRUCT;
 283         realt->next = param_structs;
 284         param_structs = realt;
 285         realt->u.param_struct.stru = t;
 286         realt->u.param_struct.param = (type_p) opt->info;
 287         return pointer_p ? create_pointer (realt) : realt;
 288       }
 289
 290   if (! length_p
 291       && pointer_p
 292       && t->u.p->kind == TYPE_SCALAR
 293       && (strcmp (t->u.p->u.sc, "char") == 0
 294           || strcmp (t->u.p->u.sc, "unsigned char") == 0))
 295     return &string_type;
 296   if (t->kind == TYPE_ARRAY && t->u.a.p->kind == TYPE_POINTER
 297       && t->u.a.p->u.p->kind == TYPE_SCALAR
 298       && (strcmp (t->u.a.p->u.p->u.sc, "char") == 0
 299           || strcmp (t->u.a.p->u.p->u.sc, "unsigned char") == 0))
 300     return create_array (&string_type, t->u.a.len);
 301
 302   return t;
 303 }
 304
 305 /* Add a variable named S of type T with options O defined at POS,
 306    to `variables'.  */
 307
 308 void
 309 note_variable (s, t, o, pos)
 310      const char *s;
 311      type_p t;
 312      options_p o;
 313      struct fileloc *pos;
 314 {
 315   pair_p n;
 316   n = xmalloc (sizeof (*n));
 317   n->name = s;
 318   n->type = t;
 319   n->line = *pos;
 320   n->opt = o;
 321   n->next = variables;
 322   variables = n;
 323 }
 324
 325 /* Create a union for YYSTYPE, as yacc would do it, given a fieldlist FIELDS
 326    and information about the correspondance between token types and fields
 327    in TYPEINFO.  POS is used for error messages.  */
 328
 329 void
 330 note_yacc_type (o, fields, typeinfo, pos)
 331      options_p o;
 332      pair_p fields;
 333      pair_p typeinfo;
 334      struct fileloc *pos;
 335 {
 336   pair_p p;
 337   pair_p *p_p;
 338
 339   for (p = typeinfo; p; p = p->next)
 340     {
 341       pair_p m;
 342
 343       if (p->name == NULL)
 344         continue;
 345
 346       if (p->type == (type_p) 1)
 347         {
 348           pair_p pp;
 349           int ok = 0;
 350
 351           for (pp = typeinfo; pp; pp = pp->next)
 352             if (pp->type != (type_p) 1
 353                 && strcmp (pp->opt->info, p->opt->info) == 0)
 354               {
 355                 ok = 1;
 356                 break;
 357               }
 358           if (! ok)
 359             continue;
 360         }
 361
 362       for (m = fields; m; m = m->next)
 363         if (strcmp (m->name, p->name) == 0)
 364           p->type = m->type;
 365       if (p->type == NULL)
 366         {
 367           error_at_line (&p->line,
 368                          "couldn't match fieldname `%s'", p->name);
 369           p->name = NULL;
 370         }
 371     }
 372
 373   p_p = &typeinfo;
 374   while (*p_p)
 375     {
 376       pair_p p = *p_p;
 377
 378       if (p->name == NULL
 379           || p->type == (type_p) 1)
 380         *p_p = p->next;
 381       else
 382         p_p = &p->next;
 383     }
 384
 385   new_structure ("yy_union", 1, pos, typeinfo, o);
 386   do_typedef ("YYSTYPE", find_structure ("yy_union", 1), pos);
 387 }
 388 \f
 389 static void process_gc_options PARAMS ((options_p, enum gc_used_enum, int *));
 390 static void set_gc_used_type PARAMS ((type_p, enum gc_used_enum));
 391 static void set_gc_used PARAMS ((pair_p));
 392
 393 /* Handle OPT for set_gc_used_type.  */
 394
 395 static void
 396 process_gc_options (opt, level, maybe_undef)
 397      options_p opt;
 398      enum gc_used_enum level;
 399      int *maybe_undef;
 400 {
 401   options_p o;
 402   for (o = opt; o; o = o->next)
 403     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
 404       set_gc_used_type ((type_p) o->info, GC_POINTED_TO);
 405     else if (strcmp (o->name, "maybe_undef") == 0)
 406       *maybe_undef = 1;
 407 }
 408
 409 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
 410
 411 static void
 412 set_gc_used_type (t, level)
 413      type_p t;
 414      enum gc_used_enum level;
 415 {
 416   if (t->gc_used >= level)
 417     return;
 418
 419   t->gc_used = level;
 420
 421   switch (t->kind)
 422     {
 423     case TYPE_STRUCT:
 424     case TYPE_UNION:
 425       {
 426         pair_p f;
 427         int dummy;
 428
 429         process_gc_options (t->u.s.opt, level, &dummy);
 430
 431         for (f = t->u.s.fields; f; f = f->next)
 432           {
 433             int maybe_undef = 0;
 434             process_gc_options (t->u.s.opt, level, &maybe_undef);
 435
 436             if (maybe_undef && f->type->kind == TYPE_POINTER)
 437               set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO);
 438             else
 439               set_gc_used_type (f->type, GC_USED);
 440           }
 441         break;
 442       }
 443
 444     case TYPE_POINTER:
 445       set_gc_used_type (t->u.p, GC_POINTED_TO);
 446       break;
 447
 448     case TYPE_ARRAY:
 449       set_gc_used_type (t->u.a.p, GC_USED);
 450       break;
 451
 452     case TYPE_LANG_STRUCT:
 453       for (t = t->u.s.lang_struct; t; t = t->next)
 454         set_gc_used_type (t, level);
 455       break;
 456
 457     case TYPE_PARAM_STRUCT:
 458       set_gc_used_type (t->u.param_struct.param, GC_POINTED_TO);
 459       set_gc_used_type (t->u.param_struct.stru, GC_USED);
 460       break;
 461
 462     default:
 463       break;
 464     }
 465 }
 466
 467 /* Set the gc_used fileds of all the types pointed to by VARIABLES.  */
 468
 469 static void
 470 set_gc_used (variables)
 471      pair_p variables;
 472 {
 473   pair_p p;
 474   for (p = variables; p; p = p->next)
 475     set_gc_used_type (p->type, GC_USED);
 476 }
 477 \f
 478 /* File mapping routines.  For each input file, there is one output .c file
 479    (but some output files have many input files), and there is one .h file
 480    for the whole build.  */
 481
 482 typedef struct filemap *filemap_p;
 483
 484 struct filemap {
 485   filemap_p next;
 486   const char *input_name;
 487   const char *output_name;
 488   FILE *output;
 489 };
 490
 491 /* The list of output files.  */
 492
 493 static filemap_p files;
 494
 495 /* The output header file that is included into pretty much every
 496    source file.  */
 497
 498 FILE * header_file;
 499
 500 enum {
 501   BASE_FILE_C,
 502   BASE_FILE_OBJC,
 503   BASE_FILE_CPLUSPLUS,
 504   BASE_FILE_TREELANG,
 505   BASE_FILE_COBOL
 506 };
 507
 508 static const char *lang_names[] = {
 509   "c", "objc", "cp", "treelang", "cobol", "f", "ada", "java"
 510 };
 511 #define NUM_BASE_FILES (sizeof (lang_names) / sizeof (lang_names[0]))
 512 FILE *base_files[NUM_BASE_FILES];
 513
 514 static FILE * create_file PARAMS ((const char *));
 515 static const char * get_file_basename PARAMS ((const char *));
 516
 517 /* Create and return a FILE* for a new header file to be called NAME.  */
 518
 519 static FILE *
 520 create_file (name)
 521      const char *name;
 522 {
 523   static const char *const hdr[] = {
 524     "   Copyright (C) 2002 Free Software Foundation, Inc.\n",
 525     "\n",
 526     "This file is part of GCC.\n",
 527     "\n",
 528     "GCC is free software; you can redistribute it and/or modify it under\n",
 529     "the terms of the GNU General Public License as published by the Free\n",
 530     "Software Foundation; either version 2, or (at your option) any later\n",
 531     "version.\n",
 532     "\n",
 533     "GCC is distributed in the hope that it will be useful, but WITHOUT ANY\n",
 534     "WARRANTY; without even the implied warranty of MERCHANTABILITY or\n",
 535     "FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License\n",
 536     "for more details.\n",
 537     "\n",
 538     "You should have received a copy of the GNU General Public License\n",
 539     "along with GCC; see the file COPYING.  If not, write to the Free\n",
 540     "Software Foundation, 59 Temple Place - Suite 330, Boston, MA\n",
 541     "02111-1307, USA.  */\n",
 542     "\n",
 543     "/* This file is machine generated.  Do not edit.  */\n"
 544   };
 545   FILE *f;
 546   size_t i;
 547
 548   f = tmpfile();
 549   if (f == NULL)
 550     {
 551       perror ("couldn't create temporary file");
 552       exit (1);
 553     }
 554   fprintf (f, "/* Type information for %s.\n", name);
 555   for (i = 0; i < sizeof(hdr)/sizeof(hdr[0]); i++)
 556     fputs (hdr[i], f);
 557   return f;
 558 }
 559
 560 /* Open the global header file and the language-specific header files.  */
 561
 562 static void
 563 open_base_files (void)
 564 {
 565   size_t i;
 566
 567   header_file = create_file ("GCC");
 568
 569   for (i = 0; i < NUM_BASE_FILES; i++)
 570     {
 571       filemap_p newf;
 572       char *s;
 573
 574       base_files[i] = create_file (lang_names[i]);
 575       newf = xmalloc (sizeof (*newf));
 576       newf->next = files;
 577       files = newf;
 578       newf->input_name = NULL;
 579       newf->output = base_files[i];
 580       newf->output_name = s = xmalloc (16);
 581       sprintf (s, "gtype-%s.h", lang_names[i]);
 582     }
 583 }
 584
 585 #define startswith(len, c, s)  \
 586   ((size_t)(len) >= strlen (s) && memcmp (c, s, strlen (s)) == 0)
 587
 588 /* Determine the pathname to F relative to $(srcdir).  */
 589
 590 static const char *
 591 get_file_basename (f)
 592      const char *f;
 593 {
 594   size_t len;
 595   const char *basename;
 596
 597   /* Determine the output file name.  */
 598   len = strlen (f);
 599   basename = strrchr (f, '/');
 600   if (basename == NULL)
 601     basename = f;
 602   else
 603     basename++;
 604   if (startswith (basename - f, basename-2, "f/"))
 605     basename -= 2;
 606   else if (startswith (basename - f, basename-3, "cp/"))
 607     basename -= 3;
 608   else if (startswith (basename - f, basename-4, "ada/"))
 609     basename -= 4;
 610   else if (startswith (basename - f, basename-5, "java/"))
 611     basename -= 5;
 612   else if (startswith (basename - f, basename-5, "objc/"))
 613     basename -= 5;
 614   else if (startswith (basename - f, basename-9, "treelang/"))
 615     basename -= 9;
 616   else if (startswith (basename - f, basename-6, "cobol/"))
 617     basename -= 6;
 618
 619   return basename;
 620 }
 621
 622 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
 623    INPUT_FILE is used by <lang>.
 624
 625    This function should be written to assume that a file _is_ used
 626    if the situation is unclear.  If it wrongly assumes a file _is_ used,
 627    a linker error will result.  If it wrongly assumes a file _is not_ used,
 628    some GC roots may be missed, which is a much harder-to-debug problem.  */
 629
 630 unsigned
 631 get_base_file_bitmap (input_file)
 632      const char *input_file;
 633 {
 634   const char *basename = get_file_basename (input_file);
 635   const char *slashpos = strchr (basename, '/');
 636   size_t len = strlen (basename);
 637
 638   if (slashpos != NULL)
 639     {
 640       size_t i;
 641       for (i = 0; i < NUM_BASE_FILES; i++)
 642         if ((size_t)(slashpos - basename) == strlen (lang_names [i])
 643             && memcmp (basename, lang_names[i], strlen (lang_names[i])) == 0)
 644           return 1 << i;
 645     }
 646   else if (strcmp (basename, "c-lang.c") == 0)
 647     return 1 << BASE_FILE_C;
 648   else if (strcmp (basename, "c-parse.in") == 0
 649            || strcmp (basename, "c-tree.h") == 0
 650            || strcmp (basename, "c-decl.c") == 0
 651            || strcmp (basename, "c-objc-common.c") == 0)
 652     return 1 << BASE_FILE_C | 1 << BASE_FILE_OBJC;
 653   else if (startswith (len, basename, "c-common.c"))
 654     return 1 << BASE_FILE_C | 1 << BASE_FILE_OBJC| 1 << BASE_FILE_CPLUSPLUS
 655       |  1 << BASE_FILE_TREELANG | 1 << BASE_FILE_COBOL;
 656   else if (startswith (len, basename, "c-"))
 657     return 1 << BASE_FILE_C | 1 << BASE_FILE_OBJC | 1 << BASE_FILE_CPLUSPLUS;
 658   else
 659     return (1 << NUM_BASE_FILES) - 1;
 660   abort ();
 661 }
 662
 663 /* An output file, suitable for definitions, that can see declarations
 664    made in INPUT_FILE and is linked into every language that uses
 665    INPUT_FILE.  */
 666
 667 FILE *
 668 get_output_file_with_visibility (input_file)
 669      const char *input_file;
 670 {
 671   filemap_p fm, fmo;
 672   size_t len;
 673   const char *basename;
 674
 675   /* Do we already know the file?  */
 676   for (fm = files; fm; fm = fm->next)
 677     if (input_file == fm->input_name)
 678       return fm->output;
 679
 680   /* No, we'll be creating a new filemap.  */
 681   fm = xmalloc (sizeof (*fm));
 682   fm->next = files;
 683   files = fm;
 684   fm->input_name = input_file;
 685
 686   /* Determine the output file name.  */
 687   basename = get_file_basename (input_file);
 688
 689   len = strlen (basename);
 690   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
 691       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
 692       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
 693     {
 694       char *s;
 695
 696       fm->output_name = s = xmalloc (sizeof ("gt-") + len);
 697       sprintf (s, "gt-%s", basename);
 698       for (; *s != '.'; s++)
 699         if (! ISALNUM (*s) && *s != '-')
 700           *s = '-';
 701       memcpy (s, ".h", sizeof (".h"));
 702     }
 703   else if (strcmp (basename, "c-common.h") == 0)
 704     fm->output_name = "gt-c-common.h";
 705   else if (strcmp (basename, "c-tree.h") == 0)
 706     fm->output_name = "gt-c-decl.h";
 707   else
 708     {
 709       size_t i;
 710
 711       fm->output_name = "gtype-desc.c";
 712       for (i = 0; i < NUM_BASE_FILES; i++)
 713         if (memcmp (basename, lang_names[i], strlen (lang_names[i])) == 0
 714             && basename[strlen(lang_names[i])] == '/')
 715           {
 716             char *s;
 717
 718             s = xmalloc (16);
 719             sprintf (s, "gtype-%s.h", lang_names[i]);
 720             fm->output_name = s;
 721             break;
 722           }
 723     }
 724
 725   /* Look through to see if we've ever seen this output filename before.  */
 726   for (fmo = fm->next; fmo; fmo = fmo->next)
 727     if (strcmp (fmo->output_name, fm->output_name) == 0)
 728       {
 729         fm->output = fmo->output;
 730         break;
 731       }
 732
 733   /* If not, create it.  */
 734   if (fmo == NULL)
 735     {
 736       fm->output = create_file (fm->output_name);
 737       if (strcmp (fm->output_name, "gtype-desc.c") == 0)
 738         {
 739           fputs ("#include \"config.h\"\n", fm->output);
 740           fputs ("#include \"system.h\"\n", fm->output);
 741           fputs ("#include \"varray.h\"\n", fm->output);
 742           fputs ("#include \"hashtab.h\"\n", fm->output);
 743           fputs ("#include \"bitmap.h\"\n", fm->output);
 744           fputs ("#include \"tree.h\"\n", fm->output);
 745           fputs ("#include \"rtl.h\"\n", fm->output);
 746           fputs ("#include \"function.h\"\n", fm->output);
 747           fputs ("#include \"insn-config.h\"\n", fm->output);
 748           fputs ("#include \"expr.h\"\n", fm->output);
 749           fputs ("#include \"hard-reg-set.h\"\n", fm->output);
 750           fputs ("#include \"basic-block.h\"\n", fm->output);
 751           fputs ("#include \"cselib.h\"\n", fm->output);
 752           fputs ("#include \"insn-addr.h\"\n", fm->output);
 753           fputs ("#include \"ssa.h\"\n", fm->output);
 754           fputs ("#include \"optabs.h\"\n", fm->output);
 755           fputs ("#include \"libfuncs.h\"\n", fm->output);
 756           fputs ("#include \"debug.h\"\n", fm->output);
 757           fputs ("#include \"ggc.h\"\n", fm->output);
 758         }
 759     }
 760
 761   return fm->output;
 762 }
 763
 764 /* The name of an output file, suitable for definitions, that can see
 765    declarations made in INPUT_FILE and is linked into every language
 766    that uses INPUT_FILE.  */
 767
 768 const char *
 769 get_output_file_name (input_file)
 770      const char *input_file;
 771 {
 772   filemap_p fm;
 773
 774   for (fm = files; fm; fm = fm->next)
 775     if (input_file == fm->input_name)
 776       return fm->output_name;
 777   (void) get_output_file_with_visibility (input_file);
 778   return get_output_file_name (input_file);
 779 }
 780
 781 /* Close all output files and copy them to their final destinations,
 782    but don't unnecessarily change modification times.  */
 783
 784 static void
 785 close_output_files PARAMS ((void))
 786 {
 787   filemap_p fm;
 788   struct filemap header;
 789   header.next = files;
 790   header.output_name = "gtype-desc.h";
 791   header.output = header_file;
 792
 793   for (fm = &header; fm; fm = fm->next)
 794     {
 795       int no_write_p;
 796       filemap_p ofm;
 797       FILE *newfile;
 798
 799       /* Handle each output file once.  */
 800       if (fm->output == NULL)
 801         continue;
 802
 803       for (ofm = fm->next; ofm; ofm = ofm->next)
 804         if (fm->output == ofm->output)
 805           ofm->output = NULL;
 806
 807       /* Compare the output file with the file to be created, avoiding
 808          unnecessarily changing timestamps.  */
 809       newfile = fopen (fm->output_name, "r");
 810       if (newfile != NULL)
 811         {
 812           int ch1, ch2;
 813
 814           rewind (fm->output);
 815           do {
 816             ch1 = fgetc (fm->output);
 817             ch2 = fgetc (newfile);
 818           } while (ch1 != EOF && ch1 == ch2);
 819
 820           fclose (newfile);
 821
 822           no_write_p = ch1 == ch2;
 823         }
 824       else
 825         no_write_p = 0;
 826
 827       /* Nothing interesting to do.  Close the output file.  */
 828       if (no_write_p)
 829         {
 830           fclose (fm->output);
 831           continue;
 832         }
 833
 834       newfile = fopen (fm->output_name, "w");
 835       if (newfile == NULL)
 836         {
 837           perror ("opening output file");
 838           exit (1);
 839         }
 840       {
 841         int ch;
 842         rewind (fm->output);
 843         while ((ch = fgetc (fm->output)) != EOF)
 844           fputc (ch, newfile);
 845       }
 846       fclose (newfile);
 847       fclose (fm->output);
 848     }
 849 }
 850 \f
 851 struct flist {
 852   struct flist *next;
 853   int started_p;
 854   const char *name;
 855   FILE *f;
 856 };
 857
 858 static void output_escaped_param PARAMS ((FILE *, const char *, const char *,
 859                                           const char *, const char *,
 860                                           struct fileloc *));
 861 static void write_gc_structure_fields
 862   PARAMS ((FILE *, type_p, const char *, const char *, options_p,
 863            int, struct fileloc *, lang_bitmap, type_p));
 864 static void write_gc_marker_routine_for_structure PARAMS ((type_p, type_p));
 865 static void write_gc_types PARAMS ((type_p structures, type_p param_structs));
 866 static void put_mangled_filename PARAMS ((FILE *, const char *));
 867 static void finish_root_table PARAMS ((struct flist *flp, const char *pfx,
 868                                        const char *tname, const char *lastname,
 869                                        const char *name));
 870 static void write_gc_root PARAMS ((FILE *, pair_p, type_p, const char *, int,
 871                                    struct fileloc *, const char *));
 872 static void write_gc_roots PARAMS ((pair_p));
 873
 874 static int gc_counter;
 875
 876 /* Print PARAM to OF processing escapes.  VAL references the current object,
 877    PREV_VAL the object containing the current object, ONAME is the name
 878    of the option and LINE is used to print error messages.  */
 879
 880 static void
 881 output_escaped_param (of, param, val, prev_val, oname, line)
 882      FILE *of;
 883      const char *param;
 884      const char *val;
 885      const char *prev_val;
 886      const char *oname;
 887      struct fileloc *line;
 888 {
 889   const char *p;
 890
 891   for (p = param; *p; p++)
 892     if (*p != '%')
 893       fputc (*p, of);
 894     else if (*++p == 'h')
 895       fprintf (of, "(%s)", val);
 896     else if (*p == '0')
 897       fputs ("(*x)", of);
 898     else if (*p == '1')
 899       fprintf (of, "(%s)", prev_val);
 900     else
 901       error_at_line (line, "`%s' option contains bad escape %c%c",
 902                      oname, '%', *p);
 903 }
 904
 905 /* Write out code to OF which marks the fields of S.  VAL references
 906    the current object, PREV_VAL the object containing the current
 907    object, OPTS is a list of options to apply, INDENT is the current
 908    indentation level, LINE is used to print error messages, BITMAP
 909    indicates which languages to print the structure for, and PARAM is
 910    the current parameter (from an enclosing param_is option).  */
 911
 912 static void
 913 write_gc_structure_fields (of, s, val, prev_val, opts, indent, line, bitmap,
 914                            param)
 915      FILE *of;
 916      type_p s;
 917      const char *val;
 918      const char *prev_val;
 919      options_p opts;
 920      int indent;
 921      struct fileloc *line;
 922      lang_bitmap bitmap;
 923      type_p param;
 924 {
 925   pair_p f;
 926   int tagcounter = -1;
 927
 928   if (! s->u.s.line.file)
 929     error_at_line (line, "incomplete structure `%s'", s->u.s.tag);
 930   else if ((s->u.s.bitmap & bitmap) != bitmap)
 931     {
 932       error_at_line (line, "structure defined for mismatching languages");
 933       error_at_line (&s->u.s.line, "one structure defined here");
 934     }
 935
 936   if (s->kind == TYPE_UNION)
 937     {
 938       const char *tagexpr = NULL;
 939       options_p oo;
 940
 941       tagcounter = ++gc_counter;
 942       for (oo = opts; oo; oo = oo->next)
 943         if (strcmp (oo->name, "desc") == 0)
 944           tagexpr = (const char *)oo->info;
 945       if (tagexpr == NULL)
 946         {
 947           tagexpr = "1";
 948           error_at_line (line, "missing `desc' option");
 949         }
 950
 951       fprintf (of, "%*s{\n", indent, "");
 952       indent += 2;
 953       fprintf (of, "%*sunsigned int tag%d = (", indent, "", tagcounter);
 954       output_escaped_param (of, tagexpr, val, prev_val, "desc", line);
 955       fputs (");\n", of);
 956     }
 957
 958   for (f = s->u.s.fields; f; f = f->next)
 959     {
 960       const char *tagid = NULL;
 961       const char *length = NULL;
 962       const char *special = NULL;
 963       int skip_p = 0;
 964       int always_p = 0;
 965       int maybe_undef_p = 0;
 966       int use_param_p = 0;
 967       options_p oo;
 968       type_p t = f->type;
 969
 970       if (t->kind == TYPE_SCALAR
 971           || (t->kind == TYPE_ARRAY
 972               && t->u.a.p->kind == TYPE_SCALAR))
 973         continue;
 974
 975       for (oo = f->opt; oo; oo = oo->next)
 976         if (strcmp (oo->name, "length") == 0)
 977           length = (const char *)oo->info;
 978         else if (strcmp (oo->name, "maybe_undef") == 0)
 979           maybe_undef_p = 1;
 980         else if (strcmp (oo->name, "tag") == 0)
 981           tagid = (const char *)oo->info;
 982         else if (strcmp (oo->name, "special") == 0)
 983           special = (const char *)oo->info;
 984         else if (strcmp (oo->name, "skip") == 0)
 985           skip_p = 1;
 986         else if (strcmp (oo->name, "always") == 0)
 987           always_p = 1;
 988         else if (strcmp (oo->name, "desc") == 0 && UNION_P (t))
 989           ;
 990         else if (strcmp (oo->name, "descbits") == 0 && UNION_P (t))
 991           ;
 992         else if (strcmp (oo->name, "param_is") == 0)
 993           ;
 994         else if (strcmp (oo->name, "use_param") == 0)
 995           use_param_p = 1;
 996         else
 997           error_at_line (&f->line, "unknown field option `%s'\n", oo->name);
 998
 999       if (skip_p)
1000         continue;
1001
1002       if (use_param_p)
1003         {
1004           if (param != NULL)
1005             {
1006               type_p t1;
1007               type_p nt = param;
1008               int arraycount = 0;
1009
1010               for (t1 = t; t->kind == TYPE_ARRAY; t = t->u.a.p)
1011                 arraycount++;
1012               for (; t->kind == TYPE_POINTER; t = t->u.p)
1013                 nt = create_pointer (nt);
1014               while (arraycount-- > 0)
1015                 nt = create_array (nt, t->u.a.len);
1016               t = nt;
1017             }
1018           else if (s->kind == TYPE_UNION && ! always_p && tagid)
1019             ;
1020           else
1021             error_at_line (&f->line, "no parameter defined");
1022         }
1023
1024       if (maybe_undef_p
1025           && (t->kind != TYPE_POINTER
1026               || t->u.p->kind != TYPE_STRUCT))
1027         error_at_line (&f->line,
1028                        "field `%s' has invalid option `maybe_undef_p'\n",
1029                        f->name);
1030       if (s->kind == TYPE_UNION && ! always_p )
1031         {
1032           if (! tagid)
1033             {
1034               error_at_line (&f->line, "field `%s' has no tag", f->name);
1035               continue;
1036             }
1037           fprintf (of, "%*sif (tag%d == (%s)) {\n", indent, "",
1038                    tagcounter, tagid);
1039           indent += 2;
1040         }
1041
1042       switch (t->kind)
1043         {
1044         case TYPE_STRING:
1045           /* Do nothing; strings go in the string pool.  */
1046           break;
1047
1048         case TYPE_LANG_STRUCT:
1049           {
1050             type_p ti;
1051             for (ti = t->u.s.lang_struct; ti; ti = ti->next)
1052               if (ti->u.s.bitmap & bitmap)
1053                 {
1054                   t = ti;
1055                   break;
1056                 }
1057             if (ti == NULL)
1058               {
1059                 error_at_line (&f->line,
1060                                "structure not defined for this language");
1061                 break;
1062               }
1063           }
1064           /* Fall through... */
1065         case TYPE_STRUCT:
1066         case TYPE_UNION:
1067           {
1068             char *newval;
1069
1070             newval = xmalloc (strlen (val) + sizeof (".") + strlen (f->name));
1071             sprintf (newval, "%s.%s", val, f->name);
1072             write_gc_structure_fields (of, t, newval, val, f->opt, indent,
1073                                        &f->line, bitmap, param);
1074             free (newval);
1075             break;
1076           }
1077
1078         case TYPE_POINTER:
1079           if (! length)
1080             {
1081               if (maybe_undef_p
1082                   && t->u.p->u.s.line.file == NULL)
1083                 fprintf (of, "%*sif (%s.%s) abort();\n", indent, "",
1084                          val, f->name);
1085               else if (UNION_OR_STRUCT_P (t->u.p))
1086                 fprintf (of, "%*sgt_ggc_m_%s (%s.%s);\n", indent, "",
1087                          t->u.p->u.s.tag, val, f->name);
1088               else if (t->u.p->kind == TYPE_PARAM_STRUCT)
1089                 fprintf (of, "%*sgt_ggc_mm_%d%s_%s (%s.%s);\n", indent, "",
1090                          (int) strlen (t->u.p->u.param_struct.param->u.s.tag),
1091                          t->u.p->u.param_struct.param->u.s.tag,
1092                          t->u.p->u.param_struct.stru->u.s.tag,
1093                          val, f->name);
1094               else
1095                 error_at_line (&f->line, "field `%s' is pointer to scalar",
1096                                f->name);
1097               break;
1098             }
1099           else if (t->u.p->kind == TYPE_SCALAR
1100                    || t->u.p->kind == TYPE_STRING)
1101             fprintf (of, "%*sggc_mark (%s.%s);\n", indent, "",
1102                      val, f->name);
1103           else
1104             {
1105               int loopcounter = ++gc_counter;
1106
1107               fprintf (of, "%*sif (%s.%s != NULL) {\n", indent, "",
1108                        val, f->name);
1109               indent += 2;
1110               fprintf (of, "%*ssize_t i%d;\n", indent, "", loopcounter);
1111               fprintf (of, "%*sggc_set_mark (%s.%s);\n", indent, "",
1112                        val, f->name);
1113               fprintf (of, "%*sfor (i%d = 0; i%d < (", indent, "",
1114                        loopcounter, loopcounter);
1115               output_escaped_param (of, length, val, prev_val, "length", line);
1116               fprintf (of, "); i%d++) {\n", loopcounter);
1117               indent += 2;
1118               switch (t->u.p->kind)
1119                 {
1120                 case TYPE_STRUCT:
1121                 case TYPE_UNION:
1122                   {
1123                     char *newval;
1124
1125                     newval = xmalloc (strlen (val) + 8 + strlen (f->name));
1126                     sprintf (newval, "%s.%s[i%d]", val, f->name, loopcounter);
1127                     write_gc_structure_fields (of, t->u.p, newval, val,
1128                                                f->opt, indent, &f->line,
1129                                                bitmap, param);
1130                     free (newval);
1131                     break;
1132                   }
1133                 case TYPE_POINTER:
1134                   if (UNION_OR_STRUCT_P (t->u.p->u.p))
1135                     fprintf (of, "%*sgt_ggc_m_%s (%s.%s[i%d]);\n", indent, "",
1136                              t->u.p->u.p->u.s.tag, val, f->name,
1137                              loopcounter);
1138                   else
1139                     error_at_line (&f->line,
1140                                    "field `%s' is array of pointer to scalar",
1141                                    f->name);
1142                   break;
1143                 default:
1144                   error_at_line (&f->line,
1145                                  "field `%s' is array of unimplemented type",
1146                                  f->name);
1147                   break;
1148                 }
1149               indent -= 2;
1150               fprintf (of, "%*s}\n", indent, "");
1151               indent -= 2;
1152               fprintf (of, "%*s}\n", indent, "");
1153             }
1154           break;
1155
1156         case TYPE_ARRAY:
1157           {
1158             int loopcounter = ++gc_counter;
1159             type_p ta;
1160             int i;
1161
1162             if (! length &&
1163                 (strcmp (t->u.a.len, "0") == 0
1164                  || strcmp (t->u.a.len, "1") == 0))
1165               error_at_line (&f->line,
1166                              "field `%s' is array of size %s",
1167                              f->name, t->u.a.len);
1168
1169             /* Arrays of scalars can be ignored.  */
1170             for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
1171               ;
1172             if (ta->kind == TYPE_SCALAR
1173                 || ta->kind == TYPE_STRING)
1174               break;
1175
1176             fprintf (of, "%*s{\n", indent, "");
1177             indent += 2;
1178
1179             if (special != NULL && strcmp (special, "tree_exp") == 0)
1180               {
1181                 fprintf (of, "%*sconst size_t tree_exp_size = (",
1182                          indent, "");
1183                 output_escaped_param (of, length, val, prev_val,
1184                                       "length", line);
1185                 fputs (");\n", of);
1186
1187                 length = "first_rtl_op (TREE_CODE ((tree)&%h))";
1188               }
1189
1190             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1191               {
1192                 fprintf (of, "%*ssize_t i%d_%d;\n",
1193                          indent, "", loopcounter, i);
1194                 fprintf (of, "%*sconst size_t ilimit%d_%d = (",
1195                          indent, "", loopcounter, i);
1196                 if (i == 0 && length != NULL)
1197                   output_escaped_param (of, length, val, prev_val,
1198                                         "length", line);
1199                 else
1200                   fputs (ta->u.a.len, of);
1201                 fputs (");\n", of);
1202               }
1203
1204             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1205               {
1206                 fprintf (of,
1207                  "%*sfor (i%d_%d = 0; i%d_%d < ilimit%d_%d; i%d_%d++) {\n",
1208                          indent, "", loopcounter, i, loopcounter, i,
1209                          loopcounter, i, loopcounter, i);
1210                 indent += 2;
1211               }
1212
1213             if (ta->kind == TYPE_POINTER
1214                 && (ta->u.p->kind == TYPE_STRUCT
1215                     || ta->u.p->kind == TYPE_UNION))
1216               {
1217                 fprintf (of, "%*sgt_ggc_m_%s (%s.%s",
1218                          indent, "", ta->u.p->u.s.tag, val, f->name);
1219                 for (ta = t, i = 0;
1220                      ta->kind == TYPE_ARRAY;
1221                      ta = ta->u.a.p, i++)
1222                   fprintf (of, "[i%d_%d]", loopcounter, i);
1223                 fputs (");\n", of);
1224               }
1225             else if (ta->kind == TYPE_STRUCT || ta->kind == TYPE_UNION)
1226               {
1227                 char *newval;
1228                 int len;
1229
1230                 len = strlen (val) + strlen (f->name) + 2;
1231                 for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
1232                   len += sizeof ("[i_]") + 2*6;
1233
1234                 newval = xmalloc (len);
1235                 sprintf (newval, "%s.%s", val, f->name);
1236                 for (ta = t, i = 0;
1237                      ta->kind == TYPE_ARRAY;
1238                      ta = ta->u.a.p, i++)
1239                   sprintf (newval + strlen (newval), "[i%d_%d]",
1240                            loopcounter, i);
1241                 write_gc_structure_fields (of, t->u.p, newval, val,
1242                                            f->opt, indent, &f->line, bitmap,
1243                                            param);
1244                 free (newval);
1245               }
1246             else if (ta->kind == TYPE_POINTER && ta->u.p->kind == TYPE_SCALAR
1247                      && use_param_p && param == NULL)
1248               fprintf (of, "%*sabort();\n", indent, "");
1249             else
1250               error_at_line (&f->line,
1251                              "field `%s' is array of unimplemented type",
1252                              f->name);
1253             for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
1254               {
1255                 indent -= 2;
1256                 fprintf (of, "%*s}\n", indent, "");
1257               }
1258
1259             if (special != NULL && strcmp (special, "tree_exp") == 0)
1260               {
1261                 fprintf (of,
1262                  "%*sfor (; i%d_0 < tree_exp_size; i%d_0++)\n",
1263                          indent, "", loopcounter, loopcounter);
1264                 fprintf (of, "%*s  gt_ggc_m_rtx_def (%s.%s[i%d_0]);\n",
1265                          indent, "", val, f->name, loopcounter);
1266                 special = NULL;
1267               }
1268
1269             indent -= 2;
1270             fprintf (of, "%*s}\n", indent, "");
1271             break;
1272           }
1273
1274         default:
1275           error_at_line (&f->line,
1276                          "field `%s' is unimplemented type",
1277                          f->name);
1278           break;
1279         }
1280
1281       if (s->kind == TYPE_UNION && ! always_p )
1282         {
1283           indent -= 2;
1284           fprintf (of, "%*s}\n", indent, "");
1285         }
1286       if (special)
1287         error_at_line (&f->line, "unhandled special `%s'", special);
1288     }
1289   if (s->kind == TYPE_UNION)
1290     {
1291       indent -= 2;
1292       fprintf (of, "%*s}\n", indent, "");
1293     }
1294 }
1295
1296 /* Write out a marker routine for S.  PARAM is the parameter from an
1297    enclosing PARAM_IS option.  */
1298
1299 static void
1300 write_gc_marker_routine_for_structure (s, param)
1301      type_p s;
1302      type_p param;
1303 {
1304   FILE *f;
1305   if (param == NULL)
1306     f = get_output_file_with_visibility (s->u.s.line.file);
1307   else
1308     f = get_output_file_with_visibility (param->u.s.line.file);
1309
1310   fputc ('\n', f);
1311   fputs ("void\n", f);
1312   if (param == NULL)
1313     fprintf (f, "gt_ggc_mx_%s (x_p)\n", s->u.s.tag);
1314   else
1315     fprintf (f, "gt_ggc_mm_%d%s_%s (x_p)\n", (int) strlen (param->u.s.tag),
1316              param->u.s.tag, s->u.s.tag);
1317   fputs ("      void *x_p;\n", f);
1318   fputs ("{\n", f);
1319   fprintf (f, "  %s %s * const x = (%s %s *)x_p;\n",
1320            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1321            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1322   fputs ("  if (! ggc_test_and_set_mark (x))\n", f);
1323   fputs ("    return;\n", f);
1324
1325   gc_counter = 0;
1326   write_gc_structure_fields (f, s, "(*x)", "not valid postage",
1327                              s->u.s.opt, 2, &s->u.s.line, s->u.s.bitmap,
1328                              param);
1329
1330   fputs ("}\n", f);
1331 }
1332
1333 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
1334
1335 static void
1336 write_gc_types (structures, param_structs)
1337      type_p structures;
1338      type_p param_structs;
1339 {
1340   type_p s;
1341
1342   fputs ("\n/* GC marker procedures.  */\n", header_file);
1343   for (s = structures; s; s = s->next)
1344     if (s->gc_used == GC_POINTED_TO
1345         || s->gc_used == GC_MAYBE_POINTED_TO)
1346       {
1347         options_p opt;
1348
1349         if (s->gc_used == GC_MAYBE_POINTED_TO
1350             && s->u.s.line.file == NULL)
1351           continue;
1352
1353         fprintf (header_file,
1354                  "#define gt_ggc_m_%s(X) do { \\\n", s->u.s.tag);
1355         fprintf (header_file,
1356                  "  if (X != NULL) gt_ggc_mx_%s (X);\\\n", s->u.s.tag);
1357         fprintf (header_file,
1358                  "  } while (0)\n");
1359
1360         for (opt = s->u.s.opt; opt; opt = opt->next)
1361           if (strcmp (opt->name, "ptr_alias") == 0)
1362             {
1363               type_p t = (type_p) opt->info;
1364               if (t->kind == TYPE_STRUCT
1365                   || t->kind == TYPE_UNION
1366                   || t->kind == TYPE_LANG_STRUCT)
1367                 fprintf (header_file,
1368                          "#define gt_ggc_mx_%s gt_ggc_mx_%s\n",
1369                          s->u.s.tag, t->u.s.tag);
1370               else
1371                 error_at_line (&s->u.s.line,
1372                                "structure alias is not a structure");
1373               break;
1374             }
1375         if (opt)
1376           continue;
1377
1378         /* Declare the marker procedure only once.  */
1379         fprintf (header_file,
1380                  "extern void gt_ggc_mx_%s PARAMS ((void *));\n",
1381                  s->u.s.tag);
1382
1383         if (s->u.s.line.file == NULL)
1384           {
1385             fprintf (stderr, "warning: structure `%s' used but not defined\n",
1386                      s->u.s.tag);
1387             continue;
1388           }
1389
1390         if (s->kind == TYPE_LANG_STRUCT)
1391           {
1392             type_p ss;
1393             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
1394               write_gc_marker_routine_for_structure (ss, NULL);
1395           }
1396         else
1397           write_gc_marker_routine_for_structure (s, NULL);
1398       }
1399
1400   for (s = param_structs; s; s = s->next)
1401     if (s->gc_used == GC_POINTED_TO)
1402       {
1403         type_p param = s->u.param_struct.param;
1404         type_p stru = s->u.param_struct.stru;
1405
1406         if (param->kind != TYPE_STRUCT && param->kind != TYPE_UNION
1407             && param->kind != TYPE_LANG_STRUCT)
1408           {
1409             error_at_line (&s->u.param_struct.line,
1410                            "unsupported parameter type");
1411             continue;
1412           }
1413
1414         /* Declare the marker procedure.  */
1415         fprintf (header_file,
1416                  "extern void gt_ggc_mm_%d%s_%s PARAMS ((void *));\n",
1417                  (int) strlen (param->u.s.tag), param->u.s.tag,
1418                  stru->u.s.tag);
1419
1420         if (stru->u.s.line.file == NULL)
1421           {
1422             fprintf (stderr, "warning: structure `%s' used but not defined\n",
1423                      s->u.s.tag);
1424             continue;
1425           }
1426
1427         if (stru->kind == TYPE_LANG_STRUCT)
1428           {
1429             type_p ss;
1430             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
1431               write_gc_marker_routine_for_structure (ss, param);
1432           }
1433         else
1434           write_gc_marker_routine_for_structure (stru, param);
1435       }
1436 }
1437
1438 /* Mangle FN and print it to F.  */
1439
1440 static void
1441 put_mangled_filename (f, fn)
1442      FILE *f;
1443      const char *fn;
1444 {
1445   const char *name = get_output_file_name (fn);
1446   for (; *name != 0; name++)
1447     if (ISALNUM (*name))
1448       fputc (*name, f);
1449     else
1450       fputc ('_', f);
1451 }
1452
1453 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
1454    LASTNAME, and NAME are all strings to insert in various places in
1455    the resulting code.  */
1456
1457 static void
1458 finish_root_table (flp, pfx, lastname, tname, name)
1459      struct flist *flp;
1460      const char *pfx;
1461      const char *tname;
1462      const char *lastname;
1463      const char *name;
1464 {
1465   struct flist *fli2;
1466   unsigned started_bitmap = 0;
1467
1468   for (fli2 = flp; fli2; fli2 = fli2->next)
1469     if (fli2->started_p)
1470       {
1471         fprintf (fli2->f, "  %s\n", lastname);
1472         fputs ("};\n\n", fli2->f);
1473       }
1474
1475   for (fli2 = flp; fli2; fli2 = fli2->next)
1476     if (fli2->started_p)
1477       {
1478         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
1479         int fnum;
1480
1481         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
1482           if (bitmap & 1)
1483             {
1484               fprintf (base_files[fnum],
1485                        "extern const struct %s gt_ggc_%s_",
1486                        tname, pfx);
1487               put_mangled_filename (base_files[fnum], fli2->name);
1488               fputs ("[];\n", base_files[fnum]);
1489             }
1490       }
1491
1492   for (fli2 = flp; fli2; fli2 = fli2->next)
1493     if (fli2->started_p)
1494       {
1495         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
1496         int fnum;
1497
1498         fli2->started_p = 0;
1499
1500         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
1501           if (bitmap & 1)
1502             {
1503               if (! (started_bitmap & (1 << fnum)))
1504                 {
1505                   fprintf (base_files [fnum],
1506                            "const struct %s * const %s[] = {\n",
1507                            tname, name);
1508                   started_bitmap |= 1 << fnum;
1509                 }
1510               fprintf (base_files[fnum], "  gt_ggc_%s_", pfx);
1511               put_mangled_filename (base_files[fnum], fli2->name);
1512               fputs (",\n", base_files[fnum]);
1513             }
1514       }
1515
1516   {
1517     unsigned bitmap;
1518     int fnum;
1519
1520     for (bitmap = started_bitmap, fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
1521       if (bitmap & 1)
1522         {
1523           fputs ("  NULL\n", base_files[fnum]);
1524           fputs ("};\n\n", base_files[fnum]);
1525         }
1526   }
1527 }
1528
1529 /* Write out to F the table entry and any marker routines needed to
1530    mark NAME as TYPE.  The original variable is V, at LINE.
1531    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
1532    is nonzero iff we are building the root table for hash table caches.  */
1533
1534 static void
1535 write_gc_root (f, v, type, name, has_length, line, if_marked)
1536      FILE *f;
1537      pair_p v;
1538      type_p type;
1539      const char *name;
1540      int has_length;
1541      struct fileloc *line;
1542      const char *if_marked;
1543 {
1544   switch (type->kind)
1545     {
1546     case TYPE_STRUCT:
1547       {
1548         pair_p fld;
1549         for (fld = type->u.s.fields; fld; fld = fld->next)
1550           {
1551             int skip_p = 0;
1552             const char *desc = NULL;
1553             options_p o;
1554
1555             for (o = fld->opt; o; o = o->next)
1556               if (strcmp (o->name, "skip") == 0)
1557                 skip_p = 1;
1558               else if (strcmp (o->name, "desc") == 0)
1559                 desc = (const char *)o->info;
1560               else
1561                 error_at_line (line,
1562                        "field `%s' of global `%s' has unknown option `%s'",
1563                                fld->name, name, o->name);
1564
1565             if (skip_p)
1566               continue;
1567             else if (desc && fld->type->kind == TYPE_UNION)
1568               {
1569                 pair_p validf = NULL;
1570                 pair_p ufld;
1571
1572                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
1573                   {
1574                     const char *tag = NULL;
1575                     options_p oo;
1576
1577                     for (oo = ufld->opt; oo; oo = oo->next)
1578                       if (strcmp (oo->name, "tag") == 0)
1579                         tag = (const char *)oo->info;
1580                     if (tag == NULL || strcmp (tag, desc) != 0)
1581                       continue;
1582                     if (validf != NULL)
1583                       error_at_line (line,
1584                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
1585                                      name, fld->name, validf->name,
1586                                      name, fld->name, ufld->name,
1587                                      tag);
1588                     validf = ufld;
1589                   }
1590                 if (validf != NULL)
1591                   {
1592                     char *newname;
1593                     newname = xmalloc (strlen (name) + 3 + strlen (fld->name)
1594                                        + strlen (validf->name));
1595                     sprintf (newname, "%s.%s.%s",
1596                              name, fld->name, validf->name);
1597                     write_gc_root (f, v, validf->type, newname, 0, line,
1598                                    if_marked);
1599                     free (newname);
1600                   }
1601               }
1602             else if (desc)
1603               error_at_line (line,
1604                      "global `%s.%s' has `desc' option but is not union",
1605                              name, fld->name);
1606             else
1607               {
1608                 char *newname;
1609                 newname = xmalloc (strlen (name) + 2 + strlen (fld->name));
1610                 sprintf (newname, "%s.%s", name, fld->name);
1611                 write_gc_root (f, v, fld->type, newname, 0, line, if_marked);
1612                 free (newname);
1613               }
1614           }
1615       }
1616       break;
1617
1618     case TYPE_ARRAY:
1619       {
1620         char *newname;
1621         newname = xmalloc (strlen (name) + 4);
1622         sprintf (newname, "%s[0]", name);
1623         write_gc_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
1624         free (newname);
1625       }
1626       break;
1627
1628     case TYPE_POINTER:
1629       {
1630         type_p ap, tp;
1631
1632         fputs ("  {\n", f);
1633         fprintf (f, "    &%s,\n", name);
1634         fputs ("    1", f);
1635
1636         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
1637           if (ap->u.a.len[0])
1638             fprintf (f, " * (%s)", ap->u.a.len);
1639           else if (ap == v->type)
1640             fprintf (f, " * (sizeof (%s) / sizeof (%s[0]))",
1641                      v->name, v->name);
1642         fputs (",\n", f);
1643         fprintf (f, "    sizeof (%s", v->name);
1644         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
1645           fputs ("[0]", f);
1646         fputs ("),\n", f);
1647
1648         tp = type->u.p;
1649
1650         if (! has_length && UNION_OR_STRUCT_P (tp))
1651           {
1652             fprintf (f, "    &gt_ggc_mx_%s\n", tp->u.s.tag);
1653           }
1654         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
1655           {
1656             fprintf (f, "    &gt_ggc_mm_%d%s_%s",
1657                      (int) strlen (tp->u.param_struct.param->u.s.tag),
1658                      tp->u.param_struct.param->u.s.tag,
1659                      tp->u.param_struct.stru->u.s.tag);
1660           }
1661         else if (has_length
1662                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
1663           {
1664             fprintf (f, "    &gt_ggc_ma_%s", name);
1665           }
1666         else
1667           {
1668             error_at_line (line,
1669                            "global `%s' is pointer to unimplemented type",
1670                            name);
1671           }
1672         if (if_marked)
1673           fprintf (f, ",\n    &%s", if_marked);
1674         fputs ("\n  },\n", f);
1675       }
1676       break;
1677
1678     case TYPE_SCALAR:
1679     case TYPE_STRING:
1680       break;
1681
1682     default:
1683       error_at_line (line,
1684                      "global `%s' is unimplemented type",
1685                      name);
1686     }
1687 }
1688
1689 /* Output a table describing the locations and types of VARIABLES.  */
1690
1691 static void
1692 write_gc_roots (variables)
1693      pair_p variables;
1694 {
1695   pair_p v;
1696   struct flist *flp = NULL;
1697
1698   for (v = variables; v; v = v->next)
1699     {
1700       FILE *f = get_output_file_with_visibility (v->line.file);
1701       struct flist *fli;
1702       const char *length = NULL;
1703       int deletable_p = 0;
1704       options_p o;
1705
1706       for (o = v->opt; o; o = o->next)
1707         if (strcmp (o->name, "length") == 0)
1708           length = (const char *)o->info;
1709         else if (strcmp (o->name, "deletable") == 0)
1710           deletable_p = 1;
1711         else if (strcmp (o->name, "param_is") == 0)
1712           ;
1713         else if (strcmp (o->name, "if_marked") == 0)
1714           ;
1715         else
1716           error_at_line (&v->line,
1717                          "global `%s' has unknown option `%s'",
1718                          v->name, o->name);
1719
1720       for (fli = flp; fli; fli = fli->next)
1721         if (fli->f == f)
1722           break;
1723       if (fli == NULL)
1724         {
1725           fli = xmalloc (sizeof (*fli));
1726           fli->f = f;
1727           fli->next = flp;
1728           fli->started_p = 0;
1729           fli->name = v->line.file;
1730           flp = fli;
1731
1732           fputs ("\n/* GC roots.  */\n\n", f);
1733         }
1734
1735       if (! deletable_p
1736           && length
1737           && v->type->kind == TYPE_POINTER
1738           && (v->type->u.p->kind == TYPE_POINTER
1739               || v->type->u.p->kind == TYPE_STRUCT))
1740         {
1741           fprintf (f, "static void gt_ggc_ma_%s PARAMS ((void *));\n",
1742                    v->name);
1743           fprintf (f, "static void\ngt_ggc_ma_%s (x_p)\n      void *x_p;\n",
1744                    v->name);
1745           fputs ("{\n", f);
1746           fputs ("  size_t i;\n", f);
1747
1748           if (v->type->u.p->kind == TYPE_POINTER)
1749             {
1750               type_p s = v->type->u.p->u.p;
1751
1752               fprintf (f, "  %s %s ** const x = (%s %s **)x_p;\n",
1753                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1754                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1755               fputs ("  if (ggc_test_and_set_mark (x))\n", f);
1756               fprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
1757               if (s->kind != TYPE_STRUCT && s->kind != TYPE_UNION)
1758                 {
1759                   error_at_line (&v->line,
1760                                  "global `%s' has unsupported ** type",
1761                                  v->name);
1762                   continue;
1763                 }
1764
1765               fprintf (f, "      gt_ggc_m_%s (x[i]);\n", s->u.s.tag);
1766             }
1767           else
1768             {
1769               type_p s = v->type->u.p;
1770
1771               fprintf (f, "  %s %s * const x = (%s %s *)x_p;\n",
1772                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
1773                        s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
1774               fputs ("  if (ggc_test_and_set_mark (x))\n", f);
1775               fprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
1776               fputs ("      {\n", f);
1777               write_gc_structure_fields (f, s, "x[i]", "x[i]",
1778                                          v->opt, 8, &v->line, s->u.s.bitmap,
1779                                          NULL);
1780               fputs ("      }\n", f);
1781             }
1782
1783           fputs ("}\n\n", f);
1784         }
1785     }
1786
1787   for (v = variables; v; v = v->next)
1788     {
1789       FILE *f = get_output_file_with_visibility (v->line.file);
1790       struct flist *fli;
1791       int skip_p = 0;
1792       int length_p = 0;
1793       options_p o;
1794
1795       for (o = v->opt; o; o = o->next)
1796         if (strcmp (o->name, "length") == 0)
1797           length_p = 1;
1798         else if (strcmp (o->name, "deletable") == 0
1799                  || strcmp (o->name, "if_marked") == 0)
1800           skip_p = 1;
1801
1802       if (skip_p)
1803         continue;
1804
1805       for (fli = flp; fli; fli = fli->next)
1806         if (fli->f == f)
1807           break;
1808       if (! fli->started_p)
1809         {
1810           fli->started_p = 1;
1811
1812           fputs ("const struct ggc_root_tab gt_ggc_r_", f);
1813           put_mangled_filename (f, v->line.file);
1814           fputs ("[] = {\n", f);
1815         }
1816
1817       write_gc_root (f, v, v->type, v->name, length_p, &v->line, NULL);
1818     }
1819
1820   finish_root_table (flp, "r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
1821                      "gt_ggc_rtab");
1822
1823   for (v = variables; v; v = v->next)
1824     {
1825       FILE *f = get_output_file_with_visibility (v->line.file);
1826       struct flist *fli;
1827       int skip_p = 1;
1828       options_p o;
1829
1830       for (o = v->opt; o; o = o->next)
1831         if (strcmp (o->name, "deletable") == 0)
1832           skip_p = 0;
1833         else if (strcmp (o->name, "if_marked") == 0)
1834           skip_p = 1;
1835
1836       if (skip_p)
1837         continue;
1838
1839       for (fli = flp; fli; fli = fli->next)
1840         if (fli->f == f)
1841           break;
1842       if (! fli->started_p)
1843         {
1844           fli->started_p = 1;
1845
1846           fputs ("const struct ggc_root_tab gt_ggc_rd_", f);
1847           put_mangled_filename (f, v->line.file);
1848           fputs ("[] = {\n", f);
1849         }
1850
1851       fprintf (f, "  { &%s, 1, sizeof (%s), NULL },\n",
1852                v->name, v->name);
1853     }
1854
1855   finish_root_table (flp, "rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
1856                      "gt_ggc_deletable_rtab");
1857
1858   for (v = variables; v; v = v->next)
1859     {
1860       FILE *f = get_output_file_with_visibility (v->line.file);
1861       struct flist *fli;
1862       const char *if_marked = NULL;
1863       int length_p = 0;
1864       options_p o;
1865
1866       for (o = v->opt; o; o = o->next)
1867         if (strcmp (o->name, "length") == 0)
1868           length_p = 1;
1869         else if (strcmp (o->name, "if_marked") == 0)
1870           if_marked = (const char *) o->info;
1871
1872       if (if_marked == NULL)
1873         continue;
1874
1875       if (v->type->kind != TYPE_POINTER
1876           || v->type->u.p->kind != TYPE_PARAM_STRUCT
1877           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
1878         {
1879           error_at_line (&v->line, "if_marked option used but not hash table");
1880           continue;
1881         }
1882
1883       for (fli = flp; fli; fli = fli->next)
1884         if (fli->f == f)
1885           break;
1886       if (! fli->started_p)
1887         {
1888           fli->started_p = 1;
1889
1890           fputs ("const struct ggc_cache_tab gt_ggc_rc_", f);
1891           put_mangled_filename (f, v->line.file);
1892           fputs ("[] = {\n", f);
1893         }
1894
1895       write_gc_root (f, v, create_pointer (v->type->u.p->u.param_struct.param),
1896                      v->name, length_p, &v->line, if_marked);
1897     }
1898
1899   finish_root_table (flp, "rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
1900                      "gt_ggc_cache_rtab");
1901 }
1902
1903 \f
1904 extern int main PARAMS ((int argc, char **argv));
1905 int
1906 main(argc, argv)
1907      int argc;
1908      char **argv;
1909 {
1910   int i;
1911   static struct fileloc pos = { __FILE__, __LINE__ };
1912
1913   do_typedef ("CUMULATIVE_ARGS",
1914               create_scalar_type ("CUMULATIVE_ARGS",
1915                                   strlen ("CUMULATIVE_ARGS")),
1916               &pos);
1917   do_typedef ("REAL_VALUE_TYPE",
1918               create_scalar_type ("REAL_VALUE_TYPE",
1919                                   strlen ("REAL_VALUE_TYPE")),
1920               &pos);
1921   do_typedef ("PTR", create_pointer (create_scalar_type ("void",
1922                                                          strlen ("void"))),
1923               &pos);
1924
1925   for (i = 1; i < argc; i++)
1926     parse_file (argv[i]);
1927
1928   if (hit_error != 0)
1929     exit (1);
1930
1931   set_gc_used (variables);
1932
1933   open_base_files ();
1934   write_gc_types (structures, param_structs);
1935   write_gc_roots (variables);
1936   close_output_files ();
1937
1938   return (hit_error != 0);
1939 }