OSDN Git Service

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