https://gcc.gnu.org/g:20e6f36771df7e3a8857628dd367eecfe77ba4fc

commit r15-756-g20e6f36771df7e3a8857628dd367eecfe77ba4fc
Author: Gaius Mulley <gaiusm...@gmail.com>
Date:   Tue May 21 15:46:46 2024 +0100

    modula2: use groups in the type resolver of the bootstrap tool mc
    
    This patch introduces groups to maintain the lists used when resolving
    types in the bootstrap tool mc.  The groups and type resolver are very
    similar to that used in cc1gm2.  Specifically the resolver uses the group
    to detect any change to any element in any list within a group.  This is
    much cleaner and safer than the previous list length comparisons.
    
    gcc/m2/ChangeLog:
    
            * Make-lang.in (MC_EXTENDED_OPAQUE): New definition.
            * mc-boot/GDynamicStrings.cc: Rebuild.
            * mc-boot/GDynamicStrings.h: Rebuild.
            * mc-boot/Galists.cc: Rebuild.
            * mc-boot/Galists.h: Rebuild.
            * mc-boot/Gdecl.cc: Rebuild.
            * mc/alists.def (equalList): New procedure.
            * mc/alists.mod (equalList): New procedure implementation.
            * mc/decl.mod (group): New type.
            (freeGroup): New variable.
            (globalGroup): Ditto.
            (todoQ): Remove declaration and prefix all occurances with 
globalGroup^.
            (partialQ): Ditto.
            (doneQ): Ditto.
            (newGroup): New procedure.
            (initGroup): Ditto.
            (killGroup): Ditto.
            (dupGroup): Ditto.
            (equalGroup): Ditto.
            (topologicallyOut): Rewrite.
    
    Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>

Diff:
---
 gcc/m2/Make-lang.in               |   5 +-
 gcc/m2/mc-boot/GDynamicStrings.cc |  74 ++++++++-
 gcc/m2/mc-boot/GDynamicStrings.h  |  17 +-
 gcc/m2/mc-boot/Galists.cc         |  43 +++++
 gcc/m2/mc-boot/Galists.h          |   6 +
 gcc/m2/mc-boot/Gdecl.cc           | 319 +++++++++++++++++++++++++++-----------
 gcc/m2/mc/alists.def              |   7 +
 gcc/m2/mc/alists.mod              |  28 ++++
 gcc/m2/mc/decl.mod                | 218 ++++++++++++++++++--------
 9 files changed, 552 insertions(+), 165 deletions(-)

diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index da4226123df..83d592f35d8 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -505,6 +505,7 @@ MC_ARGS= --olang=c++ \
  $(MC_COPYRIGHT) \
  --gcc-config-system
 
+MC_EXTENDED_OPAQUE=--extended-opaque
 MCDEPS=m2/boot-bin/mc$(exeext)
 
 MC=m2/boot-bin/mc$(exeext) $(MC_ARGS)
