OSDN Git Service

Merge from pch-branch.
[pf3gnuchains/gcc-fork.git] / gcc / gengtype.c
index 855e5ed..b279263 100644 (file)
@@ -603,14 +603,6 @@ adjust_field_rtx_def (t, opt)
              subfields->opt->name = "skip";
              subfields->opt->info = NULL;
            }
-         else if ((size_t) rtx_next[i] == aindex)
-           {
-             /* The 'next' field will be marked by the chain_next option.  */
-             subfields->opt = xmalloc (sizeof (*subfields->opt));
-             subfields->opt->next = nodot;
-             subfields->opt->name = "skip";
-             subfields->opt->info = NULL;
-           }
          else
            subfields->opt = nodot;
        }
@@ -1364,70 +1356,78 @@ struct flist {
   outf_p f;
 };
 
-static void output_escaped_param PARAMS ((outf_p , const char *, const char *,
-                                         const char *, const char *,
-                                         struct fileloc *));
+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) 
+     PARAMS ((type_p f, const struct walk_type_data *p));
+typedef void (*func_name_fn)
+     PARAMS ((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 PARAMS ((struct walk_type_data *d, 
+                                         const char *, const char *));
 static void output_mangled_typename PARAMS ((outf_p, type_p));
-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, 
-                                                          type_p *));
-static void write_gc_types PARAMS ((type_p structures, type_p param_structs));
+static void walk_type PARAMS ((type_p t, struct walk_type_data *d));
+static void write_func_for_structure
+     PARAMS ((type_p orig_s, type_p s, type_p * param,
+             const struct write_types_data *wtd));
+static void write_types_process_field 
+     PARAMS ((type_p f, const struct walk_type_data *d));
+static void write_types PARAMS ((type_p structures, 
+                                type_p param_structs,
+                                const struct write_types_data *wtd));
+static void write_types_local_process_field
+     PARAMS ((type_p f, const struct walk_type_data *d));
+static void write_local_func_for_structure
+     PARAMS ((type_p orig_s, type_p s, type_p * param));
+static void write_local PARAMS ((type_p structures, 
+                                type_p param_structs));
 static void write_enum_defn PARAMS ((type_p structures, type_p param_structs));
+static int contains_scalar_p PARAMS ((type_p t));
 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,
+static void write_root PARAMS ((outf_p , pair_p, type_p, const char *, int,
                                   struct fileloc *, const char *));
-static void write_gc_roots PARAMS ((pair_p));
+static void write_array PARAMS ((outf_p f, pair_p v,
+                                const struct write_types_data *wtd));
+static void write_roots PARAMS ((pair_p));
 
-static int gc_counter;
+/* Parameters for walk_type.  */
 
-/* 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.  */
-
-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;
+struct walk_type_data
 {
-  const char *p;
-  
-  for (p = param; *p; p++)
-    if (*p != '%')
-      oprintf (of, "%c", *p);
-    else switch (*++p)
-      {
-      case 'h':
-       oprintf (of, "(%s)", val);
-       break;
-      case '0':
-       oprintf (of, "(*x)");
-       break;
-      case '1':
-       oprintf (of, "(%s)", prev_val);
-       break;
-      case 'a':
-       {
-         const char *pp = val + strlen (val);
-         while (pp[-1] == ']')
-           while (*pp != '[')
-             pp--;
-         oprintf (of, "%s", pp);
-       }
-       break;
-      default:
-       error_at_line (line, "`%s' option contains bad escape %c%c",
-                      oname, '%', *p);
-      }
-}
+  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;
+};
 
 /* Print a mangled name representing T to OF.  */
 
@@ -1469,423 +1469,491 @@ output_mangled_typename (of, t)
     }
 }
 
