gcc/gengtype.c

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