@@ -1539,7 +1540,7 @@ m2/gm2-libs-boot/SysStorage.o: 
$(srcdir)/m2/gm2-libs/SysStorage.mod $(MCDEPS) $(
 
 m2/gm2-compiler-boot/M2GCCDeclare.o: 
$(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod $(MCDEPS) $(BUILD-BOOT-H)
        -test -d $(@D)/$(DEPDIR) || $(mkinstalldirs) $(@D)/$(DEPDIR)
-       $(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2GCCDeclare.c $<
+       $(MC) $(MC_EXTENDED_OPAQUE) -o=m2/gm2-compiler-boot/M2GCCDeclare.c $<
        $(COMPILER) $(CM2DEP) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) 
\
             -I. -I$(srcdir)/../include -I$(srcdir) \
             -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
@@ -1548,7 +1549,7 @@ m2/gm2-compiler-boot/M2GCCDeclare.o: 
$(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod
 
 m2/gm2-compiler-boot/M2Error.o: $(srcdir)/m2/gm2-compiler/M2Error.mod 
$(MCDEPS) $(BUILD-BOOT-H)
        -test -d $(@D)/$(DEPDIR) || $(mkinstalldirs) $(@D)/$(DEPDIR)
-       $(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2Error.c $<
+       $(MC) $(MC_EXTENDED_OPAQUE) -o=m2/gm2-compiler-boot/M2Error.c $<
        $(COMPILER) $(CM2DEP) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) 
\
             -I. -I$(srcdir)/../include -I$(srcdir) \
             -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \
diff --git a/gcc/m2/mc-boot/GDynamicStrings.cc 
b/gcc/m2/mc-boot/GDynamicStrings.cc
index 7f61778af64..a1cb88c03b7 100644
--- a/gcc/m2/mc-boot/GDynamicStrings.cc
+++ b/gcc/m2/mc-boot/GDynamicStrings.cc
@@ -255,12 +255,25 @@ extern "C" int DynamicStrings_Index 
(DynamicStrings_String s, char ch, unsigned
 
 /*
    RIndex - returns the indice of the last occurance of, ch,
-            in String, s. The search starts at position, o.
-            -1 is returned if, ch, is not found.
+            in String, s.  The search starts at position, o.
+            -1 is returned if, ch, is not found.  The search
+            is performed left to right.
 */
 
 extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, 
unsigned int o);
 
+/*
+   ReverseIndex - returns the indice of the last occurance of ch
+                  in String s.  The search starts at position o
+                  and searches from right to left.  The start position
+                  may be indexed negatively from the right (-1 is the
+                  last index).
+                  The return value if ch is found will always be positive.
+                  -1 is returned if ch is not found.
+*/
+
+extern "C" int DynamicStrings_ReverseIndex (DynamicStrings_String s, char ch, 
int o);
+
 /*
    RemoveComment - assuming that, comment, is a comment delimiter
                    which indicates anything to its right is a comment
@@ -2177,8 +2190,9 @@ extern "C" int DynamicStrings_Index 
(DynamicStrings_String s, char ch, unsigned
 
 /*
    RIndex - returns the indice of the last occurance of, ch,
-            in String, s. The search starts at position, o.
-            -1 is returned if, ch, is not found.
+            in String, s.  The search starts at position, o.
+            -1 is returned if, ch, is not found.  The search
+            is performed left to right.
 */
 
 extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, 
unsigned int o)
@@ -2227,6 +2241,52 @@ extern "C" int DynamicStrings_RIndex 
(DynamicStrings_String s, char ch, unsigned
 }
 
 
+/*
+   ReverseIndex - returns the indice of the last occurance of ch
+                  in String s.  The search starts at position o
+                  and searches from right to left.  The start position
+                  may be indexed negatively from the right (-1 is the
+                  last index).
+                  The return value if ch is found will always be positive.
+                  -1 is returned if ch is not found.
+*/
+
+extern "C" int DynamicStrings_ReverseIndex (DynamicStrings_String s, char ch, 
int o)
+{
+  unsigned int c;
+
+  if (PoisonOn)
+    {
+      s = CheckPoisoned (s);
+    }
+  if (o < 0)
+    {
+      o = ((int ) (DynamicStrings_Length (s)))+o;
+      if (o < 0)
+        {
+          return -1;
+        }
+    }
+  if (((unsigned int ) (o)) < (DynamicStrings_Length (s)))
+    {
+      while (o >= 0)
+        {
+          if ((DynamicStrings_char (s, o)) == ch)
+            {
+              return o;
+            }
+          else
+            {
+              o -= 1;
+            }
+        }
+    }
+  return -1;
+  /* static analysis guarentees a RETURN statement will be used before here.  
*/
+  __builtin_unreachable ();
+}
+
+
 /*
    RemoveComment - assuming that, comment, is a comment delimiter
                    which indicates anything to its right is a comment
@@ -2251,7 +2311,7 @@ extern "C" DynamicStrings_String 
DynamicStrings_RemoveComment (DynamicStrings_St
     }
   if (TraceOn)
     {
-      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1534, (const char *) 
"RemoveComment", 13);
+      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1576, (const char *) 
"RemoveComment", 13);
     }
   return s;
   /* static analysis guarentees a RETURN statement will be used before here.  
*/
@@ -2276,7 +2336,7 @@ extern "C" DynamicStrings_String 
DynamicStrings_RemoveWhitePrefix (DynamicString
   s = DynamicStrings_Slice (s, (int ) (i), 0);
   if (TraceOn)
     {
-      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1646, (const char *) 
"RemoveWhitePrefix", 17);
+      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1688, (const char *) 
"RemoveWhitePrefix", 17);
     }
   return s;
   /* static analysis guarentees a RETURN statement will be used before here.  
*/
@@ -2301,7 +2361,7 @@ extern "C" DynamicStrings_String 
DynamicStrings_RemoveWhitePostfix (DynamicStrin
   s = DynamicStrings_Slice (s, 0, i+1);
   if (TraceOn)
     {
-      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1668, (const char *) 
"RemoveWhitePostfix", 18);
+      s = AssignDebug (s, (const char *) 
"../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1710, (const char *) 
"RemoveWhitePostfix", 18);
     }
   return s;
   /* static analysis guarentees a RETURN statement will be used before here.  
*/
diff --git a/gcc/m2/mc-boot/GDynamicStrings.h b/gcc/m2/mc-boot/GDynamicStrings.h
index 76f4cea6c81..e0652a7d3bd 100644
--- a/gcc/m2/mc-boot/GDynamicStrings.h
+++ b/gcc/m2/mc-boot/GDynamicStrings.h
@@ -194,12 +194,25 @@ EXTERN int DynamicStrings_Index (DynamicStrings_String s, 
char ch, unsigned int
 
 /*
    RIndex - returns the indice of the last occurance of, ch,
-            in String, s. The search starts at position, o.
-            -1 is returned if, ch, is not found.
+            in String, s.  The search starts at position, o.
+            -1 is returned if ch is not found.  The search
+            is performed left to right.
 */
 
 EXTERN int DynamicStrings_RIndex (DynamicStrings_String s, char ch, unsigned 
int o);
 
+/*
+   ReverseIndex - returns the indice of the last occurance of ch
+                  in String s.  The search starts at position o
+                  and searches from right to left.  The start position
+                  may be indexed negatively from the right (-1 is the
+                  last index).
+                  The return value if ch is found will always be positive.
+                  -1 is returned if ch is not found.
+*/
+
+EXTERN int DynamicStrings_ReverseIndex (DynamicStrings_String s, char ch, int 
o);
+
 /*
    RemoveComment - assuming that, comment, is a comment delimiter
                    which indicates anything to its right is a comment
diff --git a/gcc/m2/mc-boot/Galists.cc b/gcc/m2/mc-boot/Galists.cc
index 2505ab13361..238bcc87d50 100644
--- a/gcc/m2/mc-boot/Galists.cc
+++ b/gcc/m2/mc-boot/Galists.cc
@@ -137,6 +137,12 @@ extern "C" void alists_foreachItemInListDo (alists_alist 
l, alists_performOperat
 
 extern "C" alists_alist alists_duplicateList (alists_alist l);
 
+/*
+   equalList - returns TRUE if left contains the same information as right.
+*/
+
+extern "C" bool alists_equalList (alists_alist left, alists_alist right);
+
 /*
    removeItem - remove an element at index, i, from the alist data type.
 */
@@ -432,6 +438,43 @@ extern "C" alists_alist alists_duplicateList (alists_alist 
l)
   __builtin_unreachable ();
 }
 
+
+/*
+   equalList - returns TRUE if left contains the same information as right.
+*/
+
+extern "C" bool alists_equalList (alists_alist left, alists_alist right)
+{
+  unsigned int leftn;
+  unsigned int rightn;
+  unsigned int i;
+
+  leftn = alists_noOfItemsInList (left);
+  rightn = alists_noOfItemsInList (right);
+  if (leftn == rightn)
+    {
+      i = 1;
+      while (i <= leftn)
+        {
+          if (alists_isItemInList (right, alists_getItemFromList (left, i)))
+            {
+              i += 1;
+            }
+          else
+            {
+              return false;
+            }
+        }
+    }
+  else
+    {
+      return false;
+    }
+  return true;
+  /* static analysis guarentees a RETURN statement will be used before here.  
*/
+  __builtin_unreachable ();
+}
+
 extern "C" void _M2_alists_init (__attribute__((unused)) int 
argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
 {
 }
diff --git a/gcc/m2/mc-boot/Galists.h b/gcc/m2/mc-boot/Galists.h
index bd4557b6a51..3ed524152f4 100644
--- a/gcc/m2/mc-boot/Galists.h
+++ b/gcc/m2/mc-boot/Galists.h
@@ -124,6 +124,12 @@ EXTERN void alists_foreachItemInListDo (alists_alist l, 
alists_performOperation
 */
 
 EXTERN alists_alist alists_duplicateList (alists_alist l);
+
+/*
+   equalList - returns TRUE if left contains the same information as right.
+*/
+
+EXTERN bool alists_equalList (alists_alist left, alists_alist right);
 #   ifdef __cplusplus
 }
 #   endif
diff --git a/gcc/m2/mc-boot/Gdecl.cc b/gcc/m2/mc-boot/Gdecl.cc
index 654cb0f3120..bd43faebeac 100644
--- a/gcc/m2/mc-boot/Gdecl.cc
+++ b/gcc/m2/mc-boot/Gdecl.cc
@@ -46,12 +46,12 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 typedef unsigned int nameKey_Name;
 
 #   define nameKey_NulName 0
-typedef struct mcPretty_writeProc_p mcPretty_writeProc;
-
 typedef struct symbolKey__T8_r symbolKey__T8;
 
 typedef symbolKey__T8 *symbolKey_symbolTree;
 
+typedef struct mcPretty_writeProc_p mcPretty_writeProc;
+
 typedef struct mcPretty_writeLnProc_p mcPretty_writeLnProc;
 
 typedef unsigned int FIO_File;
@@ -61,12 +61,6 @@ extern FIO_File FIO_StdOut;
 typedef struct symbolKey_performOperation_p symbolKey_performOperation;
 
 #   define ASCII_tab ASCII_ht
-typedef struct alists__T13_r alists__T13;
-
-typedef alists__T13 *alists_alist;
-
-typedef struct alists__T14_a alists__T14;
-
 #   define ASCII_ht (char) 011
 #   define ASCII_lf ASCII_nl
 #   define ASCII_nl (char) 012
@@ -270,6 +264,10 @@ typedef struct decl_nodeProcedure_p decl_nodeProcedure;
 
 typedef struct decl_cnameT_r decl_cnameT;
 
+typedef struct decl__T15_r decl__T15;
+
+typedef decl__T15 *decl_group;
+
 #   define MaxBuf 127
 #   define maxNoOfElements 5
 typedef enum {decl_explist, decl_funccall, decl_exit, decl_return, 
decl_stmtseq, decl_comment, decl_halt, decl_new, decl_dispose, decl_inc, 
decl_dec, decl_incl, decl_excl, decl_length, decl_nil, decl_true, decl_false, 
decl_address, decl_loc, decl_byte, decl_word, decl_csizet, decl_cssizet, 
decl_char, decl_cardinal, decl_longcard, decl_shortcard, decl_integer, 
decl_longint, decl_shortint, decl_real, decl_longreal, decl_shortreal, 
decl_bitset, decl_boolean, decl_proc, decl_ztype, decl_rtype, decl_complex, 
decl_longcomplex, decl_shortcomplex, decl_type, decl_record, decl_varient, 
decl_var, decl_enumeration, decl_subrange, decl_array, decl_subscript, 
decl_string, decl_const, decl_literal, decl_varparam, decl_param, decl_varargs, 
decl_optarg, decl_pointer, decl_recordfield, decl_varientfield, 
decl_enumerationfield, decl_set, decl_proctype, decl_procedure, decl_def, 
decl_imp, decl_module, decl_loop, decl_while, decl_for, decl_repeat, decl_case, 
decl_caselabellist, decl_caselist, decl_rang
 e, decl_assignment, decl_if, decl_elsif, decl_constexp, decl_neg, decl_cast, 
decl_val, decl_plus, decl_sub, decl_div, decl_mod, decl_mult, decl_divide, 
decl_in, decl_adr, decl_size, decl_tsize, decl_ord, decl_float, decl_trunc, 
decl_chr, decl_abs, decl_cap, decl_high, decl_throw, decl_unreachable, 
decl_cmplx, decl_re, decl_im, decl_min, decl_max, decl_componentref, 
decl_pointerref, decl_arrayref, decl_deref, decl_equal, decl_notequal, 
decl_less, decl_greater, decl_greequal, decl_lessequal, decl_lsl, decl_lsr, 
decl_lor, decl_land, decl_lnot, decl_lxor, decl_and, decl_or, decl_not, 
decl_identlist, decl_vardecl, decl_setvalue} decl_nodeT;
@@ -298,13 +296,17 @@ typedef struct DynamicStrings_Contents_r 
DynamicStrings_Contents;
 
 typedef struct wlists__T9_r wlists__T9;
 
+typedef struct alists__T13_r alists__T13;
+
 typedef struct mcPretty__T12_r mcPretty__T12;
 
 typedef struct wlists__T10_a wlists__T10;
 
+typedef Indexing__T5 *Indexing_Index;
+
 typedef struct DynamicStrings__T7_a DynamicStrings__T7;
 
-typedef Indexing__T5 *Indexing_Index;
+typedef struct alists__T14_a alists__T14;
 
 typedef mcComment__T6 *mcComment_commentDesc;
 
@@ -314,10 +316,9 @@ typedef DynamicStrings_stringRecord *DynamicStrings_String;
 
 typedef wlists__T9 *wlists_wlist;
 
-typedef mcPretty__T12 *mcPretty_pretty;
+typedef alists__T13 *alists_alist;
 
-typedef void (*mcPretty_writeProc_t) (char);
-struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
+typedef mcPretty__T12 *mcPretty_pretty;
 
 struct symbolKey__T8_r {
                          nameKey_Name name;
@@ -326,13 +327,15 @@ struct symbolKey__T8_r {
                          symbolKey_symbolTree right;
                        };
 
+typedef void (*mcPretty_writeProc_t) (char);
+struct mcPretty_writeProc_p { mcPretty_writeProc_t proc; };
+
 typedef void (*mcPretty_writeLnProc_t) (void);
 struct mcPretty_writeLnProc_p { mcPretty_writeLnProc_t proc; };
 
 typedef void (*symbolKey_performOperation_t) (void *);
 struct symbolKey_performOperation_p { symbolKey_performOperation_t proc; };
 
-struct alists__T14_a { void * array[MaxnoOfelements-1+1]; };
 typedef void (*Indexing_IndexProcedure_t) (void *);
 struct Indexing_IndexProcedure_p { Indexing_IndexProcedure_t proc; };
 
@@ -649,6 +652,13 @@ struct decl_cnameT_r {
                        bool init;
                      };
 
+struct decl__T15_r {
+                     alists_alist todoQ;
+                     alists_alist partialQ;
+                     alists_alist doneQ;
+                     decl_group next;
+                   };
+
 struct Indexing__T5_r {
                         void *ArrayStart;
                         unsigned int ArraySize;
@@ -668,12 +678,7 @@ struct mcComment__T6_r {
 
 struct wlists__T10_a { unsigned int array[maxNoOfElements-1+1]; };
 struct DynamicStrings__T7_a { char array[(MaxBuf-1)+1]; };
-struct alists__T13_r {
-                       unsigned int noOfelements;
-                       alists__T14 elements;
-                       alists_alist next;
-                     };
-
+struct alists__T14_a { void * array[MaxnoOfelements-1+1]; };
 struct decl_intrinsicT_r {
                            decl_node args;
                            unsigned int noArgs;
@@ -843,6 +848,12 @@ struct wlists__T9_r {
                       wlists_wlist next;
                     };
 
+struct alists__T13_r {
+                       unsigned int noOfelements;
+                       alists__T14 elements;
+                       alists_alist next;
+                     };
+
 struct mcPretty__T12_r {
                          mcPretty_writeProc write_;
                          mcPretty_writeLnProc writeln;
@@ -943,6 +954,8 @@ struct DynamicStrings_stringRecord_r {
                                        DynamicStrings_DebugInfo debug;
                                      };
 
+static decl_group freeGroup;
+static decl_group globalGroup;
 static FIO_File outputFile;
 static decl_language lang;
 static decl_node bitsperunitN;
@@ -1015,9 +1028,6 @@ static symbolKey_symbolTree defUniverse;
 static symbolKey_symbolTree baseSymbols;
 static decl_outputStates outputState;
 static mcPretty_pretty doP;
-static alists_alist todoQ;
-static alists_alist partialQ;
-static alists_alist doneQ;
 static bool mustVisitScope;
 static bool simplified;
 static unsigned int tempCount;
@@ -2584,12 +2594,25 @@ extern "C" int DynamicStrings_Index 
(DynamicStrings_String s, char ch, unsigned
 
 /*
    RIndex - returns the indice of the last occurance of, ch,
-            in String, s. The search starts at position, o.
-            -1 is returned if, ch, is not found.
+            in String, s.  The search starts at position, o.
+            -1 is returned if, ch, is not found.  The search
+            is performed left to right.
 */
 
 extern "C" int DynamicStrings_RIndex (DynamicStrings_String s, char ch, 
unsigned int o);
 
+/*
+   ReverseIndex - returns the indice of the last occurance of ch
+                  in String s.  The search starts at position o
+                  and searches from right to left.  The start position
+                  may be indexed negatively from the right (-1 is the
+                  last index).
+                  The return value if ch is found will always be positive.
+                  -1 is returned if ch is not found.
+*/
+
+extern "C" int DynamicStrings_ReverseIndex (DynamicStrings_String s, char ch, 
int o);
+
 /*
    RemoveComment - assuming that, comment, is a comment delimiter
                    which indicates anything to its right is a comment
@@ -3251,6 +3274,12 @@ extern "C" void alists_foreachItemInListDo (alists_alist 
l, alists_performOperat
 
 extern "C" alists_alist alists_duplicateList (alists_alist l);
 
+/*
+   equalList - returns TRUE if left contains the same information as right.
+*/
+
+extern "C" bool alists_equalList (alists_alist left, alists_alist right);
+
 /*
    initList - creates a new wlist, l.
 */
@@ -3432,6 +3461,37 @@ static decl_node newNode (decl_nodeT k);
 
 static void disposeNode (decl_node *n);
 
+/*
+   newGroup -
+*/
+
+static void newGroup (decl_group *g);
+
+/*
+   initGroup - returns a group which with all lists initialized.
+*/
+
+static decl_group initGroup (void);
+
+/*
+   killGroup - deallocate the group and place the group record into the 
freeGroup list.
+*/
+
+static void killGroup (decl_group *g);
+
+/*
+   dupGroup - If g is not NIL then destroy g.
+              Return a duplicate of GlobalGroup (not g).
+*/
+
+static decl_group dupGroup (decl_group g);
+
+/*
+   equalGroup - return TRUE if group left = right.
+*/
+
+static bool equalGroup (decl_group left, decl_group right);
+
 /*
    isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
 */
@@ -6215,7 +6275,8 @@ static void addEnumConst (decl_node n);
 static void populateTodo (decl_nodeProcedure p);
 
 /*
-   topologicallyOut -
+   topologicallyOut - keep trying to resolve the todoQ and partialQ
+                      until there is no change from the global group.
 */
 
 static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, 
decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, 
decl_nodeProcedure pt, decl_nodeProcedure pv);
@@ -6721,6 +6782,93 @@ static void disposeNode (decl_node *n)
 }
 
 
+/*
+   newGroup -
+*/
+
+static void newGroup (decl_group *g)
+{
+  if (freeGroup == NULL)
+    {
+      Storage_ALLOCATE ((void **) &(*g), sizeof (decl__T15));
+    }
+  else
+    {
+      (*g) = freeGroup;
+      freeGroup = freeGroup->next;
+    }
+}
+
+
+/*
+   initGroup - returns a group which with all lists initialized.
+*/
+
+static decl_group initGroup (void)
+{
+  decl_group g;
+
+  newGroup (&g);
+  g->todoQ = alists_initList ();
+  g->partialQ = alists_initList ();
+  g->doneQ = alists_initList ();
+  g->next = NULL;
+  return g;
+  /* static analysis guarentees a RETURN statement will be used before here.  
*/
+  __builtin_unreachable ();
+}
+
+
+/*
+   killGroup - deallocate the group and place the group record into the 
freeGroup list.
+*/
+
+static void killGroup (decl_group *g)
+{
+  alists_killList (&(*g)->todoQ);
+  alists_killList (&(*g)->partialQ);
+  alists_killList (&(*g)->doneQ);
+  (*g)->next = freeGroup;
+  freeGroup = (*g);
+}
+
+
+/*
+   dupGroup - If g is not NIL then destroy g.
+              Return a duplicate of GlobalGroup (not g).
+*/
+
+static decl_group dupGroup (decl_group g)
+{
+  if (g != NULL)
+    {
+      /* Kill old group.  */
+      killGroup (&g);
+    }
+  newGroup (&g);
+  /* Copy all lists.  */
+  g->todoQ = alists_duplicateList (globalGroup->todoQ);
+  g->partialQ = alists_duplicateList (globalGroup->partialQ);
+  g->doneQ = alists_duplicateList (globalGroup->doneQ);
+  g->next = NULL;
+  return g;
+  /* static analysis guarentees a RETURN statement will be used before here.  
*/
+  __builtin_unreachable ();
+}
+
+
+/*
+   equalGroup - return TRUE if group left = right.
+*/
+
+static bool equalGroup (decl_group left, decl_group right)
+{
+  return (left == right) || (((alists_equalList (left->todoQ, right->todoQ)) 
&& (alists_equalList (left->partialQ, right->partialQ))) && (alists_equalList 
(left->doneQ, right->doneQ)));
+  /* static analysis guarentees a RETURN statement will be used before here.  
*/
+  __builtin_unreachable ();
+}
+
+
 /*
    isLocal - returns TRUE if symbol, n, is locally declared in a procedure.
 */
@@ -9531,14 +9679,14 @@ static void doNothing (decl_node n)
 
 static void doConstC (decl_node n)
 {
-  if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n))))
+  if (! (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> 
(n))))
     {
       mcPretty_print (doP, (const char *) "#   define ", 11);
       doFQNameC (doP, n);
       mcPretty_setNeedSpace (doP);
       doExprC (doP, n->constF.value);
       mcPretty_print (doP, (const char *) "\\n", 2);
-      alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
+      alists_includeItemIntoList (globalGroup->doneQ, reinterpret_cast<void *> 
(n));
     }
 }
 
@@ -13554,12 +13702,12 @@ static void doPrototypeC (decl_node n)
 
 static void addTodo (decl_node n)
 {
-  if (((n != NULL) && (! (alists_isItemInList (partialQ, reinterpret_cast<void 
*> (n))))) && (! (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))))
+  if (((n != NULL) && (! (alists_isItemInList (globalGroup->partialQ, 
reinterpret_cast<void *> (n))))) && (! (alists_isItemInList 
(globalGroup->doneQ, reinterpret_cast<void *> (n)))))
     {
       mcDebug_assert (! (decl_isVarient (n)));
       mcDebug_assert (! (decl_isVarientField (n)));
       mcDebug_assert (! (decl_isDef (n)));
-      alists_includeItemIntoList (todoQ, reinterpret_cast<void *> (n));
+      alists_includeItemIntoList (globalGroup->todoQ, reinterpret_cast<void *> 
(n));
     }
 }
 