-/* 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).  */
+/* 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
-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;
+output_escaped_param (d, param, oname)
+     struct walk_type_data *d;
+     const char *param;
+     const char *oname;
 {
-  pair_p f;
-  int seen_default = 0;
-
-  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)
-    {
-      error_at_line (line, "structure defined for mismatching languages");
-      error_at_line (&s->u.s.line, "one structure defined here");
-    }
+  const char *p;
   
-  if (s->kind == TYPE_UNION)
-    {
-      const char *tagexpr = NULL;
-      options_p oo;
-      
-      for (oo = opts; oo; oo = oo->next)
-       if (strcmp (oo->name, "desc") == 0)
-         tagexpr = (const char *)oo->info;
-      if (tagexpr == NULL)
+  for (p = param; *p; p++)
+    if (*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':
        {
-         tagexpr = "1";
-         error_at_line (line, "missing `desc' option");
+         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);
+      }
+}
 
-      oprintf (of, "%*sswitch (", indent, "");
-      output_escaped_param (of, tagexpr, val, prev_val, "desc", line);
-      oprintf (of, ")\n");
-      indent += 2;
-      oprintf (of, "%*s{\n", indent, "");
-    }
-  
-  for (f = s->u.s.fields; f; f = f->next)
-    {
-      const char *tagid = NULL;
-      const char *length = NULL;
-      int skip_p = 0;
-      int default_p = 0;
-      int maybe_undef_p = 0;
-      int use_param_num = -1;
-      int use_params_p = 0;
-      int needs_cast_p = 0;
-      options_p oo;
-      type_p t = f->type;
-      const char *dot = ".";
-      
-      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)
-         ;
-       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, "desc") == 0)
-         ;
-       else if (strcmp (oo->name, "descbits") == 0)
-         ;
-       else if (strcmp (oo->name, "param_is") == 0)
-         ;
-       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, "dot") == 0)
-         dot = (const char *)oo->info;
-       else
-         error_at_line (&f->line, "unknown field option `%s'\n", oo->name);
+/* 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.  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).  */
 
-      if (skip_p)
-       continue;
+static void
+walk_type (t, d)
+     type_p t;
+     struct walk_type_data *d;
+{
+  const char *length = NULL;
+  const char *desc = NULL;
+  int maybe_undef_p = 0;
+  int use_param_num = -1;
+  int use_params_p = 0;
+  int needs_cast_p = 0;
+  options_p oo;
+  
+  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, "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 (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 (use_params_p)
-       {
-         int pointer_p = t->kind == TYPE_POINTER;
+  if (d->used_length)
+    length = NULL;
 
-         if (pointer_p)
-           t = t->u.p;
-         t = find_param_structure (t, param);
-         if (pointer_p)
-           t = create_pointer (t);
-       }
+  if (use_params_p)
+    {
+      int pointer_p = t->kind == TYPE_POINTER;
       
-      if (use_param_num != -1)
-       {
-         if (param != NULL && param[use_param_num] != NULL)
-           {
-             type_p nt = 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);
-             needs_cast_p = (t->kind != TYPE_POINTER
-                             && nt->kind == TYPE_POINTER);
-             t = nt;
-           }
-         else if (s->kind != TYPE_UNION)
-           error_at_line (&f->line, "no parameter defined");
-       }
-
-      if (t->kind == TYPE_SCALAR
-         || (t->kind == TYPE_ARRAY 
-             && t->u.a.p->kind == TYPE_SCALAR))
-       continue;
+      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);
+    }
       
-      seen_default |= default_p;
-
-      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)
+  if (use_param_num != -1)
+    {
+      if (d->param != NULL && d->param[use_param_num] != NULL)
        {
-         if (tagid)
-           {
-             oprintf (of, "%*scase %s:\n", indent, "", tagid);
-
-           }
-         else if (default_p)
-           {
-             oprintf (of, "%*sdefault:\n", indent, "");
-           }
-         else
-           {
-             error_at_line (&f->line, "field `%s' has no tag", f->name);
-             continue;
-           }
-         indent += 2;
+         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);
+         needs_cast_p = (t->kind != TYPE_POINTER
+                         && nt->kind == TYPE_POINTER);
+         t = nt;
        }
+      else
+       error_at_line (d->line, "no parameter defined for `%s'",
+                      d->val);
+    }
+  
+  if (maybe_undef_p 
+      && (t->kind != TYPE_POINTER || ! UNION_OR_STRUCT_P (t->u.p)))
+    {
+      error_at_line (d->line, 
+                    "field `%s' has invalid option `maybe_undef_p'\n",
+                    d->val);
+      return;
+    }
+  
+  switch (t->kind)
+    {
+    case TYPE_SCALAR:
+    case TYPE_STRING:
+      d->process_field (t, d);
+      break;
       
-      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;
              }
