OSDN Git Service

PR c/13519
[pf3gnuchains/gcc-fork.git] / gcc / gengtype.c
index d661e38..804ef70 100644 (file)
@@ -1,5 +1,5 @@
 /* Process source files and output type information.
-   Copyright (C) 2002 Free Software Foundation, Inc.
+   Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -18,41 +18,45 @@ along with GCC; see the file COPYING.  If not, write to the Free
 Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 02111-1307, USA.  */
 
-#include "hconfig.h"
+#include "bconfig.h"
 #include "system.h"
+#include "coretypes.h"
+#include "tm.h"
 #include "gengtype.h"
 #include "gtyp-gen.h"
 
+#define NO_GENRTL_H
+#include "rtl.h"
+#undef abort
+
 /* Nonzero iff an error has occurred.  */
 static int hit_error = 0;
 
-static void open_base_files PARAMS ((void));
-static void close_output_files PARAMS ((void));
-
+static void gen_rtx_next (void);
+static void write_rtx_next (void);
+static void open_base_files (void);
+static void close_output_files (void);
 
 /* Report an error at POS, printing MSG.  */
 
 void
-error_at_line VPARAMS ((struct fileloc *pos, const char *msg, ...))
+error_at_line (struct fileloc *pos, const char *msg, ...)
 {
-  VA_OPEN (ap, msg);
-  VA_FIXEDARG (ap, struct fileloc *, pos);
-  VA_FIXEDARG (ap, const char *, msg);
+  va_list ap;
+
+  va_start (ap, msg);
 
   fprintf (stderr, "%s:%d: ", pos->file, pos->line);
   vfprintf (stderr, msg, ap);
   fputc ('\n', stderr);
   hit_error = 1;
 
-  VA_CLOSE (ap);
+  va_end (ap);
 }
 
 /* vasprintf, but produces fatal message on out-of-memory.  */
 int
-xvasprintf (result, format, args)
-     char ** result;
-     const char *format;
-     va_list args;
+xvasprintf (char **result, const char *format, va_list args)
 {
   int ret = vasprintf (result, format, args);
   if (*result == NULL || ret < 0)
@@ -65,22 +69,22 @@ xvasprintf (result, format, args)
 
 /* Wrapper for xvasprintf.  */
 char *
-xasprintf VPARAMS ((const char *format, ...))
+xasprintf (const char *format, ...)
 {
   char *result;
-  VA_OPEN (ap, format);
-  VA_FIXEDARG (ap, const char *, format);
+  va_list ap;
+
+  va_start (ap, format);
   xvasprintf (&result, format, ap);
-  VA_CLOSE (ap);
+  va_end (ap);
   return result;
 }
 
 /* The one and only TYPE_STRING.  */
 
 struct type string_type = {
-  TYPE_STRING, NULL, NULL, GC_USED
-  UNION_INIT_ZERO
-}; 
+  TYPE_STRING, NULL, NULL, GC_USED, {0}
+};
 
 /* Lists of various things.  */
 
@@ -89,13 +93,16 @@ static type_p structures;
 static type_p param_structs;
 static pair_p variables;
 
+static void do_scalar_typedef (const char *, struct fileloc *);
+static type_p find_param_structure
+  (type_p t, type_p param[NUM_PARAM]);
+static type_p adjust_field_tree_exp (type_p t, options_p opt);
+static type_p adjust_field_rtx_def (type_p t, options_p opt);
+
 /* Define S as a typedef to T at POS.  */
 
 void
-do_typedef (s, t, pos)
-     const char *s;
-     type_p t;
-     struct fileloc *pos;
+do_typedef (const char *s, type_p t, struct fileloc *pos)
 {
   pair_p p;
 
@@ -118,12 +125,18 @@ do_typedef (s, t, pos)
   typedefs = p;
 }
 
-/* Return the type previously defined for S.  Use POS to report errors.   */
+/* Define S as a typename of a scalar.  */
+
+static void
+do_scalar_typedef (const char *s, struct fileloc *pos)
+{
+  do_typedef (s, create_scalar_type (s, strlen (s)), pos);
+}
+
+/* Return the type previously defined for S.  Use POS to report errors.  */
 
 type_p