@@ -17320,7 +17468,7 @@ static decl_dependentState allDependants (decl_node n)
 
 static decl_dependentState walkDependants (alists_alist l, decl_node n)
 {
-  if ((n == NULL) || (alists_isItemInList (doneQ, reinterpret_cast<void *> 
(n))))
+  if ((n == NULL) || (alists_isItemInList (globalGroup->doneQ, 
reinterpret_cast<void *> (n))))
     {
       return decl_completed;
     }
@@ -17349,11 +17497,11 @@ static decl_dependentState walkType (alists_alist l, 
decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> (t)))
     {
       return decl_completed;
     }
-  else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  else if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void 
*> (t)))
     {
       /* avoid dangling else.  */
       return decl_blocked;
@@ -17458,18 +17606,18 @@ static void dbq (decl_node n)
   if (mcOptions_getDebugTopological ())
     {
       /* avoid gcc warning by using compound statement even if not strictly 
necessary.  */
-      if (alists_isItemInList (todoQ, reinterpret_cast<void *> (n)))
+      if (alists_isItemInList (globalGroup->todoQ, reinterpret_cast<void *> 
(n)))
         {
           db ((const char *) "{T", 2, n);
           outText (doP, (const char *) "}", 1);
         }
-      else if (alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))
+      else if (alists_isItemInList (globalGroup->partialQ, 
reinterpret_cast<void *> (n)))
         {
           /* avoid dangling else.  */
           db ((const char *) "{P", 2, n);
           outText (doP, (const char *) "}", 1);
         }
-      else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (n)))
+      else if (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void 
*> (n)))
         {
           /* avoid dangling else.  */
           db ((const char *) "{D", 2, n);
@@ -17577,7 +17725,7 @@ static decl_dependentState walkVarient (alists_alist l, 
decl_node n)
 
 static void queueBlocked (decl_node n)
 {
-  if (! ((alists_isItemInList (doneQ, reinterpret_cast<void *> (n))) || 
(alists_isItemInList (partialQ, reinterpret_cast<void *> (n)))))
+  if (! ((alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> 
(n))) || (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(n)))))
     {
       addTodo (n);
     }
