OSDN Git Service

* sdbout.c: Include vec.h, do not include varray.h.
[pf3gnuchains/gcc-fork.git] / gcc / gengtype.c
1 /* Process source files and output type information.
2    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
3    Free Software Foundation, Inc.
4
5    This file is part of GCC.
6
7    GCC is free software; you can redistribute it and/or modify it under
8    the terms of the GNU General Public License as published by the Free
9    Software Foundation; either version 3, or (at your option) any later
10    version.
11
12    GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13    WARRANTY; without even the implied warranty of MERCHANTABILITY or
14    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15    for more details.
16
17    You should have received a copy of the GNU General Public License
18    along with GCC; see the file COPYING3.  If not see
19    <http://www.gnu.org/licenses/>.  */
20
21 #include "bconfig.h"
22 #include "system.h"
23 #include "gengtype.h"
24 #include "errors.h"     /* for fatal */
25 #include "double-int.h"
26
27 /* Data types, macros, etc. used only in this file.  */
28
29 /* Kinds of types we can understand.  */
30 enum typekind {
31   TYPE_SCALAR,
32   TYPE_STRING,
33   TYPE_STRUCT,
34   TYPE_UNION,
35   TYPE_POINTER,
36   TYPE_ARRAY,
37   TYPE_LANG_STRUCT,
38   TYPE_PARAM_STRUCT
39 };
40
41 typedef unsigned lang_bitmap;
42
43 /* A way to pass data through to the output end.  */
44 struct options
45 {
46   struct options *next;
47   const char *name;
48   const char *info;
49 };
50
51 /* Option data for the 'nested_ptr' option.  */
52 struct nested_ptr_data
53 {
54   type_p type;
55   const char *convert_to;
56   const char *convert_from;
57 };
58
59 /* A name and a type.  */
60 struct pair
61 {
62   pair_p next;
63   const char *name;
64   type_p type;
65   struct fileloc line;
66   options_p opt;
67 };
68
69 #define NUM_PARAM 10
70
71 /* A description of a type.  */
72 enum gc_used_enum
73   {
74     GC_UNUSED = 0,
75     GC_USED,
76     GC_MAYBE_POINTED_TO,
77     GC_POINTED_TO
78   };
79
80 struct type
81 {
82   enum typekind kind;
83   type_p next;
84   type_p pointer_to;
85   enum gc_used_enum gc_used;
86   union {
87     type_p p;
88     struct {
89       const char *tag;
90       struct fileloc line;
91       pair_p fields;
92       options_p opt;
93       lang_bitmap bitmap;
94       type_p lang_struct;
95     } s;
96     bool scalar_is_char;
97     struct {
98       type_p p;
99       const char *len;
100     } a;
101     struct {
102       type_p stru;
103       type_p param[NUM_PARAM];
104       struct fileloc line;
105     } param_struct;
106   } u;
107 };
108
109 #define UNION_P(x)                                      \
110  ((x)->kind == TYPE_UNION ||                            \
111   ((x)->kind == TYPE_LANG_STRUCT                        \
112    && (x)->u.s.lang_struct->kind == TYPE_UNION))
113 #define UNION_OR_STRUCT_P(x)                    \
114  ((x)->kind == TYPE_UNION                       \
115   || (x)->kind == TYPE_STRUCT                   \
116   || (x)->kind == TYPE_LANG_STRUCT)
117
118 /* Structure representing an output file.  */
119 struct outf
120 {
121   struct outf *next;
122   const char *name;
123   size_t buflength;
124   size_t bufused;
125   char *buf;
126 };
127 typedef struct outf * outf_p;
128
129 /* An output file, suitable for definitions, that can see declarations
130    made in INPUT_FILE and is linked into every language that uses
131    INPUT_FILE.  May return NULL in plugin mode. */
132 extern outf_p get_output_file_with_visibility
133    (const char *input_file);
134 const char *get_output_file_name (const char *);
135
136 /* Print, like fprintf, to O.  No-op if O is NULL. */
137 static void oprintf (outf_p o, const char *S, ...)
138      ATTRIBUTE_PRINTF_2;
139
140 /* The list of output files.  */
141 static outf_p output_files;
142
143 /* The plugin input files and their number; in that case only
144    a single file is produced.  */
145 static char** plugin_files;
146 static size_t nb_plugin_files;
147 /* the generated plugin output name & file */
148 static outf_p plugin_output;
149
150 /* The output header file that is included into pretty much every
151    source file.  */
152 static outf_p header_file;
153
154 /* Source directory.  */
155 static const char *srcdir;
156
157 /* Length of srcdir name.  */
158 static size_t srcdir_len = 0;
159
160 static outf_p create_file (const char *, const char *);
161
162 static const char * get_file_basename (const char *);
163 static const char * get_file_realbasename (const char *);
164 static const char * get_file_srcdir_relative_path (const char *);
165
166 static int get_prefix_langdir_index (const char *);
167 static const char * get_file_langdir (const char *);
168
169 \f
170 /* Nonzero iff an error has occurred.  */
171 bool hit_error = false;
172
173 static void gen_rtx_next (void);
174 static void write_rtx_next (void);
175 static void open_base_files (void);
176 static void close_output_files (void);
177
178 /* Report an error at POS, printing MSG.  */
179
180 void
181 error_at_line (struct fileloc *pos, const char *msg, ...)
182 {
183   va_list ap;
184
185   va_start (ap, msg);
186
187   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
188   vfprintf (stderr, msg, ap);
189   fputc ('\n', stderr);
190   hit_error = true;
191
192   va_end (ap);
193 }
194
195 /* asprintf, but produces fatal message on out-of-memory.  */
196 char *
197 xasprintf (const char *format, ...)
198 {
199   int n;
200   char *result;
201   va_list ap;
202
203   va_start (ap, format);
204   n = vasprintf (&result, format, ap);
205   if (result == NULL || n < 0)
206     fatal ("out of memory");
207   va_end (ap);
208
209   return result;
210 }
211 \f
212 /* Input file handling. */
213
214 /* Table of all input files.  */
215 static const char **gt_files;
216 static size_t num_gt_files;
217
218 /* A number of places use the name of this file for a location for
219    things that we can't rely on the source to define.  Make sure we
220    can still use pointer comparison on filenames.  */
221 static const char this_file[] = __FILE__;
222
223 /* Vector of per-language directories.  */
224 static const char **lang_dir_names;
225 static size_t num_lang_dirs;
226
227 /* An array of output files suitable for definitions.  There is one
228    BASE_FILES entry for each language.  */
229 static outf_p *base_files;
230
231 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
232    INPUT_FILE is used by <lang>.
233
234    This function should be written to assume that a file _is_ used
235    if the situation is unclear.  If it wrongly assumes a file _is_ used,
236    a linker error will result.  If it wrongly assumes a file _is not_ used,
237    some GC roots may be missed, which is a much harder-to-debug problem.
238
239    The relevant bitmap is stored immediately before the file's name in the
240    buffer set up by read_input_list.  It may be unaligned, so we have to
241    read it byte-by-byte.  */
242
243 static lang_bitmap
244 get_lang_bitmap (const char *gtfile)
245 {
246
247   if (gtfile == this_file)
248     /* Things defined in this file are universal.  */
249     return (((lang_bitmap)1) << num_lang_dirs) - 1;
250   else
251     {
252       lang_bitmap n = 0;
253       int i;
254       for (i = -(int) sizeof (lang_bitmap); i < 0; i++)
255         n = (n << CHAR_BIT) + (unsigned char)gtfile[i];
256       return n;
257     }
258 }
259
260 /* Set the bitmap returned by get_lang_bitmap.  The only legitimate
261    caller of this function is read_input_list.  */
262 static void
263 set_lang_bitmap (char *gtfile, lang_bitmap n)
264 {
265   int i;
266   for (i = -1; i >= -(int) sizeof (lang_bitmap); i--)
267     {
268       gtfile[i] = n & ((1U << CHAR_BIT)-1);
269       n >>= CHAR_BIT;
270     }
271 }
272
273 /* Scan the input file, LIST, and determine how much space we need to
274    store strings in.  Also, count the number of language directories
275    and files.  The numbers returned are overestimates as they does not
276    consider repeated files.  */
277 static size_t
278 measure_input_list (FILE *list)
279 {
280   size_t n = 0;
281   int c;
282   bool atbol = true;
283   num_lang_dirs = 0;
284   num_gt_files = plugin_files ? nb_plugin_files : 0;
285   while ((c = getc (list)) != EOF)
286     {
287       n++;
288       if (atbol)
289         {
290           if (c == '[')
291             num_lang_dirs++;
292           else
293             {
294               /* Add space for a lang_bitmap before the input file name.  */
295               n += sizeof (lang_bitmap);
296               num_gt_files++;
297             }
298           atbol = false;
299         }
300
301       if (c == '\n')
302         atbol = true;
303     }
304
305   rewind (list);
306   return n;
307 }
308
309 /* Read one input line from LIST to HEREP (which is updated).  A
310    pointer to the string is returned via LINEP.  If it was a language
311    subdirectory in square brackets, strip off the square brackets and
312    return true.  Otherwise, leave space before the string for a
313    lang_bitmap, and return false.  At EOF, returns false, does not
314    touch *HEREP, and sets *LINEP to NULL.  POS is used for
315    diagnostics.  */
316 static bool
317 read_input_line (FILE *list, char **herep, char **linep,
318                  struct fileloc *pos)
319 {
320   char *here = *herep;
321   char *line;
322   int c = getc (list);
323
324   /* Read over whitespace.  */
325   while (c == '\n' || c == ' ')
326     c = getc (list);
327
328   if (c == EOF)
329     {
330       *linep = 0;
331       return false;
332     }
333   else if (c == '[')
334     {
335       /* No space for a lang_bitmap is necessary.  Discard the '['. */
336       c = getc (list);
337       line = here;
338       while (c != ']' && c != '\n' && c != EOF)
339         {
340           *here++ = c;
341           c = getc (list);
342         }
343       *here++ = '\0';
344
345       if (c == ']')
346         {
347           c = getc (list);  /* eat what should be a newline */
348           if (c != '\n' && c != EOF)
349             error_at_line (pos, "junk on line after language tag [%s]", line);
350         }
351       else
352         error_at_line (pos, "missing close bracket for language tag [%s", line);
353
354       *herep = here;
355       *linep = line;
356       return true;
357     }
358   else
359     {
360       /* Leave space for a lang_bitmap.  */
361       memset (here, 0, sizeof (lang_bitmap));
362       here += sizeof (lang_bitmap);
363       line = here;
364       do
365         {
366           *here++ = c;
367           c = getc (list);
368         }
369       while (c != EOF && c != '\n');
370       *here++ = '\0';
371       *herep = here;
372       *linep = line;
373       return false;
374     }
375 }
376
377 /* Read the list of input files from LIST and compute all of the
378    relevant tables.  There is one file per line of the list.  At
379    first, all the files on the list are language-generic, but
380    eventually a line will appear which is the name of a language
381    subdirectory in square brackets, like this: [cp].  All subsequent
382    files are specific to that language, until another language
383    subdirectory tag appears.  Files can appear more than once, if
384    they apply to more than one language.  */
385 static void
386 read_input_list (const char *listname)
387 {
388   FILE *list = fopen (listname, "r");
389   if (!list)
390     fatal ("cannot open %s: %s", listname, strerror (errno));
391   else
392     {
393       struct fileloc epos;
394       size_t bufsz = measure_input_list (list);
395       char *buf = XNEWVEC (char, bufsz);
396       char *here = buf;
397       char *committed = buf;
398       char *limit = buf + bufsz;
399       char *line;
400       bool is_language;
401       size_t langno = 0;
402       size_t nfiles = 0;
403       lang_bitmap curlangs = (1 << num_lang_dirs) - 1;
404
405       epos.file = listname;
406       epos.line = 0;
407
408       lang_dir_names = XNEWVEC (const char *, num_lang_dirs);
409       gt_files = XNEWVEC (const char *, num_gt_files);
410
411       for (;;)
412         {
413         next_line:
414           epos.line++;
415           committed = here;
416           is_language = read_input_line (list, &here, &line, &epos);
417           gcc_assert (here <= limit);
418           if (line == 0)
419             break;
420           else if (is_language)
421             {
422               size_t i;
423               gcc_assert (langno <= num_lang_dirs);
424               for (i = 0; i < langno; i++)
425                 if (strcmp (lang_dir_names[i], line) == 0)
426                   {
427                     error_at_line (&epos, "duplicate language tag [%s]", line);
428                     curlangs = 1 << i;
429                     here = committed;
430                     goto next_line;
431                   }
432
433               curlangs = 1 << langno;
434               lang_dir_names[langno++] = line;
435             }
436           else
437             {
438               size_t i;
439               gcc_assert (nfiles <= num_gt_files);
440               for (i = 0; i < nfiles; i++)
441                 if (strcmp (gt_files[i], line) == 0)
442                   {
443                     /* Throw away the string we just read, and add the
444                        current language to the existing string's bitmap.  */
445                     lang_bitmap bmap = get_lang_bitmap (gt_files[i]);
446                     if (bmap & curlangs)
447                       error_at_line (&epos, "file %s specified more than once "
448                                      "for language %s", line, langno == 0
449                                      ? "(all)"
450                                      : lang_dir_names[langno - 1]);
451
452                     bmap |= curlangs;
453                     set_lang_bitmap (CONST_CAST(char *, gt_files[i]), bmap);
454                     here = committed;
455                     goto next_line;
456                   }
457
458               set_lang_bitmap (line, curlangs);
459               gt_files[nfiles++] = line;
460             }
461         }
462       /* Update the global counts now that we know accurately how many
463          things there are.  (We do not bother resizing the arrays down.)  */
464       num_lang_dirs = langno;
465       /* Add the plugin files if provided.  */
466       if (plugin_files)
467         {
468           size_t i;
469           for (i = 0; i < nb_plugin_files; i++)
470             gt_files[nfiles++] = plugin_files[i];
471         }
472       num_gt_files = nfiles;
473     }
474
475   /* Sanity check: any file that resides in a language subdirectory
476      (e.g. 'cp') ought to belong to the corresponding language.
477      ??? Still true if for instance ObjC++ is enabled and C++ isn't?
478      (Can you even do that?  Should you be allowed to?)  */
479   {
480     size_t f;
481     for (f = 0; f < num_gt_files; f++)
482       {
483         lang_bitmap bitmap = get_lang_bitmap (gt_files[f]);
484         const char *basename = get_file_basename (gt_files[f]);
485         const char *slashpos = strchr (basename, '/');
486
487         if (slashpos)
488           {
489             size_t l;
490             for (l = 0; l < num_lang_dirs; l++)
491               if ((size_t)(slashpos - basename) == strlen (lang_dir_names [l])
492                   && memcmp (basename, lang_dir_names[l],
493                              strlen (lang_dir_names[l])) == 0)
494                 {
495                   if (!(bitmap & (1 << l)))
496                     error ("%s is in language directory '%s' but is not "
497                            "tagged for that language",
498                            basename, lang_dir_names[l]);
499                   break;
500                 }
501           }
502       }
503   }
504
505   if (ferror (list))
506     fatal ("error reading %s: %s", listname, strerror (errno));
507
508   fclose (list);
509 }
510
511
512 \f
513 /* The one and only TYPE_STRING.  */
514
515 static struct type string_type = {
516   TYPE_STRING, 0, 0, GC_USED, {0}
517 };
518
519 /* The two and only TYPE_SCALARs.  Their u.scalar_is_char flags are
520    set to appropriate values at the beginning of main.  */
521
522 static struct type scalar_nonchar = {
523   TYPE_SCALAR, 0, 0, GC_USED, {0}
524 };
525 static struct type scalar_char = {
526   TYPE_SCALAR, 0, 0, GC_USED, {0}
527 };
528
529 /* Lists of various things.  */
530
531 static pair_p typedefs;
532 static type_p structures;
533 static type_p param_structs;
534 static pair_p variables;
535
536 static type_p find_param_structure
537   (type_p t, type_p param[NUM_PARAM]);
538 static type_p adjust_field_tree_exp (type_p t, options_p opt);
539 static type_p adjust_field_rtx_def (type_p t, options_p opt);
540
541 /* Define S as a typedef to T at POS.  */
542
543 void
544 do_typedef (const char *s, type_p t, struct fileloc *pos)
545 {
546   pair_p p;
547
548   /* temporary kludge - gengtype doesn't handle conditionals or
549      macros.  Ignore any attempt to typedef CUMULATIVE_ARGS, unless it
550      is coming from this file (main() sets them up with safe dummy
551      definitions).  */
552   if (!strcmp (s, "CUMULATIVE_ARGS") && pos->file != this_file)
553     return;
554
555   for (p = typedefs; p != NULL; p = p->next)
556     if (strcmp (p->name, s) == 0)
557       {
558         if (p->type != t)
559           {
560             error_at_line (pos, "type `%s' previously defined", s);
561             error_at_line (&p->line, "previously defined here");
562           }
563         return;
564       }
565
566   p = XNEW (struct pair);
567   p->next = typedefs;
568   p->name = s;
569   p->type = t;
570   p->line = *pos;
571   typedefs = p;
572 }
573
574 /* Define S as a typename of a scalar.  Cannot be used to define
575    typedefs of 'char'.  Note: is also used for pointer-to-function
576    typedefs (which are therefore not treated as pointers).  */
577
578 void
579 do_scalar_typedef (const char *s, struct fileloc *pos)
580 {
581   do_typedef (s, &scalar_nonchar, pos);
582 }
583
584 /* Return the type previously defined for S.  Use POS to report errors.  */
585
586 type_p
587 resolve_typedef (const char *s, struct fileloc *pos)
588 {
589   pair_p p;
590   for (p = typedefs; p != NULL; p = p->next)
591     if (strcmp (p->name, s) == 0)
592       return p->type;
593   error_at_line (pos, "unidentified type `%s'", s);
594   return &scalar_nonchar;  /* treat as "int" */
595 }
596
597 /* Create and return a new structure with tag NAME (or a union iff
598    ISUNION is nonzero), at POS with fields FIELDS and options O.  */
599
600 type_p
601 new_structure (const char *name, int isunion, struct fileloc *pos,
602                pair_p fields, options_p o)
603 {
604   type_p si;
605   type_p s = NULL;
606   lang_bitmap bitmap = get_lang_bitmap (pos->file);
607
608   /* temporary kludge - gengtype doesn't handle conditionals or
609      macros.  Ignore any attempt to define struct location_s, unless
610      it is coming from this file (main() sets it up safely). */
611   if (!strcmp (name, "location_s") && !isunion
612       && pos->file != this_file)
613     return find_structure (name, 0);
614
615   for (si = structures; si != NULL; si = si->next)
616     if (strcmp (name, si->u.s.tag) == 0
617         && UNION_P (si) == isunion)
618       {
619         type_p ls = NULL;
620         if (si->kind == TYPE_LANG_STRUCT)
621           {
622             ls = si;
623
624             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
625               if (si->u.s.bitmap == bitmap)
626                 s = si;
627           }
628         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
629           {
630             ls = si;
631             si = XCNEW (struct type);
632             memcpy (si, ls, sizeof (struct type));
633             ls->kind = TYPE_LANG_STRUCT;
634             ls->u.s.lang_struct = si;
635             ls->u.s.fields = NULL;
636             si->next = NULL;
637             si->pointer_to = NULL;
638             si->u.s.lang_struct = ls;
639           }
640         else
641           s = si;
642
643         if (ls != NULL && s == NULL)
644           {
645             s = XCNEW (struct type);
646             s->next = ls->u.s.lang_struct;
647             ls->u.s.lang_struct = s;
648             s->u.s.lang_struct = ls;
649           }
650         break;
651       }
652
653   if (s == NULL)
654     {
655       s = XCNEW (struct type);
656       s->next = structures;
657       structures = s;
658     }
659
660   if (s->u.s.line.file != NULL
661       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
662     {
663       error_at_line (pos, "duplicate definition of '%s %s'",
664                      isunion ? "union" : "struct", s->u.s.tag);
665       error_at_line (&s->u.s.line, "previous definition here");
666     }
667
668   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
669   s->u.s.tag = name;
670   s->u.s.line = *pos;
671   s->u.s.fields = fields;
672   s->u.s.opt = o;
673   s->u.s.bitmap = bitmap;
674   if (s->u.s.lang_struct)
675     s->u.s.lang_struct->u.s.bitmap |= bitmap;
676
677   /* Reset location_s's location to input.h so that we know where to
678      write out its mark routine.  */
679   if (!strcmp (name, "location_s") && !isunion
680       && pos->file == this_file)
681     {
682       size_t n;
683       for (n = 0; n < num_gt_files; n++)
684         if (!strcmp (gt_files[n] + strlen (gt_files[n]) - strlen ("input.h"),
685                      "input.h"))
686           {
687             s->u.s.line.file = gt_files[n];
688             break;
689           }
690     }
691
692     return s;
693 }
694
695 /* Return the previously-defined structure with tag NAME (or a union
696    iff ISUNION is nonzero), or a new empty structure or union if none
697    was defined previously.  */
698
699 type_p
700 find_structure (const char *name, int isunion)
701 {
702   type_p s;
703
704   for (s = structures; s != NULL; s = s->next)
705     if (strcmp (name, s->u.s.tag) == 0
706         && UNION_P (s) == isunion)
707       return s;
708
709   s = XCNEW (struct type);
710   s->next = structures;
711   structures = s;
712   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
713   s->u.s.tag = name;
714   structures = s;
715   return s;
716 }
717
718 /* Return the previously-defined parameterized structure for structure
719    T and parameters PARAM, or a new parameterized empty structure or
720    union if none was defined previously.  */
721
722 static type_p
723 find_param_structure (type_p t, type_p param[NUM_PARAM])
724 {
725   type_p res;
726
727   for (res = param_structs; res; res = res->next)
728     if (res->u.param_struct.stru == t
729         && memcmp (res->u.param_struct.param, param,
730                    sizeof (type_p) * NUM_PARAM) == 0)
731       break;
732   if (res == NULL)
733     {
734       res = XCNEW (struct type);
735       res->kind = TYPE_PARAM_STRUCT;
736       res->next = param_structs;
737       param_structs = res;
738       res->u.param_struct.stru = t;
739       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
740     }
741   return res;
742 }
743
744 /* Return a scalar type with name NAME.  */
745
746 type_p
747 create_scalar_type (const char *name)
748 {
749   if (!strcmp (name, "char") || !strcmp (name, "unsigned char"))
750     return &scalar_char;
751   else
752     return &scalar_nonchar;
753 }
754
755 /* Return a pointer to T.  */
756
757 type_p
758 create_pointer (type_p t)
759 {
760   if (! t->pointer_to)
761     {
762       type_p r = XCNEW (struct type);
763       r->kind = TYPE_POINTER;
764       r->u.p = t;
765       t->pointer_to = r;
766     }
767   return t->pointer_to;
768 }
769
770 /* Return an array of length LEN.  */
771
772 type_p
773 create_array (type_p t, const char *len)
774 {
775   type_p v;
776
777   v = XCNEW (struct type);
778   v->kind = TYPE_ARRAY;
779   v->u.a.p = t;
780   v->u.a.len = len;
781   return v;
782 }
783
784 /* Return an options structure with name NAME and info INFO.  NEXT is the
785    next option in the chain.  */
786
787 options_p
788 create_option (options_p next, const char *name, const void *info)
789 {
790   options_p o = XNEW (struct options);
791   o->next = next;
792   o->name = name;
793   o->info = (const char*) info;
794   return o;
795 }
796
797 /* Return an options structure for a "nested_ptr" option.  */
798 options_p
799 create_nested_ptr_option (options_p next, type_p t,
800                           const char *to, const char *from)
801 {
802   struct nested_ptr_data *d = XNEW (struct nested_ptr_data);
803
804   d->type = adjust_field_type (t, 0);
805   d->convert_to = to;
806   d->convert_from = from;
807   return create_option (next, "nested_ptr", d);
808 }
809
810 /* Add a variable named S of type T with options O defined at POS,
811    to `variables'.  */
812
813 void
814 note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
815 {
816   pair_p n;
817   n = XNEW (struct pair);
818   n->name = s;
819   n->type = t;
820   n->line = *pos;
821   n->opt = o;
822   n->next = variables;
823   variables = n;
824 }
825
826 /* Most-general structure field creator.  */
827 static pair_p
828 create_field_all (pair_p next, type_p type, const char *name, options_p opt,
829                   const char *file, int line)
830 {
831   pair_p field;
832
833   field = XNEW (struct pair);
834   field->next = next;
835   field->type = type;
836   field->name = name;
837   field->opt = opt;
838   field->line.file = file;
839   field->line.line = line;
840   return field;
841 }
842
843 /* Create a field that came from the source code we are scanning,
844    i.e. we have a 'struct fileloc', and possibly options; also,
845    adjust_field_type should be called.  */
846 pair_p
847 create_field_at (pair_p next, type_p type, const char *name, options_p opt,
848                  struct fileloc *pos)
849 {
850   return create_field_all (next, adjust_field_type (type, opt),
851                            name, opt, pos->file, pos->line);
852 }
853
854 /* Create a fake field with the given type and name.  NEXT is the next
855    field in the chain.  */
856 #define create_field(next,type,name) \
857     create_field_all(next,type,name, 0, this_file, __LINE__)
858
859 /* Like create_field, but the field is only valid when condition COND
860    is true.  */
861
862 static pair_p
863 create_optional_field_ (pair_p next, type_p type, const char *name,
864                         const char *cond, int line)
865 {
866   static int id = 1;
867   pair_p union_fields;
868   type_p union_type;
869
870   /* Create a fake union type with a single nameless field of type TYPE.
871      The field has a tag of "1".  This allows us to make the presence
872      of a field of type TYPE depend on some boolean "desc" being true.  */
873   union_fields = create_field (NULL, type, "");
874   union_fields->opt = create_option (union_fields->opt, "dot", "");
875   union_fields->opt = create_option (union_fields->opt, "tag", "1");
876   union_type = new_structure (xasprintf ("%s_%d", "fake_union", id++), 1,
877                               &lexer_line, union_fields, NULL);
878
879   /* Create the field and give it the new fake union type.  Add a "desc"
880      tag that specifies the condition under which the field is valid.  */
881   return create_field_all (next, union_type, name,
882                            create_option (0, "desc", cond),
883                            this_file, line);
884 }
885 #define create_optional_field(next,type,name,cond)      \
886        create_optional_field_(next,type,name,cond,__LINE__)
887
888 /* Reverse a linked list of 'struct pair's in place.  */
889 pair_p
890 nreverse_pairs (pair_p list)
891 {
892   pair_p prev = 0, p, next;
893   for (p = list; p; p = next)
894     {
895       next = p->next;
896       p->next = prev;
897       prev = p;
898     }
899   return prev;
900 }
901
902 \f
903 /* We don't care how long a CONST_DOUBLE is.  */
904 #define CONST_DOUBLE_FORMAT "ww"
905 /* We don't want to see codes that are only for generator files.  */
906 #undef GENERATOR_FILE
907
908 enum rtx_code {
909 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS) ENUM ,
910 #include "rtl.def"
911 #undef DEF_RTL_EXPR
912   NUM_RTX_CODE
913 };
914
915 static const char * const rtx_name[NUM_RTX_CODE] = {
916 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
917 #include "rtl.def"
918 #undef DEF_RTL_EXPR
919 };
920
921 static const char * const rtx_format[NUM_RTX_CODE] = {
922 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
923 #include "rtl.def"
924 #undef DEF_RTL_EXPR
925 };
926
927 static int rtx_next_new[NUM_RTX_CODE];
928
929 /* We also need codes and names for insn notes (not register notes).
930    Note that we do *not* bias the note values here.  */
931 enum insn_note {
932 #define DEF_INSN_NOTE(NAME) NAME,
933 #include "insn-notes.def"
934 #undef DEF_INSN_NOTE
935
936   NOTE_INSN_MAX
937 };
938
939 /* We must allocate one more entry here, as we use NOTE_INSN_MAX as the
940    default field for line number notes.  */
941 static const char *const note_insn_name[NOTE_INSN_MAX+1] = {
942 #define DEF_INSN_NOTE(NAME) #NAME,
943 #include "insn-notes.def"
944 #undef DEF_INSN_NOTE
945 };
946
947 #undef CONST_DOUBLE_FORMAT
948 #define GENERATOR_FILE
949
950 /* Generate the contents of the rtx_next array.  This really doesn't belong
951    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
952
953 static void
954 gen_rtx_next (void)
955 {
956   int i;
957   for (i = 0; i < NUM_RTX_CODE; i++)
958     {
959       int k;
960
961       rtx_next_new[i] = -1;
962       if (strncmp (rtx_format[i], "iuu", 3) == 0)
963         rtx_next_new[i] = 2;
964       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
965         rtx_next_new[i] = 1;
966       else
967         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
968           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
969             rtx_next_new[i] = k;
970     }
971 }
972
973 /* Write out the contents of the rtx_next array.  */
974 static void
975 write_rtx_next (void)
976 {
977   outf_p f = get_output_file_with_visibility (NULL);
978   int i;
979   if (!f)
980     return;
981
982   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
983   oprintf (f, "EXPORTED_CONST unsigned char rtx_next[NUM_RTX_CODE] = {\n");
984   for (i = 0; i < NUM_RTX_CODE; i++)
985     if (rtx_next_new[i] == -1)
986       oprintf (f, "  0,\n");
987     else
988       oprintf (f,
989                "  RTX_HDR_SIZE + %d * sizeof (rtunion),\n",
990                rtx_next_new[i]);
991   oprintf (f, "};\n");
992 }
993
994 /* Handle `special("rtx_def")'.  This is a special case for field
995    `fld' of struct rtx_def, which is an array of unions whose values
996    are based in a complex way on the type of RTL.  */
997
998 static type_p
999 adjust_field_rtx_def (type_p t, options_p ARG_UNUSED (opt))
1000 {
1001   pair_p flds = NULL;
1002   options_p nodot;
1003   int i;
1004   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
1005   type_p bitmap_tp, basic_block_tp, reg_attrs_tp, constant_tp, symbol_union_tp;
1006
1007   if (t->kind != TYPE_UNION)
1008     {
1009       error_at_line (&lexer_line,
1010                      "special `rtx_def' must be applied to a union");
1011       return &string_type;
1012     }
1013
1014   nodot = create_option (NULL, "dot", "");
1015
1016   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
1017   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
1018   tree_tp = create_pointer (find_structure ("tree_node", 1));
1019   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
1020   reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
1021   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
1022   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
1023   constant_tp = create_pointer (find_structure ("constant_descriptor_rtx", 0));
1024   scalar_tp = &scalar_nonchar;  /* rtunion int */
1025
1026   {
1027     pair_p note_flds = NULL;
1028     int c;
1029
1030     for (c = 0; c <= NOTE_INSN_MAX; c++)
1031       {
1032         switch (c)
1033           {
1034           case NOTE_INSN_MAX:
1035           case NOTE_INSN_DELETED_LABEL:
1036             note_flds = create_field (note_flds, &string_type, "rt_str");
1037             break;
1038
1039           case NOTE_INSN_BLOCK_BEG:
1040           case NOTE_INSN_BLOCK_END:
1041             note_flds = create_field (note_flds, tree_tp, "rt_tree");
1042             break;
1043
1044           case NOTE_INSN_VAR_LOCATION:
1045             note_flds = create_field (note_flds, rtx_tp, "rt_rtx");
1046             break;
1047
1048           default:
1049             note_flds = create_field (note_flds, scalar_tp, "rt_int");
1050             break;
1051           }
1052         /* NOTE_INSN_MAX is used as the default field for line
1053            number notes.  */
1054         if (c == NOTE_INSN_MAX)
1055           note_flds->opt = create_option (nodot, "default", "");
1056         else
1057           note_flds->opt = create_option (nodot, "tag", note_insn_name[c]);
1058       }
1059     note_union_tp = new_structure ("rtx_def_note_subunion", 1,
1060                                    &lexer_line, note_flds, NULL);
1061   }
1062   /* Create a type to represent the various forms of SYMBOL_REF_DATA.  */
1063   {
1064     pair_p sym_flds;
1065
1066     sym_flds = create_field (NULL, tree_tp, "rt_tree");
1067     sym_flds->opt = create_option (nodot, "default", "");
1068
1069     sym_flds = create_field (sym_flds, constant_tp, "rt_constant");
1070     sym_flds->opt = create_option (nodot, "tag", "1");
1071
1072     symbol_union_tp = new_structure ("rtx_def_symbol_subunion", 1,
1073                                      &lexer_line, sym_flds, NULL);
1074   }
1075   for (i = 0; i < NUM_RTX_CODE; i++)
1076     {
1077       pair_p subfields = NULL;
1078       size_t aindex, nmindex;
1079       const char *sname;
1080       type_p substruct;
1081       char *ftag;
1082
1083       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
1084         {
1085           type_p t;
1086           const char *subname;
1087
1088           switch (rtx_format[i][aindex])
1089             {
1090             case '*':
1091             case 'i':
1092             case 'n':
1093             case 'w':
1094               t = scalar_tp;
1095               subname = "rt_int";
1096               break;
1097
1098             case '0':
1099               if (i == MEM && aindex == 1)
1100                 t = mem_attrs_tp, subname = "rt_mem";
1101               else if (i == JUMP_INSN && aindex == 8)
1102                 t = rtx_tp, subname = "rt_rtx";
1103               else if (i == CODE_LABEL && aindex == 4)
1104                 t = scalar_tp, subname = "rt_int";
1105               else if (i == CODE_LABEL && aindex == 5)
1106                 t = rtx_tp, subname = "rt_rtx";
1107               else if (i == LABEL_REF
1108                        && (aindex == 1 || aindex == 2))
1109                 t = rtx_tp, subname = "rt_rtx";
1110               else if (i == NOTE && aindex == 4)
1111                 t = note_union_tp, subname = "";
1112               else if (i == NOTE && aindex == 5)
1113                 t = scalar_tp, subname = "rt_int";
1114               else if (i == NOTE && aindex >= 7)
1115                 t = scalar_tp, subname = "rt_int";
1116               else if (i == ADDR_DIFF_VEC && aindex == 4)
1117                 t = scalar_tp, subname = "rt_int";
1118               else if (i == VALUE && aindex == 0)
1119                 t = scalar_tp, subname = "rt_int";
1120               else if (i == DEBUG_EXPR && aindex == 0)
1121                 t = tree_tp, subname = "rt_tree";
1122               else if (i == REG && aindex == 1)
1123                 t = scalar_tp, subname = "rt_int";
1124               else if (i == REG && aindex == 2)
1125                 t = reg_attrs_tp, subname = "rt_reg";
1126               else if (i == SCRATCH && aindex == 0)
1127                 t = scalar_tp, subname = "rt_int";
1128               else if (i == SYMBOL_REF && aindex == 1)
1129                 t = scalar_tp, subname = "rt_int";
1130               else if (i == SYMBOL_REF && aindex == 2)
1131                 t = symbol_union_tp, subname = "";
1132               else if (i == BARRIER && aindex >= 3)
1133                 t = scalar_tp, subname = "rt_int";
1134               else
1135                 {
1136                   error_at_line (&lexer_line,
1137                         "rtx type `%s' has `0' in position %lu, can't handle",
1138                                  rtx_name[i], (unsigned long) aindex);
1139                   t = &string_type;
1140                   subname = "rt_int";
1141                 }
1142               break;
1143
1144             case 's':
1145             case 'S':
1146             case 'T':
1147               t = &string_type;
1148               subname = "rt_str";
1149               break;
1150
1151             case 'e':
1152             case 'u':
1153               t = rtx_tp;
1154               subname = "rt_rtx";
1155               break;
1156
1157             case 'E':
1158             case 'V':
1159               t = rtvec_tp;
1160               subname = "rt_rtvec";
1161               break;
1162
1163             case 't':
1164               t = tree_tp;
1165               subname = "rt_tree";
1166               break;
1167
1168             case 'b':
1169               t = bitmap_tp;
1170               subname = "rt_bit";
1171               break;
1172
1173             case 'B':
1174               t = basic_block_tp;
1175               subname = "rt_bb";
1176               break;
1177
1178             default:
1179               error_at_line (&lexer_line,
1180                      "rtx type `%s' has `%c' in position %lu, can't handle",
1181                              rtx_name[i], rtx_format[i][aindex],
1182                              (unsigned long)aindex);
1183               t = &string_type;
1184               subname = "rt_int";
1185               break;
1186             }
1187
1188           subfields = create_field (subfields, t,
1189                                     xasprintf (".fld[%lu].%s",
1190                                                (unsigned long) aindex,
1191                                                subname));
1192           subfields->opt = nodot;
1193           if (t == note_union_tp)
1194             subfields->opt = create_option (subfields->opt, "desc",
1195                                             "NOTE_KIND (&%0)");
1196           if (t == symbol_union_tp)
1197             subfields->opt = create_option (subfields->opt, "desc",
1198                                             "CONSTANT_POOL_ADDRESS_P (&%0)");
1199         }
1200
1201       if (i == SYMBOL_REF)
1202         {
1203           /* Add the "block_sym" field if SYMBOL_REF_HAS_BLOCK_INFO_P holds.  */
1204           type_p field_tp = find_structure ("block_symbol", 0);
1205           subfields
1206             = create_optional_field (subfields, field_tp, "block_sym",
1207                                      "SYMBOL_REF_HAS_BLOCK_INFO_P (&%0)");
1208         }
1209
1210       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
1211       substruct = new_structure (sname, 0, &lexer_line, subfields, NULL);
1212
1213       ftag = xstrdup (rtx_name[i]);
1214       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
1215         ftag[nmindex] = TOUPPER (ftag[nmindex]);
1216
1217       flds = create_field (flds, substruct, "");
1218       flds->opt = create_option (nodot, "tag", ftag);
1219     }
1220
1221   return new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
1222 }
1223
1224 /* Handle `special("tree_exp")'.  This is a special case for
1225    field `operands' of struct tree_exp, which although it claims to contain
1226    pointers to trees, actually sometimes contains pointers to RTL too.
1227    Passed T, the old type of the field, and OPT its options.  Returns
1228    a new type for the field.  */
1229
1230 static type_p
1231 adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
1232 {
1233   pair_p flds;
1234   options_p nodot;
1235
1236   if (t->kind != TYPE_ARRAY)
1237     {
1238       error_at_line (&lexer_line,
1239                      "special `tree_exp' must be applied to an array");
1240       return &string_type;
1241     }
1242
1243   nodot = create_option (NULL, "dot", "");
1244
1245   flds = create_field (NULL, t, "");
1246   flds->opt = create_option (nodot, "length",
1247                              "TREE_OPERAND_LENGTH ((tree) &%0)");
1248   flds->opt = create_option (flds->opt, "default", "");
1249
1250   return new_structure ("tree_exp_subunion", 1, &lexer_line, flds, nodot);
1251 }
1252
1253 /* Perform any special processing on a type T, about to become the type
1254    of a field.  Return the appropriate type for the field.
1255    At present:
1256    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
1257    - Similarly for arrays of pointer-to-char;
1258    - Converts structures for which a parameter is provided to
1259      TYPE_PARAM_STRUCT;
1260    - Handles "special" options.
1261 */
1262
1263 type_p
1264 adjust_field_type (type_p t, options_p opt)
1265 {
1266   int length_p = 0;
1267   const int pointer_p = t->kind == TYPE_POINTER;
1268   type_p params[NUM_PARAM];
1269   int params_p = 0;
1270   int i;
1271
1272   for (i = 0; i < NUM_PARAM; i++)
1273     params[i] = NULL;
1274
1275   for (; opt; opt = opt->next)
1276     if (strcmp (opt->name, "length") == 0)
1277       length_p = 1;
1278     else if (strcmp (opt->name, "param_is") == 0
1279              || (strncmp (opt->name, "param", 5) == 0
1280                  && ISDIGIT (opt->name[5])
1281                  && strcmp (opt->name + 6, "_is") == 0))
1282       {
1283         int num = ISDIGIT (opt->name[5]) ? opt->name[5] - '0' : 0;
1284
1285         if (! UNION_OR_STRUCT_P (t)
1286             && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
1287           {
1288             error_at_line (&lexer_line,
1289    "option `%s' may only be applied to structures or structure pointers",
1290                            opt->name);
1291             return t;
1292           }
1293
1294         params_p = 1;
1295         if (params[num] != NULL)
1296           error_at_line (&lexer_line, "duplicate `%s' option", opt->name);
1297         if (! ISDIGIT (opt->name[5]))
1298           params[num] = create_pointer (CONST_CAST2(type_p, const char *, opt->info));
1299         else
1300           params[num] = CONST_CAST2 (type_p, const char *, opt->info);
1301       }
1302     else if (strcmp (opt->name, "special") == 0)
1303       {
1304         const char *special_name = opt->info;
1305         if (strcmp (special_name, "tree_exp") == 0)
1306           t = adjust_field_tree_exp (t, opt);
1307         else if (strcmp (special_name, "rtx_def") == 0)
1308           t = adjust_field_rtx_def (t, opt);
1309         else
1310           error_at_line (&lexer_line, "unknown special `%s'", special_name);
1311       }
1312
1313   if (params_p)
1314     {
1315       type_p realt;
1316
1317       if (pointer_p)
1318         t = t->u.p;
1319       realt = find_param_structure (t, params);
1320       t = pointer_p ? create_pointer (realt) : realt;
1321     }
1322
1323   if (! length_p
1324       && pointer_p
1325       && t->u.p->kind == TYPE_SCALAR
1326       && t->u.p->u.scalar_is_char)
1327     return &string_type;
1328   if (t->kind == TYPE_ARRAY && t->u.a.p->kind == TYPE_POINTER
1329       && t->u.a.p->u.p->kind == TYPE_SCALAR
1330       && t->u.a.p->u.p->u.scalar_is_char)
1331     return create_array (&string_type, t->u.a.len);
1332
1333   return t;
1334 }
1335
1336 \f
1337 static void set_gc_used_type (type_p, enum gc_used_enum, type_p *);
1338 static void set_gc_used (pair_p);
1339
1340 /* Handle OPT for set_gc_used_type.  */
1341
1342 static void
1343 process_gc_options (options_p opt, enum gc_used_enum level, int *maybe_undef,
1344                     int *pass_param, int *length, int *skip, type_p *nested_ptr)
1345 {
1346   options_p o;
1347   for (o = opt; o; o = o->next)
1348     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
1349       set_gc_used_type (CONST_CAST2 (type_p, const char *, o->info),
1350                         GC_POINTED_TO, NULL);
1351     else if (strcmp (o->name, "maybe_undef") == 0)
1352       *maybe_undef = 1;
1353     else if (strcmp (o->name, "use_params") == 0)
1354       *pass_param = 1;
1355     else if (strcmp (o->name, "length") == 0)
1356       *length = 1;
1357     else if (strcmp (o->name, "skip") == 0)
1358       *skip = 1;
1359     else if (strcmp (o->name, "nested_ptr") == 0)
1360       *nested_ptr = ((const struct nested_ptr_data *) o->info)->type;
1361 }
1362
1363 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
1364
1365 static void
1366 set_gc_used_type (type_p t, enum gc_used_enum level, type_p param[NUM_PARAM])
1367 {
1368   if (t->gc_used >= level)
1369     return;
1370
1371   t->gc_used = level;
1372
1373   switch (t->kind)
1374     {
1375     case TYPE_STRUCT:
1376     case TYPE_UNION:
1377       {
1378         pair_p f;
1379         int dummy;
1380         type_p dummy2;
1381
1382         process_gc_options (t->u.s.opt, level, &dummy, &dummy, &dummy, &dummy,
1383                             &dummy2);
1384
1385         for (f = t->u.s.fields; f; f = f->next)
1386           {
1387             int maybe_undef = 0;
1388             int pass_param = 0;
1389             int length = 0;
1390             int skip = 0;
1391             type_p nested_ptr = NULL;
1392             process_gc_options (f->opt, level, &maybe_undef, &pass_param,
1393                                 &length, &skip, &nested_ptr);
1394
1395             if (nested_ptr && f->type->kind == TYPE_POINTER)
1396               set_gc_used_type (nested_ptr, GC_POINTED_TO,
1397                                 pass_param ? param : NULL);
1398             else if (length && f->type->kind == TYPE_POINTER)
1399               set_gc_used_type (f->type->u.p, GC_USED, NULL);
1400             else if (maybe_undef && f->type->kind == TYPE_POINTER)
1401               set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO, NULL);
1402             else if (pass_param && f->type->kind == TYPE_POINTER && param)
1403               set_gc_used_type (find_param_structure (f->type->u.p, param),
1404                                 GC_POINTED_TO, NULL);
1405             else if (skip)
1406               ; /* target type is not used through this field */
1407             else
1408               set_gc_used_type (f->type, GC_USED, pass_param ? param : NULL);
1409           }
1410         break;
1411       }
1412
1413     case TYPE_POINTER:
1414       set_gc_used_type (t->u.p, GC_POINTED_TO, NULL);
1415       break;
1416
1417     case TYPE_ARRAY:
1418       set_gc_used_type (t->u.a.p, GC_USED, param);
1419       break;
1420
1421     case TYPE_LANG_STRUCT:
1422       for (t = t->u.s.lang_struct; t; t = t->next)
1423         set_gc_used_type (t, level, param);
1424       break;
1425
1426     case TYPE_PARAM_STRUCT:
1427       {
1428         int i;
1429         for (i = 0; i < NUM_PARAM; i++)
1430           if (t->u.param_struct.param[i] != 0)
1431             set_gc_used_type (t->u.param_struct.param[i], GC_USED, NULL);
1432       }
1433       if (t->u.param_struct.stru->gc_used == GC_POINTED_TO)
1434         level = GC_POINTED_TO;
1435       else
1436         level = GC_USED;
1437       t->u.param_struct.stru->gc_used = GC_UNUSED;
1438       set_gc_used_type (t->u.param_struct.stru, level,
1439                         t->u.param_struct.param);
1440       break;
1441
1442     default:
1443       break;
1444     }
1445 }
1446
1447 /* Set the gc_used fields of all the types pointed to by VARIABLES.  */
1448
1449 static void
1450 set_gc_used (pair_p variables)
1451 {
1452   pair_p p;
1453   for (p = variables; p; p = p->next)
1454     set_gc_used_type (p->type, GC_USED, NULL);
1455 }
1456 \f
1457 /* File mapping routines.  For each input file, there is one output .c file
1458    (but some output files have many input files), and there is one .h file
1459    for the whole build.  */
1460
1461 /* Output file handling.  */
1462
1463 /* Create and return an outf_p for a new file for NAME, to be called
1464    ONAME.  */
1465
1466 static outf_p
1467 create_file (const char *name, const char *oname)
1468 {
1469   static const char *const hdr[] = {
1470     "   Copyright (C) 2004, 2007, 2009 Free Software Foundation, Inc.\n",
1471     "\n",
1472     "This file is part of GCC.\n",
1473     "\n",
1474     "GCC is free software; you can redistribute it and/or modify it under\n",
1475     "the terms of the GNU General Public License as published by the Free\n",
1476     "Software Foundation; either version 3, or (at your option) any later\n",
1477     "version.\n",
1478     "\n",
1479     "GCC is distributed in the hope that it will be useful, but WITHOUT ANY\n",
1480     "WARRANTY; without even the implied warranty of MERCHANTABILITY or\n",
1481     "FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License\n",
1482     "for more details.\n",
1483     "\n",
1484     "You should have received a copy of the GNU General Public License\n",
1485     "along with GCC; see the file COPYING3.  If not see\n",
1486     "<http://www.gnu.org/licenses/>.  */\n",
1487     "\n",
1488     "/* This file is machine generated.  Do not edit.  */\n"
1489   };
1490   outf_p f;
1491   size_t i;
1492
1493   gcc_assert (name != NULL);
1494   gcc_assert (oname != NULL);
1495   f = XCNEW (struct outf);
1496   f->next = output_files;
1497   f->name = oname;
1498   output_files = f;
1499
1500   oprintf (f, "/* Type information for %s.\n", name);
1501   for (i = 0; i < ARRAY_SIZE (hdr); i++)
1502     oprintf (f, "%s", hdr[i]);
1503   return f;
1504 }
1505
1506 /* Print, like fprintf, to O.
1507    N.B. You might think this could be implemented more efficiently
1508    with vsnprintf().  Unfortunately, there are C libraries that
1509    provide that function but without the C99 semantics for its return
1510    value, making it impossible to know how much space is required.  */
1511 void
1512 oprintf (outf_p o, const char *format, ...)
1513 {
1514   char *s;
1515   size_t slength;
1516   va_list ap;
1517
1518   /* In plugin mode, the O could be a NULL pointer, so avoid crashing
1519      in that case.  */
1520   if (!o)
1521     return;
1522
1523   va_start (ap, format);
1524   slength = vasprintf (&s, format, ap);
1525   if (s == NULL || (int)slength < 0)
1526     fatal ("out of memory");
1527   va_end (ap);
1528
1529   if (o->bufused + slength > o->buflength)
1530     {
1531       size_t new_len = o->buflength;
1532       if (new_len == 0)
1533         new_len = 1024;
1534       do {
1535         new_len *= 2;
1536       } while (o->bufused + slength >= new_len);
1537       o->buf = XRESIZEVEC (char, o->buf, new_len);
1538       o->buflength = new_len;
1539     }
1540   memcpy (o->buf + o->bufused, s, slength);
1541   o->bufused += slength;
1542   free (s);
1543 }
1544
1545 /* Open the global header file and the language-specific header files.  */
1546
1547 static void
1548 open_base_files (void)
1549 {
1550   size_t i;
1551
1552   if (nb_plugin_files > 0 && plugin_files)
1553     return;
1554
1555   header_file = create_file ("GCC", "gtype-desc.h");
1556
1557   base_files = XNEWVEC (outf_p, num_lang_dirs);
1558
1559   for (i = 0; i < num_lang_dirs; i++)
1560     base_files[i] = create_file (lang_dir_names[i],
1561                                  xasprintf ("gtype-%s.h", lang_dir_names[i]));
1562
1563   /* gtype-desc.c is a little special, so we create it here.  */
1564   {
1565     /* The order of files here matters very much.  */
1566     static const char *const ifiles [] = {
1567       "config.h", "system.h", "coretypes.h", "tm.h",
1568       "hashtab.h", "splay-tree.h",  "obstack.h", "bitmap.h", "input.h",
1569       "tree.h", "rtl.h", "function.h", "insn-config.h", "expr.h",
1570       "hard-reg-set.h", "basic-block.h", "cselib.h", "insn-addr.h",
1571       "optabs.h", "libfuncs.h", "debug.h", "ggc.h", "cgraph.h",
1572       "tree-flow.h", "reload.h", "cpp-id-data.h", "tree-chrec.h",
1573       "cfglayout.h", "except.h", "output.h", "gimple.h", "cfgloop.h",
1574       "target.h", "ipa-prop.h", "lto-streamer.h", NULL
1575     };
1576     const char *const *ifp;
1577     outf_p gtype_desc_c;
1578
1579     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
1580     for (ifp = ifiles; *ifp; ifp++)
1581       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
1582
1583     /* Make sure we handle "cfun" specially.  */
1584     oprintf (gtype_desc_c, "\n/* See definition in function.h.  */\n");
1585     oprintf (gtype_desc_c, "#undef cfun\n");
1586   }
1587 }
1588
1589 /* For F a filename, return the real basename of F, with all the directory
1590    components skipped.  */
1591
1592 static const char *
1593 get_file_realbasename (const char *f)
1594 {
1595   const char * lastslash = strrchr (f, '/');
1596
1597   return (lastslash != NULL) ? lastslash + 1 : f;
1598 }
1599
1600 /* For F a filename, return the relative path to F from $(srcdir) if the
1601    latter is a prefix in F, NULL otherwise.  */
1602
1603 static const char *
1604 get_file_srcdir_relative_path (const char *f)
1605 {
1606   if (strlen (f) > srcdir_len
1607       && IS_DIR_SEPARATOR (f[srcdir_len])
1608       && memcmp (f, srcdir, srcdir_len) == 0)
1609     return f + srcdir_len + 1;
1610   else
1611     return NULL;
1612 }
1613
1614 /* For F a filename, return the relative path to F from $(srcdir) if the
1615    latter is a prefix in F, or the real basename of F otherwise.  */
1616
1617 static const char *
1618 get_file_basename (const char *f)
1619 {
1620   const char * srcdir_path = get_file_srcdir_relative_path (f);
1621
1622   return (srcdir_path != NULL) ? srcdir_path : get_file_realbasename (f);
1623 }
1624
1625 /* For F a filename, return the lang_dir_names relative index of the language
1626    directory that is a prefix in F, if any, -1 otherwise.  */
1627
1628 static int
1629 get_prefix_langdir_index (const char *f)
1630 {
1631   size_t f_len = strlen (f);
1632   size_t lang_index;
1633
1634   for (lang_index = 0; lang_index < num_lang_dirs; lang_index++)
1635     {
1636       const char * langdir = lang_dir_names [lang_index];
1637       size_t langdir_len = strlen (langdir);
1638
1639       if (f_len > langdir_len
1640           && IS_DIR_SEPARATOR (f[langdir_len])
1641           && memcmp (f, langdir, langdir_len) == 0)
1642         return lang_index;
1643     }
1644
1645   return -1;
1646 }
1647
1648 /* For F a filename, return the name of language directory where F is located,
1649    if any, NULL otherwise.  */
1650
1651 static const char *
1652 get_file_langdir (const char *f)
1653 {
1654   /* Get the relative path to F from $(srcdir) and find the language by
1655      comparing the prefix with language directory names.  If F is not even
1656      srcdir relative, no point in looking further.  */
1657
1658   int lang_index;
1659   const char * srcdir_relative_path = get_file_srcdir_relative_path (f);
1660
1661   if (!srcdir_relative_path)
1662     return NULL;
1663
1664   lang_index = get_prefix_langdir_index (srcdir_relative_path);
1665
1666   return (lang_index >= 0) ? lang_dir_names [lang_index] : NULL;
1667 }
1668
1669 /* The gt- output file name for F.  */
1670
1671 static const char *
1672 get_file_gtfilename (const char *f)
1673 {
1674   /* Cook up an initial version of the gt- file name from the file real
1675      basename and the language name, if any.  */
1676
1677   const char *basename = get_file_realbasename (f);
1678   const char *langdir = get_file_langdir (f);
1679
1680   char * result =
1681     (langdir ? xasprintf ("gt-%s-%s", langdir, basename)
1682      : xasprintf ("gt-%s", basename));
1683
1684   /* Then replace all non alphanumerics characters by '-' and change the
1685      extenstion to ".h".  We expect the input filename extension was at least
1686      one character long.  */
1687
1688   char *s = result;
1689
1690   for (; *s != '.'; s++)
1691     if (! ISALNUM (*s) && *s != '-')
1692       *s = '-';
1693
1694   memcpy (s, ".h", sizeof (".h"));
1695
1696   return result;
1697 }
1698
1699 /* An output file, suitable for definitions, that can see declarations
1700    made in INPUT_FILE and is linked into every language that uses
1701    INPUT_FILE.  */
1702
1703 outf_p
1704 get_output_file_with_visibility (const char *input_file)
1705 {
1706   outf_p r;
1707   size_t len;
1708   const char *basename;
1709   const char *for_name;
1710   const char *output_name;
1711
1712   /* This can happen when we need a file with visibility on a
1713      structure that we've never seen.  We have to just hope that it's
1714      globally visible.  */
1715   if (input_file == NULL)
1716     input_file = "system.h";
1717
1718   /* In plugin mode, return NULL unless the input_file is one of the
1719      plugin_files.  */
1720   if (plugin_files)
1721     {
1722       size_t i;
1723       for (i = 0; i < nb_plugin_files; i++)
1724         if (strcmp (input_file, plugin_files[i]) == 0)
1725           return plugin_output;
1726
1727       return NULL;
1728     }
1729
1730   /* Determine the output file name.  */
1731   basename = get_file_basename (input_file);
1732
1733   len = strlen (basename);
1734   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
1735       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
1736       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
1737     {
1738       output_name = get_file_gtfilename (input_file);
1739       for_name = basename;
1740     }
1741   /* Some headers get used by more than one front-end; hence, it
1742      would be inappropriate to spew them out to a single gtype-<lang>.h
1743      (and gengtype doesn't know how to direct spewage into multiple
1744      gtype-<lang>.h headers at this time).  Instead, we pair up these
1745      headers with source files (and their special purpose gt-*.h headers).  */
1746   else if (strcmp (basename, "c-common.h") == 0)
1747     output_name = "gt-c-common.h", for_name = "c-common.c";
1748   else if (strcmp (basename, "c-lang.h") == 0)
1749     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1750   else if (strcmp (basename, "c-tree.h") == 0)
1751     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1752   else if (strncmp (basename, "cp", 2) == 0 && IS_DIR_SEPARATOR (basename[2])
1753            && strcmp (basename + 3, "cp-tree.h") == 0)
1754     output_name = "gt-cp-tree.h", for_name = "cp/tree.c";
1755   else if (strncmp (basename, "cp", 2) == 0 && IS_DIR_SEPARATOR (basename[2])
1756            && strcmp (basename + 3, "decl.h") == 0)
1757     output_name = "gt-cp-decl.h", for_name = "cp/decl.c";
1758   else if (strncmp (basename, "cp", 2) == 0 && IS_DIR_SEPARATOR (basename[2])
1759            && strcmp (basename + 3, "name-lookup.h") == 0)
1760     output_name = "gt-cp-name-lookup.h", for_name = "cp/name-lookup.c";
1761   else if (strncmp (basename, "objc", 4) == 0 && IS_DIR_SEPARATOR (basename[4])
1762            && strcmp (basename + 5, "objc-act.h") == 0)
1763     output_name = "gt-objc-objc-act.h", for_name = "objc/objc-act.c";
1764   else
1765     {
1766       int lang_index = get_prefix_langdir_index (basename);
1767
1768       if (lang_index >= 0)
1769         return base_files[lang_index];
1770
1771       output_name = "gtype-desc.c";
1772       for_name = NULL;
1773     }
1774
1775   /* Look through to see if we've ever seen this output filename before.  */
1776   for (r = output_files; r; r = r->next)
1777     if (strcmp (r->name, output_name) == 0)
1778       return r;
1779
1780   /* If not, create it.  */
1781   r = create_file (for_name, output_name);
1782
1783   gcc_assert (r && r->name);
1784   return r;
1785 }
1786
1787 /* The name of an output file, suitable for definitions, that can see
1788    declarations made in INPUT_FILE and is linked into every language
1789    that uses INPUT_FILE.  */
1790
1791 const char *
1792 get_output_file_name (const char *input_file)
1793 {
1794   outf_p o =  get_output_file_with_visibility (input_file);
1795   if (o)
1796     return o->name;
1797   return NULL;
1798 }
1799
1800 /* Check if existing file is equal to the in memory buffer. */
1801
1802 static bool
1803 is_file_equal (outf_p of)
1804 {
1805   FILE *newfile = fopen (of->name, "r");
1806   size_t i;
1807   bool equal;
1808   if (newfile == NULL)
1809     return false;
1810
1811   equal = true;
1812   for (i = 0; i < of->bufused; i++)
1813     {
1814       int ch;
1815       ch = fgetc (newfile);
1816       if (ch == EOF || ch != (unsigned char) of->buf[i])
1817         {
1818           equal = false;
1819           break;
1820         }
1821     }
1822   fclose (newfile);
1823   return equal;
1824 }
1825
1826 /* Copy the output to its final destination,
1827    but don't unnecessarily change modification times.  */
1828
1829 static void
1830 close_output_files (void)
1831 {
1832   outf_p of;
1833
1834   for (of = output_files; of; of = of->next)
1835     {
1836
1837       if (!is_file_equal(of))
1838       {
1839         FILE *newfile = fopen (of->name, "w");
1840         if (newfile == NULL)
1841           fatal ("opening output file %s: %s", of->name, strerror (errno));
1842         if (fwrite (of->buf, 1, of->bufused, newfile) != of->bufused)
1843           fatal ("writing output file %s: %s", of->name, strerror (errno));
1844         if (fclose (newfile) != 0)
1845           fatal ("closing output file %s: %s", of->name, strerror (errno));
1846       }
1847       free(of->buf);
1848       of->buf = NULL;
1849       of->bufused = of->buflength = 0;
1850     }
1851 }
1852 \f
1853 struct flist {
1854   struct flist *next;
1855   int started_p;
1856   const char *name;
1857   outf_p f;
1858 };
1859
1860 struct walk_type_data;
1861
1862 /* For scalars and strings, given the item in 'val'.
1863    For structures, given a pointer to the item in 'val'.
1864    For misc. pointers, given the item in 'val'.
1865 */
1866 typedef void (*process_field_fn)
1867      (type_p f, const struct walk_type_data *p);
1868 typedef void (*func_name_fn)
1869      (type_p s, const struct walk_type_data *p);
1870
1871 /* Parameters for write_types.  */
1872
1873 struct write_types_data
1874 {
1875   const char *prefix;
1876   const char *param_prefix;
1877   const char *subfield_marker_routine;
1878   const char *marker_routine;
1879   const char *reorder_note_routine;
1880   const char *comment;
1881   int skip_hooks;               /* skip hook generation if non zero */
1882 };
1883
1884 static void output_escaped_param (struct walk_type_data *d,
1885                                   const char *, const char *);
1886 static void output_mangled_typename (outf_p, const_type_p);
1887 static void walk_type (type_p t, struct walk_type_data *d);
1888 static void write_func_for_structure
1889      (type_p orig_s, type_p s, type_p * param,
1890       const struct write_types_data *wtd);
1891 static void write_types_process_field
1892      (type_p f, const struct walk_type_data *d);
1893 static void write_types (outf_p output_header,
1894                          type_p structures,
1895                          type_p param_structs,
1896                          const struct write_types_data *wtd);
1897 static void write_types_local_process_field
1898      (type_p f, const struct walk_type_data *d);
1899 static void write_local_func_for_structure
1900      (type_p orig_s, type_p s, type_p * param);
1901 static void write_local (outf_p output_header,
1902                          type_p structures,
1903                          type_p param_structs);
1904 static void write_enum_defn (type_p structures, type_p param_structs);
1905 static int contains_scalar_p (type_p t);
1906 static void put_mangled_filename (outf_p , const char *);
1907 static void finish_root_table (struct flist *flp, const char *pfx,
1908                                const char *tname, const char *lastname,
1909                                const char *name);
1910 static void write_root (outf_p , pair_p, type_p, const char *, int,
1911                         struct fileloc *, const char *, bool);
1912 static void write_array (outf_p f, pair_p v,
1913                          const struct write_types_data *wtd);
1914 static void write_roots (pair_p, bool);
1915
1916 /* Parameters for walk_type.  */
1917
1918 struct walk_type_data
1919 {
1920   process_field_fn process_field;
1921   const void *cookie;
1922   outf_p of;
1923   options_p opt;
1924   const char *val;
1925   const char *prev_val[4];
1926   int indent;
1927   int counter;
1928   struct fileloc *line;
1929   lang_bitmap bitmap;
1930   type_p *param;
1931   int used_length;
1932   type_p orig_s;
1933   const char *reorder_fn;
1934   bool needs_cast_p;
1935   bool fn_wants_lvalue;
1936 };
1937
1938 /* Print a mangled name representing T to OF.  */
1939
1940 static void
1941 output_mangled_typename (outf_p of, const_type_p t)
1942 {
1943   if (t == NULL)
1944     oprintf (of, "Z");
1945   else switch (t->kind)
1946     {
1947     case TYPE_POINTER:
1948       oprintf (of, "P");
1949       output_mangled_typename (of, t->u.p);
1950       break;
1951     case TYPE_SCALAR:
1952       oprintf (of, "I");
1953       break;
1954     case TYPE_STRING:
1955       oprintf (of, "S");
1956       break;
1957     case TYPE_STRUCT:
1958     case TYPE_UNION:
1959     case TYPE_LANG_STRUCT:
1960       oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
1961       break;
1962     case TYPE_PARAM_STRUCT:
1963       {
1964         int i;
1965         for (i = 0; i < NUM_PARAM; i++)
1966           if (t->u.param_struct.param[i] != NULL)
1967             output_mangled_typename (of, t->u.param_struct.param[i]);
1968         output_mangled_typename (of, t->u.param_struct.stru);
1969       }
1970       break;
1971     case TYPE_ARRAY:
1972       gcc_unreachable ();
1973     }
1974 }
1975
1976 /* Print PARAM to D->OF processing escapes.  D->VAL references the
1977    current object, D->PREV_VAL the object containing the current
1978    object, ONAME is the name of the option and D->LINE is used to
1979    print error messages.  */
1980
1981 static void
1982 output_escaped_param (struct walk_type_data *d, const char *param,
1983                       const char *oname)
1984 {
1985   const char *p;
1986
1987   for (p = param; *p; p++)
1988     if (*p != '%')
1989       oprintf (d->of, "%c", *p);
1990     else switch (*++p)
1991       {
1992       case 'h':
1993         oprintf (d->of, "(%s)", d->prev_val[2]);
1994         break;
1995       case '0':
1996         oprintf (d->of, "(%s)", d->prev_val[0]);
1997         break;
1998       case '1':
1999         oprintf (d->of, "(%s)", d->prev_val[1]);
2000         break;
2001       case 'a':
2002         {
2003           const char *pp = d->val + strlen (d->val);
2004           while (pp[-1] == ']')
2005             while (*pp != '[')
2006               pp--;
2007           oprintf (d->of, "%s", pp);
2008         }
2009         break;
2010       default:
2011         error_at_line (d->line, "`%s' option contains bad escape %c%c",
2012                        oname, '%', *p);
2013       }
2014 }
2015
2016 /* Call D->PROCESS_FIELD for every field (or subfield) of D->VAL,
2017    which is of type T.  Write code to D->OF to constrain execution (at
2018    the point that D->PROCESS_FIELD is called) to the appropriate
2019    cases.  Call D->PROCESS_FIELD on subobjects before calling it on
2020    pointers to those objects.  D->PREV_VAL lists the objects
2021    containing the current object, D->OPT is a list of options to
2022    apply, D->INDENT is the current indentation level, D->LINE is used
2023    to print error messages, D->BITMAP indicates which languages to
2024    print the structure for, and D->PARAM is the current parameter
2025    (from an enclosing param_is option).  */
2026
2027 static void
2028 walk_type (type_p t, struct walk_type_data *d)
2029 {
2030   const char *length = NULL;
2031   const char *desc = NULL;
2032   int maybe_undef_p = 0;
2033   int use_param_num = -1;
2034   int use_params_p = 0;
2035   options_p oo;
2036   const struct nested_ptr_data *nested_ptr_d = NULL;
2037
2038   d->needs_cast_p = false;
2039   for (oo = d->opt; oo; oo = oo->next)
2040     if (strcmp (oo->name, "length") == 0)
2041       length = oo->info;
2042     else if (strcmp (oo->name, "maybe_undef") == 0)
2043       maybe_undef_p = 1;
2044     else if (strncmp (oo->name, "use_param", 9) == 0
2045              && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
2046       use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
2047     else if (strcmp (oo->name, "use_params") == 0)
2048       use_params_p = 1;
2049     else if (strcmp (oo->name, "desc") == 0)
2050       desc = oo->info;
2051     else if (strcmp (oo->name, "mark_hook") == 0)
2052       ;
2053     else if (strcmp (oo->name, "nested_ptr") == 0)
2054       nested_ptr_d = (const struct nested_ptr_data *) oo->info;
2055     else if (strcmp (oo->name, "dot") == 0)
2056       ;
2057     else if (strcmp (oo->name, "tag") == 0)
2058       ;
2059     else if (strcmp (oo->name, "special") == 0)
2060       ;
2061     else if (strcmp (oo->name, "skip") == 0)
2062       ;
2063     else if (strcmp (oo->name, "default") == 0)
2064       ;
2065     else if (strcmp (oo->name, "descbits") == 0)
2066       ;
2067     else if (strcmp (oo->name, "param_is") == 0)
2068       ;
2069     else if (strncmp (oo->name, "param", 5) == 0
2070              && ISDIGIT (oo->name[5])
2071              && strcmp (oo->name + 6, "_is") == 0)
2072       ;
2073     else if (strcmp (oo->name, "chain_next") == 0)
2074       ;
2075     else if (strcmp (oo->name, "chain_prev") == 0)
2076       ;
2077     else if (strcmp (oo->name, "chain_circular") == 0)
2078       ;
2079     else if (strcmp (oo->name, "reorder") == 0)
2080       ;
2081     else
2082       error_at_line (d->line, "unknown option `%s'\n", oo->name);
2083
2084   if (d->used_length)
2085     length = NULL;
2086
2087   if (use_params_p)
2088     {
2089       int pointer_p = t->kind == TYPE_POINTER;
2090
2091       if (pointer_p)
2092         t = t->u.p;
2093       if (! UNION_OR_STRUCT_P (t))
2094         error_at_line (d->line, "`use_params' option on unimplemented type");
2095       else
2096         t = find_param_structure (t, d->param);
2097       if (pointer_p)
2098         t = create_pointer (t);
2099     }
2100
2101   if (use_param_num != -1)
2102     {
2103       if (d->param != NULL && d->param[use_param_num] != NULL)
2104         {
2105           type_p nt = d->param[use_param_num];
2106
2107           if (t->kind == TYPE_ARRAY)
2108             nt = create_array (nt, t->u.a.len);
2109           else if (length != NULL && t->kind == TYPE_POINTER)
2110             nt = create_pointer (nt);
2111           d->needs_cast_p = (t->kind != TYPE_POINTER
2112                              && (nt->kind == TYPE_POINTER
2113                                  || nt->kind == TYPE_STRING));
2114           t = nt;
2115         }
2116       else
2117         error_at_line (d->line, "no parameter defined for `%s'",
2118                        d->val);
2119     }
2120
2121   if (maybe_undef_p
2122       && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
2123     {
2124       error_at_line (d->line,
2125                      "field `%s' has invalid option `maybe_undef_p'\n",
2126                      d->val);
2127       return;
2128     }
2129
2130   switch (t->kind)
2131     {
2132     case TYPE_SCALAR:
2133     case TYPE_STRING:
2134       d->process_field (t, d);
2135       break;
2136
2137     case TYPE_POINTER:
2138       {
2139         if (maybe_undef_p
2140             && t->u.p->u.s.line.file == NULL)
2141           {
2142             oprintf (d->of, "%*sgcc_assert (!%s);\n", d->indent, "", d->val);
2143             break;
2144           }
2145
2146         if (! length)
2147           {
2148             if (! UNION_OR_STRUCT_P (t->u.p)
2149                 && t->u.p->kind != TYPE_PARAM_STRUCT)
2150               {
2151                 error_at_line (d->line,
2152                                "field `%s' is pointer to unimplemented type",
2153                                d->val);
2154                 break;
2155               }
2156
2157             if (nested_ptr_d)
2158               {
2159                 const char *oldprevval2 = d->prev_val[2];
2160
2161                 if (! UNION_OR_STRUCT_P (nested_ptr_d->type))
2162                   {
2163                     error_at_line (d->line,
2164                                    "field `%s' has invalid "
2165                                    "option `nested_ptr'\n",
2166                                    d->val);
2167                     return;
2168                   }
2169
2170                 d->prev_val[2] = d->val;
2171                 oprintf (d->of, "%*s{\n", d->indent, "");
2172                 d->indent += 2;
2173                 d->val = xasprintf ("x%d", d->counter++);
2174                 oprintf (d->of, "%*s%s %s * %s%s =\n", d->indent, "",
2175                          (nested_ptr_d->type->kind == TYPE_UNION
2176                           ? "union" : "struct"),
2177                          nested_ptr_d->type->u.s.tag,
2178                          d->fn_wants_lvalue ? "" : "const ",
2179                          d->val);
2180                 oprintf (d->of, "%*s", d->indent + 2, "");
2181                 output_escaped_param (d, nested_ptr_d->convert_from,
2182                                       "nested_ptr");
2183                 oprintf (d->of, ";\n");
2184
2185                 d->process_field (nested_ptr_d->type, d);
2186
2187                 if (d->fn_wants_lvalue)
2188                   {
2189                     oprintf (d->of, "%*s%s = ", d->indent, "",
2190                              d->prev_val[2]);
2191                     d->prev_val[2] = d->val;
2192                     output_escaped_param (d, nested_ptr_d->convert_to,
2193                                           "nested_ptr");
2194                     oprintf (d->of, ";\n");
2195                   }
2196
2197                 d->indent -= 2;
2198                 oprintf (d->of, "%*s}\n", d->indent, "");
2199                 d->val = d->prev_val[2];
2200                 d->prev_val[2] = oldprevval2;
2201               }
2202             else
2203               d->process_field (t->u.p, d);
2204           }
2205         else
2206           {
2207             int loopcounter = d->counter++;
2208             const char *oldval = d->val;
2209             const char *oldprevval3 = d->prev_val[3];
2210             char *newval;
2211
2212             oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
2213             d->indent += 2;
2214             oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
2215             oprintf (d->of, "%*sfor (i%d = 0; i%d != (size_t)(", d->indent, "",
2216                      loopcounter, loopcounter);
2217             output_escaped_param (d, length, "length");
2218             oprintf (d->of, "); i%d++) {\n", loopcounter);
2219             d->indent += 2;
2220             d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
2221             d->used_length = 1;
2222             d->prev_val[3] = oldval;
2223             walk_type (t->u.p, d);
2224             free (newval);
2225             d->val = oldval;
2226             d->prev_val[3] = oldprevval3;
2227             d->used_length = 0;
2228             d->indent -= 2;
2229             oprintf (d->of, "%*s}\n", d->indent, "");
2230             d->process_field(t, d);
2231             d->indent -= 2;
2232             oprintf (d->of, "%*s}\n", d->indent, "");
2233           }
2234       }
2235       break;
2236
2237     case TYPE_ARRAY:
2238       {
2239         int loopcounter = d->counter++;
2240         const char *oldval = d->val;
2241         char *newval;
2242
2243         /* If it's an array of scalars, we optimize by not generating
2244            any code.  */
2245         if (t->u.a.p->kind == TYPE_SCALAR)
2246           break;
2247
2248         /* When walking an array, compute the length and store it in a
2249            local variable before walking the array elements, instead of
2250            recomputing the length expression each time through the loop.
2251            This is necessary to handle tcc_vl_exp objects like CALL_EXPR,
2252            where the length is stored in the first array element,
2253            because otherwise that operand can get overwritten on the
2254            first iteration.  */
2255         oprintf (d->of, "%*s{\n", d->indent, "");
2256         d->indent += 2;
2257         oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
2258         oprintf (d->of, "%*ssize_t l%d = (size_t)(",
2259                  d->indent, "", loopcounter);
2260         if (length)
2261           output_escaped_param (d, length, "length");
2262         else
2263           oprintf (d->of, "%s", t->u.a.len);
2264         oprintf (d->of, ");\n");
2265
2266         oprintf (d->of, "%*sfor (i%d = 0; i%d != l%d; i%d++) {\n",
2267                  d->indent, "",
2268                  loopcounter, loopcounter, loopcounter, loopcounter);
2269         d->indent += 2;
2270         d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
2271         d->used_length = 1;
2272         walk_type (t->u.a.p, d);
2273         free (newval);
2274         d->used_length = 0;
2275         d->val = oldval;
2276         d->indent -= 2;
2277         oprintf (d->of, "%*s}\n", d->indent, "");
2278         d->indent -= 2;
2279         oprintf (d->of, "%*s}\n", d->indent, "");
2280       }
2281       break;
2282
2283     case TYPE_STRUCT:
2284     case TYPE_UNION:
2285       {
2286         pair_p f;
2287         const char *oldval = d->val;
2288         const char *oldprevval1 = d->prev_val[1];
2289         const char *oldprevval2 = d->prev_val[2];
2290         const int union_p = t->kind == TYPE_UNION;
2291         int seen_default_p = 0;
2292         options_p o;
2293
2294         if (! t->u.s.line.file)
2295           error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
2296
2297         if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
2298           {
2299             error_at_line (d->line,
2300                            "structure `%s' defined for mismatching languages",
2301                            t->u.s.tag);
2302             error_at_line (&t->u.s.line, "one structure defined here");
2303           }
2304
2305         /* Some things may also be defined in the structure's options.  */
2306         for (o = t->u.s.opt; o; o = o->next)
2307           if (! desc && strcmp (o->name, "desc") == 0)
2308             desc = o->info;
2309
2310         d->prev_val[2] = oldval;
2311         d->prev_val[1] = oldprevval2;
2312         if (union_p)
2313           {
2314             if (desc == NULL)
2315               {
2316                 error_at_line (d->line, "missing `desc' option for union `%s'",
2317                                t->u.s.tag);
2318                 desc = "1";
2319               }
2320             oprintf (d->of, "%*sswitch (", d->indent, "");
2321             output_escaped_param (d, desc, "desc");
2322             oprintf (d->of, ")\n");
2323             d->indent += 2;
2324             oprintf (d->of, "%*s{\n", d->indent, "");
2325           }
2326         for (f = t->u.s.fields; f; f = f->next)
2327           {
2328             options_p oo;
2329             const char *dot = ".";
2330             const char *tagid = NULL;
2331             int skip_p = 0;
2332             int default_p = 0;
2333             int use_param_p = 0;
2334             char *newval;
2335
2336             d->reorder_fn = NULL;
2337             for (oo = f->opt; oo; oo = oo->next)
2338               if (strcmp (oo->name, "dot") == 0)
2339                 dot = oo->info;
2340               else if (strcmp (oo->name, "tag") == 0)
2341                 tagid = oo->info;
2342               else if (strcmp (oo->name, "skip") == 0)
2343                 skip_p = 1;
2344               else if (strcmp (oo->name, "default") == 0)
2345                 default_p = 1;
2346               else if (strcmp (oo->name, "reorder") == 0)
2347                 d->reorder_fn = oo->info;
2348               else if (strncmp (oo->name, "use_param", 9) == 0
2349                        && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
2350                 use_param_p = 1;
2351
2352             if (skip_p)
2353               continue;
2354
2355             if (union_p && tagid)
2356               {
2357                 oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
2358                 d->indent += 2;
2359               }
2360             else if (union_p && default_p)
2361               {
2362                 oprintf (d->of, "%*sdefault:\n", d->indent, "");
2363                 d->indent += 2;
2364                 seen_default_p = 1;
2365               }
2366             else if (! union_p && (default_p || tagid))
2367               error_at_line (d->line,
2368                              "can't use `%s' outside a union on field `%s'",
2369                              default_p ? "default" : "tag", f->name);
2370             else if (union_p && ! (default_p || tagid)
2371                      && f->type->kind == TYPE_SCALAR)
2372               {
2373                 fprintf (stderr,
2374         "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
2375                          d->line->file, d->line->line, f->name);
2376                 continue;
2377               }
2378             else if (union_p && ! (default_p || tagid))
2379               error_at_line (d->line,
2380                              "field `%s' is missing `tag' or `default' option",
2381                              f->name);
2382
2383             d->line = &f->line;
2384             d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
2385             d->opt = f->opt;
2386             d->used_length = false;
2387
2388             if (union_p && use_param_p && d->param == NULL)
2389               oprintf (d->of, "%*sgcc_unreachable ();\n", d->indent, "");
2390             else
2391               walk_type (f->type, d);
2392
2393             free (newval);
2394
2395             if (union_p)
2396               {
2397                 oprintf (d->of, "%*sbreak;\n", d->indent, "");
2398                 d->indent -= 2;
2399               }
2400           }
2401         d->reorder_fn = NULL;
2402
2403         d->val = oldval;
2404         d->prev_val[1] = oldprevval1;
2405         d->prev_val[2] = oldprevval2;
2406
2407         if (union_p && ! seen_default_p)
2408           {
2409             oprintf (d->of, "%*sdefault:\n", d->indent, "");
2410             oprintf (d->of, "%*s  break;\n", d->indent, "");
2411           }
2412         if (union_p)
2413           {
2414             oprintf (d->of, "%*s}\n", d->indent, "");
2415             d->indent -= 2;
2416           }
2417       }
2418       break;
2419
2420     case TYPE_LANG_STRUCT:
2421       {
2422         type_p nt;
2423         for (nt = t->u.s.lang_struct; nt; nt = nt->next)
2424           if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
2425             break;
2426         if (nt == NULL)
2427           error_at_line (d->line, "structure `%s' differs between languages",
2428                          t->u.s.tag);
2429         else
2430           walk_type (nt, d);
2431       }
2432       break;
2433
2434     case TYPE_PARAM_STRUCT:
2435       {
2436         type_p *oldparam = d->param;
2437
2438         d->param = t->u.param_struct.param;
2439         walk_type (t->u.param_struct.stru, d);
2440         d->param = oldparam;
2441       }
2442       break;
2443
2444     default:
2445       gcc_unreachable ();
2446     }
2447 }
2448
2449 /* process_field routine for marking routines.  */
2450
2451 static void
2452 write_types_process_field (type_p f, const struct walk_type_data *d)
2453 {
2454   const struct write_types_data *wtd;
2455   const char *cast = d->needs_cast_p ? "(void *)" : "";
2456   wtd = (const struct write_types_data *) d->cookie;
2457
2458   switch (f->kind)
2459     {
2460     case TYPE_POINTER:
2461       oprintf (d->of, "%*s%s (%s%s", d->indent, "",
2462                wtd->subfield_marker_routine, cast, d->val);
2463       if (wtd->param_prefix)
2464         {
2465           oprintf (d->of, ", %s", d->prev_val[3]);
2466           if (d->orig_s)
2467             {
2468               oprintf (d->of, ", gt_%s_", wtd->param_prefix);
2469               output_mangled_typename (d->of, d->orig_s);
2470             }
2471           else
2472             oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
2473
2474           if (f->u.p->kind == TYPE_PARAM_STRUCT
2475               && f->u.p->u.s.line.file != NULL)
2476             {
2477               oprintf (d->of, ", gt_e_");
2478               output_mangled_typename (d->of, f);
2479             }
2480           else if (UNION_OR_STRUCT_P (f)
2481                    && f->u.p->u.s.line.file != NULL)
2482             {
2483               oprintf (d->of, ", gt_ggc_e_");
2484               output_mangled_typename (d->of, f);
2485             }
2486           else
2487             oprintf (d->of, ", gt_types_enum_last");
2488         }
2489       oprintf (d->of, ");\n");
2490       if (d->reorder_fn && wtd->reorder_note_routine)
2491         oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
2492                  wtd->reorder_note_routine, cast, d->val,
2493                  d->prev_val[3], d->reorder_fn);
2494       break;
2495
2496     case TYPE_STRING:
2497     case TYPE_STRUCT:
2498     case TYPE_UNION:
2499     case TYPE_LANG_STRUCT:
2500     case TYPE_PARAM_STRUCT:
2501       oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
2502       output_mangled_typename (d->of, f);
2503       oprintf (d->of, " (%s%s);\n", cast, d->val);
2504       if (d->reorder_fn && wtd->reorder_note_routine)
2505         oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
2506                  wtd->reorder_note_routine, cast, d->val, cast, d->val,
2507                  d->reorder_fn);
2508       break;
2509
2510     case TYPE_SCALAR:
2511       break;
2512
2513     default:
2514       gcc_unreachable ();
2515     }
2516 }
2517
2518 /* A subroutine of write_func_for_structure.  Write the enum tag for S.  */
2519
2520 static void
2521 output_type_enum (outf_p of, type_p s)
2522 {
2523   if (s->kind == TYPE_PARAM_STRUCT && s->u.s.line.file != NULL)
2524     {
2525       oprintf (of, ", gt_e_");
2526       output_mangled_typename (of, s);
2527     }
2528   else if (UNION_OR_STRUCT_P (s) && s->u.s.line.file != NULL)
2529     {
2530       oprintf (of, ", gt_ggc_e_");
2531       output_mangled_typename (of, s);
2532     }
2533   else
2534     oprintf (of, ", gt_types_enum_last");
2535 }
2536
2537 /* For S, a structure that's part of ORIG_S, and using parameters
2538    PARAM, write out a routine that:
2539    - Takes a parameter, a void * but actually of type *S
2540    - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
2541      field of S or its substructures and (in some cases) things
2542      that are pointed to by S.
2543 */
2544
2545 static void
2546 write_func_for_structure (type_p orig_s, type_p s, type_p *param,
2547                           const struct write_types_data *wtd)
2548 {
2549   const char *fn = s->u.s.line.file;
2550   int i;
2551   const char *chain_next = NULL;
2552   const char *chain_prev = NULL;
2553   const char *chain_circular = NULL;
2554   const char *mark_hook_name = NULL;
2555   options_p opt;
2556   struct walk_type_data d;
2557
2558   /* This is a hack, and not the good kind either.  */
2559   for (i = NUM_PARAM - 1; i >= 0; i--)
2560     if (param && param[i] && param[i]->kind == TYPE_POINTER
2561         && UNION_OR_STRUCT_P (param[i]->u.p))
2562       fn = param[i]->u.p->u.s.line.file;
2563
2564   memset (&d, 0, sizeof (d));
2565   d.of = get_output_file_with_visibility (fn);
2566
2567   for (opt = s->u.s.opt; opt; opt = opt->next)
2568     if (strcmp (opt->name, "chain_next") == 0)
2569       chain_next = opt->info;
2570     else if (strcmp (opt->name, "chain_prev") == 0)
2571       chain_prev = opt->info;
2572     else if (strcmp (opt->name, "chain_circular") == 0)
2573       chain_circular = opt->info;
2574     else if (strcmp (opt->name, "mark_hook") == 0)
2575       mark_hook_name = opt->info;
2576
2577   if (chain_prev != NULL && chain_next == NULL)
2578     error_at_line (&s->u.s.line, "chain_prev without chain_next");
2579   if (chain_circular != NULL && chain_next != NULL)
2580     error_at_line (&s->u.s.line, "chain_circular with chain_next");
2581   if (chain_circular != NULL)
2582     chain_next = chain_circular;
2583
2584   d.process_field = write_types_process_field;
2585   d.cookie = wtd;
2586   d.orig_s = orig_s;
2587   d.opt = s->u.s.opt;
2588   d.line = &s->u.s.line;
2589   d.bitmap = s->u.s.bitmap;
2590   d.param = param;
2591   d.prev_val[0] = "*x";
2592   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2593   d.prev_val[3] = "x";
2594   d.val = "(*x)";
2595
2596   oprintf (d.of, "\n");
2597   oprintf (d.of, "void\n");
2598   if (param == NULL)
2599     oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
2600   else
2601     {
2602       oprintf (d.of, "gt_%s_", wtd->prefix);
2603       output_mangled_typename (d.of, orig_s);
2604     }
2605   oprintf (d.of, " (void *x_p)\n");
2606   oprintf (d.of, "{\n");
2607   oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
2608            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2609            chain_next == NULL ? "const " : "",
2610            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2611   if (chain_next != NULL)
2612     oprintf (d.of, "  %s %s * xlimit = x;\n",
2613              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2614   if (chain_next == NULL)
2615     {
2616       oprintf (d.of, "  if (%s (x", wtd->marker_routine);
2617       if (wtd->param_prefix)
2618         {
2619           oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
2620           output_mangled_typename (d.of, orig_s);
2621           output_type_enum (d.of, orig_s);
2622         }
2623       oprintf (d.of, "))\n");
2624     }
2625   else
2626     {
2627       if (chain_circular != NULL)
2628         oprintf (d.of, "  if (!%s (xlimit", wtd->marker_routine);
2629       else
2630         oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
2631       if (wtd->param_prefix)
2632         {
2633           oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
2634           output_mangled_typename (d.of, orig_s);
2635           output_type_enum (d.of, orig_s);
2636         }
2637       oprintf (d.of, "))\n");
2638       if (chain_circular != NULL)
2639         oprintf (d.of, "    return;\n  do\n");
2640       if (mark_hook_name && !wtd->skip_hooks)
2641         {
2642           oprintf (d.of, "    {\n");
2643           oprintf (d.of, "      %s (xlimit);\n   ", mark_hook_name);
2644         }
2645       oprintf (d.of, "   xlimit = (");
2646       d.prev_val[2] = "*xlimit";
2647       output_escaped_param (&d, chain_next, "chain_next");
2648       oprintf (d.of, ");\n");
2649       if (mark_hook_name && !wtd->skip_hooks)
2650         oprintf (d.of, "    }\n");
2651       if (chain_prev != NULL)
2652         {
2653           oprintf (d.of, "  if (x != xlimit)\n");
2654           oprintf (d.of, "    for (;;)\n");
2655           oprintf (d.of, "      {\n");
2656           oprintf (d.of, "        %s %s * const xprev = (",
2657                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2658
2659           d.prev_val[2] = "*x";
2660           output_escaped_param (&d, chain_prev, "chain_prev");
2661           oprintf (d.of, ");\n");
2662           oprintf (d.of, "        if (xprev == NULL) break;\n");
2663           oprintf (d.of, "        x = xprev;\n");
2664           oprintf (d.of, "        (void) %s (xprev",
2665                    wtd->marker_routine);
2666           if (wtd->param_prefix)
2667             {
2668               oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
2669               output_mangled_typename (d.of, orig_s);
2670               output_type_enum (d.of, orig_s);
2671             }
2672           oprintf (d.of, ");\n");
2673           oprintf (d.of, "      }\n");
2674         }
2675       if (chain_circular != NULL)
2676         {
2677           oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
2678           if (wtd->param_prefix)
2679             {
2680               oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
2681               output_mangled_typename (d.of, orig_s);
2682               output_type_enum (d.of, orig_s);
2683             }
2684           oprintf (d.of, "));\n");
2685           if (mark_hook_name && !wtd->skip_hooks)
2686             oprintf (d.of, "  %s (xlimit);\n", mark_hook_name);
2687           oprintf (d.of, "  do\n");
2688         }
2689       else
2690         oprintf (d.of, "  while (x != xlimit)\n");
2691     }
2692   oprintf (d.of, "    {\n");
2693   if (mark_hook_name && chain_next == NULL && !wtd->skip_hooks)
2694     {
2695       oprintf (d.of, "      %s (x);\n", mark_hook_name);
2696     }
2697   d.prev_val[2] = "*x";
2698   d.indent = 6;
2699   walk_type (s, &d);
2700
2701   if (chain_next != NULL)
2702     {
2703       oprintf (d.of, "      x = (");
2704       output_escaped_param (&d, chain_next, "chain_next");
2705       oprintf (d.of, ");\n");
2706     }
2707
2708   oprintf (d.of, "    }\n");
2709   if (chain_circular != NULL)
2710     oprintf (d.of, "  while (x != xlimit);\n");
2711   oprintf (d.of, "}\n");
2712 }
2713
2714 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
2715
2716 static void
2717 write_types (outf_p output_header, type_p structures, type_p param_structs,
2718              const struct write_types_data *wtd)
2719 {
2720   type_p s;
2721
2722   oprintf (output_header, "\n/* %s*/\n", wtd->comment);
2723   /* We first emit the macros and the declarations. Functions' code is
2724      emitted afterwards.  This is needed in plugin mode.  */
2725   oprintf (output_header, "/* macros and declarations */\n");
2726   for (s = structures; s; s = s->next)
2727     if (s->gc_used == GC_POINTED_TO
2728         || s->gc_used == GC_MAYBE_POINTED_TO)
2729       {
2730         options_p opt;
2731
2732         if (s->gc_used == GC_MAYBE_POINTED_TO
2733             && s->u.s.line.file == NULL)
2734           continue;
2735
2736         oprintf (output_header, "#define gt_%s_", wtd->prefix);
2737         output_mangled_typename (output_header, s);
2738         oprintf (output_header, "(X) do { \\\n");
2739         oprintf (output_header,
2740                  "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
2741                  s->u.s.tag);
2742         oprintf (output_header,
2743                  "  } while (0)\n");
2744
2745         for (opt = s->u.s.opt; opt; opt = opt->next)
2746           if (strcmp (opt->name, "ptr_alias") == 0)
2747             {
2748               const_type_p const t = (const_type_p) opt->info;
2749               if (t->kind == TYPE_STRUCT
2750                   || t->kind == TYPE_UNION
2751                   || t->kind == TYPE_LANG_STRUCT)
2752                 oprintf (output_header,
2753                          "#define gt_%sx_%s gt_%sx_%s\n",
2754                          wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
2755               else
2756                 error_at_line (&s->u.s.line,
2757                                "structure alias is not a structure");
2758               break;
2759             }
2760         if (opt)
2761           continue;
2762
2763         /* Declare the marker procedure only once.  */
2764         oprintf (output_header,
2765                  "extern void gt_%sx_%s (void *);\n",
2766                  wtd->prefix, s->u.s.tag);
2767
2768         if (s->u.s.line.file == NULL)
2769           {
2770             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2771                      s->u.s.tag);
2772             continue;
2773           }
2774       }
2775
2776   for (s = param_structs; s; s = s->next)
2777     if (s->gc_used == GC_POINTED_TO)
2778       {
2779         type_p stru = s->u.param_struct.stru;
2780
2781         /* Declare the marker procedure.  */
2782         oprintf (output_header, "extern void gt_%s_", wtd->prefix);
2783         output_mangled_typename (output_header, s);
2784         oprintf (output_header, " (void *);\n");
2785
2786         if (stru->u.s.line.file == NULL)
2787           {
2788             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2789                      s->u.s.tag);
2790             continue;
2791           }
2792       }
2793
2794   /* At last we emit the functions code.  */
2795   oprintf (output_header, "\n/* functions code */\n");
2796   for (s = structures; s; s = s->next)
2797     if (s->gc_used == GC_POINTED_TO
2798         || s->gc_used == GC_MAYBE_POINTED_TO)
2799       {
2800         options_p opt;
2801
2802         if (s->gc_used == GC_MAYBE_POINTED_TO
2803             && s->u.s.line.file == NULL)
2804           continue;
2805         for (opt = s->u.s.opt; opt; opt = opt->next)
2806           if (strcmp (opt->name, "ptr_alias") == 0)
2807             break;
2808         if (opt)
2809           continue;
2810
2811         if (s->kind == TYPE_LANG_STRUCT)
2812           {
2813             type_p ss;
2814             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2815               write_func_for_structure (s, ss, NULL, wtd);
2816           }
2817         else
2818           write_func_for_structure (s, s, NULL, wtd);
2819       }
2820   for (s = param_structs; s; s = s->next)
2821     if (s->gc_used == GC_POINTED_TO)
2822       {
2823         type_p *param = s->u.param_struct.param;
2824         type_p stru = s->u.param_struct.stru;
2825         if (stru->u.s.line.file == NULL)
2826           continue;
2827         if (stru->kind == TYPE_LANG_STRUCT)
2828           {
2829             type_p ss;
2830             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2831               write_func_for_structure (s, ss, param, wtd);
2832           }
2833         else
2834           write_func_for_structure (s, stru, param, wtd);
2835       }
2836 }
2837
2838 static const struct write_types_data ggc_wtd =
2839 {
2840   "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
2841   "GC marker procedures.  ",
2842   FALSE
2843 };
2844
2845 static const struct write_types_data pch_wtd =
2846 {
2847   "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
2848   "gt_pch_note_reorder",
2849   "PCH type-walking procedures.  ",
2850   TRUE
2851 };
2852
2853 /* Write out the local pointer-walking routines.  */
2854
2855 /* process_field routine for local pointer-walking.  */
2856
2857 static void
2858 write_types_local_process_field (type_p f, const struct walk_type_data *d)
2859 {
2860   switch (f->kind)
2861     {
2862     case TYPE_POINTER:
2863     case TYPE_STRUCT:
2864     case TYPE_UNION:
2865     case TYPE_LANG_STRUCT:
2866     case TYPE_PARAM_STRUCT:
2867     case TYPE_STRING:
2868       oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
2869                d->prev_val[3]);
2870       oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
2871       break;
2872
2873     case TYPE_SCALAR:
2874       break;
2875
2876     default:
2877       gcc_unreachable ();
2878     }
2879 }
2880
2881 /* For S, a structure that's part of ORIG_S, and using parameters
2882    PARAM, write out a routine that:
2883    - Is of type gt_note_pointers
2884    - Calls PROCESS_FIELD on each field of S or its substructures.
2885 */
2886
2887 static void
2888 write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
2889 {
2890   const char *fn = s->u.s.line.file;
2891   int i;
2892   struct walk_type_data d;
2893
2894   /* This is a hack, and not the good kind either.  */
2895   for (i = NUM_PARAM - 1; i >= 0; i--)
2896     if (param && param[i] && param[i]->kind == TYPE_POINTER
2897         && UNION_OR_STRUCT_P (param[i]->u.p))
2898       fn = param[i]->u.p->u.s.line.file;
2899
2900   memset (&d, 0, sizeof (d));
2901   d.of = get_output_file_with_visibility (fn);
2902   d.process_field = write_types_local_process_field;
2903   d.opt = s->u.s.opt;
2904   d.line = &s->u.s.line;
2905   d.bitmap = s->u.s.bitmap;
2906   d.param = param;
2907   d.prev_val[0] = d.prev_val[2] = "*x";
2908   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2909   d.prev_val[3] = "x";
2910   d.val = "(*x)";
2911   d.fn_wants_lvalue = true;
2912
2913   oprintf (d.of, "\n");
2914   oprintf (d.of, "void\n");
2915   oprintf (d.of, "gt_pch_p_");
2916   output_mangled_typename (d.of, orig_s);
2917   oprintf (d.of, " (ATTRIBUTE_UNUSED void *this_obj,\n"
2918            "\tvoid *x_p,\n"
2919            "\tATTRIBUTE_UNUSED gt_pointer_operator op,\n"
2920            "\tATTRIBUTE_UNUSED void *cookie)\n");
2921   oprintf (d.of, "{\n");
2922   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2923            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2924            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2925   d.indent = 2;
2926   walk_type (s, &d);
2927   oprintf (d.of, "}\n");
2928 }
2929
2930 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2931
2932 static void
2933 write_local (outf_p output_header, type_p structures, type_p param_structs)
2934 {
2935   type_p s;
2936
2937   if (!output_header)
2938     return;
2939   oprintf (output_header, "\n/* Local pointer-walking routines.  */\n");
2940   for (s = structures; s; s = s->next)
2941     if (s->gc_used == GC_POINTED_TO
2942         || s->gc_used == GC_MAYBE_POINTED_TO)
2943       {
2944         options_p opt;
2945
2946         if (s->u.s.line.file == NULL)
2947           continue;
2948
2949         for (opt = s->u.s.opt; opt; opt = opt->next)
2950           if (strcmp (opt->name, "ptr_alias") == 0)
2951             {
2952               const_type_p const t = (const_type_p) opt->info;
2953               if (t->kind == TYPE_STRUCT
2954                   || t->kind == TYPE_UNION
2955                   || t->kind == TYPE_LANG_STRUCT)
2956                 {
2957                   oprintf (output_header, "#define gt_pch_p_");
2958                   output_mangled_typename (output_header, s);
2959                   oprintf (output_header, " gt_pch_p_");
2960                   output_mangled_typename (output_header, t);
2961                   oprintf (output_header, "\n");
2962                 }
2963               else
2964                 error_at_line (&s->u.s.line,
2965                                "structure alias is not a structure");
2966               break;
2967             }
2968         if (opt)
2969           continue;
2970
2971         /* Declare the marker procedure only once.  */
2972         oprintf (output_header, "extern void gt_pch_p_");
2973         output_mangled_typename (output_header, s);
2974         oprintf (output_header,
2975          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2976
2977         if (s->kind == TYPE_LANG_STRUCT)
2978           {
2979             type_p ss;
2980             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2981               write_local_func_for_structure (s, ss, NULL);
2982           }
2983         else
2984           write_local_func_for_structure (s, s, NULL);
2985       }
2986
2987   for (s = param_structs; s; s = s->next)
2988     if (s->gc_used == GC_POINTED_TO)
2989       {
2990         type_p * param = s->u.param_struct.param;
2991         type_p stru = s->u.param_struct.stru;
2992
2993         /* Declare the marker procedure.  */
2994         oprintf (output_header, "extern void gt_pch_p_");
2995         output_mangled_typename (output_header, s);
2996         oprintf (output_header,
2997          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2998
2999         if (stru->u.s.line.file == NULL)
3000           {
3001             fprintf (stderr, "warning: structure `%s' used but not defined\n",
3002                      s->u.s.tag);
3003             continue;
3004           }
3005
3006         if (stru->kind == TYPE_LANG_STRUCT)
3007           {
3008             type_p ss;
3009             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
3010               write_local_func_for_structure (s, ss, param);
3011           }
3012         else
3013           write_local_func_for_structure (s, stru, param);
3014       }
3015 }
3016
3017 /* Write out the 'enum' definition for gt_types_enum.  */
3018
3019 static void
3020 write_enum_defn (type_p structures, type_p param_structs)
3021 {
3022   type_p s;
3023
3024   if (!header_file)
3025     return;
3026   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
3027   oprintf (header_file, "enum gt_types_enum {\n");
3028   for (s = structures; s; s = s->next)
3029     if (s->gc_used == GC_POINTED_TO
3030         || s->gc_used == GC_MAYBE_POINTED_TO)
3031       {
3032         if (s->gc_used == GC_MAYBE_POINTED_TO
3033             && s->u.s.line.file == NULL)
3034           continue;
3035
3036         oprintf (header_file, " gt_ggc_e_");
3037         output_mangled_typename (header_file, s);
3038         oprintf (header_file, ", \n");
3039       }
3040   for (s = param_structs; s; s = s->next)
3041     if (s->gc_used == GC_POINTED_TO)
3042       {
3043         oprintf (header_file, " gt_e_");
3044         output_mangled_typename (header_file, s);
3045         oprintf (header_file, ", \n");
3046       }
3047   oprintf (header_file, " gt_types_enum_last\n");
3048   oprintf (header_file, "};\n");
3049 }
3050
3051 /* Might T contain any non-pointer elements?  */
3052
3053 static int
3054 contains_scalar_p (type_p t)
3055 {
3056   switch (t->kind)
3057     {
3058     case TYPE_STRING:
3059     case TYPE_POINTER:
3060       return 0;
3061     case TYPE_ARRAY:
3062       return contains_scalar_p (t->u.a.p);
3063     default:
3064       /* Could also check for structures that have no non-pointer
3065          fields, but there aren't enough of those to worry about.  */
3066       return 1;
3067     }
3068 }
3069
3070 /* Mangle FN and print it to F.  */
3071
3072 static void
3073 put_mangled_filename (outf_p f, const char *fn)
3074 {
3075   const char *name = get_output_file_name (fn);
3076   if (!f || !name)
3077     return;
3078   for (; *name != 0; name++)
3079     if (ISALNUM (*name))
3080       oprintf (f, "%c", *name);
3081     else
3082       oprintf (f, "%c", '_');
3083 }
3084
3085 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
3086    LASTNAME, and NAME are all strings to insert in various places in
3087    the resulting code.  */
3088
3089 static void
3090 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
3091                    const char *tname, const char *name)
3092 {
3093   struct flist *fli2;
3094
3095   for (fli2 = flp; fli2; fli2 = fli2->next)
3096     if (fli2->started_p)
3097       {
3098         oprintf (fli2->f, "  %s\n", lastname);
3099         oprintf (fli2->f, "};\n\n");
3100       }
3101
3102   for (fli2 = flp; fli2 && base_files; fli2 = fli2->next)
3103     if (fli2->started_p)
3104       {
3105         lang_bitmap bitmap = get_lang_bitmap (fli2->name);
3106         int fnum;
3107
3108         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
3109           if (bitmap & 1)
3110             {
3111               oprintf (base_files[fnum],
3112                        "extern const struct %s gt_%s_",
3113                        tname, pfx);
3114               put_mangled_filename (base_files[fnum], fli2->name);
3115               oprintf (base_files[fnum], "[];\n");
3116             }
3117       }
3118
3119   {
3120     size_t fnum;
3121     for (fnum = 0; base_files && fnum < num_lang_dirs; fnum++)
3122       oprintf (base_files [fnum],
3123                "EXPORTED_CONST struct %s * const %s[] = {\n",
3124                tname, name);
3125   }
3126
3127
3128   for (fli2 = flp; fli2; fli2 = fli2->next)
3129     if (fli2->started_p)
3130       {
3131         lang_bitmap bitmap = get_lang_bitmap (fli2->name);
3132         int fnum;
3133
3134         fli2->started_p = 0;
3135
3136         for (fnum = 0; base_files && bitmap != 0; fnum++, bitmap >>= 1)
3137           if (bitmap & 1)
3138             {
3139               oprintf (base_files[fnum], "  gt_%s_", pfx);
3140               put_mangled_filename (base_files[fnum], fli2->name);
3141               oprintf (base_files[fnum], ",\n");
3142             }
3143       }
3144
3145   {
3146     size_t fnum;
3147     for (fnum = 0; base_files && fnum < num_lang_dirs; fnum++)
3148       {
3149         oprintf (base_files[fnum], "  NULL\n");
3150         oprintf (base_files[fnum], "};\n");
3151       }
3152   }
3153 }
3154
3155 /* Write out to F the table entry and any marker routines needed to
3156    mark NAME as TYPE.  The original variable is V, at LINE.
3157    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
3158    is nonzero iff we are building the root table for hash table caches.  */
3159
3160 static void
3161 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
3162             struct fileloc *line, const char *if_marked, bool emit_pch)
3163 {
3164   switch (type->kind)
3165     {
3166     case TYPE_STRUCT:
3167       {
3168         pair_p fld;
3169         for (fld = type->u.s.fields; fld; fld = fld->next)
3170           {
3171             int skip_p = 0;
3172             const char *desc = NULL;
3173             options_p o;
3174
3175             for (o = fld->opt; o; o = o->next)
3176               if (strcmp (o->name, "skip") == 0)
3177                 skip_p = 1;
3178               else if (strcmp (o->name, "desc") == 0)
3179                 desc = o->info;
3180               else if (strcmp (o->name, "param_is") == 0)
3181                 ;
3182               else
3183                 error_at_line (line,
3184                        "field `%s' of global `%s' has unknown option `%s'",
3185                                fld->name, name, o->name);
3186
3187             if (skip_p)
3188               continue;
3189             else if (desc && fld->type->kind == TYPE_UNION)
3190               {
3191                 pair_p validf = NULL;
3192                 pair_p ufld;
3193
3194                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
3195                   {
3196                     const char *tag = NULL;
3197                     options_p oo;
3198
3199                     for (oo = ufld->opt; oo; oo = oo->next)
3200                       if (strcmp (oo->name, "tag") == 0)
3201                         tag = oo->info;
3202                     if (tag == NULL || strcmp (tag, desc) != 0)
3203                       continue;
3204                     if (validf != NULL)
3205                       error_at_line (line,
3206                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
3207                                      name, fld->name, validf->name,
3208                                      name, fld->name, ufld->name,
3209                                      tag);
3210                     validf = ufld;
3211                   }
3212                 if (validf != NULL)
3213                   {
3214                     char *newname;
3215                     newname = xasprintf ("%s.%s.%s",
3216                                          name, fld->name, validf->name);
3217                     write_root (f, v, validf->type, newname, 0, line,
3218                                 if_marked, emit_pch);
3219                     free (newname);
3220                   }
3221               }
3222             else if (desc)
3223               error_at_line (line,
3224                      "global `%s.%s' has `desc' option but is not union",
3225                              name, fld->name);
3226             else
3227               {
3228                 char *newname;
3229                 newname = xasprintf ("%s.%s", name, fld->name);
3230                 write_root (f, v, fld->type, newname, 0, line, if_marked,
3231                             emit_pch);
3232                 free (newname);
3233               }
3234           }
3235       }
3236       break;
3237
3238     case TYPE_ARRAY:
3239       {
3240         char *newname;
3241         newname = xasprintf ("%s[0]", name);
3242         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked,
3243                     emit_pch);
3244         free (newname);
3245       }
3246       break;
3247
3248     case TYPE_POINTER:
3249       {
3250         type_p ap, tp;
3251
3252         oprintf (f, "  {\n");
3253         oprintf (f, "    &%s,\n", name);
3254         oprintf (f, "    1");
3255
3256         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
3257           if (ap->u.a.len[0])
3258             oprintf (f, " * (%s)", ap->u.a.len);
3259           else if (ap == v->type)
3260             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
3261         oprintf (f, ",\n");
3262         oprintf (f, "    sizeof (%s", v->name);
3263         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
3264           oprintf (f, "[0]");
3265         oprintf (f, "),\n");
3266
3267         tp = type->u.p;
3268
3269         if (! has_length && UNION_OR_STRUCT_P (tp))
3270           {
3271             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
3272             if (emit_pch)
3273               oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
3274             else
3275               oprintf (f, "    NULL");
3276           }
3277         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
3278           {
3279             oprintf (f, "    &gt_ggc_m_");
3280             output_mangled_typename (f, tp);
3281             if (emit_pch)
3282               {
3283                 oprintf (f, ",\n    &gt_pch_n_");
3284                 output_mangled_typename (f, tp);
3285               }
3286             else
3287               oprintf (f, ",\n    NULL");
3288           }
3289         else if (has_length
3290                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
3291           {
3292             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
3293             if (emit_pch)
3294               oprintf (f, "    &gt_pch_na_%s", name);
3295             else
3296               oprintf (f, "    NULL");
3297           }
3298         else
3299           {
3300             error_at_line (line,
3301                            "global `%s' is pointer to unimplemented type",
3302                            name);
3303           }
3304         if (if_marked)
3305           oprintf (f, ",\n    &%s", if_marked);
3306         oprintf (f, "\n  },\n");
3307       }
3308       break;
3309
3310     case TYPE_STRING:
3311       {
3312         oprintf (f, "  {\n");
3313         oprintf (f, "    &%s,\n", name);
3314         oprintf (f, "    1, \n");
3315         oprintf (f, "    sizeof (%s),\n", v->name);
3316         oprintf (f, "    (gt_pointer_walker) &gt_ggc_m_S,\n");
3317         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
3318         oprintf (f, "  },\n");
3319       }
3320       break;
3321
3322     case TYPE_SCALAR:
3323       break;
3324
3325     default:
3326       error_at_line (line,
3327                      "global `%s' is unimplemented type",
3328                      name);
3329     }
3330 }
3331
3332 /* This generates a routine to walk an array.  */
3333
3334 static void
3335 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
3336 {
3337   struct walk_type_data d;
3338   char *prevval3;
3339
3340   memset (&d, 0, sizeof (d));
3341   d.of = f;
3342   d.cookie = wtd;
3343   d.indent = 2;
3344   d.line = &v->line;
3345   d.opt = v->opt;
3346   d.bitmap = get_lang_bitmap (v->line.file);
3347   d.param = NULL;
3348
3349   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
3350
3351   if (wtd->param_prefix)
3352     {
3353       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
3354       oprintf (f,
3355        "    (void *, void *, gt_pointer_operator, void *);\n");
3356       oprintf (f, "static void gt_%sa_%s (ATTRIBUTE_UNUSED void *this_obj,\n",
3357                wtd->param_prefix, v->name);
3358       oprintf (d.of,
3359                "      ATTRIBUTE_UNUSED void *x_p,\n"
3360                "      ATTRIBUTE_UNUSED gt_pointer_operator op,\n"
3361                "      ATTRIBUTE_UNUSED void * cookie)\n");
3362       oprintf (d.of, "{\n");
3363       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
3364       d.process_field = write_types_local_process_field;
3365       walk_type (v->type, &d);
3366       oprintf (f, "}\n\n");
3367     }
3368
3369   d.opt = v->opt;
3370   oprintf (f, "static void gt_%sa_%s (void *);\n",
3371            wtd->prefix, v->name);
3372   oprintf (f, "static void\ngt_%sa_%s (ATTRIBUTE_UNUSED void *x_p)\n",
3373            wtd->prefix, v->name);
3374   oprintf (f, "{\n");
3375   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
3376   d.process_field = write_types_process_field;
3377   walk_type (v->type, &d);
3378   free (prevval3);
3379   oprintf (f, "}\n\n");
3380 }
3381
3382 /* Output a table describing the locations and types of VARIABLES.  */
3383
3384 static void
3385 write_roots (pair_p variables, bool emit_pch)
3386 {
3387   pair_p v;
3388   struct flist *flp = NULL;
3389
3390   for (v = variables; v; v = v->next)
3391     {
3392       outf_p f = get_output_file_with_visibility (v->line.file);
3393       struct flist *fli;
3394       const char *length = NULL;
3395       int deletable_p = 0;
3396       options_p o;
3397
3398       for (o = v->opt; o; o = o->next)
3399         if (strcmp (o->name, "length") == 0)
3400           length = o->info;
3401         else if (strcmp (o->name, "deletable") == 0)
3402           deletable_p = 1;
3403         else if (strcmp (o->name, "param_is") == 0)
3404           ;
3405         else if (strncmp (o->name, "param", 5) == 0
3406                  && ISDIGIT (o->name[5])
3407                  && strcmp (o->name + 6, "_is") == 0)
3408           ;
3409         else if (strcmp (o->name, "if_marked") == 0)
3410           ;
3411         else
3412           error_at_line (&v->line,
3413                          "global `%s' has unknown option `%s'",
3414                          v->name, o->name);
3415
3416       for (fli = flp; fli; fli = fli->next)
3417         if (fli->f == f && f)
3418           break;
3419       if (fli == NULL)
3420         {
3421           fli = XNEW (struct flist);
3422           fli->f = f;
3423           fli->next = flp;
3424           fli->started_p = 0;
3425           fli->name = v->line.file;
3426           gcc_assert(fli->name);
3427           flp = fli;
3428
3429           oprintf (f, "\n/* GC roots.  */\n\n");
3430         }
3431
3432       if (! deletable_p
3433           && length
3434           && v->type->kind == TYPE_POINTER
3435           && (v->type->u.p->kind == TYPE_POINTER
3436               || v->type->u.p->kind == TYPE_STRUCT))
3437         {
3438           write_array (f, v, &ggc_wtd);
3439           write_array (f, v, &pch_wtd);
3440         }
3441     }
3442
3443   for (v = variables; v; v = v->next)
3444     {
3445       outf_p f = get_output_file_with_visibility (v->line.file);
3446       struct flist *fli;
3447       int skip_p = 0;
3448       int length_p = 0;
3449       options_p o;
3450
3451       for (o = v->opt; o; o = o->next)
3452         if (strcmp (o->name, "length") == 0)
3453           length_p = 1;
3454         else if (strcmp (o->name, "deletable") == 0
3455                  || strcmp (o->name, "if_marked") == 0)
3456           skip_p = 1;
3457
3458       if (skip_p)
3459         continue;
3460
3461       for (fli = flp; fli; fli = fli->next)
3462         if (fli->f == f)
3463           break;
3464       if (! fli->started_p)
3465         {
3466           fli->started_p = 1;
3467
3468           oprintf (f, "EXPORTED_CONST struct ggc_root_tab gt_ggc_r_");
3469           put_mangled_filename (f, v->line.file);
3470           oprintf (f, "[] = {\n");
3471         }
3472
3473       write_root (f, v, v->type, v->name, length_p, &v->line, NULL, emit_pch);
3474     }
3475
3476   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
3477                      "gt_ggc_rtab");
3478
3479   for (v = variables; v; v = v->next)
3480     {
3481       outf_p f = get_output_file_with_visibility (v->line.file);
3482       struct flist *fli;
3483       int skip_p = 1;
3484       options_p o;
3485
3486       for (o = v->opt; o; o = o->next)
3487         if (strcmp (o->name, "deletable") == 0)
3488           skip_p = 0;
3489         else if (strcmp (o->name, "if_marked") == 0)
3490           skip_p = 1;
3491
3492       if (skip_p)
3493         continue;
3494
3495       for (fli = flp; fli; fli = fli->next)
3496         if (fli->f == f)
3497           break;
3498       if (! fli->started_p)
3499         {
3500           fli->started_p = 1;
3501
3502           oprintf (f, "EXPORTED_CONST struct ggc_root_tab gt_ggc_rd_");
3503           put_mangled_filename (f, v->line.file);
3504           oprintf (f, "[] = {\n");
3505         }
3506
3507       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
3508                v->name, v->name);
3509     }
3510
3511   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
3512                      "gt_ggc_deletable_rtab");
3513
3514   for (v = variables; v; v = v->next)
3515     {
3516       outf_p f = get_output_file_with_visibility (v->line.file);
3517       struct flist *fli;
3518       const char *if_marked = NULL;
3519       int length_p = 0;
3520       options_p o;
3521
3522       for (o = v->opt; o; o = o->next)
3523         if (strcmp (o->name, "length") == 0)