Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50325/flowan.bli
There are no other files named flowan.bli in the archive.
! 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<P,S>, 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 <P,S> 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)]<LTYPF> 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 <UNION> 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