@@ -17593,7 +17741,7 @@ static decl_dependentState walkVar (alists_alist l, 
decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> (t)))
     {
       return decl_completed;
     }
@@ -17700,7 +17848,7 @@ static decl_dependentState walkPointer (alists_alist l, 
decl_node n)
 
   /* if the type of, n, is done or partial then we can output pointer.  */
   t = decl_getType (n);
-  if ((alists_isItemInList (partialQ, reinterpret_cast<void *> (t))) || 
(alists_isItemInList (doneQ, reinterpret_cast<void *> (t))))
+  if ((alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t))) || (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> 
(t))))
     {
       /* pointer to partial can always generate a complete type.  */
       return decl_completed;
@@ -17720,7 +17868,7 @@ static decl_dependentState walkArray (alists_alist l, 
decl_node n)
   decl_dependentState s;
 
   /* an array can only be declared if its data type has already been emitted.  
*/
-  if (! (alists_isItemInList (doneQ, reinterpret_cast<void *> 
(n->arrayF.type))))
+  if (! (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> 
(n->arrayF.type))))
     {
       s = walkDependants (l, n->arrayF.type);
       queueBlocked (n->arrayF.type);
@@ -17773,7 +17921,7 @@ static decl_dependentState walkVarParam (alists_alist 
l, decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t)))
     {
       /* parameter can be issued from a partial.  */
       return decl_completed;
@@ -17793,7 +17941,7 @@ static decl_dependentState walkParam (alists_alist l, 
decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t)))
     {
       /* parameter can be issued from a partial.  */
       return decl_completed;
@@ -17813,7 +17961,7 @@ static decl_dependentState walkOptarg (alists_alist l, 
decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t)))
     {
       /* parameter can be issued from a partial.  */
       return decl_completed;
@@ -17835,12 +17983,12 @@ static decl_dependentState walkRecordField 
(alists_alist l, decl_node n)
 
   mcDebug_assert (decl_isRecordField (n));
   t = decl_getType (n);
-  if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t)))
     {
       dbs (decl_partial, n);
       return decl_partial;
     }
