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