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) ;