-resolve_typedef (s, pos)
-     const char *s;
-     struct fileloc *pos;
+resolve_typedef (const char *s, struct fileloc *pos)
 {
   pair_p p;
   for (p = typedefs; p != NULL; p = p->next)
@@ -137,26 +150,22 @@ resolve_typedef (s, pos)
    at POS with fields FIELDS and options O.  */
 
 void
-new_structure (name, isunion, pos, fields, o)
-     const char *name;
-     int isunion;
-     struct fileloc *pos;
-     pair_p fields;
-     options_p o;
+new_structure (const char *name, int isunion, struct fileloc *pos,
+              pair_p fields, options_p o)
 {
   type_p si;
   type_p s = NULL;
   lang_bitmap bitmap = get_base_file_bitmap (pos->file);
 
   for (si = structures; si != NULL; si = si->next)
-    if (strcmp (name, si->u.s.tag) == 0 
+    if (strcmp (name, si->u.s.tag) == 0
        && UNION_P (si) == isunion)
       {
        type_p ls = NULL;
        if (si->kind == TYPE_LANG_STRUCT)
          {
            ls = si;
-           
+
            for (si = ls->u.s.lang_struct; si != NULL; si = si->next)
              if (si->u.s.bitmap == bitmap)
                s = si;
@@ -185,7 +194,7 @@ new_structure (name, isunion, pos, fields, o)
          }
        break;
       }
-  
+
   if (s == NULL)
     {
       s = xcalloc (1, sizeof (struct type));
@@ -215,14 +224,12 @@ new_structure (name, isunion, pos, fields, o)
    was defined previously.  */
 
 type_p
-find_structure (name, isunion)
-     const char *name;
-     int isunion;
+find_structure (const char *name, int isunion)
 {
   type_p s;
 
   for (s = structures; s != NULL; s = s->next)
-    if (strcmp (name, s->u.s.tag) == 0 
+    if (strcmp (name, s->u.s.tag) == 0
        && UNION_P (s) == isunion)
       return s;
 
@@ -235,12 +242,36 @@ find_structure (name, isunion)
   return s;
 }
 
+/* Return the previously-defined parameterized structure for structure
+   T and parameters PARAM, or a new parameterized empty structure or
+   union if none was defined previously.  */
+
+static type_p
+find_param_structure (type_p t, type_p param[NUM_PARAM])
+{
+  type_p res;
+
+  for (res = param_structs; res; res = res->next)
+    if (res->u.param_struct.stru == t
+       && memcmp (res->u.param_struct.param, param,
+                  sizeof (type_p) * NUM_PARAM) == 0)
+      break;
+  if (res == NULL)
+    {
+      res = xcalloc (1, sizeof (*res));
+      res->kind = TYPE_PARAM_STRUCT;
+      res->next = param_structs;
+      param_structs = res;
+      res->u.param_struct.stru = t;
+      memcpy (res->u.param_struct.param, param, sizeof (type_p) * NUM_PARAM);
+    }
+  return res;
+}
+
 /* Return a scalar type with name NAME.  */
 
 type_p
-create_scalar_type (name, name_len)
-     const char *name;
-     size_t name_len;
+create_scalar_type (const char *name, size_t name_len)
 {
   type_p r = xcalloc (1, sizeof (struct type));
   r->kind = TYPE_SCALAR;
@@ -251,8 +282,7 @@ create_scalar_type (name, name_len)
 /* Return a pointer to T.  */
 
 type_p
-create_pointer (t)
-     type_p t;
+create_pointer (type_p t)
 {
   if (! t->pointer_to)
     {
@@ -267,12 +297,10 @@ create_pointer (t)
 /* Return an array of length LEN.  */
 
 type_p
-create_array (t, len)
-     type_p t;
-     const char *len;
+create_array (type_p t, const char *len)
 {
   type_p v;
-  
+
   v = xcalloc (1, sizeof (*v));
   v->kind = TYPE_ARRAY;
   v->u.a.p = t;
@@ -280,46 +308,496 @@ create_array (t, len)
   return v;
 }
 
+/* Return an options structure with name NAME and info INFO.  */
+options_p
+create_option (const char *name, void *info)
+{
+  options_p o = xmalloc (sizeof (*o));
+  o->name = name;
+  o->info = info;
+  return o;
+}
+
+/* Add a variable named S of type T with options O defined at POS,
+   to `variables'.  */
+
+void
+note_variable (const char *s, type_p t, options_p o, struct fileloc *pos)
+{
+  pair_p n;
+  n = xmalloc (sizeof (*n));
+  n->name = s;
+  n->type = t;
+  n->line = *pos;
+  n->opt = o;
+  n->next = variables;
+  variables = n;
+}
+
+/* We really don't care how long a CONST_DOUBLE is.  */
+#define CONST_DOUBLE_FORMAT "ww"
+const char * const rtx_format[NUM_RTX_CODE] = {
+#define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   FORMAT ,
+#include "rtl.def"
+#undef DEF_RTL_EXPR
+};
+
+static int rtx_next_new[NUM_RTX_CODE];
+
+/* Generate the contents of the rtx_next array.  This really doesn't belong
+   in gengtype at all, but it's needed for adjust_field_rtx_def.  */
+
+static void
+gen_rtx_next (void)
+{
+  int i;
+  for (i = 0; i < NUM_RTX_CODE; i++)
+    {
+      int k;
+
+      rtx_next_new[i] = -1;
+      if (strncmp (rtx_format[i], "iuu", 3) == 0)
+       rtx_next_new[i] = 2;
+      else if (i == COND_EXEC || i == SET || i == EXPR_LIST || i == INSN_LIST)
+       rtx_next_new[i] = 1;
+      else
+       for (k = strlen (rtx_format[i]) - 1; k >= 0; k--)
+         if (rtx_format[i][k] == 'e' || rtx_format[i][k] == 'u')
+           rtx_next_new[i] = k;
+    }
+}
+
+/* Write out the contents of the rtx_next array.  */
+static void
+write_rtx_next (void)
+{
+  outf_p f = get_output_file_with_visibility (NULL);
+  int i;
+
+  oprintf (f, "\n/* Used to implement the RTX_NEXT macro.  */\n");
+  oprintf (f, "const unsigned char rtx_next[NUM_RTX_CODE] = {\n");
+  for (i = 0; i < NUM_RTX_CODE; i++)
+    if (rtx_next_new[i] == -1)
+      oprintf (f, "  0,\n");
+    else
+      oprintf (f,
+              "  RTX_HDR_SIZE + %d * sizeof (rtunion),\n",
+              rtx_next_new[i]);
+  oprintf (f, "};\n");
+}
+
+/* Handle `special("rtx_def")'.  This is a special case for field
+   `fld' of struct rtx_def, which is an array of unions whose values
+   are based in a complex way on the type of RTL.  */
+
+static type_p
+adjust_field_rtx_def (type_p t, options_p opt ATTRIBUTE_UNUSED)
+{
+  pair_p flds = NULL;
+  options_p nodot;
+  int i;
+  type_p rtx_tp, rtvec_tp, tree_tp, mem_attrs_tp, note_union_tp, scalar_tp;
+  type_p bitmap_tp, basic_block_tp, reg_attrs_tp;
+
+  static const char * const rtx_name[NUM_RTX_CODE] = {
+#define DEF_RTL_EXPR(ENUM, NAME, FORMAT, CLASS)   NAME ,
+#include "rtl.def"
+#undef DEF_RTL_EXPR
+  };
+
+  if (t->kind != TYPE_UNION)
+    {
+      error_at_line (&lexer_line,
+                    "special `rtx_def' must be applied to a union");
+      return &string_type;
+    }
+
+  nodot = xmalloc (sizeof (*nodot));
+  nodot->next = NULL;
+  nodot->name = "dot";
+  nodot->info = "";
+
+  rtx_tp = create_pointer (find_structure ("rtx_def", 0));
+  rtvec_tp = create_pointer (find_structure ("rtvec_def", 0));
+  tree_tp = create_pointer (find_structure ("tree_node", 1));
+  mem_attrs_tp = create_pointer (find_structure ("mem_attrs", 0));
+  reg_attrs_tp = create_pointer (find_structure ("reg_attrs", 0));
+  bitmap_tp = create_pointer (find_structure ("bitmap_element_def", 0));
+  basic_block_tp = create_pointer (find_structure ("basic_block_def", 0));
+  scalar_tp = create_scalar_type ("rtunion scalar", 14);
+
+  {
+    pair_p note_flds = NULL;
+    int c;
+
+    for (c = NOTE_INSN_BIAS; c <= NOTE_INSN_MAX; c++)
+      {
+       pair_p old_note_flds = note_flds;
+
+       note_flds = xmalloc (sizeof (*note_flds));
+       note_flds->line.file = __FILE__;
+       note_flds->line.line = __LINE__;
+       note_flds->opt = xmalloc (sizeof (*note_flds->opt));
+       note_flds->opt->next = nodot;
+       note_flds->opt->name = "tag";
+       note_flds->opt->info = xasprintf ("%d", c);
+       note_flds->next = old_note_flds;
+
+       switch (c)
+         {
+           /* NOTE_INSN_MAX is used as the default field for line
+              number notes.  */
+         case NOTE_INSN_MAX:
+           note_flds->opt->name = "default";
+           note_flds->name = "rtstr";
+           note_flds->type = &string_type;
+           break;
+
+         case NOTE_INSN_BLOCK_BEG:
+         case NOTE_INSN_BLOCK_END:
+           note_flds->name = "rttree";
+           note_flds->type = tree_tp;
+           break;
+
+         case NOTE_INSN_EXPECTED_VALUE:
+         case NOTE_INSN_VAR_LOCATION:
+           note_flds->name = "rtx";
+           note_flds->type = rtx_tp;
+           break;
+
+         default:
+           note_flds->name = "rtint";
+           note_flds->type = scalar_tp;
+           break;
+         }
+      }
+    new_structure ("rtx_def_note_subunion", 1, &lexer_line, note_flds, NULL);
+  }
+
+  note_union_tp = find_structure ("rtx_def_note_subunion", 1);
+
+  for (i = 0; i < NUM_RTX_CODE; i++)
+    {
+      pair_p old_flds = flds;
+      pair_p subfields = NULL;
+      size_t aindex, nmindex;
+      const char *sname;
+      char *ftag;
+
+      for (aindex = 0; aindex < strlen (rtx_format[i]); aindex++)
+       {
+         pair_p old_subf = subfields;
+         type_p t;
+         const char *subname;
+
+         switch (rtx_format[i][aindex])
+           {
+           case '*':
+           case 'i':
+           case 'n':
+           case 'w':
+             t = scalar_tp;
+             subname = "rtint";
+             break;
+
+           case '0':
+             if (i == MEM && aindex == 1)
+               t = mem_attrs_tp, subname = "rtmem";
+             else if (i == JUMP_INSN && aindex == 9)
+               t = rtx_tp, subname = "rtx";
+             else if (i == CODE_LABEL && aindex == 4)
+               t = scalar_tp, subname = "rtint";
+             else if (i == CODE_LABEL && aindex == 5)
+               t = rtx_tp, subname = "rtx";
+             else if (i == LABEL_REF
+                      && (aindex == 1 || aindex == 2))
+               t = rtx_tp, subname = "rtx";
+             else if (i == NOTE && aindex == 4)
+               t = note_union_tp, subname = "";
+             else if (i == NOTE && aindex >= 7)
+               t = scalar_tp, subname = "rtint";
+             else if (i == ADDR_DIFF_VEC && aindex == 4)
+               t = scalar_tp, subname = "rtint";
+             else if (i == VALUE && aindex == 0)
+               t = scalar_tp, subname = "rtint";
+             else if (i == REG && aindex == 1)
+               t = scalar_tp, subname = "rtint";
+             else if (i == REG && aindex == 2)
+               t = reg_attrs_tp, subname = "rtreg";
+             else if (i == SCRATCH && aindex == 0)
+               t = scalar_tp, subname = "rtint";
+             else if (i == SYMBOL_REF && aindex == 1)
+               t = scalar_tp, subname = "rtint";
+             else if (i == SYMBOL_REF && aindex == 2)
+               t = tree_tp, subname = "rttree";
+             else if (i == BARRIER && aindex >= 3)
+               t = scalar_tp, subname = "rtint";
+             else
+               {
+                 error_at_line (&lexer_line,
+                       "rtx type `%s' has `0' in position %lu, can't handle",
+                                rtx_name[i], (unsigned long) aindex);
+                 t = &string_type;
+                 subname = "rtint";
+               }
+             break;
+
+           case 's':
+           case 'S':
+           case 'T':
+             t = &string_type;
+             subname = "rtstr";
+             break;
+
+           case 'e':
+           case 'u':
+             t = rtx_tp;
+             subname = "rtx";
+             break;
+
+           case 'E':
+           case 'V':
+             t = rtvec_tp;
+             subname = "rtvec";
+             break;
+
+           case 't':
+             t = tree_tp;
+             subname = "rttree";
+             break;
+
+           case 'b':
+             t = bitmap_tp;
+             subname = "rtbit";
+             break;
+
+           case 'B':
+             t = basic_block_tp;
+             subname = "bb";
+             break;
+
+           default:
+             error_at_line (&lexer_line,
+                    "rtx type `%s' has `%c' in position %lu, can't handle",
+                            rtx_name[i], rtx_format[i][aindex],
+                            (unsigned long)aindex);
+             t = &string_type;
+             subname = "rtint";
+             break;
+           }
+
+         subfields = xmalloc (sizeof (*subfields));
+         subfields->next = old_subf;
+         subfields->type = t;
+         subfields->name = xasprintf (".fld[%lu].%s", (unsigned long)aindex,
+                                      subname);
+         subfields->line.file = __FILE__;
+         subfields->line.line = __LINE__;
+         if (t == note_union_tp)
+           {
+             subfields->opt = xmalloc (sizeof (*subfields->opt));
+             subfields->opt->next = nodot;
+             subfields->opt->name = "desc";
+             subfields->opt->info = "NOTE_LINE_NUMBER (&%0)";
+           }
+         else if (t == basic_block_tp)
+           {
+             /* We don't presently GC basic block structures...  */
+             subfields->opt = xmalloc (sizeof (*subfields->opt));
+             subfields->opt->next = nodot;
+             subfields->opt->name = "skip";
+             subfields->opt->info = NULL;
+           }
+         else
+           subfields->opt = nodot;
+       }
+
+      flds = xmalloc (sizeof (*flds));
+      flds->next = old_flds;
+      flds->name = "";
+      sname = xasprintf ("rtx_def_%s", rtx_name[i]);
+      new_structure (sname, 0, &lexer_line, subfields, NULL);
+      flds->type = find_structure (sname, 0);
+      flds->line.file = __FILE__;
+      flds->line.line = __LINE__;
+      flds->opt = xmalloc (sizeof (*flds->opt));
+      flds->opt->next = nodot;
+      flds->opt->name = "tag";
+      ftag = xstrdup (rtx_name[i]);
+      for (nmindex = 0; nmindex < strlen (ftag); nmindex++)
+       ftag[nmindex] = TOUPPER (ftag[nmindex]);
+      flds->opt->info = ftag;
+    }
+
+  new_structure ("rtx_def_subunion", 1, &lexer_line, flds, nodot);
+  return find_structure ("rtx_def_subunion", 1);
+}
+
+/* Handle `special("tree_exp")'.  This is a special case for
+   field `operands' of struct tree_exp, which although it claims to contain
+   pointers to trees, actually sometimes contains pointers to RTL too.
+   Passed T, the old type of the field, and OPT its options.  Returns
+   a new type for the field.  */
+
+static type_p
+adjust_field_tree_exp (type_p t, options_p opt ATTRIBUTE_UNUSED)
+{
+  pair_p flds;
+  options_p nodot;
+  size_t i;
+  static const struct {
+    const char *name;
+    int first_rtl;
+    int num_rtl;
+  } data[] = {
+    { "SAVE_EXPR", 2, 1 },
+    { "GOTO_SUBROUTINE_EXPR", 0, 2 },
+    { "RTL_EXPR", 0, 2 },
+    { "WITH_CLEANUP_EXPR", 2, 1 },
+  };
+
+  if (t->kind != TYPE_ARRAY)
+    {
+      error_at_line (&lexer_line,
+                    "special `tree_exp' must be applied to an array");
+      return &string_type;
+    }
+
+  nodot = xmalloc (sizeof (*nodot));
+  nodot->next = NULL;
+  nodot->name = "dot";
+  nodot->info = "";
+
+  flds = xmalloc (sizeof (*flds));
+  flds->next = NULL;
+  flds->name = "";
+  flds->type = t;
+  flds->line.file = __FILE__;
+  flds->line.line = __LINE__;
+  flds->opt = xmalloc (sizeof (*flds->opt));
+  flds->opt->next = nodot;
+  flds->opt->name = "length";
+  flds->opt->info = "TREE_CODE_LENGTH (TREE_CODE ((tree) &%0))";
+  {
+    options_p oldopt = flds->opt;
+    flds->opt = xmalloc (sizeof (*flds->opt));
+    flds->opt->next = oldopt;
+    flds->opt->name = "default";
+    flds->opt->info = "";
+  }
+
+  for (i = 0; i < ARRAY_SIZE (data); i++)
+    {
+      pair_p old_flds = flds;
+      pair_p subfields = NULL;
+      int r_index;
+      const char *sname;
+
+      for (r_index = 0;
+          r_index < data[i].first_rtl + data[i].num_rtl;
+          r_index++)
+       {
+         pair_p old_subf = subfields;
+         subfields = xmalloc (sizeof (*subfields));
+         subfields->next = old_subf;
+         subfields->name = xasprintf ("[%d]", r_index);
+         if (r_index < data[i].first_rtl)
+           subfields->type = t->u.a.p;
+         else
+           subfields->type = create_pointer (find_structure ("rtx_def", 0));
+         subfields->line.file = __FILE__;
+         subfields->line.line = __LINE__;
+         subfields->opt = nodot;
+       }
+
+      flds = xmalloc (sizeof (*flds));
+      flds->next = old_flds;
+      flds->name = "";
+      sname = xasprintf ("tree_exp_%s", data[i].name);
+      new_structure (sname, 0, &lexer_line, subfields, NULL);
+      flds->type = find_structure (sname, 0);
+      flds->line.file = __FILE__;
+      flds->line.line = __LINE__;
+      flds->opt = xmalloc (sizeof (*flds->opt));
+      flds->opt->next = nodot;
+      flds->opt->name = "tag";
+      flds->opt->info = data[i].name;
+    }
+
+  new_structure ("tree_exp_subunion", 1, &lexer_line, flds, nodot);
+  return find_structure ("tree_exp_subunion", 1);
+}
+
 /* Perform any special processing on a type T, about to become the type
    of a field.  Return the appropriate type for the field.
    At present:
    - Converts pointer-to-char, with no length parameter, to TYPE_STRING;
    - Similarly for arrays of pointer-to-char;
    - Converts structures for which a parameter is provided to
-   TYPE_PARAM_STRUCT.
-*/   
+     TYPE_PARAM_STRUCT;
+   - Handles "special" options.
+*/
 
 type_p
-adjust_field_type (t, opt)
-     type_p t;
-     options_p opt;
+adjust_field_type (type_p t, options_p opt)
 {
   int length_p = 0;
   const int pointer_p = t->kind == TYPE_POINTER;
-  
+  type_p params[NUM_PARAM];
+  int params_p = 0;
+  int i;
+
+  for (i = 0; i < NUM_PARAM; i++)
+    params[i] = NULL;
+
   for (; opt; opt = opt->next)
     if (strcmp (opt->name, "length") == 0)
       length_p = 1;
-    else if (strcmp (opt->name, "param_is") == 0)
+    else if (strcmp (opt->name, "param_is") == 0
+            || (strncmp (opt->name, "param", 5) == 0
+                && ISDIGIT (opt->name[5])
+                && strcmp (opt->name + 6, "_is") == 0))
+      {
+       int num = ISDIGIT (opt->name[5]) ? opt->name[5] - '0' : 0;
+
+       if (! UNION_OR_STRUCT_P (t)
+           && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
+         {
+           error_at_line (&lexer_line,
+   "option `%s' may only be applied to structures or structure pointers",
+                          opt->name);
+           return t;
+         }
+
+       params_p = 1;
+       if (params[num] != NULL)
+         error_at_line (&lexer_line, "duplicate `%s' option", opt->name);
+       if (! ISDIGIT (opt->name[5]))
+         params[num] = create_pointer ((type_p) opt->info);
+       else
+         params[num] = (type_p) opt->info;
+      }
+    else if (strcmp (opt->name, "special") == 0)
       {
-       type_p realt;
-
-       if (pointer_p)
-         t = t->u.p;
-       
-       for (realt = param_structs; realt; realt = realt->next)
-         if (realt->u.param_struct.stru == t
-             && realt->u.param_struct.param == (type_p) opt->info)
-           return pointer_p ? create_pointer (realt) : realt;
-       realt = xcalloc (1, sizeof (*realt));
-       realt->kind = TYPE_PARAM_STRUCT;
-       realt->next = param_structs;
-       param_structs = realt;
-       realt->u.param_struct.stru = t;
-       realt->u.param_struct.param = (type_p) opt->info;
-       return pointer_p ? create_pointer (realt) : realt;
+       const char *special_name = (const char *)opt->info;
+       if (strcmp (special_name, "tree_exp") == 0)
+         t = adjust_field_tree_exp (t, opt);
+       else if (strcmp (special_name, "rtx_def") == 0)
+         t = adjust_field_rtx_def (t, opt);
+       else
+         error_at_line (&lexer_line, "unknown special `%s'", special_name);
       }
-  
+
+  if (params_p)
+    {
+      type_p realt;
+
+      if (pointer_p)
+       t = t->u.p;
+      realt = find_param_structure (t, params);
+      t = pointer_p ? create_pointer (realt) : realt;
+    }
+
   if (! length_p
       && pointer_p
       && t->u.p->kind == TYPE_SCALAR
@@ -335,44 +813,21 @@ adjust_field_type (t, opt)
   return t;
 }
 
-/* Add a variable named S of type T with options O defined at POS,
-   to `variables'.  */
-
-void
-note_variable (s, t, o, pos)
-     const char *s;
-     type_p t;
-     options_p o;
-     struct fileloc *pos;
-{
-  pair_p n;
-  n = xmalloc (sizeof (*n));
-  n->name = s;
-  n->type = t;
-  n->line = *pos;
-  n->opt = o;
-  n->next = variables;
-  variables = n;
-}
-
 /* Create a union for YYSTYPE, as yacc would do it, given a fieldlist FIELDS
-   and information about the correspondance between token types and fields
+   and information about the correspondence between token types and fields
    in TYPEINFO.  POS is used for error messages.  */
 
 void
-note_yacc_type (o, fields, typeinfo, pos)
-     options_p o;
-     pair_p fields;
-     pair_p typeinfo;
-     struct fileloc *pos;
+note_yacc_type (options_p o, pair_p fields, pair_p typeinfo,
+               struct fileloc *pos)
 {
   pair_p p;
   pair_p *p_p;
-  
+
   for (p = typeinfo; p; p = p->next)
     {
       pair_p m;
-      
+
       if (p->name == NULL)
        continue;
 
@@ -380,7 +835,7 @@ note_yacc_type (o, fields, typeinfo, pos)
        {
          pair_p pp;
          int ok = 0;
-         
+
          for (pp = typeinfo; pp; pp = pp->next)
            if (pp->type != (type_p) 1
                && strcmp (pp->opt->info, p->opt->info) == 0)
@@ -397,12 +852,12 @@ note_yacc_type (o, fields, typeinfo, pos)
          p->type = m->type;
       if (p->type == NULL)
        {
-         error_at_line (&p->line, 
+         error_at_line (&p->line,
                         "couldn't match fieldname `%s'", p->name);
          p->name = NULL;
        }
     }
-  
+
   p_p = &typeinfo;
   while (*p_p)
     {
@@ -419,32 +874,33 @@ note_yacc_type (o, fields, typeinfo, pos)
   do_typedef ("YYSTYPE", find_structure ("yy_union", 1), pos);
 }
 \f
-static void process_gc_options PARAMS ((options_p, enum gc_used_enum, int *));
-static void set_gc_used_type PARAMS ((type_p, enum gc_used_enum));
-static void set_gc_used PARAMS ((pair_p));
+static void process_gc_options (options_p, enum gc_used_enum,
+                               int *, int *, int *);
+static void set_gc_used_type (type_p, enum gc_used_enum, type_p *);
+static void set_gc_used (pair_p);
 
 /* Handle OPT for set_gc_used_type.  */
 
 static void
-process_gc_options (opt, level, maybe_undef)
-     options_p opt;
-     enum gc_used_enum level;
-     int *maybe_undef;
+process_gc_options (options_p opt, enum gc_used_enum level, int *maybe_undef,
+                   int *pass_param, int *length)
 {
   options_p o;
   for (o = opt; o; o = o->next)
     if (strcmp (o->name, "ptr_alias") == 0 && level == GC_POINTED_TO)
-      set_gc_used_type ((type_p) o->info, GC_POINTED_TO);
+      set_gc_used_type ((type_p) o->info, GC_POINTED_TO, NULL);
     else if (strcmp (o->name, "maybe_undef") == 0)
       *maybe_undef = 1;
+    else if (strcmp (o->name, "use_params") == 0)
+      *pass_param = 1;
+    else if (strcmp (o->name, "length") == 0)
+      *length = 1;
 }
 
 /* Set the gc_used field of T to LEVEL, and handle the types it references.  */
 
 static void
-set_gc_used_type (t, level)
-     type_p t;
-     enum gc_used_enum level;
+set_gc_used_type (type_p t, enum gc_used_enum level, type_p param[NUM_PARAM])
 {
   if (t->gc_used >= level)
     return;
@@ -459,37 +915,56 @@ set_gc_used_type (t, level)
        pair_p f;
        int dummy;
 
-       process_gc_options (t->u.s.opt, level, &dummy);
+       process_gc_options (t->u.s.opt, level, &dummy, &dummy, &dummy);
 
        for (f = t->u.s.fields; f; f = f->next)
          {
            int maybe_undef = 0;
-           process_gc_options (t->u.s.opt, level, &maybe_undef);
-           
-           if (maybe_undef && f->type->kind == TYPE_POINTER)
-             set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO);
+           int pass_param = 0;
+           int length = 0;
+           process_gc_options (f->opt, level, &maybe_undef, &pass_param,
+                               &length);
+
+           if (length && f->type->kind == TYPE_POINTER)
+             set_gc_used_type (f->type->u.p, GC_USED, NULL);
+           else if (maybe_undef && f->type->kind == TYPE_POINTER)
+             set_gc_used_type (f->type->u.p, GC_MAYBE_POINTED_TO, NULL);
+           else if (pass_param && f->type->kind == TYPE_POINTER && param)
+             set_gc_used_type (find_param_structure (f->type->u.p, param),
+                               GC_POINTED_TO, NULL);
            else
-             set_gc_used_type (f->type, GC_USED);
+             set_gc_used_type (f->type, GC_USED, pass_param ? param : NULL);
          }
        break;
       }
 
     case TYPE_POINTER:
-      set_gc_used_type (t->u.p, GC_POINTED_TO);
+      set_gc_used_type (t->u.p, GC_POINTED_TO, NULL);
       break;
 
     case TYPE_ARRAY:
-      set_gc_used_type (t->u.a.p, GC_USED);
+      set_gc_used_type (t->u.a.p, GC_USED, param);
       break;
-      
+
     case TYPE_LANG_STRUCT:
       for (t = t->u.s.lang_struct; t; t = t->next)
-       set_gc_used_type (t, level);
+       set_gc_used_type (t, level, param);
       break;
 
     case TYPE_PARAM_STRUCT:
-      set_gc_used_type (t->u.param_struct.param, GC_POINTED_TO);
-      set_gc_used_type (t->u.param_struct.stru, GC_USED);
+      {
+       int i;
+       for (i = 0; i < NUM_PARAM; i++)
+         if (t->u.param_struct.param[i] != 0)
+           set_gc_used_type (t->u.param_struct.param[i], GC_USED, NULL);
+      }
+      if (t->u.param_struct.stru->gc_used == GC_POINTED_TO)
+       level = GC_POINTED_TO;
+      else
+       level = GC_USED;
+      t->u.param_struct.stru->gc_used = GC_UNUSED;
+      set_gc_used_type (t->u.param_struct.stru, level,
+                       t->u.param_struct.param);
       break;
 
     default:
@@ -497,15 +972,14 @@ set_gc_used_type (t, level)
     }
 }
 
-/* Set the gc_used fileds of all the types pointed to by VARIABLES.  */
+/* Set the gc_used fields of all the types pointed to by VARIABLES.  */
 
 static void
-set_gc_used (variables)
-     pair_p variables;
+set_gc_used (pair_p variables)
 {
   pair_p p;
   for (p = variables; p; p = p->next)
-    set_gc_used_type (p->type, GC_USED);
+    set_gc_used_type (p->type, GC_USED, NULL);
 }
 \f
 /* File mapping routines.  For each input file, there is one output .c file
@@ -517,7 +991,7 @@ static outf_p output_files;
 
 /* The output header file that is included into pretty much every
    source file.  */
-outf_p header_file;
+static outf_p header_file;
 
 /* Number of files specified in gtfiles.  */
 #define NUM_GT_FILES (ARRAY_SIZE (all_files) - 1)
@@ -531,19 +1005,17 @@ static int srcdir_len = 0;
 #define NUM_BASE_FILES (ARRAY_SIZE (lang_dir_names) - 1)
 outf_p base_files[NUM_BASE_FILES];
 
-static outf_p create_file PARAMS ((const char *, const char *));
-static const char * get_file_basename PARAMS ((const char *));
+static outf_p create_file (const char *, const char *);
+static const char * get_file_basename (const char *);
 
 /* Create and return an outf_p for a new file for NAME, to be called
    ONAME.  */
 
 static outf_p
-create_file (name, oname)
-     const char *name;
-     const char *oname;
+create_file (const char *name, const char *oname)
 {
   static const char *const hdr[] = {
-    "   Copyright (C) 2002 Free Software Foundation, Inc.\n",
+    "   Copyright (C) 2003 Free Software Foundation, Inc.\n",
     "\n",
     "This file is part of GCC.\n",
     "\n",
@@ -566,7 +1038,7 @@ create_file (name, oname)
   };
   outf_p f;
   size_t i;
-  
+
   f = xcalloc (sizeof (*f), 1);
   f->next = output_files;
   f->name = oname;
@@ -579,15 +1051,14 @@ create_file (name, oname)
 }
 
 /* Print, like fprintf, to O.  */
-void 
-oprintf VPARAMS ((outf_p o, const char *format, ...))
+void
+oprintf (outf_p o, const char *format, ...)
 {
   char *s;
   size_t slength;
-  
-  VA_OPEN (ap, format);
-  VA_FIXEDARG (ap, outf_p, o);
-  VA_FIXEDARG (ap, const char *, format);
+  va_list ap;
+
+  va_start (ap, format);
   slength = xvasprintf (&s, format, ap);
 
   if (o->bufused + slength > o->buflength)
@@ -604,38 +1075,37 @@ oprintf VPARAMS ((outf_p o, const char *format, ...))
   memcpy (o->buf + o->bufused, s, slength);
   o->bufused += slength;
   free (s);
-  VA_CLOSE (ap);
+  va_end (ap);
 }
 
 /* Open the global header file and the language-specific header files.  */
 
-static void open_base_files PARAMS((void));
-
 static void
-open_base_files ()
+open_base_files (void)
 {
   size_t i;
-  
+
   header_file = create_file ("GCC", "gtype-desc.h");
 
   for (i = 0; i < NUM_BASE_FILES; i++)
-    base_files[i] = create_file (lang_dir_names[i], 
+    base_files[i] = create_file (lang_dir_names[i],
                                 xasprintf ("gtype-%s.h", lang_dir_names[i]));
 
   /* gtype-desc.c is a little special, so we create it here.  */
   {
     /* The order of files here matters very much.  */
     static const char *const ifiles [] = {
-      "config.h", "system.h", "varray.h", "hashtab.h",
-      "bitmap.h", "tree.h", "rtl.h", "function.h", "insn-config.h",
-      "expr.h", "hard-reg-set.h", "basic-block.h", "cselib.h",
-      "insn-addr.h", "ssa.h", "optabs.h", "libfuncs.h",
-      "debug.h", "ggc.h",
+      "config.h", "system.h", "coretypes.h", "tm.h", "varray.h", 
+      "hashtab.h", "splay-tree.h", "bitmap.h", "tree.h", "rtl.h",
+      "function.h", "insn-config.h", "expr.h", "hard-reg-set.h",
+      "basic-block.h", "cselib.h", "insn-addr.h", "optabs.h",
+      "libfuncs.h", "debug.h", "ggc.h", "cgraph.h",
+      "tree-alias-type.h", "tree-flow.h", "reload.h",
       NULL
     };
     const char *const *ifp;
     outf_p gtype_desc_c;
-      
+
     gtype_desc_c = create_file ("GCC", "gtype-desc.c");
     for (ifp = ifiles; *ifp; ifp++)
       oprintf (gtype_desc_c, "#include \"%s\"\n", *ifp);
@@ -645,21 +1115,18 @@ open_base_files ()
 /* Determine the pathname to F relative to $(srcdir).  */
 
 static const char *
-get_file_basename (f)
-     const char *f;
+get_file_basename (const char *f)
 {
-  size_t len;
   const char *basename;
   unsigned i;
-  
+
   basename = strrchr (f, '/');
-  
+
   if (!basename)
     return f;
-  
-  len = strlen (f);
+
   basename++;
-  
+
   for (i = 1; i < NUM_BASE_FILES; i++)
     {
       const char * s1;
@@ -678,12 +1145,12 @@ get_file_basename (f)
           break;
         }
     }
-  
+
   return basename;
 }
 
 /* Return a bitmap which has bit `1 << BASE_FILE_<lang>' set iff
-   INPUT_FILE is used by <lang>.  
+   INPUT_FILE is used by <lang>.
 
    This function should be written to assume that a file _is_ used
    if the situation is unclear.  If it wrongly assumes a file _is_ used,
@@ -691,15 +1158,14 @@ get_file_basename (f)
    some GC roots may be missed, which is a much harder-to-debug problem.  */
 
 unsigned
-get_base_file_bitmap (input_file)
-     const char *input_file;
+get_base_file_bitmap (const char *input_file)
 {
   const char *basename = get_file_basename (input_file);
   const char *slashpos = strchr (basename, '/');
   unsigned j;
   unsigned k;
   unsigned bitmap;
-  
+
   if (slashpos)
     {
       size_t i;
@@ -731,7 +1197,7 @@ get_base_file_bitmap (input_file)
             }
         }
     }
-    
+
   /* Otherwise, set all languages.  */
   if (!bitmap)
     bitmap = (1 << NUM_BASE_FILES) - 1;
@@ -744,8 +1210,7 @@ get_base_file_bitmap (input_file)
    INPUT_FILE.  */
 
 outf_p
-get_output_file_with_visibility (input_file)
-     const char *input_file;
+get_output_file_with_visibility (const char *input_file)
 {
   outf_p r;
   size_t len;
@@ -768,7 +1233,7 @@ get_output_file_with_visibility (input_file)
       || (len > 3 && memcmp (basename+len-3, ".in", 3) == 0))
     {
       char *s;
-      
+
       output_name = s = xasprintf ("gt-%s", basename);
       for (; *s != '.'; s++)
        if (! ISALNUM (*s) && *s != '-')
@@ -780,10 +1245,10 @@ get_output_file_with_visibility (input_file)
     output_name = "gt-c-common.h", for_name = "c-common.c";
   else if (strcmp (basename, "c-tree.h") == 0)
     output_name = "gt-c-decl.h", for_name = "c-decl.c";
-  else 
+  else
     {
       size_t i;
-      
+
       for (i = 0; i < NUM_BASE_FILES; i++)
        if (memcmp (basename, lang_dir_names[i], strlen (lang_dir_names[i])) == 0
            && basename[strlen(lang_dir_names[i])] == '/')
@@ -809,8 +1274,7 @@ get_output_file_with_visibility (input_file)
    that uses INPUT_FILE.  */
 
 const char *
-get_output_file_name (input_file)
-     const char *input_file;
+get_output_file_name (const char *input_file)
 {
   return get_output_file_with_visibility (input_file)->name;
 }
@@ -818,13 +1282,11 @@ get_output_file_name (input_file)
 /* Copy the output to its final destination,
    but don't unnecessarily change modification times.  */
 
-static void close_output_files PARAMS ((void));
-
 static void
-close_output_files ()
+close_output_files (void)
 {
   outf_p of;
-  
+
   for (of = output_files; of; of = of->next)
     {
       FILE * newfile;
@@ -875,519 +1337,799 @@ struct flist {
   outf_p f;
 };
 
-static void output_escaped_param PARAMS ((outf_p , const char *, const char *,
-                                         const char *, const char *,
-                                         struct fileloc *));
-static void write_gc_structure_fields 
-  PARAMS ((outf_p , type_p, const char *, const char *, options_p, 
-          int, struct fileloc *, lang_bitmap, type_p));
-static void write_gc_marker_routine_for_structure PARAMS ((type_p, type_p));
-static void write_gc_types PARAMS ((type_p structures, type_p param_structs));
-static void put_mangled_filename PARAMS ((outf_p , const char *));
-static void finish_root_table PARAMS ((struct flist *flp, const char *pfx, 
-                                      const char *tname, const char *lastname,
-                                      const char *name));
-static void write_gc_root PARAMS ((outf_p , pair_p, type_p, const char *, int,
-                                  struct fileloc *, const char *));
-static void write_gc_roots PARAMS ((pair_p));
-
-static int gc_counter;
-
-/* Print PARAM to OF processing escapes.  VAL references the current object,
-   PREV_VAL the object containing the current object, ONAME is the name
-   of the option and LINE is used to print error messages.  */
+struct walk_type_data;
+
+/* For scalars and strings, given the item in 'val'.
+   For structures, given a pointer to the item in 'val'.
+   For misc. pointers, given the item in 'val'.
+*/
+typedef void (*process_field_fn)
+     (type_p f, const struct walk_type_data *p);
+typedef void (*func_name_fn)
+     (type_p s, const struct walk_type_data *p);
+
+/* Parameters for write_types.  */
+
+struct write_types_data
+{
+  const char *prefix;
+  const char *param_prefix;
+  const char *subfield_marker_routine;
+  const char *marker_routine;
+  const char *reorder_note_routine;
+  const char *comment;
+};
+
+static void output_escaped_param (struct walk_type_data *d,
+                                 const char *, const char *);
+static void output_mangled_typename (outf_p, type_p);
+static void walk_type (type_p t, struct walk_type_data *d);
+static void write_func_for_structure
+     (type_p orig_s, type_p s, type_p * param,
+      const struct write_types_data *wtd);
+static void write_types_process_field
+     (type_p f, const struct walk_type_data *d);
+static void write_types (type_p structures,
+                        type_p param_structs,
+                        const struct write_types_data *wtd);
+static void write_types_local_process_field
+     (type_p f, const struct walk_type_data *d);
+static void write_local_func_for_structure
+     (type_p orig_s, type_p s, type_p * param);
+static void write_local (type_p structures,
+                        type_p param_structs);
+static void write_enum_defn (type_p structures, type_p param_structs);
+static int contains_scalar_p (type_p t);
+static void put_mangled_filename (outf_p , const char *);
+static void finish_root_table (struct flist *flp, const char *pfx,
+                              const char *tname, const char *lastname,
+                              const char *name);
+static void write_root (outf_p , pair_p, type_p, const char *, int,
+                       struct fileloc *, const char *);
+static void write_array (outf_p f, pair_p v,
+                        const struct write_types_data *wtd);
+static void write_roots (pair_p);
+
+/* Parameters for walk_type.  */
+
+struct walk_type_data
+{
+  process_field_fn process_field;
+  const void *cookie;
+  outf_p of;
+  options_p opt;
+  const char *val;
+  const char *prev_val[4];
+  int indent;
+  int counter;
+  struct fileloc *line;
+  lang_bitmap bitmap;
+  type_p *param;
+  int used_length;
+  type_p orig_s;
+  const char *reorder_fn;
+  int needs_cast_p;
+};
+
+/* Print a mangled name representing T to OF.  */
+
+static void
+output_mangled_typename (outf_p of, type_p t)
+{
+  if (t == NULL)
+    oprintf (of, "Z");
+  else switch (t->kind)
+    {
+    case TYPE_POINTER:
+      oprintf (of, "P");
+      output_mangled_typename (of, t->u.p);
+      break;
+    case TYPE_SCALAR:
+      oprintf (of, "I");
+      break;
+    case TYPE_STRING:
+      oprintf (of, "S");
+      break;
+    case TYPE_STRUCT:
+    case TYPE_UNION:
+    case TYPE_LANG_STRUCT:
+      oprintf (of, "%lu%s", (unsigned long) strlen (t->u.s.tag), t->u.s.tag);
+      break;
+    case TYPE_PARAM_STRUCT:
+      {
+       int i;
+       for (i = 0; i < NUM_PARAM; i++)
+         if (t->u.param_struct.param[i] != NULL)
+           output_mangled_typename (of, t->u.param_struct.param[i]);
+       output_mangled_typename (of, t->u.param_struct.stru);
+      }
+      break;
+    case TYPE_ARRAY:
+      abort ();
+    }
+}
+
+/* Print PARAM to D->OF processing escapes.  D->VAL references the
+   current object, D->PREV_VAL the object containing the current
+   object, ONAME is the name of the option and D->LINE is used to
+   print error messages.  */
 
 static void
-output_escaped_param (of, param, val, prev_val, oname, line)
-     outf_p of;
-     const char *param;
-     const char *val;
-     const char *prev_val;
-     const char *oname;
-     struct fileloc *line;
+output_escaped_param (struct walk_type_data *d, const char *param,
+                     const char *oname)
 {
   const char *p;
-  
+
   for (p = param; *p; p++)
     if (*p != '%')
-      oprintf (of, "%c", *p);
-    else if (*++p == 'h')
-      oprintf (of, "(%s)", val);
-    else if (*p == '0')
-      oprintf (of, "(*x)");
-    else if (*p == '1')
-      oprintf (of, "(%s)", prev_val);
-    else
-      error_at_line (line, "`%s' option contains bad escape %c%c",
-                    oname, '%', *p);
+      oprintf (d->of, "%c", *p);
+    else switch (*++p)
+      {
+      case 'h':
+       oprintf (d->of, "(%s)", d->prev_val[2]);
+       break;
+      case '0':
+       oprintf (d->of, "(%s)", d->prev_val[0]);
+       break;
+      case '1':
+       oprintf (d->of, "(%s)", d->prev_val[1]);
+       break;
+      case 'a':
+       {
+         const char *pp = d->val + strlen (d->val);
+         while (pp[-1] == ']')
+           while (*pp != '[')
+             pp--;
+         oprintf (d->of, "%s", pp);
+       }
+       break;
+      default:
+       error_at_line (d->line, "`%s' option contains bad escape %c%c",
+                      oname, '%', *p);
+      }
 }
 
-/* Write out code to OF which marks the fields of S.  VAL references
-   the current object, PREV_VAL the object containing the current
-   object, OPTS is a list of options to apply, INDENT is the current
-   indentation level, LINE is used to print error messages, BITMAP
-   indicates which languages to print the structure for, and PARAM is
-   the current parameter (from an enclosing param_is option).  */
+/* Call D->PROCESS_FIELD for every field (or subfield) of D->VAL,
+   which is of type T.  Write code to D->OF to constrain execution (at
+   the point that D->PROCESS_FIELD is called) to the appropriate
+   cases.  Call D->PROCESS_FIELD on subobjects before calling it on
+   pointers to those objects.  D->PREV_VAL lists the objects
+   containing the current object, D->OPT is a list of options to
+   apply, D->INDENT is the current indentation level, D->LINE is used
+   to print error messages, D->BITMAP indicates which languages to
+   print the structure for, and D->PARAM is the current parameter
+   (from an enclosing param_is option).  */
 
 static void
-write_gc_structure_fields (of, s, val, prev_val, opts, indent, line, bitmap,
-                          param)
-     outf_p of;
-     type_p s;
-     const char *val;
-     const char *prev_val;
-     options_p opts;
-     int indent;
-     struct fileloc *line;
-     lang_bitmap bitmap;
-     type_p param;
+walk_type (type_p t, struct walk_type_data *d)
 {
-  pair_p f;
-  int tagcounter = -1;
+  const char *length = NULL;
+  const char *desc = NULL;
+  int maybe_undef_p = 0;
+  int use_param_num = -1;
+  int use_params_p = 0;
+  options_p oo;
+  const struct nested_ptr_data *nested_ptr_d = NULL;
+
+  d->needs_cast_p = 0;
+  for (oo = d->opt; oo; oo = oo->next)
+    if (strcmp (oo->name, "length") == 0)
+      length = (const char *)oo->info;
+    else if (strcmp (oo->name, "maybe_undef") == 0)
+      maybe_undef_p = 1;
+    else if (strncmp (oo->name, "use_param", 9) == 0
+            && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
+      use_param_num = oo->name[9] == '\0' ? 0 : oo->name[9] - '0';
+    else if (strcmp (oo->name, "use_params") == 0)
+      use_params_p = 1;
+    else if (strcmp (oo->name, "desc") == 0)
+      desc = (const char *)oo->info;
+    else if (strcmp (oo->name, "nested_ptr") == 0)
+      nested_ptr_d = (const struct nested_ptr_data *)oo->info ;
+    else if (strcmp (oo->name, "dot") == 0)
+      ;
+    else if (strcmp (oo->name, "tag") == 0)
+      ;
+    else if (strcmp (oo->name, "special") == 0)
+      ;
+    else if (strcmp (oo->name, "skip") == 0)
+      ;
+    else if (strcmp (oo->name, "default") == 0)
+      ;
+    else if (strcmp (oo->name, "descbits") == 0)
+      ;
+    else if (strcmp (oo->name, "param_is") == 0)
+      ;
+    else if (strncmp (oo->name, "param", 5) == 0
+            && ISDIGIT (oo->name[5])
+            && strcmp (oo->name + 6, "_is") == 0)
+      ;
+    else if (strcmp (oo->name, "chain_next") == 0)
+      ;
+    else if (strcmp (oo->name, "chain_prev") == 0)
+      ;
+    else if (strcmp (oo->name, "reorder") == 0)
+      ;
+    else
+      error_at_line (d->line, "unknown option `%s'\n", oo->name);
 
-  if (! s->u.s.line.file)
-    error_at_line (line, "incomplete structure `%s'", s->u.s.tag);
-  else if ((s->u.s.bitmap & bitmap) != bitmap)
+  if (d->used_length)
+    length = NULL;
+
+  if (use_params_p)
     {
-      error_at_line (line, "structure defined for mismatching languages");
-      error_at_line (&s->u.s.line, "one structure defined here");
+      int pointer_p = t->kind == TYPE_POINTER;
+
+      if (pointer_p)
+       t = t->u.p;
+      if (! UNION_OR_STRUCT_P (t))
+       error_at_line (d->line, "`use_params' option on unimplemented type");
+      else
+       t = find_param_structure (t, d->param);
+      if (pointer_p)
+       t = create_pointer (t);
     }
-  
-  if (s->kind == TYPE_UNION)
+
+  if (use_param_num != -1)
     {
-      const char *tagexpr = NULL;
-      options_p oo;
-      
-      tagcounter = ++gc_counter;
-      for (oo = opts; oo; oo = oo->next)
-       if (strcmp (oo->name, "desc") == 0)
-         tagexpr = (const char *)oo->info;
-      if (tagexpr == NULL)
+      if (d->param != NULL && d->param[use_param_num] != NULL)
        {
-         tagexpr = "1";
-         error_at_line (line, "missing `desc' option");
+         type_p nt = d->param[use_param_num];
+
+         if (t->kind == TYPE_ARRAY)
+           nt = create_array (nt, t->u.a.len);
+         else if (length != NULL && t->kind == TYPE_POINTER)
+           nt = create_pointer (nt);
+         d->needs_cast_p = (t->kind != TYPE_POINTER
+                            && (nt->kind == TYPE_POINTER
+                                || nt->kind == TYPE_STRING));
+         t = nt;
        }
-
-      oprintf (of, "%*s{\n", indent, "");
-      indent += 2;
-      oprintf (of, "%*sunsigned int tag%d = (", indent, "", tagcounter);
-      output_escaped_param (of, tagexpr, val, prev_val, "desc", line);
-      oprintf (of, ");\n");
+      else
+       error_at_line (d->line, "no parameter defined for `%s'",
+                      d->val);
     }
-  
-  for (f = s->u.s.fields; f; f = f->next)
+
+  if (maybe_undef_p
+      && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
     {
-      const char *tagid = NULL;
-      const char *length = NULL;
-      const char *special = NULL;
-      int skip_p = 0;
-      int always_p = 0;
-      int maybe_undef_p = 0;
-      int use_param_p = 0;
-      options_p oo;
-      type_p t = f->type;
-      
-      if (t->kind == TYPE_SCALAR
-         || (t->kind == TYPE_ARRAY 
-             && t->u.a.p->kind == TYPE_SCALAR))
-       continue;
-      
-      for (oo = f->opt; oo; oo = oo->next)
-       if (strcmp (oo->name, "length") == 0)
-         length = (const char *)oo->info;
-       else if (strcmp (oo->name, "maybe_undef") == 0)
-         maybe_undef_p = 1;
-       else if (strcmp (oo->name, "tag") == 0)
-         tagid = (const char *)oo->info;
-       else if (strcmp (oo->name, "special") == 0)
-         special = (const char *)oo->info;
-       else if (strcmp (oo->name, "skip") == 0)
-         skip_p = 1;
-       else if (strcmp (oo->name, "always") == 0)
-         always_p = 1;
-       else if (strcmp (oo->name, "desc") == 0 && UNION_P (t))
-         ;
-       else if (strcmp (oo->name, "descbits") == 0 && UNION_P (t))
-         ;
-       else if (strcmp (oo->name, "param_is") == 0)
-         ;
-       else if (strcmp (oo->name, "use_param") == 0)
-         use_param_p = 1;
-       else
-         error_at_line (&f->line, "unknown field option `%s'\n", oo->name);
+      error_at_line (d->line,
+                    "field `%s' has invalid option `maybe_undef_p'\n",
+                    d->val);
+      return;
+    }
 
-      if (skip_p)
-       continue;
-      
-      if (use_param_p)
-       {
-         if (param != NULL)
-           {
-             type_p t1;
-             type_p nt = param;
-             int arraycount = 0;
-             
-             for (t1 = t; t->kind == TYPE_ARRAY; t = t->u.a.p)
-               arraycount++;
-             for (; t->kind == TYPE_POINTER; t = t->u.p)
-               nt = create_pointer (nt);
-             while (arraycount-- > 0)
-               nt = create_array (nt, t->u.a.len);
-             t = nt;
-           }
-         else if (s->kind == TYPE_UNION && ! always_p && tagid)
-           ;
-         else
-           error_at_line (&f->line, "no parameter defined");
-       }
+  switch (t->kind)
+    {
+    case TYPE_SCALAR:
+    case TYPE_STRING:
+      d->process_field (t, d);
+      break;
 
-      if (maybe_undef_p
-         && (t->kind != TYPE_POINTER
-             || t->u.p->kind != TYPE_STRUCT))
-       error_at_line (&f->line, 
-                      "field `%s' has invalid option `maybe_undef_p'\n",
-                      f->name);
-      if (s->kind == TYPE_UNION && ! always_p )
-       {
-         if (! tagid)
-           {
-             error_at_line (&f->line, "field `%s' has no tag", f->name);
-             continue;
-           }
-         oprintf (of, "%*sif (tag%d == (%s)) {\n", indent, "", 
-                  tagcounter, tagid);
-         indent += 2;
-       }
-      
-      switch (t->kind)
-       {
-       case TYPE_STRING:
-         /* Do nothing; strings go in the string pool.  */
-         break;
+    case TYPE_POINTER:
+      {
+       if (maybe_undef_p
+           && t->u.p->u.s.line.file == NULL)
+         {
+           oprintf (d->of, "%*sif (%s) abort();\n", d->indent, "", d->val);
+           break;
+         }
 
-       case TYPE_LANG_STRUCT:
+       if (! length)
          {
-           type_p ti;
-           for (ti = t->u.s.lang_struct; ti; ti = ti->next)
-             if (ti->u.s.bitmap & bitmap)
-               {
-                 t = ti;
-                 break;
-               }
-           if (ti == NULL)
+           if (! UNION_OR_STRUCT_P (t->u.p)
+               && t->u.p->kind != TYPE_PARAM_STRUCT)
              {
-               error_at_line (&f->line, 
-                              "structure not defined for this language");
+               error_at_line (d->line,
+                              "field `%s' is pointer to unimplemented type",
+                              d->val);
                break;
              }
+
+           if (nested_ptr_d)
+             {
+               const char *oldprevval2 = d->prev_val[2];
+
+               if (! UNION_OR_STRUCT_P (nested_ptr_d->type))
+                 {
+                   error_at_line (d->line,
+                                  "field `%s' has invalid "
+                                  "option `nested_ptr'\n",
+                                  d->val);
+                   return;
+                 }
+
+               d->prev_val[2] = d->val;
+               oprintf (d->of, "%*s{\n", d->indent, "");
+               d->indent += 2;
+               d->val = xasprintf ("x%d", d->counter++);
+               oprintf (d->of, "%*s%s %s * %s =\n", d->indent, "",
+                        (nested_ptr_d->type->kind == TYPE_UNION 
+                         ? "union" : "struct"), 
+                        nested_ptr_d->type->u.s.tag, d->val);
+               oprintf (d->of, "%*s", d->indent + 2, "");
+               output_escaped_param (d, nested_ptr_d->convert_from,
+                                     "nested_ptr");
+               oprintf (d->of, ";\n");
+
+               d->process_field (nested_ptr_d->type, d);
+
+               oprintf (d->of, "%*s%s = ", d->indent, "",
+                        d->prev_val[2]);
+               d->prev_val[2] = d->val;
+               output_escaped_param (d, nested_ptr_d->convert_to,
+                                     "nested_ptr");
+               oprintf (d->of, ";\n");
+
+               d->indent -= 2;
+               oprintf (d->of, "%*s}\n", d->indent, "");
+               d->val = d->prev_val[2];
+               d->prev_val[2] = oldprevval2;
+             }
+           else
+             d->process_field (t->u.p, d);
          }
-         /* Fall through... */
-       case TYPE_STRUCT:
-       case TYPE_UNION:
+       else
          {
+           int loopcounter = d->counter++;
+           const char *oldval = d->val;
+           const char *oldprevval3 = d->prev_val[3];
            char *newval;
 
-           newval = xasprintf ("%s.%s", val, f->name);
-           write_gc_structure_fields (of, t, newval, val, f->opt, indent, 
-                                      &f->line, bitmap, param);
+           oprintf (d->of, "%*sif (%s != NULL) {\n", d->indent, "", d->val);
+           d->indent += 2;
+           oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
+           oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
+                    loopcounter, loopcounter);
+           output_escaped_param (d, length, "length");
+           oprintf (d->of, "); i%d++) {\n", loopcounter);
+           d->indent += 2;
+           d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
+           d->used_length = 1;
+           d->prev_val[3] = oldval;
+           walk_type (t->u.p, d);
            free (newval);
-           break;
+           d->val = oldval;
+           d->prev_val[3] = oldprevval3;
+           d->used_length = 0;
+           d->indent -= 2;
+           oprintf (d->of, "%*s}\n", d->indent, "");
+           d->process_field(t, d);
+           d->indent -= 2;
+           oprintf (d->of, "%*s}\n", d->indent, "");
          }
+      }
+      break;
 
-       case TYPE_POINTER:
-         if (! length)
-           {
-             if (maybe_undef_p
-                 && t->u.p->u.s.line.file == NULL)
-               oprintf (of, "%*sif (%s.%s) abort();\n", indent, "",
-                        val, f->name);
-             else if (UNION_OR_STRUCT_P (t->u.p))
-               oprintf (of, "%*sgt_ggc_m_%s (%s.%s);\n", indent, "", 
-                        t->u.p->u.s.tag, val, f->name);
-             else if (t->u.p->kind == TYPE_PARAM_STRUCT)
-               oprintf (of, "%*sgt_ggc_mm_%d%s_%s (%s.%s);\n", indent, "",
-                        (int) strlen (t->u.p->u.param_struct.param->u.s.tag),
-                        t->u.p->u.param_struct.param->u.s.tag,
-                        t->u.p->u.param_struct.stru->u.s.tag,
-                        val, f->name);
-             else
-               error_at_line (&f->line, "field `%s' is pointer to scalar",
-                              f->name);
-             break;
-           }
-         else if (t->u.p->kind == TYPE_SCALAR
-                  || t->u.p->kind == TYPE_STRING)
-           oprintf (of, "%*sggc_mark (%s.%s);\n", indent, "", 
-                    val, f->name);
-         else
-           {
-             int loopcounter = ++gc_counter;
-             
-             oprintf (of, "%*sif (%s.%s != NULL) {\n", indent, "",
-                      val, f->name);
-             indent += 2;
-             oprintf (of, "%*ssize_t i%d;\n", indent, "", loopcounter);
-             oprintf (of, "%*sggc_set_mark (%s.%s);\n", indent, "", 
-                      val, f->name);
-             oprintf (of, "%*sfor (i%d = 0; i%d < (", indent, "", 
-                      loopcounter, loopcounter);
-             output_escaped_param (of, length, val, prev_val, "length", line);
-             oprintf (of, "); i%d++) {\n", loopcounter);
-             indent += 2;
-             switch (t->u.p->kind)
-               {
-               case TYPE_STRUCT:
-               case TYPE_UNION:
-                 {
-                   char *newval;
-                   
-                   newval = xasprintf ("%s.%s[i%d]", val, f->name, 
-                                       loopcounter);
-                   write_gc_structure_fields (of, t->u.p, newval, val,
-                                              f->opt, indent, &f->line,
-                                              bitmap, param);
-                   free (newval);
-                   break;
-                 }
-               case TYPE_POINTER:
-                 if (UNION_OR_STRUCT_P (t->u.p->u.p))
-                   oprintf (of, "%*sgt_ggc_m_%s (%s.%s[i%d]);\n", indent, "", 
-                            t->u.p->u.p->u.s.tag, val, f->name,
-                            loopcounter);
-                 else
-                   error_at_line (&f->line, 
-                                  "field `%s' is array of pointer to scalar",
-                                  f->name);
-                 break;
-               default:
-                 error_at_line (&f->line, 
-                                "field `%s' is array of unimplemented type",
-                                f->name);
-                 break;
-               }
-             indent -= 2;
-             oprintf (of, "%*s}\n", indent, "");
-             indent -= 2;
-             oprintf (of, "%*s}\n", indent, "");
-           }
+    case TYPE_ARRAY:
+      {
+       int loopcounter = d->counter++;
+       const char *oldval = d->val;
+       char *newval;
+
+       /* If it's an array of scalars, we optimize by not generating
+          any code.  */
+       if (t->u.a.p->kind == TYPE_SCALAR)
          break;
 
-       case TYPE_ARRAY:
-         {
-           int loopcounter = ++gc_counter;
-           type_p ta;
-           int i;
-
-           if (! length &&
-               (strcmp (t->u.a.len, "0") == 0
-                || strcmp (t->u.a.len, "1") == 0))
-             error_at_line (&f->line, 
-                            "field `%s' is array of size %s",
-                            f->name, t->u.a.len);
-           
-           /* Arrays of scalars can be ignored.  */
-           for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
-             ;
-           if (ta->kind == TYPE_SCALAR
-               || ta->kind == TYPE_STRING)
-             break;
+       oprintf (d->of, "%*s{\n", d->indent, "");
+       d->indent += 2;
+       oprintf (d->of, "%*ssize_t i%d;\n", d->indent, "", loopcounter);
+       oprintf (d->of, "%*sfor (i%d = 0; i%d < (size_t)(", d->indent, "",
+                loopcounter, loopcounter);
+       if (length)
+         output_escaped_param (d, length, "length");
+       else
+         oprintf (d->of, "%s", t->u.a.len);
+       oprintf (d->of, "); i%d++) {\n", loopcounter);
+       d->indent += 2;
+       d->val = newval = xasprintf ("%s[i%d]", oldval, loopcounter);
+       d->used_length = 1;
+       walk_type (t->u.a.p, d);
+       free (newval);
+       d->used_length = 0;
+       d->val = oldval;
+       d->indent -= 2;
+       oprintf (d->of, "%*s}\n", d->indent, "");
+       d->indent -= 2;
+       oprintf (d->of, "%*s}\n", d->indent, "");
+      }
+      break;
 
-           oprintf (of, "%*s{\n", indent, "");
-           indent += 2;
+    case TYPE_STRUCT:
+    case TYPE_UNION:
+      {
+       pair_p f;
+       const char *oldval = d->val;
+       const char *oldprevval1 = d->prev_val[1];
+       const char *oldprevval2 = d->prev_val[2];
+       const int union_p = t->kind == TYPE_UNION;
+       int seen_default_p = 0;
+       options_p o;
 
-           if (special != NULL && strcmp (special, "tree_exp") == 0)
-             {
-               oprintf (of, "%*sconst size_t tree_exp_size = (",
-                         indent, "");
-               output_escaped_param (of, length, val, prev_val,
-                                     "length", line);
-               oprintf (of, ");\n");
+       if (! t->u.s.line.file)
+         error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
 
-               length = "first_rtl_op (TREE_CODE ((tree)&%h))";
-             }
+       if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
+         {
+           error_at_line (d->line,
+                          "structure `%s' defined for mismatching languages",
+                          t->u.s.tag);
+           error_at_line (&t->u.s.line, "one structure defined here");
+         }
 
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
-             {
-               oprintf (of, "%*ssize_t i%d_%d;\n", 
-                        indent, "", loopcounter, i);
-               oprintf (of, "%*sconst size_t ilimit%d_%d = (",
-                        indent, "", loopcounter, i);
-               if (i == 0 && length != NULL)
-                 output_escaped_param (of, length, val, prev_val, 
-                                       "length", line);
-               else
-                 oprintf (of, "%s", ta->u.a.len);
-               oprintf (of, ");\n");
-             }
-               
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
+       /* Some things may also be defined in the structure's options.  */
+       for (o = t->u.s.opt; o; o = o->next)
+         if (! desc && strcmp (o->name, "desc") == 0)
+           desc = (const char *)o->info;
+
+       d->prev_val[2] = oldval;
+       d->prev_val[1] = oldprevval2;
+       if (union_p)
+         {
+           if (desc == NULL)
              {
-               oprintf (of, 
-                "%*sfor (i%d_%d = 0; i%d_%d < ilimit%d_%d; i%d_%d++) {\n",
-                        indent, "", loopcounter, i, loopcounter, i,
-                        loopcounter, i, loopcounter, i);
-               indent += 2;
+               error_at_line (d->line, "missing `desc' option for union `%s'",
+                              t->u.s.tag);
+               desc = "1";
              }
+           oprintf (d->of, "%*sswitch (", d->indent, "");
+           output_escaped_param (d, desc, "desc");
+           oprintf (d->of, ")\n");
+           d->indent += 2;
+           oprintf (d->of, "%*s{\n", d->indent, "");
+         }
+       for (f = t->u.s.fields; f; f = f->next)
+         {
+           options_p oo;
+           const char *dot = ".";
+           const char *tagid = NULL;
+           int skip_p = 0;
+           int default_p = 0;
+           int use_param_p = 0;
+           char *newval;
+
+           d->reorder_fn = NULL;
+           for (oo = f->opt; oo; oo = oo->next)
+             if (strcmp (oo->name, "dot") == 0)
+               dot = (const char *)oo->info;
+             else if (strcmp (oo->name, "tag") == 0)
+               tagid = (const char *)oo->info;
+             else if (strcmp (oo->name, "skip") == 0)
+               skip_p = 1;
+             else if (strcmp (oo->name, "default") == 0)
+               default_p = 1;
+             else if (strcmp (oo->name, "reorder") == 0)
+               d->reorder_fn = (const char *)oo->info;
+             else if (strncmp (oo->name, "use_param", 9) == 0
+                      && (oo->name[9] == '\0' || ISDIGIT (oo->name[9])))
+               use_param_p = 1;
+
+           if (skip_p)
+             continue;
 
-           if (ta->kind == TYPE_POINTER
-               && (ta->u.p->kind == TYPE_STRUCT
-                   || ta->u.p->kind == TYPE_UNION))
+           if (union_p && tagid)
              {
-               oprintf (of, "%*sgt_ggc_m_%s (%s.%s", 
-                        indent, "", ta->u.p->u.s.tag, val, f->name);
-               for (ta = t, i = 0; 
-                    ta->kind == TYPE_ARRAY; 
-                    ta = ta->u.a.p, i++)
-                 oprintf (of, "[i%d_%d]", loopcounter, i);
-               oprintf (of, ");\n");
+               oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
+               d->indent += 2;
              }
-           else if (ta->kind == TYPE_STRUCT || ta->kind == TYPE_UNION)
+           else if (union_p && default_p)
              {
-               char *newval;
-               int len;
-               
-               len = strlen (val) + strlen (f->name) + 2;
-               for (ta = t; ta->kind == TYPE_ARRAY; ta = ta->u.a.p)
-                 len += sizeof ("[i_]") + 2*6;
-               
-               newval = xmalloc (len);
-               sprintf (newval, "%s.%s", val, f->name);
-               for (ta = t, i = 0; 
-                    ta->kind == TYPE_ARRAY; 
-                    ta = ta->u.a.p, i++)
-                 sprintf (newval + strlen (newval), "[i%d_%d]", 
-                          loopcounter, i);
-               write_gc_structure_fields (of, t->u.p, newval, val,
-                                          f->opt, indent, &f->line, bitmap,
-                                          param);
-               free (newval);
+               oprintf (d->of, "%*sdefault:\n", d->indent, "");
+               d->indent += 2;
+               seen_default_p = 1;
              }
-           else if (ta->kind == TYPE_POINTER && ta->u.p->kind == TYPE_SCALAR
-                    && use_param_p && param == NULL)
-             oprintf (of, "%*sabort();\n", indent, "");
-           else
-             error_at_line (&f->line, 
-                            "field `%s' is array of unimplemented type",
-                            f->name);
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
+           else if (! union_p && (default_p || tagid))
+             error_at_line (d->line,
+                            "can't use `%s' outside a union on field `%s'",
+                            default_p ? "default" : "tag", f->name);
+           else if (union_p && ! (default_p || tagid)
+                    && f->type->kind == TYPE_SCALAR)
              {
-               indent -= 2;
-               oprintf (of, "%*s}\n", indent, "");
+               fprintf (stderr,
+       "%s:%d: warning: field `%s' is missing `tag' or `default' option\n",
+                        d->line->file, d->line->line, f->name);
+               continue;
              }
+           else if (union_p && ! (default_p || tagid))
+             error_at_line (d->line,
+                            "field `%s' is missing `tag' or `default' option",
+                            f->name);
+
+           d->line = &f->line;
+           d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
+           d->opt = f->opt;
 
-           if (special != NULL && strcmp (special, "tree_exp") == 0)
+           if (union_p && use_param_p && d->param == NULL)
+             oprintf (d->of, "%*sabort();\n", d->indent, "");
+           else
+             walk_type (f->type, d);
+
+           free (newval);
+
+           if (union_p)
              {
-               oprintf (of, 
-                "%*sfor (; i%d_0 < tree_exp_size; i%d_0++)\n",
-                        indent, "", loopcounter, loopcounter);
-               oprintf (of, "%*s  gt_ggc_m_rtx_def (%s.%s[i%d_0]);\n",
-                        indent, "", val, f->name, loopcounter);
-               special = NULL;
+               oprintf (d->of, "%*sbreak;\n", d->indent, "");
+               d->indent -= 2;
              }
+         }
+       d->reorder_fn = NULL;
 
-           indent -= 2;
-           oprintf (of, "%*s}\n", indent, "");
-           break;
+       d->val = oldval;
+       d->prev_val[1] = oldprevval1;
+       d->prev_val[2] = oldprevval2;
+
+       if (union_p && ! seen_default_p)
+         {
+           oprintf (d->of, "%*sdefault:\n", d->indent, "");
+           oprintf (d->of, "%*s  break;\n", d->indent, "");
+         }
+       if (union_p)
+         {
+           oprintf (d->of, "%*s}\n", d->indent, "");
+           d->indent -= 2;
          }
+      }
+      break;
 
-       default:
-         error_at_line (&f->line, 
-                        "field `%s' is unimplemented type",
-                        f->name);
-         break;
-       }
-      
-      if (s->kind == TYPE_UNION && ! always_p )
-       {
-         indent -= 2;
-         oprintf (of, "%*s}\n", indent, "");
-       }
-      if (special)
-       error_at_line (&f->line, "unhandled special `%s'", special);
+    case TYPE_LANG_STRUCT:
+      {
+       type_p nt;
+       for (nt = t->u.s.lang_struct; nt; nt = nt->next)
+         if ((d->bitmap & nt->u.s.bitmap) == d->bitmap)
+           break;
+       if (nt == NULL)
+         error_at_line (d->line, "structure `%s' differs between languages",
+                        t->u.s.tag);
+       else
+         walk_type (nt, d);
+      }
+      break;
+
+    case TYPE_PARAM_STRUCT:
+      {
+       type_p *oldparam = d->param;
+
+       d->param = t->u.param_struct.param;
+       walk_type (t->u.param_struct.stru, d);
+       d->param = oldparam;
+      }
+      break;
+
+    default:
+      abort ();
     }
-  if (s->kind == TYPE_UNION)
+}
+
+/* process_field routine for marking routines.  */
+
+static void
+write_types_process_field (type_p f, const struct walk_type_data *d)
+{
+  const struct write_types_data *wtd;
+  const char *cast = d->needs_cast_p ? "(void *)" : "";
+  wtd = (const struct write_types_data *) d->cookie;
+
+  switch (f->kind)
     {
-      indent -= 2;
-      oprintf (of, "%*s}\n", indent, "");
+    case TYPE_POINTER:
+      oprintf (d->of, "%*s%s (%s%s", d->indent, "",
+              wtd->subfield_marker_routine, cast, d->val);
+      if (wtd->param_prefix)
+       {
+         oprintf (d->of, ", %s", d->prev_val[3]);
+         if (d->orig_s)
+           {
+             oprintf (d->of, ", gt_%s_", wtd->param_prefix);
+             output_mangled_typename (d->of, d->orig_s);
+           }
+         else
+           oprintf (d->of, ", gt_%sa_%s", wtd->param_prefix, d->prev_val[0]);
+       }
+      oprintf (d->of, ");\n");
+      if (d->reorder_fn && wtd->reorder_note_routine)
+       oprintf (d->of, "%*s%s (%s%s, %s, %s);\n", d->indent, "",
+                wtd->reorder_note_routine, cast, d->val,
+                d->prev_val[3], d->reorder_fn);
+      break;
+
+    case TYPE_STRING:
+      if (wtd->param_prefix == NULL)
+       break;
+
+    case TYPE_STRUCT:
+    case TYPE_UNION:
+    case TYPE_LANG_STRUCT:
+    case TYPE_PARAM_STRUCT:
+      oprintf (d->of, "%*sgt_%s_", d->indent, "", wtd->prefix);
+      output_mangled_typename (d->of, f);
+      oprintf (d->of, " (%s%s);\n", cast, d->val);
+      if (d->reorder_fn && wtd->reorder_note_routine)
+       oprintf (d->of, "%*s%s (%s%s, %s%s, %s);\n", d->indent, "",
+                wtd->reorder_note_routine, cast, d->val, cast, d->val,
+                d->reorder_fn);
+      break;
+
+    case TYPE_SCALAR:
+      break;
+
+    default:
+      abort ();
     }
 }
 
-/* Write out a marker routine for S.  PARAM is the parameter from an
-   enclosing PARAM_IS option.  */
+/* For S, a structure that's part of ORIG_S, and using parameters
+   PARAM, write out a routine that:
+   - Takes a parameter, a void * but actually of type *S
+   - If SEEN_ROUTINE returns nonzero, calls write_types_process_field on each
+     field of S or its substructures and (in some cases) things
+     that are pointed to by S.
+*/
 
 static void
-write_gc_marker_routine_for_structure (s, param)
-     type_p s;
-     type_p param;
+write_func_for_structure (type_p orig_s, type_p s, type_p *param,
+                         const struct write_types_data *wtd)
 {
-  outf_p f;
-  if (param == NULL)
-    f = get_output_file_with_visibility (s->u.s.line.file);
-  else
-    f = get_output_file_with_visibility (param->u.s.line.file);
-  
-  oprintf (f, "%c", '\n');
-  oprintf (f, "void\n");
+  const char *fn = s->u.s.line.file;
+  int i;
+  const char *chain_next = NULL;
+  const char *chain_prev = NULL;
+  options_p opt;
+  struct walk_type_data d;
+
+  /* This is a hack, and not the good kind either.  */
+  for (i = NUM_PARAM - 1; i >= 0; i--)
+    if (param && param[i] && param[i]->kind == TYPE_POINTER
+       && UNION_OR_STRUCT_P (param[i]->u.p))
+      fn = param[i]->u.p->u.s.line.file;
+
+  memset (&d, 0, sizeof (d));
+  d.of = get_output_file_with_visibility (fn);
+
+  for (opt = s->u.s.opt; opt; opt = opt->next)
+    if (strcmp (opt->name, "chain_next") == 0)
+      chain_next = (const char *) opt->info;
+    else if (strcmp (opt->name, "chain_prev") == 0)
+      chain_prev = (const char *) opt->info;
+
+  if (chain_prev != NULL && chain_next == NULL)
+    error_at_line (&s->u.s.line, "chain_prev without chain_next");
+
+  d.process_field = write_types_process_field;
+  d.cookie = wtd;
+  d.orig_s = orig_s;
+  d.opt = s->u.s.opt;
+  d.line = &s->u.s.line;
+  d.bitmap = s->u.s.bitmap;
+  d.param = param;
+  d.prev_val[0] = "*x";
+  d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
+  d.prev_val[3] = "x";
+  d.val = "(*x)";
+
+  oprintf (d.of, "\n");
+  oprintf (d.of, "void\n");
   if (param == NULL)
-    oprintf (f, "gt_ggc_mx_%s (x_p)\n", s->u.s.tag);
+    oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
   else
-    oprintf (f, "gt_ggc_mm_%d%s_%s (x_p)\n", (int) strlen (param->u.s.tag),
-            param->u.s.tag, s->u.s.tag);
-  oprintf (f, "      void *x_p;\n");
-  oprintf (f, "{\n");
-  oprintf (f, "  %s %s * const x = (%s %s *)x_p;\n",
+    {
+      oprintf (d.of, "gt_%s_", wtd->prefix);
+      output_mangled_typename (d.of, orig_s);
+    }
+  oprintf (d.of, " (void *x_p)\n");
+  oprintf (d.of, "{\n");
+  oprintf (d.of, "  %s %s * %sx = (%s %s *)x_p;\n",
           s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
+          chain_next == NULL ? "const " : "",
           s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
-  oprintf (f, "  if (! ggc_test_and_set_mark (x))\n");
-  oprintf (f, "    return;\n");
-  
-  gc_counter = 0;
-  write_gc_structure_fields (f, s, "(*x)", "not valid postage",
-                            s->u.s.opt, 2, &s->u.s.line, s->u.s.bitmap,
-                            param);
-  
-  oprintf (f, "}\n");
+  if (chain_next != NULL)
+    oprintf (d.of, "  %s %s * xlimit = x;\n",
+            s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
+  if (chain_next == NULL)
+    {
+      oprintf (d.of, "  if (%s (x", wtd->marker_routine);
+      if (wtd->param_prefix)
+       {
+         oprintf (d.of, ", x, gt_%s_", wtd->param_prefix);
+         output_mangled_typename (d.of, orig_s);
+       }
+      oprintf (d.of, "))\n");
+    }
+  else
+    {
+      oprintf (d.of, "  while (%s (xlimit", wtd->marker_routine);
+      if (wtd->param_prefix)
+       {
+         oprintf (d.of, ", xlimit, gt_%s_", wtd->param_prefix);
+         output_mangled_typename (d.of, orig_s);
+       }
+      oprintf (d.of, "))\n");
+      oprintf (d.of, "   xlimit = (");
+      d.prev_val[2] = "*xlimit";
+      output_escaped_param (&d, chain_next, "chain_next");
+      oprintf (d.of, ");\n");
+      if (chain_prev != NULL)
+       {
+         oprintf (d.of, "  if (x != xlimit)\n");
+         oprintf (d.of, "    for (;;)\n");
+         oprintf (d.of, "      {\n");
+         oprintf (d.of, "        %s %s * const xprev = (",
+                  s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
+
+         d.prev_val[2] = "*x";
+         output_escaped_param (&d, chain_prev, "chain_prev");
+         oprintf (d.of, ");\n");
+         oprintf (d.of, "        if (xprev == NULL) break;\n");
+         oprintf (d.of, "        x = xprev;\n");
+         oprintf (d.of, "        (void) %s (xprev",
+                  wtd->marker_routine);
+         if (wtd->param_prefix)
+           {
+             oprintf (d.of, ", xprev, gt_%s_", wtd->param_prefix);
+             output_mangled_typename (d.of, orig_s);
+           }
+         oprintf (d.of, ");\n");
+         oprintf (d.of, "      }\n");
+       }
+      oprintf (d.of, "  while (x != xlimit)\n");
+    }
+  oprintf (d.of, "    {\n");
+
+  d.prev_val[2] = "*x";
+  d.indent = 6;
+  walk_type (s, &d);
+
+  if (chain_next != NULL)
+    {
+      oprintf (d.of, "      x = (");
+      output_escaped_param (&d, chain_next, "chain_next");
+      oprintf (d.of, ");\n");
+    }
+
+  oprintf (d.of, "    }\n");
+  oprintf (d.of, "}\n");
 }
 
 /* Write out marker routines for STRUCTURES and PARAM_STRUCTS.  */
 
 static void
-write_gc_types (structures, param_structs)
-     type_p structures;
-     type_p param_structs;
+write_types (type_p structures, type_p param_structs,
+            const struct write_types_data *wtd)
 {
   type_p s;
-  
-  oprintf (header_file, "\n/* GC marker procedures.  */\n");
+
+  oprintf (header_file, "\n/* %s*/\n", wtd->comment);
   for (s = structures; s; s = s->next)
     if (s->gc_used == GC_POINTED_TO
        || s->gc_used == GC_MAYBE_POINTED_TO)
       {
        options_p opt;
-       
+
        if (s->gc_used == GC_MAYBE_POINTED_TO
            && s->u.s.line.file == NULL)
          continue;
 
+       oprintf (header_file, "#define gt_%s_", wtd->prefix);
+       output_mangled_typename (header_file, s);
+       oprintf (header_file, "(X) do { \\\n");
        oprintf (header_file,
-                "#define gt_ggc_m_%s(X) do { \\\n", s->u.s.tag);
-       oprintf (header_file,
-                "  if (X != NULL) gt_ggc_mx_%s (X);\\\n", s->u.s.tag);
+                "  if (X != NULL) gt_%sx_%s (X);\\\n", wtd->prefix,
+                s->u.s.tag);
        oprintf (header_file,
                 "  } while (0)\n");
-       
+
        for (opt = s->u.s.opt; opt; opt = opt->next)
          if (strcmp (opt->name, "ptr_alias") == 0)
            {
              type_p t = (type_p) opt->info;
-             if (t->kind == TYPE_STRUCT 
+             if (t->kind == TYPE_STRUCT
                  || t->kind == TYPE_UNION
                  || t->kind == TYPE_LANG_STRUCT)
                oprintf (header_file,
-                        "#define gt_ggc_mx_%s gt_ggc_mx_%s\n",
-                        s->u.s.tag, t->u.s.tag);
+                        "#define gt_%sx_%s gt_%sx_%s\n",
+                        wtd->prefix, s->u.s.tag, wtd->prefix, t->u.s.tag);
              else
-               error_at_line (&s->u.s.line, 
+               error_at_line (&s->u.s.line,
                               "structure alias is not a structure");
              break;
            }
@@ -1395,71 +2137,283 @@ write_gc_types (structures, param_structs)
          continue;
 
        /* Declare the marker procedure only once.  */
-       oprintf (header_file, 
-                "extern void gt_ggc_mx_%s PARAMS ((void *));\n",
-                s->u.s.tag);
-  
+       oprintf (header_file,
+                "extern void gt_%sx_%s (void *);\n",
+                wtd->prefix, s->u.s.tag);
+
        if (s->u.s.line.file == NULL)
          {
-           fprintf (stderr, "warning: structure `%s' used but not defined\n", 
+           fprintf (stderr, "warning: structure `%s' used but not defined\n",
                     s->u.s.tag);
            continue;
          }
-  
+
        if (s->kind == TYPE_LANG_STRUCT)
          {
            type_p ss;
            for (ss = s->u.s.lang_struct; ss; ss = ss->next)
-             write_gc_marker_routine_for_structure (ss, NULL);
+             write_func_for_structure (s, ss, NULL, wtd);
          }
        else
-         write_gc_marker_routine_for_structure (s, NULL);
+         write_func_for_structure (s, s, NULL, wtd);
       }
 
   for (s = param_structs; s; s = s->next)
     if (s->gc_used == GC_POINTED_TO)
       {
-       type_p param = s->u.param_struct.param;
+       type_p param = s->u.param_struct.param;
        type_p stru = s->u.param_struct.stru;
 
-       if (param->kind != TYPE_STRUCT && param->kind != TYPE_UNION
-           && param->kind != TYPE_LANG_STRUCT)
+       /* Declare the marker procedure.  */
+       oprintf (header_file, "extern void gt_%s_", wtd->prefix);
+       output_mangled_typename (header_file, s);
+       oprintf (header_file, " (void *);\n");
+
+       if (stru->u.s.line.file == NULL)
          {
-           error_at_line (&s->u.param_struct.line,
-                          "unsupported parameter type");
+           fprintf (stderr, "warning: structure `%s' used but not defined\n",
+                    s->u.s.tag);
            continue;
          }
-       
+
+       if (stru->kind == TYPE_LANG_STRUCT)
+         {
+           type_p ss;
+           for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
+             write_func_for_structure (s, ss, param, wtd);
+         }
+       else
+         write_func_for_structure (s, stru, param, wtd);
+      }
+}
+
+static const struct write_types_data ggc_wtd =
+{
+  "ggc_m", NULL, "ggc_mark", "ggc_test_and_set_mark", NULL,
+  "GC marker procedures.  "
+};
+
+static const struct write_types_data pch_wtd =
+{
+  "pch_n", "pch_p", "gt_pch_note_object", "gt_pch_note_object",
+  "gt_pch_note_reorder",
+  "PCH type-walking procedures.  "
+};
+
+/* Write out the local pointer-walking routines.  */
+
+/* process_field routine for local pointer-walking.  */
+
+static void
+write_types_local_process_field (type_p f, const struct walk_type_data *d)
+{
+  switch (f->kind)
+    {
+    case TYPE_POINTER:
+    case TYPE_STRUCT:
+    case TYPE_UNION:
+    case TYPE_LANG_STRUCT:
+    case TYPE_PARAM_STRUCT:
+    case TYPE_STRING:
+      oprintf (d->of, "%*sif ((void *)(%s) == this_obj)\n", d->indent, "",
+              d->prev_val[3]);
+      oprintf (d->of, "%*s  op (&(%s), cookie);\n", d->indent, "", d->val);
+      break;
+
+    case TYPE_SCALAR:
+      break;
+
+    default:
+      abort ();
+    }
+}
+
+/* For S, a structure that's part of ORIG_S, and using parameters
+   PARAM, write out a routine that:
+   - Is of type gt_note_pointers
+   - If calls PROCESS_FIELD on each field of S or its substructures.
+*/
+
+static void
+write_local_func_for_structure (type_p orig_s, type_p s, type_p *param)
+{
+  const char *fn = s->u.s.line.file;
+  int i;
+  struct walk_type_data d;
+
+  /* This is a hack, and not the good kind either.  */
+  for (i = NUM_PARAM - 1; i >= 0; i--)
+    if (param && param[i] && param[i]->kind == TYPE_POINTER
+       && UNION_OR_STRUCT_P (param[i]->u.p))
+      fn = param[i]->u.p->u.s.line.file;
+
+  memset (&d, 0, sizeof (d));
+  d.of = get_output_file_with_visibility (fn);
+
+  d.process_field = write_types_local_process_field;
+  d.opt = s->u.s.opt;
+  d.line = &s->u.s.line;
+  d.bitmap = s->u.s.bitmap;
+  d.param = param;
+  d.prev_val[0] = d.prev_val[2] = "*x";
+  d.prev_val[1] = "not valid postage";  /* Guarantee an error.  */
+  d.prev_val[3] = "x";
+  d.val = "(*x)";
+
+  oprintf (d.of, "\n");
+  oprintf (d.of, "void\n");
+  oprintf (d.of, "gt_pch_p_");
+  output_mangled_typename (d.of, orig_s);
+  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");
+  oprintf (d.of, "{\n");
+  oprintf (d.of, "  %s %s * const x ATTRIBUTE_UNUSED = (%s %s *)x_p;\n",
+          s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
+          s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
+  d.indent = 2;
+  walk_type (s, &d);
+  oprintf (d.of, "}\n");
+}
+
+/* Write out local marker routines for STRUCTURES and PARAM_STRUCTS.  */
+
+static void
+write_local (type_p structures, type_p param_structs)
+{
+  type_p s;
+
+  oprintf (header_file, "\n/* Local pointer-walking routines.  */\n");
+  for (s = structures; s; s = s->next)
+    if (s->gc_used == GC_POINTED_TO
+       || s->gc_used == GC_MAYBE_POINTED_TO)
+      {
+       options_p opt;
+
+       if (s->u.s.line.file == NULL)
+         continue;
+
+       for (opt = s->u.s.opt; opt; opt = opt->next)
+         if (strcmp (opt->name, "ptr_alias") == 0)
+           {
+             type_p t = (type_p) opt->info;
+             if (t->kind == TYPE_STRUCT
+                 || t->kind == TYPE_UNION
+                 || t->kind == TYPE_LANG_STRUCT)
+               {
+                 oprintf (header_file, "#define gt_pch_p_");
+                 output_mangled_typename (header_file, s);
+                 oprintf (header_file, " gt_pch_p_");
+                 output_mangled_typename (header_file, t);
+                 oprintf (header_file, "\n");
+               }
+             else
+               error_at_line (&s->u.s.line,
+                              "structure alias is not a structure");
+             break;
+           }
+       if (opt)
+         continue;
+
+       /* Declare the marker procedure only once.  */
+       oprintf (header_file, "extern void gt_pch_p_");
+       output_mangled_typename (header_file, s);
+       oprintf (header_file,
+        "\n    (void *, void *, gt_pointer_operator, void *);\n");
+
+       if (s->kind == TYPE_LANG_STRUCT)
+         {
+           type_p ss;
+           for (ss = s->u.s.lang_struct; ss; ss = ss->next)
+             write_local_func_for_structure (s, ss, NULL);
+         }
+       else
+         write_local_func_for_structure (s, s, NULL);
+      }
+
+  for (s = param_structs; s; s = s->next)
+    if (s->gc_used == GC_POINTED_TO)
+      {
+       type_p * param = s->u.param_struct.param;
+       type_p stru = s->u.param_struct.stru;
+
        /* Declare the marker procedure.  */
-       oprintf (header_file, 
-                "extern void gt_ggc_mm_%d%s_%s PARAMS ((void *));\n",
-                (int) strlen (param->u.s.tag), param->u.s.tag,
-                stru->u.s.tag);
-  
+       oprintf (header_file, "extern void gt_pch_p_");
+       output_mangled_typename (header_file, s);
+       oprintf (header_file,
+        "\n    (void *, void *, gt_pointer_operator, void *);\n");
+
        if (stru->u.s.line.file == NULL)
          {
-           fprintf (stderr, "warning: structure `%s' used but not defined\n", 
+           fprintf (stderr, "warning: structure `%s' used but not defined\n",
                     s->u.s.tag);
            continue;
          }
-  
+
        if (stru->kind == TYPE_LANG_STRUCT)
          {
            type_p ss;
            for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
-             write_gc_marker_routine_for_structure (ss, param);
+             write_local_func_for_structure (s, ss, param);
          }
        else
-         write_gc_marker_routine_for_structure (stru, param);
+         write_local_func_for_structure (s, stru, param);
+      }
+}
+
+/* Write out the 'enum' definition for gt_types_enum.  */
+
+static void
+write_enum_defn (type_p structures, type_p param_structs)
+{
+  type_p s;
+
+  oprintf (header_file, "\n/* Enumeration of types known.  */\n");
+  oprintf (header_file, "enum gt_types_enum {\n");
+  for (s = structures; s; s = s->next)
+    if (s->gc_used == GC_POINTED_TO
+       || s->gc_used == GC_MAYBE_POINTED_TO)
+      {
+       if (s->gc_used == GC_MAYBE_POINTED_TO
+           && s->u.s.line.file == NULL)
+         continue;
+
+       oprintf (header_file, " gt_ggc_e_");
+       output_mangled_typename (header_file, s);
+       oprintf (header_file, ", \n");
+      }
+  for (s = param_structs; s; s = s->next)
+    if (s->gc_used == GC_POINTED_TO)
+      {
+       oprintf (header_file, " gt_e_");
+       output_mangled_typename (header_file, s);
+       oprintf (header_file, ", \n");
       }
+  oprintf (header_file, " gt_types_enum_last\n");
+  oprintf (header_file, "};\n");
+}
+
+/* Might T contain any non-pointer elements?  */
+
+static int
+contains_scalar_p (type_p t)
+{
+  switch (t->kind)
+    {
+    case TYPE_STRING:
+    case TYPE_POINTER:
+      return 0;
+    case TYPE_ARRAY:
+      return contains_scalar_p (t->u.a.p);
+    default:
+      /* Could also check for structures that have no non-pointer
+        fields, but there aren't enough of those to worry about.  */
+      return 1;
+    }
 }
 
 /* Mangle FN and print it to F.  */
 
 static void
-put_mangled_filename (f, fn)
-     outf_p f;
-     const char *fn;
+put_mangled_filename (outf_p f, const char *fn)
 {
   const char *name = get_output_file_name (fn);
   for (; *name != 0; name++)
@@ -1474,16 +2428,11 @@ put_mangled_filename (f, fn)
    the resulting code.  */
 
 static void
-finish_root_table (flp, pfx, lastname, tname, name)
-     struct flist *flp;
-     const char *pfx;
-     const char *tname;
-     const char *lastname;
-     const char *name;
+finish_root_table (struct flist *flp, const char *pfx, const char *lastname,
+                  const char *tname, const char *name)
 {
   struct flist *fli2;
-  unsigned started_bitmap = 0;
-  
+
   for (fli2 = flp; fli2; fli2 = fli2->next)
     if (fli2->started_p)
       {
@@ -1501,13 +2450,22 @@ finish_root_table (flp, pfx, lastname, tname, name)
          if (bitmap & 1)
            {
              oprintf (base_files[fnum],
-                      "extern const struct %s gt_ggc_%s_",
+                      "extern const struct %s gt_%s_",
                       tname, pfx);
              put_mangled_filename (base_files[fnum], fli2->name);
              oprintf (base_files[fnum], "[];\n");
            }
       }
 
+  {
+    size_t fnum;
+    for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
+      oprintf (base_files [fnum],
+              "const struct %s * const %s[] = {\n",
+              tname, name);
+  }
+
+
   for (fli2 = flp; fli2; fli2 = fli2->next)
     if (fli2->started_p)
       {
@@ -1519,29 +2477,19 @@ finish_root_table (flp, pfx, lastname, tname, name)
        for (fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
          if (bitmap & 1)
            {
-             if (! (started_bitmap & (1 << fnum)))
-               {
-                 oprintf (base_files [fnum],
-                          "const struct %s * const %s[] = {\n",
-                          tname, name);
-                 started_bitmap |= 1 << fnum;
-               }
-             oprintf (base_files[fnum], "  gt_ggc_%s_", pfx);
+             oprintf (base_files[fnum], "  gt_%s_", pfx);
              put_mangled_filename (base_files[fnum], fli2->name);
              oprintf (base_files[fnum], ",\n");
            }
       }
 
   {
-    unsigned bitmap;
-    int fnum;
-    
-    for (bitmap = started_bitmap, fnum = 0; bitmap != 0; fnum++, bitmap >>= 1)
-      if (bitmap & 1)
-       {
-         oprintf (base_files[fnum], "  NULL\n");
-         oprintf (base_files[fnum], "};\n\n");
-       }
+    size_t fnum;
+    for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
+      {
+       oprintf (base_files[fnum], "  NULL\n");
+       oprintf (base_files[fnum], "};\n");
+      }
   }
 }
 
@@ -1551,14 +2499,8 @@ finish_root_table (flp, pfx, lastname, tname, name)
    is nonzero iff we are building the root table for hash table caches.  */
 
 static void
-write_gc_root (f, v, type, name, has_length, line, if_marked)
-     outf_p f;
-     pair_p v;
-     type_p type;
-     const char *name;
-     int has_length;
-     struct fileloc *line;
-     const char *if_marked;
+write_root (outf_p f, pair_p v, type_p type, const char *name, int has_length,
+           struct fileloc *line, const char *if_marked)
 {
   switch (type->kind)
     {
@@ -1570,7 +2512,7 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
            int skip_p = 0;
            const char *desc = NULL;
            options_p o;
-           
+
            for (o = fld->opt; o; o = o->next)
              if (strcmp (o->name, "skip") == 0)
                skip_p = 1;
@@ -1580,26 +2522,26 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
                error_at_line (line,
                       "field `%s' of global `%s' has unknown option `%s'",
                               fld->name, name, o->name);
-           
+
            if (skip_p)
              continue;
            else if (desc && fld->type->kind == TYPE_UNION)
              {
                pair_p validf = NULL;
                pair_p ufld;
-               
+
                for (ufld = fld->type->u.s.fields; ufld; ufld = ufld->next)
                  {
                    const char *tag = NULL;
                    options_p oo;
-                   
+
                    for (oo = ufld->opt; oo; oo = oo->next)
                      if (strcmp (oo->name, "tag") == 0)
                        tag = (const char *)oo->info;
                    if (tag == NULL || strcmp (tag, desc) != 0)
                      continue;
                    if (validf != NULL)
-                     error_at_line (line, 
+                     error_at_line (line,
                           "both `%s.%s.%s' and `%s.%s.%s' have tag `%s'",
                                     name, fld->name, validf->name,
                                     name, fld->name, ufld->name,
@@ -1609,22 +2551,22 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
                if (validf != NULL)
                  {
                    char *newname;
-                   newname = xasprintf ("%s.%s.%s", 
+                   newname = xasprintf ("%s.%s.%s",
                                         name, fld->name, validf->name);
-                   write_gc_root (f, v, validf->type, newname, 0, line,
-                                  if_marked);
+                   write_root (f, v, validf->type, newname, 0, line,
+                               if_marked);
                    free (newname);
                  }
              }
            else if (desc)
-             error_at_line (line, 
+             error_at_line (line,
                     "global `%s.%s' has `desc' option but is not union",
                             name, fld->name);
            else
              {
                char *newname;
                newname = xasprintf ("%s.%s", name, fld->name);
-               write_gc_root (f, v, fld->type, newname, 0, line, if_marked);
+               write_root (f, v, fld->type, newname, 0, line, if_marked);
                free (newname);
              }
          }
@@ -1635,19 +2577,19 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
       {
        char *newname;
        newname = xasprintf ("%s[0]", name);
-       write_gc_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
+       write_root (f, v, type->u.a.p, newname, has_length, line, if_marked);
        free (newname);
       }
       break;
-      
+
     case TYPE_POINTER:
       {
        type_p ap, tp;
-       
+
        oprintf (f, "  {\n");
        oprintf (f, "    &%s,\n", name);
        oprintf (f, "    1");
-       
+
        for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
          if (ap->u.a.len[0])
            oprintf (f, " * (%s)", ap->u.a.len);
@@ -1658,28 +2600,30 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
        for (ap = v->type; ap->kind == TYPE_ARRAY; ap = ap->u.a.p)
          oprintf (f, "[0]");
        oprintf (f, "),\n");
-       
+
        tp = type->u.p;
-       
+
        if (! has_length && UNION_OR_STRUCT_P (tp))
          {
-           oprintf (f, "    &gt_ggc_mx_%s\n", tp->u.s.tag);
+           oprintf (f, "    &gt_ggc_mx_%s,\n", tp->u.s.tag);
+           oprintf (f, "    &gt_pch_nx_%s", tp->u.s.tag);
          }
        else if (! has_length && tp->kind == TYPE_PARAM_STRUCT)
          {
-           oprintf (f, "    &gt_ggc_mm_%d%s_%s",
-                    (int) strlen (tp->u.param_struct.param->u.s.tag),
-                    tp->u.param_struct.param->u.s.tag,
-                    tp->u.param_struct.stru->u.s.tag);
+           oprintf (f, "    &gt_ggc_m_");
+           output_mangled_typename (f, tp);
+           oprintf (f, ",\n    &gt_pch_n_");
+           output_mangled_typename (f, tp);
          }
        else if (has_length
                 && (tp->kind == TYPE_POINTER || UNION_OR_STRUCT_P (tp)))
          {
-           oprintf (f, "    &gt_ggc_ma_%s", name);
+           oprintf (f, "    &gt_ggc_ma_%s,\n", name);
+           oprintf (f, "    &gt_pch_na_%s", name);
          }
        else
          {
-           error_at_line (line, 
+           error_at_line (line,
                           "global `%s' is pointer to unimplemented type",
                           name);
          }
@@ -1689,22 +2633,81 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
       }
       break;
 
-    case TYPE_SCALAR:
     case TYPE_STRING:
+      {
+       oprintf (f, "  {\n");
+       oprintf (f, "    &%s,\n", name);
+       oprintf (f, "    1, \n");
+       oprintf (f, "    sizeof (%s),\n", v->name);
+       oprintf (f, "    &gt_ggc_m_S,\n");
+       oprintf (f, "    (gt_pointer_walker) &gt_pch_n_S\n");
+       oprintf (f, "  },\n");
+      }
+      break;
+
+    case TYPE_SCALAR:
       break;
-      
+
     default:
-      error_at_line (line, 
+      error_at_line (line,
                     "global `%s' is unimplemented type",
                     name);
     }
 }
 
+/* This generates a routine to walk an array.  */
+
+static void
+write_array (outf_p f, pair_p v, const struct write_types_data *wtd)
+{
+  struct walk_type_data d;
+  char *prevval3;
+
+  memset (&d, 0, sizeof (d));
+  d.of = f;
+  d.cookie = wtd;
+  d.indent = 2;
+  d.line = &v->line;
+  d.opt = v->opt;
+  d.bitmap = get_base_file_bitmap (v->line.file);
+  d.param = NULL;
+
+  d.prev_val[3] = prevval3 = xasprintf ("&%s", v->name);
+
+  if (wtd->param_prefix)
+    {
+      oprintf (f, "static void gt_%sa_%s\n", wtd->param_prefix, v->name);
+      oprintf (f,
+       "    (void *, void *, gt_pointer_operator, void *);\n");
+      oprintf (f, "static void gt_%sa_%s (void *this_obj ATTRIBUTE_UNUSED,\n",
+              wtd->param_prefix, v->name);
+      oprintf (d.of, "      void *x_p ATTRIBUTE_UNUSED,\n");
+      oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED,\n");
+      oprintf (d.of, "      void *cookie ATTRIBUTE_UNUSED)\n");
+      oprintf (d.of, "{\n");
+      d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
+      d.process_field = write_types_local_process_field;
+      walk_type (v->type, &d);
+      oprintf (f, "}\n\n");
+    }
+
+  d.opt = v->opt;
+  oprintf (f, "static void gt_%sa_%s (void *);\n",
+          wtd->prefix, v->name);
+  oprintf (f, "static void\ngt_%sa_%s (void *x_p ATTRIBUTE_UNUSED)\n",
+          wtd->prefix, v->name);
+  oprintf (f, "{\n");
+  d.prev_val[0] = d.prev_val[1] = d.prev_val[2] = d.val = v->name;
+  d.process_field = write_types_process_field;
+  walk_type (v->type, &d);
+  free (prevval3);
+  oprintf (f, "}\n\n");
+}
+
 /* Output a table describing the locations and types of VARIABLES.  */
 
 static void
-write_gc_roots (variables)
-     pair_p variables;
+write_roots (pair_p variables)
 {
   pair_p v;
   struct flist *flp = NULL;
@@ -1724,10 +2727,14 @@ write_gc_roots (variables)
          deletable_p = 1;
        else if (strcmp (o->name, "param_is") == 0)
          ;
+       else if (strncmp (o->name, "param", 5) == 0
+                && ISDIGIT (o->name[5])
+                && strcmp (o->name + 6, "_is") == 0)
+         ;
        else if (strcmp (o->name, "if_marked") == 0)
          ;
        else
-         error_at_line (&v->line, 
+         error_at_line (&v->line,
                         "global `%s' has unknown option `%s'",
                         v->name, o->name);
 
@@ -1752,49 +2759,8 @@ write_gc_roots (variables)
          && (v->type->u.p->kind == TYPE_POINTER
              || v->type->u.p->kind == TYPE_STRUCT))
        {
-         oprintf (f, "static void gt_ggc_ma_%s PARAMS ((void *));\n",
-                  v->name);
-         oprintf (f, "static void\ngt_ggc_ma_%s (x_p)\n      void *x_p;\n",
-                  v->name);
-         oprintf (f, "{\n");
-         oprintf (f, "  size_t i;\n");
-
-         if (v->type->u.p->kind == TYPE_POINTER)
-           {
-             type_p s = v->type->u.p->u.p;
-
-             oprintf (f, "  %s %s ** const x = (%s %s **)x_p;\n",
-                      s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
-                      s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
-             oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
-             oprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
-             if (s->kind != TYPE_STRUCT && s->kind != TYPE_UNION)
-               {
-                 error_at_line (&v->line, 
-                                "global `%s' has unsupported ** type",
-                                v->name);
-                 continue;
-               }
-
-             oprintf (f, "      gt_ggc_m_%s (x[i]);\n", s->u.s.tag);
-           }
-         else
-           {
-             type_p s = v->type->u.p;
-
-             oprintf (f, "  %s %s * const x = (%s %s *)x_p;\n",
-                      s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag,
-                      s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
-             oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
-             oprintf (f, "    for (i = 0; i < (%s); i++)\n", length);
-             oprintf (f, "      {\n");
-             write_gc_structure_fields (f, s, "x[i]", "x[i]",
-                                        v->opt, 8, &v->line, s->u.s.bitmap,
-                                        NULL);
-             oprintf (f, "      }\n");
-           }
-
-         oprintf (f, "}\n\n");
+         write_array (f, v, &ggc_wtd);
+         write_array (f, v, &pch_wtd);
        }
     }
 
@@ -1805,7 +2771,7 @@ write_gc_roots (variables)
       int skip_p = 0;
       int length_p = 0;
       options_p o;
-      
+
       for (o = v->opt; o; o = o->next)
        if (strcmp (o->name, "length") == 0)
          length_p = 1;
@@ -1828,10 +2794,10 @@ write_gc_roots (variables)
          oprintf (f, "[] = {\n");
        }
 
-      write_gc_root (f, v, v->type, v->name, length_p, &v->line, NULL);
+      write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
     }
 
-  finish_root_table (flp, "r", "LAST_GGC_ROOT_TAB", "ggc_root_tab", 
+  finish_root_table (flp, "ggc_r", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
                     "gt_ggc_rtab");
 
   for (v = variables; v; v = v->next)
@@ -1861,12 +2827,12 @@ write_gc_roots (variables)
          put_mangled_filename (f, v->line.file);
          oprintf (f, "[] = {\n");
        }
-      
-      oprintf (f, "  { &%s, 1, sizeof (%s), NULL },\n",
+
+      oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
               v->name, v->name);
     }
-  
-  finish_root_table (flp, "rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
+
+  finish_root_table (flp, "ggc_rd", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
                     "gt_ggc_deletable_rtab");
 
   for (v = variables; v; v = v->next)
@@ -1876,7 +2842,7 @@ write_gc_roots (variables)
       const char *if_marked = NULL;
       int length_p = 0;
       options_p o;
-      
+
       for (o = v->opt; o; o = o->next)
        if (strcmp (o->name, "length") == 0)
          length_p = 1;
@@ -1905,39 +2871,112 @@ write_gc_roots (variables)
          put_mangled_filename (f, v->line.file);
          oprintf (f, "[] = {\n");
        }
-      
-      write_gc_root (f, v, create_pointer (v->type->u.p->u.param_struct.param),
+
+      write_root (f, v, v->type->u.p->u.param_struct.param[0],
                     v->name, length_p, &v->line, if_marked);
     }
-  
-  finish_root_table (flp, "rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
+
+  finish_root_table (flp, "ggc_rc", "LAST_GGC_CACHE_TAB", "ggc_cache_tab",
                     "gt_ggc_cache_rtab");
+
+  for (v = variables; v; v = v->next)
+    {
+      outf_p f = get_output_file_with_visibility (v->line.file);
+      struct flist *fli;
+      int length_p = 0;
+      int if_marked_p = 0;
+      options_p o;
+
+      for (o = v->opt; o; o = o->next)
+       if (strcmp (o->name, "length") == 0)
+         length_p = 1;
+       else if (strcmp (o->name, "if_marked") == 0)
+         if_marked_p = 1;
+
+      if (! if_marked_p)
+       continue;
+
+      for (fli = flp; fli; fli = fli->next)
+       if (fli->f == f)
+         break;
+      if (! fli->started_p)
+       {
+         fli->started_p = 1;
+
+         oprintf (f, "const struct ggc_root_tab gt_pch_rc_");
+         put_mangled_filename (f, v->line.file);
+         oprintf (f, "[] = {\n");
+       }
+
+      write_root (f, v, v->type, v->name, length_p, &v->line, NULL);
+    }
+
+  finish_root_table (flp, "pch_rc", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
+                    "gt_pch_cache_rtab");
+
+  for (v = variables; v; v = v->next)
+    {
+      outf_p f = get_output_file_with_visibility (v->line.file);
+      struct flist *fli;
+      int skip_p = 0;
+      options_p o;
+
+      for (o = v->opt; o; o = o->next)
+       if (strcmp (o->name, "deletable") == 0
+           || strcmp (o->name, "if_marked") == 0)
+         skip_p = 1;
+
+      if (skip_p)
+       continue;
+
+      if (! contains_scalar_p (v->type))
+       continue;
+
+      for (fli = flp; fli; fli = fli->next)
+       if (fli->f == f)
+         break;
+      if (! fli->started_p)
+       {
+         fli->started_p = 1;
+
+         oprintf (f, "const struct ggc_root_tab gt_pch_rs_");
+         put_mangled_filename (f, v->line.file);
+         oprintf (f, "[] = {\n");
+       }
+
+      oprintf (f, "  { &%s, 1, sizeof (%s), NULL, NULL },\n",
+              v->name, v->name);
+    }
+
+  finish_root_table (flp, "pch_rs", "LAST_GGC_ROOT_TAB", "ggc_root_tab",
+                    "gt_pch_scalar_rtab");
 }
 
 \f
-extern int main PARAMS ((int argc, char **argv));
-int 
-main(argc, argv)
-     int argc ATTRIBUTE_UNUSED;
-     char **argv ATTRIBUTE_UNUSED;
+extern int main (int argc, char **argv);
+int
+main(int argc ATTRIBUTE_UNUSED, char **argv ATTRIBUTE_UNUSED)
 {
   unsigned i;
   static struct fileloc pos = { __FILE__, __LINE__ };
   unsigned j;
-  
+
+  gen_rtx_next ();
+
   srcdir_len = strlen (srcdir);
 
-  do_typedef ("CUMULATIVE_ARGS",
-             create_scalar_type ("CUMULATIVE_ARGS", 
-                                 strlen ("CUMULATIVE_ARGS")),
-             &pos);
-  do_typedef ("REAL_VALUE_TYPE",
-             create_scalar_type ("REAL_VALUE_TYPE", 
-                                 strlen ("REAL_VALUE_TYPE")),
-             &pos);
-  do_typedef ("PTR", create_pointer (create_scalar_type ("void",
-                                                        strlen ("void"))),
-             &pos);
+  do_scalar_typedef ("CUMULATIVE_ARGS", &pos);
+  do_scalar_typedef ("REAL_VALUE_TYPE", &pos);
+  do_scalar_typedef ("uint8", &pos);
+  do_scalar_typedef ("jword", &pos);
+  do_scalar_typedef ("JCF_u2", &pos);
+  do_scalar_typedef ("void", &pos);
+
+  do_typedef ("PTR", create_pointer (resolve_typedef ("void", &pos)), &pos);
+
+  do_typedef ("HARD_REG_SET", create_array (
+             create_scalar_type ("unsigned long", strlen ("unsigned long")),
+             "2"), &pos);
 
   for (i = 0; i < NUM_GT_FILES; i++)
     {
@@ -1961,8 +3000,12 @@ main(argc, argv)
   set_gc_used (variables);
 
   open_base_files ();
-  write_gc_types (structures, param_structs);
-  write_gc_roots (variables);
+  write_enum_defn (structures, param_structs);
+  write_types (structures, param_structs, &ggc_wtd);
+  write_types (structures, param_structs, &pch_wtd);
+  write_local (structures, param_structs);
+  write_roots (variables);
+  write_rtx_next ();
   close_output_files ();
 
   return (hit_error != 0);