+           
+           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%s", val, dot, 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);
+           d->process_field(t, d);
+           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->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%s) abort();\n", indent, "",
-                        val, dot, f->name);
-             else if (UNION_OR_STRUCT_P (t->u.p)
-                      || t->u.p->kind == TYPE_PARAM_STRUCT)
-               {
-                 oprintf (of, "%*sgt_ggc_m_", indent, "");
-                 output_mangled_typename (of, t->u.p);
-                 oprintf (of, " (");
-                 if (needs_cast_p)
-                   oprintf (of, "(%s %s *)", 
-                            UNION_P (t->u.p) ? "union" : "struct",
-                            t->u.p->u.s.tag);
-                 oprintf (of, "%s%s%s);\n", val, dot, 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%s);\n", indent, "", 
-                    val, dot, f->name);
-         else
-           {
-             int loopcounter = ++gc_counter;
-             
-             oprintf (of, "%*sif (%s%s%s != NULL) {\n", indent, "",
-                      val, dot, f->name);
-             indent += 2;
-             oprintf (of, "%*ssize_t i%d;\n", indent, "", loopcounter);
-             oprintf (of, "%*sggc_set_mark (%s%s%s);\n", indent, "", 
-                      val, dot, f->name);
-             oprintf (of, "%*sfor (i%d = 0; i%d < (size_t)(", 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%s[i%d]", val, dot, 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)
-                     || t->u.p->u.p->kind == TYPE_PARAM_STRUCT)
-                   {
-                     oprintf (of, "%*sgt_ggc_m_", indent, "");
-                     output_mangled_typename (of, t->u.p->u.p);
-                     oprintf (of, " (%s%s%s[i%d]);\n", val, dot, 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 optimise by not generating
+          any code.  */
+       if (t->u.a.p->kind == TYPE_SCALAR)
          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;
+      
+    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 (! t->u.s.line.file)
+         error_at_line (d->line, "incomplete structure `%s'", t->u.s.tag);
 
-       case TYPE_ARRAY:
+       if ((d->bitmap & t->u.s.bitmap) != d->bitmap)
          {
-           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;
+           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");
+         }
 
-           oprintf (of, "%*s{\n", indent, "");
-           indent += 2;
+       /* 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;
 
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
+       d->prev_val[2] = oldval;
+       d->prev_val[1] = oldprevval2;
+       if (union_p)
+         {
+           if (desc == NULL)
              {
-               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");
+               error_at_line (d->line, "missing `desc' option for union `%s'",
+                              t->u.s.tag);
+               desc = "1";
              }
-               
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
+           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 (union_p && tagid)
              {
-               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;
+               oprintf (d->of, "%*scase %s:\n", d->indent, "", tagid);
+               d->indent += 2;
              }
-
-           if (ta->kind == TYPE_POINTER
-               && (UNION_OR_STRUCT_P (ta->u.p)
-                   || ta->u.p->kind == TYPE_PARAM_STRUCT))
+           else if (union_p && default_p)
              {
-               oprintf (of, "%*sgt_ggc_m_", indent, "");
-               output_mangled_typename (of, ta->u.p);
-               oprintf (of, " (%s%s%s", val, dot, 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, "%*sdefault:\n", d->indent, "");
+               d->indent += 2;
+               seen_default_p = 1;
              }
-           else if (ta->kind == TYPE_STRUCT || ta->kind == TYPE_UNION)
+           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)
              {
-               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%s", val, dot, 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);
+               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 (ta->kind == TYPE_POINTER && ta->u.p->kind == TYPE_SCALAR
-                    && use_param_num != -1 && param == NULL)
-             oprintf (of, "%*sabort();\n", indent, "");
-           else
-             error_at_line (&f->line, 
-                            "field `%s' is array of unimplemented type",
+           else if (union_p && ! (default_p || tagid))
+             error_at_line (d->line, 
+                            "field `%s' is missing `tag' or `default' option",
                             f->name);
-           for (ta = t, i = 0; ta->kind == TYPE_ARRAY; ta = ta->u.a.p, i++)
+           
+           d->line = &f->line;
+           d->val = newval = xasprintf ("%s%s%s", oldval, dot, f->name);
+           d->opt = f->opt;
+
+           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)
              {
-               indent -= 2;
-               oprintf (of, "%*s}\n", indent, "");
+               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;
-       }
+    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;
       
-      if (s->kind == TYPE_UNION)
-       {
-         oprintf (of, "%*sbreak;\n", indent, "");
-         indent -= 2;
-       }
+    default:
+      abort ();
     }
-  if (s->kind == TYPE_UNION)
+}
+
+/* process_field routine for marking routines.  */
+
+static void
+write_types_process_field (f, d)
+     type_p f;
+     const struct walk_type_data *d;
+{
+  const struct write_types_data *wtd;
+  wtd = (const struct write_types_data *) d->cookie;
+  
+  switch (f->kind)
     {
-      if (! seen_default)
+    case TYPE_POINTER:
+      oprintf (d->of, "%*s%s (%s", d->indent, "", 
+              wtd->subfield_marker_routine, d->val);
+      if (wtd->param_prefix)
        {
-         oprintf (of, "%*sdefault:\n", indent, "");
-         oprintf (of, "%*s  break;\n", indent, "");
+         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 (of, "%*s}\n", indent, "");
-      indent -= 2;
+      oprintf (d->of, ");\n");
+      if (d->reorder_fn && wtd->reorder_note_routine)
+       oprintf (d->of, "%*s%s (%s, %s, %s);\n", d->indent, "", 
+                wtd->reorder_note_routine, 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);\n", d->val);
+      if (d->reorder_fn && wtd->reorder_note_routine)
+       oprintf (d->of, "%*s%s (%s, %s, %s);\n", d->indent, "", 
+                wtd->reorder_note_routine, d->val, 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 (orig_s, s, param)
+write_func_for_structure (orig_s, s, param, wtd)
      type_p orig_s;
      type_p s;
      type_p * param;
+     const struct write_types_data *wtd;
 {
-  outf_p f;
   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--)
@@ -1893,7 +1961,8 @@ write_gc_marker_routine_for_structure (orig_s, s, param)
        && UNION_OR_STRUCT_P (param[i]->u.p))
       fn = param[i]->u.p->u.s.line.file;
   
-  f = get_output_file_with_visibility (fn);
+  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)
@@ -1904,80 +1973,113 @@ write_gc_marker_routine_for_structure (orig_s, s, param)
   if (chain_prev != NULL && chain_next == NULL)
     error_at_line (&s->u.s.line, "chain_prev without chain_next");
 
-  oprintf (f, "\n");
-  oprintf (f, "void\n");
+  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", s->u.s.tag);
+    oprintf (d.of, "gt_%sx_%s", wtd->prefix, orig_s->u.s.tag);
   else
     {
-      oprintf (f, "gt_ggc_m_");
-      output_mangled_typename (f, orig_s);
+      oprintf (d.of, "gt_%s_", wtd->prefix);
+      output_mangled_typename (d.of, orig_s);
     }
-  oprintf (f, " (x_p)\n");
-  oprintf (f, "      void *x_p;\n");
-  oprintf (f, "{\n");
-  oprintf (f, "  %s %s * %sx = (%s %s *)x_p;\n",
+  oprintf (d.of, " (x_p)\n");
+  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);
   if (chain_next != NULL)
-    oprintf (f, "  %s %s * xlimit = x;\n",
+    oprintf (d.of, "  %s %s * xlimit = x;\n",
             s->kind == TYPE_UNION ? "union" : "struct", s->u.s.tag);
   if (chain_next == NULL)
-    oprintf (f, "  if (ggc_test_and_set_mark (x))\n");
+    {
+      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 (f, "  while (ggc_test_and_set_mark (xlimit))\n");
-      oprintf (f, "   xlimit = (");
-      output_escaped_param (f, chain_next, "*xlimit", "*xlimit", 
-                           "chain_next", &s->u.s.line);
-      oprintf (f, ");\n");
+      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 (f, "  if (x != xlimit)\n");
-         oprintf (f, "    for (;;)\n");
-         oprintf (f, "      {\n");
-         oprintf (f, "        %s %s * const xprev = (",
+         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);
-         output_escaped_param (f, chain_prev, "*x", "*x",
-                               "chain_prev", &s->u.s.line);
-         oprintf (f, ");\n");
-         oprintf (f, "        if (xprev == NULL) break;\n");
-         oprintf (f, "        x = xprev;\n");
-         oprintf (f, "        ggc_set_mark (xprev);\n");
-         oprintf (f, "      }\n");
+         
+         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 (f, "  while (x != xlimit)\n");
+      oprintf (d.of, "  while (x != xlimit)\n");
     }
-  oprintf (f, "    {\n");
+  oprintf (d.of, "    {\n");
   
-  gc_counter = 0;
-  write_gc_structure_fields (f, s, "(*x)", "not valid postage",
-                            s->u.s.opt, 6, &s->u.s.line, s->u.s.bitmap,
-                            param);
+  d.prev_val[2] = "*x";
+  d.indent = 6;
+  walk_type (s, &d);
   
   if (chain_next != NULL)
     {
-      oprintf (f, "      x = (");
-      output_escaped_param (f, chain_next, "*x", "*x",
-                           "chain_next", &s->u.s.line);
-      oprintf (f, ");\n");
+      oprintf (d.of, "      x = (");
+      output_escaped_param (&d, chain_next, "chain_next");
+      oprintf (d.of, ");\n");
     }
 
-  oprintf (f, "  }\n");
-  oprintf (f, "}\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)
+write_types (structures, param_structs, wtd)
      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)
@@ -1988,11 +2090,12 @@ write_gc_types (structures, param_structs)
            && s->u.s.line.file == NULL)
          continue;
 
-       oprintf (header_file, "#define gt_ggc_m_");
+       oprintf (header_file, "#define gt_%s_", wtd->prefix);
        output_mangled_typename (header_file, s);
        oprintf (header_file, "(X) do { \\\n");
        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");
        
@@ -2004,8 +2107,8 @@ write_gc_types (structures, param_structs)
                  || 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, 
                               "structure alias is not a structure");
@@ -2016,8 +2119,8 @@ write_gc_types (structures, param_structs)
 
        /* Declare the marker procedure only once.  */
        oprintf (header_file, 
-                "extern void gt_ggc_mx_%s PARAMS ((void *));\n",
-                s->u.s.tag);
+                "extern void gt_%sx_%s PARAMS ((void *));\n",
+                wtd->prefix, s->u.s.tag);
   
        if (s->u.s.line.file == NULL)
          {
@@ -2030,10 +2133,10 @@ write_gc_types (structures, param_structs)
          {
            type_p ss;
            for (ss = s->u.s.lang_struct; ss; ss = ss->next)
-             write_gc_marker_routine_for_structure (s, ss, NULL);
+             write_func_for_structure (s, ss, NULL, wtd);
          }
        else
-         write_gc_marker_routine_for_structure (s, s, NULL);
+         write_func_for_structure (s, s, NULL, wtd);
       }
 
   for (s = param_structs; s; s = s->next)
@@ -2043,7 +2146,7 @@ write_gc_types (structures, param_structs)
        type_p stru = s->u.param_struct.stru;
 
        /* Declare the marker procedure.  */
-       oprintf (header_file, "extern void gt_ggc_m_");
+       oprintf (header_file, "extern void gt_%s_", wtd->prefix);
        output_mangled_typename (header_file, s);
        oprintf (header_file, " PARAMS ((void *));\n");
   
@@ -2058,10 +2161,193 @@ write_gc_types (structures, param_structs)
          {
            type_p ss;
            for (ss = stru->u.s.lang_struct; ss; ss = ss->next)
-             write_gc_marker_routine_for_structure (s, ss, param);
+             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 (f, d)
+     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 (orig_s, s, param)
+     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, " (this_obj, x_p, op, cookie)\n");
+  oprintf (d.of, "      void *this_obj ATTRIBUTE_UNUSED;\n");
+  oprintf (d.of, "      void *x_p;\n");
+  oprintf (d.of, "      gt_pointer_operator op ATTRIBUTE_UNUSED;\n");
+  oprintf (d.of, "      void *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 (structures, param_structs)
+     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    PARAMS ((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_pch_p_");
+       output_mangled_typename (header_file, s);
+       oprintf (header_file, 
+        "\n    PARAMS ((void *, void *, gt_pointer_operator, void *));\n");
+  
+       if (stru->u.s.line.file == NULL)
+         {
+           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_local_func_for_structure (s, ss, param);
          }
        else
-         write_gc_marker_routine_for_structure (s, stru, param);
+         write_local_func_for_structure (s, stru, param);
       }
 }
 
@@ -2099,6 +2385,25 @@ write_enum_defn (structures, param_structs)
   oprintf (header_file, "};\n");
 }
 
+/* Might T contain any non-pointer elements?  */
+
+static int
+contains_scalar_p (t)
+     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.  */
 
@@ -2128,7 +2433,6 @@ finish_root_table (flp, pfx, lastname, tname, name)
      const char *name;
 {
   struct flist *fli2;
-  unsigned started_bitmap = 0;
   
   for (fli2 = flp; fli2; fli2 = fli2->next)
     if (fli2->started_p)
@@ -2147,12 +2451,21 @@ 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)
@@ -2165,29 +2478,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");
-       }
+    size_t fnum;
+    for (fnum = 0; fnum < NUM_BASE_FILES; fnum++)
+      {
+       oprintf (base_files[fnum], "  NULL\n");
+       oprintf (base_files[fnum], "};\n");
+      }
   }
 }
 