-  else if (alists_isItemInList (doneQ, reinterpret_cast<void *> (t)))
+  else if (alists_isItemInList (globalGroup->doneQ, reinterpret_cast<void *> 
(t)))
     {
       /* avoid dangling else.  */
       dbs (decl_completed, n);
@@ -17928,7 +18076,7 @@ static decl_dependentState walkProcType (alists_alist 
l, decl_node n)
   decl_node t;
 
   t = decl_getType (n);
-  if (alists_isItemInList (partialQ, reinterpret_cast<void *> (t)))
+  if (alists_isItemInList (globalGroup->partialQ, reinterpret_cast<void *> 
(t)))
     {}  /* empty.  */
   else
     {
@@ -18377,7 +18525,7 @@ static bool tryCompleteFromPartial (decl_node n, 
decl_nodeProcedure t)
 {
   if ((((decl_isType (n)) && ((decl_getType (n)) != NULL)) && (decl_isPointer 
(decl_getType (n)))) && ((allDependants (decl_getType (n))) == decl_completed))
     {
-      /* alists.includeItemIntoList (partialQ, getType (n)) ;  */
+      /* alists.includeItemIntoList (globalGroup^.partialQ, getType (n)) ;  */
       outputHiddenComplete (n);
       return true;
     }
@@ -19854,9 +20002,9 @@ static void dumpLists (void)
     {
       m = FormatStrings_Sprintf0 (DynamicStrings_InitString ((const char *) 
"\\n", 2));
       m = DynamicStrings_KillString (SFIO_WriteS (FIO_StdOut, m));
-      dumpQ ((const char *) "todo", 4, todoQ);
-      dumpQ ((const char *) "partial", 7, partialQ);
-      dumpQ ((const char *) "done", 4, doneQ);
+      dumpQ ((const char *) "todo", 4, globalGroup->todoQ);
+      dumpQ ((const char *) "partial", 7, globalGroup->partialQ);
+      dumpQ ((const char *) "done", 4, globalGroup->doneQ);
     }
 }
 
@@ -20011,21 +20159,21 @@ static void tryOutputTodo (decl_nodeProcedure c, 
decl_nodeProcedure t, decl_node
   decl_node d;
 
   i = 1;
-  n = alists_noOfItemsInList (todoQ);
+  n = alists_noOfItemsInList (globalGroup->todoQ);
   while (i <= n)
     {
-      d = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
+      d = static_cast<decl_node> (alists_getItemFromList (globalGroup->todoQ, 
i));
       if (tryComplete (d, c, t, v))
         {
-          alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
-          alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
+          alists_removeItemFromList (globalGroup->todoQ, reinterpret_cast<void 
*> (d));
+          alists_includeItemIntoList (globalGroup->doneQ, 
reinterpret_cast<void *> (d));
           i = 1;
         }
       else if (tryPartial (d, pt))
         {
           /* avoid dangling else.  */
-          alists_removeItemFromList (todoQ, reinterpret_cast<void *> (d));
-          alists_includeItemIntoList (partialQ, reinterpret_cast<void *> (d));
+          alists_removeItemFromList (globalGroup->todoQ, reinterpret_cast<void 
*> (d));
+          alists_includeItemIntoList (globalGroup->partialQ, 
reinterpret_cast<void *> (d));
           i = 1;
         }
       else
@@ -20033,7 +20181,7 @@ static void tryOutputTodo (decl_nodeProcedure c, 
decl_nodeProcedure t, decl_node
           /* avoid dangling else.  */
           i += 1;
         }
-      n = alists_noOfItemsInList (todoQ);
+      n = alists_noOfItemsInList (globalGroup->todoQ);
     }
 }
 
@@ -20049,14 +20197,14 @@ static void tryOutputPartial (decl_nodeProcedure t)
   decl_node d;
 
   i = 1;
-  n = alists_noOfItemsInList (partialQ);
+  n = alists_noOfItemsInList (globalGroup->partialQ);
   while (i <= n)
     {
-      d = static_cast<decl_node> (alists_getItemFromList (partialQ, i));
+      d = static_cast<decl_node> (alists_getItemFromList 
(globalGroup->partialQ, i));
       if (tryCompleteFromPartial (d, t))
         {
-          alists_removeItemFromList (partialQ, reinterpret_cast<void *> (d));
-          alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (d));
+          alists_removeItemFromList (globalGroup->partialQ, 
reinterpret_cast<void *> (d));
+          alists_includeItemIntoList (globalGroup->doneQ, 
reinterpret_cast<void *> (d));
           i = 1;
           n -= 1;
         }
@@ -20105,8 +20253,8 @@ static void debugLists (void)
 {
   if (mcOptions_getDebugTopological ())
     {
-      debugList ((const char *) "todo", 4, todoQ);
-      debugList ((const char *) "partial", 7, partialQ);
+      debugList ((const char *) "todo", 4, globalGroup->todoQ);
+      debugList ((const char *) "partial", 7, globalGroup->partialQ);
     }
 }
 
@@ -20137,47 +20285,39 @@ static void populateTodo (decl_nodeProcedure p)
   unsigned int h;
   alists_alist l;
 
-  h = alists_noOfItemsInList (todoQ);
+  h = alists_noOfItemsInList (globalGroup->todoQ);
   i = 1;
   while (i <= h)
     {
-      n = static_cast<decl_node> (alists_getItemFromList (todoQ, i));
+      n = static_cast<decl_node> (alists_getItemFromList (globalGroup->todoQ, 
i));
       l = alists_initList ();
       visitNode (l, n, p);
       alists_killList (&l);
-      h = alists_noOfItemsInList (todoQ);
+      h = alists_noOfItemsInList (globalGroup->todoQ);
       i += 1;
     }
 }
 
 
 /*
-   topologicallyOut -
+   topologicallyOut - keep trying to resolve the todoQ and partialQ
+                      until there is no change from the global group.
 */
 
 static void topologicallyOut (decl_nodeProcedure c, decl_nodeProcedure t, 
decl_nodeProcedure v, decl_nodeProcedure tp, decl_nodeProcedure pc, 
decl_nodeProcedure pt, decl_nodeProcedure pv)
 {
-  unsigned int tol;
-  unsigned int pal;
-  unsigned int to;
-  unsigned int pa;
+  decl_group before;
 
   populateTodo ((decl_nodeProcedure) {(decl_nodeProcedure_t) addEnumConst});
-  tol = 0;
-  pal = 0;
-  to = alists_noOfItemsInList (todoQ);
-  pa = alists_noOfItemsInList (partialQ);
-  while ((tol != to) || (pal != pa))
-    {
-      dumpLists ();
-      tryOutputTodo (c, t, v, tp);
-      dumpLists ();
-      tryOutputPartial (pt);
-      tol = to;
-      pal = pa;
-      to = alists_noOfItemsInList (todoQ);
-      pa = alists_noOfItemsInList (partialQ);
-    }
+  before = NULL;
+  do {
+    before = dupGroup (before);  /* Get a copy of the globalGroup and free 
before.  */
+    dumpLists ();  /* Get a copy of the globalGroup and free before.  */
+    tryOutputTodo (c, t, v, tp);
+    dumpLists ();
+    tryOutputPartial (pt);
+  } while (! (equalGroup (before, globalGroup)));
+  killGroup (&before);
   dumpLists ();
   debugLists ();
 }
@@ -21414,7 +21554,7 @@ static void outM2 (mcPretty_pretty p, decl_node n)
 
 static void addDone (decl_node n)
 {
-  alists_includeItemIntoList (doneQ, reinterpret_cast<void *> (n));
+  alists_includeItemIntoList (globalGroup->doneQ, reinterpret_cast<void *> 
(n));
 }
 
 
@@ -21430,7 +21570,7 @@ static void addDoneDef (decl_node n)
       addDone (n);
       return ;
     }
