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