@@ -2197,7 +2500,7 @@ 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)
+write_root (f, v, type, name, has_length, line, if_marked)
      outf_p f;
      pair_p v;
      type_p type;
@@ -2257,8 +2560,8 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
                    char *newname;
                    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);
                  }
              }
@@ -2270,7 +2573,7 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
              {
                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);
              }
          }
@@ -2281,7 +2584,7 @@ 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;
@@ -2309,17 +2612,21 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
        
        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_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
          {
@@ -2333,8 +2640,19 @@ 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_pch_n_S\n");
+       oprintf (f, "  },\n");
+      }
+      break;
+       
+    case TYPE_SCALAR:
       break;
       
     default:
@@ -2344,10 +2662,64 @@ write_gc_root (f, v, type, name, has_length, line, if_marked)
     }
 }
 
+/* This generates a routine to walk an array.  */
+
+static void
+write_array (f, v, wtd)
+     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, 
+       "    PARAMS ((void *, void *, gt_pointer_operator, void *));\n");
+      oprintf (f, "static void gt_%sa_%s (this_obj, x_p, op, cookie)\n", 
+              wtd->param_prefix, v->name);
+      oprintf (d.of, "      void *this_obj ATTRIBUTE_UNUSED;\n");
+      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 PARAMS ((void *));\n",
+          wtd->prefix, v->name);
+  oprintf (f, "static void\ngt_%sa_%s (x_p)\n",
+          wtd->prefix, v->name);
+  oprintf (f, "      void *x_p ATTRIBUTE_UNUSED;\n");
+  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)
+write_roots (variables)
      pair_p variables;
 {
   pair_p v;
@@ -2400,52 +2772,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 (! UNION_OR_STRUCT_P (s)
-                 && ! s->kind == TYPE_PARAM_STRUCT)
-               {
-                 error_at_line (&v->line, 
-                                "global `%s' has unsupported ** type",
-                                v->name);
-                 continue;
-               }
-
-             oprintf (f, "      gt_ggc_m_");
-             output_mangled_typename (f, s);
-             oprintf (f, " (x[i]);\n");
-           }
-         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);
        }
     }
 
@@ -2479,10 +2807,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)
@@ -2513,11 +2841,11 @@ write_gc_roots (variables)
          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)
@@ -2557,12 +2885,84 @@ write_gc_roots (variables)
          oprintf (f, "[] = {\n");
        }
       
-      write_gc_root (f, v, v->type->u.p->u.param_struct.param[0],
+      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
@@ -2616,8 +3016,10 @@ main(argc, argv)
 
   open_base_files ();
   write_enum_defn (structures, param_structs);
-  write_gc_types (structures, param_structs);
-  write_gc_roots (variables);
+  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 ();