-  if ((! (decl_isDef (n))) && ((decl_lookupImp (decl_getSymName (decl_getScope 
(n)))) == (decl_getMainModule ())))
+  if (false && ((decl_lookupImp (decl_getSymName (decl_getScope (n)))) == 
(decl_getMainModule ())))
     {
       mcMetaError_metaError1 ((const char *) "cyclic dependancy found between 
another module using {%1ad} from the definition module of the implementation 
main being compiled, use the --extended-opaque option to compile", 173, (const 
unsigned char *) &n, (sizeof (n)-1));
       mcError_flushErrors ();
@@ -22409,9 +22549,8 @@ static void init (void)
   lang = decl_ansiC;
   outputFile = FIO_StdOut;
   doP = mcPretty_initPretty ((mcPretty_writeProc) {(mcPretty_writeProc_t) 
write_}, (mcPretty_writeLnProc) {(mcPretty_writeLnProc_t) writeln});
-  todoQ = alists_initList ();
-  partialQ = alists_initList ();
-  doneQ = alists_initList ();
+  freeGroup = NULL;
+  globalGroup = initGroup ();
   modUniverse = symbolKey_initTree ();
   defUniverse = symbolKey_initTree ();
   modUniverseI = Indexing_InitIndex (1);
diff --git a/gcc/m2/mc/alists.def b/gcc/m2/mc/alists.def
index 878fc88d6dc..93bc56d1e78 100644
--- a/gcc/m2/mc/alists.def
+++ b/gcc/m2/mc/alists.def
@@ -109,4 +109,11 @@ PROCEDURE foreachItemInListDo (l: alist; p: 
performOperation) ;
 PROCEDURE duplicateList (l: alist) : alist ;
 
 
+(*
+   equalList - returns TRUE if left contains the same information as right.
+*)
+
+PROCEDURE equalList (left, right: alist) : BOOLEAN ;
+
+
 END alists.
diff --git a/gcc/m2/mc/alists.mod b/gcc/m2/mc/alists.mod
index 048ce1f7978..5a56ec03c2b 100644
--- a/gcc/m2/mc/alists.mod
+++ b/gcc/m2/mc/alists.mod
@@ -302,4 +302,32 @@ BEGIN
 END duplicateList ;
 
 
+(*
+   equalList - returns TRUE if left contains the same information as right.
+*)
+
+PROCEDURE equalList (left, right: alist) : BOOLEAN ;
+VAR
+   leftn, rightn, i: CARDINAL ;
+BEGIN
+   leftn := noOfItemsInList (left) ;
+   rightn := noOfItemsInList (right) ;
+   IF leftn = rightn
+   THEN
+      i := 1 ;
+      WHILE i <= leftn DO
+         IF isItemInList (right, getItemFromList (left, i))
+         THEN
+            INC (i)
+         ELSE
+            RETURN FALSE
+         END
+      END
+   ELSE
+      RETURN FALSE
+   END ;
+   RETURN TRUE
+END equalList ;
+
+
 END alists.
diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod
index 3d1b57fb4ae..c3ee646caaf 100644
--- a/gcc/m2/mc/decl.mod
+++ b/gcc/m2/mc/decl.mod
@@ -682,7 +682,17 @@ TYPE
                    init :  BOOLEAN ;
                 END ;
 
+       group = POINTER TO RECORD
+                             todoQ,
+                             partialQ,
+                             doneQ   : alist ;
+                             next    : group ;
+                          END ;
+
+
 VAR
+   freeGroup,
+   globalGroup   : group ;    (* The global group of all alists.  *)
    outputFile    : File ;
    lang          : language ;
    bitsperunitN,
@@ -755,9 +765,6 @@ VAR
    baseSymbols   : symbolTree ;
    outputState   : outputStates ;
    doP           : pretty ;
-   todoQ,
-   partialQ,
-   doneQ         : alist ;
    mustVisitScope,
    simplified    : BOOLEAN ;
    tempCount     : CARDINAL ;
@@ -800,6 +807,92 @@ BEGIN
 END disposeNode ;
 
 
