OSDN Git Service

* c-decl.c (grokdeclarator): Don't frob current_function_decl
[pf3gnuchains/gcc-fork.git] / gcc / gengtype.c
1 /* Process source files and output type information.
2    Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
3
4 This file is part of GCC.
5
6 GCC is free software; you can redistribute it and/or modify it under
7 the terms of the GNU General Public License as published by the Free
8 Software Foundation; either version 2, or (at your option) any later
9 version.
10
11 GCC is distributed in the hope that it will be useful, but WITHOUT ANY
12 WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with GCC; see the file COPYING.  If not, write to the Free
18 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
19 02111-1307, USA.  */
20
21 #include "bconfig.h"
22 #include "system.h"
23 #include "coretypes.h"
24 #include "tm.h"
25 #include "gengtype.h"
26 #include "gtyp-gen.h"
27
28 #define NO_GENRTL_H
29 #include "rtl.h"
30 #undef abort
31
32 /* Nonzero iff an error has occurred.  */
33 static int hit_error = 0;
34
35 static void gen_rtx_next (void);
36 static void write_rtx_next (void);
37 static void open_base_files (void);
38 static void close_output_files (void);
39
40 /* Report an error at POS, printing MSG.  */
41
42 void
43 error_at_line (struct fileloc *pos, const char *msg, ...)
44 {
45   va_list ap;
46
47   va_start (ap, msg);
48
49   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
50   vfprintf (stderr, msg, ap);
51   fputc ('\n', stderr);
52   hit_error = 1;
53
54   va_end (ap);
55 }
56
57 /* vasprintf, but produces fatal message on out-of-memory.  */
58 int
59 xvasprintf (char **result, const char *format, va_list args)
60 {
61   int ret = vasprintf (result, format, args);
62   if (*result == NULL || ret < 0)
63     {
64       fputs ("gengtype: out of memory", stderr);
65       xexit (1);
66     }
67   return ret;
68 }
69
70 /* Wrapper for xvasprintf.  */
71 char *
72 xasprintf (const char *format, ...)
73 {
74   char *result;
75   va_list ap;
76
77   va_start (ap, format);
78   xvasprintf (&result, format, ap);
79   va_end (ap);
80   return result;
81 }
82
83 /* The one and only TYPE_STRING.  */
84
85 struct type string_type = {
86   TYPE_STRING, NULL, NULL, GC_USED, {0}
87 };
88
89 /* Lists of various things.  */
90
91 static pair_p typedefs;
92 static type_p structures;
93 static type_p param_structs;
94 static pair_p variables;
95
96 static void do_scalar_typedef (const char *, struct fileloc *);
97 static type_p find_param_structure
98   (type_p t, type_p param[NUM_PARAM]);
99 static type_p adjust_field_tree_exp (type_p t, options_p opt);
100 static type_p adjust_field_rtx_def (type_p t, options_p opt);
101
102 /* Define S as a typedef to T at POS.  */
103
104 void
105 do_typedef (const char *s, type_p t, struct fileloc *pos)
106 {
107   pair_p p;
108
109   for (p = typedefs; p != NULL; p = p->next)
110     if (strcmp (p->name, s) == 0)
111       {
112         if (p->type != t)
113           {
114             error_at_line (pos, "type `%s' previously defined", s);
115             error_at_line (&p->line, "previously defined here");
116           }
117         return;
118       }
119
120   p = xmalloc (sizeof (struct pair));
121   p->next = typedefs;
122   p->name = s;
123   p->type = t;
124   p->line = *pos;
125   typedefs = p;
126 }
127
128 /* Define S as a typename of a scalar.  */
129
130 static void
131 do_scalar_typedef (const char *s, struct fileloc *pos)
132 {
133   do_typedef (s, create_scalar_type (s, strlen (s)), pos);
134 }
135
136 /* Return the type previously defined for S.  Use POS to report errors.  */
137
138 type_p
139 resolve_typedef (const char *s, struct fileloc *pos)
140 {
141   pair_p p;
142   for (p = typedefs; p != NULL; p = p->next)
143     if (strcmp (p->name, s) == 0)
144       return p->type;
145   error_at_line (pos, "unidentified type `%s'", s);
146   return create_scalar_type ("char", 4);
147 }
148
149 /* Create a new structure with tag NAME (or a union iff ISUNION is nonzero),
150    at POS with fields FIELDS and options O.  */
151
152 void
153 new_structure (const char *name, int isunion, struct fileloc *pos,
154                pair_p fields, options_p o)
155 {
156   type_p si;
157   type_p s = NULL;
158   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
159
160   for (si = structures; si != NULL; si = si->next)
161     if (strcmp (name, si->u.s.tag) == 0
162         && UNION_P (si) == isunion)
163       {
164         type_p ls = NULL;
165         if (si->kind == TYPE_LANG_STRUCT)
166           {
167             ls = si;
168
169             for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
170               if (si->u.s.bitmap == bitmap)
171                 s = si;
172           }
173         else if (si->u.s.line.file != NULL && si->u.s.bitmap != bitmap)
174           {
175             ls = si;
176             si = xcalloc (1, sizeof (struct type));
177             memcpy (si, ls, sizeof (struct type));
178             ls->kind = TYPE_LANG_STRUCT;
179             ls->u.s.lang_struct = si;
180             ls->u.s.fields = NULL;
181             si->next = NULL;
182             si->pointer_to = NULL;
183             si->u.s.lang_struct = ls;
184           }
185         else
186           s = si;
187
188         if (ls != NULL && s == NULL)
189           {
190             s = xcalloc (1, sizeof (struct type));
191             s->next = ls->u.s.lang_struct;
192             ls->u.s.lang_struct = s;
193             s->u.s.lang_struct = ls;
194           }
195         break;
196       }
197
198   if (s == NULL)
199     {
200       s = xcalloc (1, sizeof (struct type));
201       s->next = structures;
202       structures = s;
203     }
204
205   if (s->u.s.line.file != NULL
206       || (s->u.s.lang_struct && (s->u.s.lang_struct->u.s.bitmap & bitmap)))
207     {
208       error_at_line (pos, "duplicate structure definition");
209       error_at_line (&s->u.s.line, "previous definition here");
210     }
211
212   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
213   s->u.s.tag = name;
214   s->u.s.line = *pos;
215   s->u.s.fields = fields;
216   s->u.s.opt = o;
217   s->u.s.bitmap = bitmap;
218   if (s->u.s.lang_struct)
219     s->u.s.lang_struct->u.s.bitmap |= bitmap;
220 }
221
222 /* Return the previously-defined structure with tag NAME (or a union
223    iff ISUNION is nonzero), or a new empty structure or union if none
224    was defined previously.  */
225
226 type_p
227 find_structure (const char *name, int isunion)
228 {
229   type_p s;
230
231   for (s = structures; s != NULL; s = s->next)
232     if (strcmp (name, s->u.s.tag) == 0
233         && UNION_P (s) == isunion)
234       return s;
235
236   s = xcalloc (1, sizeof (struct type));
237   s->next = structures;
238   structures = s;
239   s->kind = isunion ? TYPE_UNION : TYPE_STRUCT;
240   s->u.s.tag = name;
241   structures = s;
242   return s;
243 }
244
245 /* Return the previously-defined parameterized structure for structure
246    T and parameters PARAM, or a new parameterized empty structure or
247    union if none was defined previously.  */
248
249 static type_p
250 find_param_structure (type_p t, type_p param[NUM_PARAM])
251 {
252   type_p res;
253
254   for (res = param_structs; res; res = res->next)
255     if (res->u.param_struct.stru == t
256         && memcmp (res->u.param_struct.param, param,
257                    sizeof (type_p) * NUM_PARAM) == 0)
258       break;
259   if (res == NULL)
260     {
261       res = xcalloc (1, sizeof (*res));
262       res->kind = TYPE_PARAM_STRUCT;
263       res->next = param_structs;
264       param_structs = res;
265       res->u.param_struct.stru = t;
266       memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
267     }
268   return res;
269 }
270
271 /* Return a scalar type with name NAME.  */
272
273 type_p
274 create_scalar_type (const char *name, size_t name_len)
275 {
276   type_p r = xcalloc (1, sizeof (struct type));
277   r->kind = TYPE_SCALAR;
278   r->u.sc = xmemdup (name, name_len, name_len + 1);
279   return r;
280 }
281
282 /* Return a pointer to T.  */
283
284 type_p
285 create_pointer (type_p t)
286 {
287   if (! t->pointer_to)
288     {
289       type_p r = xcalloc (1, sizeof (struct type));
290       r->kind = TYPE_POINTER;
291       r->u.p = t;
292       t->pointer_to = r;
293     }
294   return t->pointer_to;
295 }
296
297 /* Return an array of length LEN.  */
298
299 type_p
300 create_array (type_p t, const char *len)
301 {
302   type_p v;
303
304   v = xcalloc (1, sizeof (*v));
305   v->kind = TYPE_ARRAY;
306   v->u.a.p = t;
307   v->u.a.len = len;
308   return v;
309 }
310
311 /* Return an options structure with name NAME and info INFO.  */
312 options_p
313 create_option (const char *name, void *info)
314 {
315   options_p o = xmalloc (sizeof (*o));
316   o->name = name;
317   o->info = info;
318   return o;
319 }
320
321 /* Add a variable named S of type T with options O defined at POS,
322    to `variables'.  */
323
324 void
325 note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
326 {
327   pair_p n;
328   n = xmalloc (sizeof (*n));
329   n->name = s;
330   n->type = t;
331   n->line = *pos;
332   n->opt = o;
333   n->next = variables;
334   variables = n;
335 }
336
337 /* We really don't care how long a CONST_DOUBLE is.  */
338 #define CONST_DOUBLE_FORMAT "ww"
339 const char * const rtx_format[NUM_RTX_CODE] = {
340 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
341 #include "rtl.def"
342 #undef DEF_RTL_EXPR
343 };
344
345 static int rtx_next_new[NUM_RTX_CODE];
346
347 /* Generate the contents of the rtx_next array.  This really doesn't belong
348    in gengtype at all, but it's needed for adjust_field_rtx_def.  */
349
350 static void
351 gen_rtx_next (void)
352 {
353   int i;
354   for (i = 0; i < NUM_RTX_CODE; i++)
355     {
356       int k;
357
358       rtx_next_new[i] = -1;
359       if (strncmp (rtx_format[i], "iuu", 3) == 0)
360         rtx_next_new[i] = 2;
361       else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
362         rtx_next_new[i] = 1;
363       else
364         for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
365           if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
366             rtx_next_new[i] = k;
367     }
368 }
369
370 /* Write out the contents of the rtx_next array.  */
371 static void
372 write_rtx_next (void)
373 {
374   outf_p f = get_output_file_with_visibility (NULL);
375   int i;
376
377   oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
378   oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
379   for (i = 0; i < NUM_RTX_CODE; i++)
380     if (rtx_next_new[i] == -1)
381       oprintf (f, "  0,\n");
382     else
383       oprintf (f,
384                "  RTX_HDR_SIZE + %d * sizeof (rtunion),\n",
385                rtx_next_new[i]);
386   oprintf (f, "};\n");
387 }
388
389 /* Handle `special("rtx_def")'.  This is a special case for field
390    `fld' of struct rtx_def, which is an array of unions whose values
391    are based in a complex way on the type of RTL.  */
392
393 static type_p
394 adjust_field_rtx_def (type_p t, options_p opt ATTRIBUTE_UNUSED)
395 {
396   pair_p flds = NULL;
397   options_p nodot;
398   int i;
399   type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
400   type_p bitmap_tp, basic_block_tp, reg_attrs_tp;
401
402   static const char * const rtx_name[NUM_RTX_CODE] = {
403 #define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
404 #include "rtl.def"
405 #undef DEF_RTL_EXPR
406   };
407
408   if (t->kind != TYPE_UNION)
409     {
410       error_at_line (&lexer_line,
411                      "special `rtx_def' must be applied to a union");
412       return &string_type;
413     }
414
415   nodot = xmalloc (sizeof (*nodot));
416   nodot->next = NULL;
417   nodot->name = "dot";
418   nodot->info = "";
419
420   rtx_tp = create_pointer (find_structure ("rtx_def", 0));
421   rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
422   tree_tp = create_pointer (find_structure ("tree_node", 1));
423   mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
424   reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
425   bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
426   basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
427   scalar_tp = create_scalar_type ("rtunion scalar", 14);
428
429   {
430     pair_p note_flds = NULL;
431     int c;
432
433     for (c = NOTE_INSN_BIAS; c <= NOTE_INSN_MAX; c++)
434       {
435         pair_p old_note_flds = note_flds;
436
437         note_flds = xmalloc (sizeof (*note_flds));
438         note_flds->line.file = __FILE__;
439         note_flds->line.line = __LINE__;
440         note_flds->opt = xmalloc (sizeof (*note_flds->opt));
441         note_flds->opt->next = nodot;
442         note_flds->opt->name = "tag";
443         note_flds->opt->info = xasprintf ("%d", c);
444         note_flds->next = old_note_flds;
445
446         switch (c)
447           {
448             /* NOTE_INSN_MAX is used as the default field for line
449                number notes.  */
450           case NOTE_INSN_MAX:
451             note_flds->opt->name = "default";
452             note_flds->name = "rtstr";
453             note_flds->type = &string_type;
454             break;
455
456           case NOTE_INSN_BLOCK_BEG:
457           case NOTE_INSN_BLOCK_END:
458             note_flds->name = "rttree";
459             note_flds->type = tree_tp;
460             break;
461
462           case NOTE_INSN_EXPECTED_VALUE:
463           case NOTE_INSN_VAR_LOCATION:
464             note_flds->name = "rtx";
465             note_flds->type = rtx_tp;
466             break;
467
468           default:
469             note_flds->name = "rtint";
470             note_flds->type = scalar_tp;
471             break;
472           }
473       }
474     new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
475   }
476
477   note_union_tp = find_structure ("rtx_def_note_subunion", 1);
478
479   for (i = 0; i < NUM_RTX_CODE; i++)
480     {
481       pair_p old_flds = flds;
482       pair_p subfields = NULL;
483       size_t aindex, nmindex;
484       const char *sname;
485       char *ftag;
486
487       for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
488         {
489           pair_p old_subf = subfields;
490           type_p t;
491           const char *subname;
492
493           switch (rtx_format[i][aindex])
494             {
495             case '*':
496             case 'i':
497             case 'n':
498             case 'w':
499               t = scalar_tp;
500               subname = "rtint";
501               break;
502
503             case '0':
504               if (i == MEM && aindex == 1)
505                 t = mem_attrs_tp, subname = "rtmem";
506               else if (i == JUMP_INSN && aindex == 9)
507                 t = rtx_tp, subname = "rtx";
508               else if (i == CODE_LABEL && aindex == 4)
509                 t = scalar_tp, subname = "rtint";
510               else if (i == CODE_LABEL && aindex == 5)
511                 t = rtx_tp, subname = "rtx";
512               else if (i == LABEL_REF
513                        && (aindex == 1 || aindex == 2))
514                 t = rtx_tp, subname = "rtx";
515               else if (i == NOTE && aindex == 4)
516                 t = note_union_tp, subname = "";
517               else if (i == NOTE && aindex >= 7)
518                 t = scalar_tp, subname = "rtint";
519               else if (i == ADDR_DIFF_VEC && aindex == 4)
520                 t = scalar_tp, subname = "rtint";
521               else if (i == VALUE && aindex == 0)
522                 t = scalar_tp, subname = "rtint";
523               else if (i == REG && aindex == 1)
524                 t = scalar_tp, subname = "rtint";
525               else if (i == REG && aindex == 2)
526                 t = reg_attrs_tp, subname = "rtreg";
527               else if (i == SCRATCH && aindex == 0)
528                 t = scalar_tp, subname = "rtint";
529               else if (i == SYMBOL_REF && aindex == 1)
530                 t = scalar_tp, subname = "rtint";
531               else if (i == SYMBOL_REF && aindex == 2)
532                 t = tree_tp, subname = "rttree";
533               else if (i == BARRIER && aindex >= 3)
534                 t = scalar_tp, subname = "rtint";
535               else
536                 {
537                   error_at_line (&lexer_line,
538                         "rtx type `%s' has `0' in position %lu, can't handle",
539                                  rtx_name[i], (unsigned long) aindex);
540                   t = &string_type;
541                   subname = "rtint";
542                 }
543               break;
544
545             case 's':
546             case 'S':
547             case 'T':
548               t = &string_type;
549               subname = "rtstr";
550               break;
551
552             case 'e':
553             case 'u':
554               t = rtx_tp;
555               subname = "rtx";
556               break;
557
558             case 'E':
559             case 'V':
560               t = rtvec_tp;
561               subname = "rtvec";
562               break;
563
564             case 't':
565               t = tree_tp;
566               subname = "rttree";
567               break;
568
569             case 'b':
570               t = bitmap_tp;
571               subname = "rtbit";
572               break;
573
574             case 'B':
575               t = basic_block_tp;
576               subname = "bb";
577               break;
578
579             default:
580               error_at_line (&lexer_line,
581                      "rtx type `%s' has `%c' in position %lu, can't handle",
582                              rtx_name[i], rtx_format[i][aindex],
583                              (unsigned long)aindex);
584               t = &string_type;
585               subname = "rtint";
586               break;
587             }
588
589           subfields = xmalloc (sizeof (*subfields));
590           subfields->next = old_subf;
591           subfields->type = t;
592           subfields->name = xasprintf (".fld[%lu].%s", (unsigned long)aindex,
593                                        subname);
594           subfields->line.file = __FILE__;
595           subfields->line.line = __LINE__;
596           if (t == note_union_tp)
597             {
598               subfields->opt = xmalloc (sizeof (*subfields->opt));
599               subfields->opt->next = nodot;
600               subfields->opt->name = "desc";
601               subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
602             }
603           else if (t == basic_block_tp)
604             {
605               /* We don't presently GC basic block structures...  */
606               subfields->opt = xmalloc (sizeof (*subfields->opt));
607               subfields->opt->next = nodot;
608               subfields->opt->name = "skip";
609               subfields->opt->info = NULL;
610             }
611           else
612             subfields->opt = nodot;
613         }
614
615       flds = xmalloc (sizeof (*flds));
616       flds->next = old_flds;
617       flds->name = "";
618       sname = xasprintf ("rtx_def_%s", rtx_name[i]);
619       new_structure (sname, 0, &lexer_line, subfields, NULL);
620       flds->type = find_structure (sname, 0);
621       flds->line.file = __FILE__;
622       flds->line.line = __LINE__;
623       flds->opt = xmalloc (sizeof (*flds->opt));
624       flds->opt->next = nodot;
625       flds->opt->name = "tag";
626       ftag = xstrdup (rtx_name[i]);
627       for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
628         ftag[nmindex] = TOUPPER (ftag[nmindex]);
629       flds->opt->info = ftag;
630     }
631
632   new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
633   return find_structure ("rtx_def_subunion", 1);
634 }
635
636 /* Handle `special("tree_exp")'.  This is a special case for
637    field `operands' of struct tree_exp, which although it claims to contain
638    pointers to trees, actually sometimes contains pointers to RTL too.
639    Passed T, the old type of the field, and OPT its options.  Returns
640    a new type for the field.  */
641
642 static type_p
643 adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
644 {
645   pair_p flds;
646   options_p nodot;
647   size_t i;
648   static const struct {
649     const char *name;
650     int first_rtl;
651     int num_rtl;
652   } data[] = {
653     { "GOTO_SUBROUTINE_EXPR", 0, 2 },
654     { "WITH_CLEANUP_EXPR", 2, 1 },
655   };
656
657   if (t->kind != TYPE_ARRAY)
658     {
659       error_at_line (&lexer_line,
660                      "special `tree_exp' must be applied to an array");
661       return &string_type;
662     }
663
664   nodot = xmalloc (sizeof (*nodot));
665   nodot->next = NULL;
666   nodot->name = "dot";
667   nodot->info = "";
668
669   flds = xmalloc (sizeof (*flds));
670   flds->next = NULL;
671   flds->name = "";
672   flds->type = t;
673   flds->line.file = __FILE__;
674   flds->line.line = __LINE__;
675   flds->opt = xmalloc (sizeof (*flds->opt));
676   flds->opt->next = nodot;
677   flds->opt->name = "length";
678   flds->opt->info = "TREE_CODE_LENGTH (TREE_CODE ((tree) &%0))";
679   {
680     options_p oldopt = flds->opt;
681     flds->opt = xmalloc (sizeof (*flds->opt));
682     flds->opt->next = oldopt;
683     flds->opt->name = "default";
684     flds->opt->info = "";
685   }
686
687   for (i = 0; i < ARRAY_SIZE (data); i++)
688     {
689       pair_p old_flds = flds;
690       pair_p subfields = NULL;
691       int r_index;
692       const char *sname;
693
694       for (r_index = 0;
695            r_index < data[i].first_rtl + data[i].num_rtl;
696            r_index++)
697         {
698           pair_p old_subf = subfields;
699           subfields = xmalloc (sizeof (*subfields));
700           subfields->next = old_subf;
701           subfields->name = xasprintf ("[%d]", r_index);
702           if (r_index < data[i].first_rtl)
703             subfields->type = t->u.a.p;
704           else
705             subfields->type = create_pointer (find_structure ("rtx_def", 0));
706           subfields->line.file = __FILE__;
707           subfields->line.line = __LINE__;
708           subfields->opt = nodot;
709         }
710
711       flds = xmalloc (sizeof (*flds));
712       flds->next = old_flds;
713       flds->name = "";
714       sname = xasprintf ("tree_exp_%s", data[i].name);
715       new_structure (sname, 0, &lexer_line, subfields, NULL);
716       flds->type = find_structure (sname, 0);
717       flds->line.file = __FILE__;
718       flds->line.line = __LINE__;
719       flds->opt = xmalloc (sizeof (*flds->opt));
720       flds->opt->next = nodot;
721       flds->opt->name = "tag";
722       flds->opt->info = data[i].name;
723     }
724
725   new_structure ("tree_exp_subunion", 1, &lexer_line, flds, nodot);
726   return find_structure ("tree_exp_subunion", 1);
727 }
728
729 /* Perform any special processing on a type T, about to become the type
730    of a field.  Return the appropriate type for the field.
731    At present:
732    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
733    - Similarly for arrays of pointer-to-char;
734    - Converts structures for which a parameter is provided to
735      TYPE_PARAM_STRUCT;
736    - Handles "special" options.
737 */
738
739 type_p
740 adjust_field_type (type_p t, options_p opt)
741 {
742   int length_p = 0;
743   const int pointer_p = t->kind == TYPE_POINTER;
744   type_p params[NUM_PARAM];
745   int params_p = 0;
746   int i;
747
748   for (i = 0; i < NUM_PARAM; i++)
749     params[i] = NULL;
750
751   for (; opt; opt = opt->next)
752     if (strcmp (opt->name, "length") == 0)
753       length_p = 1;
754     else if (strcmp (opt->name, "param_is") == 0
755              || (strncmp (opt->name, "param", 5) == 0
756                  && ISDIGIT (opt->name[5])
757                  && strcmp (opt->name + 6, "_is") == 0))
758       {
759         int num = ISDIGIT (opt->name[5]) ? opt->name[5] - '0' : 0;
760
761         if (! UNION_OR_STRUCT_P (t)
762             && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
763           {
764             error_at_line (&lexer_line,
765    "option `%s' may only be applied to structures or structure pointers",
766                            opt->name);
767             return t;
768           }
769
770         params_p = 1;
771         if (params[num] != NULL)
772           error_at_line (&lexer_line, "duplicate `%s' option", opt->name);
773         if (! ISDIGIT (opt->name[5]))
774           params[num] = create_pointer ((type_p) opt->info);
775         else
776           params[num] = (type_p) opt->info;
777       }
778     else if (strcmp (opt->name, "special") == 0)
779       {
780         const char *special_name = (const char *)opt->info;
781         if (strcmp (special_name, "tree_exp") == 0)
782           t = adjust_field_tree_exp (t, opt);
783         else if (strcmp (special_name, "rtx_def") == 0)
784           t = adjust_field_rtx_def (t, opt);
785         else
786           error_at_line (&lexer_line, "unknown special `%s'", special_name);
787       }
788
789   if (params_p)
790     {
791       type_p realt;
792
793       if (pointer_p)
794         t = t->u.p;
795       realt = find_param_structure (t, params);
796       t = pointer_p ? create_pointer (realt) : realt;
797     }
798
799   if (! length_p
800       && pointer_p
801       && t->u.p->kind == TYPE_SCALAR
802       && (strcmp (t->u.p->u.sc, "char") == 0
803           || strcmp (t->u.p->u.sc, "unsigned char") == 0))
804     return &string_type;
805   if (t->kind == TYPE_ARRAY && t->u.a.p->kind == TYPE_POINTER
806       && t->u.a.p->u.p->kind == TYPE_SCALAR
807       && (strcmp (t->u.a.p->u.p->u.sc, "char") == 0
808           || strcmp (t->u.a.p->u.p->u.sc, "unsigned char") == 0))
809     return create_array (&string_type, t->u.a.len);
810
811   return t;
812 }
813
814 /* Create a union for YYSTYPE, as yacc would do it, given a fieldlist FIELDS
815    and information about the correspondence between token types and fields
816    in TYPEINFO.  POS is used for error messages.  */
817
818 void
819 note_yacc_type (options_p o, pair_p fields, pair_p typeinfo,
820                 struct fileloc *pos)
821 {
822   pair_p p;
823   pair_p *p_p;
824
825   for (p = typeinfo; p; p = p->next)
826     {
827       pair_p m;
828
829       if (p->name == NULL)
830         continue;
831
832       if (p->type == (type_p) 1)
833         {
834           pair_p pp;
835           int ok = 0;
836
837           for (pp = typeinfo; pp; pp = pp->next)
838             if (pp->type != (type_p) 1
839                 && strcmp (pp->opt->info, p->opt->info) == 0)
840               {
841                 ok = 1;
842                 break;
843               }
844           if (! ok)
845             continue;
846         }
847
848       for (m = fields; m; m = m->next)
849         if (strcmp (m->name, p->name) == 0)
850           p->type = m->type;
851       if (p->type == NULL)
852         {
853           error_at_line (&p->line,
854                          "couldn't match fieldname `%s'", p->name);
855           p->name = NULL;
856         }
857     }
858
859   p_p = &typeinfo;
860   while (*p_p)
861     {
862       pair_p p = *p_p;
863
864       if (p->name == NULL
865           || p->type == (type_p) 1)
866         *p_p = p->next;
867       else
868         p_p = &p->next;
869     }
870
871   new_structure ("yy_union", 1, pos, typeinfo, o);
872   do_typedef ("YYSTYPE", find_structure ("yy_union", 1), pos);
873 }
874 \f
875 static void process_gc_options (options_p, enum gc_used_enum,
876                                 int *, int *, int *, type_p *);
877 static void set_gc_used_type (type_p, enum gc_used_enum, type_p *);
878 static void set_gc_used (pair_p);
879
880 /* Handle OPT for set_gc_used_type.  */
881
882 static void
883 process_gc_options (options_p opt, enum gc_used_enum level, int *maybe_undef,
884                     int *pass_param, int *length, type_p *nested_ptr)
885 {
886   options_p o;
887   for (o = opt; o; o = o->next)
888     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
889       set_gc_used_type ((type_p) o->info, GC_POINTED_TO, NULL);
890     else if (strcmp (o->name, "maybe_undef") == 0)
891       *maybe_undef = 1;
892     else if (strcmp (o->name, "use_params") == 0)
893       *pass_param = 1;
894     else if (strcmp (o->name, "length") == 0)
895       *length = 1;
896     else if (strcmp (o->name, "nested_ptr") == 0)
897       *nested_ptr = ((const struct nested_ptr_data *) o->info)->type;
898 }
899
900 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
901
902 static void
903 set_gc_used_type (type_p t, enum gc_used_enum level, type_p param[NUM_PARAM])
904 {
905   if (t->gc_used >= level)
906     return;
907
908   t->gc_used = level;
909
910   switch (t->kind)
911     {
912     case TYPE_STRUCT:
913     case TYPE_UNION:
914       {
915         pair_p f;
916         int dummy;
917         type_p dummy2;
918
919         process_gc_options (t->u.s.opt, level, &dummy, &dummy, &dummy,
920                             &dummy2);
921
922         for (f = t->u.s.fields; f; f = f->next)
923           {
924             int maybe_undef = 0;
925             int pass_param = 0;
926             int length = 0;
927             type_p nested_ptr = NULL;
928             process_gc_options (f->opt, level, &maybe_undef, &pass_param,
929                                 &length, &nested_ptr);
930
931             if (nested_ptr && f->type->kind == TYPE_POINTER)
932               set_gc_used_type (nested_ptr, GC_POINTED_TO, 
933                                 pass_param ? param : NULL);
934             else if (length && f->type->kind == TYPE_POINTER)
935               set_gc_used_type (f->type->u.p, GC_USED, NULL);
936             else if (maybe_undef && f->type->kind == TYPE_POINTER)
937               set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO, NULL);
938             else if (pass_param && f->type->kind == TYPE_POINTER && param)
939               set_gc_used_type (find_param_structure (f->type->u.p, param),
940                                 GC_POINTED_TO, NULL);
941             else
942               set_gc_used_type (f->type, GC_USED, pass_param ? param : NULL);
943           }
944         break;
945       }
946
947     case TYPE_POINTER:
948       set_gc_used_type (t->u.p, GC_POINTED_TO, NULL);
949       break;
950
951     case TYPE_ARRAY:
952       set_gc_used_type (t->u.a.p, GC_USED, param);
953       break;
954
955     case TYPE_LANG_STRUCT:
956       for (t = t->u.s.lang_struct; t; t = t->next)
957         set_gc_used_type (t, level, param);
958       break;
959
960     case TYPE_PARAM_STRUCT:
961       {
962         int i;
963         for (i = 0; i < NUM_PARAM; i++)
964           if (t->u.param_struct.param[i] != 0)
965             set_gc_used_type (t->u.param_struct.param[i], GC_USED, NULL);
966       }
967       if (t->u.param_struct.stru->gc_used == GC_POINTED_TO)
968         level = GC_POINTED_TO;
969       else
970         level = GC_USED;
971       t->u.param_struct.stru->gc_used = GC_UNUSED;
972       set_gc_used_type (t->u.param_struct.stru, level,
973                         t->u.param_struct.param);
974       break;
975
976     default:
977       break;
978     }
979 }
980
981 /* Set the gc_used fields of all the types pointed to by VARIABLES.  */
982
983 static void
984 set_gc_used (pair_p variables)
985 {
986   pair_p p;
987   for (p = variables; p; p = p->next)
988     set_gc_used_type (p->type, GC_USED, NULL);
989 }
990 \f
991 /* File mapping routines.  For each input file, there is one output .c file
992    (but some output files have many input files), and there is one .h file
993    for the whole build.  */
994
995 /* The list of output files.  */
996 static outf_p output_files;
997
998 /* The output header file that is included into pretty much every
999    source file.  */
1000 static outf_p header_file;
1001
1002 /* Number of files specified in gtfiles.  */
1003 #define NUM_GT_FILES (ARRAY_SIZE (all_files) - 1)
1004
1005 /* Number of files in the language files array.  */
1006 #define NUM_LANG_FILES (ARRAY_SIZE (lang_files) - 1)
1007
1008 /* Length of srcdir name.  */
1009 static int srcdir_len = 0;
1010
1011 #define NUM_BASE_FILES (ARRAY_SIZE (lang_dir_names) - 1)
1012 outf_p base_files[NUM_BASE_FILES];
1013
1014 static outf_p create_file (const char *, const char *);
1015 static const char * get_file_basename (const char *);
1016
1017 /* Create and return an outf_p for a new file for NAME, to be called
1018    ONAME.  */
1019
1020 static outf_p
1021 create_file (const char *name, const char *oname)
1022 {
1023   static const char *const hdr[] = {
1024     "   Copyright (C) 2004 Free Software Foundation, Inc.\n",
1025     "\n",
1026     "This file is part of GCC.\n",
1027     "\n",
1028     "GCC is free software; you can redistribute it and/or modify it under\n",
1029     "the terms of the GNU General Public License as published by the Free\n",
1030     "Software Foundation; either version 2, or (at your option) any later\n",
1031     "version.\n",
1032     "\n",
1033     "GCC is distributed in the hope that it will be useful, but WITHOUT ANY\n",
1034     "WARRANTY; without even the implied warranty of MERCHANTABILITY or\n",
1035     "FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License\n",
1036     "for more details.\n",
1037     "\n",
1038     "You should have received a copy of the GNU General Public License\n",
1039     "along with GCC; see the file COPYING.  If not, write to the Free\n",
1040     "Software Foundation, 59 Temple Place - Suite 330, Boston, MA\n",
1041     "02111-1307, USA.  */\n",
1042     "\n",
1043     "/* This file is machine generated.  Do not edit.  */\n"
1044   };
1045   outf_p f;
1046   size_t i;
1047
1048   f = xcalloc (sizeof (*f), 1);
1049   f->next = output_files;
1050   f->name = oname;
1051   output_files = f;
1052
1053   oprintf (f, "/* Type information for %s.\n", name);
1054   for (i = 0; i < ARRAY_SIZE (hdr); i++)
1055     oprintf (f, "%s", hdr[i]);
1056   return f;
1057 }
1058
1059 /* Print, like fprintf, to O.  */
1060 void
1061 oprintf (outf_p o, const char *format, ...)
1062 {
1063   char *s;
1064   size_t slength;
1065   va_list ap;
1066
1067   va_start (ap, format);
1068   slength = xvasprintf (&s, format, ap);
1069
1070   if (o->bufused + slength > o->buflength)
1071     {
1072       size_t new_len = o->buflength;
1073       if (new_len == 0)
1074         new_len = 1024;
1075       do {
1076         new_len *= 2;
1077       } while (o->bufused + slength >= new_len);
1078       o->buf = xrealloc (o->buf, new_len);
1079       o->buflength = new_len;
1080     }
1081   memcpy (o->buf + o->bufused, s, slength);
1082   o->bufused += slength;
1083   free (s);
1084   va_end (ap);
1085 }
1086
1087 /* Open the global header file and the language-specific header files.  */
1088
1089 static void
1090 open_base_files (void)
1091 {
1092   size_t i;
1093
1094   header_file = create_file ("GCC", "gtype-desc.h");
1095
1096   for (i = 0; i < NUM_BASE_FILES; i++)
1097     base_files[i] = create_file (lang_dir_names[i],
1098                                  xasprintf ("gtype-%s.h", lang_dir_names[i]));
1099
1100   /* gtype-desc.c is a little special, so we create it here.  */
1101   {
1102     /* The order of files here matters very much.  */
1103     static const char *const ifiles [] = {
1104       "config.h", "system.h", "coretypes.h", "tm.h", "varray.h", 
1105       "hashtab.h", "splay-tree.h", "bitmap.h", "input.h", "tree.h", "rtl.h",
1106       "function.h", "insn-config.h", "expr.h", "hard-reg-set.h",
1107       "basic-block.h", "cselib.h", "insn-addr.h", "optabs.h",
1108       "libfuncs.h", "debug.h", "ggc.h", "cgraph.h",
1109       "tree-alias-type.h", "tree-flow.h", "reload.h",
1110       "cpp-id-data.h",
1111       "tree-chrec.h",
1112       NULL
1113     };
1114     const char *const *ifp;
1115     outf_p gtype_desc_c;
1116
1117     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
1118     for (ifp = ifiles; *ifp; ifp++)
1119       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
1120   }
1121 }
1122
1123 /* Determine the pathname to F relative to $(srcdir).  */
1124
1125 static const char *
1126 get_file_basename (const char *f)
1127 {
1128   const char *basename;
1129   unsigned i;
1130
1131   basename = strrchr (f, '/');
1132
1133   if (!basename)
1134     return f;
1135
1136   basename++;
1137
1138   for (i = 1; i < NUM_BASE_FILES; i++)
1139     {
1140       const char * s1;
1141       const char * s2;
1142       int l1;
1143       int l2;
1144       s1 = basename - strlen (lang_dir_names [i]) - 1;
1145       s2 = lang_dir_names [i];
1146       l1 = strlen (s1);
1147       l2 = strlen (s2);
1148       if (l1 >= l2 && !memcmp (s1, s2, l2))
1149         {
1150           basename -= l2 + 1;
1151           if ((basename - f - 1) != srcdir_len)
1152             abort (); /* Match is wrong - should be preceded by $srcdir.  */
1153           break;
1154         }
1155     }
1156
1157   return basename;
1158 }
1159
1160 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
1161    INPUT_FILE is used by <lang>.
1162
1163    This function should be written to assume that a file _is_ used
1164    if the situation is unclear.  If it wrongly assumes a file _is_ used,
1165    a linker error will result.  If it wrongly assumes a file _is not_ used,
1166    some GC roots may be missed, which is a much harder-to-debug problem.  */
1167
1168 unsigned
1169 get_base_file_bitmap (const char *input_file)
1170 {
1171   const char *basename = get_file_basename (input_file);
1172   const char *slashpos = strchr (basename, '/');
1173   unsigned j;
1174   unsigned k;
1175   unsigned bitmap;
1176
1177   if (slashpos)
1178     {
1179       size_t i;
1180       for (i = 1; i < NUM_BASE_FILES; i++)
1181         if ((size_t)(slashpos - basename) == strlen (lang_dir_names [i])
1182             && memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0)
1183           {
1184             /* It's in a language directory, set that language.  */
1185             bitmap = 1 << i;
1186             return bitmap;
1187           }
1188
1189       abort (); /* Should have found the language.  */
1190     }
1191
1192   /* If it's in any config-lang.in, then set for the languages
1193      specified.  */
1194
1195   bitmap = 0;
1196
1197   for (j = 0; j < NUM_LANG_FILES; j++)
1198     {
1199       if (!strcmp(input_file, lang_files[j]))
1200         {
1201           for (k = 0; k < NUM_BASE_FILES; k++)
1202             {
1203               if (!strcmp(lang_dir_names[k], langs_for_lang_files[j]))
1204                 bitmap |= (1 << k);
1205             }
1206         }
1207     }
1208
1209   /* Otherwise, set all languages.  */
1210   if (!bitmap)
1211     bitmap = (1 << NUM_BASE_FILES) - 1;
1212
1213   return bitmap;
1214 }
1215
1216 /* An output file, suitable for definitions, that can see declarations
1217    made in INPUT_FILE and is linked into every language that uses
1218    INPUT_FILE.  */
1219
1220 outf_p
1221 get_output_file_with_visibility (const char *input_file)
1222 {
1223   outf_p r;
1224   size_t len;
1225   const char *basename;
1226   const char *for_name;
1227   const char *output_name;
1228
1229   /* This can happen when we need a file with visibility on a
1230      structure that we've never seen.  We have to just hope that it's
1231      globally visible.  */
1232   if (input_file == NULL)
1233     input_file = "system.h";
1234
1235   /* Determine the output file name.  */
1236   basename = get_file_basename (input_file);
1237
1238   len = strlen (basename);
1239   if ((len > 2 && memcmp (basename+len-2, ".c", 2) == 0)
1240       || (len > 2 && memcmp (basename+len-2, ".y", 2) == 0)
1241       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
1242     {
1243       char *s;
1244
1245       output_name = s = xasprintf ("gt-%s", basename);
1246       for (; *s != '.'; s++)
1247         if (! ISALNUM (*s) && *s != '-')
1248           *s = '-';
1249       memcpy (s, ".h", sizeof (".h"));
1250       for_name = basename;
1251     }
1252   else if (strcmp (basename, "c-common.h") == 0)
1253     output_name = "gt-c-common.h", for_name = "c-common.c";
1254   else if (strcmp (basename, "c-tree.h") == 0)
1255     output_name = "gt-c-decl.h", for_name = "c-decl.c";
1256   else
1257     {
1258       size_t i;
1259
1260       for (i = 0; i < NUM_BASE_FILES; i++)
1261         if (memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0
1262             && basename[strlen(lang_dir_names[i])] == '/')
1263           return base_files[i];
1264
1265       output_name = "gtype-desc.c";
1266       for_name = NULL;
1267     }
1268
1269   /* Look through to see if we've ever seen this output filename before.  */
1270   for (r = output_files; r; r = r->next)
1271     if (strcmp (r->name, output_name) == 0)
1272       return r;
1273
1274   /* If not, create it.  */
1275   r = create_file (for_name, output_name);
1276
1277   return r;
1278 }
1279
1280 /* The name of an output file, suitable for definitions, that can see
1281    declarations made in INPUT_FILE and is linked into every language
1282    that uses INPUT_FILE.  */
1283
1284 const char *
1285 get_output_file_name (const char *input_file)
1286 {
1287   return get_output_file_with_visibility (input_file)->name;
1288 }
1289
1290 /* Copy the output to its final destination,
1291    but don't unnecessarily change modification times.  */
1292
1293 static void
1294 close_output_files (void)
1295 {
1296   outf_p of;
1297
1298   for (of = output_files; of; of = of->next)
1299     {
1300       FILE * newfile;
1301
1302       newfile = fopen (of->name, "r");
1303       if (newfile != NULL )
1304         {
1305           int no_write_p;
1306           size_t i;
1307
1308           for (i = 0; i < of->bufused; i++)
1309             {
1310               int ch;
1311               ch = fgetc (newfile);
1312               if (ch == EOF || ch != (unsigned char) of->buf[i])
1313                 break;
1314             }
1315           no_write_p = i == of->bufused && fgetc (newfile) == EOF;
1316           fclose (newfile);
1317
1318           if (no_write_p)
1319             continue;
1320         }
1321
1322       newfile = fopen (of->name, "w");
1323       if (newfile == NULL)
1324         {
1325           perror ("opening output file");
1326           exit (1);
1327         }
1328       if (fwrite (of->buf, 1, of->bufused, newfile) != of->bufused)
1329         {
1330           perror ("writing output file");
1331           exit (1);
1332         }
1333       if (fclose (newfile) != 0)
1334         {
1335           perror ("closing output file");
1336           exit (1);
1337         }
1338     }
1339 }
1340 \f
1341 struct flist {
1342   struct flist *next;
1343   int started_p;
1344   const char *name;
1345   outf_p f;
1346 };
1347
1348 struct walk_type_data;
1349
1350 /* For scalars and strings, given the item in 'val'.
1351    For structures, given a pointer to the item in 'val'.
1352    For misc. pointers, given the item in 'val'.
1353 */
1354 typedef void (*process_field_fn)
1355      (type_p f, const struct walk_type_data *p);
1356 typedef void (*func_name_fn)
1357      (type_p s, const struct walk_type_data *p);
1358
1359 /* Parameters for write_types.  */
1360
1361 struct write_types_data
1362 {
1363   const char *prefix;
1364   const char *param_prefix;
1365   const char *subfield_marker_routine;
1366   const char *marker_routine;
1367   const char *reorder_note_routine;
1368   const char *comment;
1369 };
1370
1371 static void output_escaped_param (struct walk_type_data *d,
1372                                   const char *, const char *);
1373 static void output_mangled_typename (outf_p, type_p);
1374 static void walk_type (type_p t, struct walk_type_data *d);
1375 static void write_func_for_structure
1376      (type_p orig_s, type_p s, type_p * param,
1377       const struct write_types_data *wtd);
1378 static void write_types_process_field
1379      (type_p f, const struct walk_type_data *d);
1380 static void write_types (type_p structures,
1381                          type_p param_structs,
1382                          const struct write_types_data *wtd);
1383 static void write_types_local_process_field
1384      (type_p f, const struct walk_type_data *d);
1385 static void write_local_func_for_structure
1386      (type_p orig_s, type_p s, type_p * param);
1387 static void write_local (type_p structures,
1388                          type_p param_structs);
1389 static void write_enum_defn (type_p structures, type_p param_structs);
1390 static int contains_scalar_p (type_p t);
1391 static void put_mangled_filename (outf_p , const char *);
1392 static void finish_root_table (struct flist *flp, const char *pfx,
1393                                const char *tname, const char *lastname,
1394                                const char *name);
1395 static void write_root (outf_p , pair_p, type_p, const char *, int,
1396                         struct fileloc *, const char *);
1397 static void write_array (outf_p f, pair_p v,
1398                          const struct write_types_data *wtd);
1399 static void write_roots (pair_p);
1400
1401 /* Parameters for walk_type.  */
1402
1403 struct walk_type_data
1404 {
1405   process_field_fn process_field;
1406   const void *cookie;
1407   outf_p of;
1408   options_p opt;
1409   const char *val;
1410   const char *prev_val[4];
1411   int indent;
1412   int counter;
1413   struct fileloc *line;
1414   lang_bitmap bitmap;
1415   type_p *param;
1416   int used_length;
1417   type_p orig_s;
1418   const char *reorder_fn;
1419   bool needs_cast_p;
1420   bool fn_wants_lvalue;
1421 };
1422
1423 /* Print a mangled name representing T to OF.  */
1424
1425 static void
1426 output_mangled_typename (outf_p of, type_p t)
1427 {
1428   if (t == NULL)
1429     oprintf (of, "Z");
1430   else switch (t->kind)
1431     {
1432     case TYPE_POINTER:
1433       oprintf (of, "P");
1434       output_mangled_typename (of, t->u.p);
1435       break;
1436     case TYPE_SCALAR:
1437       oprintf (of, "I");
1438       break;
1439     case TYPE_STRING:
1440       oprintf (of, "S");
1441       break;
1442     case TYPE_STRUCT:
1443     case TYPE_UNION:
1444     case TYPE_LANG_STRUCT:
1445       oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
1446       break;
1447     case TYPE_PARAM_STRUCT:
1448       {
1449         int i;
1450         for (i = 0; i < NUM_PARAM; i++)
1451           if (t->u.param_struct.param[i] != NULL)
1452             output_mangled_typename (of, t->u.param_struct.param[i]);
1453         output_mangled_typename (of, t->u.param_struct.stru);
1454       }
1455       break;
1456     case TYPE_ARRAY:
1457       abort ();
1458     }
1459 }
1460
1461 /* Print PARAM to D->OF processing escapes.  D->VAL references the
1462    current object, D->PREV_VAL the object containing the current
1463    object, ONAME is the name of the option and D->LINE is used to
1464    print error messages.  */
1465
1466 static void
1467 output_escaped_param (struct walk_type_data *d, const char *param,
1468                       const char *oname)
1469 {
1470   const char *p;
1471
1472   for (p = param; *p; p++)
1473     if (*p != '%')
1474       oprintf (d->of, "%c", *p);
1475     else switch (*++p)
1476       {
1477       case 'h':
1478         oprintf (d->of, "(%s)", d->prev_val[2]);
1479         break;
1480       case '0':
1481         oprintf (d->of, "(%s)", d->prev_val[0]);
1482         break;
1483       case '1':
1484         oprintf (d->of, "(%s)", d->prev_val[1]);
1485         break;
1486       case 'a':
1487         {
1488           const char *pp = d->val + strlen (d->val);
1489           while (pp[-1] == ']')
1490             while (*pp != '[')
1491               pp--;
1492           oprintf (d->of, "%s", pp);
1493         }
1494         break;
1495       default:
1496         error_at_line (d->line, "`%s' option contains bad escape %c%c",
1497                        oname, '%', *p);
1498       }
1499 }
1500
1501 /* Call D->PROCESS_FIELD for every field (or subfield) of D->VAL,
1502    which is of type T.  Write code to D->OF to constrain execution (at
1503    the point that D->PROCESS_FIELD is called) to the appropriate
1504    cases.  Call D->PROCESS_FIELD on subobjects before calling it on
1505    pointers to those objects.  D->PREV_VAL lists the objects
1506    containing the current object, D->OPT is a list of options to
1507    apply, D->INDENT is the current indentation level, D->LINE is used
1508    to print error messages, D->BITMAP indicates which languages to
1509    print the structure for, and D->PARAM is the current parameter
1510    (from an enclosing param_is option).  */
1511
1512 static void
1513 walk_type (type_p t, struct walk_type_data *d)
1514 {
1515   const char *length = NULL;
1516   const char *desc = NULL;
1517   int maybe_undef_p = 0;
1518   int use_param_num = -1;
1519   int use_params_p = 0;
1520   options_p oo;
1521   const struct nested_ptr_data *nested_ptr_d = NULL;
1522
1523   d->needs_cast_p = false;
1524   for (oo = d->opt; oo; oo = oo->next)
1525     if (strcmp (oo->name, "length") == 0)
1526       length = (const char *)oo->info;
1527     else if (strcmp (oo->name, "maybe_undef") == 0)
1528       maybe_undef_p = 1;
1529     else if (strncmp (oo->name, "use_param", 9) == 0
1530              && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1531       use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
1532     else if (strcmp (oo->name, "use_params") == 0)
1533       use_params_p = 1;
1534     else if (strcmp (oo->name, "desc") == 0)
1535       desc = (const char *)oo->info;
1536     else if (strcmp (oo->name, "nested_ptr") == 0)
1537       nested_ptr_d = (const struct nested_ptr_data *) oo->info;
1538     else if (strcmp (oo->name, "dot") == 0)
1539       ;
1540     else if (strcmp (oo->name, "tag") == 0)
1541       ;
1542     else if (strcmp (oo->name, "special") == 0)
1543       ;
1544     else if (strcmp (oo->name, "skip") == 0)
1545       ;
1546     else if (strcmp (oo->name, "default") == 0)
1547       ;
1548     else if (strcmp (oo->name, "descbits") == 0)
1549       ;
1550     else if (strcmp (oo->name, "param_is") == 0)
1551       ;
1552     else if (strncmp (oo->name, "param", 5) == 0
1553              && ISDIGIT (oo->name[5])
1554              && strcmp (oo->name + 6, "_is") == 0)
1555       ;
1556     else if (strcmp (oo->name, "chain_next") == 0)
1557       ;
1558     else if (strcmp (oo->name, "chain_prev") == 0)
1559       ;
1560     else if (strcmp (oo->name, "reorder") == 0)
1561       ;
1562     else
1563       error_at_line (d->line, "unknown option `%s'\n", oo->name);
1564
1565   if (d->used_length)
1566     length = NULL;
1567
1568   if (use_params_p)
1569     {
1570       int pointer_p = t->kind == TYPE_POINTER;
1571
1572       if (pointer_p)
1573         t = t->u.p;
1574       if (! UNION_OR_STRUCT_P (t))
1575         error_at_line (d->line, "`use_params' option on unimplemented type");
1576       else
1577         t = find_param_structure (t, d->param);
1578       if (pointer_p)
1579         t = create_pointer (t);
1580     }
1581
1582   if (use_param_num != -1)
1583     {
1584       if (d->param != NULL && d->param[use_param_num] != NULL)
1585         {
1586           type_p nt = d->param[use_param_num];
1587
1588           if (t->kind == TYPE_ARRAY)
1589             nt = create_array (nt, t->u.a.len);
1590           else if (length != NULL && t->kind == TYPE_POINTER)
1591             nt = create_pointer (nt);
1592           d->needs_cast_p = (t->kind != TYPE_POINTER
1593                              && (nt->kind == TYPE_POINTER
1594                                  || nt->kind == TYPE_STRING));
1595           t = nt;
1596         }
1597       else
1598         error_at_line (d->line, "no parameter defined for `%s'",
1599                        d->val);
1600     }
1601
1602   if (maybe_undef_p
1603       && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
1604     {
1605       error_at_line (d->line,
1606                      "field `%s' has invalid option `maybe_undef_p'\n",
1607                      d->val);
1608       return;
1609     }
1610
1611   switch (t->kind)
1612     {
1613     case TYPE_SCALAR:
1614     case TYPE_STRING:
1615       d->process_field (t, d);
1616       break;
1617
1618     case TYPE_POINTER:
1619       {
1620         if (maybe_undef_p
1621             && t->u.p->u.s.line.file == NULL)
1622           {
1623             oprintf (d->of, "%*sif (%s) abort();\n", d->indent, "", d->val);
1624             break;
1625           }
1626
1627         if (! length)
1628           {
1629             if (! UNION_OR_STRUCT_P (t->u.p)
1630                 && t->u.p->kind != TYPE_PARAM_STRUCT)
1631               {
1632                 error_at_line (d->line,
1633                                "field `%s' is pointer to unimplemented type",
1634                                d->val);
1635                 break;
1636               }
1637
1638             if (nested_ptr_d)
1639               {
1640                 const char *oldprevval2 = d->prev_val[2];
1641
1642                 if (! UNION_OR_STRUCT_P (nested_ptr_d->type))
1643                   {
1644                     error_at_line (d->line,
1645                                    "field `%s' has invalid "
1646                                    "option `nested_ptr'\n",
1647                                    d->val);
1648                     return;
1649                   }
1650
1651                 d->prev_val[2] = d->val;
1652                 oprintf (d->of, "%*s{\n", d->indent, "");
1653                 d->indent += 2;
1654                 d->val = xasprintf ("x%d", d->counter++);
1655                 oprintf (d->of, "%*s%s %s * %s%s =\n", d->indent, "",
1656                          (nested_ptr_d->type->kind == TYPE_UNION 
1657                           ? "union" : "struct"), 
1658                          nested_ptr_d->type->u.s.tag, 
1659                          d->fn_wants_lvalue ? "" : "const ",
1660                          d->val);
1661                 oprintf (d->of, "%*s", d->indent + 2, "");
1662                 output_escaped_param (d, nested_ptr_d->convert_from,
1663                                       "nested_ptr");
1664                 oprintf (d->of, ";\n");
1665
1666                 d->process_field (nested_ptr_d->type, d);
1667
1668                 if (d->fn_wants_lvalue)
1669                   {
1670                     oprintf (d->of, "%*s%s = ", d->indent, "",
1671                              d->prev_val[2]);
1672                     d->prev_val[2] = d->val;
1673                     output_escaped_param (d, nested_ptr_d->convert_to,
1674                                           "nested_ptr");
1675                     oprintf (d->of, ";\n");
1676                   }
1677
1678                 d->indent -= 2;
1679                 oprintf (d->of, "%*s}\n", d->indent, "");
1680                 d->val = d->prev_val[2];
1681                 d->prev_val[2] = oldprevval2;
1682               }
1683             else
1684               d->process_field (t->u.p, d);
1685           }
1686         else
1687           {
1688             int loopcounter = d->counter++;
1689             const char *oldval = d->val;
1690             const char *oldprevval3 = d->prev_val[3];
1691             char *newval;
1692
1693             oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
1694             d->indent += 2;
1695             oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1696             oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1697                      loopcounter, loopcounter);
1698             output_escaped_param (d, length, "length");
1699             oprintf (d->of, "); i%d++) {\n", loopcounter);
1700             d->indent += 2;
1701             d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1702             d->used_length = 1;
1703             d->prev_val[3] = oldval;
1704             walk_type (t->u.p, d);
1705             free (newval);
1706             d->val = oldval;
1707             d->prev_val[3] = oldprevval3;
1708             d->used_length = 0;
1709             d->indent -= 2;
1710             oprintf (d->of, "%*s}\n", d->indent, "");
1711             d->process_field(t, d);
1712             d->indent -= 2;
1713             oprintf (d->of, "%*s}\n", d->indent, "");
1714           }
1715       }
1716       break;
1717
1718     case TYPE_ARRAY:
1719       {
1720         int loopcounter = d->counter++;
1721         const char *oldval = d->val;
1722         char *newval;
1723
1724         /* If it's an array of scalars, we optimize by not generating
1725            any code.  */
1726         if (t->u.a.p->kind == TYPE_SCALAR)
1727           break;
1728
1729         oprintf (d->of, "%*s{\n", d->indent, "");
1730         d->indent += 2;
1731         oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
1732         oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
1733                  loopcounter, loopcounter);
1734         if (length)
1735           output_escaped_param (d, length, "length");
1736         else
1737           oprintf (d->of, "%s", t->u.a.len);
1738         oprintf (d->of, "); i%d++) {\n", loopcounter);
1739         d->indent += 2;
1740         d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
1741         d->used_length = 1;
1742         walk_type (t->u.a.p, d);
1743         free (newval);
1744         d->used_length = 0;
1745         d->val = oldval;
1746         d->indent -= 2;
1747         oprintf (d->of, "%*s}\n", d->indent, "");
1748         d->indent -= 2;
1749         oprintf (d->of, "%*s}\n", d->indent, "");
1750       }
1751       break;
1752
1753     case TYPE_STRUCT:
1754     case TYPE_UNION:
1755       {
1756         pair_p f;
1757         const char *oldval = d->val;
1758         const char *oldprevval1 = d->prev_val[1];
1759         const char *oldprevval2 = d->prev_val[2];
1760         const int union_p = t->kind == TYPE_UNION;
1761         int seen_default_p = 0;
1762         options_p o;
1763
1764         if (! t->u.s.line.file)
1765           error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
1766
1767         if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
1768           {
1769             error_at_line (d->line,
1770                            "structure `%s' defined for mismatching languages",
1771                            t->u.s.tag);
1772             error_at_line (&t->u.s.line, "one structure defined here");
1773           }
1774
1775         /* Some things may also be defined in the structure's options.  */
1776         for (o = t->u.s.opt; o; o = o->next)
1777           if (! desc && strcmp (o->name, "desc") == 0)
1778             desc = (const char *)o->info;
1779
1780         d->prev_val[2] = oldval;
1781         d->prev_val[1] = oldprevval2;
1782         if (union_p)
1783           {
1784             if (desc == NULL)
1785               {
1786                 error_at_line (d->line, "missing `desc' option for union `%s'",
1787                                t->u.s.tag);
1788                 desc = "1";
1789               }
1790             oprintf (d->of, "%*sswitch (", d->indent, "");
1791             output_escaped_param (d, desc, "desc");
1792             oprintf (d->of, ")\n");
1793             d->indent += 2;
1794             oprintf (d->of, "%*s{\n", d->indent, "");
1795           }
1796         for (f = t->u.s.fields; f; f = f->next)
1797           {
1798             options_p oo;
1799             const char *dot = ".";
1800             const char *tagid = NULL;
1801             int skip_p = 0;
1802             int default_p = 0;
1803             int use_param_p = 0;
1804             char *newval;
1805
1806             d->reorder_fn = NULL;
1807             for (oo = f->opt; oo; oo = oo->next)
1808               if (strcmp (oo->name, "dot") == 0)
1809                 dot = (const char *)oo->info;
1810               else if (strcmp (oo->name, "tag") == 0)
1811                 tagid = (const char *)oo->info;
1812               else if (strcmp (oo->name, "skip") == 0)
1813                 skip_p = 1;
1814               else if (strcmp (oo->name, "default") == 0)
1815                 default_p = 1;
1816               else if (strcmp (oo->name, "reorder") == 0)
1817                 d->reorder_fn = (const char *)oo->info;
1818               else if (strncmp (oo->name, "use_param", 9) == 0
1819                        && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
1820                 use_param_p = 1;
1821
1822             if (skip_p)
1823               continue;
1824
1825             if (union_p && tagid)
1826               {
1827                 oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
1828                 d->indent += 2;
1829               }
1830             else if (union_p && default_p)
1831               {
1832                 oprintf (d->of, "%*sdefault:\n", d->indent, "");
1833                 d->indent += 2;
1834                 seen_default_p = 1;
1835               }
1836             else if (! union_p && (default_p || tagid))
1837               error_at_line (d->line,
1838                              "can't use `%s' outside a union on field `%s'",
1839                              default_p ? "default" : "tag", f->name);
1840             else if (union_p && ! (default_p || tagid)
1841                      && f->type->kind == TYPE_SCALAR)
1842               {
1843                 fprintf (stderr,
1844         "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
1845                          d->line->file, d->line->line, f->name);
1846                 continue;
1847               }
1848             else if (union_p && ! (default_p || tagid))
1849               error_at_line (d->line,
1850                              "field `%s' is missing `tag' or `default' option",
1851                              f->name);
1852
1853             d->line = &f->line;
1854             d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
1855             d->opt = f->opt;
1856             d->used_length = false;
1857
1858             if (union_p && use_param_p && d->param == NULL)
1859               oprintf (d->of, "%*sabort();\n", d->indent, "");
1860             else
1861               walk_type (f->type, d);
1862
1863             free (newval);
1864
1865             if (union_p)
1866               {
1867                 oprintf (d->of, "%*sbreak;\n", d->indent, "");
1868                 d->indent -= 2;
1869               }
1870           }
1871         d->reorder_fn = NULL;
1872
1873         d->val = oldval;
1874         d->prev_val[1] = oldprevval1;
1875         d->prev_val[2] = oldprevval2;
1876
1877         if (union_p && ! seen_default_p)
1878           {
1879             oprintf (d->of, "%*sdefault:\n", d->indent, "");
1880             oprintf (d->of, "%*s  break;\n", d->indent, "");
1881           }
1882         if (union_p)
1883           {
1884             oprintf (d->of, "%*s}\n", d->indent, "");
1885             d->indent -= 2;
1886           }
1887       }
1888       break;
1889
1890     case TYPE_LANG_STRUCT:
1891       {
1892         type_p nt;
1893         for (nt = t->u.s.lang_struct; nt; nt = nt->next)
1894           if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
1895             break;
1896         if (nt == NULL)
1897           error_at_line (d->line, "structure `%s' differs between languages",
1898                          t->u.s.tag);
1899         else
1900           walk_type (nt, d);
1901       }
1902       break;
1903
1904     case TYPE_PARAM_STRUCT:
1905       {
1906         type_p *oldparam = d->param;
1907
1908         d->param = t->u.param_struct.param;
1909         walk_type (t->u.param_struct.stru, d);
1910         d->param = oldparam;
1911       }
1912       break;
1913
1914     default:
1915       abort ();
1916     }
1917 }
1918
1919 /* process_field routine for marking routines.  */
1920
1921 static void
1922 write_types_process_field (type_p f, const struct walk_type_data *d)
1923 {
1924   const struct write_types_data *wtd;
1925   const char *cast = d->needs_cast_p ? "(void *)" : "";
1926   wtd = (const struct write_types_data *) d->cookie;
1927
1928   switch (f->kind)
1929     {
1930     case TYPE_POINTER:
1931       oprintf (d->of, "%*s%s (%s%s", d->indent, "",
1932                wtd->subfield_marker_routine, cast, d->val);
1933       if (wtd->param_prefix)
1934         {
1935           oprintf (d->of, ", %s", d->prev_val[3]);
1936           if (d->orig_s)
1937             {
1938               oprintf (d->of, ", gt_%s_", wtd->param_prefix);
1939               output_mangled_typename (d->of, d->orig_s);
1940             }
1941           else
1942             oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
1943         }
1944       oprintf (d->of, ");\n");
1945       if (d->reorder_fn && wtd->reorder_note_routine)
1946         oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
1947                  wtd->reorder_note_routine, cast, d->val,
1948                  d->prev_val[3], d->reorder_fn);
1949       break;
1950
1951     case TYPE_STRING:
1952       if (wtd->param_prefix == NULL)
1953         break;
1954
1955     case TYPE_STRUCT:
1956     case TYPE_UNION:
1957     case TYPE_LANG_STRUCT:
1958     case TYPE_PARAM_STRUCT:
1959       oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
1960       output_mangled_typename (d->of, f);
1961       oprintf (d->of, " (%s%s);\n", cast, d->val);
1962       if (d->reorder_fn && wtd->reorder_note_routine)
1963         oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
1964                  wtd->reorder_note_routine, cast, d->val, cast, d->val,
1965                  d->reorder_fn);
1966       break;
1967
1968     case TYPE_SCALAR:
1969       break;
1970
1971     default:
1972       abort ();
1973     }
1974 }
1975
1976 /* For S, a structure that's part of ORIG_S, and using parameters
1977    PARAM, write out a routine that:
1978    - Takes a parameter, a void * but actually of type *S
1979    - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
1980      field of S or its substructures and (in some cases) things
1981      that are pointed to by S.
1982 */
1983
1984 static void
1985 write_func_for_structure (type_p orig_s, type_p s, type_p *param,
1986                           const struct write_types_data *wtd)
1987 {
1988   const char *fn = s->u.s.line.file;
1989   int i;
1990   const char *chain_next = NULL;
1991   const char *chain_prev = NULL;
1992   options_p opt;
1993   struct walk_type_data d;
1994
1995   /* This is a hack, and not the good kind either.  */
1996   for (i = NUM_PARAM - 1; i >= 0; i--)
1997     if (param && param[i] && param[i]->kind == TYPE_POINTER
1998         && UNION_OR_STRUCT_P (param[i]->u.p))
1999       fn = param[i]->u.p->u.s.line.file;
2000
2001   memset (&d, 0, sizeof (d));
2002   d.of = get_output_file_with_visibility (fn);
2003
2004   for (opt = s->u.s.opt; opt; opt = opt->next)
2005     if (strcmp (opt->name, "chain_next") == 0)
2006       chain_next = (const char *) opt->info;
2007     else if (strcmp (opt->name, "chain_prev") == 0)
2008       chain_prev = (const char *) opt->info;
2009
2010   if (chain_prev != NULL && chain_next == NULL)
2011     error_at_line (&s->u.s.line, "chain_prev without chain_next");
2012
2013   d.process_field = write_types_process_field;
2014   d.cookie = wtd;
2015   d.orig_s = orig_s;
2016   d.opt = s->u.s.opt;
2017   d.line = &s->u.s.line;
2018   d.bitmap = s->u.s.bitmap;
2019   d.param = param;
2020   d.prev_val[0] = "*x";
2021   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2022   d.prev_val[3] = "x";
2023   d.val = "(*x)";
2024
2025   oprintf (d.of, "\n");
2026   oprintf (d.of, "void\n");
2027   if (param == NULL)
2028     oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
2029   else
2030     {
2031       oprintf (d.of, "gt_%s_", wtd->prefix);
2032       output_mangled_typename (d.of, orig_s);
2033     }
2034   oprintf (d.of, " (void *x_p)\n");
2035   oprintf (d.of, "{\n");
2036   oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
2037            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2038            chain_next == NULL ? "const " : "",
2039            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2040   if (chain_next != NULL)
2041     oprintf (d.of, "  %s %s * xlimit = x;\n",
2042              s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2043   if (chain_next == NULL)
2044     {
2045       oprintf (d.of, "  if (%s (x", wtd->marker_routine);
2046       if (wtd->param_prefix)
2047         {
2048           oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
2049           output_mangled_typename (d.of, orig_s);
2050         }
2051       oprintf (d.of, "))\n");
2052     }
2053   else
2054     {
2055       oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
2056       if (wtd->param_prefix)
2057         {
2058           oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
2059           output_mangled_typename (d.of, orig_s);
2060         }
2061       oprintf (d.of, "))\n");
2062       oprintf (d.of, "   xlimit = (");
2063       d.prev_val[2] = "*xlimit";
2064       output_escaped_param (&d, chain_next, "chain_next");
2065       oprintf (d.of, ");\n");
2066       if (chain_prev != NULL)
2067         {
2068           oprintf (d.of, "  if (x != xlimit)\n");
2069           oprintf (d.of, "    for (;;)\n");
2070           oprintf (d.of, "      {\n");
2071           oprintf (d.of, "        %s %s * const xprev = (",
2072                    s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2073
2074           d.prev_val[2] = "*x";
2075           output_escaped_param (&d, chain_prev, "chain_prev");
2076           oprintf (d.of, ");\n");
2077           oprintf (d.of, "        if (xprev == NULL) break;\n");
2078           oprintf (d.of, "        x = xprev;\n");
2079           oprintf (d.of, "        (void) %s (xprev",
2080                    wtd->marker_routine);
2081           if (wtd->param_prefix)
2082             {
2083               oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
2084               output_mangled_typename (d.of, orig_s);
2085             }
2086           oprintf (d.of, ");\n");
2087           oprintf (d.of, "      }\n");
2088         }
2089       oprintf (d.of, "  while (x != xlimit)\n");
2090     }
2091   oprintf (d.of, "    {\n");
2092
2093   d.prev_val[2] = "*x";
2094   d.indent = 6;
2095   walk_type (s, &d);
2096
2097   if (chain_next != NULL)
2098     {
2099       oprintf (d.of, "      x = (");
2100       output_escaped_param (&d, chain_next, "chain_next");
2101       oprintf (d.of, ");\n");
2102     }
2103
2104   oprintf (d.of, "    }\n");
2105   oprintf (d.of, "}\n");
2106 }
2107
2108 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
2109
2110 static void
2111 write_types (type_p structures, type_p param_structs,
2112              const struct write_types_data *wtd)
2113 {
2114   type_p s;
2115
2116   oprintf (header_file, "\n/* %s*/\n", wtd->comment);
2117   for (s = structures; s; s = s->next)
2118     if (s->gc_used == GC_POINTED_TO
2119         || s->gc_used == GC_MAYBE_POINTED_TO)
2120       {
2121         options_p opt;
2122
2123         if (s->gc_used == GC_MAYBE_POINTED_TO
2124             && s->u.s.line.file == NULL)
2125           continue;
2126
2127         oprintf (header_file, "#define gt_%s_", wtd->prefix);
2128         output_mangled_typename (header_file, s);
2129         oprintf (header_file, "(X) do { \\\n");
2130         oprintf (header_file,
2131                  "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
2132                  s->u.s.tag);
2133         oprintf (header_file,
2134                  "  } while (0)\n");
2135
2136         for (opt = s->u.s.opt; opt; opt = opt->next)
2137           if (strcmp (opt->name, "ptr_alias") == 0)
2138             {
2139               type_p t = (type_p) opt->info;
2140               if (t->kind == TYPE_STRUCT
2141                   || t->kind == TYPE_UNION
2142                   || t->kind == TYPE_LANG_STRUCT)
2143                 oprintf (header_file,
2144                          "#define gt_%sx_%s gt_%sx_%s\n",
2145                          wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
2146               else
2147                 error_at_line (&s->u.s.line,
2148                                "structure alias is not a structure");
2149               break;
2150             }
2151         if (opt)
2152           continue;
2153
2154         /* Declare the marker procedure only once.  */
2155         oprintf (header_file,
2156                  "extern void gt_%sx_%s (void *);\n",
2157                  wtd->prefix, s->u.s.tag);
2158
2159         if (s->u.s.line.file == NULL)
2160           {
2161             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2162                      s->u.s.tag);
2163             continue;
2164           }
2165
2166         if (s->kind == TYPE_LANG_STRUCT)
2167           {
2168             type_p ss;
2169             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2170               write_func_for_structure (s, ss, NULL, wtd);
2171           }
2172         else
2173           write_func_for_structure (s, s, NULL, wtd);
2174       }
2175
2176   for (s = param_structs; s; s = s->next)
2177     if (s->gc_used == GC_POINTED_TO)
2178       {
2179         type_p * param = s->u.param_struct.param;
2180         type_p stru = s->u.param_struct.stru;
2181
2182         /* Declare the marker procedure.  */
2183         oprintf (header_file, "extern void gt_%s_", wtd->prefix);
2184         output_mangled_typename (header_file, s);
2185         oprintf (header_file, " (void *);\n");
2186
2187         if (stru->u.s.line.file == NULL)
2188           {
2189             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2190                      s->u.s.tag);
2191             continue;
2192           }
2193
2194         if (stru->kind == TYPE_LANG_STRUCT)
2195           {
2196             type_p ss;
2197             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2198               write_func_for_structure (s, ss, param, wtd);
2199           }
2200         else
2201           write_func_for_structure (s, stru, param, wtd);
2202       }
2203 }
2204
2205 static const struct write_types_data ggc_wtd =
2206 {
2207   "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
2208   "GC marker procedures.  "
2209 };
2210
2211 static const struct write_types_data pch_wtd =
2212 {
2213   "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
2214   "gt_pch_note_reorder",
2215   "PCH type-walking procedures.  "
2216 };
2217
2218 /* Write out the local pointer-walking routines.  */
2219
2220 /* process_field routine for local pointer-walking.  */
2221
2222 static void
2223 write_types_local_process_field (type_p f, const struct walk_type_data *d)
2224 {
2225   switch (f->kind)
2226     {
2227     case TYPE_POINTER:
2228     case TYPE_STRUCT:
2229     case TYPE_UNION:
2230     case TYPE_LANG_STRUCT:
2231     case TYPE_PARAM_STRUCT:
2232     case TYPE_STRING:
2233       oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
2234                d->prev_val[3]);
2235       oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
2236       break;
2237
2238     case TYPE_SCALAR:
2239       break;
2240
2241     default:
2242       abort ();
2243     }
2244 }
2245
2246 /* For S, a structure that's part of ORIG_S, and using parameters
2247    PARAM, write out a routine that:
2248    - Is of type gt_note_pointers
2249    - Calls PROCESS_FIELD on each field of S or its substructures.
2250 */
2251
2252 static void
2253 write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
2254 {
2255   const char *fn = s->u.s.line.file;
2256   int i;
2257   struct walk_type_data d;
2258
2259   /* This is a hack, and not the good kind either.  */
2260   for (i = NUM_PARAM - 1; i >= 0; i--)
2261     if (param && param[i] && param[i]->kind == TYPE_POINTER
2262         && UNION_OR_STRUCT_P (param[i]->u.p))
2263       fn = param[i]->u.p->u.s.line.file;
2264
2265   memset (&d, 0, sizeof (d));
2266   d.of = get_output_file_with_visibility (fn);
2267
2268   d.process_field = write_types_local_process_field;
2269   d.opt = s->u.s.opt;
2270   d.line = &s->u.s.line;
2271   d.bitmap = s->u.s.bitmap;
2272   d.param = param;
2273   d.prev_val[0] = d.prev_val[2] = "*x";
2274   d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
2275   d.prev_val[3] = "x";
2276   d.val = "(*x)";
2277   d.fn_wants_lvalue = true;
2278
2279   oprintf (d.of, "\n");
2280   oprintf (d.of, "void\n");
2281   oprintf (d.of, "gt_pch_p_");
2282   output_mangled_typename (d.of, orig_s);
2283   oprintf (d.of, " (void *this_obj ATTRIBUTE_UNUSED,\n\tvoid *x_p,\n\tgt_pointer_operator op ATTRIBUTE_UNUSED,\n\tvoid *cookie ATTRIBUTE_UNUSED)\n");
2284   oprintf (d.of, "{\n");
2285   oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
2286            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
2287            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
2288   d.indent = 2;
2289   walk_type (s, &d);
2290   oprintf (d.of, "}\n");
2291 }
2292
2293 /* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
2294
2295 static void
2296 write_local (type_p structures, type_p param_structs)
2297 {
2298   type_p s;
2299
2300   oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
2301   for (s = structures; s; s = s->next)
2302     if (s->gc_used == GC_POINTED_TO
2303         || s->gc_used == GC_MAYBE_POINTED_TO)
2304       {
2305         options_p opt;
2306
2307         if (s->u.s.line.file == NULL)
2308           continue;
2309
2310         for (opt = s->u.s.opt; opt; opt = opt->next)
2311           if (strcmp (opt->name, "ptr_alias") == 0)
2312             {
2313               type_p t = (type_p) opt->info;
2314               if (t->kind == TYPE_STRUCT
2315                   || t->kind == TYPE_UNION
2316                   || t->kind == TYPE_LANG_STRUCT)
2317                 {
2318                   oprintf (header_file, "#define gt_pch_p_");
2319                   output_mangled_typename (header_file, s);
2320                   oprintf (header_file, " gt_pch_p_");
2321                   output_mangled_typename (header_file, t);
2322                   oprintf (header_file, "\n");
2323                 }
2324               else
2325                 error_at_line (&s->u.s.line,
2326                                "structure alias is not a structure");
2327               break;
2328             }
2329         if (opt)
2330           continue;
2331
2332         /* Declare the marker procedure only once.  */
2333         oprintf (header_file, "extern void gt_pch_p_");
2334         output_mangled_typename (header_file, s);
2335         oprintf (header_file,
2336          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2337
2338         if (s->kind == TYPE_LANG_STRUCT)
2339           {
2340             type_p ss;
2341             for (ss = s->u.s.lang_struct; ss; ss = ss->next)
2342               write_local_func_for_structure (s, ss, NULL);
2343           }
2344         else
2345           write_local_func_for_structure (s, s, NULL);
2346       }
2347
2348   for (s = param_structs; s; s = s->next)
2349     if (s->gc_used == GC_POINTED_TO)
2350       {
2351         type_p * param = s->u.param_struct.param;
2352         type_p stru = s->u.param_struct.stru;
2353
2354         /* Declare the marker procedure.  */
2355         oprintf (header_file, "extern void gt_pch_p_");
2356         output_mangled_typename (header_file, s);
2357         oprintf (header_file,
2358          "\n    (void *, void *, gt_pointer_operator, void *);\n");
2359
2360         if (stru->u.s.line.file == NULL)
2361           {
2362             fprintf (stderr, "warning: structure `%s' used but not defined\n",
2363                      s->u.s.tag);
2364             continue;
2365           }
2366
2367         if (stru->kind == TYPE_LANG_STRUCT)
2368           {
2369             type_p ss;
2370             for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
2371               write_local_func_for_structure (s, ss, param);
2372           }
2373         else
2374           write_local_func_for_structure (s, stru, param);
2375       }
2376 }
2377
2378 /* Write out the 'enum' definition for gt_types_enum.  */
2379
2380 static void
2381 write_enum_defn (type_p structures, type_p param_structs)
2382 {
2383   type_p s;
2384
2385   oprintf (header_file, "\n/* Enumeration of types known.  */\n");
2386   oprintf (header_file, "enum gt_types_enum {\n");
2387   for (s = structures; s; s = s->next)
2388     if (s->gc_used == GC_POINTED_TO
2389         || s->gc_used == GC_MAYBE_POINTED_TO)
2390       {
2391         if (s->gc_used == GC_MAYBE_POINTED_TO
2392             && s->u.s.line.file == NULL)
2393           continue;
2394
2395         oprintf (header_file, " gt_ggc_e_");
2396         output_mangled_typename (header_file, s);
2397         oprintf (header_file, ", \n");
2398       }
2399   for (s = param_structs; s; s = s->next)
2400     if (s->gc_used == GC_POINTED_TO)
2401       {
2402         oprintf (header_file, " gt_e_");
2403         output_mangled_typename (header_file, s);
2404         oprintf (header_file, ", \n");
2405       }
2406   oprintf (header_file, " gt_types_enum_last\n");
2407   oprintf (header_file, "};\n");
2408 }
2409
2410 /* Might T contain any non-pointer elements?  */
2411
2412 static int
2413 contains_scalar_p (type_p t)
2414 {
2415   switch (t->kind)
2416     {
2417     case TYPE_STRING:
2418     case TYPE_POINTER:
2419       return 0;
2420     case TYPE_ARRAY:
2421       return contains_scalar_p (t->u.a.p);
2422     default:
2423       /* Could also check for structures that have no non-pointer
2424          fields, but there aren't enough of those to worry about.  */
2425       return 1;
2426     }
2427 }
2428
2429 /* Mangle FN and print it to F.  */
2430
2431 static void
2432 put_mangled_filename (outf_p f, const char *fn)
2433 {
2434   const char *name = get_output_file_name (fn);
2435   for (; *name != 0; name++)
2436     if (ISALNUM (*name))
2437       oprintf (f, "%c", *name);
2438     else
2439       oprintf (f, "%c", '_');
2440 }
2441
2442 /* Finish off the currently-created root tables in FLP.  PFX, TNAME,
2443    LASTNAME, and NAME are all strings to insert in various places in
2444    the resulting code.  */
2445
2446 static void
2447 finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
2448                    const char *tname, const char *name)
2449 {
2450   struct flist *fli2;
2451
2452   for (fli2 = flp; fli2; fli2 = fli2->next)
2453     if (fli2->started_p)
2454       {
2455         oprintf (fli2->f, "  %s\n", lastname);
2456         oprintf (fli2->f, "};\n\n");
2457       }
2458
2459   for (fli2 = flp; fli2; fli2 = fli2->next)
2460     if (fli2->started_p)
2461       {
2462         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2463         int fnum;
2464
2465         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2466           if (bitmap & 1)
2467             {
2468               oprintf (base_files[fnum],
2469                        "extern const struct %s gt_%s_",
2470                        tname, pfx);
2471               put_mangled_filename (base_files[fnum], fli2->name);
2472               oprintf (base_files[fnum], "[];\n");
2473             }
2474       }
2475
2476   {
2477     size_t fnum;
2478     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2479       oprintf (base_files [fnum],
2480                "const struct %s * const %s[] = {\n",
2481                tname, name);
2482   }
2483
2484
2485   for (fli2 = flp; fli2; fli2 = fli2->next)
2486     if (fli2->started_p)
2487       {
2488         lang_bitmap bitmap = get_base_file_bitmap (fli2->name);
2489         int fnum;
2490
2491         fli2->started_p = 0;
2492
2493         for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
2494           if (bitmap & 1)
2495             {
2496               oprintf (base_files[fnum], "  gt_%s_", pfx);
2497               put_mangled_filename (base_files[fnum], fli2->name);
2498               oprintf (base_files[fnum], ",\n");
2499             }
2500       }
2501
2502   {
2503     size_t fnum;
2504     for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
2505       {
2506         oprintf (base_files[fnum], "  NULL\n");
2507         oprintf (base_files[fnum], "};\n");
2508       }
2509   }
2510 }
2511
2512 /* Write out to F the table entry and any marker routines needed to
2513    mark NAME as TYPE.  The original variable is V, at LINE.
2514    HAS_LENGTH is nonzero iff V was a variable-length array.  IF_MARKED
2515    is nonzero iff we are building the root table for hash table caches.  */
2516
2517 static void
2518 write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
2519             struct fileloc *line, const char *if_marked)
2520 {
2521   switch (type->kind)
2522     {
2523     case TYPE_STRUCT:
2524       {
2525         pair_p fld;
2526         for (fld = type->u.s.fields; fld; fld = fld->next)
2527           {
2528             int skip_p = 0;
2529             const char *desc = NULL;
2530             options_p o;
2531
2532             for (o = fld->opt; o; o = o->next)
2533               if (strcmp (o->name, "skip") == 0)
2534                 skip_p = 1;
2535               else if (strcmp (o->name, "desc") == 0)
2536                 desc = (const char *)o->info;
2537               else
2538                 error_at_line (line,
2539                        "field `%s' of global `%s' has unknown option `%s'",
2540                                fld->name, name, o->name);
2541
2542             if (skip_p)
2543               continue;
2544             else if (desc && fld->type->kind == TYPE_UNION)
2545               {
2546                 pair_p validf = NULL;
2547                 pair_p ufld;
2548
2549                 for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
2550                   {
2551                     const char *tag = NULL;
2552                     options_p oo;
2553
2554                     for (oo = ufld->opt; oo; oo = oo->next)
2555                       if (strcmp (oo->name, "tag") == 0)
2556                         tag = (const char *)oo->info;
2557                     if (tag == NULL || strcmp (tag, desc) != 0)
2558                       continue;
2559                     if (validf != NULL)
2560                       error_at_line (line,
2561                            "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
2562                                      name, fld->name, validf->name,
2563                                      name, fld->name, ufld->name,
2564                                      tag);
2565                     validf = ufld;
2566                   }
2567                 if (validf != NULL)
2568                   {
2569                     char *newname;
2570                     newname = xasprintf ("%s.%s.%s",
2571                                          name, fld->name, validf->name);
2572                     write_root (f, v, validf->type, newname, 0, line,
2573                                 if_marked);
2574                     free (newname);
2575                   }
2576               }
2577             else if (desc)
2578               error_at_line (line,
2579                      "global `%s.%s' has `desc' option but is not union",
2580                              name, fld->name);
2581             else
2582               {
2583                 char *newname;
2584                 newname = xasprintf ("%s.%s", name, fld->name);
2585                 write_root (f, v, fld->type, newname, 0, line, if_marked);
2586                 free (newname);
2587               }
2588           }
2589       }
2590       break;
2591
2592     case TYPE_ARRAY:
2593       {
2594         char *newname;
2595         newname = xasprintf ("%s[0]", name);
2596         write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
2597         free (newname);
2598       }
2599       break;
2600
2601     case TYPE_POINTER:
2602       {
2603         type_p ap, tp;
2604
2605         oprintf (f, "  {\n");
2606         oprintf (f, "    &%s,\n", name);
2607         oprintf (f, "    1");
2608
2609         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2610           if (ap->u.a.len[0])
2611             oprintf (f, " * (%s)", ap->u.a.len);
2612           else if (ap == v->type)
2613             oprintf (f, " * ARRAY_SIZE (%s)", v->name);
2614         oprintf (f, ",\n");
2615         oprintf (f, "    sizeof (%s", v->name);
2616         for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
2617           oprintf (f, "[0]");
2618         oprintf (f, "),\n");
2619
2620         tp = type->u.p;
2621
2622         if (! has_length && UNION_OR_STRUCT_P (tp))
2623           {
2624             oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
2625             oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
2626           }
2627         else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
2628           {
2629             oprintf (f, "    &gt_ggc_m_");
2630             output_mangled_typename (f, tp);
2631             oprintf (f, ",\n    &gt_pch_n_");
2632             output_mangled_typename (f, tp);
2633           }
2634         else if (has_length
2635                  && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
2636           {
2637             oprintf (f, "    &gt_ggc_ma_%s,\n", name);
2638             oprintf (f, "    &gt_pch_na_%s", name);
2639           }
2640         else
2641           {
2642             error_at_line (line,
2643                            "global `%s' is pointer to unimplemented type",
2644                            name);
2645           }
2646         if (if_marked)
2647           oprintf (f, ",\n    &%s", if_marked);
2648         oprintf (f, "\n  },\n");
2649       }
2650       break;
2651
2652     case TYPE_STRING:
2653       {
2654         oprintf (f, "  {\n");
2655         oprintf (f, "    &%s,\n", name);
2656         oprintf (f, "    1, \n");
2657         oprintf (f, "    sizeof (%s),\n", v->name);
2658         oprintf (f, "    &gt_ggc_m_S,\n");
2659         oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
2660         oprintf (f, "  },\n");
2661       }
2662       break;
2663
2664     case TYPE_SCALAR:
2665       break;
2666
2667     default:
2668       error_at_line (line,
2669                      "global `%s' is unimplemented type",
2670                      name);
2671     }
2672 }
2673
2674 /* This generates a routine to walk an array.  */
2675
2676 static void
2677 write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
2678 {
2679   struct walk_type_data d;
2680   char *prevval3;
2681
2682   memset (&d, 0, sizeof (d));
2683   d.of = f;
2684   d.cookie = wtd;
2685   d.indent = 2;
2686   d.line = &v->line;
2687   d.opt = v->opt;
2688   d.bitmap = get_base_file_bitmap (v->line.file);
2689   d.param = NULL;
2690
2691   d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
2692
2693   if (wtd->param_prefix)
2694     {
2695       oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
2696       oprintf (f,
2697        "    (void *, void *, gt_pointer_operator, void *);\n");
2698       oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
2699                wtd->param_prefix, v->name);
2700       oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
2701       oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
2702       oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
2703       oprintf (d.of, "{\n");
2704       d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2705       d.process_field = write_types_local_process_field;
2706       walk_type (v->type, &d);
2707       oprintf (f, "}\n\n");
2708     }
2709
2710   d.opt = v->opt;
2711   oprintf (f, "static void gt_%sa_%s (void *);\n",
2712            wtd->prefix, v->name);
2713   oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
2714            wtd->prefix, v->name);
2715   oprintf (f, "{\n");
2716   d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
2717   d.process_field = write_types_process_field;
2718   walk_type (v->type, &d);
2719   free (prevval3);
2720   oprintf (f, "}\n\n");
2721 }
2722
2723 /* Output a table describing the locations and types of VARIABLES.  */
2724
2725 static void
2726 write_roots (pair_p variables)
2727 {
2728   pair_p v;
2729   struct flist *flp = NULL;
2730
2731   for (v = variables; v; v = v->next)
2732     {
2733       outf_p f = get_output_file_with_visibility (v->line.file);
2734       struct flist *fli;
2735       const char *length = NULL;
2736       int deletable_p = 0;
2737       options_p o;
2738
2739       for (o = v->opt; o; o = o->next)
2740         if (strcmp (o->name, "length") == 0)
2741           length = (const char *)o->info;
2742         else if (strcmp (o->name, "deletable") == 0)
2743           deletable_p = 1;
2744         else if (strcmp (o->name, "param_is") == 0)
2745           ;
2746         else if (strncmp (o->name, "param", 5) == 0
2747                  && ISDIGIT (o->name[5])
2748                  && strcmp (o->name + 6, "_is") == 0)
2749           ;
2750         else if (strcmp (o->name, "if_marked") == 0)
2751           ;
2752         else
2753           error_at_line (&v->line,
2754                          "global `%s' has unknown option `%s'",
2755                          v->name, o->name);
2756
2757       for (fli = flp; fli; fli = fli->next)
2758         if (fli->f == f)
2759           break;
2760       if (fli == NULL)
2761         {
2762           fli = xmalloc (sizeof (*fli));
2763           fli->f = f;
2764           fli->next = flp;
2765           fli->started_p = 0;
2766           fli->name = v->line.file;
2767           flp = fli;
2768
2769           oprintf (f, "\n/* GC roots.  */\n\n");
2770         }
2771
2772       if (! deletable_p
2773           && length
2774           && v->type->kind == TYPE_POINTER
2775           && (v->type->u.p->kind == TYPE_POINTER
2776               || v->type->u.p->kind == TYPE_STRUCT))
2777         {
2778           write_array (f, v, &ggc_wtd);
2779           write_array (f, v, &pch_wtd);
2780         }
2781     }
2782
2783   for (v = variables; v; v = v->next)
2784     {
2785       outf_p f = get_output_file_with_visibility (v->line.file);
2786       struct flist *fli;
2787       int skip_p = 0;
2788       int length_p = 0;
2789       options_p o;
2790
2791       for (o = v->opt; o; o = o->next)
2792         if (strcmp (o->name, "length") == 0)
2793           length_p = 1;
2794         else if (strcmp (o->name, "deletable") == 0
2795                  || strcmp (o->name, "if_marked") == 0)
2796           skip_p = 1;
2797
2798       if (skip_p)
2799         continue;
2800
2801       for (fli = flp; fli; fli = fli->next)
2802         if (fli->f == f)
2803           break;
2804       if (! fli->started_p)
2805         {
2806           fli->started_p = 1;
2807
2808           oprintf (f, "const struct ggc_root_tab gt_ggc_r_");
2809           put_mangled_filename (f, v->line.file);
2810           oprintf (f, "[] = {\n");
2811         }
2812
2813       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2814     }
2815
2816   finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2817                      "gt_ggc_rtab");
2818
2819   for (v = variables; v; v = v->next)
2820     {
2821       outf_p f = get_output_file_with_visibility (v->line.file);
2822       struct flist *fli;
2823       int skip_p = 1;
2824       options_p o;
2825
2826       for (o = v->opt; o; o = o->next)
2827         if (strcmp (o->name, "deletable") == 0)
2828           skip_p = 0;
2829         else if (strcmp (o->name, "if_marked") == 0)
2830           skip_p = 1;
2831
2832       if (skip_p)
2833         continue;
2834
2835       for (fli = flp; fli; fli = fli->next)
2836         if (fli->f == f)
2837           break;
2838       if (! fli->started_p)
2839         {
2840           fli->started_p = 1;
2841
2842           oprintf (f, "const struct ggc_root_tab gt_ggc_rd_");
2843           put_mangled_filename (f, v->line.file);
2844           oprintf (f, "[] = {\n");
2845         }
2846
2847       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2848                v->name, v->name);
2849     }
2850
2851   finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2852                      "gt_ggc_deletable_rtab");
2853
2854   for (v = variables; v; v = v->next)
2855     {
2856       outf_p f = get_output_file_with_visibility (v->line.file);
2857       struct flist *fli;
2858       const char *if_marked = NULL;
2859       int length_p = 0;
2860       options_p o;
2861
2862       for (o = v->opt; o; o = o->next)
2863         if (strcmp (o->name, "length") == 0)
2864           length_p = 1;
2865         else if (strcmp (o->name, "if_marked") == 0)
2866           if_marked = (const char *) o->info;
2867
2868       if (if_marked == NULL)
2869         continue;
2870
2871       if (v->type->kind != TYPE_POINTER
2872           || v->type->u.p->kind != TYPE_PARAM_STRUCT
2873           || v->type->u.p->u.param_struct.stru != find_structure ("htab", 0))
2874         {
2875           error_at_line (&v->line, "if_marked option used but not hash table");
2876           continue;
2877         }
2878
2879       for (fli = flp; fli; fli = fli->next)
2880         if (fli->f == f)
2881           break;
2882       if (! fli->started_p)
2883         {
2884           fli->started_p = 1;
2885
2886           oprintf (f, "const struct ggc_cache_tab gt_ggc_rc_");
2887           put_mangled_filename (f, v->line.file);
2888           oprintf (f, "[] = {\n");
2889         }
2890
2891       write_root (f, v, v->type->u.p->u.param_struct.param[0],
2892                      v->name, length_p, &v->line, if_marked);
2893     }
2894
2895   finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
2896                      "gt_ggc_cache_rtab");
2897
2898   for (v = variables; v; v = v->next)
2899     {
2900       outf_p f = get_output_file_with_visibility (v->line.file);
2901       struct flist *fli;
2902       int length_p = 0;
2903       int if_marked_p = 0;
2904       options_p o;
2905
2906       for (o = v->opt; o; o = o->next)
2907         if (strcmp (o->name, "length") == 0)
2908           length_p = 1;
2909         else if (strcmp (o->name, "if_marked") == 0)
2910           if_marked_p = 1;
2911
2912       if (! if_marked_p)
2913         continue;
2914
2915       for (fli = flp; fli; fli = fli->next)
2916         if (fli->f == f)
2917           break;
2918       if (! fli->started_p)
2919         {
2920           fli->started_p = 1;
2921
2922           oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
2923           put_mangled_filename (f, v->line.file);
2924           oprintf (f, "[] = {\n");
2925         }
2926
2927       write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
2928     }
2929
2930   finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2931                      "gt_pch_cache_rtab");
2932
2933   for (v = variables; v; v = v->next)
2934     {
2935       outf_p f = get_output_file_with_visibility (v->line.file);
2936       struct flist *fli;
2937       int skip_p = 0;
2938       options_p o;
2939
2940       for (o = v->opt; o; o = o->next)
2941         if (strcmp (o->name, "deletable") == 0
2942             || strcmp (o->name, "if_marked") == 0)
2943           skip_p = 1;
2944
2945       if (skip_p)
2946         continue;
2947
2948       if (! contains_scalar_p (v->type))
2949         continue;
2950
2951       for (fli = flp; fli; fli = fli->next)
2952         if (fli->f == f)
2953           break;
2954       if (! fli->started_p)
2955         {
2956           fli->started_p = 1;
2957
2958           oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
2959           put_mangled_filename (f, v->line.file);
2960           oprintf (f, "[] = {\n");
2961         }
2962
2963       oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
2964                v->name, v->name);
2965     }
2966
2967   finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
2968                      "gt_pch_scalar_rtab");
2969 }
2970
2971 \f
2972 extern int main (int argc, char **argv);
2973 int
2974 main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
2975 {
2976   unsigned i;
2977   static struct fileloc pos = { __FILE__, __LINE__ };
2978   unsigned j;
2979
2980   gen_rtx_next ();
2981
2982   srcdir_len = strlen (srcdir);
2983
2984   do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
2985   do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
2986   do_scalar_typedef ("uint8", &pos);
2987   do_scalar_typedef ("jword", &pos);
2988   do_scalar_typedef ("JCF_u2", &pos);
2989 #ifdef USE_MAPPED_LOCATION
2990   do_scalar_typedef ("location_t", &pos);
2991   do_scalar_typedef ("source_locus", &pos);
2992 #endif
2993   do_scalar_typedef ("void", &pos);
2994
2995   do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
2996
2997   do_typedef ("HARD_REG_SET", create_array (
2998               create_scalar_type ("unsigned long", strlen ("unsigned long")),
2999               "2"), &pos);
3000
3001   for (i = 0; i < NUM_GT_FILES; i++)
3002     {
3003       int dupflag = 0;
3004       /* Omit if already seen.  */
3005       for (j = 0; j < i; j++)
3006         {
3007           if (!strcmp (all_files[i], all_files[j]))
3008             {
3009               dupflag = 1;
3010               break;
3011             }
3012         }
3013       if (!dupflag)
3014         parse_file (all_files[i]);
3015 #ifndef USE_MAPPED_LOCATION
3016       /* temporary kludge - gengtype doesn't handle conditionals.
3017          Manually add source_locus *after* we've processed input.h. */
3018       if (i == 0)
3019         do_typedef ("source_locus", create_pointer (resolve_typedef ("location_t", &pos)), &pos);
3020 #endif
3021     }
3022
3023   if (hit_error != 0)
3024     exit (1);
3025
3026   set_gc_used (variables);
3027
3028   open_base_files ();
3029   write_enum_defn (structures, param_structs);
3030   write_types (structures, param_structs, &ggc_wtd);
3031   write_types (structures, param_structs, &pch_wtd);
3032   write_local (structures, param_structs);
3033   write_roots (variables);
3034   write_rtx_next ();
3035   close_output_files ();
3036
3037   return (hit_error != 0);
3038 }