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