+(*
+   newGroup -
+*)
+
+PROCEDURE newGroup (VAR g: group) ;
+BEGIN
+   IF freeGroup = NIL
+   THEN
+      NEW (g)
+   ELSE
+      g := freeGroup ;
+      freeGroup := freeGroup^.next
+   END
+END newGroup ;
+
+
+(*
+   initGroup - returns a group which with all lists initialized.
+*)
+
+PROCEDURE initGroup () : group ;
+VAR
+   g: group ;
+BEGIN
+   newGroup (g) ;
+   WITH g^ DO
+      todoQ := alists.initList () ;
+      partialQ := alists.initList () ;
+      doneQ := alists.initList () ;
+      next := NIL
+   END ;
+   RETURN g
+END initGroup ;
+
+
+(*
+   killGroup - deallocate the group and place the group record into the 
freeGroup list.
+*)
+
+PROCEDURE killGroup (VAR g: group) ;
+BEGIN
+   alists.killList (g^.todoQ) ;
+   alists.killList (g^.partialQ) ;
+   alists.killList (g^.doneQ) ;
+   g^.next := freeGroup ;
+   freeGroup := g ;
+END killGroup ;
+
+
+(*
+   dupGroup - If g is not NIL then destroy g.
+              Return a duplicate of GlobalGroup (not g).
+*)
+
+PROCEDURE dupGroup (g: group) : group ;
+BEGIN
+   IF g # NIL
+   THEN
+      (* Kill old group.  *)
+      killGroup (g)
+   END ;
+   newGroup (g) ;
+   WITH g^ DO
+      (* Copy all lists.  *)
+      todoQ := alists.duplicateList (globalGroup^.todoQ) ;
+      partialQ := alists.duplicateList (globalGroup^.partialQ) ;
+      doneQ := alists.duplicateList (globalGroup^.doneQ) ;
+      next := NIL
+   END ;
+   RETURN g
+END dupGroup ;
+
+
+(*
+   equalGroup - return TRUE if group left = right.
+*)
+
+PROCEDURE equalGroup (left, right: group) : BOOLEAN ;
+BEGIN
+   RETURN ((left = right) OR
+           (alists.equalList (left^.todoQ, right^.todoQ) AND
+            alists.equalList (left^.partialQ, right^.partialQ) AND
+            alists.equalList (left^.doneQ, right^.doneQ)))
+END equalGroup ;
+
+
 (*
    getDeclaredDef - returns the token number associated with the nodes 
declaration
                     in the definition module.
@@ -5659,14 +5752,14 @@ END doNothing ;
 
 PROCEDURE doConstC (n: node) ;
 BEGIN
-   IF NOT alists.isItemInList (doneQ, n)
+   IF NOT alists.isItemInList (globalGroup^.doneQ, n)
    THEN
       print (doP, "#   define ") ;
       doFQNameC (doP, n) ;
       setNeedSpace (doP) ;
       doExprC (doP, n^.constF.value) ;
       print (doP, '\n') ;
-      alists.includeItemIntoList (doneQ, n)
+      alists.includeItemIntoList (globalGroup^.doneQ, n)
    END
 END doConstC ;
 
@@ -8602,13 +8695,13 @@ END doPrototypeC ;
 PROCEDURE addTodo (n: node) ;
 BEGIN
    IF (n#NIL) AND
-      (NOT alists.isItemInList (partialQ, n)) AND
-      (NOT alists.isItemInList (doneQ, n))
+      (NOT alists.isItemInList (globalGroup^.partialQ, n)) AND
+      (NOT alists.isItemInList (globalGroup^.doneQ, n))
    THEN
       assert (NOT isVarient (n)) ;
       assert (NOT isVarientField (n)) ;
       assert (NOT isDef (n)) ;
-      alists.includeItemIntoList (todoQ, n)
+      alists.includeItemIntoList (globalGroup^.todoQ, n)
    END
 END addTodo ;
 
@@ -11932,7 +12025,7 @@ END allDependants ;
 
 PROCEDURE walkDependants (l: alist; n: node) : dependentState ;
 BEGIN
-   IF (n=NIL) OR alists.isItemInList (doneQ, n)
+   IF (n=NIL) OR alists.isItemInList (globalGroup^.doneQ, n)
    THEN
       RETURN completed
    ELSIF alists.isItemInList (l, n)
@@ -11954,10 +12047,10 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (doneQ, t)
+   IF alists.isItemInList (globalGroup^.doneQ, t)
    THEN
       RETURN completed
-   ELSIF alists.isItemInList (partialQ, t)
+   ELSIF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       RETURN blocked
    ELSE
@@ -12030,13 +12123,13 @@ PROCEDURE dbq (n: node) ;
 BEGIN
    IF getDebugTopological ()
    THEN
-      IF alists.isItemInList (todoQ, n)
+      IF alists.isItemInList (globalGroup^.todoQ, n)
       THEN
          db ('{T', n) ; outText (doP, '}')
-      ELSIF alists.isItemInList (partialQ, n)
+      ELSIF alists.isItemInList (globalGroup^.partialQ, n)
       THEN
          db ('{P', n) ; outText (doP, '}')
-      ELSIF alists.isItemInList (doneQ, n)
+      ELSIF alists.isItemInList (globalGroup^.doneQ, n)
       THEN
          db ('{D', n) ; outText (doP, '}')
       END
@@ -12129,7 +12222,8 @@ END walkVarient ;
 
 PROCEDURE queueBlocked (n: node) ;
 BEGIN
-   IF NOT (alists.isItemInList (doneQ, n) OR alists.isItemInList (partialQ, n))
+   IF NOT (alists.isItemInList (globalGroup^.doneQ, n) OR
+           alists.isItemInList (globalGroup^.partialQ, n))
    THEN
       addTodo (n)
    END
@@ -12145,7 +12239,7 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (doneQ, t)
+   IF alists.isItemInList (globalGroup^.doneQ, t)
    THEN
       RETURN completed
    ELSE
@@ -12244,7 +12338,8 @@ VAR
 BEGIN
    (* if the type of, n, is done or partial then we can output pointer.  *)
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t) OR alists.isItemInList (doneQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t) OR
+      alists.isItemInList (globalGroup^.doneQ, t)
    THEN
       (* pointer to partial can always generate a complete type.  *)
       RETURN completed
@@ -12270,7 +12365,7 @@ BEGIN
       END ;
 *)
       (* an array can only be declared if its data type has already been 
emitted.  *)
-      IF NOT alists.isItemInList (doneQ, type)
+      IF NOT alists.isItemInList (globalGroup^.doneQ, type)
       THEN
          s := walkDependants (l, type) ;
          queueBlocked (type) ;
@@ -12320,7 +12415,7 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       (* parameter can be issued from a partial.  *)
       RETURN completed
@@ -12338,7 +12433,7 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       (* parameter can be issued from a partial.  *)
       RETURN completed
@@ -12356,7 +12451,7 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       (* parameter can be issued from a partial.  *)
       RETURN completed
@@ -12376,11 +12471,11 @@ VAR
 BEGIN
    assert (isRecordField (n)) ;
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       dbs (partial, n) ;
       RETURN partial
-   ELSIF alists.isItemInList (doneQ, t)
+   ELSIF alists.isItemInList (globalGroup^.doneQ, t)
    THEN
       dbs (completed, n) ;
       RETURN completed
@@ -12454,7 +12549,7 @@ VAR
    t: node ;
 BEGIN
    t := getType (n) ;
-   IF alists.isItemInList (partialQ, t)
+   IF alists.isItemInList (globalGroup^.partialQ, t)
    THEN
       (* proctype can be generated from partial types.  *)
    ELSE
