! File: FLOWAN.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. MODULE FLOWAN(TIMER=EXTERNAL(SIX12))= BEGIN ! FLOWAN MODULE ! ------------- ! ! C. GESCHKE ! B. LEVERETT ! ! ! THE FUNCTION OF THIS MODULE IS TO PERFORM GLOBAL FLOW ANALYSIS. ! IT PERFORMS COMMON-SUB-EXPRESSION RECOGNITION AND FINDS FEASIBLE ! CODE MOTION OPTIMIZATIONS. ! ! SWITCHES NOLIST; REQUIRE COMMON.BEG; REQUIRE GTST.BEG; REQUIRE GTX.BEG; REQUIRE ST.BEG; REQUIRE LDSFT.BEG; SWITCHES LIST; REQUIRE LDSF1.BEG; SWITCHES NOLIST; REQUIRE LDSF2.BEG; SWITCHES LIST; REQUIRE FLOW.BEG; BEGIN EXTERNAL LSTHDR ALPHDR:OMEGHDR:PSIHDR:CHIHDR:RHOHDR; EXTERNAL ABCOUNT; EXTERNAL LEVEL,LEVELINC,CHILEVEL; EXTERNAL DECROCC, MAKGT; FORWARD ABCBETW, BINDPCSTHREAD, ENTVCHGLST, ENTVUSELST, GCSEFROMPSI, GENPRLG, GENPSI, SEARCHFORKILLS, WISCHUSED; ! GLOBAL FLOW ANALYSIS ROUTINES ! ------------------------------ GLOBAL ROUTINE FLOWINIT= ! ! CALLED BY DOMODULE ! PERFORMS INITIALIZATION OF DATA USED BY FLOWAN ! BEGIN FLOOR_FOUNDATION_0; LEVEL_LEVELINC_CEILING_LVLCOPY_ABCOUNT_ABCBASE_1; CLEARCORE(GTHASH,MAXDELIMITER+2); CURBOGLST[BASE]_MAKHDR(BOGREMOVE,BOGENTER); CURPRLGLST[BASE]_MAKHDR(PRLGREMOVE,PRLGENTER); KILLST[BASE]_MAKHDR(KILREMOVE,KILENTER); NOVALUE END; GLOBAL ROUTINE PUSHANDBUMP(Z)= ! PUSHES LISTS FLOOR OR CEILING AND SIMULTANEOUSLY LEVEL SELECT .Z OF NSET FLOOR: EXITSELECT PAB(FLOOR); CEILING: EXITSELECT PAB(CEILING) TESN; GLOBAL ROUTINE POPANDDUMP(Z)= ! POPS LIST FLOOR OR CEILING AND SIMULTANEOUSLY LEVEL SELECT .Z OF NSET FLOOR: EXITSELECT PAD(FLOOR); CEILING: EXITSELECT PAD(CEILING) TESN; GLOBAL ROUTINE NOTELEVEL(STE)= ! CALLED BY: SLABEL, SFLABEL (IN SYNTAX) ! ARGUMENT: SYMBOL TABLE ENTRY FOR A LABEL ! CALLED WHEN: SYNTAX PROCESSING FOR THE LABELED EXPRESSION ! IS ABOUT TO BEGIN BEGIN MAP STVEC STE; STE[LVLINC]_.LEVELINC; STE[SAVLEVEL]_.LEVEL; LEVELINC_.LEVELINC*2 END; ROUTINE NOTELEAVE(STACK,LABLEVEL,INC)= ! CALLED BY: F24 ! ARGUMENTS: A STACK (EITHER LVLCOPY OR CEILING) 'STACK' ! THE INFORMATION SAVED BY NOTELEVEL IN SOME LABEL ('LABLEVEL','INC') ! CALLED WHEN: THE FIRST 'LEAVE' TO SOME LABEL IS ENCOUNTERED ! PURPOSE: FOLLOW DOWN THE STACK INCREMENTING VALUES BY 'INC' ! UNTIL A VALUE LESS THAN 'LABLEVEL' IS FOUND BEGIN LOCAL LVL S; S[CINX]_.STACK; UNTIL .S[CINX] EQL 0 OR .S[NVAL] LSS .LABLEVEL DO (S[NVAL]_.S[NVAL]+.INC; S[CINX]_.S[NINX]) END; ROUTINE PUSHFLO= ! CALLED FROM: F1, F8, F10, F12 ! CALLED WHEN: ON ENTRY TO EACH LINEAR BLOCK. ! PURPOSE: CREATE NEW PROLOG LIST & SAVE OLD; DITTO WITH ABCBASE (PUSHABC; PUSHCURPRLGLST); ROUTINE POPFLO= ! CALLED FROM: F4, F13, F16, F17, F18 ! CALLED WHEN: ON EXIT FROM EACH LINEAR BLOCK. ! PURPOSE: POP WHAT PUSHFLO PUSHED. (POPCURPRLGLST; POPABC); GLOBAL ROUTINE NONBOGUS(NODE)= ! CALLED FROM: ENRHO, NONBOGUS (RECURSIVE), FIND NAME, MARK DOT NODES, ! MARK UP, MARK ALL, GALOMBITS, OMEG DECR, OMEGHEADECR, F11. ! ARGUMENT: A GT NODE ! VALUE: A GT NODE FORMALLY IDENTICAL TO THE FIRST, BUT WHICH IS ! NOT A 'BOGUS' NODE. ! PURPOSE: 'BOGUS' NODES HAVE NO OPERANDS; THEREFORE, ANY ROUTINE ! WHICH NEEDS TO SEE THE OPERANDS OF A NODE MUST (USUALLY) ! CALL THIS ROUTINE. BEGIN MAP GTVEC NODE; IF NOT .NODE[BOGUSBIT] THEN .NODE ELSE IF .NODE[CSTHREAD] NEQ 0 THEN NONBOGUS(.NODE[CSTHREAD]) ELSE NONBOGUS(.NODE[PCSTHREAD]) END; ROUTINE FINDNAME(LEX)= ! CALLED FROM: FIND NAME (RECURSIVE), MARK DOT NODES, GALOMBITS, ! ENTVUSELST, ENTVCHGLST, WISCHUSED, F11. ! ARGUMENT: A LEXEME ! VALUE: IF THE LEXEME "LOOKS LIKE" AN UNDOTTED SYMBOL TABLE ENTRY, ! A POINTER TO THE SYMBOL TABLE ENTRY; OTHERWISE -1. ! NOTE THAT IF THE LEXEME IS THE SYMBOL TABLE ENTRY FOR "A+4", ! A POINTER TO THE STE FOR "A" IS RETURNED. BEGIN MAP LEXEME LEX; BIND STVEC LNAMEX=LEX; REGISTER GTVEC L1,L2; IF .LEX[LTYPF] EQL BNDVAR THEN IF (IF .LNAMEX[TYPEF] LEQ HIGHADDTYPE THEN .LNAMEX[NAMEXP]) THEN FASTLEXOUT(BNDVAR,.LNAMEX[NAMEXPTR]) ELSE .LEX ELSE IF .LEX[LTYPF] NEQ GTTYP THEN -1 ELSE BEGIN L1_.LEX[ADDRF]; IF .L1[NODEX] GTR MAXOPERATOR THEN RETURN SELECT .L1[NODEX] OF NSET SSTOROP: FINDNAME(.L1[OPR2]); SYNPOI: FINDNAME(.L1[OPR1]); SYNIF: IF (L2_FINDNAME(.L1[OPR3])) EQL FINDNAME(.L1[OPR4]) THEN .L2 ELSE -1; SYNCOMP: FINDNAME(.L1[OPERAND(.L1[NODESIZEF]-1)]); SFPARM: FINDNAME(.L1[OPR1]); OTHERWISE: -1 TESN; IF .L1[NODEX] EQL SDOTOP THEN -1 ELSE (L1_NONBOGUS(.L1); FORALLRANDS(I,.L1) IF (L2_FINDNAME(.L1[OPERAND(.I)])) GEQ 0 THEN RETURN .L2) END END; FORWARD MARKALL; MACRO MRK(L)= ! CALLED FROM: MARK DOT NODES, MARK ALL, F11 ! PURPOSE: SET 'MUST MARK' BIT OF A NODE, AND ADJUST ITS MARK LEVEL. IF NOT .GT[L,PURGEBIT] THEN IF NOT .GT[L,RM] THEN IF .GT[L,MM] THEN (IF .GT[L,MKLEVEL] GTR .LEVEL THEN GT[L,MKLEVEL]_.LEVEL) ELSE (GT[L,MM]_1; GT[L,MKLEVEL]_.LEVEL)$; ROUTINE FINDNOPOI(LEX)= ! CALLED FROM: FIND NO POI (RECURSIVE), FIND ANY OCCUR, MARK DOT NODES ! PURPOSE: GIVEN E, RETURNS E ! GIVEN ANY OTHER LEXEME, RETURNS LEXEME ITSELF BEGIN MAP LEXEME LEX; BIND GTVEC NODE=LEX; IF .LEX[LTYPF] NEQ GTTYP THEN RETURN .LEX; IF .NODE[NODEX] NEQ SYNPOI THEN RETURN .LEX; FINDNOPOI(.NODE[OPR1]) END; ROUTINE FINDANYOCCUR(L,LEX)= ! CALLED FROM: MARK DOT NODES ! FUNCTION: ! PREDICATE INDICATING THAT L AND LEX ARE "APPROXIMATELY" ! FORMALLY IDENTICAL. "APPROXIMATE" MEANS THAT WE MAY FIRST ! HAVE TO STRIP OFF OF LEX. BEGIN MAP LEXEME LEX, GTVEC L; BIND GTVEC NODE=LEX; IF .LEX EQL .L THEN RETURN 1; LEX_FINDNOPOI(.LEX); IF .LEX[LTYPF] NEQ GTTYP THEN RETURN 0; IF .L[FPARENT] EQL .NODE[FPARENT] THEN RETURN 1; 0 END; GLOBAL ROUTINE MRKDOTNODES(LEX)= BEGIN ! ! CALLED FROM: GENGT (IN SYNTAX), F11 ! PURPOSE: ! IF 'X_' OCCURS, OR X APPEARS UNDOTTED AS A ROUTINE CALL ! PARAMETER, MARK ALL '.X' NODES. ! REGISTER GTVEC L:LFP; LOCAL GTVEC LLEX; MAP GTVEC LEX; BIND LEXEME ALEX=LEX; IF FAST THEN RETURN; L_.GTHASH[SDOTOP]; IF (LLEX_FINDNAME(.LEX)) LSS 0 THEN BEGIN IF .MRKFLG THEN RETURN MARKALL(FALSE); LEX_FINDNOPOI(.LEX); IF .ALEX[LTYPF] EQL LITTYP THEN WHILE .L NEQ 0 DO BEGIN REGISTER GTVEC M; M_NONBOGUS(.L); IF FINDNOPOI(.M[OPR1]) EQL .LEX THEN (LFP_.L[FPARENT]; DO MRK(.LFP) WHILE (LFP_.LFP[FSTHREAD]) NEQ 0); L_.L[GTHREAD] END ELSE WHILE .L NEQ 0 DO BEGIN REGISTER GTVEC M; M_NONBOGUS(.L); IF FINDANYOCCUR(.LEX,.M[OPR1]) THEN (LFP_.L[FPARENT]; DO MRK(.LFP) WHILE (LFP_.LFP[FSTHREAD]) NEQ 0); L_.L[GTHREAD]; END; RETURN; END; DO BEGIN WHILE .L NEQ 0 DO BEGIN REGISTER Q,GTVEC M; M_NONBOGUS(.L); IF (Q_FINDNAME(.M[OPR1OF1])) EQL .LLEX THEN EXITLOOP LFP_.L; IF .Q LSS 0 THEN IF .MRKFLG AND (.LLEX[TYPEF] NEQ REGT) THEN EXITLOOP LFP_.L; L_.L[GTHREAD] END; IF .L EQL 0 THEN RETURN; DO MRK(.LFP) WHILE (LFP_.LFP[FSTHREAD]) NEQ 0; END WHILE (L_.L[GTHREAD]) NEQ 0; END; ROUTINE MARKUP(LEX)= ! PROPAGATES THE MARK-BITS UP FROM L'S DESCENDANTS TO L. ! CALLED FROM MARKMMNODES. BEGIN REGISTER MARK, GTVEC Q:L; MAP LEXEME LEX; BIND GTVEC NODE=LEX; MARK_0; IF .LEX[LTYPF] NEQ GTTYP THEN RETURN 0; L_.NODE[CSPARENT]; IF .L[RM] THEN RETURN 1; Q_NONBOGUS(.L); IF .L[MM] THEN (Q[RMMM]_L[RMMM]_1; RETURN 1); ! RM_1, MM_0 FORALLRANDS(I,.Q) MARK_.MARK OR MARKUP(.Q[OPERAND(.I)]); IF .MARK THEN BEGIN IF NOT .L[PURGEBIT] THEN Q[MKLEVEL]_L[MKLEVEL]_.LEVEL; Q[RM]_L[RM]_1 END; .MARK END; GLOBAL ROUTINE MARKMMNODES= ! CALLED FROM: F4, F5, F7, F9, F15, F17, F19, F23, SCOMPOUND ! CALLED WHEN: SIDE EFFECTS MUST BE ACCOUNTED FOR, E.G. AT ! EVERY SEMICOLON IN A COMPOUND STATEMENT ! PURPOSE: SET 'REAL MARK' BITS IN ALL NODES WHOSE 'MUST MARK' BITS ARE ON. BEGIN REGISTER GTVEC L:LFP; INCABC; IF .NPTFLG THEN MARKALL(TRUE); FORALLRATORS(I) BEGIN LFP_.GTHASH[.I]; WHILE .LFP NEQ 0 DO BEGIN L_.LFP; DO MARKUP(L_FASTLEXOUT(GTTYP,.L)) WHILE (L_.L[FSTHREAD]) NEQ 0; LFP_.LFP[GTHREAD] END; END; END; ROUTINE MARKALL(MRKREGS)= BEGIN ! ! CALLED FROM MARK DOT NODES, MARK MM NODES, F3, F21 ! MARK ALL NODES ON THE DOT CHAIN. ! IF 'MRKREGS' ISN'T SET, DON'T MARK '.R' IF R IS A REGISTER VARIABLE. ! REGISTER GTVEC L:LFP; LOCAL GTVEC M; BIND LEXEME LM=M; IF FAST THEN RETURN; LFP_.GTHASH[SDOTOP]; WHILE .LFP NEQ 0 DO BEGIN L_.LFP; M_NONBOGUS(.L); LM_.M[OPR1]; IF NOT .MRKREGS THEN IF .LM[LTYPF] EQL BNDVAR THEN IF .M[TYPEF] EQL REGT THEN EXITCOMPOUND LFP_.LFP[GTHREAD]; DO MRK(.L) WHILE (L_.L[FSTHREAD]) NEQ 0; LFP_.LFP[GTHREAD] END; END; ROUTINE PURGE= ! CALLED FROM: F6, F7, F14, F25 ! CALLED WHEN: AFTER PARSING ANY EXPRESSION WHOSE EXECUTION WILL BE ! OPTIONAL, E.G. AFTER EACH BRANCH OF A FORK, OR AFTER ! "DO" EXPRESSION OF A WHILE-DO, DO-WHILE, OR INCR LOOP. ! PURPOSE: SET THE 'PURGEBIT' OF THAT EXPRESSION ! AND ALL ITS SUBEXPRESSIONS. ! ASSUMES: PUSHANDBUMP(CEILING) WAS EXECUTED BEFORE PARSING EXPRESSION, ! BUT MATCHING POPANDDUMP(CEILING) HAS NOT YET BEEN EXECUTED. BEGIN REGISTER GTVEC LFP:LCSP,C; C_.CEILING[CVAL]-.LEVELINC; FORALLRATORS(I) BEGIN LFP_.GTHASH[.I]; WHILE .LFP NEQ 0 DO BEGIN LCSP_.LFP; DO IF .LCSP[CRLEVEL] GTR .C THEN IF NOT .LCSP[PURGEBIT] THEN (LCSP[PURGEBIT]_1; LCSP[MKLEVEL]_0) WHILE (LCSP_.LCSP[FSTHREAD]) NEQ 0; LFP_.LFP[GTHREAD] END END END; ROUTINE REFRESH= ! CALLED FROM: F4 ! CALLED WHEN: AFTER EACH BRANCH OF A FORK ! PURPOSE: ! FOR EVERY NODE THAT WAS VALID BEFORE THE BRANCH BUT WAS ! INVALIDATED DURING IT, TURN OFF THE NODE'S 'REAL MARK' BIT, ! BUT TURN ON ITS 'JOIN MARK' BIT TO 'REMEMBER' THE RM BIT. ! BEGIN REGISTER GTVEC L:LFP,C; PURGE(); C_.CEILING[CVAL]-.LEVELINC; FORALLRATORS(I) BEGIN LFP_.GTHASH[.I]; WHILE .LFP NEQ 0 DO BEGIN L_.LFP; DO IF .L[MKLEVEL] GTR .C THEN BEGIN L[JM]_.L[JRMMBITS] NEQ 0; !L[JM]_.L[JM] OR .L[RM] OR .L[MM]; L[RMMM]_0; !L[MM]_L[RM]_0 END WHILE (L_.L[FSTHREAD]) NEQ 0; LFP_.LFP[GTHREAD] END END END; ROUTINE MARKUPDATE= ! CALLED FROM: F5, F6, F7, F14 ! CALLED WHEN: AFTER ALL BRANCHES OF A FORK ! PURPOSE: INVALIDATE ANY NODE WHICH WAS INVALIDATED ON SOME BRANCH ! BUT RE-VALIDATED BY 'REFRESH'. BEGIN REGISTER GTVEC L:LFP,C; C_.CEILING[CVAL]-.LEVELINC; FORALLRATORS(I) BEGIN LFP_.GTHASH[.I]; WHILE .LFP NEQ 0 DO BEGIN L_.LFP; DO IF .L[MKLEVEL] GTR .C THEN BEGIN L[MM]_.L[JMMM] NEQ 0; !L[MM]_.L[MM] OR .L[JM]; L[MKLEVEL]_.CEILING[NVAL] END WHILE (L_.L[FSTHREAD]) NEQ 0; LFP_.LFP[GTHREAD] END END END; ROUTINE KILL(TYPE,GTINDEX)= ! ! CALLED FROM: F2, F3, F11, F24 ! PURPOSE: PUT AN ENTRY ON THE KILL LIST WITH FIELDS SET TO: ! KCAUSE - .GTINDEX ! KTYPE - .TYPE ! KABC - .ABCOUNT ! ENLST(.KILLST[BASE],MAKITEM(.ABCOUNT^23 OR .TYPE^18 OR .GTINDEX,1)); MACRO WASUSED(NODEPTR)=WISCHUSED(0,NODEPTR)$, ISUSED(ZORONE,NODEPTR)=WISCHUSED(ZORONE,1,NODEPTR)$, WASCHGED(NODEPTR)=WISCHUSED(2,NODEPTR)$, ISCHGED(ZORONE,NODEPTR)=WISCHUSED(ZORONE,3,NODEPTR)$; GLOBAL ROUTINE BINDPCSTHREAD(INITNODE)= ! CALLED WHEN A BOGUS NODE (INITNODE) IS RECOGNIZED AS A C-S-E ! TO SEQUENCE DOWN THE PCSTHREAD FROM INITNODE: ! (1) TOTALLING OCCURRENCE COUNTS ! (2) THREADING VIA CSTHREAD ALL C-S-E'S OFF INITNODE ! (3) SETTING EACH CSPARENT FIELD TO POINT TO BOGUS NODE BEGIN MAP GTVEC INITNODE; REGISTER GTVEC NODE:L,VAL; LOCAL COUNT; VAL_COUNT_0; NODE_.INITNODE; INITNODE[DONTUNLINK]_TRUE; WHILE (NODE_.NODE[PCSTHREAD]) NEQ 0 DO BEGIN IF NOT .NODE[CSP] THEN EXITCOMPOUND; IF .COUNT NEQ 0 THEN DECROCC(.NODE) ELSE COUNT_ -1; NODE[DONTUNLINK]_TRUE; VAL_.VAL+.NODE[OCCF]; L_.INITNODE; UNTIL .L[CSTHREAD] EQL 0 DO L_.L[CSTHREAD]; L[CSTHREAD]_.NODE; IF NOT .NODE[FP] THEN BEGIN L_.INITNODE[FPARENT]; UNTIL .L[FSTHREAD] EQL .NODE DO L_.L[FSTHREAD]; L[FSTHREAD]_.NODE[FSTHREAD]; NODE[FSTHREAD]_0; END; NODE[CSP]_0; END; L_.INITNODE[CSTHREAD]; UNTIL .L EQL 0 DO (L[CSPARENT]_.INITNODE; L[PCSTHREAD]_0; L_.L[CSTHREAD]); INITNODE[PCSTHREAD]_INITNODE[ENDOFPCS]_0; INITNODE[OCCF]_.VAL END; ROUTINE TURNOFFPSLG(NODELEX)= ! CALLED FROM: GENPSLGBITS ! CALLED TO TURN OFF THE PSLG-BITS OF ALL COMP-EXPS IN SEQUENCE ! BELOW (AND INCLUDING) NODELEX WHEN NODELEX IS DISCOVERED TO BE ! AN "ESSENTIAL CONSTITUENT" OF ITS ANCESTOR. E.G.: A_(F();X_.Y) ! TURNS OFF PSLG BIT OF "X_.Y" AND OF ENCLOSING COMPOUND EXPRESSION. BEGIN MAP LEXEME NODELEX; BIND GTVEC NODEPTR=NODELEX; IF .NODELEX[LTYPF] NEQ GTTYP THEN RETURN; WHILE .NODEPTR[NODEX] EQL SYNCOMP DO (NODEPTR[PSLGBIT]_0; NODELEX_.NODEPTR[OPERAND(.NODEPTR[NODESIZEF]-1)]; IF .NODELEX[LTYPF] NEQ GTTYP THEN EXITLOOP); IF .NODELEX[LTYPF] EQL GTTYP THEN NODEPTR[PSLGBIT]_0 END; ROUTINE GALOMBITS(HI,LO,NODELEX)= ! CALLED FROM GENALPHA, GALPHATOPRLG, GCHITOPRLG, AND GOMEGATOPSLG ! FUNCTION: ! PREDICATE INDICATING THAT 'NODELEX' HAS AN ESSENTIAL ! PREDECESSOR (SUCCESSOR) IN THE RANGE [LO,HI]. BEGIN MAP LEXEME NODELEX; BIND GTVEC NODEPTR=NODELEX; REGISTER STVEC LEX; IF .NODELEX[LTYPF] NEQ GTTYP THEN RETURN TRUE; IF .NODEPTR[NODEX] EQL SYNNULL THEN NODEPTR_.NODEPTR[CSPARENT]; NODEPTR_NONBOGUS(.NODEPTR); FORALLRANDS(I,.NODEPTR) (IF NOT GALOMBITS(.HI,.LO,.NODEPTR[OPERAND(.I)]) THEN RETURN FALSE); IF .NODEPTR[NODEX] EQL SDOTOP THEN BEGIN IF (LEX_FINDNAME(.NODEPTR[DOTTEDTHING])) LSS 0 THEN RETURN FALSE; ! SEE NOTE, BELOW IF SEARCHFORKILLS(.LEX,.HI,.LO,1) THEN RETURN FALSE; IF ABCBETW(.HI,.LO,.LEX[VCHGLSTF]) THEN RETURN FALSE END ELSE IF .NODEPTR[NODEX] EQL SSTOROP THEN BEGIN IF (LEX_FINDNAME(.NODEPTR[STOREDINTHING])) LSS 0 THEN RETURN FALSE ; ! SEE NOTE, BELOW IF SEARCHFORKILLS(.LEX,.HI,.LO,0) THEN RETURN FALSE; IF ABCBETW(.HI,.LO,.LEX[VUSELSTF]) THEN RETURN FALSE END; ! IN THE TWO CASES ABOVE, IT WOULD BE UNWISE TO SUBSTITUTE ! " ... THEN RETURN (NOT .MRKFLG);" FOR " ... THEN RETURN 0;". ! THE Q SWITCH TELLS THE COMPILER WHETHER "A_" HAS ANY EFFECT ! ON ".(.B+.C)"; BUT REGARDLESS OF WHETHER THE Q SWITCH IS ON, ! "(.B+.C)_" HAS AN EFFECT ON ".(.B+.C)" . SO WE DON'T WANT ! TO INDICATE, BY RETURNING 1 AT EITHER OF THE ABOVE POINTS, ! THAT THE CODE FOR .(.B+.C) CAN BE MOVED FORWARD OVER THE CODE ! FOR (.B+.C)_ . RETURN TRUE END; ROUTINE GOMEGATOPSLG(NODELEX)= ! EXAMINES AN OMEGA LIST FOR ENTRIES WHICH CAN BE ENTERED IN THE ! POSTLOG SET OF THE ENCLOSING LINEAR BLOCK BEGIN MAP LEXEME NODELEX; REGISTER LSTHDR HDR, ITEM L, LO; HDR_.NODELEX[ADDRF]; L_.HDR[BASE]; LO_.NODELEX[LEXABCF]; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN MACRO ITERATE=EXITBLOCK$; % 1 % ! IF NOT GALOMBITS(.ABCOUNT,.LO,FASTLEXOUT(GTTYP,.L[ITEMFPARENT])) % 2 % IF NOT GALOMBITS(.ABCOUNT,.LO,FASTLEXOUT(GTTYP,.L[LINTDATITEM(1)])) THEN ITERATE; ! % 1 % HAD TO BE REPLACED BY % 2 %, UNFORTUNATELY. THE PROBLEM IS ! THAT, IN A LIST ENTRY, THE 'ITEMFPARENT' AND 'ABCVAL' FIELDS ARE IN ! THE SAME PLACE. GENOMEGA FILLS THE LATTER, ZONKING THE FORMER, AND ! SINCE THIS ROUTINE DOESN'T GET CALLED TILL AFTER GENOMEGA, THE ! 'ITEMFPARENT' FIELD HAS TO BE CONSIDERED INVALID. THE SOLUTION TO ! THE PROBLEM IS THAT AN OMEGA LIST ENTRY IS MADE UP OF SEVERAL POSTLOG ! LIST ENTRIES, EACH OF WHICH HAS ITS OWN 'ITEMFPARENT' FIELD, AND ! ALL THESE FORMAL PARENTS ARE THE SAME AS THE FORMAL PARENT OF THE ! WHOLE OMEGA LIST ENTRY. ENLST(.CURPSLGLST[BASE],MAKITEM(.L[INTDATITEM(1)],1)) END; END; ROUTINE GALPHATOPRLG= ! EXAMINES AN ALPHA LIST FOR ENTRIES WHICH CAN BE ENTERED IN THE ! PROLOG SET OF THE ENCLOSING LINEAR BLOCK BEGIN REGISTER ITEM L, FPAR, HI; BIND LEXEME LEX=STK[.LASTMARK+1]; L_.ALPHDR[BASE]; HI_.LEX[LEXABCF]; WHILE (L_.L[RLINK]) NEQ .ALPHDR[BASE] DO BEGIN MACRO ITERATE=EXITBLOCK$; IF NOT GALOMBITS(.HI,.ABCBASE[CVAL],FPAR_FASTLEXOUT(GTTYP,.L[ITEMFPARENT])) THEN ITERATE; ENLST(.CURPRLGLST[BASE],MAKITEM(.FPAR^18 + 1^17 + .L,1)) END; END; ROUTINE GENPSLGBITS(NODELEX)= ! CALLED TO GENERATE PSLG-BITS FOR AN EXPRESSION IN A LINEAR BLOCK BEGIN REGISTER VAL, GTVEC L:NODEPTR, RANDVAL; MAP LEXEME NODELEX; NODEPTR_.NODELEX; VAL_-1; IF .NODELEX[LTYPF] EQL OMEGAT THEN (GOMEGATOPSLG(.NODELEX); RETURN 0); IF .NODELEX[LTYPF] NEQ GTTYP THEN RETURN .VAL; IF .NODEPTR[FLOLSTBIT] THEN RETURN 0; FORALLRANDS(I,.NODEPTR) BEGIN RANDVAL_GENPSLGBITS(.NODEPTR[OPERAND(.I)]); IF .NODEPTR[NODEX] EQL SYNCOMP THEN BEGIN IF .RANDVAL THEN IF .NODEPTR[OPERAND(.I)] EQL GTTYP THEN (L_.NODEPTR[OPERAND(.I)]; L[PSLGBIT]_1) END ELSE BEGIN TURNOFFPSLG(.NODEPTR[OPERAND(.I)]); IF NOT .RANDVAL THEN RETURN 0 END; VAL_.VAL AND .RANDVAL END; SELECT .NODEPTR[NODEX] OF NSET SYNPAR: VAL_0; SDOTOP: IF ISCHGED(1,.NODEPTR) THEN VAL_0; SSTOROP: IF ISUSED(1,.NODEPTR) THEN VAL_0 TESN; IF .VAL THEN (L_.NODEPTR[CSPARENT]; UNTIL (L_.L[CSTHREAD]) EQL 0 DO IF .L[NODEX] EQL SYNNULL THEN (VAL_NODEPTR[PSLGBIT]_0; EXITLOOP) ); IF .VAL THEN IF .NODEPTR[NODEX] NEQ SYNCOMP THEN NODEPTR[PSLGBIT]_.NODEPTR[CSP]; .VAL END; ROUTINE GENMUPSLGLST(NODELEX)= ! GENERATES THE POSTLOG SET FOR A LINEAR BLOCK (B) AND ! ALSO BUILDS THE SET: B-(PROLOG POSTLOG) WHICH IS ! CALLED THE MU LIST OF THE LINEAR BLOCK BEGIN MACRO IT=MAKITEM(.NODEPTR[FPARENT]^18 OR .NODELEX[ADDRF],1)$; MAP LEXEME NODELEX; REGISTER GTVEC NODEPTR; IF .NPTFLG THEN RETURN; NODEPTR_.NODELEX; IF .NODELEX[LTYPF] NEQ GTTYP THEN RETURN; IF .NODEPTR[FLOLSTBIT] THEN RETURN; IF .NODEPTR[PSLGBIT] THEN RETURN ENLST(.CURPSLGLST[BASE],IT); %%% IF .NODEPTR[CSP] THEN IF NOT .NODEPTR[PRLGBIT] THEN ENLST(.CURMULST[BASE],IT); %%% FORALLRANDS(I,.NODEPTR) GENMUPSLGLST(.NODEPTR[OPERAND(.I)]) END; ROUTINE GENEPLGLST(NODELEX)= ! GENERATES THE EPILOG SET FOR A LINEAR BLOCK BY DISCOVERING ALL ! AVAILABLE (I.E. UNMARKED) C-S-E'S. BEGIN MAP LEXEME NODELEX; REGISTER GTVEC L:LCS,F; BIND GTVEC NODEPTR=NODELEX; IF .NPTFLG THEN RETURN; IF .NODELEX[LTYPF] NEQ GTTYP THEN RETURN; F_.FLOOR[CVAL]; FORALLRATORS(I) BEGIN L_.GTHASH[.I]; UNTIL .L EQL 0 DO BEGIN MACRO ITERATE= L_.L[GTHREAD]; EXITBLOCK$; LCS_.L; DO IF NOT .LCS[PURGEBIT] THEN IF NOT .LCS[RM] THEN IF .LCS[CRLEVEL] GEQ .F THEN (ENLST(.CUREPLGLST[BASE],MAKITEM(.L^18 OR .LCS,1)); ITERATE) WHILE (LCS_.LCS[FSTHREAD]) NEQ 0; ITERATE END; END; END; GLOBAL ROUTINE INITSYMLSTS(S)= ! GENERATES CHANGE AND USE LIST HEADERS FOR THE DECLARED ! VARIABLES WHOSE SYMBOL TABLES ENTRY IS S. ALSO ENTERS ! USE AND CHANGE LIST ENTRIES TO PREVENT THE MOVE OF A ! VARIABLE REFERENCE BACKWARD PAST DECLARATION POINT. BEGIN MAP STVEC S; IF FAST THEN RETURN; IF .S[BLF] EQL 0 THEN RETURN; ! NO LISTS FOR 'OUTER BLOCK' ST ENTRIES S[VUSELSTF]_MAKHDR(VUSEREMOVE,VUSEENTER); S[VCHGLSTF]_MAKHDR(VCHGREMOVE,VCHGENTER); ENTVCHGLST(LEXOUT(BNDVAR,.S),0); ENTVUSELST(LEXOUT(BNDVAR,.S),0) END; GLOBAL ROUTINE ENTVUSELST(OPRND,GTINDEX)= ! ENTER VARIABLE USE LIST ! CALLED FROM: GENGT, INITSYMLSTS, F10, F11 ! ENTERS AN ITEM ON THE USE LIST OF THE NAME (IF ANY) INVOLVED ! IN THE EXPRESSION POINTED TO BY "OPRND" REFLECTING THE FACT THAT ! A REFERENCE TO THE VALUE OCCURED IN THE EXPRESSION ! "GTINDEX". THE FORM OF THE ENTRY IS: ABCOUNT,,GTINDEX. BEGIN REGISTER STVEC OPRNDPTR; IF (OPRNDPTR_FINDNAME(.OPRND)) LSS 0 THEN RETURN (IF .MRKFLG THEN KILL(3,.GTINDEX)); IF NOT ISSTVAR(OPRNDPTR) THEN RETURN; IF .OPRNDPTR[LSTWORD] EQL 0 THEN RETURN; ENLST(.OPRNDPTR[VUSELSTF],MAKITEM(.ABCOUNT^18 OR .GTINDEX,1)) END; GLOBAL ROUTINE ENTVCHGLST(OPRND,GTINDEX)= ! ENTER VARIABLE CHANGE LIST ! CALLED FROM: GENGT, INITSYMLSTS, F10, F11 ! SAME AS ENTVUSELST EXCEPT THAT THE NAME IN OPRND WAS THE ! TARGET OF A STORE. BEGIN REGISTER STVEC OPRNDPTR; IF (OPRNDPTR_FINDNAME(.OPRND)) LSS 0 THEN RETURN (IF .MRKFLG THEN KILL(2,.GTINDEX)); IF NOT ISSTVAR(OPRNDPTR) THEN RETURN; IF .OPRNDPTR[LSTWORD] EQL 0 THEN RETURN; ENLST(.OPRNDPTR[VCHGLSTF],MAKITEM(.ABCOUNT^18 OR .GTINDEX,1)) END; GLOBAL ROUTINE GENPRLG(NODEPTR)= ! GENERATE PRLG LIST AND BITS. ALWAYS CALLED WITH PTR TO GT-NODE BEGIN MACRO ISRELOP(X)=ONEOF(X,(BMSKX(SGTROP,6) OR BMSKX(SGTRUOP,6)))$; LOCAL LEXEME NODELEX; REGISTER GTVEC GTNODEPTR; IF FAST THEN RETURN; IF .NPTFLG THEN RETURN; GTNODEPTR_.NODEPTR; IF .GTNODEPTR[NODEX] GEQ SERROP THEN RETURN; IF ISRELOP(.GTNODEPTR[NODEX]) THEN RETURN; ! THIS IS A DECISION THAT OUGHT, REALLY, TO BE MADE IN DELAY. ! THE IDEA IS THAT RELATIONAL OPERATOR NODES AREN'T ALPHA- OR ! CHI-LISTED, BECAUSE THEY'RE USUALLY IN CONTEXTS WHERE IT'S ! CHEAPER TO PUT OUT A 'CMP' (OR 'TST') INSTRUCTION ON EACH ! BRANCH OF A FORK (OR IN A LOOP) THAN TO GENERATE A REAL ! RESULT (1 OR 0) BEFORE THE FORK (OUTSIDE THE LOOP). FORALLRANDS(I,.GTNODEPTR) BEGIN MACRO ITERATE=EXITBLOCK$; BIND GTVEC NODEPTR=NODELEX; NODELEX_.GTNODEPTR[OPERAND(.I)]; IF .NODELEX[LTYPF] NEQ GTTYP THEN ITERATE; IF .NODEPTR[FLOLSTBIT] THEN RETURN; IF .NODEPTR[PRLGBIT] THEN ITERATE ELSE RETURN END; SELECT .GTNODEPTR[NODEX] OF NSET SYNPAR: RETURN 0; SDOTOP: IF WASCHGED(.GTNODEPTR) THEN RETURN 0; SSTOROP: IF WASUSED(.GTNODEPTR) THEN RETURN 0 TESN; IF NOT .GTNODEPTR[CSP] THEN RETURN GTNODEPTR[PRLGBIT]_.GT[.GTNODEPTR[CSPARENT],PRLGBIT] OR (.GT[.GTNODEPTR[CSPARENT],ABCF] LEQ .ABCBASE[CVAL]); ENLST(.CURPRLGLST[BASE],MAKITEM(.GTNODEPTR[FPARENT]^18 OR .GTNODEPTR,1)); GTNODEPTR[PRLGBIT]_1 END; ROUTINE WISCHUSED(ZORONE,S,NODEPTR)= ! WAS-IS CHANGED-USED ... ! ARGUMENTS: ! NODEPTR: A _ NODE OR A . NODE ! ZORONE: ZERO OR ONE; VALID ONLY FOR "IS" CHANGED-USED. ! CALLED TO CHECK THE VCHGLST OR VUSELST WHEN A ELEMENT IS ! CONSIDERED FOR INSERTION ON A FLOLST ! S=0 --> WASUSED ! S=1 --> ISUSED ! S=2 --> WASCHGED ! S=3 --> ISCHGED BEGIN REGISTER STVEC LEX; MAP GTVEC NODEPTR; LOCAL HI,LO; IF (LEX_FINDNAME(.NODEPTR[OPR1])) LSS 0 THEN RETURN 1; IF NOT ISSTVAR(LEX) THEN RETURN 1; CASE .S MOD 2 OF SET (HI_.NODEPTR[ABCF]-1; LO_.ABCBASE[CVAL]); (HI_.ABCOUNT; LO_.NODEPTR[ABCF]+.ZORONE) TES; IF SEARCHFORKILLS(.LEX,.HI,.LO,.S/2) THEN RETURN 1; IF .LEX[LSTWORD] EQL 0 THEN RETURN 1; ABCBETW(.HI,.LO,CASE .S/2 OF SET .LEX[VUSELSTF];.LEX[VCHGLSTF] TES) END; ROUTINE ABCBETW(HI,LO,HDR)= ! ABCOUNT BETWEEN ! CALLED FROM GALOMBITS, WISCHUSED ! ATOMIC BLOCK COUNT BETWEEN ... ! PREDICATE INDICATING THERE IS AN ENTRY ON LIST HEADED BY HDR ! WHOSE ABCVAL IS IN THE CLOSED INTERVAL [LO,HI] BEGIN MAP LSTHDR HDR; REGISTER ITEM I; I_.HDR[RLINK]; HDR_.HDR[BASE]; WHILE .I NEQ .HDR DO BEGIN IF .I[ABCVAL] LSS .LO THEN RETURN 0; IF .I[ABCVAL] LEQ .HI THEN RETURN 1; I_.I[RLINK] END; 0 END; ROUTINE SEARCHFORKILLS(STVAR,HI,LO,USEORCHG)= ! ! SUPPLEMENTS THE ACTION OF 'ABCOUNT BETWEEN' BY LOOKING ! ON THE KILL LIST. ! ! ARGUMENTS: ! STVAR - THE VARIABLE WHOSE CHANGED OR USED STATUS IS IN QUESTION ! USEORCHG - BOOLEAN; TRUE IF CHANGE (RATHER THAN USE) IS BEING ! LOOKED FOR ! HI, LO - SEE 'ABCOUNT BETWEEN' ! ! KILL TYPES: ! 0 - A RETURN. A USE LIST ENTRY FOR ALL VARIABLES. ! 1 - A LEAVE. SAME AS A RETURN, BUT KILL LIST ENTRY ! DISAPPEARS WHEN SYNTAX PROCESSING FOR THE LABEL ENDS. ! 2 - STORE INTO CALCULATED ADDRESS (.A_EXPR). A CHANGE ! LIST ENTRY FOR ALL BUT REGISTER VARIABLES. ! 3 - FETCH FROM A CALCULATED ADDRESS (VAR_..A). A USE ! LIST ENTRY FOR ALL BUT REGISTER VARIABLES. ! 4 - A ROUTINE CALL. A CHANGE AND USE, FOR GLOBAL, ! EXTERNAL, AND OWN VARIABLES. ! 5 - AN INLINE. A CHANGE AND USE, FOR ALL VARIABLES. ! BEGIN REGISTER TYPE,ITEM I; MAP STVEC STVAR; I_.KILLST[BASE]; UNTIL (I_.I[RLINK]) EQL .KILLST[BASE] DO BEGIN IF .I[KABC] LSS .LO THEN RETURN 0; IF .I[KABC] LEQ .HI THEN BEGIN TYPE_.I[KTYPE]; IF .TYPE EQL 5 THEN RETURN 1; IF CASE .STVAR[TYPEF]-LOWNAMETYPE OF SET % LOCALT % IF .TYPE LEQ 3 THEN (.TYPE EQL 2 EQV .USEORCHG); % OWNT % .TYPE EQL 4 OR (.TYPE EQL 2 EQV .USEORCHG); % REGT % .TYPE LEQ 1 AND NOT .USEORCHG; % FORMALT % IF .TYPE LEQ 3 THEN (.TYPE EQL 2 EQV .USEORCHG); % EXTERNALT % .TYPE EQL 4 OR (.TYPE EQL 2 EQV .USEORCHG); % GLOBALT % .TYPE EQL 4 OR (.TYPE EQL 2 EQV .USEORCHG) TES THEN RETURN 1 END END; RETURN 0 END; ROUTINE GFWHILE= ! CALLED FROM: GFDOWHILE, F19 ! GENERATES EPILOG SET FOR WHILE EXPRESSION IN WHILE-DO CONSTRUCT BEGIN BIND GTVEC SYMPTR=SYM, FLOLSTPTR SYMLSTPTR=SYM; IF .SYM[LTYPF] NEQ GTTYP THEN RETURN; SYMPTR[FLOLSTF]_GETSPACE(GT,2); SYMLSTPTR[EPLGLSTF]_CUREPLGLST_MAKHDR(EPLGREMOVE,EPLGENTER); GENEPLGLST(.SYM); SYMPTR[FLOLSTBIT]_1 END; ROUTINE GFDOWHILE= ! CALLED FROM: F26 ! GENERATES EPILOG SET FOR COMBINED DO & WHILE EXPRESSIONS OF ! A DO-WHILE CONSTRUCT; IF "WHILE" EXPR. IS A NON-GRAPH-TABLE ! LEXEME, ATTACHES EPILOG LIST TO "DO" EXPRESSION. IF .SYM[LTYPF] EQL GTTYP THEN GFWHILE() ELSE BEGIN SYM_.STK[.TOS-1]; ! GET "DO" EXPRESSION GFWHILE(); SYM_.STK[.TOS] ! RETRIEVE "WHILE" EXPRESSION END; ROUTINE GFBRANCH= ! CALLED BY F4 ! CALLED AFTER EACH BRANCH OF A FORK ! GENERATES PROLOG, EPILOG, AND POSTLOG SETS FOR LINEAR BLOCK ! WHICH FORMS BRANCH IN FORKED CONSTRUCT BEGIN BIND GTVEC SYMPTR=SYM; BIND FLOLSTPTR SYMLSTPTR=SYM; IF .SYM[LTYPF] NEQ GTTYP THEN RETURN; SYMPTR[FLOLSTF]_GETSPACE(GT,2); SYMLSTPTR[PRLGLSTF]_.CURPRLGLST[BASE]; %%% SYMLSTPTR[MULSTF]_CURMULST[BASE]_MAKHDR(MUREMOVE,MUENTER); %%% SYMLSTPTR[PSLGLSTF]_CURPSLGLST[BASE]_MAKHDR(PSLGREMOVE,PSLGENTER); SYMLSTPTR[EPLGLSTF]_CUREPLGLST[BASE]_MAKHDR(EPLGREMOVE,EPLGENTER); IF SLOW THEN (GENPSLGBITS(.SYM); GENMUPSLGLST(.SYM); GENEPLGLST(.SYM)); SYMPTR[FLOLSTBIT]_1; END; ROUTINE GFLOOP= ! CALLED FROM F16, F17, F18 ! GENERATES PROLOG FOR LINEAR BLOCK WHICH FORMS BODY (AND ! PERHAPS PREDICATE) OF LOOPING CONSTRUCT BEGIN BIND GTVEC SYMPTR=SYM; BIND FLOLSTPTR SYMLSTPTR=SYM; IF .SYM[LTYPF] NEQ GTTYP THEN RETURN; SYMPTR[FLOLSTF]_GETSPACE(GT,2); SYMLSTPTR[PRLGLSTF]_.CURPRLGLST[BASE]; SYMPTR[FLOLSTBIT]_1; END; ROUTINE GENALOMLST(ALOMFLAG)= ! GENERATE ALPHA (ALOMFLAG=1) AND OMEGA SETS FOR FORKED CONTROL ! ENVIRONMENTS. ! AN ALPHA (OMEGA) ELEMENT FOR AN N-BRANCH FORK: ! 0: LLINK,,RLLINK ! 1: FORMAL-PARENT,,NUM-OF-BRANCHES ! AND N ENTRIES WHERE THE K-TH IS ! FORMAL-PARENT,,X ! AND WHERE IF HIGH ORDER (#17) BIT OF X IS ON THE X POINTS TO ! ANOTHER ALPHA ELEMENT ELSE X IS A NODE ON THE K-TH BRANCH. BEGIN REGISTER ITEM L, GTVEC NODE,HDR; BIND FLOLSTPTR NODE1=STK[.LASTMARK+3]; HDR_IF .ALOMFLAG THEN .ALPHDR[BASE] ELSE .OMEGHDR[BASE]; MAKINTLST(.TOS-(.LASTMARK+3), IF .ALOMFLAG THEN .NODE1[PRLGLSTF] ELSE .NODE1[PSLGLSTF], .HDR); IF .ALOMFLAG THEN NODE1[PRLGLSTF]_0 ELSE NODE1[PSLGLSTF]_0; INCR I FROM .LASTMARK+4 TO .TOS-1 DO BEGIN BIND FLOLSTPTR NXTNODE=STK[.I]; SORTFINT(.I-(.LASTMARK+2), .HDR, IF .ALOMFLAG THEN .NXTNODE[PRLGLSTF] ELSE .NXTNODE[PSLGLSTF]); IF .ALOMFLAG THEN NXTNODE[PRLGLSTF]_0 ELSE NXTNODE[PSLGLSTF]_0 END; END; ROUTINE GENALPHA= ! GENERATE THE ALPHA LIST FOR A FORKED CONTROL CONSTRUCT BEGIN REGISTER ITEM L, GTVEC M:NODE:ALPHNODE; LOCAL LEXEME RANDLEX,VAL,ITEM HDR:N; BIND LEXEME ALPHDRLEX=ALPHDR,INTITEM NLEX=N; GENALOMLST(TRUE); IF EMPTY(.ALPHDR) THEN RETURN; M_.STK[.LASTMARK+2]; ! ! AT THIS POINT 'M' HOLDS A POINTER TO THE BOOLEAN OF AN ! IF-THEN-ELSE EXPRESSION, OR THE CASE INDEX OF A CASE EXPRESSION. ! THE FOLLOWING CODE CHECKS WHETHER EACH ALPHA-LIST ENTRY HAS ! AN ESSENTIAL PREDECESSOR IN M. ! VAL_.M[ABCF]; HDR_.ALPHDR[BASE]; L_.HDR[RLINK]; WHILE .L NEQ .HDR DO IF NOT GALOMBITS(.VAL,.ALPHDRLEX[LEXABCF],FASTLEXOUT(GTTYP,.L[ITEMFPARENT])) THEN (L_.L[RLINK];RELITEM(.L[LLINK],.L[PRVITEMSIZEF])) ELSE L_.L[RLINK]; IF EMPTY(.ALPHDR) THEN RETURN; GALPHATOPRLG(); ! AT THIS POINT, THE CURRENT ALPHA LIST CONTAINS A BUNCH OF ENTRIES, ! SOME OF WHICH ARE POINTED TO BY PROLOG LIST ENTRIES, AND SOME OF ! WHICH CONTAIN POINTERS TO OTHER LIST ENTRIES RATHER THAN TO NODES. ! FOR GENALPHA'S OWN USE AND FOR DELAY, TNBIND, AND CODE, THE ALPHA ! LIST ENTRIES SHOULD ONLY CONTAIN POINTERS TO GT-NODES. THEREFORE ! THE FOLLOWING CODE MAKES A NEW COPY OF EACH ENTRY; THE OLD COPY IS ! STILL POINTED TO BY THE PROLOG LIST ENTRY (IF ANY), AND THE NEW ! COPY, WHICH REPLACES IT ON THE ALPHA LIST, HAS POINTERS ONLY TO NODES. L_.HDR[RLINK]; WHILE .L NEQ .HDR DO BEGIN LOCAL ITEM M; M_GETSPACE(.L[ITEMSIZEF]+2); M[LLINK]_M[RLINK]_.M[BASE]; M[DATITEM(1)]_.L[DATITEM(1)]; LINK(.M,.L[LLINK]); DELINK(.L); INCR I FROM 1 TO .L[ITEMSIZEF] DO BEGIN N_.L[RINTDATITEM(.I)]; IF NOT .NLEX[CHNHEAD] THEN GT[.N,PURGEBIT]_0 ELSE DO (N_.NLEX[INTCF]; N_.N[RINTDATITEM(1)] ) WHILE .NLEX[CHNHEAD]; M[RINTDATITEM(.I)]_.N END; L_.M[RLINK] END; ! END OF ABOVE NOTED CODE L_.HDR; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN ALPHNODE_.L[RINTDATITEM(1)]; VAL_0; INCR I FROM 2 TO .L[ITEMSIZEF] DO BEGIN NODE_.L[RINTDATITEM(.I)]; VAL_.VAL+.NODE[OCCF]; M_.ALPHNODE; UNTIL .M[CSTHREAD] EQL 0 DO M_.M[CSTHREAD]; M[CSTHREAD]_.NODE; M_.ALPHNODE[FPARENT]; UNTIL .M[FSTHREAD] EQL .NODE DO M_.M[FSTHREAD]; M[FSTHREAD]_.NODE[FSTHREAD]; NODE[FSTHREAD]_0; NODE[CSP]_0; NODE[MUSTGENCODE]_0; END; M_.ALPHNODE; UNTIL (M_.M[CSTHREAD]) EQL 0 DO M[CSPARENT]_.ALPHNODE; ALPHNODE[OCCF]_.ALPHNODE[OCCF] + .VAL; FORALLRANDS(I,.ALPHNODE) BEGIN BIND GTVEC RANDNODE=RANDLEX; RANDLEX_.ALPHNODE[OPERAND(.I)]; IF .RANDLEX[LTYPF] EQL GTTYP THEN BEGIN RANDNODE[OCCF]_.RANDNODE[OCCF]-(.L[ITEMSIZEF]-1); RANDNODE[ALPHABIT]_1 END; END; END; L_.ALPHDR[RLINK]; WHILE .L NEQ .ALPHDR[BASE] DO BEGIN NODE_.L[RINTDATITEM(1)]; L_.L[RLINK]; IF .NODE[ALPHABIT] THEN RELITEM(.L[LLINK],.L[PRVITEMSIZEF]) ELSE BEGIN N_.L[LLINK]; N[ABCVAL]_.NODE[ABCF]; DECR I FROM .N[ITEMSIZEF] TO 1 DO (M_.N[RINTDATITEM(.I)]; M[DONTUNLINK]_TRUE); ENLST(.ALPHDR,.N) END; END; WHILE (L_.L[RLINK]) NEQ .ALPHDR[BASE] DO BEGIN NODE_.L[RINTDATITEM(1)]; NODE[ALPHABIT]_1; END; END; ROUTINE OMEGDECR(NODE)= BEGIN MAP GTVEC NODE; REGISTER LEXEME RANDLEX, GTVEC L; BIND CSPPTR NODECSP=NODE; L_NONBOGUS(.NODE); FORALLRANDS(I,.L) BEGIN RANDLEX_.L[OPERAND(.I)]; IF .RANDLEX[LTYPF] EQL GTTYP THEN OMEGDECR(.RANDLEX); END; IF (NODECSP[OCCF]_.NODECSP[OCCF]-1) GTR 0 THEN IF .NODE[CSP] THEN IF NOT .NODE[ALPHABIT] THEN BEGIN L_.NODE; WHILE (L_.L[CSTHREAD]) NEQ 0 DO (NODE[OCCF]_.NODE[OCCF]-1;L[MUSTGENCODE]_1); END; END; ROUTINE OMEGHEADECR(NODE,DEPTH)= BEGIN MAP GTVEC NODE; REGISTER LEXEME RANDLEX, GTVEC L; BIND CSPPTR NODECSP=NODE; L_NONBOGUS(.NODE); FORALLRANDS(I,.L) BEGIN RANDLEX_.L[OPERAND(.I)]; IF .RANDLEX[LTYPF] EQL GTTYP THEN OMEGHEADECR(.RANDLEX,.DEPTH+1); END; IF .DEPTH GTR 0 THEN IF .NODECSP[OCCF] GTR 1 THEN IF .NODE[CSP] THEN BEGIN L_.NODE; WHILE (L_.L[CSTHREAD]) NEQ 0 DO (NODE[OCCF]_.NODE[OCCF]-1;L[MUSTGENCODE]_1) END; END; ROUTINE CHECKALPHA(NODE)= BEGIN MAP GTVEC NODE; LOCAL LEXEME OPND; IF .NODE[ALPHABIT] THEN RETURN TRUE; FORALLRANDS(I,.NODE) BEGIN OPND_.NODE[OPERAND(.I)]; IF .OPND[LTYPF] EQL GTTYP THEN IF CHECKALPHA(.OPND) THEN RETURN TRUE; END; FALSE END; ROUTINE GENOMEGA= ! GENERATE THE OMEGA LIST FOR A FORKED CONTROL CONSTRUCT BEGIN LOCAL ITEM L:L2, GTVEC OMEGNODE:SRCNODE:NODE, SIZE; GENALOMLST(FALSE); IF NOT EMPTY(.OMEGHDR) THEN BEGIN L_.OMEGHDR[BASE]; WHILE (L_.L[RLINK]) NEQ .OMEGHDR[BASE] DO BEGIN MACRO ITERATE=EXITBLOCK$; OMEGNODE_.L[RINTDATITEM(1)]; IF CHECKALPHA(.OMEGNODE) THEN BEGIN SIZE_.L[ITEMSIZEF]; L_.L[LLINK]; RELITEM(.L[RLINK],.SIZE); ITERATE END; INCR I FROM 1 TO .L[ITEMSIZEF] DO BEGIN SRCNODE_.L[RINTDATITEM(.I)]; IF (L2_.SRCNODE[INNEROMEGENT]) NEQ 0 THEN BEGIN SIZE_.L2[ITEMSIZEF]; INCR K FROM 2 TO .SIZE DO (NODE_.L2[RINTDATITEM(.K)]; NODE[MUSTGENCODE]_0); RELITEM(.L2,.SIZE) END END; INCR I FROM 2 TO .L[ITEMSIZEF] DO BEGIN NODE_.L[RINTDATITEM(.I)]; OMEGDECR(.NODE); NODE[OMEGABIT]_1; END; OMEGHEADECR(.OMEGNODE,0); OMEGNODE[OMEGABIT]_1; END; L_.OMEGHDR[RLINK]; WHILE .L NEQ .OMEGHDR[BASE] DO BEGIN OMEGNODE_.L[RINTDATITEM(1)]; OMEGNODE[INNEROMEGENT]_.L; L[ABCVAL]_.OMEGNODE[ABCF]; L_.L[RLINK]; ENLST(.OMEGHDR,DELINK(.L[LLINK])) END; END; L_.ALPHDR[BASE]; WHILE (L_.L[RLINK]) NEQ .ALPHDR[BASE] DO BEGIN NODE_.L[RINTDATITEM(1)]; NODE[ALPHABIT]_0 END; END; ROUTINE GPOSTFORK= ! CALLED AT END OF FORKED CONTROL STRUCURE TO COMPUTE ALPHA, ! OMEGA LISTS AS WELL AS GENERATE BOGUS NODES FOR THOSE ! C-S-E'S WHICH WERE MADE AVAILABLE BY FORKED EXPRESSIONS. BEGIN REGISTER LEXEME NODELEX,ALLGT; IF FAST THEN RETURN; IF (.TOS - .LASTMARK) LSS 5 THEN RETURN; ALPHDR_.STK[.LASTMARK+1]; OMEGHDR_.STK[.TOS]; ALLGT_ INCR I FROM .LASTMARK+3 TO .TOS-1 DO BEGIN NODELEX_.STK[.I]; IF .NODELEX[LTYPF] NEQ GTTYP THEN EXITLOOP 0 END; IF .ALLGT THEN BEGIN GENALPHA(); GENOMEGA(); GENPSI(); GCSEFROMPSI(); END; END; ROUTINE PSIINT(NXTHDR)= ! CALLED FROM: GENPSI ! VERY SIMILAR IN PURPOSE, STRUCTURE TO SORTFINT (SEE LSTPKG). ! PURPOSE: "GROWS" PSI LIST AND PCS CHAINS ! ARGUMENT: NXTHDR - HEADER OF AN EPILOG LIST ! LOCALS: ! PPSI - CURRENT LIST ENTRY FROM PSI LIST ! PNXT - CURRENT LIST ENTRY FROM EPILOG LIST (NXTHDR) ! VALPSI,VALNXT - EPILOG LISTS ARE SORTED BY THEIR 'ITEMFPARENT' ! FIELDS, AND THESE ARE THE 'ITEMFPARENT'S OF ! PPSI AND PNXT, RESPECTIVELY. ! BEGIN REGISTER ITEM PPSI:PNXT,VALPSI,VALNXT; LOCAL NL,GTVEC L; MAP LSTHDR PSIHDR:NXTHDR; ROUTINE PSIENTER(I)= BEGIN REGISTER GTVEC T; MAP GTVEC I; LOCAL NI; IF NOT .I[CSP] THEN RETURN PSIENTER(.I[CSPARENT]); T_.PPSI[RDATITEM(1)]; DO BEGIN NI_.I[PCSTHREAD]; DO BEGIN IF .T EQL .I THEN EXITLOOP; IF .T[PCSTHREAD] EQL 0 THEN EXITLOOP(T[PCSTHREAD]_.I;I[PCSTHREAD]_0;T_.PPSI[RDATITEM(1)]); T_.T[PCSTHREAD] END WHILE 1; END UNTIL (I_.NI) EQL 0; END; MACRO UDPSI= ! GET NEXT PSI,VALPSI (PPSI_.PPSI[RLINK]; VALPSI_.PPSI[ITEMFPARENT])$; MACRO UDNXT= ! GET NEXT PNXT,VALNXT (IF (PNXT_.PNXT[RLINK]) EQL .NXTHDR THEN VALNXT_0 ELSE VALNXT_.PNXT[ITEMFPARENT])$; PPSI_.PSIHDR; PNXT_NXTHDR_.NXTHDR[BASE]; UDPSI; UDNXT; WHILE .PPSI NEQ .PSIHDR DO BEGIN MACRO ITERATE=EXITBLOCK$; IF .VALPSI EQL .VALNXT THEN ! ADD A NEW ENTRY TO THE PSI LIST BEGIN PSIENTER(.PNXT[RDATITEM(1)]); UDPSI; UDNXT; ITERATE END; IF .VALPSI GTR .VALNXT THEN ! NO FORMAL COPY OF THE NODE POINTED TO BY PPSI IS ON THE ! EPILOG LIST (POINTED TO BY NXTHDR). THE PCSTHREAD CHAIN ! THAT HAS BEEN BUILT HANGING OFF THAT NODE IS BROKEN; NOTE ! THAT IF SOME NODE 'L' ON THAT CHAIN IS ITSELF 'BOGUS', I.E. ! HAS AN ALREADY-BUILT PCS CHAIN OF ITS OWN THAT MUST NOT BE ! BROKEN DURING THIS PROCESS, L'S 'END OF PCS' FIELD POINTS ! TO THE END OF THAT CHAIN. BEGIN DO ( L_.PPSI[RDATITEM(1)]; WHILE .L NEQ 0 DO BEGIN IF .L[BOGUSBIT] THEN IF .L[ENDOFPCS] NEQ 0 THEN L_.L[ENDOFPCS]; NL_.L[PCSTHREAD]; L[PCSTHREAD]_0; L_.NL END; UDPSI; RELITEM(.PPSI[LLINK],2); IF .PPSI EQL .PSIHDR THEN EXITLOOP[2]) UNTIL .VALPSI LEQ .VALNXT; ITERATE END; DO UDNXT UNTIL .VALNXT LEQ .VALPSI END; END; ROUTINE GENPSI= BEGIN BIND FLOLSTPTR NODE1=STK[.LASTMARK+3]; PSIHDR_.NODE1[EPLGLSTF]; NODE1[EPLGLSTF]_0; INCR I FROM .LASTMARK+4 TO .TOS-1 DO BEGIN BIND FLOLSTPTR NXTNODE=STK[.I]; PSIINT(.NXTNODE[EPLGLSTF]); RELLST(.NXTNODE[EPLGLSTF]); NXTNODE[EPLGLSTF]_0 END; END; ROUTINE CHANGEFPAR(FORMER,BOGUS)= ! ! CALLED FROM: G CSE FROM PSI ! ASSUMES THAT FORMER IS THE FORMAL PARENT OF BOGUS, ! AND THAT .FORMER[FSTHREAD] == .BOGUS; CAUSES THE TWO ! NODES TO SWITCH PLACES IN THE GT HASH TABLE. ! BEGIN MAP GTVEC FORMER:BOGUS; LOCAL GTVEC L:M; L_.GTHASH[.FORMER[NODEX]]; IF .L EQL .FORMER THEN GTHASH[.FORMER[NODEX]]_.BOGUS ELSE (UNTIL .L[GTHREAD] EQL .FORMER DO L_.L[GTHREAD]; L[GTHREAD]_.BOGUS); BOGUS[GTHREAD]_.FORMER[GTHREAD]; FORMER[FSTHREAD]_.BOGUS[FSTHREAD]; BOGUS[FSTHREAD]_.FORMER; L_.BOGUS; DO BEGIN M_.L; DO M[FPARENT]_.BOGUS UNTIL (M_.M[CSTHREAD]) EQL 0 END UNTIL (L_.L[FSTHREAD]) EQL 0 END; ROUTINE GCSEFROMPSI= BEGIN REGISTER ITEM L, GTVEC BOGNODE:FNODE:CNODE; L_.PSIHDR; WHILE (L_.L[RLINK]) NEQ .PSIHDR DO BEGIN MACRO ITERATE=EXITBLOCK$; LOCAL GTVEC M, ITEM I, LEXEME X; CNODE_.L[CHAINF]; IF NOT .CNODE[PURGEBIT] ! CATCH (AND THROW OUT) NODES THAT WERE THEN IF NOT .CNODE[RM] ! CREATED BEFORE THE FORK, AND WERE NOT THEN ITERATE; ! INVALIDATED ON ANY BRANCH. IF .CNODE[NODEX] EQL SDOTOP ! CATCH (AND THROW OUT) NODES THEN IF NOT .CNODE[BOGUSBIT] ! OF THE FORM '.VARIABLE'. THEN (X_.CNODE[OPR1]; IF .X[LTYPF] NEQ GTTYP THEN ITERATE); I_.ALPHDR[BASE]; ! CATCH (AND THROW OUT) NODES UNTIL (I_.I[RLINK]) EQL .ALPHDR[BASE] ! ON THE CURRENT ALPHA-LIST. DO BEGIN M_.CNODE; DO (DECR J FROM .I[ITEMSIZEF] TO 1 DO (IF .M EQL .I[RINTDATITEM(.J)] THEN ITERATE)) UNTIL (M_.M[PCSTHREAD]) EQL 0; END; MARKSTK(); FNODE_.L[ITEMFPARENT]; BOGNODE_MAKGT(-.FNODE,.FNODE[NODEX]); ! 'FPARSEARCH' MUST ENCOUNTER 'BOGNODE' BEFORE IT ENCOUNTERS ! ANY OF THE BRANCH NODES; THEREFORE, THE FOLLOWING CHECK IS ! MADE, AND IF ANY OF THE BRANCH NODES IS FORMAL PARENT OF THE ! REST OF THEM, IT CHANGES PLACE IN THE GT-HASH TABLE WITH ! 'BOGNODE'. M_.CNODE; DO (IF .M EQL .FNODE THEN EXITLOOP CHANGEFPAR(.M,.BOGNODE)) UNTIL (M_.M[PCSTHREAD]) EQL 0; ENLST(.CURBOGLST,MAKITEM(.BOGNODE,1)); BOGNODE[BOGUSBIT]_1; BOGNODE[OCCF]_0; BOGNODE[PCSTHREAD]_.CNODE; FNODE_.CNODE; UNTIL .FNODE[PCSTHREAD] EQL 0 DO FNODE_.FNODE[PCSTHREAD]; BOGNODE[ENDOFPCS]_.FNODE; CNODE[CRLEVEL]_.LEVEL; CNODE[PURGEBIT]_CNODE[RMMM]_0 END; RELLST(.PSIHDR) END; ROUTINE FINDPRELOOPCSE(NODE)= ! ! CALLED FROM: BIND LOOP CSE ! ARGUMENT: NODE - A GT NODE WITHIN THE CURRENT LOOP ! VALUE RETURNED: IF THE NODE HAS A CSE PARENT OUTSIDE THE LOOP, ! RETURN A POINTER TO THE CSE PARENT; OTHERWISE -1. ! BEGIN REGISTER GTVEC L, NEXTFLOOR,THISFLOOR; MAP GTVEC NODE; L_.NODE[FPARENT]; THISFLOOR_.FLOOR[CVAL]; NEXTFLOOR_.FLOOR[NVAL]; DO IF NOT .L[RM] THEN IF NOT .L[PURGEBIT] THEN IF .L[CRLEVEL] LSS .THISFLOOR THEN IF .L[CRLEVEL] GEQ .NEXTFLOOR THEN RETURN .L WHILE (L_.L[FSTHREAD]) NEQ 0 END; ROUTINE REMOVEFROMPRLG(X)= ! ! CALLED FROM: BIND LOOP CSE ! ARGUMENT: X - A GT NODE IN THE CURRENT LOOP, FOR WHICH A ! CSE PARENT HAS JUST BEEN FOUND OUTSIDE THE LOOP. ! PURPOSE: TAKE X OFF THE PROLOG OF THE CURRENT LINEAR BLOCK (IF IT'S ON). ! BEGIN MAP GTVEC X; REGISTER FPAR, ITEM L; FPAR_.X[FPARENT]; L_.CURPRLGLST[BASE]; WHILE (L_.L[RLINK]) NEQ .CURPRLGLST[BASE] DO IF .L[ITEMFPARENT] EQL .FPAR THEN RETURN RELITEM(.L,2) END; ROUTINE BINDLOOPCSE= ! ! CALLED FROM: GPOSTWDW, GPOSTREP ! PURPOSE: ! FOR EVERY NODE CREATED IN THE CURRENT LOOP, TRY TO FIND ! A CSPARENT OUTSIDE THE LOOP, AND IF IT IS FOUND, RESET ! ALL THE APPROPRIATE 'CSTHREAD','CSPARENT',ETC. FIELDS. ! BEGIN REGISTER GTVEC L:LFP:LC:L1; LOCAL A,F,GTVEC M; F_.FLOOR[CVAL]; A_.ABCBASE[CVAL]; FORALLRATORS(I) BEGIN LFP_.GTHASH[.I]; WHILE .LFP NEQ 0 DO BEGIN M_.LFP; WHILE (M_L_.M[FSTHREAD]) NEQ 0 DO BEGIN IF .L[CRLEVEL] GEQ .F THEN IF .L[ABCF] GEQ .A THEN IF NOT .L[RM] THEN IF (LC_FINDPRELOOPCSE(.L)) GTR 0 THEN BEGIN IF .LC[BOGUSBIT] THEN IF .LC[OCCF] EQL 0 THEN BINDPCSTHREAD(.LC); IF .L[BOGUSBIT] THEN IF .L[OCCF] GTR 0 THEN BEGIN L[RM]_1; L[MKLEVEL]_0; L1_.L[CSTHREAD]; DO ! RESET 'CSPARENT' FIELDS OF CSE USES BEGIN L1[CSPARENT]_.LC; L1[GTLDF]_.LC[XGTLDF]; L1[MUSTGENCODE]_0; IF .L1[CSTHREAD] EQL 0 THEN EXITLOOP; L1_.L1[CSTHREAD] END WHILE 1; L1[CSTHREAD]_.LC[CSTHREAD]; LC[CSTHREAD]_.L[CSTHREAD]; L[CSTHREAD]_0; LC[OCCF]_.LC[OCCF]+.L[OCCF]; DECROCC(.LC) END ELSE (L[RM]_1; L[MKLEVEL]_0) ELSE BEGIN L1_.L; DO ! RESET 'CSPARENT' FIELDS OF CSE USES BEGIN L1[CSPARENT]_.LC; IF .L1[CSTHREAD] EQL 0 THEN EXITLOOP; L1_.L1[CSTHREAD]; L1[GTLDF]_.LC[XGTLDF] END WHILE 1; L[MUSTGENCODE]_0; BEGIN ! PUT 'L' AT END OF CSE CHAIN OF 'LC' MACRO ABORT=EXITBLOCK$; L1_.LC; WHILE .L1[CSTHREAD] NEQ 0 DO IF .L1[CSTHREAD] EQL .L THEN ABORT ELSE L1_.L1[CSTHREAD]; L1[CSTHREAD]_.L; END; L1_.LFP; BEGIN ! TAKE 'L' OFF CHAIN OF CSE PARENTS MACRO ABORT=EXITBLOCK$; WHILE .L1[FSTHREAD] NEQ .L DO IF (L1_.L1[FSTHREAD]) EQL 0 THEN (L1_.L; ABORT); L1[FSTHREAD]_.L[FSTHREAD]; L[FSTHREAD]_0; END; LC[OCCF]_.LC[OCCF]+.L[OCCF]; DECROCC(.LC); M_.L1 END; REMOVEFROMPRLG(.L); L[GTLDF]_.LC[XGTLDF]; END; END; LFP_.LFP[GTHREAD]; END; END; END; ROUTINE ISCHI(INT)= BEGIN MAP INTITEM INT; IF .INT[CHNHEAD] THEN BEGIN BIND ITEM I=INT; I_.INT[INTCF]; DECR J FROM .I[ITEMSIZEF] TO 1 DO IF NOT ISCHI(.I[RDATITEM(.J)]) THEN RETURN 0; RETURN 1 END ELSE BEGIN BIND GTVEC NODE=INT; IF NOT (.NODE[RM] OR .NODE[PURGEBIT]) THEN (BIND CSPPTR NODEPTR=NODE; IF NOT (.NODEPTR[RM] OR .NODEPTR[PURGEBIT]) THEN RETURN 1); RETURN 0 END; END; MACRO ENCHI(L)=ISCHI(L[RDATITEM(1)])$; ROUTINE ENRHO(L)= ! ! VALUE: IF Z AND LFP TOGETHER BELONG ON RHO LIST OF CURRENT LOOP, ! RETURN LFP; IF NO SUCH LFP CAN BE FOUND, RETURN -1. ! BEGIN REGISTER GTVEC LFP,F; MAP ITEM L; LOCAL LEXEME Z; LFP_.L[ITEMFPARENT]; F_.FLOOR[CVAL]; Z_.GT[NONBOGUS(.LFP),OPR1]; IF .LFP[NODEX] EQL SDOTOP THEN IF .Z[LTYPF] EQL BNDVAR THEN RETURN -1; DO IF NOT (.LFP[RM] OR .LFP[PURGEBIT]) THEN IF .LFP[CRLEVEL] GEQ .F THEN RETURN .LFP WHILE (LFP_.LFP[FSTHREAD]) NEQ 0 END; ROUTINE GENCHIRHOLST= ! GENERATE THE CHI AND RHO LISTS FOR A LOOP CONTROL CONSTRUCT BEGIN REGISTER ITEM L, LSTHDR HDR, GTVEC NODE; LOCAL LEXEME RANDLEX,ITEM LC; BIND INTITEM LCLEX=LC; L_.CURPRLGLST[BASE]; WHILE (L_.L[RLINK]) NEQ .CURPRLGLST[BASE] DO IF ENCHI(.L) THEN ENLST(.CHIHDR[BASE], MAKITEM(.L[DATITEM(1)],1)) ELSE IF (LC_ENRHO(.L)) GTR 0 THEN ENLST(.RHOHDR[BASE], MAKITEM(.L[DATITEM(1)],.LC,2)); HDR_L_.CHIHDR[BASE]; ! SEE SIMILAR CODE (AND EXPLANATION) IN GENALPHA WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN LC_.L[RDATITEM(1)]; WHILE .LCLEX[CHNHEAD] DO (LC_.LCLEX[INTCF]; LC_.LC[RINTDATITEM(1)]); L[RDATITEM(1)]_.LC END; HDR_L_.RHOHDR[BASE]; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN LC_.L[RDATITEM(1)]; WHILE .LCLEX[CHNHEAD] DO (LC_.LCLEX[INTCF]; LC_.LC[RINTDATITEM(1)]); L[RDATITEM(1)]_.LC END; L_.HDR; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN NODE_.L[RDATITEM(1)]; FORALLRANDS(I,.NODE) BEGIN BIND GTVEC RANDNODE=RANDLEX; RANDLEX_.NODE[OPERAND(.I)]; IF .RANDLEX[LTYPF] EQL GTTYP THEN RANDNODE[RHOBIT]_1; END; END; L_.HDR[RLINK]; WHILE .L NEQ .HDR DO BEGIN NODE_.L[RDATITEM(1)]; L_.L[RLINK]; IF NOT .NODE[RHOBIT] THEN BEGIN L[PRVABCVAL]_.NODE[ABCF]; ENLST(.HDR,DELINK(.L[LLINK])) END ELSE (NODE_.L[PRVDATITEM(2)]; NODE[RHOBIT]_1;RELITEM(.L[LLINK],3)); END; END; ROUTINE GCHITOPRLG= ! ! CALLED FROM: F16, F17, F18 ! SEE GALPHATOPRLG ! BEGIN REGISTER ITEM L, LSTHDR HDR, GTVEC NODE, HI; LOCAL LEXEME RANDLEX; BIND LEXEME LEX=CHIHDR; IF .NOTREE THEN RETURN; L_HDR_.CHIHDR[BASE]; HI_.LEX[LEXABCF]; WHILE (L_.L[RLINK]) NEQ .HDR[BASE] DO BEGIN MACRO ITERATE=EXITBLOCK$; IF NOT GALOMBITS(.HI,.ABCBASE[CVAL],FASTLEXOUT(GTTYP,.L[ITEMFPARENT])) THEN ITERATE; ENLST(.CURPRLGLST[BASE],MAKITEM(.L[DATITEM(1)],1)) END; L_.HDR; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN NODE_.L[RDATITEM(1)]; FORALLRANDS(I,.NODE) BEGIN BIND GTVEC RANDNODE=RANDLEX; RANDLEX_.NODE[OPERAND(.I)]; IF .RANDLEX[LTYPF] EQL GTTYP THEN RANDNODE[CHIBIT]_1 END; END; L_.HDR[RLINK]; ! REVALIDATE ALL NODES ON THE CHI LIST. ! ALSO SEE OPENWUCSE WHILE .L NEQ .HDR DO BEGIN NODE_.L[DATITEM(1)]; NODE[CRLEVEL]_.CHILEVEL; NODE[JRMMBITS]_0; NODE[PURGEBIT]_0; L_.L[RLINK]; IF .NODE[CHIBIT] THEN RELITEM(.L[LLINK],2) ELSE BEGIN L[PRVABCVAL]_.NODE[ABCF]; ENLST(.HDR,DELINK(.L[LLINK])) END; END; END; ROUTINE OPENWUCSE(WHICHTYPE)= ! ! CALLED FROM: F16, F18 ! CALLED WHEN: AFTER WHILE-DO,UNTIL-DO,DO-WHILE,DO-UNTIL LOOP ! PURPOSE: ! TAKE ALL NODES THAT 1. WERE CREATED IN THE LOOP ! 2. WERE NOT INVALIDATED AFTER CREATION ! 3. MUST BE EXECUTED AT LEAST ONCE ! (I.E. FOR A WHILE-DO LOOP, THE EPILOGUE LIST OF THE WHILE PART; ! FOR A DO-WHILE LOOP, THE EPILOGUE LIST OF THE ENTIRE LOOP) ! (N.B. THE SAME LISTS THAT WERE CREATED BY GFWHILE,GFDOWHILE) ! AND REVALIDATES THE NODES, LOWERING THEIR CRLEVEL VALUES ! TO MAKE THEM LOOK AS IF THEY WERE CREATED OUTSIDE THE LOOP. ! ARGUMENT: WHICHTYPE - TRUE FOR DO-WHILE,DO-UNTIL ! FALSE FOR WHILE-DO,UNTIL-DO ! BEGIN BIND GTVEC SYMPTR=SYM, FLOLSTPTR SYMLSTPTR=SYM; LOCAL LEXEME LEX; REGISTER ITEM L, LSTHDR HDR, GTVEC LCP; BIND FLOLSTPTR LPTR=LEX; IF .NOTREE THEN RETURN; IF .WHICHTYPE THEN (LEX_.SYMPTR[OPR4]; IF .LEX[LTYPF] NEQ GTTYP THEN LEX_.SYMPTR[OPR3]) ELSE LEX_.SYMPTR[OPR3]; IF .LEX[LTYPF] NEQ GTTYP THEN RETURN; L_HDR_.LPTR[EPLGLSTF]; WHILE (L_.L[RLINK]) NEQ .HDR DO BEGIN LCP_.L[RDATITEM(1)]; DO BEGIN MACRO ITERATE=EXITBLOCK$; LCP_.LCP[CSPARENT]; IF .LCP[PURGEBIT] THEN ITERATE; IF .LCP[CRLEVEL] LSS .LEVEL THEN ITERATE; IF .LCP[RM] THEN LCP[MM]_1; LCP[RM]_0; LCP[CRLEVEL]_.LEVEL; LCP[XGTLDF]_.LOOPDEPTH; EXITLOOP END WHILE (LCP_.LCP[FSTHREAD]) NEQ 0 END; RELLST(.LPTR[EPLGLSTF]); LPTR[EPLGLSTF]_0; END; ROUTINE GPOSTWDW= ! ! CALLED FROM: F16, F18 ! CALLED WHEN: A WHILE OR UNTIL LOOP HAS BEEN PARSED ! BEGIN BIND GTVEC SYMPTR=SYM, FLOLSTPTR SYMLSTPTR=SYM; IF .NOTREE THEN RETURN; BINDLOOPCSE(); CHIHDR_.SYMPTR[OPR2]; RHOHDR_.SYMPTR[OPR1]; GENCHIRHOLST(); RELLST(.CURPRLGLST); IF .SYM[LTYPF] EQL GTTYP THEN SYMLSTPTR[PRLGLSTF]_0; END; ROUTINE REMOVELEAVEKILLS(LABNODE)= ! ! CALLED BY: F25 ! CALLED WHEN: A LABELED EXPRESSION HAS BEEN PARSED ! PURPOSE: ! REMOVE TYPE 1 KILLS CAUSED BY "LEAVE"S TO THAT LABEL ! FROM THE KILL LIST. ! BEGIN MAP GTVEC LABNODE; REGISTER ITEM I,GTVEC NODE; I_.KILLST[BASE]; UNTIL (I_.I[RLINK]) EQL .KILLST[BASE] DO BEGIN MACRO CONTINUE=EXITBLOCK$; IF .I[KABC] LSS .ABCOUNT THEN RETURN; IF .I[KTYPE] NEQ 1 THEN CONTINUE; NODE_.I[KCAUSE]; IF .NODE[OPR2] NEQ .LABNODE[OPR2] THEN CONTINUE; I_.I[LLINK]; RELEASESPACE(GT,DELINK(.I[RLINK]),2) END END; ROUTINE BYTOCHK(N)= ! ! I'M NOT SURE THERE'S ANY JUSTIFICATION FOR THIS ROUTINE. ! CALLED BY GPOSTREP; SETS THE CKF FIELD OF THE REQUEST ! WORD PASSED (IN "DELAY") TO THE 'BY' OR 'TO' PARTS OF ! AN INCR-DECR LOOP. ! BEGIN MAP GTVEC N; BIND LEXEME L=N; BIND OPERNDK=1^34, TEMPK=3^34; ! CAUTION, COPIED FROM DELAY IF .L[LTYPF] NEQ GTTYP THEN .N+OPERNDK ELSE IF .N[RMMM] EQL 0 THEN .N+OPERNDK ELSE .N+TEMPK END; ROUTINE GPOSTREP= ! ! CALLED FROM: F17 ! CALLED WHEN: AN INCR-DECR LOOP HAS BEEN PARSED ! BEGIN BIND GTVEC SYMPTR=SYM, FLOLSTPTR SYMLSTPTR=SYM; IF .NOTREE THEN RETURN; BINDLOOPCSE(); CHIHDR_.STK[.TOS-1]; RHOHDR_.STK[.TOS-2]; STK[.TOS-3]_BYTOCHK(.STK[.TOS-3]); STK[.TOS-4]_BYTOCHK(.STK[.TOS-4]); GENCHIRHOLST(); RELLST(.CURPRLGLST); IF .SYM[LTYPF] EQL GTTYP THEN SYMLSTPTR[PRLGLSTF]_0 END; MACRO LSTLEXOUT(T,A)=(.ABCOUNT^23 OR T^18 OR A)$, PUSHALPHA=PUSH(LSTLEXOUT(ALPHAT,MAKHDR(ALPHAREMOVE,ALPHAENTER)))$, ! CALLED FROM F20 PUSHRHO=PUSH(LSTLEXOUT(RHOT,MAKHDR(RHOREMOVE,RHOENTER)))$, ! CALLED FROM F1, F10 PUSHCHI=PUSH(LSTLEXOUT(CHIT,MAKHDR(CHIREMOVE,CHIENTER)))$, ! CALLED FROM F1, F10 PUSHOMEGA=PUSH(LSTLEXOUT(OMEGAT,MAKHDR(OMEGAREMOVE,OMEGAENTER)))$; ! CALLED FROM F5 SWITCHES GLOROUTINES; ROUTINE F0= PUSHANDBUMP(CEILING); ! CALLED FROM F15, F19 ROUTINE F1= (PUSHANDBUMP(FLOOR); PUSHFLO(); PUSHRHO; PUSHCHI); ROUTINE F2= KILL(0,.SYM[ADDRF]); ROUTINE F3= (KILL(5,.SYM[ADDRF]); MARKALL(TRUE)); ROUTINE F4= (MARKMMNODES(); GFBRANCH(); POPFLO(); REFRESH()); ROUTINE F5= (PUSHOMEGA; MARKUPDATE(); POPANDDUMP(CEILING); MARKMMNODES(); GPOSTFORK()); ROUTINE F6= (PURGE(); ! CALLED FROM F18,F23 MARKUPDATE(); POPANDDUMP(CEILING); POPANDDUMP(FLOOR)); ROUTINE F7= (PURGE(); MARKUPDATE(); POPANDDUMP(CEILING); MARKMMNODES()); ROUTINE F8= PUSHFLO(); ROUTINE F9= MARKMMNODES(); ROUTINE F10=(PUSHANDBUMP(FLOOR); PUSHANDBUMP(CEILING); ENTVUSELST(.STK[.LASTMARK+1],0); ENTVCHGLST(.STK[.LASTMARK+1],0); PUSHFLO(); PUSHRHO; PUSHCHI); ROUTINE F11= BEGIN REGISTER GTVEC L:LFP:B:Q; BIND GTVEC SYMPTR=SYM; ROUTINE MLST(L)=(MAP STVEC L; DO MRK(.L) WHILE (L_.L[FSTHREAD]) NEQ 0; NOVALUE); IF FAST THEN RETURN; IF .NOTREE THEN RETURN; FORALLRANDS(I,.SYMPTR) IF (Q_FINDNAME(.SYMPTR[OPERAND(.I)])) GEQ 0 THEN BEGIN MRKDOTNODES(.Q); ENTVCHGLST(.Q,.SYM); ENTVUSELST(.Q,.SYM); END; LFP_.GTHASH[SDOTOP]; WHILE .LFP NEQ 0 DO BEGIN B_NONBOGUS(.LFP); IF (Q_FINDNAME(.B[OPR1])) GEQ 0 THEN (IF NOT .Q[NOUPLEVEL] THEN IF ISSTVAR(Q) THEN MLST(.LFP)) ELSE IF .MRKFLG THEN MLST(.LFP); LFP_.LFP[GTHREAD] END; KILL(4,.SYM[ADDRF]) END; ROUTINE F12= BEGIN LOCAL GTVEC L; PUSHFLO(); PUSHCURBOGLST; IF FAST THEN RETURN NOVALUE; L_GETSPACE(GT,MAXDELIMITER+2); MOVECORE(GTHASH,.L,MAXDELIMITER+1); CLEARCORE(GTHASH,MAXDELIMITER+1); L[MAXDELIMITER+1,0,36]_.FOUNDATION; FOUNDATION_.L END; ROUTINE F13= BEGIN LOCAL GTVEC L1; REGISTER ITEM E, LSTHDR Q; RELLST(.CURPRLGLST); POPFLO(); ABCOUNT_.ABCBASE[CVAL]; Q_.KILLST[BASE]; UNTIL (E_.Q[RLINK]) EQL .KILLST[BASE] DO BEGIN IF .E[KABC] LEQ .ABCOUNT THEN EXITLOOP; RELEASESPACE(GT,DELINK(.E),2) END; IF FAST THEN RETURN NOVALUE; L1_.FOUNDATION; FOUNDATION_.L1[MAXDELIMITER+1,0,36]; MOVECORE(.L1,GTHASH,MAXDELIMITER+1); DECR J FROM HTSIZE-1 TO 0 DO BEGIN REGISTER STVEC L; L_.HT[.J,THREADF]; WHILE .L NEQ 0 DO BEGIN IF ISSTVAR(L) THEN IF .L[LSTWORD] NEQ 0 THEN DOOTWICE(I) BEGIN Q_CASE .I OF SET .L[VCHGLSTF]; .L[VUSELSTF] TES; WHILE (E_.Q[RLINK]) NEQ .Q DO BEGIN IF .E[ABCVAL] LEQ .ABCOUNT THEN EXITLOOP; RELEASESPACE(GT,DELINK(.E),2) END; END; L_.L[THREAD] END; END; RELEASESPACE(GT,.L1,MAXDELIMITER+2) END; EXTERNAL ERRORFOUND; ! FROM ERROR.BEG ROUTINE CLEANUPFLOW= IF .ERRORFOUND EQL 0 THEN (RELLST(.CURBOGLST[BASE]); POPCURBOGLST); ROUTINE F14=(PURGE(); MARKUPDATE(); POPANDDUMP(CEILING)); ROUTINE F15=(MARKMMNODES(); ! CALLED FROM F27 F0()); ROUTINE F16=(GFLOOP(); GPOSTWDW(); POPANDDUMP(FLOOR); POPFLO(); CHILEVEL_.LEVEL; GCHITOPRLG(); OPENWUCSE(1)); ROUTINE F17=(GFLOOP(); MARKMMNODES(); GPOSTREP(); POPFLO(); (LOCAL LVL L; L_.LVLCOPY[NALL]; CHILEVEL_.L[NVAL]); GCHITOPRLG()); ROUTINE F18=(GFLOOP(); GPOSTWDW(); F6(); POPFLO(); CHILEVEL_.LEVEL; GCHITOPRLG(); OPENWUCSE(0)); ROUTINE F19=(MARKMMNODES(); F0(); GFWHILE()); ROUTINE F20=PUSHALPHA; ! CALLED FROM F27 ROUTINE F21=MARKALL(TRUE); ROUTINE F22=(PUSHANDBUMP(CEILING); PUSHANDBUMP(FLOOR)); ROUTINE F23=(F6(); MARKMMNODES()); ROUTINE F24= BEGIN LOCAL STVEC LABL; BIND GTVEC SYMPTR=SYM; IF FAST THEN RETURN NOVALUE; IF .NOTREE THEN RETURN; KILL(1,.SYM[ADDRF]); LABL_.SYMPTR[OPR2]; IF NOT .LABL[LEFTBIT] THEN BEGIN LOCAL LABLEVEL,OLDINC; LABL[LEFTBIT]_1; OLDINC_.LABL[LVLINC]; LABLEVEL_.LABL[SAVLEVEL]; NOTELEAVE(CEILING,.LABLEVEL,.OLDINC); NOTELEAVE(LVLCOPY,.LABLEVEL,.OLDINC); LEVEL_.LEVEL+.OLDINC END END; ROUTINE F25= BEGIN LOCAL STVEC STE; BIND GTVEC SYMPTR=SYM; IF FAST THEN RETURN NOVALUE; IF .NOTREE THEN RETURN; STE_.SYMPTR[OPR2]; LEVELINC_.LEVELINC/2; IF .STE[LEFTBIT] THEN BEGIN PURGE(); REMOVELEAVEKILLS(.SYM); CEILING[CVAL]_.CEILING[CVAL]-.LEVELINC; LEVEL_LVLCOPY[CVAL]_.LEVEL-.LEVELINC END END; ROUTINE F26=GFDOWHILE(); ROUTINE F27=(F20(); F15()); END END ELUDOM