Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/iopt.bli
There are 12 other files named iopt.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1974,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: H. P. WEISS/NEA/DCE/JNG/EGM/EDS
MODULE IOPT(RESERVE(0,1,2,3),DREGS=4,SREG=#17,FREG=#16,VREG=#15,GLOROUTINES)=
BEGIN
GLOBAL BIND IOPTV = 6^24 + 0^18 + 63; ! Version Date: 22-Jul-81
%(
***** Begin Revision History *****
1 ----- ----- CREATION
2 ----- ----- SET CSTMNT FOR ALL CALLS TO COMSUB ROUTINES
REMOVE PARAMTER FROM GLDOFOLD
FIX TYPO IN GLEXREDUCE
3 ----- ----- FIX GLEXDFPT TO CHECK FOLDED DO LOOPS
DO NOT STORE DEFPTS IN SRCISN
4 ----- ----- INTERFACE TO TEST REPLACEMENT
5 ----- ----- GIVE GLDOFOLD A BETTER NAME (GLDOFIND)
CALL GLOBDEPD AND MOVCNST IN "RIGHT" ORDER
6 ----- ----- INCLUDE E1LISTCALL AND E2LISTCALL NODE
IN CONTROL ROUTINES FOR GLOBAL ELIMINATION
AND PROPAGATION
7 ----- ----- FOLD PRIMITIVE DO LOOPS
8 ----- ----- MORE OF 7
9 ----- ----- MORE OF 8
10 ----- ----- ADD CONTROL ROUTINES TO FOLD OUTER LEVEL
OF I/O LISTS
11 ----- ----- CONTINUATION OF ABOVE
12 ----- ----- FIX HANDLING OF LOCAL COMMON SUB EXPRESSIONS
13 ----- ----- NO ALLOCATE DOCTLVAR FOR FOLDED LOOPS
14 ----- ----- DO NOT RECURSE ON ARRAYREFS WITH CONSTANT
INDEX
15 ----- ----- DO NOT CREATE NEGATE NODES OVER NEGATE NODES
TYPE NEGATE NODES IN MAKELIST
16 ----- ----- DIFFERENTIATE READ/DECODE FROM WRITE/ENCODE
17 ----- ----- SUPPLANT WHEREVER POSSIBLE
18 ----- ----- MAKE SURE ALL I/O LISTS START WITH A
CONTINUE NODE
19 ----- ----- RESET IMPLDO AND CNSMOVFLG AFTER
SECOND CALL TO MOVCNST
20 ----- ----- MOVE COLLAPSE LOGIC UNDER IOCLEAR
TO TAKE FULL ADVANTAGE OF
PROPAGATION
21 ----- ----- NOALLOC INDVAR IF IT IS A .R TEMPORARY
22 ----- ----- FAKE OUT SETGTRD BY BREAKING I/O LIST
AT CURRENT ELEMENT IN IOEXDFPT
23 ----- ----- SET GLOBAL CELMNT IN GLOBAL DEFPT,
ELIMINATION AND PROPAGATION ROUTINES
24 ----- ----- ADD REREDID
25 ----- ----- DO NOT REA DOLPTCTL EXPRESSION IN IOGELM AND
GLSTELIM (NOTE: AFTER WE PROPAGATE THROUGH
.O VARIABLES, THIS CODE SHOULD BE PUT BACK)
26 ----- ----- CONVERT IMPLDO TO A BIT IN IOPTFLG
PARAMETERIZE IOCLEAR
27 ----- ----- SET A2VALFLG IN CMNSUB EXPRESSION FOR
DOM1 AND DOM3 IN MAKELIST
28 ----- ----- SET VALFLAG OVER CMNSUB NODES IN
CMNRPLC
29 ----- ----- DO NOT CREATE E2LISTS OUT OF SINGLE DATACALLS
30 ----- ----- TAKE OUT 29
31 ----- ----- DOCUMENTATION AND MINOR CORRECTIONS
32 ----- ----- FIX .ARGNPTR BUGS
33 ----- ----- FIX GLDOFIND TO CLEAR HASH TABLE BEFORE
MOVING CONSTANT COMPUTATIONS
34 ----- ----- SIZE REDUCTIONS AND RELATED IMPROVEMENTS
35 ----- ----- ADD ROUTINE PUTBAK TO ELIMINATE EXTRA
ASSIGNMENTS TO .O VARIABLES IN NON
FOLDING LOOPS
36 ----- ----- FIX LOCAL DEPENDENCY ANALYSIS FOR
COMMON SUBEXPRESSIONS
37 ----- ----- FIX TYPO IN GLSTDFPT
38 ----- ----- FIX INCREMENT FOR DOUBLE WORD ARGUMENTS IN
E1LISTCALL AND E2LISTCALL NODES
39 ----- ----- FIX CALLS TO CMNRPLC IN PUTBAK
ELIMINATE COMMON SUBEXPRESSIONS IN
LOOP CONTROL
40 ----- ----- FURTHER IMPROVEMENTS TO PUTBAK
41 ----- ----- FIX EDIT 38 FOR E2LISTCALL NODES
42 ----- ----- IMPROVE ANALYSIS OF WHEN DOUBLED INCREMENT
USED IN A DO LOOP WHEN COLLAPSING LISTS
43 ----- ----- REMOVE TIME BOMB IN FOLDING NESTED
ELISTS
44 ----- ----- FIX COLLAPSE TO CORRECTLY TEST FOR
COLLAPSING OF NESTED IMPLIED DO'S
CONATINING DOUBLE WORD DATA ITEMS
45 ----- ----- FIX BUG INTODUCED BY EDIT 43
46 ----- ----- RECLASSIFY ITEMS UNDER ELISTCALLS
AS SINGLE OR DOUBLE WORD FOR COLLAPSING
47 ----- ----- DEPENDENCY COUNTS NOT CORRECT. NEED
TO ITERATE ON DEPDCMN CALLS IN CMNDEPD.
WILL SEE IF A SINGLE ITERATION IS ENOUGH.
48 322 16688 ADD A CHECK FOR DISJOINT IOLISTS IN LOOPS SUCH
AS (I,A(I),A(I),J=1,2)
49 406 18978 FIX NESTED ARRAY REFERENCES IN IOLISTS
50 435 18964 FIX IO LIST INCREMENTS NOT EQUAL TO 1, (DCE)
51 475 20813 REMOVE EDIT 322, FIX THE MORE GENERAL CASE., (JNG)
***** Begin Version 5A *****
52 612 23263 EDIT 406 NEEDS INITIALIZATION OF ARRCOUNT.
***** Begin Version 5B *****
53 630 10962 REMOVE 406, 612, TRY TO FIX GENERAL CASE AND
CATCH ALL CASES OF IMPLIED DO'S THAT CANNOT BE
CONVERTED TO SLISTS OR ELISTS. CASES LIKE
A(-I) AND A((I-1)*3+1) WERE FAILING., (JNG)
54 651 25062 DO NOT COLLAPSE A LIST IF DEPENDENCIES EXIST
INVOLVING AN IOLSCLS NODE AND A COMMON SUBEXPR, (DCE)
55 731 28246 MAKE SAVSTMNT A GLOBAL (FOR XPUNGE), (DCE)
56 743 ----- EDIT 651 WAS A BIT TOO AMBITIOUS - ONLY
CATCH .O VARS (NOT .R), (DCE)
57 753 29028 CHECK FOR .O VARIABLES IN IO LIST INITIAL VALUE, (EGM)
***** Begin Version 6 *****
58 774 EGM 12-Jun-80 14244
Do not allow expressions involving variables appearing in Input stmnts
to be common subed and moved out of the I/O stmnt node.
59 1007 EGM 6-Aug-80 10-29681
Link DATACALL nodes that are candidates for common sub replacement to
an IOLSTCALL node so that the common sub information can be correctly
saved.
60 1036 DCE 31-Dec-80 QAR-1348
Fix edit 1007 to make ALL backpointers availible - even those in
innermore loops. This makes insertion of the IOLSTCALL node correct
in the more obscure cases.
61 1041 DCE 14-Jan-81 -----
Fix optimizer bug so that ((A(I),I),J=1,2) knows that the A(I)
depends on the subsequent value of I which is read.
63 1111 EDS 15-Jul-81 10-31190
Fix optimizer bug so that ((A(J,K),J=1,2,I),K=1,2,I) with I in
common does not create a common subexpression which is only used
once. Keep the assignment of the expression to the .O variable
instead of building a common sub node.
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES LIST;
%(***BRIEF FUNCTION DESCRIPTION OF IOPT
IOPT CONTAINS ROUTINES TO
1) EXTEND THE ALGORITHMS USED BY THE GLOBAL OPTIMIZER
FOR COMMON SUBEXPRESSION ELIMINATION AND PROPAGATION AND REDUCTION
OF EXPRESSIONS IN A LOOP AND TEST REPLACEMENT OF THE LOOP INDEX
TO IMPLIED LOOPS WITHIN AN I/O LIST
2) FOLD INDIVIDUAL LOOPS WITHIN THE I/O LIST INTO
SINGLE CALLS TO THE FORTRAN OBJECT TIME SYSTEM (FOROTS)
3) FOLD SEVERAL ADJACENT CALLS TO THE FORTRAN OBJECT TIME SYSTEM
INTO A SINGLE CALL TO THE OBJECT TIME SYSTEM WHERE SUITABLE
CONDITIONS OF INDEPENDENCE HOLD
FUNCTIONALLY, THE OPTIMIZATION AND FOLDING ROUTINES ARE INDEPENDENT
WITH THE EXCEPTION OF SEVERAL SHARED LOCAL VARIABLES AND IF
THE APPRIATE VARIABLES ARE MADE GLOBAL OR DUPLICATED THE MODULE MAY BE
SPLIT.
THE OPTIMIZATION ALGORITHMS USED ARE IDENTICAL TO THOSE EMPLOYED
ELSEWHERE IN THE GLOBAL OPTIMIZATION PROCESS. HOWEVER, SINCE THE
ONLY PERMISSABLE FORM OF CONTROL EXPRESSION ALLOWED ON AN I/O LIST
IS A DO LOOP, WE DO NOT NEED AND DO NOT USE THE GRAPHING
ALGORITHM EMPLOYED IN THE OPTIMIZATION OF EXPLICIT DO LOOPS.
CONSEQUENTLY, THE DEFINITION POINT AND COMMON SUBEXPRESSION MOTION
ALGORITHMS ARE SOMEWHAT SIMPLER THAN THOSE
USED IN THE OPTIMIZATION OF EXPLICIT DO LOOPS. WHEREVER POSSIBLE
THE I/O LIST OPTIMIZATION PACKAGE USES ROUTINES ALREADING
EXISTING IN OTHER OPTIMIZATION MODULES. WHEN DOING SO THE
FLAG IMPLDO IS SET TO INDICATE WHICH PARTS OF THE EXPLCIT
LOOP ALGORITHMS ARE TO BE IGNORED. HOWEVER, IT HAS BEEN NECESSARY TO
WRITE NEW DRIVING ROUTINES AT THE EXPRESSION LEVEL FOR THE
DEFINITION POINT AND REDUCTION ALGORITHMS ALTHOUGH THE
BASIC ALGORITHM HAS REMAINED UNCHANGED.
A LOOP WITHIN AN I/O LIST WILL BE FOLDED INTO AN E1LISTCALL
OR E2LISTCALL NODE IF
A) THERE ARE NO FUNCTION CALLS WITHIN THE LOOP
B) NO DATACALL WITHIN THE LOOP IS DEPENDENT UPON A
PREVIOUS DATACALL IN THE LOOP
C) NO ASSIGNMENT STATEMENTS APPEAR WITHIN THE LOOP
EXCEPT OPTIMIZER CREATED ASSIGNMENTS OF POTENTIAL
LOCAL COMMON SUBEXPRESSIONS
D) NO SLISTCALL NODES APPEAR WITHIN THE LOOP
E) ALL REFERENCES TO THE LOOP INCREMENT VARIABLE
OR REDUCED FORMS THEREOF APPEAR UNDER ARRAY REFERENCES
IN THE LOOP AND IN EXPRESSIONS OF THE FORM
E1 + R WHERE R REPRESENTS THE INCREMENT VARIABLE OR
A REDUCED FORM THEREOR AND E1 IS
AN EXPRESION NOT INVOLVINMG R OR ANY OTHER
FORM OF THE INCREMENT VARIABLE (E1 MAY BE 0)
SEVERAL IOLSCLS NODES WILL BE FOLDED INTO A SINGLE IOLSTCALL
NODE IF CONDITIONS A) AND B) ABOVE ARE MET AND THE DATACALL
NODES ARE ADJACENT.
BOTH FOLDING ALGORITHMS DESCRIBED ABOVE ARE EMBEDDED IN THE
ROUTINE COLLAPSE WHICH FIRST BUILDS IOLSTCALL NODES OUT OF
IOSCLS NODES WITHIN THE LOOP AND THEN CALLS THE ROUTINE MAKELIST
TO TRANSFORM THE WHOLE LOOP INTO AN E1LISTCALL
OR E2LISTCALL NODE IF SUCH IS POSSIBLE.
THE CONTROL PROCEDURE FOR LIST OPTIMIZATION IS AS FOLLOWS:
1) INVOKE SKOPTIO DURING THE FIRST WALK OVER THE TREE TO
PERFORM SKELETAL OPTIMIZATION OF EXPRESSIONS WITHIN
THE LIST
2) SKOPTIO INVOKES GLDOFIND WHICH DOES A SIMPLE WALK DOWN THE
I/O LIST LOOKING FOR IMPLIED LOOPS
3) WHEN THE END OF AN IMPLIED LOOP IS DETECTED, GLDOFIND
CALLS THE DEFINITION POINT (GLSTDFPT), COMMON SUBEXPRESION
ELIMINATION (GLSTELIM), PROPAGATION AND REDUCTION (GLSTREDUCE) AND
TEST REPLACEMENT (TESTREPLACE) ROUTINES TO OPTIMIZE THE LOOP
DURING THE DEFINITION POINT, OPTIMIZATION, AND PROPAGATION AND
REDUCTION WALKS THE GLOBAL OPTIMIZER CALLS THE ROUTINES IOSTDFPT,
IOGELO, IOGELM, AND IOGPNR TO INCLUDE EXPRESSIONS UNDER THE I/O LIST
IN THE GLOBAL OPTIMIZATION ALGORITHM
AFTER ALL OPTIMIZATION IS COMPLETE (INCLUDING PROPAGATION) THE
OPTIMIZER INVOKES THE FOLLOWING CONTROL PROCEDURE TO FOLD GROUPS OF
IOLSCLS NODES AND COLLAPSE LOOPS WITHIN THE LIST:
1) FOR EACH I/O LIST INVOKE THE ROUTINE IOCLEAR
2) IOCLEAR IN TURN INVOKES THE ROUTINE FOLDUP
WHICH PERFORMS AN IDENTICAL WALK TO THAT PERFORMED
BY GLDOFIND. FOR EACH LOOP FOUND, FOLDUP CALLS THE
ROUTINE COLLAPSE WHICH FOLDS GROUPS OF IOLSCLS NODES AND
COLLAPSES LOOPS WHEN POSSIBLE BY CALLING MAKELIST.
3) AFTER ALL LOOPS HAVE BEEN PASSED THROUGH COLLAPSE, FOLDUP
INVOKES THE ROUTINE CMNELIM FOR EACH IOLSCLS NODES IN THE
LIST TO FOLD AND ELIMINATE LOCAL COMMON SUBEXPRESSIONS
CREATE IN THE IOLIST AND ELIST GENERATION PROCESS
INTO EACH OTHER VIA A SIMPLE LOCAL DEPENDENCY ALGORITHM
***)%
%(***DEFINE ROUTINES IN THE MODULE AS FORWARD***)%
FORWARD
%OPTIMIZATION ROUTINES
------------ --------%
%ROUTINES CALLED BY THE OPTIMIZER TO
FIND DEFINITION POINTS FOR, HASH, PROPAGATE
AND REDUCE EXPRESSIONS ON AN I/O LIST%
IOGELO, %DRIVING ROUTINE TO HASH ALL EXPRESSIONS
ON THE RIGHT HALF OF ASSIGNMENTS
TO .O VARIABLES ON THE I/O LIST%
IOGELM, %DRIVING ROUTINE TO HASH ALL EXPRESSIONS
EXCEPT THOSE ON THE RIGHT HALF OF
ASSIGNMENTS TO .O VARIABLES ON THE
I/O LIST%
IOGPNR %DRIVING ROUTINE TO PROPAGATE AND REDUCE
ALL EXPRESSIONS ON THE I/O LIST%,
IOEXDFPT, %RECURSIVE ROUTINE TO DEFINITION POINTS
OF LEAVES UNDER EXPRESSIONS ON AN I/O
LIST%
IOSTDFPT, %DRIVING ROUTINE TO LOCATE DEFINITION
POINTS FOR ALL EXPRESSIONS
ON AN I/O LIST%
%ROUTINES CALLED TO PERFORM GLOBAL
OPTIMIZATION OF LOOPS IN AN I/O LIST%
GLEXDFPT, %RECURSIVE ROUTINE TO LOCATE LOCAL
DEFINITION POINTS OF LEAVES UNDER
EXPRESSIONS WITHIN A LOOP ON AN I/O LIST%
GLEXREDUCE, %RECURSIVE ROUTINE TO REDUCE EXPRESSIONS
WITHIN A LOOP ON AN I/O LIST%
GLSTDFPT, %DRIVING ROUTINE TO LOCATE LOCAL DEFINITION
POINTS FOR STATEMENTS WITHIN A LOOP
ON AN I/O LIST%
GLSTELIM, %DRIVING ROUTINE TO DO GLOBAL ELIMINATION
OF EXPRESSIONS WITHIN A LOOP ON AN
I/O LIST%
GLSTREDUCE, %DRIVING ROUTINE TO PROPAGATE AND
REDUCE EXPRESSIONS UNDER STATEMENTS WITHIN
A LOOP ON AN I/O LIST%
GLDOFIND, %ROUTINE TO RECURSIVE WALK AN I/O LIST
AND LOCATE AND GLOBALLY OPTIMIZE
LOOPS WITHIN THE I/O LIST%
SKOPTIO, %CONTROLLING ROUTINE FOR SKELETAL AND
GLOBAL OPTIMIZATION OF LOOPS AND
EXPRESSIONS ON AN I/O LIST. REPALCE
SKIOLIST IN THE LOCAL OPTIMIZER%
%LOOP FOLDING AND COLLAPSING ROUTINES
---- ------- --- ---------- --------%
ISOLATE, %ROUTINE TO ISOLATE THE INCREMENT EXPRESSION
UNDER A DATACALL NODE%
LCLLNK, %ROUTINE TO LINK COMMON SUBEXPRESSION NODES
ONTO AN IOLSCLS NODE%
CHNINIT, %ROUTINE TO INITIALIZE COMMON SUBEXPRESSION
CHAINS FOR LOOP FOLDING%
CHNLNK, %ROUTINE TO LINK A COMMON SUBEXPRESSION
NODE ONTO THE APPROPRIATE COMMON SUBEXPRESSION
CHAIN%
MRGCHN, %ROUTINE TO MERGE THE COMMON SUBEXPRESSION
CHAINS INTO THE IOLSCLS NODE%
FINDASGN, %ROUTINE TO FIND AS ASSIGNMENT OF A VALUE
TO A SPECIFIED VARIABLE WITHIN THE CURRENT
LOOP%
ELIMTEMP, %ROUTINE TO ELIMINATE THE ASSIGNMENT STATEMENT
OF A VALUE TO A VARIABLES
AND GENERATE A COMMON SUBEXPRESSION%
ELIMSTEP, %ROUTINE TO ELIMINATE THE INCREMENT ASSIGNMENT
FOR A REDUCTION VARIABLE IN A LOOP AND CREATE
A COMMON SUBEXPRESSION%
DIV2CMN, %ROUTINE TO BUILD A COMMON SUBEXPRESSION
NODE FOR A VALUE DIVIDED BY 2%
CHKDBLSUB, %ROUTINE TO DETERMINE IF AN EXPRESSION
IS A DOUBLE PRECISION ARRAYREF WITH AN
UNFOLDED MULTIPLICATION BY TWO IN THE
SUBSCRIPT COMPUTATION%
MAKELIST, %ROUTINE TO FOLD AN IMPLIED LOOP INTO
AN E1LISTCALL OR E2LISTCALL IOLSCLS NODE%
ELIMCONT, %ROUTINE TO ELIMINATE CONTINUE
STATEMENTS WITHIN A LOOP%
EXPEXP, %ROUTINE TO DETERMINE IF THE PRODUCT
OF TWO EXPRESSIONS IS A LEAF%
IOCONTVAR, %CHECK IF IOLSCLS ELEMENT CONTAINS
A REFERNCE TO A VARIABLE%
PUTBAK, %CONVERTS GLOBAL COMMON SUBEXPRESSIONS
TO LOCAL COMMON SUBEXPRESSIONS%
COLLAPSE, %CONTROL ROUTINE FOR THE FOLDING
OF SEVERAL IOLSCLS NODES INTO A SINGLE
IOLSTCALL NODE AND THE FOLDING OF LOOPS
INTO E1LISTCALL OR E2LISTCALL NODES%
RPLCMN, %ROUTINE TO MERGE LOCALLY DEPENDENT COMMON
SUBEXPRESSIONS UNDER AN IOLSCLS NODE%
CMNRPLC, %ROUTINE TO SUBSTITUTE COMMON SUBEXPRESSION
NODES FOR LEAVES IN AN IOLSCLS NODE AND
VICA-VERSA%
DEPDCMN, %ROUTINE TO PERFORM LOCAL DEPENDENCY
WITHIN COMMON SUBEXPRESSIONS%
CMNDEPD, %ROUTINE TO PERFORM LOCAL DEPENDENCY
ANALYSIS FOR COMMON SUBEXPRESSION NODES
UNDER AN IOLSCLS NODE%
CMNELIM, %CONTROL ROUTINE FOR THE LOCAL DEPENDENCY
ANALYSIS AND FOLDING OF
COMMON SUBEXPRESSION NODES%
FOLDUP, %RECURSIVE ROUTINE TO LOCATE AND FOLD
LOOPS UNDER AN I/O LIST%
IOCLEAR; %CONTROLLING ROUTINE FOR LOOP FOLDING AND
MERGING OF IOLSCLS NODES ON AN I/O LIST%
%(***DEFINE EXTERNAL VARIABLES AND ROUTINES USED BY I/O OPTIMIZATION
PACKAGE)%
EXTERNAL
SLINGHASH, !CLEAR THE EXPRESSION HASH TABLE <COMSUB>
SCRUBARRAY, !CLEANUP AFTER ARRAY REF COMMON SUB
!PROCESSING <GCMNSB>
CELMNT, !CURRENT ELEMENT IN GLOBAL ELIMINATION <GLOBAL>
LOWLIM, !GLOBAL FOR SUBSTITUTION <GLOBAL>
INPFLAG, !SET IF DECODE OR READ STATEMENT <GLOBAL>
FOLDER, !FOLD EXPRESSIONS <PNROPT>
ARSKOPT, !SKELETAL STUFF FOR ARITHMETIC EXPRESSION <SPS21>
SWAPEM, !SWAP EXPRESSION IF SUBSTTUTED <UTIL>
RDUCINIT, !INITIALIZE REDUCTION GLOBALS <TSTR>
IODEPNDS, !TEST INTERDEPENDENCE OF TWO IOLSCLS
!NODES <SKSTMN>
CONTVAR, !DOES EXPRESSION CONTAIN VARIABLE
MAKEPR, !MAKE EXPRESSION NODE <MAKEPR>
MAKPR1, !MAKE EXPRESSION NODE<MAKEPR>
PROPNEG, !PROPAGATE NEGATIVE <UTIL>
CHOSEN[32], !GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
GLOBREG[16], !GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
SPECCASE, !GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
ITMCT, !GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
LEAFSUBSTITUTE, !LEAF SUBSTITUTION ROUTINE <UTIL>
IOSUBSTITUTE, !CONTROL ROUTINE FOR LEAFSUBSTITUTION <UTIL>
RDCLNK, !FIRST INCREMENT ASSIGNMENT OF A .R
!TEMPORARY CREATED BY REDUCE <TESTR>
NAME, !GLOBAL FOR CORMANAGER <GLOBAL>
CORMAN, !COR ALLOCATOTR <SRCA>
SAVSPACE, !CORE DEALLOCATOR <SRCA>
CONTFN, !EXPRESSION CONTAINS A FUNCTION CALL <UTIL>
SKERR, !ERROR
LPRDCCT, !LOOP REDUCTION COUNT <GLOBAL>
RDCCT, !REDUCTION COUNT <GLOBAL>
TESTREPLACE, !CAN LOOP INDEX CAN BE REPLACED? <TSTR>
SUPPLANT, !REPLACE LOOP INDEX <TSTR>
LOKDEFPT, !PROPAGATE AND REDUCE <PNROPT>
GETDEF, !NORMAL DEFINITION POINT ALGORITHM <DEFPT>
SETGTRD, !TEST IF A VARIABLE WAS READ <DEFPT>
TREEPTR, !GLOBAL POINTER FOR SETGTRD <GLOBAL>
GLOBDEPD, !COLLECT COMMON SUBS <COMSUB>
REDUCE, !REDUCE AN EXPRESSION <TSTR>
MOVCNST, !MOVE CONSTANT COMPUTATONS <COMSUB>
REA, !EXPRESSION OPTIMIZER <COMSUB>
TOP, !CURRENT DO LOOP NODE <GLOBAL>
BOTTOM, !STATEMENT AFTER DO LOOP <GLOBAL>
LENTRY, !STATEMENT BEFORE DO LOOP <GLOBAL>
LEND, !CONTINUE NODE AT END OF LOOP <GLOBAL>
INDVAR, !INDUCTION VARIABLE <GLOBAL>
BACKST, !GLOBAL OPTIMIZATION SWITCH <GLOBAL>
ARGCONE, !TEST IF LIB FUNCTION WITH 1 ARG <GOPT2>
MAKCONTINUE, !MAKE A CONTINUE NODE <GOPT2>
CSTMNT, !CURRENT STATEMENT <GLOBAL>
NEGFLG, !NEG FLAG FOR CURRENT EXPR <GLOBAL>
NOTFLG, !NOT FLAG FOR CURRENT EXPR <GLOBAL>
P2SKL1DISP, !DISPATCH FOR P2 SKELETON <P2S1>
P2SKSTMNT; !DISPATCH FOR P2 SKELETON <SKSTMN>
%(***DEFINE LOCAL VARIABLES USED IN THE I/O LIST OPTIMIZATION PHASE***)%
%[731]% GLOBAL SAVSTMNT; ! POINTS TO CURRENT I/O STATEMENT
OWN
%[1041]% ENDDOPTRS, !PTR TO DO END,,PTR TO SUCCESSOR
IONODE, !IOLSCLS NODE BEGIN BUILT
PREVELEM, !PREVIOUS ELEMENT IN I/O LIST
CURRELEM; !CURRENT ELEMENT IN I/O LIST
MAP BASE SAVSTMNT:PREVELEM:IONODE:CURRELEM;
MAP PHAZ2 TOP:BOTTOM:LEND:LENTRY:INDVAR:CSTMNT;
GLOBAL ROUTINE IOGELO(STMT)=
%(**********************************************************************
CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM GLOBAL
COMMON SUBEXPRESSION ELIMINATION OF RIGHT
HAND EXPRESSIONS UNDER ASSIGNMENT STATEMENTS
TO OPTIMIZER CREATED GLOBAL COMMON SUBEXPRESSIONS
**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
%[774]% SAVSTMNT _ .STMT; ! Save the I/O node location
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
IF .ELEM[OPRS] EQL ASGNOS THEN
BEGIN
LOCAL BASE TMP;
TMP_.ELEM[LHEXP];
IF .TMP[IDDOTO] EQL SIXBIT ".O" THEN
BEGIN
REA(.ELEM[RHEXP])
END
END
ELSE
IF .ELEM[OPRS] EQL DOOS THEN
BEGIN
ELEM_.ELEM[DOLBL]; !COLLAPSE
ELEM_.ELEM[SNHDR] !DO NODE
END;
ELEM_.ELEM[SRCLINK]
END
END;
GLOBAL ROUTINE IOGELM(STMT)=
%(**********************************************************************
CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM GLOBAL
COMMON SUBEXPRESSION ELIMINATION OF ALL EXPRESSIONS EXCEPT
THOSE ON THE RIGHT HAND SIDE OF ASSIGNMENT
STATEMENTS TO OPTIMIZER CREATED GLOBAL COMMON
SUBEXPRESSIONS
**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
IF .ELEM[OPRS] EQL ASGNOS THEN
BEGIN
LOCAL BASE TMP;
TMP_.ELEM[LHEXP];
IF .TMP[IDDOTO] NEQ SIXBIT ".O" THEN
BEGIN
REA(.ELEM[LHEXP]);
REA(.ELEM[RHEXP])
END
END
ELSE
IF .ELEM[OPRS] EQL DOOS THEN
BEGIN
REA(.ELEM[DOLPCTL]); !TRY CTL EXPRESSION
ELEM_.ELEM[DOLBL];
ELEM_.ELEM[SNHDR] !COLLAPSE DO LOOP
END
ELSE
IF .ELEM[OPRCLS] EQL IOLSCLS THEN
BEGIN
CASE .ELEM[OPERSP] OF SET
%DATACALL% REA(.ELEM[DCALLELEM]);
%SLISTCALL% BEGIN
REA(.ELEM[SCALLCT]);
REA(.ELEM[SCALLELEM])
END;
%IOLSTCALL% SKERR(); !SHOULD NOT APPEAR
%E1LISTCALL% SKERR(); !SHOULD NOT APPEAR
%E2LISTCALL% SKERR(); !SHOULD NOT APPEAR
%ESNGLELEM% SKERR(); !SHOULD NOT APPEAR
%EDBLELEM% SKERR() !SHOULD NOT APPEAR
TES
END;
ELEM_.ELEM[SRCLINK]
END
END;
GLOBAL ROUTINE IOGPNR(STMT)=
%(**********************************************************************
CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM PROPAGATION
AND REDUCTION FOR ALL EXPRESSIONS
**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
IF .ELEM[OPRS] EQL ASGNOS THEN
BEGIN
ELEM[LHEXP]_LOKDEFPT(.ELEM[LHEXP]);
ELEM[RHEXP]_LOKDEFPT(.ELEM[RHEXP])
END
ELSE
IF .ELEM[OPRS] EQL DOOS THEN
BEGIN
ELEM[DOLPCTL]_LOKDEFPT(.ELEM[DOLPCTL])
END
ELSE
IF .ELEM[OPRCLS] EQL IOLSCLS THEN
BEGIN
CASE .ELEM[OPERSP] OF SET
%DATACALL% ELEM[DCALLELEM]_LOKDEFPT(.ELEM[DCALLELEM]);
%SLISTCALL% BEGIN
ELEM[SCALLELEM]_LOKDEFPT(.ELEM[SCALLELEM]);
ELEM[SCALLCT]_LOKDEFPT(.ELEM[SCALLCT])
END;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES
END;
ELEM_.ELEM[SRCLINK]
END
END;
GLOBAL ROUTINE IOEXDFPT(EXPRNODE,DFPT)=
%(**********************************************************************
RECURSIVE ROUTINE TO LOCATE ALL LEAVES IN EXPRESSIONS
ON AN I/O LIST AND ESTABLISH DEFINITION POINTS FOR
THEM VIA THE STANDARD DEFINITION POINT ALGORITHM
(GETDEF)
RETURNS AS THE DEFINITION POINT EITHER A NODE
IN FRONT OF THE I/O STATEMENT OR THE I/O STATEMENT
IF THE LEAF IS READ IN FRONT OF THE ELEMENT
IN THE I/O LIST FOR WHICH WE ARE CURRENTLY COMPUTING
DEFINITION POINTS
**********************************************************************)%
BEGIN
MAP BASE DFPT;
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
END;
%DATAOPR% BEGIN
%(
WE HAVE REACHED A LEAF UNDER THE CURRENT I/O
LIST ELEMENT
SINCE WE WANT GETDEF TO LOOK ONLY AT STATEMENTS
OR I/O LISTS ELEMENTS IN FRONT OF THE CURRENT
ELEMENT WE WILL PRETEND THAT
THE I/O LIST ENDS AT THE ELEMENT IN
FRONT OF THE CURRENT ELEMENT (PREVELEM)
BY SUBSTITUTING ZERO FOR THE LINK FIELD OF
PREVELEM BEFORE CALLING GETDEF AND
RESTORING THE LINK AFTER THE CALL TO GETDEF.
IF WE ARE IN A LOOP, THE CLEARING IS NOT POSSIBLE,
BUT A ZERO LINK FIELD HAS ALREADY BEEN SUBSTITUTED
AFTER THE LOOP (JUST AS IT SHOULD BE!).
)%
LOCAL BASE SAVDEFPT;
![1041] If in a loop, (A(I), I) represents a dependency,
![1041] so we do not break the stmnt chain here; rather
![1041] we do it when encountering an outermost loop out in
![1041] IOSTDFPT. The chain is broken after the loop in that
![1041] case so that ((A(I),I),J=1,2) gets correct dependency.
%[1041]% IF .ENDDOPTRS EQL 0 THEN PREVELEM[CLINK]_0;
SAVDEFPT_GETDEF(.EXPR,.SAVSTMNT,.DFPT);
PREVELEM[CLINK]_.CURRELEM; !RESTORE THE LINK
RETURN .SAVDEFPT
END;
%RELATIONAL% BEGIN
EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
END;
%FNCALL% BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
IF ARGCONE(.EXPR) THEN
EXPR[DEFPT2]_IOEXDFPT(.AG[1,ARGNPTR],.EXPR[DEFPT2])
ELSE
INCR I FROM 1 TO .AG[ARGCOUNT] DO
IOEXDFPT(.AG[.I,ARGNPTR],0);
END;
%ARITHMETIC% BEGIN
EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
END;
%TYPECNV% EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%ARRAYREF% IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%CMNSUB% EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%NEGNOT% EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%SPECOP% EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN
CASE .EXPR[OPERSP] OF SET
%DATACALL% IOEXDFPT(.EXPR[DCALLELEM],0);
%SLISTCALL% BEGIN
IOEXDFPT(.EXPR[SCALLELEM],0);
IOEXDFPT(.EXPR[SCALLCT],0)
END;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES
END;
%INLINFN% BEGIN
EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
END
TES;
RETURN 0 !ONLY DATAOPR'S CAN HAVE DEFPTS
END;
GLOBAL ROUTINE IOSTDFPT(STMTNODE)=
%(**********************************************************************
ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
IN THE I/O LIST AND PASS THEM TO IOEXDFPT
**********************************************************************)%
BEGIN
%[1041]% MACRO ENDLP = LEFT$, ! PTR to end of outermost DO loop
%[1041]% DOSUCC = RIGHT$; ! PTR to successor for loop
%[1041]% MAP BASE ENDDOPTRS; ! ENDLP,,DOSUCC
MAP PHAZ2 STMTNODE;
REGISTER PHAZ2 STMT;
PREVELEM_SAVSTMNT_.STMTNODE; !MARK THE STATEMENT
INPFLAG_IF .STMTNODE[SRCID] EQL READID OR .STMTNODE[SRCID] EQL REREDID OR .STMTNODE[SRCID] EQL DECOID THEN 1 ELSE 0;
STMT_.STMTNODE[IOLIST]; !LOCATE I/O LIST
%[1041]% ENDDOPTRS_0;
UNTIL (CURRELEM_CELMNT_.STMT) EQL 0 DO
BEGIN
%[1041]% IF .STMT EQL .ENDDOPTRS<ENDLP> THEN ! At the end of outermost loop
%[1041]% BEGIN ! Restore I/O list to original state
%[1041]% STMT[CLINK]_.ENDDOPTRS<DOSUCC>;
%[1041]% ENDDOPTRS_0
%[1041]% END;
IF .STMT[OPRS] EQL ASGNOS THEN
BEGIN
IOEXDFPT(.STMT[LHEXP],0); !FILL IN LH DEFPTS
IOEXDFPT(.STMT[RHEXP],0) !FILL IN RH DEFPTS
END
ELSE
IF .STMT[OPRS] EQL DOOS THEN
BEGIN
%[1041]% IF .ENDDOPTRS EQL 0 THEN
%[1041]% BEGIN ! Set up for outermost loop (break chain)
%[1041]% LOCAL BASE T;
%[1041]% T_.STMT[DOLBL]; ! Label for end of DO loop
%[1041]% ENDDOPTRS<ENDLP>_T_.T[SNHDR]; ! Stmnt at end of loop
%[1041]% ENDDOPTRS<DOSUCC>_.T[CLINK]; ! Stmnt after loop
%[1041]% T[CLINK]_0 ! Ignore stmnts after end of loop
%[1041]% END;
IOEXDFPT(.STMT[DOLPCTL],0)
END
ELSE
IF .STMT[OPRCLS] EQL IOLSCLS THEN
BEGIN
IOEXDFPT(.STMT,0)
END;
PREVELEM_.STMT;
STMT_.STMT[CLINK]
END
END;
GLOBAL ROUTINE GLEXDFPT(EXPRNODE)=
%(**********************************************************************
ROUTINE TO COMPUTE PSEUDO-DEFINITION POINTS
FOR DATA REFERENCES ON THE I/O LIST
DEFINITION POINTS MAY BE AT:
1) AN EARLIER SLISTCALL OR DATACALL NODE WITHIN THE
CURRENT LOOP
2) AT A STATEMENT WITHIN THE LOOP
3) AT THE LOOP ITSELF (TOP)
4) OUTSIDE THE LOOP (LENTRY)
COMPUTATION OF DEFINITION POINTS IS EMBEDDED WITHIN
ROUTINE TO WALK AN EXPRESSION TREE AND CALL GLEXDEFPT
FOR EACH LEAF
**********************************************************************)%
BEGIN
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
END;
%DATAOPR% IF .EXPR[OPERSP] EQL VARIABLE OR
.EXPR[OPERSP] EQL FNNAME OR
.EXPR[OPERSP] EQL FORMLVAR THEN
%VARIABLE% BEGIN
%FORMLVAR% LOCAL BASE DEFPT;
%FNNAME% LOCAL BASE ELEM;
%(
DEFINITION POINT FOR THE LOOP INDEX IS THE
DO LOOP NODE (TOP)
)%
IF .EXPR EQL .INDVAR THEN RETURN .TOP;
%(
SEARCH FOR AN ASSIGNMENT STATEMENT TO
OR IOLSCLS NODE INITIALIZING THE LEAF IN
QUESTION
)%
DEFPT_0;
ELEM_.TOP[SRCLINK];
UNTIL .ELEM EQL .CURRELEM DO
BEGIN
IF .ELEM[OPRCLS] EQL STATEMENT THEN
BEGIN
IF .ELEM[SRCID] EQL ASGNID THEN
BEGIN
IF .ELEM[LHEXP] EQL .EXPR THEN
DEFPT_.ELEM
END
ELSE
IF .ELEM[SRCID] EQL DOID THEN
BEGIN
IF .ELEM[DOSYM] EQL .EXPR THEN
DEFPT_.ELEM
END
END
ELSE
IF .INPFLAG THEN !READ OR DECODE
IF .ELEM[OPRCLS] EQL IOLSCLS THEN
CASE .ELEM[OPERSP] OF SET
%DATACALL% IF .ELEM[DCALLELEM] EQL .EXPR THEN DEFPT_.ELEM;
%SLISTCALL% IF .ELEM[SCALLELEM] EQL .EXPR THEN DEFPT_.ELEM;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES;
ELEM_.ELEM[CLINK]
END;
RETURN IF .DEFPT NEQ 0 THEN .DEFPT ELSE .LENTRY
END
ELSE
%OTHERWISE% RETURN .LENTRY;
%RELATIONAL% BEGIN
EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
END;
%FNCALL% BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
IF ARGCONE(.EXPR) THEN
EXPR[DEFPT2]_GLEXDFPT(.AG[1,ARGNPTR])
ELSE
INCR I FROM 1 TO .AG[ARGCOUNT] DO
GLEXDFPT(.AG[.I,ARGNPTR]);
END;
%ARITHMETIC% BEGIN
EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
END;
%TYPECNV% EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%ARRAYREF% IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%CMNSUB% EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%NEGNOT% EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%SPECOP% EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN END;
%INLINFN% BEGIN
EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
END
TES;
RETURN 0 !ONLY DATAOPR'S CAN HAVE DEFPTS
END;
GLOBAL ROUTINE GLEXREDUCE(EXPRNODE)=
%(**********************************************************************
ROUTINE TO FIND ALL EXPRESSIONS UNDER STATEMENTS
IN AN I/O LIST AND CALL REDUCE FOR ALL REDUCIBLE
EXPRESSIONS
REDUICIBLE EXPRESSIONS ARE:
1) ARITHMETIC MULTIPLY
2) SPECIAL OPERATORS - P2MUL AND P2PL1 MUL
**********************************************************************)%
BEGIN
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
END;
%DATAOPR% BEGIN END;
%RELATIONAL% BEGIN
EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
END;
%FNCALL% BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
AG[.I,ARGNPTR]_GLEXREDUCE(.AG[.I,ARGNPTR]);
END;
%ARITHMETIC% BEGIN
EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
IF .EXPR[OPERSP] EQL MULOP THEN
RETURN REDUCE(.EXPR)
END;
%TYPECNV% EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%ARRAYREF% IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%CMNSUB% EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%NEGNOT% EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%SPECOP% BEGIN
EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
IF .EXPR[OPERSP] EQL P2MULOP OR .EXPR[OPERSP]
EQL P2PL1OP THEN RETURN REDUCE(.EXPR)
END;
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN END;
%INLINFN% BEGIN
EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
IF .EXPR[ARG2PTR] NEQ 0 THEN
EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
END
TES;
RETURN .EXPR !RETURN EXPR
END;
GLOBAL ROUTINE GLSTDFPT=
%(**********************************************************************
ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
AND ILSCLS NODES IN THE I/O LIST AND PASS THEM
TO GLEXDFPT TO COMPUTE "LOCAL" DEFINITION POINTS
**********************************************************************)%
BEGIN
REGISTER PHAZ2 STMT;
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
IF .STMT[OPRS] EQL ASGNOS THEN
BEGIN
GLEXDFPT(.STMT[LHEXP]); !DO LEFT HALF
STMT[SRCISN]_
GLEXDFPT(.STMT[RHEXP]) !DO RIGHT HALF
END
ELSE
IF .STMT[OPRS] EQL DOOS THEN
BEGIN
GLEXDFPT(.STMT[DOLPCTL]); !DO CONTROL EXPRESSION
STMT_.STMT[DOLBL]; !SKIP INNER LOOPS
CSTMNT_STMT_.STMT[SNHDR] !SKIP INNER LOOPS
END
ELSE
IF .STMT[OPRCLS] EQL IOLSCLS THEN
BEGIN
CASE .STMT[OPERSP] OF SET
%DATACALL% GLEXDFPT(.STMT[DCALLELEM]);
%SLISTCALL% BEGIN
GLEXDFPT(.STMT[SCALLCT]);
GLEXDFPT(.STMT[SCALLELEM])
END;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES
END;
CSTMNT_STMT_.STMT[CLINK]
END
END;
GLOBAL ROUTINE GLSTELIM=
%(**********************************************************************
ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
AND IOLSCLS NODES IN AN I/O LIST AND
PERFORM "LOCAL" GLOBAL COMMON SUBEXPRESSION
ELIMINATION
**********************************************************************)%
BEGIN
REGISTER PHAZ2 STMT;
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
IF .STMT[OPRS] EQL ASGNOS THEN
BEGIN
REA(.STMT[LHEXP]); !ELIMINATE COMMON SUBS
REA(.STMT[RHEXP]) !ELIMINATE COMMON SUBS
END
ELSE
IF .STMT[OPRS] EQL DOOS THEN
BEGIN
REA(.STMT[DOLPCTL]); !ELIMINATE COMMON SUBS
STMT_.STMT[DOLBL]; !SKIP INNER LOOPS
CSTMNT_STMT_.STMT[SNHDR] !SKIP INNER LOOPS
END
ELSE
IF .STMT[OPRCLS] EQL IOLSCLS THEN
BEGIN
CASE .STMT[OPERSP] OF SET
%DATACALL% REA(.STMT[DCALLELEM]);
%SLISTCALL% BEGIN
REA(.STMT[SCALLCT]);
REA(.STMT[SCALLELEM])
END;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES
END;
CSTMNT_STMT_.STMT[CLINK]
END
END;
GLOBAL ROUTINE GLSTREDUCE=
%(**********************************************************************
ROUTINE TO FIND ALL EXPRESSIONS UNDER STATEMENTS
AND IOLSCLS NODES IN THE I/O LIST AND PASS
THEM TO GLEXREDUCE FOR REDUCTION AND PROPAGATION
**********************************************************************)%
BEGIN
REGISTER BASE IOARRAY;
REGISTER PHAZ2 STMT;
RDUCINIT(); !INITIALIZE REDUCTION GLOBALS
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
IF .STMT[OPRS] EQL ASGNOS THEN
BEGIN
STMT[LHEXP]_GLEXREDUCE(.STMT[LHEXP]); !REDUCE EXPRESSIONS
STMT[RHEXP]_GLEXREDUCE(.STMT[RHEXP]) !REDUCE EXPRESSIONS
END
ELSE
IF .STMT[OPRS] EQL DOOS THEN
BEGIN
STMT[DOLPCTL]_GLEXREDUCE(.STMT[DOLPCTL]); !REDUCE EXPRESSIONS
STMT_.STMT[DOLBL]; !SKIP INNER LOOPS
CSTMNT_STMT_.STMT[SNHDR] !SKIP INNER LOOPS
END
ELSE
IF .STMT[OPRCLS] EQL IOLSCLS THEN
BEGIN
CASE .STMT[OPERSP] OF SET
%DATACALL% STMT[DCALLELEM]_GLEXREDUCE(.STMT[DCALLELEM]);
%SLISTCALL% BEGIN
STMT[SCALLCT]_GLEXREDUCE(.STMT[SCALLCT]);
STMT[SCALLELEM]_GLEXREDUCE(.STMT[SCALLELEM])
END;
%IOLSTCALL% SKERR();
%E1LISTCALL% SKERR();
%E2LISTCALL% SKERR();
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES
END;
CSTMNT_STMT_.STMT[CLINK]
END
END;
GLOBAL ROUTINE GLDOFIND=
%(**********************************************************************
CONTROLLING ROUTINE FOR OPTIMIZATION OF IMPLIED
DO LOOPS
THIS ROUTINE PERFORMS A SIMPLE RECURSIVE STACK WALK OF
THE I/O LIST SEARCHING FOR DO LOOPS
AND PERFORMING SKELETAL OPTIMIZATIONS FOR ALL
STATEMENTS AND IOLSCLS NODES ON THE I/O LIST
WHEN THE END OF AN IMPLIED DO LOOP IS DETECTED, THE
OPTIMIZER GLOBALS LENTRY, TOP, INDVAR, LEND,
AND BOTTOM ARE INITIALIZED FOR THE LOOP JUST DETECTED
AND THE ROUTINES GLSTDFPT, GLSTELIM, GLSTREDUCE, AND
TESTREPLACE ARE CALLED TO PERFORM GLOBAL COMMON SUBEXPRESSION
ELIMINATE, PROPAGATION, REDUCTION, AND TEST REPLACEMENT
FOR THE LOOP
AFTER ALL LOOPS HAVE BEEN DETECTED AND OPTIMIZED, GLDOFIND
RETURNS TO THE CALLING ROUTINE
**********************************************************************)%
BEGIN
LOCAL BASE PREVCONT; !LOCATION OF CONTINUE IN FRONT OF DO
LOCAL BASE CURRDO; !LOCATION OF CURRENT DO NODE
LOCAL PEXPRNODE ARGNODE; !POINTS TO EXPR FOR P2SKELETON
EXTERNAL OBJECTCODE DOWDP; !GLOBAL DO LOOP
IF .CURRELEM[OPRS] EQL DOOS THEN
BEGIN
%(
INSERT A CONTINUE NODE IN THE TREE
IN FRONT OF THE DO LOOP. THIS NODE BECOMES LENTRY WHEN
WE CALL THE OPTIMIZATION ROUTINES
)%
PREVCONT_MAKCONTINUE(); !CREATE A CONTINUE NODE
IF .PREVELEM EQL .SAVSTMNT THEN
SAVSTMNT[IOLIST]_.PREVCONT ELSE
PREVELEM[CLINK]_.PREVCONT; !RELINK PREVIOUS ELEMENT
PREVCONT[SRCLINK]_.CURRELEM; !LINK CONTINUE TO DO
CURRELEM[DOPRED]_.PREVCONT; !LINK DO TO CONTINUE
CURRDO_.CURRELEM; !REMEMBER DO NODE ADR
PREVELEM_.CURRELEM; !POINT TO NEW PREVIOUS NODE
CURRELEM_.CURRELEM[CLINK]; !POINT TO NEXT NODE
END
ELSE CURRDO_0;
%(
SEARCH FOR ANOTHER DO NODE OR THE END OF THE CURRENT
LOOP
)%
WHILE 1 DO
BEGIN
CSTMNT_.CURRELEM; !MARK CURRENT ELEMENT
IF .CURRELEM[OPRCLS] EQL STATEMENT THEN
BEGIN
P2SKSTMNT(); !DO SKELETAL OPTIMIZATIONS
%(
RECURSIVE IF AN INNERMORE DO IS ENCOUNTERED
)%
IF .CURRELEM[SRCID] EQL DOID THEN
BEGIN
GLDOFIND() !FIND INNER DO
END
ELSE
%(
CHECK FOR END OF CURRENT DO
)%
IF .CURRDO NEQ 0 THEN
IF .CURRELEM[SRCID] EQL CONTID THEN
IF .CURRELEM[SRCLBL] EQL .CURRDO[DOLBL] THEN
BEGIN
%(
END OF LOOP DETECTED
OPTIMIZE THE LOOP
-------- --- ----
)%
TOP_.CURRDO; !SET GLOBAL POINTERS
LENTRY_.PREVCONT;
LEND_.TOP[DOLBL];
LEND_.LEND[SNHDR];
IF (BOTTOM_.LEND[SRCLINK]) EQL 0 THEN
BOTTOM_LEND[SRCLINK]_MAKCONTINUE();
INDVAR_.TOP[DOSYM];
GLSTDFPT(); !FILL IN DEF POINTS
GLSTELIM(); !ELIMINATE COMMON SUBS
MOVCNST(); !MOVE CONSTANT COMPUTATIONS
GLOBDEPD(); !COLLECT COMMON SUBS
SCRUBARRAY(); !CLEAN UP ARRAYREFS
SLINGHASH(); !CLEAR HASH TABLE
%(
HASH EXPRESSIONS CREATED BY G;LOBDEPD
INTO THE HASH TABLE
)%
IMPLDO_0; !CLEAR IMPLIED DO FLAG
CNSMOVFLG_1; !SET CNSMOVFLG
CSTMNT_.TOP; !MARK CURRENT STATEMEMENT
WHILE .CSTMNT NEQ .BOTTOM DO
BEGIN
IF .CSTMNT[OPRS] EQL ASGNOS THEN
REA(.CSTMNT[RHEXP]); !REHASH
CSTMNT_.CSTMNT[SRCLINK]
END;
MOVCNST(); !MOVE CONSTANT ASSIGNMENTS
CNSMOVFLG_0; !CLEAR CMNMOVFLG
IMPLDO_1; !RESET IMPLIED DO
GLOBDEPD(); !COLLECT COMMON SUBS
SCRUBARRAY(); !CLEAN UP ARRAYREFS
SLINGHASH(); !CLEAR HASH TABLE
LPRDCCT_.RDCCT; !SET UP REPLACEMENT GLOBALS
GLSTREDUCE(); !REDUCE EXPRESSIONS
!REPLACE AND SUPPLANT
!LOOP INDEX
IF TESTREPLACE() NEQ 0 THEN SUPPLANT();
RETURN
%(
END OF LOOP OPTIMIZATION
--- -- ---- ------------
)%
END
END
ELSE
IF .CURRELEM[OPERSP] EQL DATACALL THEN
BEGIN
%(
DO SKELETAL OPTIMIZATIONS FOR DATACALL NODE
)%
NEGFLG_NOTFLG_FALSE;
ARGNODE_.CURRELEM[DCALLELEM];
ARGNODE_CURRELEM[DCALLELEM]_(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
IF .ARGNODE EQL .DOWDP[DOINDUC] THEN DOWDP[DONOAOBJN]_1;
END;
%(
UPDATE ELEMENT POINTERS
)%
IF (PREVELEM_.CURRELEM) EQL 0 THEN RETURN;
IF (CURRELEM_.CURRELEM[CLINK]) EQL 0 THEN RETURN
END
END;
GLOBAL ROUTINE SKOPTIO=
%(**********************************************************************
ROUTINE INVOKED BY OPTIMIZE SWITCH TO
1) PERFORM PHASE 2 SKELETON ON ALL EXPRESSIONS UNDER AN
I/O LIST
2) PERFORM GLOBAL OPTIMIZATION OF IMPLIED DO LOOPS ON
AN I/O LIST
CALLS GLDOFIND TO MAKE A RECURSIVE STACK WALK
OVER THE I/O LIST AND CALL SKELETAL OPTIMIZATION AND
GLOBAL OPTIMIZATION ROUTINES
CALLED WITH THE GLOBAL CSTMNT POINTING TO A STATEMENT
WITH A POTENTIAL I/O LIST
**********************************************************************)%
BEGIN
IF (CURRELEM_.CSTMNT[IOLIST]) NEQ 0 THEN
BEGIN !AN I/O LIST IS PRESENT
IMPLDO_1; !SET IMPLIED DO OPTIMIZATION
BACKST_0; !GLOBALLY OPTIMIZE
SAVSTMNT_.CSTMNT; !REMEMBER THE I/O STATEMENT
IF .CURRELEM[OPRS] NEQ CONTOS THEN !START LIST WITH CONTINUE
BEGIN !NODE
CURRELEM_MAKCONTINUE(); !INSERT A CONTINUE NODE
CURRELEM[SRCLINK]_.CSTMNT[IOLIST];
CSTMNT[IOLIST]_.CURRELEM
END;
GLDOFIND(); !FIND IMPLIED DO LOOPS
!RECURSIVELY
IMPLDO_0; !CLEAR IMPLIED DO
CSTMNT_.SAVSTMNT !RESTORE CSTMNT
END
END;
%(**********************************************************************
THE MODULE IOPT MAY BE SPLIT HERE TO SEPERATE THE OPTIMIZING
AND I/O LIST COLLPSING ROUTINES
**********************************************************************)%
OWN
INCEXPR, !EXPRESSION IN WHICH INCREMENTED VARIABLE
!WAS DETECTED
INCVAR, !INCREMENTED VARIABLE DETECTED
%[630]% INCBADFORM, !FLAG THAT THE INCREMENTED VARIABLE HAS
%[630]% !BEEN USED IN A WAY THAT PRECLUDES INCLUSION
%[630]% !OF THIS EXPRESSION IN AN SLIST OR ELIST.
INCCOUNT, !NUMBER OF INCREMENTED VARIABS DETECTED
INCFNCTN; !FLAG IF A FUNCTION CALL WAS DETECTED IN
!THE EXPRESSION TREE
%[630]% MAP BASE INCEXPR:INCVAR:INCBADFORM:INCCOUNT:INCFNCTN;
GLOBAL ROUTINE ISOLATE(EXPRNODE,PRNT,FLAGS)= ![630]
%(**********************************************************************
ISOLATES EXPRESSIONS OF THE FORM
INDVAR, .R, INDVAR OP, OR .R OP
IN AN EXPRESSION TREE
RETURNS:
INCEXPR - THE EXPRESSION IN WHICH
THE INCREMENTED VARIABLES WAS DETECTED
INCVAR - THE INCREMENTED VARIABLE DETETCED
[630] INCBADFORM - FLAG IF SOMETHING LIKE A(-I), A((I-1)*3+1),
[630] OR I**3 HAS BEEN DETECTED
INCCOUNT - THE NUMBER OF INCREMENTED VARIABLES DETETCED
INCFNCTN - FLAG IF A FUNCTION CALL WAS SEEN IN THE
TREE
THIS ROUTINE IS USED BY THE COLLAPSING LOGIC TO
DETERMINE IF AN ARBITRARY DATACALL MEETS THE CONDITIONS
WHICH ALLOW THE LOOP TO BE COLLAPSED INTO AN
E1LISTCALL OR E2LISTCALL NODE
CALLED WITH AN EXPRESSION (POTENTIALLY A LEAF) IN
EXPRNODE AND THE "PARENT" OF THAT EXPRESSION
IN PRNT
**********************************************************************)%
BEGIN
LABEL RASGNFIND;
LABEL OASGNFIND;
MAP BASE EXPRNODE:PRNT:FLAGS; ![630] SEE LINES BELOW FOR FLAGS
MACRO ARRSEENFLG=35,1$, ![630] ARRAYREF NODE HAS BEEN SEEN ABOVE
OPNOTADDFLG=0,1$; ![630] * ETC. SEEN ABOVE. MUST BE BIT 35
REGISTER BASE EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
%[630]% FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
END;
%DATAOPR% BEGIN
%(
FOR A .O VARIABLE, WE MUST
IN THE LOOP TO SEE IF THE EXPRESSION ASSIGNED
TO THE .O VARIABLE IS INCREMENTED IN THE LOOP
)%
IF .EXPR[IDDOTO] EQL SIXBIT ".O" THEN
BEGIN
LOCAL BASE ASGN;
ASGN_.TOP[SRCLINK]; !LOOK FOR ASSIGNMENT
OASGNFIND: WHILE .ASGN NEQ .LEND DO
BEGIN
IF .ASGN[OPRS] EQL ASGNOS THEN
IF .ASGN[LHEXP] EQL .EXPR THEN
BEGIN
%(
THE .O VARIABLE IS ASSIGNED
IN THE LOOP. LOOK IN
THE RIGHT HAND EXPRESSION FOR AN
INCREMENTED VARIABLE
)%
%[630]% ISOLATE(.ASGN[RHEXP],.ASGN,.FLAGS);
LEAVE OASGNFIND
END;
ASGN_.ASGN[SRCLINK]
END
END
ELSE
%(
IF THE LEAF IS THE LOOP INDUCTION VARIABLE
INDVAR, WE HAVE FOUND AN INCREMENTED VARIABLE.
SET THE OWNS ACCORDINGLY
)%
IF .EXPR EQL .INDVAR THEN
BEGIN
INCVAR_.EXPR;
INCEXPR_.PRNT;
%[630]% IF .FLAGS<OPNOTADDFLG> OR NOT .FLAGS<ARRSEENFLG>
%[630]% THEN INCBADFORM_TRUE;
INCCOUNT_.INCCOUNT+1
END
ELSE
%(
FOR A .R VARIABLE, WE MUST LOOK IN THE
LOOP TO SEE IF THIS VARIABLE IS INCREMENTED IN
THE LOOP. IF SO, WE HAVE FOUND AN INCREMENTED
VARIABLE. SETS THE OWN ACCORDINGLY
)%
IF .EXPR[IDDOTO] EQL SIXBIT ".R" THEN
BEGIN
LOCAL BASE ASGN;
ASGN_.TOP[SRCLINK];
RASGNFIND: WHILE .ASGN NEQ .LEND DO
BEGIN
IF .ASGN[OPRS] EQL ASGNOS THEN
IF .ASGN[LHEXP] EQL .EXPR THEN
BEGIN
%(
THE .R VARIABLE IS INCREMENTED
IN THE LOOP
)%
INCVAR_.EXPR;
INCEXPR_.PRNT;
%[630]% IF .FLAGS<OPNOTADDFLG> OR NOT .FLAGS<ARRSEENFLG>
%[630]% THEN INCBADFORM_TRUE;
INCCOUNT_.INCCOUNT+1;
LEAVE RASGNFIND
END;
ASGN_.ASGN[SRCLINK]
END
END
END;
%RELATIONAL% BEGIN
%[630]% FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
END;
%FNCALL% BEGIN
%(
FUNCTION CALL DETECTED - SET THE
FUNCTION OWN ACCORDINGLY
)%
INCFNCTN_1
END;
%ARITHMETIC% BEGIN
%[630]% IF .EXPR[OPERSP] NEQ ADDOP THEN FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS OR .EXPR[A1NEGFLG]);
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG])
END;
%TYPECNV% BEGIN
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG])
END;
%ARRAYREF% BEGIN
IF .EXPR[ARG2PTR] NEQ 0 THEN
BEGIN
%[630]% IF .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE
%[630]% ELSE FLAGS<ARRSEENFLG>_TRUE;
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG]);
END
END;
%CMNSUB% BEGIN
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG])
END;
%NEGNOT% BEGIN
%[630]% FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
END;
%SPECOP% BEGIN
%[630]% FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS)
END;
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN END;
%INLINFN% BEGIN
%[630]% FLAGS<OPNOTADDFLG>_TRUE;
%[630]% IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]% ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]% IF .EXPR[ARG2PTR] NEQ 0 THEN ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
END
TES
END;
GLOBAL ROUTINE BLDCMN(EXPR1,EXPR2)=
%(**********************************************************************
BUILD A COMMON SUB NODE WITH EXPRESSIONS
EXPR1 AND EXPR2 AS ARGUMENTS
**********************************************************************)%
BEGIN
MAP BASE EXPR1;
MAP BASE EXPR2;
REGISTER BASE CMNNODE; !NODE BEING BUILT
NAME<LEFT>_EXSIZ; !SET SIZE OF NODE TO BE BUILT
CMNNODE_CORMAN(); !ALLOCATE CORE
CMNNODE[OPRCLS]_CMNSUB; !SET COMMON SUB
CMNNODE[VALTYPE]_.EXPR2[VALTYPE]; !SET VALTYPE
CMNNODE[ARG1PTR]_.EXPR1; !SET ARG1
CMNNODE[ARG2PTR]_.EXPR2; !SET ARG2
IF .EXPR2[OPRCLS] EQL DATAOPR THEN CMNNODE[A2VALFLG]_1
ELSE EXPR2[PARENT]_.CMNNODE;
RETURN .CMNNODE
END;
GLOBAL ROUTINE LCLLNK(CMNSNODE)=
%(**************************************************************
LINK A COMMON SUBEXPRESSION NODE OR STRING OF
COMMON SUBEXPRESSION NODES ONTO THE NODE IONODE
CALLED WITH CMNSNODE POINTING TO THE FIRST (OR ONLY)
COMMON SUB NODE IN THE STRING
RETURNS THE ADDRESS OF THE FIRST COMMON
SUBEXPRESSION LINKED ONTO THE NODE
**************************************************************)%
BEGIN
MAP BASE CMNSNODE;
REGISTER BASE CMNLST;
IF (CMNLST_.IONODE[SRCCOMNSUB]) EQL 0 THEN
BEGIN
%(
COMMON SUB FIELD IS ZERO - SET IT
TO THE FIRST COMMON SUBEXPRESSION NODE IN THE
STRING
)%
IONODE[SRCCOMNSUB]_.CMNSNODE
END
ELSE
BEGIN
%(
COMMON SUBS ALREADY EXIST ON IONODE
FIND THE LAST COMMON SUB NODE AND LINK
THE STRING AFTER IT
)%
WHILE .CMNLST[SRCLINK] NEQ 0 DO
BEGIN !FIND LAST COMMON SUB NODE ON IONODE
CMNLST_.CMNLST[SRCLINK]
END;
CMNLST[SRCLINK]_.CMNSNODE !LINK STRING ONTO CURRENT COMMON
!SUBEXPRESSION STRING
END;
RETURN .CMNSNODE !RETURN POINTER TO FIRST NODE ADDED
END;
%(
ALGORITHM FOR FOLDING A LOOP INTO AN E1LISTCALL OR E2LISTCALL NODE
(MAKELIST)
MAKELIST STARTS WITH A LOOP CONSISTING OF
1) A DO NODE (TOP)
2) A SERIES OF ASSIGNMENT STATEMENTS INITIALIZING
OPTIMIZER CREATED .O VARIABLES
3) A SINGLE IOLSCLS NODE OF TYPE IOLSTCALL OR E1LISTCALL OR
E2LISTCALL
4) A SERIES OF ASSIGNMENT STATEMENTS INCREMENTING OPTIMIZER
CREATED .R VARIABLES
5) A CONTINUE NODE (LEND)
CONTINUE NODES OTHER THAN LEND WERE ELIMINATED
DURING THE LOOP LLAPSING ANALYSIS
MAKELIST
1) RESETS THE OPERATOR FIELD OF THE I/O NODE
TO E1LISTCALL OR E2LISTCALL IF NECESSARY
2) TRANSFORMS ASSIGNMENT STATEMENTS INITIALIZING THE
LOOP INCREMENT AND/OR STEPSIZE IF THEY ARE PRESENT
INTO COMMON SUBEXPRESSIONS
3) TRANSFORMS ALL ASSIGNMENT STATEMENTS IN THE
LOOP INTO COMMON SUBEXPRESSIONS
4) TRANSFORMS THE LOOP INITIAL VALUE AND INCREMENT EXPRESSIONS
INTO COMMON SUBEXPRESSIONS
5) COMPUTES THE NUMBER OF ELEMENTS FROM THE LOOP CONTROL EXPRESSION
AND SETS OR RESETS THE ECNTPTR FIELD OF THE IONODE ACCORDINGLY
6) SUBSTITUTE THE COMMON SUBEXPRESSION NODES
CREATED IN THE ABOVE STEPS FOR THE VARIABLES WHOSE VALUES THEY
ASSIGNED IN THE IONODE
7) ELIMINATES TOP AND LEND AND LINKS THE E1LISTCALL OR
E2LISTCALL NODE CREATED INTO THE TREE
THIS PROCESS HOWEVER, IS REQUIRED TO PRESERVE THE
ORDER IN WHICH THE VARIABLES WERE ASSIGNED IN CREATING
A LINKING THE COMMON SUBEXPRESSION
STATEMENTS REPLACING THE ASSIGNMENT STATEMENTS ONTO THE NODE
TO DO SO, MAKELIST IN FACT BUILDS SIX STRINGS OF
COMMON SUBEXPRESSION NODES AS IT ELIMINATES THE ASIGNMENT
STATEMENTS AND, AFTER ALL SUCH NODES ARE CREATED, LINKS
THEM ONTO THE IONODE
THE ADDRESS OF THE FIRST NODE IN EACH STRING IS MAINTAINED
IN THE OWN VECTOR CHAIN.
THE ROUTINE CHNINIT INITIALIZES THIS VECTOR. CHNLNK IS USED TO
ADD A COMMON SUBEXPRESSION ONTO THE APPROPRIATE CHAIN.
MRGCHN MOVES THESE CHAINS ONTO THE NODE ITSELF.
THE SPECIFIC CHAINS MAINTAINED (IN THE ORDER IN
WHICH THE COMMON SUBEXPRESSION NODES MUST APPEAR ON THE
IONODE) ARE
1) COMMON SUBEXPRESSIONS CREATED FROM THE ASSIGNMENT OF
A VALUE TO THE LOOP STEPSIZE
2) COMMON SUBEXPRESSIONS CREATD FROM THE ASSIGNMENT OF
A VALUE TO THE LOOP INCREMENT
3) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENT
STATEMENT IN FRONT OF THE LOOP INITIALIZING .OPTIMIZER
CREATED .R VARIABLES
4) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENTS IN
THE LOOP OF VALUES TO OPTIMIZER CREATED .O VARIABLES
5) ANY COMMON SUBEXPRESSIONS ORIGINALLY APPEARING ON THE NODE
(FROM FOLDING AN INNER LOOP)
6) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENTS
INCREMENTING THE VALUE OF OPTIMIZER CREATED .R VARIABLES
WHEN CREATED, THE COMMON SUBEXPRESSIONS FOR THE LOOP INCREMENT
AND STEPSIZE VARIABLES ARE LINKED ON THE DOT R VARIABLE CHAIN
SINCE THEY APPEAR ON THE DO NODE WHICH LIES BETWEEN THE
.R INITIALIZING ASSIGNMENT STATEMENTS AND THE .O INITIALIZING
ASSIGNMENT STATEMENTS
THE ROUTINES FINDASGN, ELIMTEMP, AND ELIMSTEP ARE USED
TO LOCATE AND ELIMINATE ASSIGNMENT STATEMENTS
)%
OWN CHAIN[6]; !COMMON SUBEXPRESSION CHAIN VECTOR
!DEFINE SYMBOLS TO REFER SYMBOLICALLY TO
!EACH COMMON SUBEXPRESSIONC CHAIN
BIND
DOTS=0, !STEPSIZE CHAIN
DOTI=1, !INITIAL VALUE CHAIN
DOTR=2, !INITIAL .R VARIABLE VALUE CHAIN
DOTO=3, !.O VARIABLE VALUE CHAIN
OLDC=4, !OLD COMMON SUBEXPRESSIONS
RINC=5; !.R VARIABLE INCREMENT CHAIN
GLOBAL ROUTINE CHNINIT=
%(**********************************************************************
CLEAR THE CHAIN VECTOR AND MOVE THE CURRENT
COMMON SUBEXPRESSION CHAIN INTO THE OLDC
CHAIN
**********************************************************************)%
BEGIN
DECR I FROM 5 TO 0 DO
BEGIN
CHAIN[.I]_0
END;
CHAIN[OLDC]_.IONODE[SRCCOMNSUB];
IONODE[SRCCOMNSUB]_0
END;
GLOBAL ROUTINE CHNLNK(CMNSNODE,INDEX)=
%(**********************************************************************
LINK THE COMMONN SUBEXPRESSION NODE CMNSNODE ONTO
THE CHAIN WHOSE SYMBOLIC NOME IS INDEX
**********************************************************************)%
BEGIN
MAP BASE CMNSNODE:INDEX;
REGISTER BASE CMNLST;
IF (CMNLST_.CHAIN[.INDEX]) EQL 0 THEN
BEGIN
%(
EMPTY CHAIN - INITIALIZE WITH CMNSNODE
)%
CHAIN[.INDEX]_.CMNSNODE
END
ELSE
BEGIN
%(
SEARCH FOR END OF CHAIN AND LINK
CMNSNODE ONTO THE CHAIN
)%
WHILE .CMNLST[SRCLINK] NEQ 0 DO
BEGIN
CMNLST_.CMNLST[SRCLINK]
END;
CMNLST[SRCLINK]_.CMNSNODE
END;
RETURN .CMNSNODE !RETURNS THE ADDRESS OF THE COMMON
!SUBEXPRESSION NODE LINKED
END;
GLOBAL ROUTINE MRGCHN=
%(**********************************************************************
LINK THE CHAINS IN THE CORRECT ORDER ON THE
IONODE USING LCLLNK
**********************************************************************)%
BEGIN
INCR I FROM 0 TO 5 DO
BEGIN
IF .CHAIN[.I] NEQ 0 THEN LCLLNK(.CHAIN[.I])
END
END;
GLOBAL ROUTINE FINDASGN(VARPTR)=
%(**********************************************************************
FIND AN ASSIGNMENT STATEMENT OF A VALUE TO
THE VARIABLE VARPTR IN FRONT OF OR IN THE CURRENT
LOOP ON THE I/O LIST
RETURN THE ADDRESS OF THE NODE IN FRONT OF
THE ASSIGNMENT STATEMENT OR 0 IF NO ASSIGNMENT
STATEMENT EXISTS
**********************************************************************)%
BEGIN
MAP BASE VARPTR;
LABEL SRCH1;
LOCAL BASE PREVSTMT;
LOCAL BASE CURRSTMT;
PREVSTMT_.SAVSTMNT; !SEARCH FOR ASSIGNMENT
CURRSTMT_.SAVSTMNT[IOLIST]; !SEARCH FOR ASSIGNMENT
SRCH1:
WHILE .CURRSTMT NEQ .LEND DO !SEARCH AS FAR AS LEND
BEGIN
IF .CURRSTMT[OPRS] EQL ASGNOS THEN
IF .CURRSTMT[LHEXP] EQL .VARPTR THEN
LEAVE SRCH1;
PREVSTMT_.CURRSTMT; !ADVANCE POINTER
CURRSTMT_.CURRSTMT[SRCLINK] !ADVANCE POINTER
END;
RETURN IF .CURRSTMT EQL .LEND THEN 0 ELSE .PREVSTMT
END;
GLOBAL ROUTINE ELIMTEMP(VARPTR,ASGNPTR,INDEX)=
%(**********************************************************************
ROUTINE TO ELIMINATE THE TEMPORARY POINTED BY VARPTR
AND CREATE A COMMON SUBEXPRESSION NODE OF THE
ASSIGNMENT OF A VALUE TO THAT TEMPORARY AT THE
STATEMENT AFTER ASGNPTR
THE FORMAL INDEX INDICATES WHICH CHAIN THE COMMON
SUBEXPRESSION IS TO BE LINKED INTO
**********************************************************************)%
BEGIN
MAP BASE VARPTR;
MAP BASE ASGNPTR;
LOCAL BASE ASGNNODE;
LOCAL BASE CMNNODE;
IF .ASGNPTR EQL 0 THEN RETURN; !NO ASSIGNMENT STATEMENT - DO NOT
!ELIMINATE VARPTR
ASGNNODE_.ASGNPTR[SRCLINK]; !FIND THE ASSIGNMENT STATEMENT
ASGNPTR[SRCLINK]_.ASGNNODE[SRCLINK]; !LINK THE ASSIGNMENT STATEMENT OUT OF THE TREE
CMNNODE_CHNLNK(BLDCMN(.VARPTR,.ASGNNODE[RHEXP]),.INDEX); !BUILD AND LINK COMMON SUB NODE
VARPTR[IDATTRIBUT(NOALLOC)]_1; !NOALLOCATE THE VARIABLE
SAVSPACE(ASGNSIZ+SRCSIZ-1,.ASGNNODE); !DEALLOCATE THE ASSIGNMENT STATEMENT
RETURN .CMNNODE !RETURN THE ADDRESS OF THE COMMON SUBEXPRESSION
!NODE CREATED
END;
GLOBAL ROUTINE ELIMSTEP(VARPTR,ASGNPTR)=
%(**********************************************************************
ROUTINE TO ELIMINATE THE ASSIGNMENT STATEMENT
INCREMENTING THE VALUE OF THE .R TEMPORARY
VARPTR AND GENERATE A COMMON SUBEXPRESSION NODE
FOR THE INCREMENT EXPRESSION
VARPTR POINTS TO THE SYMBOL TABLE ENTRY FOR THE
.R VARIABLE
ASGNPTR POINTS TO THE STATEMENT IN FRONT OF
THE ASSIGNMENT STATEMENT TO BE ELIMINATED
**********************************************************************)%
BEGIN
MAP BASE ASGNPTR;
MAP BASE VARPTR;
LOCAL BASE ASGNNODE;
LOCAL BASE CMNEXPR;
LOCAL BASE CMNNODE;
ASGNNODE_.ASGNPTR[SRCLINK]; !LOCATE THE ASSIGNMENT STATEMENT
CMNEXPR_.ASGNNODE[RHEXP]; !ISOLATE THE EXPRESSION .R + I OR I + .R
ASGNPTR[SRCLINK]_.ASGNNODE[SRCLINK]; !LINK THE ASSIGNMENT STATEMENT OUT OF THE TREE
SAVSPACE(ASGNSIZ+SRCSIZ-1,.ASGNNODE); !DEALLOCATE THE ASSIGNMENT STATEMENT
CMNNODE_CHNLNK(BLDCMN(0,IF .CMNEXPR[ARG1PTR] NEQ .VARPTR THEN
.CMNEXPR[ARG1PTR] ELSE .CMNEXPR[ARG2PTR]),RINC); !BUILD AND LINK COMMON SUB NODE
SAVSPACE(EXSIZ-1,.CMNEXPR); !DEALLOCATE THE .R + I OR
!I + .R EXPRESSION
RETURN .CMNNODE !RETURN THE ADDRESS OF THE COMMON
!SUBEXPRESSION NODE CREATED
END;
GLOBAL ROUTINE DIV2CMN(CMNNODE,INDEX)=
%(**********************************************************************
GENERATE A COMMON SUB FOR CMNNODE / 2
USING SPECOP P2MULOP
**********************************************************************)%
BEGIN
MAP BASE CMNNODE;
LOCAL BASE DIV2NODE;
LOCAL BASE DIV2CMNNODE;
DIV2NODE_MAKEPR(SPECOP,P2MULOP,.CMNNODE[VALTYPE],.CMNNODE,-1); !GENERATE SPECOP NODE
DIV2NODE[A1VALFLG]_1; !SET VALFLG
DIV2CMNNODE_CHNLNK(BLDCMN(0,.DIV2NODE),.INDEX); !BUILD AND LINK NEW COMMON
!SUB NODE
RETURN .DIV2CMNNODE
END;
GLOBAL ROUTINE CHKDBLSUB(EXPR)=
%(**********************************************************************
ROUTINE TO DETERMINE IF AN EXPRESSION IS A DOUBLE PRECISION
ARRAYREFERENCE WITH A MULTIPLICATION BY 2
AS THE FIRST EXPRESSION UNDER THE SUBSCRIPT
RETURNS 0 IF THE EXPRESSION IS NOT A DOUBLE WORD ARRAYREF
WITH A MULTIPLICATION BY 2 FOLDED INTO THE SUBSCRIPT
**********************************************************************)%
BEGIN
MAP BASE EXPR; !MAP THE EXPRESSION NODE
IF .EXPR[OPRCLS] EQL ARRAYREF THEN !TEST FOR ARRAYREF
IF .EXPR[ARG2PTR] NEQ 0 THEN !WITH A SUBSCRIPT
IF DBLFROMVAL(.EXPR[VALTYPE]) THEN !CHECK THAT ARRAY IS
!DOUBLE PRECISION OR COMPLEX
BEGIN
LOCAL BASE SBSCRPT; !ALLOCATE TEMP FOR SUBSCRIPT
SBSCRPT_.EXPR[ARG2PTR]; !LOOK AT SUBSCRIPT
IF .SBSCRPT[OPR1] EQL MULOPF THEN !IF THIS IS A MULTIPLY
BEGIN
LOCAL BASE SUBARG; !ALLOW A LOCAL
SUBARG_.SBSCRPT[ARG1PTR]; !LOOK AT FIRST ARG
IF .SUBARG[OPR1] EQL CONSTFL THEN
IF .SUBARG[CONST1] EQL 0 AND
.SUBARG[CONST2] EQL 2 THEN
RETURN 0;
SUBARG_.SBSCRPT[ARG2PTR]; !LOOK AT 2ND ARG
IF .SUBARG[OPR1] EQL CONSTFL THEN
IF .SUBARG[CONST1] EQL 0
AND .SUBARG[CONST2] EQL 2 THEN
RETURN 0
END;
RETURN 1 !ARRAYREF WITH MULTIPLICATION BY 2
!FOLDED
END;
RETURN 0
END;
GLOBAL ROUTINE MAKELIST(LCLASS)=
%(**********************************************************************
ROUTINE TO TRANSFORM A LOOP INTO AN
E1LISTCALL OR E2LISTCALL NODE
CALLED FROM COLLAPSE UNDER THE FOLLOWING:
LCLASS CONDITION
------ ---------
0 AN INNER LOOP HAS ALREADY BEEN FOLDED
INTO AN E1LISTCALL OR E2LISTCALL
NODE. MAKELIST WILL DO COMMON SUBEXPRESSION
GENERATION AND UPDATE THE COUNT
EXPRESSION FOR THE ELISTCALL
NODE
1 INNERMOST LOOP TO BE FOLDED INTO
AN E1LISTCALL NODE
2 INNERMOST LOOP TO BE FOLDED INTO AN
E2LISTCALL NODE
IF LCLASS EQL 1 OR 2, THE LOOP CONTAINS EXACLTY ONE
IOSLCLS NODE OF TYPE IOLSTCALL TO BE TRANSFORMED
INTO AN E1LISTCALL OR E2LISTCALL NODE. WHEN COLLPASE
GENERATED THIS NODE IT ALLOWED AN EXTRA WORD FOR THE
E1INCR AND ECNTPTR FIELDS WHICH DO NOT NORMALLY
APPEAR IN AN IOLSTCALL NODE
SEE DOCUMENTATION IN FRONT OF ROUTINE LCLLNK
FOR A BASIC FUNCTIONAL DESCRIPTION OF
MAKELIST
**********************************************************************)%
BEGIN
MAP BASE LCLASS;
LOCAL BASE PREV;
LOCAL BASE CURR;
%(***INITIALIZE COLLECTION OF COMMON SUBS***)%
CHNINIT();
%(***RESET OPERATOR FIELD OF NODE IF NECESSARY***)%
IF .LCLASS NEQ 0 THEN
BEGIN
IONODE[OPERATOR]_IF .LCLASS EQL 1 THEN E1LISTCFL ELSE E2LISTCFL
END;
%(***COLLECT ALL POTENTIAL COMMON SUBS UNDER THE ELISTNODE***)%
IF .TOP[INITLTMP] THEN !ELIMINATE INCREMENT TEMPORARY
BEGIN
ELIMTEMP(.TOP[DOM1],FINDASGN(.TOP[DOM1]),DOTI)
END;
IF .TOP[SSIZINTMP] THEN !ELIMINATE STEPSIZE TEMPORARY
BEGIN
ELIMTEMP(.TOP[DOM3],FINDASGN(.TOP[DOM3]),DOTS)
END;
CURR_.IONODE[ELSTPTR]; !RECLASSIFY DATACALL NODES
WHILE .CURR NEQ 0 DO
BEGIN
CURR[OPERSP]_IF CHKDBLSUB(.CURR[E2ARREFPTR]) THEN
EDBLELEM ELSE ESNGLELEM;
CURR_.CURR[CLINK]
END;
PREV_.TOP; !ELIMINATE ASSIGNMENT STATEMENTS TO
!OPTIMIZER CREATED TEMPORARIES IN THE LOOP
WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
IF .CURR[OPRS] EQL ASGNOS THEN
BEGIN
LOCAL BASE VARPTR;
VARPTR_.CURR[LHEXP];
%(
CONVERT ASSIGNMENTS TO .O
VARIABLES INTO COMMON SUBS
)%
IF .VARPTR[IDDOTO] EQL SIXBIT ".O" THEN
BEGIN
ELIMTEMP(.VARPTR,FINDASGN(.VARPTR),DOTO)
END
ELSE
%(
ANY ASSIGNMENT STATEMENTS TO .R TEMPORARIES
DETECTED IN THE LOOP ARE INCREMENT EXPRESSION
FIRST LOCATE AND TRANSFORM INTO
A COMMON EXPRESSION THE ASSIGNMENT STATEMENT
OUTSIDE THE LOOP INITIALIZING THE
.R TEMPORARY
THEN, GENERATE A COMMON SUBEXPRESSION NODE
VIA ELIMSTEP FOR THE INCREMENT
IF LCLASS IS NOT 0 SUBSTITUTE THIS EXPRESSION
IN THE E2INCR FIELD FOR ALL ARRAYS INCREMENTED
BY THE .R VARIABLE
)%
IF .VARPTR[IDDOTO] EQL SIXBIT ".R" THEN
BEGIN
!LOCATE AND ELIMINATE THE ASSIGNMENT
!STATEMENT INITIALIZING THE .R
!VARIABLE
ELIMTEMP(.VARPTR,FINDASGN(.VARPTR),DOTR);
!ELIMINATE THE INCREMENTING ASSIGNMENT
!STATEMENT AND SUBSTITUTE FOR THE
!INCREMENT EXPRESSION IN THE APPROPRIATE
!ELIST SUBNODES
!ALSO GENERATE A COMMON SUB FOR
!INCREMENT DIVIDED BY 2 IN CASE TWO
!WORD ELEMENT
IF .LCLASS NEQ 0 THEN
BEGIN
LOCAL BASE DIV2NODE;
LOCAL BASE CMNNODE;
LOCAL BASE IOARRAY;
CMNNODE_ELIMSTEP(.VARPTR,.PREV);
DIV2NODE_DIV2CMN(.CMNNODE,RINC);
IOARRAY_.IONODE[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF .IOARRAY[E2INCR] EQL .VARPTR THEN
IOARRAY[E2INCR]_IF .IOARRAY[OPERSP] EQL EDBLELEM THEN
.DIV2NODE ELSE .CMNNODE;
IOARRAY_.IOARRAY[CLINK]
END
END
ELSE
BEGIN
PREV[SRCLINK]_.CURR[SRCLINK];
SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR)
END
END
ELSE
BEGIN
PREV_.PREV[SRCLINK]
END
END
ELSE
BEGIN
PREV_.PREV[SRCLINK]
END
END;
%(***GENERATE A COMMON SUBEXPRESSION FOR THE LOOP INCREMENT FOR
AN E1LISTCALL OR E2LISTCALL NODE***)%
IF .LCLASS NEQ 0 THEN
BEGIN
LOCAL BASE CMNNODE;
LOCAL BASE DIV2NODE;
CMNNODE_CHNLNK(BLDCMN(0,.TOP[DOM3]),DOTR); !BUILD INITIAL COMMON SUB NODE
DIV2NODE_DIV2CMN(.CMNNODE,DOTR); !BUILD DEFAULT COMMON SUB NODE
%(
SUBSTITUTE COMMON SUBEXPRESSION FOR ELIST SUB NODES
WHOSE INCREMENT VARIABLE WAS THE TOP LOOP INDUCTION
VARIABLE
OR SET E1INCR
)%
CURR_.IONODE[ELSTPTR];
WHILE .CURR NEQ 0 DO
BEGIN
IF .LCLASS EQL 1 THEN !SET E1INCR
BEGIN
CURR[E2INCR]_0; !CLEAR E2INCR
IONODE[E1INCR]_IF .CURR[OPERSP] EQL EDBLELEM THEN
.DIV2NODE ELSE .CMNNODE
END
ELSE
IF .LCLASS EQL 2 THEN
BEGIN
IF .CURR[E2INCR] EQL .INDVAR THEN
CURR[E2INCR]_IF .CURR[OPERSP] EQL EDBLELEM THEN
.DIV2NODE ELSE .CMNNODE
END;
CURR_.CURR[CLINK]
END
END;
%(***GENERATE A COMMON SUBEXPRESSION NODE FOR THE INITIAL
VALUE OF THE LOOP INDUCTION VARIABLE***)%
CHNLNK(BLDCMN(.INDVAR,.TOP[DOM1]),DOTR); !BUILD AND LINK NODE
IF .INDVAR[IDDOTO] EQL SIXBIT ".R" THEN INDVAR[IDATTRIBUT(NOALLOC)]_1; !NOALLOC OPTIMIZER CREATED INDUCTION VARIABLE
%(***SET THE # OF ELEMENTS***)%
CURR_.IONODE[ECNTPTR]; !REMMEBER PREVIOUS COUNT FOR LCLASS EQL 0
IONODE[ECNTPTR]_.TOP[DOLPCTL]; !LOCATE COUNT EXPRESSION
!CONVERT COUNT EXPRESSION TO
!A POSITIVE EXPRESSION
IF .TOP[FLCWD] THEN
BEGIN
!TRANSFORM AOBJN CONTROL WORD
!BY GENERATING POSITIVE CONSTANT
!FROM NEGATIVE COUNT IN LEFT HALF
!OF LOOP CONTROL CONSTANT
LOCAL BASE NEGEXPR;
NEGEXPR_.IONODE[ECNTPTR];
NEGEXPR<RIGHT>_.NEGEXPR[CONST2]<LEFT>;
NEGEXPR<LEFT>_-1;
IONODE[ECNTPTR]_MAKECNST(INTEGER,0,-.NEGEXPR)
END
ELSE
IF NOT .TOP[CTLNEG] THEN
BEGIN
!NEGATE THE LOOP CONTROL EXPRESSION
!IF IT IS NEGATIVE (TOP[CTLNEG]) NOT SET
LOCAL BASE NEGCNTPTR;
NEGCNTPTR_.IONODE[ECNTPTR];
!IF CONTROL EXPRESSION POINTS TO
!A NEGATE NODE ELIMINATE THE NEGATE
!NODE
IF .NEGCNTPTR[OPR1] EQL NEGFL THEN
BEGIN
IONODE[ECNTPTR]_.NEGCNTPTR[ARG2PTR];
SAVSPACE(EXSIZ-1,.NEGCNTPTR)
END
ELSE
!IF CONTROL EXPRESSION IS A
!CONSTANT GENERATE A POSITIVE CONSTANT
!VIA NEGCNST
IF .NEGCNTPTR[OPR1] EQL CONSTFL THEN
BEGIN
IONODE[ECNTPTR]_NEGCNST(NEGCNTPTR)
END
ELSE
!TRY TO PROPAGATE A NEGATIVE
!IF THIS FAILS GENERATE A
!NEGATE NODE AND PLACE THE
!ORIGINAL CONTROL EXPRESSION
!UNDER IT
BEGIN
IF NOT PROPNEG(.IONODE[ECNTPTR]) THEN
IONODE[ECNTPTR]_MAKPR1(0,NEGNOT,NEGOP,.NEGCNTPTR[VALTYPE],0,.NEGCNTPTR)
END
END;
%(***CREATE NEW COUNT EXPRESSION FOR LCLASS EQL 0***)%
IF .LCLASS EQL 0 THEN
BEGIN
!BUILD A MULTIPLY OF THE OLD VALUE OF ECNTPTR AND THE
!NEW VALUE OF ECNTPTR
!THIS EXPRESSION WILL BE FOLDED DURING THE CALL TO
!CMNELIM BELOW
IONODE[ECNTPTR]_MAKPR1(0,ARITHMETIC,MULOP,.CURR[VALTYPE],.CURR,.IONODE[ECNTPTR])
END;
%(***MERGE COMMON SUBEXPRESSION CHAINS***)%
MRGCHN();
%(***SUBSITITUTE THE COMMON SUBEXPRESSIONS INTO THE ELISTCALL NODE***)%
%(
WHEN THE COMMON SUBEXPRESSION NODES WERE GENERATED BY
ELIMTEMP A POINTER TO THE VARIABLE ASSIGNED BY
THE ASSIGNMENT STATEMENT ELIMINATED WAS PLACED IN
ARG1PTR. FOR EACH COMMON SUBEXPRESSION NODE WITH ARG1PTR NEQ 0
SUBSTITUTE THAT COMMON SUBEXPRESSION NODE FOR ALL
OCCURENCES OF THE VARIABLE POINTED TO BY ARG1PTR
A MODIFIED FORM OF THE LEAFSUBSTITUTION SCHEME USED ELSEWHERE
IN THE OPTIMIZER IS EMPLOYED HERE. THE VECTORS GLOBREG AND
CHOSEN ARFE INITIALIZED TO POINT TO THE VALUES TO BE SUBSTITED
FOR AND THE VALUE SUBSTITUTED. THE GLOBAL ITMCT HOLDS THE NUMBER
OF SUCH ITEMS TO BE SUBSTITUTED. THE ROUTINE CMNRPLC PERFORMS
PARALLEL SUBSTITUION OF THE VALUES IN CHOSEN FOR THE VALUES IN
GLOBREG
)%
CURR_.IONODE[SRCCOMNSUB];
LOWLIM_1; !SET LOWLIM FOR SWAPEM
SPECCASE_ITMCT_0;
WHILE .CURR NEQ 0 DO
BEGIN
%(
INITIALIZE THE VECTORS GLOBREG AND CHOSEN
)%
IF .CURR[ARG1PTR] NEQ 0 THEN
BEGIN
ITMCT_.ITMCT+1;
GLOBREG[.ITMCT]_.CURR[ARG1PTR];
CHOSEN[.ITMCT]_.CURR
END;
IF (.CURR[SRCLINK] EQL 0 AND .ITMCT NEQ 0) OR .ITMCT EQL 15 THEN
BEGIN
CMNRPLC(.IONODE); !SUBSTITUTE
ITMCT_0
END;
CURR_.CURR[SRCLINK]
END;
%(***REMOVE TOP AND LEND AND LINK NODE INTO TREE***)%
IF .TOP[SRCLINK] NEQ .IONODE THEN SKERR(); !CONSISTENCY CHECKS
IF .IONODE[SRCLINK] NEQ .LEND THEN SKERR();
IF .LEND[SRCLINK] NEQ .BOTTOM THEN SKERR();
PREVELEM_.SAVSTMNT[IOLIST]; !LOCATE NODE IN FRONT OF THE DO NODE TOP
WHILE .PREVELEM[SRCLINK] NEQ .TOP DO
BEGIN
PREVELEM_.PREVELEM[SRCLINK]
END;
SAVSPACE(CONTSIZ+SRCSIZ-1,.LEND); !DEALLOCTE LEND
CURR_.TOP[DOCTLVAR]; !NOALLOCATE THE .S CONTROL
CURR[IDATTRIBUT(NOALLOC)]_1; !VARIABLE FOR THE LOOP
SAVSPACE(DOSIZ+SRCSIZ-1,.TOP); !DEALLOCATE TOP
CURRELEM_PREVELEM[SRCLINK]_.IONODE; !LINK IN THE E1LISTCALL OR
!E2LISTCALL NODE
IONODE[SRCLINK]_.BOTTOM; !FORWARD LINK THE ELIST NODE
CMNELIM(); !PERFORM COMMON SUBEXPRESSION ELIMINATION
!AND LOCAL DEPENDENCY
RETURN .IONODE !RETURN THE ADDRESS OF THE IONODE
END;
GLOBAL ROUTINE ELIMCONT=
%(**********************************************************************
ROUTINE TO ELIMINATE CONTINUE STATEMENTS IN A LOOP
ELIMINATES ALL CONTINUES BETWEEN TOP AND LEND
EXCEPT CONTINUES TERMINATING INNER LOOPS
EXCLUSIVE
**********************************************************************)%
BEGIN
LOCAL BASE PREV;
LOCAL BASE CURR;
LABEL SEARCH;
PREV_.TOP; !POINT AT LOOP START
SEARCH:
WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
IF .CURR EQL 0 THEN LEAVE SEARCH;
IF .CURR[OPRS] EQL CONTOS THEN
BEGIN
%(
DELINK AND DEALLOCATE CONTINUE
STATEMENT
)%
PREV[SRCLINK]_.CURR[SRCLINK];
SAVSPACE(SRCSIZ+CONTSIZ-1,.CURR)
END
ELSE
IF .CURR[OPRS] EQL DOOS THEN
BEGIN
%(
SKIP OVER INNER LOOPS
)%
PREV_.CURR[DOLBL];
PREV_.PREV[SNHDR]
END
ELSE
PREV_.PREV[SRCLINK]
END
END;
GLOBAL ROUTINE EXPEXP(XP1,XP2)=
%(**********************************************************************
ROUTINE TO FOLD TWO POTENTIAL EXPRESSIONS
RETURNS A POINTER TO THE FOLDED EXPRESSION
OR 0 IF EITHER XP1 OR XP2 IS A NOT AN
INTEGER OR THEIR PRODUCT IS NOT A SINGLE
DATAOPR
**********************************************************************)%
BEGIN
EXTERNAL NEGFLG;
EXTERNAL NOTFLG;
EXTERNAL ARSKOPT;
LOCAL BASE EXPR;
MAP BASE XP1:XP2;
WHILE .XP1[OPRCLS] EQL CMNSUB DO XP1_.XP1[ARG2PTR];
IF .XP1[OPRCLS] NEQ DATAOPR THEN RETURN 0;
IF .XP1[VALTYPE] NEQ INTEGER THEN RETURN 0;
WHILE .XP2[OPRCLS] EQL CMNSUB DO XP2_.XP2[ARG2PTR];
IF .XP2[OPRCLS] NEQ DATAOPR THEN RETURN 0;
IF .XP2[VALTYPE] NEQ INTEGER THEN RETURN 0;
NEGFLG_NOTFLG_FALSE;
%(
CREATE AND FOLD XP1 * XP2
)%
EXPR_ARSKOPT(MAKPR1(0,ARITHMETIC,MULOP,INTEGER,.XP1,.XP2));
IF .EXPR[OPRCLS] EQL DATAOPR THEN RETURN .EXPR ELSE
BEGIN
%(
PRODUCT WAS NOT A DATAOPR
ELIMINATE THE EXPRESSION CREATED
)%
SAVSPACE(EXSIZ-1,.EXPR);
RETURN 0
END
END;
GLOBAL ROUTINE IOCONTVAR(ELEM,VAR)=
%(**********************************************************************
ROUTINE TO CHECK IF AN IOLSCLS ELEMENT CONTAINS THE
VARIABLE VAR
**********************************************************************)%
BEGIN
MAP BASE ELEM;
MAP BASE VAR;
CASE .ELEM[OPERSP] OF SET
%DATACALL% RETURN CONTVAR(.ELEM[DCALLELEM],.VAR);
%SLISTCALL% RETURN CONTVAR(.ELEM[SCALLELEM],.VAR) OR
CONTVAR(.ELEM[SCALLCT],.VAR);
%IOLSTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.ELEM[SRCCOMNSUB];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END;
IOARRAY_.ELEM[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF IOCONTVAR(.IOARRAY,.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END
END;
%E1LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.ELEM[SRCCOMNSUB];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END;
IOARRAY_.ELEM[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTVAR(.IOARRAY[E2ARREFPTR],.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END;
RETURN CONTVAR(.ELEM[ECNTPTR],.VAR) OR CONTVAR(.ELEM[E1INCR],.VAR)
END;
%E2LISTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.ELEM[SRCCOMNSUB];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END;
IOARRAY_.ELEM[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTVAR(.IOARRAY[E2INCR],.VAR) OR
CONTVAR(.IOARRAY[E2ARREFPTR],.VAR) THEN
RETURN 1
ELSE IOARRAY_.IOARRAY[CLINK]
END;
RETURN CONTVAR(.ELEM[ECNTPTR],.VAR)
END;
%ESNGLELEM% SKERR();
%EDBLELEM% SKERR()
TES;
RETURN 0
END;
GLOBAL ROUTINE PUTBAK=
%(**********************************************************************
ROUTINE TO PUT BACK COMMON SUBEXPRESSIONS CREATED
BY THE GLOBAL OPTIMIZER IF THEY ARE IN FACT LOCAL
COMMON SUBEXPRESSIONS UNDER A SINGLE IOLSCLS NODE
**********************************************************************)%
BEGIN
LOCAL BASE CURR; !CURRENT NODE
LOCAL BASE PREV; !PREVIOUS NODE
%(***ESTABLISH BACK POINTERS***)%
CURR_.TOP; !LOCATE FIRST NODE
PREV_.TOP[SRCLINK]; !LOCATE NEXT NODE
WHILE .PREV NEQ .LEND DO
BEGIN
PREV[CW0L]_.CURR;
CURR_.PREV;
![1036], Do not skip over inner loops - we now need complete back pointers
![1036], to implement edit 1007 properly. Without them we can end up
![1036], stepping on register zero with random consequences (all bad!).
![1036] IF .PREV[OPRS] EQL DOOS THEN
![1036] BEGIN
![1036] PREV_.PREV[DOLBL];
![1036] PREV_.PREV[SNHDR];
![1036] END
![1036] ELSE
PREV_.PREV[SRCLINK];
END;
%(
SEARCHING FOR ASSIGNMENTS STATEMENTS BACKWARDS FROM CURR
SEARCH FOR ALL ASSIGNMENTS TO .O VARIABLES IN THE LOOP
)%
WHILE .CURR NEQ .TOP DO
BEGIN
IF .CURR[OPRS] EQL ASGNOS THEN
BEGIN
LOCAL BASE OVAR;
OVAR_.CURR[LHEXP]; !LOCATE VARIABLE BEGING ASSIGNED
IF .OVAR[IDDOTO] EQL SIXBIT ".O" THEN
BEGIN
%(
COUNT THE NUMBER OF OTHER ELEMENTS REFERENCING
OVAR IN THE LOOP
)%
LOCAL BASE OCOUNT; !COUNT OF STATEMENTS
!REFERENCING OVAR
%[1111]% LOCAL BASE OSTEP; !STEP SIZE OVAR SEEN
LOCAL BASE OSEEN; !NODE WHERE LAST SEEN
LOCAL BASE OCURR; !NODE WE ARE LOOKING AT
%[1111]% OCOUNT_OSTEP_OSEEN_0; !CLEAR LOCAL VARS
OCURR_.CURR[SRCLINK]; !INITIALIZE SEARCH
WHILE .OCURR NEQ .LEND DO
BEGIN
IF .OCURR[OPRS] EQL ASGNOS THEN
BEGIN
IF CONTVAR(.OCURR[LHEXP],.OVAR)
OR CONTVAR(.OCURR[RHEXP],.OVAR)
THEN
BEGIN
OSEEN_.OCURR;
OCOUNT_.OCOUNT+1
END
END
ELSE
IF .OCURR[OPRS] EQL DOOS THEN
BEGIN
IF CONTVAR(.OCURR[DOLPCTL],.OVAR)
THEN
BEGIN
OSEEN_.OCURR;
OCOUNT_.OCOUNT+1
END;
%[753]% IF CONTVAR(.OCURR[DOM1],.OVAR)
%[753]% THEN
%[753]% BEGIN ! .O IN INITIAL VALUE
%[753]% OSEEN_.OCURR;
%[753]% OCOUNT_.OCOUNT+1
%[753]% END;
!WHEN TESTING FOR THE USE OF .O VARIABLES,
! BE SURE TO CHECK THE INCREMENT FIELD OF
! REDUCTION IN STRENGTH WHICH MAY OCCUR
IF CONTVAR(.OCURR[DOM3],.OVAR)
THEN
BEGIN
%[1111]% OSTEP_1;
OSEEN_.OCURR;
OCOUNT_.OCOUNT+1
END
END
ELSE
IF .OCURR[OPRCLS] EQL IOLSCLS THEN
BEGIN
IF IOCONTVAR(.OCURR,.OVAR) THEN
BEGIN
![1007] In the unusual case that a DATACALL node points to an array ref
![1007] and the subscript calculation contains 2 or more references to
![1007] the same .O variable, a common sub replacement can occur.
![1007] For such a case, link the DATACALL node under an IOLSTCALL
![1007] node, so that storing the common sub pointer will not trash
![1007] some random word.
%[1007]% IF .OCURR[OPERSP] EQL DATACALL
%[1007]% THEN
%[1007]% BEGIN
%[1007]% LOCAL BASE IOLNODE;
%[1007]% SIZOFENTRY_IOLCSIZ; !SETUP IOLSTCALL NODE
%[1007]% IOLNODE_CORMAN();
%[1007]% IOLNODE[OPERATOR]_IOLSTCFL;
%[1007]% IOLNODE[IOLSTPTR]_.OCURR;
%[1007]% IOLNODE[CLINK]_.OCURR[CLINK]; !LINK IN DATACALL
%[1007]% IOLNODE[CW0L]_.OCURR[CW0L];
%[1007]% OCURR[CLINK]_0; !CLEANUP DATACALL LINKS
%[1007]% OCURR[CW0L]_0;
%[1007]% PREV_.IOLNODE[CW0L]; !LINK IOLSTCALL TO IOLIST
%[1007]% PREV[CLINK]_.IOLNODE;
%[1007]% OCURR_.IOLNODE !CORRECT CURRENT POINTER
%[1007]% END;
OSEEN_.OCURR;
OCOUNT_.OCOUNT+1
END
END;
OCURR_.OCURR[SRCLINK]
END;
%(
ELIMINATE UNUSED COMMON EXPRESSIONS
CREATED BY OPTIMIZER AND OBSOLETED
BY COLLAPSING OF INNER LOOP
INTO AN ELISTCALL NODE
)%
IF .OCOUNT EQL 0 THEN
BEGIN
OVAR[IDATTRIBUT(NOALLOC)]_1;
PREV_.CURR[CW0L]; !LOCATE NEXT NODE
PREV[SRCLINK]_.CURR[SRCLINK];
SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR);
CURR_.PREV[SRCLINK];
CURR[CW0L]_.PREV
END
ELSE
%(
IF OCOUNT IS 1, THEN WE SHOULD ELIMINATE
THE ASSIGNMENT AND CREATE A COMMON SUBEXPRESSION
NODE
)%
%[1111]% IF .OCOUNT EQL 1 AND .OSTEP EQL 0 THEN
BEGIN
LOCAL BASE CMNPTR; !CURRENT CMNSUB NODE
LOCAL BASE CMNNODE; !NODE CREATED
LOCAL BASE OEXPR; !EXPRESSION
OVAR[IDATTRIBUT(NOALLOC)]_1; !NOALLOC VAR
OEXPR_.CURR[RHEXP]; !REMEMBER THE EXPRESSION
PREV_.CURR[CW0L]; !FIND NODE IN FRONT
PREV[SRCLINK]_.CURR[SRCLINK]; !LINK OVER NODE
SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR); !DELETE ASSIGNMENT
CURR_.PREV[SRCLINK]; !FIND NEW CURR
CURR[CW0L]_.PREV; !RESET BACK POINTER
!BUILD COMMON SUB NODE
IF .OEXPR[OPRCLS] EQL DATAOPR THEN
BEGIN
CMNNODE_.OEXPR
END
ELSE
BEGIN
CMNNODE_BLDCMN(0,.OEXPR);
!LINK ON FRONT OF CHAIN
CMNNODE[SRCLINK]_.OSEEN[SRCCOMNSUB];
OSEEN[SRCCOMNSUB]_.CMNNODE
END;
!SUBSTITUTE COMMON SUB NODE FOR
!VARIABLES
ITMCT_1;
CHOSEN[1]_.CMNNODE;
GLOBREG[1]_.OVAR;
CMNPTR_.IMPLDO; !SAVE IMPLDO FLAG
IMPLDO_1; !SET IT FOR CMNRPLC
IF .OSEEN[OPRS] EQL ASGNOS THEN
BEGIN
OSEEN[LHEXP]_CMNRPLC(.OSEEN[LHEXP]);
OSEEN[RHEXP]_CMNRPLC(.OSEEN[RHEXP])
END
ELSE
IF .OSEEN[OPRS] EQL DOOS THEN
BEGIN
OSEEN[DOLPCTL]_CMNRPLC(.OSEEN[DOLPCTL]);
%[753]% OSEEN[DOM1]_CMNRPLC(.OSEEN[DOM1]);
!DO NOT FORGET THAT A .O VAR MAY BE USED IN THE
! INCREMENT FIELD OF THE DO LOOP
OSEEN[DOM3]_CMNRPLC(.OSEEN[DOM3])
END
ELSE
IF .OSEEN[OPRCLS] EQL IOLSCLS THEN
BEGIN
CMNRPLC(.OSEEN)
END;
IMPLDO_.CMNPTR !RESET IMPLDO FLAG
END
ELSE
CURR_.CURR[CW0L]
END
ELSE
CURR_.CURR[CW0L]
END
ELSE
CURR_.CURR[CW0L]
END;
%(***CLEAR CW0L FIELD AND ELIMINATE EXTRA COMMON SUBS***)%
IONODE_.TOP;
WHILE .IONODE NEQ .LEND DO
BEGIN
IONODE[CW0L]_0;
IF .IONODE[OPRCLS] EQL IOLSCLS THEN CMNELIM();
IONODE_.IONODE[SRCLINK]
END;
END;
GLOBAL ROUTINE COLLAPSE=
%(**********************************************************************
CONTROL ROUTINE TO FOLD GROUPS OF DATACALL AND/OR
SLISTCALL NODES IN IOLSTCALL NODES AND DETERMINE
IF A LOOP CAN BE COLLAPSED INTO
AN E1LISTCALL NODE OR E2LISTCALL NODE
CALLED BY FOLDUP WITH THE GLOBAL TOP POINTING
TO A DONODE (OR A CONTINUE FOR THE OUTERMOST
LEVEL OF AN IOLIST) AND LEND POINTING TO THE
CONTINUE TERMINATING THE
LOOP
COLLPASE WALKS THE LOOP COUNTING THE NUMBER
OF IOLSCLS NODES SEEN AND CREATED AND
SETTING FLAGS TO INDICATE WHETHER
TO INDICATE WHETHER
1) A DATACALL POINTS TO AN ARRAYREF A SUBSRCIPT
WHICH CONTAINS A VARIABLE INCREMENTED IN
THE LOOP OTHER THAN THE LOOP INDUCTION VARIABLE
2) AN IOLSCLS NODE OTHER THAN A
DATACALL NODES WAS ENCOUNTERED IN THE LOOP
3) THE CURRENT AND LAST ELEMENTS IN THE LOOP WERE IOLSCLS
ELEMENTS
4) A FUNCTION REFERENCE WAS SEEN ANYWHERE IN THE LOOP
5) THE CURRENT OR LAST ELEMENTS CONTAINED FUNCTION
REFERENCES
6) A STATEMENT OTHER THAN AS ASSIGNMENT STATEMENT
WAS DETECTED IN THE LOOP
7) A DATACALL CONTAINED MORE THAN ONE VARIABLE
INCREMENTED IN THE LOOP
8) THE EXPRESSION UNDER A DATACALL NODE CONTAINING
THE INCREMENT EXPRESSION WAS NIOT AN ADD
WHENEVER ADJACENT IOLSCLS NODES ARE DETETCED, COLLAPSE
DETERMINES IF THE CALLS ARE INDEPENDENT
NODES ARE INDEPENT IF
A) NEITHER CONTAIN FUNCTION CALLS
B) ON A READ, THE SECOND NODE DOES NOT USE IN
A COMPUTATION ANY VARIABLE INITIALIZED
BY THE FIRST
WHEN INDEPENDENT NODES ARE ENCOUNTERED,
COLLAPSE MERGES THE TWO NODES INTO A SINGLE
IOLSTCALL EITHER BY CREATING A IOLSTCALL NODE AND
LINKING BOTH NODES UNDER THE IOLSTCALL NODE IF THE
FIRST NODE WAS NOT AN IOLSTCALL NODE OR LINKING
THE SECOND NODE UNDER THE FIRST IF THE FIRST
NODE WAS AN IOLSTCALL NODE.
AFTER ALL THE LOOP ELEMENTS HAVE BEEN EXAMINED
AND IF WE ARE COLLAPSING A LOOP (WE MIGHT
BE COLLAPSING NODES OUTSIDE THE OUTERMOST
LOOP ON THE I/O LIST) COLLAPSE DETERMINES
IF THE LOOP MAY BE FOLDED BY CHECKING
THE FLAGS AND COUNTS FOR THE NUMBER OF IOLSCLS NODES
SEEN AND THE NUMBER OF IOLSTCALL NODES CREATED.
NO FOLDING WILL OCCUR IF EITHERANY OF THE FUNCTION,
MORE THAN ONE INCREMENTED VARIABLE, STATEMENT
OTHER THAN ASSIGNMENT, OR INCREMENTED VARIABLE
NOT IN AN ADD EXPRESSION FLAGS ARE SET OR IF
MORE THAN ONE IOLSTCALL NODE WAS CREATED IN THE LOOP
OTHERWISE, IF ONLY 1 IOLSCLS NODES WAS SEEN
OF TYPE DATACALL, COLLAPSE WILL GENERATE AND LINK
INTO THE TREE AN IOLSTCALL NODE OVER THE DATACALL
NODE TO FORCE COLLPASING OF THE
LOOP
LOOP COLLAPSING OCCURS AS FOLLOWS
1) IF THE LOOP CONTAINED EXACTLY ONME E1LISTCALL OR
E2LISTCALL NODE AND NO OTHER IOLSCLS NODES
AND THE PRODUCT OF THE NUMBER OF ELEMENTS AND
THE INCREMENT EXPRESSION FOR EACH ELEMENT
UNDER THE E1LISTCALL OR E2LISTCALL NODE IS
THE SAME AS THE LOOP INCREMENT THEN THE OUTER LOOP WILL
BE FOLDED INTO THE E1LISTCALL OR E2LISTCALL
NODE
2) IF EXACLTY ONE IOLSTCALL NODE WAS GENERATED
IN THE LOOP AND NO IOLSCLS NODES
OF TYPE OTHER THAN DATACALL WERE DETECTED
IN THE LOOP THEN THE LOOP WILL BE FOLDED INTO AN
E1LISTCALL OR E2LISTCALL NODE DEPENDING UPON THE
STATE OF THE FLAG INDICATING WHETHER ALL INCREMENTED
VARIABLES IN THE LOOP MATCHED THE LOOP INDUCTION
VARIABLES
COLLAPSE CALLS MAKELIST WITH PARAMETER
0, 1 , OR 2 TO COLLPAAPSE A LOOP INTO AN ALREADY
EXISTING ELIST OR INTO A E1LISTCALL OR E2LISTCALL
NODES, RESPECTIVELY
**********************************************************************)%
BEGIN
LOCAL BASE CNSTTWO; !ADRESS OF INTEGER TWO IN CONSTANT TABLE
LOCAL BASE CNSTZERO; !ADDRESS OF ZERO IN CONSTANT TABLE
LOCAL BASE CURRIOLS; !LAST IOLSCLS NODE SEEN IN LOOP
LOCAL BASE PREVCURR; !NODE IN FRONT OF CURRIOLS
LOCAL BASE IOLSTSEEN; !COUNT OF IOLSCLS ELEMENTS SEEN IN LOOP
LOCAL BASE IOLSTCNT; !COUNT OF IOLSCLS ELEMENTS BUILT IN LOOP
LABEL E2NLYZ;
LABEL RASGNFND;
LABEL E1LOOP;
LABEL E2LOOP;
LOCAL BASE CURR; !CURRENT ELEMENT BEING ANALYZED
LOCAL BASE PREV; !NODE IN FRONT OF CURR
LOCAL BASE PREPREV; !NODE IN FRONT OF PREV
REGISTER BASE FOLDFLG; !ANALYSIS FLAGS
MACRO
INCEXNOTADD=FOLDFLG<0,1>$, !INCREMENT EXPRESSION NOT ADD FLAG
IOLSNOTDATA=FOLDFLG<1,1>$, !IOLSCLS NODE OTHER THAN DATACALL SEEN
THISIOLS=FOLDFLG<2,1>$, !CURRENT ELEMENT IS AN IOLSCLS NODE
LASTIOLS=FOLDFLG<3,1>$, !PREVIOUS ELEMENT WAS AN IOSCLS NODE
FUNCSEEN=FOLDFLG<4,1>$, !FUNCTION CALL IN LOOP
OTHERSTMT=FOLDFLG<6,1>$, !STATEMENT OTHER THAN ASSIGNMENT SEEN
LASTFNCTN=FOLDFLG<7,1>$, !FUNCTION CALL IN PREVIOUS ELEMENT
THISFNCTN=FOLDFLG<8,1>$, !FUNCTION CALL IN CURRENT ELEMENT
CNTGTRONE=FOLDFLG<9,1>$, !MORE THAN ONE INCREMENTED VARIABLE
INCNOTIND=FOLDFLG<10,1>$, !INCREMENTED VARIABLE OTHER THAN INDVAR IN LOOP
DBLEWORD=FOLDFLG<11,1>$, !DOUBLE WORD ARG UNDER DATACALL
SNGLWORD=FOLDFLG<12,1>$, !SINGLE WORD ARG UNDER DATACALL
DEPIOLSCLS=FOLDFLG<13,1>$; !DEPENDENT IOLSCLS NODES SEEN
%(***INITIALIZE***)%
CNSTTWO_MAKECNST(INTEGER,0,2); !LOCATE 2 IN CONSTANT TABLE
CNSTZERO_MAKECNST(INTEGER,0,0); !LOCATE ZERO
ELIMCONT(); !ELIMINATE CONTINUE STATEMENTS IN LOOP
IOLSTSEEN_IOLSTCNT_FOLDFLG_0; !CLEAR FLAGS AND COUNTS
DEPIOLSCLS_0; !CLEAR MORE FLAGS
IF NOT .IMPLDO THEN LEND_0; !SET LEND IF OUTSIDE OUTERMOST LOOP
%(***
EXAMINE EACH NODE IN THE LOOP
FOR EACH NODE, DETERMINE IF A FUNCTION CALL
WAS PRESENT AND SET THE THISFNCTN AND FUNCSEEN
FLAGS ACCORDINGLY
FOR A DATACALL NODE, ISOLATE THE INCREMENTED VARIABLE(S)
AND SET CNTGTRONE, INCEXNOTADD, AND INCNOTIND APPROPRIATELY
FOLD PAIRS OF INDEPENDENT DATACALL NODES
INTO IOLSTCALL NODES
***)%
PREV_.TOP; !INITIALIZE LOOP SEARCH
WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
LASTIOLS_.THISIOLS; !SET FLAGS FOR PREVIOUS NODE
LASTFNCTN_.THISFNCTN;
THISIOLS_THISFNCTN_0; !CLEAR FLAGS FOR THIS NODE
%(
STATEMENT NODE ENCOUNTERED
--------- ---- -----------
)%
IF .CURR[OPRS] EQL ASGNOS THEN
BEGIN
%(
SET OTHERSTMT IF NOT AN
OPTIMIZER CREATED ASSIGNMENT STATEMENT
)%
![651] IF WE HAVE AN ASSIGNMENT INTO A .O VARIABLE WHICH HAS
![651] BEEN PRECEDED BY SOME IOLSCLS NODE, THEN THE .O VARIABLE
![651] ASSIGNMENT MUST DEPEND UPON THE IOLSCLS (AND HENCE THE VARIABLE
![651] BEING READ), AND SO WE WILL BE UNABLE TO COLLAPSE THIS LOOP
![651] DUE TO THIS DEPENDENCY. TEST FOR IT HERE AND SET FLAG.
%[651]% IF .CURR[SRCISN] NEQ 0 THEN OTHERSTMT_1
![743] MAKE SURE IT IS A .O VARIABLE, SINCE .R VARIABLES ARE POSSIBLE
![743] AND WE DO NOT WANT TO KILL OPTIMIZATION FOR THEM!
%[743]% ELSE IF .IOLSTSEEN GTR 0 THEN
%[743]% BEGIN
%[743]% LOCAL BASE VARPTR;
%[743]% VARPTR_.CURR[LHEXP];
%[743]% IF .VARPTR[IDDOTO] EQL SIXBIT ".O"
%[743]% THEN DEPIOLSCLS_1
%[743]% END;
%(
CHECK FOR FUNCTION CALL
)%
IF CONTFN(.CURR[RHEXP]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END;
IF CONTFN(.CURR[LHEXP]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
END
ELSE
IF .CURR[OPRS] EQL DOOS THEN
BEGIN
%(
SET OTHERSTMT FOR DO NODE
)%
OTHERSTMT_1;
%(
COLLAPSE INNER LOOPS
)%
PREV_.CURR; !ADVANCE PREVIOUS NODE POINTER
CURR_.CURR[DOLBL]; !ADVANCE CURRENT NODE POINTER
CURR_.CURR[SNHDR] !TO CONTINUE NODE TERMINATING THE LOOP
END
ELSE
IF .CURR[OPRCLS] EQL IOLSCLS THEN
BEGIN
%(
IOLSCLS NODE ENCOUNTERED
------- ---- -----------
)%
IOLSTSEEN.IOLSTSEEN+1; !INCREMENT COUNT OF IOLSCLS NODES SEEN
CURRIOLS_.CURR; !MARK THIS IOSLCLS NODE AS LAST IOLSCLS NODE SEEN
PREVCURR_.PREV; !REMEMBER NODE IN FRONT OF CURRENT NODE
THISIOLS_1; !SET THIS NODE IS AN IOLSCLS NODE FLAG
%(
CHECK FOR FUNCTION REFERENCE
IF A DATACALL NODE, ISOLATE
INCREMENT VARIABLE AND SET E2INCR FIELD. SET
APPROPRIATE FLAGS FROM INFORMATION RETURNED
BY ISOLATE
)%
CASE .CURR[OPERSP] OF SET
%DATACALL% BEGIN
%(
ANALYZE DATACALL
)%
IF .IMPLDO THEN !DON'T BOTHER IF NO LOOP TO COLLAPSE
BEGIN
IF CHKDBLSUB(.CURR[DCALLELEM]) THEN
DBLEWORD_1 ELSE SNGLWORD_1; !DETERMINE TYPE OF REFERENCE
!TO INCREMENTED VARIABLE
%[630]% INCVAR_INCCOUNT_INCBADFORM_INCEXPR_INCFNCTN_0; !CLEAR MODULE OWNS FOR ISOLATE
%[630]% ISOLATE(.CURR[DCALLELEM],.CURR,0); !FILL IN INFORMATION ABOUT DATACALL ARGUMENT
%(***
BBBB EEEEE W W W AAA RRRR EEEEE
B B E W W W A A R R E
B B E W W W A A RRRR E
BBBB EEEE W W W AAAAA RR EEEEE
B B E W W W A A R R E
B B E WW WW A A R R E
BBBB EEEEE W W A A R R EEEEE
FOR THE CASE (I,I=1,N) ISOLATE WILL
RETURN INCVAR AS I AND INCEXPR AS
.CURR. WE WILL THEREFORE
SET INCEXNOTADD AND NOT FOLD
THE LOOP
***)%
IF .INCCOUNT GTR 1 THEN CNTGTRONE_1; !SET CNTGTRONE IF ISOLATE FOUND MORE THAN ONE INCRMENTED VARIABLE
IF .INCVAR NEQ .INDVAR THEN INCNOTIND_1;!SET INCNOTIND IF INCREMENTED VARIABLE WAS NOT LOOP INDUCTION VARIABLE
%(
SET E2INCR FIELD IN DATACALL NODE
)%
IF (CURR[E2INCR]_.INCVAR) NEQ 0 THEN
BEGIN
%(
SOME INCREMENTED VARIABLE APPEARS IN
THE DATACALL - ANALYZE THE EXPRESSION
IN WHICH IT APPEARS
SET INCEXNOTADD IF THE EXPRESSION
IS NEITHER THE DCALLELEM
OF THE DATACALL NODE OR AN ADD
E.G. ALL EXPRESSIONS OF THE FORM
A(I) OR A(I+X) ARE OK (IF I IS INDVAR)
)%
%[630]% IF .INCBADFORM THEN %(ISOLATE CHECKED)%
INCEXNOTADD_1
END
ELSE
BEGIN
%(
NO INCREMENTED VARIABLE - INCREMENT
IS ZERO
)%
CURR[E2INCR]_.CNSTZERO
END;
%(
SET FUNCTION FLAGS IF A FUNCTION WAS
ENCOUNTERED BY ISOLATE
)%
IF .INCFNCTN THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
END
ELSE
%(
OUTSIDE OUTER LOOP - JUST LOOK FOR
A FUNCTION CALL UNDER THE DATACALL
NODE
)%
IF CONTFN(.CURR[DCALLELEM]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
END;
%(
FOR IOLSCLS NODES OTHER THAN DATATCALL
SET THE IOLSNOTDATA FLAG AND LOOK
FOR A FUNCTION CALL UNDER THE NODE
)%
%SLISTCALL% BEGIN
IOLSNOTDATA_1;
IF CONTFN(.CURR[SCALLELEM]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
ELSE
IF CONTFN(.CURR[SCALLCT]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
END;
%IOLSTCALL% BEGIN
SKERR() !SHOULD NEVER SEE AN IOLSTCALL
END;
%E1LISTCALL% BEGIN
IOLSNOTDATA_1;
IF CONTFN(.CURR[ECNTPTR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
ELSE
IF CONTFN(.CURR[E1INCR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
ELSE
BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.CURR[ELSTPTR];
E1LOOP: WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTFN(.IOARRAY[E2ARREFPTR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1;
LEAVE E1LOOP
END;
IOARRAY_.IOARRAY[CLINK]
END
END
END;
%E2LISTCALL% BEGIN
IOLSNOTDATA_1;
IF CONTFN(.CURR[ECNTPTR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1
END
ELSE
BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.CURR[ELSTPTR];
E2LOOP: WHILE .IOARRAY NEQ 0 DO
BEGIN
IF CONTFN(.IOARRAY[E2INCR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1;
LEAVE E2LOOP
END
ELSE
IF CONTFN(.IOARRAY[E2ARREFPTR]) THEN
BEGIN
FUNCSEEN_1;
THISFNCTN_1;
LEAVE E2LOOP
END;
IOARRAY_.IOARRAY[CLINK]
END
END
END
TES;
%(***FOLD ADJACENT OF NODES IF POSSIBLE***)%
IF .LASTIOLS THEN !WAS LAST NODE AN IOLSCLS NODE
IF NOT .LASTFNCTN THEN !WITHOUT FUNCTION CALLS?
IF NOT .THISFNCTN THEN !AND NO FUNCTION CALLS IN THIS NODE?
IF
BEGIN
%[1041]% IF NOT .INPFLAG THEN 1 !Not dependent.
%[1041]% ELSE IF IODEPNDS(.CURR,.PREV) THEN 0
%[1041]% ELSE IF NOT .IMPLDO THEN 1 !In a loop? If not, done!
%[1041]% !Otherwise, check to see if
%[1041]% ELSE NOT IODEPNDS(.PREV,.CURR) !PREV depends on CURR?
END
THEN
BEGIN !FOLD THE NODES
!IS THE NODE IN FRONT
!OF THIS ALREADY ON IOSLTCALL
!NODE?
IF .PREV[OPERSP] EQL IOLSTCALL THEN
BEGIN !YES - ADD TO PREVIOUS IOLSTCALL
LOCAL BASE IOELEM;
!FIND LAST NODE UNDER
!IOLSTCALL NODE
IOELEM_.PREV[IOLSTPTR];
WHILE .IOELEM[CLINK] NEQ 0 DO
IOELEM_.IOELEM[CLINK];
IOELEM[CLINK]_.CURR; !LINK NODES
IF .CURR[OPERSP] EQL E1LISTCALL OR
.CURR[OPERSP] EQL E2LISTCALL THEN
IF .CURR[SRCCOMNSUB] NEQ 0 THEN
BEGIN !COPY COMMON SUBEXPRESSIONS TO THE
!IOLSTCALL NODE
LCLLNK(.CURR[SRCCOMNSUB]);
!AND CLEAR THE
!COMMON SUBEXPRESSION
!FIELD IN THE NODE BEING
!LINKED
CURR[SRCCOMNSUB]_0
END;
!RELINK THE TREE
PREV[SRCLINK]_.CURR[SRCLINK];
!CLEAR LINK FIELD
!OF NODE JUYST ADDED
CURR[SRCLINK]_0;
CURR_.PREV !RESET LOOP POINTERS
END
ELSE
BEGIN !MAKE "IOLSTCALL" NODE
!"" APPEAR BECAUSE
!THIS NODES IS 1 WORD
!LARGER THAN A REAL
!IOLSTCALL NODE
!TO ALLOW CONVERTING THE NODE
!TO AN E1LISTCALL OR E2LISTCALL
!NODE
IOLSTCNT_.IOLSTCNT+1; !COUNT THE NODE
NAME<LEFT>_ELCSIZ; !MAY BECOME AN ELIST
IONODE_CORMAN(); !ALLOCATE CORE
!IDENTIFY THE NODE
IONODE[OPERATOR]_IOLSTCFL;
IONODE[IOLSTPTR]_.PREV; !LINK PREVIOUS NODE
PREPREV[SRCLINK]_.IONODE;!LINK INTO TREE
IF .PREV[OPERSP] EQL E1LISTCALL OR
.PREV[OPERSP] EQL E2LISTCALL THEN
IF .PREV[SRCCOMNSUB] NEQ 0 THEN
BEGIN
!COPY COMMON SUBEXPRESSION TO
!IOLSTCALL NODE AND CLEAR
!COMMON SUBEXPRESSION FIELD
LCLLNK(.PREV[SRCCOMNSUB]);
PREV[SRCCOMNSUB]_0
END;
IF .CURR[OPERSP] EQL E1LISTCALL OR
.CURR[OPERSP] EQL E2LISTCALL THEN
IF .CURR[SRCCOMNSUB] NEQ 0 THEN
BEGIN
!COPY COMMON SUBEXPRESSIONS
!TO IOLSTCALL NODE AND CLEAR
!COMMON SUBEXPRESSION FIELD
LCLLNK(.CURR[SRCCOMNSUB]);
CURR[SRCCOMNSUB]_0
END;
IONODE[SRCLINK]_.CURR[SRCLINK]; !LINK INTO TREE
CURR[SRCLINK]_0; !CLEAR END OF LIST
PREV_.PREPREV; !RESET LOOP POINTERS
CURR_.IONODE !RESET LOOP POINTERS
END
END
ELSE DEPIOLSCLS _ 1; !MARK CAN NEVER MAKE AN ELIST
!SINCE DEPENDENT IOLSCLS NODES
END;
PREPREV_.PREV; !REMEMBER ONE MORE NODE BACK
PREV_.CURR !ADVANCE A NODE
END;
%(***END OF I/O LIST FOLDING***)%
!IF OUTER LOOP, RESTORE COMMON
!SUBS AND EXIT
IF NOT .IMPLDO THEN RETURN PUTBAK();
%(***ANALYZE A LOOP WITH JUST 1 IOLSTCALL NODE***)%
IF .IOLSTSEEN EQL 1 THEN !CHECK FLAGS
IF NOT .INCEXNOTADD THEN
IF NOT .FUNCSEEN THEN
IF NOT .OTHERSTMT THEN
IF NOT .CNTGTRONE THEN
BEGIN
IF .CURRIOLS[OPERSP] EQL DATACALL THEN
BEGIN
%(
IF EXACTLY ONE DATACALL NODE
APPEARED IN THE LOOP WE CAN
MAKE IT INTO AN E1LISTCALL OR
E2LISTCALL NODE
HOWEVER, WE MUST FIRST GENERATE
AN IOLSTCALL NODE.
GENERATE THE I/O LIST CALL NODE HERE
PREPERATORY TO THE 1 IOLSTCALL NODE
CREATED ANALYSIS IN FURTHER
ON
)%
IOLSTCNT_.IOLSTCNT+1; !COUNT NODE
NAME<LEFT>_ELCSIZ; !SET NODE SIZE
IONODE_CORMAN(); !ALLOCATE CORE FOR NODE
!IDENTIFY NODE
IONODE[OPERATOR]_IOLSTCFL;
!PUT DATACALL UNDER THE NODE
IONODE[IOLSTPTR]_.CURRIOLS;
!LINK IONODE INTO TREE
PREVCURR[SRCLINK]_.IONODE;
!LINK TREE TO IONODE
IONODE[SRCLINK]_.CURRIOLS[SRCLINK];
CURRIOLS[SRCLINK]_0 !CLEAR LINK FIELD OF DATACALL NODE
END
ELSE
IF .CURRIOLS[OPERSP] EQL E1LISTCALL OR
.CURRIOLS[OPERSP] EQL E2LISTCALL THEN
%(
IF EXACLTY ONE E1LISTCALL OR E2LISTCALL NODE
WAS ENCOUNTERED IN THE LOOP WE CAN FOLD THE
LOOP INTO THE E1LISTCALL OR E2LISTCALL NODE
IF THE PRODUCT OF THE NUMBER OF ELEMENTS
SPECIFIED BY THE ELIST
AND THE INCREMENT FOR EACH ARRAY BEING
TRANSFERRED MATCHES THE INCREMENT FOR THE
LOOP BEGIN ANALYZED
)%
E2NLYZ: BEGIN
LOCAL BASE IOARRAY;
%(
FOR AN E1LISTCALL, CHECK THAT THE PRODUCT OF
E1INCR WHICH IS THE INCREMENT FOR ALL THE DATA ITEMS
AND THE ELIST COUNT
MATCHES THE LOOP INCREMENT
)%
IF .CURRIOLS[OPERSP] EQL E1LISTCALL THEN
BEGIN
LOCAL BASE TESTARRAY;
LOCAL BASE INNERINC;
INNERINC_EXPEXP(.CURRIOLS[ECNTPTR],.CURRIOLS[E1INCR]);
TESTARRAY_.CURRIOLS[ELSTPTR];
IF .TESTARRAY[OPERSP] EQL EDBLELEM THEN
BEGIN
IF .INNERINC NEQ 0 THEN
INNERINC_EXPEXP(.INNERINC,.CNSTTWO)
END;
IF .INNERINC NEQ .TOP[DOM3] THEN LEAVE E2NLYZ
END;
%(
FOR EACH SUBELEMENT OF THE ELIST CHECK THAT
1) IF THE NODE IS AN E1LIST THAT ALL ELEMENTS
ARE INCREMENTED BY THE LOOP INDUCTION VARIABLE
2) IF THE NODE IS AN E2LISTCALL THAT THE PRODUCT OF
E2INCR FOR THE SUBNODE AND THE NUMBER OF
ELEMENTS IN THE E2LISTCALL NODE MATCHES THE INCREMENT
FOR THE INCREMENT VARIABLE FOR THAT SUBNODE
IN THE OUTER LOOP
3) THE INCREMENT VARIABLE APPEARS IN A VALID CONTEXT
)%
IOARRAY_.CURRIOLS[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
%(
ISOLATE THE INCREMENT VARIABLE
)%
%[630]% INCVAR_INCCOUNT_INCBADFORM_INCEXPR_INCFNCTN_0;
%[630]% ISOLATE(.IOARRAY[E2ARREFPTR],.IOARRAY,0);
IF .CURRIOLS[OPERSP] EQL E1LISTCALL THEN
BEGIN
%(
MAKE SURE INCVAR IS INDVAR AND THAT
IT APPEARS IN A VALID CONTEXT
)%
IF .INCVAR NEQ .INDVAR THEN LEAVE E2NLYZ;
IF .INCCOUNT GTR 1 THEN LEAVE E2NLYZ;
%[630]% IF .INCBADFORM THEN LEAVE E2NLYZ
END
ELSE
BEGIN
%(
IF NO INCREMENT IN THIS LOOP THE
E2INCR FIELD MUST BE ZERO
)%
IF .INCVAR EQL 0 THEN
BEGIN
IF .IOARRAY[E2INCR] NEQ .CNSTZERO THEN
LEAVE E2NLYZ
END
ELSE
BEGIN
%(
CHECK THAT INCVAR APPEARS IN A
VALID CONTEXT
)%
IF .INCCOUNT GTR 1 THEN LEAVE E2NLYZ;
%[630]% IF .INCBADFORM THEN LEAVE E2NLYZ; IF .INCVAR EQL .INDVAR THEN
%(
FOR INVAR EQL INDVAR, THE INCREMENT
EXPRESSION IS THE LOOP INCREMENT
MAKE SURE THE LOOP INCREMENT
MATCHES THE PRODUCT OF E2INCR
AND THE ELIST ELEMENT COUNT
)%
BEGIN
LOCAL BASE INNERINC;
INNERINC_EXPEXP(.CURRIOLS[ECNTPTR],.IOARRAY[E2INCR]);
IF .IOARRAY[OPERSP] EQL EDBLELEM THEN
BEGIN
IF .INNERINC NEQ 0 THEN
INNERINC_EXPEXP(.INNERINC,.CNSTTWO)
END;
IF .INNERINC NEQ .TOP[DOM3] THEN LEAVE E2NLYZ
END
ELSE
%(
IF THE INCREMENTED VARIABLE
IS A .R TEMPORARY, FIND THE
INCREMENT EXPRESSION BY
ISOLATING THE I FROM THE
.R + I OR I + .R EXPRESSION
APPEARING IN THE LOOP
CHECK THAT I MATCHES THE
PRODUCT OF E2INCR AND THE
ELIST ELEMENT COUNT
)%
RASGNFND: BEGIN !LOCATE .R INCREMENT ASSIGNMENT
CURR_.TOP[SRCLINK];
WHILE 1 DO
BEGIN
IF .CURR[OPRS] EQL ASGNOS THEN
IF .CURR[LHEXP] EQL .INCVAR THEN
%(
COMPUTE PRODUCT OF E2INCR AND
THE ELIST ELEMENT COUNT
)%
IF
BEGIN
LOCAL BASE INNERINC;
INNERINC_EXPEXP(.CURRIOLS[ECNTPTR],.IOARRAY[E2INCR]);
IF .IOARRAY[OPERSP] EQL EDBLELEM THEN
BEGIN
IF .INNERINC NEQ 0 THEN
INNERINC_EXPEXP(.INNERINC,.CNSTTWO)
END;
.INNERINC
END
EQL
BEGIN !ISOLATE I
PREV_.CURR[RHEXP];
IF .PREV[ARG1PTR] EQL .INCVAR
THEN .PREV[ARG2PTR] ELSE .PREV[ARG1PTR]
END !AND CHECK THAT PRODUCT AND
!I MATCH
THEN LEAVE RASGNFND ELSE LEAVE E2NLYZ;
IF (CURR_.CURR[SRCLINK]) EQL .LEND THEN
SKERR() !ERROR IF NO INCREMENT ASSIGNMENT
END
END
END
END;
IOARRAY_.IOARRAY[CLINK]
END;
IONODE_.CURRIOLS; !SET IONODE FOR MAKELIST
RETURN MAKELIST(0) !FOLD LOOP INTO ELIST NODE
END
END;
%(***CONVERT TO E1LISTCALL OR E2LISTCALL NODE IF POSSIBLE***)%
IF .IOLSTCNT EQL 1 THEN
IF NOT .INCEXNOTADD THEN
IF NOT .IOLSNOTDATA THEN
IF NOT .FUNCSEEN THEN
IF NOT .OTHERSTMT THEN
IF NOT .CNTGTRONE THEN
IF NOT .DEPIOLSCLS THEN !IF ALL NODES COLLAPSED
BEGIN
%(
IF A SINGLE IOLSTCALL NODE WAS CREATED IN THE
LOOP AND THE FLAGS ARE CORRECT TRANSFORM THE
IOLSTCALL NODE INTO AN E1LISTCALL OR E2LISTCALL NODE
)%
RETURN MAKELIST(IF (.INCNOTIND OR (.DBLEWORD AND .SNGLWORD)) THEN 2 ELSE 1)
END;
%(***THE LOOP DOES NOT FOLD***)%
RETURN PUTBAK() !RESTORE COMMON SUBS
END;
%(
ROUTINE TO PERFORM SUBSTITUTION AND LOCAL DEPENDENCY
ELIMINATION OF COMMON SUBEXPRESSION NODES
USED IN TWO CONTEXTS:
1) AFTER AN ELIST NODE HAS BEEN CREATED, WE MUST SUBSTITUTE
COMMON SUBEXPRESSION NODES FOR THE VARIABLES WHOSE VALUES WERE
ORIGINALLY SET BY ASSIGNMENT STATEMENTS WE HAVE ELIMINTED
2) AFTER THE SUBSTITION IN 1) WE MUST ELIMINATE ALL
UNUSED COMMON SUBEXPRESSIONS AND PERFORM LOCAL SUBSTITUTION OF
THE EXPRESSION UNDER THE COMMON SUBEXPRESSION NODE FOR THE
COMMON SUBEXPRESSION NODE IF IT IS USED ONLY ONCE
THE ROUTINE RPLCMN AND CMNRPLC PERFORM SUBSTITUTION OF
COMMON SUBEXPRESSION NODES FOR VARIABLES AND ARBITRARY
EXPRESSIONS FOR COMMON SUBEXPRESSION NODES. BOTH ROUTINES RESET THE
VALFLGS IN ALL EXPRESSIONS SINCE WE MAY BE SUBSTITUTING AN EXPRESSION
FOR A DATAOPR OR CMNSUB NODE
THE ROUTINE CMNDEPD PERFORMS A LOCAL DEPENDENCY ANALYSIS BY SETTING
A USE COUNT IN THE ARG1PTR FIELD OF THE COMMON SUBEXPRESSION NODE
WHICH IS CHECKED TO DETERMINE WHICH NODES TO ELIMINATE
)%
GLOBAL ROUTINE RPLCMN(NODE)=
%(**********************************************************************
ROUTINE TO SUBSTITUTE COMMON SUBEXPRESSION NODES
UNDER COMMON SUBEXPRESSION NODES IN AN I/O LIST
**********************************************************************)%
BEGIN
MAP BASE NODE;
REGISTER BASE CMNNODE;
REGISTER BASE ARG;
CMNNODE_.NODE[SRCCOMNSUB];
WHILE .CMNNODE NEQ 0 DO
BEGIN
ARG_CMNNODE[ARG2PTR]_CMNRPLC(.CMNNODE[ARG2PTR]); !SUBSTITUTE IN EXPRESSION
!UNDER THE CMNSUB NODE
CMNNODE[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB); !RESET THE VALFLG
CMNNODE_.CMNNODE[CLINK]
END
END;
GLOBAL ROUTINE CMNRPLC(EXPRNODE)=
%(**********************************************************************
ROUTINE TO SUBSTITUTE FOR COMMON
SUBEXPRESSION NODES IN AN IOLSCLS NODE
USED TO
1) IF IMPLDO - SUBSTITUTE COMMON SUBEXPRESSION NODES
FOR DATAOPRS
2) IF NOT IMPLDO - SUBSTITUTE FOR
COMMON SUBEXPRESSIONS IF THEY DEFINE CONSTANTS OR
ARE REFERENCED ONLY ONCE
RESETS VALFLGS IN ALL EXPRESSIONS
**********************************************************************)%
BEGIN
REGISTER PHAZ2 ARG;
REGISTER PHAZ2 EXPR;
MAP BASE EXPRNODE;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%DATAOPR% BEGIN
IF .IMPLDO THEN RETURN SWAPEM(.EXPR)
END;
%RELATIONAL% BEGIN
ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%FNCALL% BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
ARG_AG[.I,ARGNPTR]_CMNRPLC(.AG[.I,ARGNPTR]);
AG[.I,AVALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB)
END;
RETURN LOKDEFPT(.EXPR)
END;
%ARITHMETIC% BEGIN
ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%TYPECNV% BEGIN
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%ARRAYREF% BEGIN
IF .EXPR[ARG2PTR] NEQ 0 THEN
BEGIN
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END
END;
%CMNSUB% BEGIN
%(
SUBSTITUTE THE EXPRESSION UNDER THE COMMON SUB NODE
IF
1) THE NODE IS REFERNCED ONCE
2) THE EXPRESSION IS A CONSTANT
)%
IF NOT .IMPLDO THEN
BEGIN
IF .EXPR[ARG1PTR] EQL 1 THEN
BEGIN
RETURN .EXPR[ARG2PTR]
END
ELSE
BEGIN
LOCAL BASE CMNEXPR;
CMNEXPR_.EXPR[ARG2PTR];
IF .CMNEXPR[OPR1] EQL CONSTFL THEN
RETURN .CMNEXPR
END
END
END;
%NEGNOT% BEGIN
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%SPECOP% BEGIN
ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
RETURN LOKDEFPT(.EXPR)
END;
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN
CASE .EXPR[OPERSP] OF SET
%DATACALL% EXPR[DCALLELEM]_CMNRPLC(.EXPR[DCALLELEM]);
%SLISTCALL% BEGIN
EXPR[SCALLELEM]_CMNRPLC(.EXPR[SCALLELEM]);
EXPR[SCALLCT]_CMNRPLC(.EXPR[SCALLCT])
END;
%IOLSTCALL% BEGIN
RPLCMN(.EXPR);
EXPR_.EXPR[IOLSTPTR];
WHILE .EXPR NEQ 0 DO
BEGIN
CMNRPLC(.EXPR);
EXPR_.EXPR[CLINK]
END
END;
%E1LISTCALL% BEGIN
RPLCMN(.EXPR);
EXPR[ECNTPTR]_CMNRPLC(.EXPR[ECNTPTR]);
EXPR[E1INCR]_CMNRPLC(.EXPR[E1INCR]);
EXPR_.EXPR[ELSTPTR];
WHILE .EXPR NEQ 0 DO
BEGIN
EXPR[E2ARREFPTR]_CMNRPLC(.EXPR[E2ARREFPTR]);
EXPR_.EXPR[CLINK]
END
END;
%E2LISTCALL% BEGIN
RPLCMN(.EXPR);
EXPR[ECNTPTR]_CMNRPLC(.EXPR[ECNTPTR]);
EXPR_.EXPR[ELSTPTR];
WHILE .EXPR NEQ 0 DO
BEGIN
EXPR[E2ARREFPTR]_CMNRPLC(.EXPR[E2ARREFPTR]);
EXPR[E2INCR]_CMNRPLC(.EXPR[E2INCR]);
EXPR_.EXPR[CLINK]
END
END
TES
END;
%INLINFN% BEGIN
ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
IF .EXPR[ARG2PTR] NEQ 0 THEN
BEGIN
ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB)
END;
RETURN LOKDEFPT(.EXPR)
END
TES;
RETURN .EXPR !RETURN EXPR
END;
GLOBAL ROUTINE DEPDCMN(EXPR)=
%(**********************************************************************
ROUTINE TO PERFORM LOCAL DEPENDENCY WITHIN
COMMON SUBEXPRESSION CHAIN
**********************************************************************)%
BEGIN
MAP BASE EXPR;
REGISTER BASE CMNNODE;
CMNNODE_.EXPR[SRCCOMNSUB]; !LOCATE CHAIN
WHILE .CMNNODE NEQ 0 DO
BEGIN
IF .CMNNODE[ARG1PTR] NEQ 0 THEN !IF CMNSUB IS REFERENCED
CMNDEPD(.CMNNODE[ARG2PTR]); !SET DEPENDENCY COUNT
!IN SUB COMMON SUBEXPRESSIONS
CMNNODE_.CMNNODE[SRCLINK]; !ADVANCE ALONG CHAIN
END;
END;
GLOBAL ROUTINE CMNDEPD(EXPR)=
%(**********************************************************************
ROUTINE TO SET USE COUNT INTO ARG1PTR OF COMMON
SUBEXPRESSION NODES APPEARING UNDER AN IOLSCLS
NODE
**********************************************************************)%
BEGIN
MAP BASE EXPR;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN% BEGIN
CMNDEPD(.EXPR[ARG1PTR]);
CMNDEPD(.EXPR[ARG2PTR])
END;
%DATAOPR% BEGIN END;
%RELATIONAL% BEGIN
CMNDEPD(.EXPR[ARG1PTR]);
CMNDEPD(.EXPR[ARG2PTR])
END;
%FNCALL% BEGIN
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
CMNDEPD(.AG[.I,ARGNPTR])
END;
%ARITHMETIC% BEGIN
CMNDEPD(.EXPR[ARG1PTR]);
CMNDEPD(.EXPR[ARG2PTR])
END;
%TYPECNV% CMNDEPD(.EXPR[ARG2PTR]);
%ARRAYREF% IF .EXPR[ARG2PTR] NEQ 0 THEN
CMNDEPD(.EXPR[ARG2PTR]);
%CMNSUB% EXPR[ARG1PTR]_.EXPR[ARG1PTR]+1;
%NEGNOT% CMNDEPD(.EXPR[ARG2PTR]);
%SPECOP% CMNDEPD(.EXPR[ARG1PTR]);
%FIELDREF% BEGIN END;
%STORECLS% BEGIN END;
%REGCONTENTS% BEGIN END;
%LABOP% BEGIN END;
%STATEMENT% BEGIN END;
%IOLSCLS% BEGIN
CASE .EXPR[OPERSP] OF SET
%DATACALL% CMNDEPD(.EXPR[DCALLELEM]);
%SLISTCALL% BEGIN
CMNDEPD(.EXPR[SCALLCT]);
CMNDEPD(.EXPR[SCALLELEM])
END;
%IOLSTCALL% BEGIN
LOCAL BASE IOARRAY;
IOARRAY_.EXPR[IOLSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
CMNDEPD(.IOARRAY);
IOARRAY_.IOARRAY[CLINK]
END;
DEPDCMN(.EXPR);
DEPDCMN(.EXPR)
END;
%E1LISTCALL% BEGIN
LOCAL BASE IOARRAY;
CMNDEPD(.EXPR[ECNTPTR]);
CMNDEPD(.EXPR[E1INCR]);
IOARRAY_.EXPR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
CMNDEPD(.IOARRAY[E2ARREFPTR]);
IOARRAY_.IOARRAY[CLINK]
END;
DEPDCMN(.EXPR);
DEPDCMN(.EXPR)
END;
%E2LISTCALL% BEGIN
LOCAL BASE IOARRAY;
CMNDEPD(.EXPR[ECNTPTR]);
IOARRAY_.EXPR[ELSTPTR];
WHILE .IOARRAY NEQ 0 DO
BEGIN
CMNDEPD(.IOARRAY[E2INCR]);
CMNDEPD(.IOARRAY[E2ARREFPTR]);
IOARRAY_.IOARRAY[CLINK]
END;
DEPDCMN(.EXPR);
DEPDCMN(.EXPR)
END
TES
END;
%INLINFN% BEGIN
CMNDEPD(.EXPR[ARG1PTR]);
IF .EXPR[ARG2PTR] NEQ 0 THEN CMNDEPD(.EXPR[ARG2PTR])
END
TES
END;
GLOBAL ROUTINE CMNELIM=
%(**********************************************************************
ROUTINE TO ELIMINATE COMMON SUBEXPRESSIONS ON
IOLSCLS NODES
A COMMON SUBEXPRESSION MAY BE ELIMINATED IF
1) IF ITS USED 0 OR 1 TIMES
2) IF IT DEFINES A CONSTANT AS A COMMON
SUBEXPRESSION
ADDRESS OF NODE IS IN IONODE
**********************************************************************)%
BEGIN
LOCAL SAVIMPLDO;
LOCAL BASE CMNPREV;
LOCAL BASE CMNNODE;
IF .IONODE[OPERSP] EQL DATACALL OR .IONODE[OPERSP] EQL SLISTCALL THEN RETURN;
IF (CMNNODE_.IONODE[SRCCOMNSUB]) EQL 0 THEN RETURN;
WHILE .CMNNODE NEQ 0 DO
BEGIN !CLEAR USEFUL FIELDS IN CMNNODES
CMNNODE[ARG1PTR]_0;
CMNNODE_.CMNNODE[CLINK]
END;
SAVIMPLDO_.IMPLDO; !REMEMBER VALUE OF IMPLDO
IMPLDO_0; !CLEAR FOR CMNRPLC
CMNDEPD(.IONODE); !SET FIELDS IN CMNSUB NODES
CMNRPLC(.IONODE); !REPLACE CONSTANT OR NON-COMMON
!COMMON SUBEXPRESSIONS
IMPLDO_.SAVIMPLDO; !RESTORE IMPLDO
%(***ELIMINATE EXTRA COMMON SUBEXPRESSIONS***)%
CMNPREV_.IONODE;
CMNNODE_.IONODE[SRCCOMNSUB];
WHILE .CMNNODE NEQ 0 DO
BEGIN
LOCAL BASE EXPR;
EXPR_.CMNNODE[ARG2PTR];
IF .CMNNODE[ARG1PTR] LEQ 1 OR
(.EXPR[OPRCLS] EQL DATAOPR AND .EXPR[OPERSP] EQL CONSTANT) THEN
BEGIN
%(
ELIMINATE THE COMMON SUB NODE
)%
IF .CMNPREV EQL .IONODE THEN IONODE[SRCCOMNSUB]_.CMNNODE[SRCLINK]
ELSE CMNPREV[SRCLINK]_.CMNNODE[SRCLINK];
SAVSPACE(EXSIZ-1,.CMNNODE);
CMNNODE_IF .CMNPREV EQL .IONODE THEN .IONODE[SRCCOMNSUB]
ELSE .CMNPREV[SRCLINK]
END
ELSE
BEGIN
CMNNODE[ARG1PTR]_0;
CMNPREV_.CMNNODE;
CMNNODE_.CMNNODE[SRCLINK]
END
END;
END;
GLOBAL ROUTINE FOLDUP=
%(**********************************************************************
RECURSIVE ROUTINE TO FIND AND FOLD LOOPS ON
AN I/O LIST
**********************************************************************)%
BEGIN
LOCAL BASE PREVCONT; !BECOMES LENTRY FOR MAKELIST
LOCAL BASE CURRDO; !BECOMES TOP FOR MAKELIST
PREVCONT_.PREVELEM; !REMEMBER PREVIOUS ELEMENT
CURRDO_.CURRELEM; !REMEMBER CURRENT ELEMENT
IF .CURRELEM[OPRS] EQL DOOS THEN
BEGIN
PREVELEM_.CURRELEM; !ADVANCE PAST DO NODE
CURRELEM_.CURRELEM[SRCLINK]
END;
WHILE .CURRELEM NEQ 0 DO
BEGIN
IF .CURRELEM[OPRS] EQL DOOS THEN
BEGIN
FOLDUP() !RECURSE A LEVEL
END
ELSE
IF .CURRELEM[OPRS] EQL CONTOS THEN
IF .CURRDO[OPRS] EQL DOOS THEN
IF .CURRDO[DOLBL] EQL .CURRELEM[SRCLBL] THEN
BEGIN
IMPLDO_1; !SET IMPLIED DO
TOP_.CURRDO; !SET TOP
INDVAR_.TOP[DOSYM]; !SET INDVAR
LEND_.CURRELEM; !SET LEND
BOTTOM_.CURRELEM[SRCLINK]; !SET BOTTOM
RETURN COLLAPSE() !COLLAPSE THE LOOP
END;
PREVELEM_.CURRELEM;
CURRELEM_.CURRELEM[SRCLINK]
END;
IMPLDO_0; !FOLD OUTER LEVEL
TOP_.PREVCONT; !SET UP TOP
COLLAPSE() !COLLAPSE THE OUTER LEVEL
END;
GLOBAL ROUTINE IOCLEAR(STMT)=
%(**********************************************************************
CONTROLLING ROUTINE TO FOLD AN I/O LIST
INTO IOLSTCALL, E1LISTCALL, AND E2LISTCALL
NODES
**********************************************************************)%
BEGIN
MAP BASE STMT;
IF (PREVELEM_.STMT[IOLIST]) NEQ 0 THEN
BEGIN
SAVSTMNT_.STMT; !SET STATEMENT ADDRESS
INPFLAG_.STMT[SRCID] EQL READID OR
.STMT[SRCID] EQL REREDID OR
.STMT[SRCID] EQL DECOID; !SET INPFLAG
CURRELEM_.PREVELEM[SRCLINK]; !SET UP POINTERS
FOLDUP() !FOLD LOOP RECURSIVELY
END
END;
END
ELUDOM