OSDN Git Service

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