@@ -12787,7 +12882,7 @@ PROCEDURE tryCompleteFromPartial (n: node; t: 
nodeProcedure) : BOOLEAN ;
 BEGIN
    IF isType (n) AND (getType (n)#NIL) AND isPointer (getType (n)) AND 
(allDependants (getType (n)) = completed)
    THEN
-      (* alists.includeItemIntoList (partialQ, getType (n)) ; *)
+      (* alists.includeItemIntoList (globalGroup^.partialQ, getType (n)) ; *)
       outputHiddenComplete (n) ;
       RETURN TRUE
    ELSIF allDependants (n) = completed
@@ -13824,9 +13919,9 @@ BEGIN
    THEN
       m := Sprintf0 (InitString ('\n')) ;
       m := KillString (WriteS (StdOut, m)) ;
-      dumpQ ('todo', todoQ) ;
-      dumpQ ('partial', partialQ) ;
-      dumpQ ('done', doneQ)
+      dumpQ ('todo', globalGroup^.todoQ) ;
+      dumpQ ('partial', globalGroup^.partialQ) ;
+      dumpQ ('done', globalGroup^.doneQ)
    END
 END dumpLists ;
 
@@ -13885,7 +13980,8 @@ BEGIN
             pt (n) ;
             addTodo (q) ;
             RETURN TRUE
-         ELSIF isArray (q) AND (seenPointer OR alists.isItemInList (doneQ, 
getType (q)))
+         ELSIF isArray (q) AND (seenPointer OR
+                                alists.isItemInList (globalGroup^.doneQ, 
getType (q)))
          THEN
             pt (n) ;
             addTodo (q) ;
@@ -13997,23 +14093,23 @@ VAR
    d   : node ;
 BEGIN
    i := 1 ;
-   n := alists.noOfItemsInList (todoQ) ;
+   n := alists.noOfItemsInList (globalGroup^.todoQ) ;
    WHILE i<=n DO
-      d := alists.getItemFromList (todoQ, i) ;
+      d := alists.getItemFromList (globalGroup^.todoQ, i) ;
       IF tryComplete (d, c, t, v)
       THEN
-         alists.removeItemFromList (todoQ, d) ;
-        alists.includeItemIntoList (doneQ, d) ;
+         alists.removeItemFromList (globalGroup^.todoQ, d) ;
+        alists.includeItemIntoList (globalGroup^.doneQ, d) ;
          i := 1
       ELSIF tryPartial (d, pt)
       THEN
-         alists.removeItemFromList (todoQ, d) ;
-         alists.includeItemIntoList (partialQ, d) ;
+         alists.removeItemFromList (globalGroup^.todoQ, d) ;
+         alists.includeItemIntoList (globalGroup^.partialQ, d) ;
          i := 1
       ELSE
          INC (i)
       END ;
-      n := alists.noOfItemsInList (todoQ)
+      n := alists.noOfItemsInList (globalGroup^.todoQ)
    END
 END tryOutputTodo ;
 
@@ -14028,13 +14124,13 @@ VAR
    d   : node ;
 BEGIN
    i := 1 ;
-   n := alists.noOfItemsInList (partialQ) ;
+   n := alists.noOfItemsInList (globalGroup^.partialQ) ;
    WHILE i<=n DO
-      d := alists.getItemFromList (partialQ, i) ;
+      d := alists.getItemFromList (globalGroup^.partialQ, i) ;
       IF tryCompleteFromPartial (d, t)
       THEN
-         alists.removeItemFromList (partialQ, d) ;
-         alists.includeItemIntoList (doneQ, d) ;
+         alists.removeItemFromList (globalGroup^.partialQ, d) ;
+         alists.includeItemIntoList (globalGroup^.doneQ, d) ;
          i := 1 ;
          DEC (n)
       ELSE
@@ -14076,8 +14172,8 @@ PROCEDURE debugLists ;
 BEGIN
    IF getDebugTopological ()
    THEN
-      debugList ('todo', todoQ) ;
-      debugList ('partial', partialQ)
+      debugList ('todo', globalGroup^.todoQ) ;
+      debugList ('partial', globalGroup^.partialQ)
    END
 END debugLists ;
 
@@ -14107,44 +14203,39 @@ VAR
    i, h: CARDINAL ;
    l   : alist ;
 BEGIN
-   h := alists.noOfItemsInList (todoQ) ;
+   h := alists.noOfItemsInList (globalGroup^.todoQ) ;
    i := 1 ;
    WHILE i <= h DO
-      n := alists.getItemFromList (todoQ, i) ;
+      n := alists.getItemFromList (globalGroup^.todoQ, i) ;
       l := alists.initList () ;
       visitNode (l, n, p) ;
       alists.killList (l) ;
-      h := alists.noOfItemsInList (todoQ) ;
+      h := alists.noOfItemsInList (globalGroup^.todoQ) ;
       INC (i)
    END
 END populateTodo ;
 
 
 (*
-   topologicallyOut -
+   topologicallyOut - keep trying to resolve the todoQ and partialQ
+                      until there is no change from the global group.
 *)
 
 PROCEDURE topologicallyOut (c, t, v, tp,
                             pc, pt, pv: nodeProcedure) ;
 VAR
-   tol, pal,
-   to,  pa : CARDINAL ;
+   before: group ;
 BEGIN
    populateTodo (addEnumConst) ;
-   tol := 0 ;
-   pal := 0 ;
-   to := alists.noOfItemsInList (todoQ) ;
-   pa := alists.noOfItemsInList (partialQ) ;
-   WHILE (tol#to) OR (pal#pa) DO
+   before := NIL ;
+   REPEAT
+      before := dupGroup (before) ;  (* Get a copy of the globalGroup and free 
before.  *)
       dumpLists ;
       tryOutputTodo (c, t, v, tp) ;
       dumpLists ;
-      tryOutputPartial (pt) ;
-      tol := to ;
-      pal := pa ;
-      to := alists.noOfItemsInList (todoQ) ;
-      pa := alists.noOfItemsInList (partialQ)
-   END ;
+      tryOutputPartial (pt)
+   UNTIL equalGroup (before, globalGroup) ;
+   killGroup (before) ;
    dumpLists ;
    debugLists
 END topologicallyOut ;
@@ -15352,7 +15443,7 @@ END setLangM2 ;
 
 PROCEDURE addDone (n: node) ;
 BEGIN
-   alists.includeItemIntoList (doneQ, n)
+   alists.includeItemIntoList (globalGroup^.doneQ, n)
 END addDone ;
 
 
@@ -15368,7 +15459,7 @@ BEGIN
       addDone (n) ;
       RETURN
    END ;
-   IF (NOT isDef (n)) AND (lookupImp (getSymName (getScope (n))) = 
getMainModule ())
+   IF FALSE AND (lookupImp (getSymName (getScope (n))) = getMainModule ())
    THEN
       metaError1 ('cyclic dependancy found between another module using {%1ad} 
from the definition module of the implementation main being compiled, use the 
--extended-opaque option to compile', n) ;
       flushErrors ;
@@ -16977,9 +17068,8 @@ BEGIN
    lang := ansiC ;
    outputFile := StdOut ;
    doP := initPretty (write, writeln) ;
-   todoQ := alists.initList () ;
-   partialQ := alists.initList () ;
-   doneQ := alists.initList () ;
+   freeGroup := NIL ;
+   globalGroup := initGroup () ;
    modUniverse := initTree () ;
    defUniverse := initTree () ;
    modUniverseI := InitIndex (1) ;

Reply via email to