Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
pnropt.bli
There are 12 other files named pnropt.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) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: NORMA ABEL/HPW/MD/SJW/JNG/DCE/TFV/EGM/SRM/CDM/RVM
MODULE PNROPT(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND PNROPV = 7^24 + 0^18 + #1542; ! Version Date: 25-May-82
%(
***** Begin Revision History *****
113 ----- ----- MAKE REDUCE A GLOBAL FOR I/O OPTIMIZATION
114 ----- ----- CALL ARSKOPT TO DO PHASE 2 SKELETON FOR
EXPRESSIONS CREATED BY REDUCE
115 ----- ----- INTERFACE TO IOGPNR TO PROPAGATE AND REDUCE
EXPRESSIONS ON I/O LISTS
116 ----- ----- MAKE LOKDEFPT A GLOBAL ROUTINE
117 ----- ----- TAKE OUT REDUCE TO PUT IT IN TSTR
118 ----- ----- MAKE FOLDER GLOBAL
119 ----- ----- FIXES TO FOLDER FOR DATAOPR, ARRAYREF, IOLSCLS
120 ----- ----- CALL IOGPNR FOR READ/WRITE/ENCODE/DECODE
121 ----- ----- ADD RERED TO IOGPNR
122 ----- ----- STOP LOKDEFPT FROM BOMBING ON A DATAOPR
123 ----- ----- TYPO IN DOPROPAGATE CAUSING VALFLGS ON SYMBOL NODES
124 ----- ----- ZERO DEFPT1 ON AN ARRAYREF
125 ----- ----- FORGOT ASGNPROP IN 124
126 ----- ----- FOR ALL LOOPS OR MAINS ZERO DEFPTS
BETWEEN LENTRY AND TOP
127 ----- ----- ADD POTENTIAL TO REDUCE P2MUL AND P2+1 MULS
128 ----- ----- PROPAGATE THRU DO LOOPS BETTER AND THROUGH
.O VARIBALES
129 ----- ----- NEXT DAY CONTINUE ON 128
130 ----- ----- REDUCE SPECIAL SPECIAL OPS
131 ----- ----- DO NOT PROPAGATE INTO LOOPS ANY VARIABLE
THAT STARTS WITH A DOT .
132 ----- ----- MAKE OLDHEAD A MODULE OWN INSTEAD OF EXTERNAL
133 ----- ----- MAKE DOTOPROPAGATE LOOK AT I/O LISTS AND
ALSO PROPAGATE .O=.O,.O=.R,.S=.O,.I=.O
134 ----- ----- IF MULTIPLE OF 133 HAVE OCCURRED THEN
ELIMINATE .OX=.OX BY MAKING IT A CONTINUE
135 ----- ----- FIX DOTOPROPAGATE SO WE DO NOT BLOW I/O LISTS
136 ----- ----- FIX 135
137 ----- ----- FIX RUBOUT TO CHECK IF VARIABLE BEING
PROPAGATED WAS ALREADY PROPAGATED TO
138 ----- ----- TAKE INCORRECT CALL TO ASGNNN OUT OF
DOPROPAGATE
139 ----- ----- MAKE PROPCASE LOOK AT LH SIDES WHEN PROPAPAGATING TO GET ARRAYREFS
140 ----- ----- DOTOPROPAGATE LOSES NEGS/NOTS. STOP IT.
141 ----- ----- FOLD DABS
142 ----- ----- FOLD PROPAGATED DO LOOP CONTROLS WITH
THE NEG NODE ABOVE THEM
143 ----- ----- IN 142 CHECK FOR FULL NEGATIVE NOT
JUST OPERSP. STUPID!
***** Begin Version 4A *****
144 234 14167 FIX PROPAGATION OF LIB FUNCTION CALLS
WITH CONSTANT ARGUMENT TO PROGRAM ENTRY., (NEA/MD)
145 375 18450 USE .O VAR INSTEAD OF .R FOR CONSTANTS, (DCE)
146 VER5 ----- DON'T ZERO DEFPTS IN CONS1DEF,LOK1DEFPT,
LOK2DEFPT, ASGNPROP
MOVE DEFPT UP WHEN FOLDEE BECOMES A LEAF
SET DEFKEEPER FOR FOLDER
SET DEFPT OF CONSTANT PROPERLY
CALL DFCLEANUP SO .O FLAGS NOT CLEARED, (SJW)
147 421 QA651 DON'T DOTOPROPAGATE .O WHICH CAME FROM .R
(ORFIXFLG => NOT ELIGIBLE), (SJW)
148 465 20657 ZERO INDVAR BEFORE CALLING REDUCE FOR
STATEMENTS BEFORE THE LOOP, SINCE WE OTHERWISE
MIGHT FIND SOME REDUCTIONS (!!!)
149 466 VER5 DON'T TRY TO ZERO DEF POINTS FOR STATEMENTS
BETWEEN LENTRY AND TOP (REMOVES EDIT 465), (SJW)
***** Begin Version 5A *****
150 562 22540 WHEN FOLDING CONSTANTS, TAKE CARE OF EXPRESSIONS
WHICH HAVE NO PARENT POINTER (FIELD IS ZERO), (DCE)
***** Begin Version 5B *****
151 661 24100 DO NOT THROW AWAY LABELED STATEMENTS, (DCE)
152 714 26498 INTERNAL PROBLEM WITH DEF POINTS, (DCE)
***** Begin Version 6 *****
153 761 TFV 1-Mar-80 -----
Add indices for folding /GFLOATING constants
154 775 EGM 17-Jun-80 10-29566
Make DOTOPROPAGATE work reliably for the second and subsequent walks
through the statement nodes.
155 1022 TFV 27-Oct-80 ------
Preserve the bit patterns for octals and literals assigned to reals
under GFLOATING.
156 1060 DCE 6-Apr-81 -----
Fix bug with constant specop negative-number (A*0.5 where A has
a known propagated constant value).
157 1074 SRM 27-May-81 -----
Fix bug in folding logical IFs when the condition is NOT of
a REAL or DP. In PROPAGATE, it was assumed that IFNN would not
alter the data type of the constant; but .NOT. (REAL) has
type logical.
159 1104 EGM 25-Jun-81 --------
When propagating .O variables, handle the neg/not correctly for
assignments.
***** Begin Version 7 *****
158 1212 TFV 29-Apr-81 ------
Replace LITERAL with HOLLERITH.
160 1270 CDM 6-Oct-81 ------
In FOLDER, for type conversion nodes, do no conversions to arguments
for nodes that want real and have octal constant arguments.
161 1415 RVM 9-Nov-81
In VALCNV, preserve the bit pattern for logical constants that are
propagated under GFLOATING. This edit is related to edit 1414.
See REVHST.MAC.
162 1447 CDM/CKS 12-Dec-81
In DOTOPR, change
IF () AND () AND () THEN
to
IF () THEN IF () THEN IF () THEN
so that the last clause is not evaluated unless the first two
are true. Was getting an illegal memory read for reading
beyond what actually existed for a continue statement. Also
some needed prettying of code.
1542 RVM 25-May-82
In VALCNV, always convert OCTAL, HOLLERITH, LOGICAL, and
CONTROL expressions to REAL, even under /GFLOATING. This
removes edits 1022 and 1415 from this module.
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
EXTERNAL CNSTCMB,COPRIX,SPKABA,C1H,C1L,C2H,C2L,CMBEQLARGS,BLCMB,ARCMB,
TBLSEARCH,PREV,LOOPNO;
OWN DEFKEP,DEFKEEPER;
OWN OLDHEAD;
OWN PAPPY; !PARENT POINTER
EXTERNAL INDVAR,CORMAN;
EXTERNAL TOP,BOTTOM,LEND,LENTRY;
MAP PEXPRNODE TOP:LENTRY:LEND;
EXTERNAL MAKPR1;
EXTERNAL REDUCE;
FORWARD FIX1NN,FIX2NN;
FORWARD STMTPROP,ASGNNN;
EXTERNAL QQ;
MAP PHAZ2 QQ;
FORWARD IFNN;
!MACRO TO CALL MAKPR1 TO MAKE A NEG OR NOT NODE AND RETURN IT
MACRO MAKNEGNOT(WHICH)=
MAKPR1(.DAD,NEGNOT,WHICH,.SON[VALTYPE],0,.SON)$;
ROUTINE SETPNOT(DAD,SON)=
BEGIN
!THIS ROUTINE EXAMINES DAD, DETERMINES IF SON IS
!ARG1 OR ARG 2 AND
!COMPLEMENT THE NOTFLG OF THE CORRECT ARGUMENT
EXTERNAL TAKNOTARG;
EXTERNAL SKERR;
MAP BASE DAD:SON;
!IF ITS A STATEMENT LOOK AT ASSIGNEMNT
!LOGICAL AND ARITHMETIC IF.
IF .DAD[OPRCLS] EQL STATEMENT THEN
BEGIN
IF .DAD[SRCID] EQL ASGNID THEN
BEGIN
IF .SON EQL .DAD[RHEXP] THEN
BEGIN
IF NOT .DAD[A2NEGFLG] THEN
DAD[A2NOTFLG]_NOT .DAD[A2NOTFLG]
ELSE
DAD[RHEXP]_MAKNEGNOT(NOTOP);
END
ELSE
BEGIN
IF NOT .DAD[A1NEGFLG] THEN
DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
ELSE
SKERR();
END;
END ELSE
IF .DAD[SRCID] EQL IFLID THEN
DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
ELSE
IF .DAD[SRCID] EQL IFAID THEN
DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG];
END ELSE
!IT MUST BE AN EXPRESSION. IT HAD BETTER NOT BE
!A FUNCTION CALL (FNCALL)
IF .DAD[ARG1PTR] EQL .SON THEN
BEGIN
IF TAKNOTARG(.DAD) AND NOT .DAD[A1NEGFLG] THEN
DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
ELSE
DAD[ARG1PTR]_MAKNEGNOT(NOTOP);
END
ELSE
BEGIN
IF TAKNOTARG(.DAD) AND NOT .DAD[A2NEGFLG] THEN
DAD[A2NOTFLG]_NOT .DAD[A2NOTFLG]
ELSE
DAD[ARG2PTR]_MAKNEGNOT(NOTOP);
END;
END;
ROUTINE SETPNEG(DAD,SON)=
BEGIN
EXTERNAL SETNEG;
!THIS ROUTINE EXAMINES DAD, DETERMINES IF SON IS
!ARG1 OR ARG 2 AND CALLS THE ROUTINE SETNEG TO
!COMPLEMENT THE NEGFLG OF THE CORRECT ARGUMENT
MAP BASE DAD:SON;
!IF ITS A STATEMENT LOOK AT ASSIGNEMNT
!LOGICAL AND ARITHMETIC IF.
IF .DAD[OPRCLS] EQL STATEMENT THEN
BEGIN
IF .DAD[SRCID] EQL ASGNID THEN
BEGIN
IF .SON EQL .DAD[RHEXP] THEN
BEGIN
IF NOT .DAD[A2NOTFLG] THEN
DAD[A2NEGFLG]_NOT .DAD[A2NEGFLG]
ELSE
DAD[RHEXP]_MAKNEGNOT(NEGOP);
END
ELSE
DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG];
END ELSE
IF .DAD[SRCID] EQL IFLID THEN
DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG]
ELSE
IF .DAD[SRCID] EQL IFAID THEN
DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG];
END ELSE
!IT MUST BE AN EXPRESSION. IT HAD BETTER NOT BE
!A FUNCTION CALL (FNCALL)
IF .DAD[ARG1PTR] EQL .SON THEN
BEGIN
IF SETNEG(.DAD,1) THEN ELSE DAD[ARG1PTR]_MAKNEGNOT(NEGOP);
END
ELSE
BEGIN
IF SETNEG(.DAD,0) THEN ELSE DAD[ARG2PTR]_MAKNEGNOT(NEGOP);
END;
END;
GLOBAL ROUTINE FOLDER(EXPR)=
BEGIN
EXTERNAL SETPVAL;
![761] KSPECG, KILFBG, KTYPCG for folding /GFLOATING constants
%[761]% EXTERNAL KSPECB,KSPECG,DNEGCNST,KILFBA,KILFBR,KILFBG;
%[761]% EXTERNAL RELSKOPT,BLSKOPT,ARSKOPT,KTYCM,KTYPCB,KTYPCG;
EXTERNAL NEGFLG,NOTFLG;
MAP PEXPRNODE EXPR;
!A CONSTANT HAS JUST PROPAGATED
!CHECK FOR AND PERFORM ANY POSSIBLE FOLDING ETC
!
%[1060]% LOCAL PHAZ2 OPEXPR;
%[1060]% REGISTER PHAZ2 T;
OPEXPR_.EXPR; !SAVE TO SEE IF IT REALLY FOLDED
!FOR SOME OPERATIONS WE MAY BE HERE BECAUSE ONE OF
!TWO CONSTANTS IN THE EXPRESSION FOLDED, BUT NOT
!NECESSARILY BOTH. THIS IS OK, IN THAT ROUTINES LIKE RELSKOPT,
!ARSKOPT, ETC HANDLE THIS SITUATION. IT IS NOT
!ACCEPTABLE, HOWEVER, FOR SPECOPS AND INLINFNS.
!SO WE WILL TEST FOR THE THREE EXCEPTIONS AND QUIT
!IF BOTH ARGS ARE NOT CONSTANTS.
!WE MUST ALSO MAKE SURE THAT NEG/NOT FLAGS ARE FOLDED
!INTO ANY CONSTANTS THAT ARE CURRENTLY EXTANT OR CREATED.
EXPR_(
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
!FOLD NEG/NOT FLAGS, IF THERE
T_.EXPR[ARG1PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
PAPPY_.EXPR[PARENT];
!SET NOT FLAG FALSE
NOTFLG_FALSE;
EXPR_BLSKOPT(.EXPR);
!IF BLSKOPT SET NOTFLG THEN WE HAVE TO PASS IT BACK UP
IF .NOTFLG THEN
SETPNOT(.PAPPY,.OPEXPR);
.EXPR
END;
!DATAOPR
BEGIN
RETURN .EXPR
END;
!RELATIONAL
BEGIN
!FOLD NEG/NOT FLAGS IF THERE
T_.EXPR[ARG1PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
RELSKOPT(.EXPR)
END;
!FNCALL
.EXPR;
!ARITHMETIC
BEGIN
!FOLD NEG/NOT FLAGS IF THERE
T_.EXPR[ARG1PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
!SAVE PARENT POINTER FOR THE NEGFLAG PROPAGATION HASSLE
PAPPY_.EXPR[PARENT];
!SET NEGFLG FALSE
NOTFLG_FALSE;
NEGFLG_FALSE;
EXPR_ARSKOPT(.EXPR);
!IF NEGFLG IS NOW TRUE WE HAVE TO SET THE NEGFLG ON
!PAPPY FOR THE CORRECT ARGUMENT. NOT SET BUT COMPLEMENT.
IF .NEGFLG THEN
SETPNEG(.PAPPY,.OPEXPR);
.EXPR
END;
!TYPECNV
BEGIN
LOCAL BASE ARG2NODE;
!FOLD NEG/NOT FLAGS, IF THERE
T_.EXPR[ARG2PTR];
IF .T[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
!IF THIS IS A CONVERSION FROM LOGICAL (INDICATED BY OPERSP)
! TO DOUBLE PRECISION DO NOT DO IT ELSE THERE WILL
! BE ROUNDING ERRORS ON A KA.
![1270] Also if node wants Real and has non-real constant
! argument then leave before conversions take place.
%1270% T_.EXPR[ARG2PTR];
IF (.EXPR[VALTYPE] EQL DOUBLPREC AND
.EXPR[OPERSP] EQL LOGICAL) OR
%1270% (.EXPR[OPERSP] EQL FROMREAL AND .T[VALTYPE] NEQ REAL)
THEN RETURN(.EXPR);
COPRIX_KTPCNVIX(EXPR);
ARG2NODE_.EXPR[ARG2PTR];
C1H_.ARG2NODE[CONST1];
C1L_.ARG2NODE[CONST2];
CNSTCMB();
MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
END;
!ARRAYREF
BEGIN
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
!FOLD NEG/NOT FLAGS, IF THERE
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
EXPR[ARG2PTR]_ARSKOPT(.EXPR[ARG2PTR])
END;
RETURN .EXPR
END;
!CMNSUB
RETURN .EXPR;
!NEGNOT
BEGIN
LOCAL BASE ARGNODE;
!FOLD NEG/NOT FLAGS, IF THERE
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
ARGNODE_.EXPR[ARG2PTR];
IF .ARGNODE[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
IF .EXPR[OPERSP] EQL NEGOP THEN
NEGCNST(ARGNODE)
ELSE
NOTCNST(ARGNODE)
END;
!SPECOP
BEGIN
LOCAL BASE ARG1NODE;
%[1060]% MACHOP HRREM=#572;
T_.EXPR[ARG1PTR];
IF .T[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
ARG1NODE_.EXPR[ARG1PTR];
COPRIX_KSPECOPIX(EXPR);
C1H_.ARG1NODE[CONST1];
C1L_.ARG1NODE[CONST2];
%[1060]% T_.EXPR[ARG2PTR];
%[1060]% HRREM(T,C2L); ! Careful for negative numbers...
CNSTCMB();
MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
END;
!FIELDREF
BEGIN
END;
!STOERCLS
BEGIN END;
!REGCONTENTS
BEGIN END;
!LABOP
BEGIN END;
!STATEMENT
BEGIN END;
!IOLSCLS
RETURN .EXPR;
!INLINFN
BEGIN
LOCAL BASE ARGNODE;
EXTERNAL KILDAB;
T_.EXPR[ARG1PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
ARGNODE_.EXPR[ARG1PTR];
IF .ARGNODE[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
ARGNODE_.EXPR[ARG2PTR];
IF .ARGNODE NEQ 0 THEN
BEGIN
T_.EXPR[ARG2PTR];
IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
IF .ARGNODE[OPR1] NEQ CONSTFL THEN
RETURN(.EXPR);
END;
ARGNODE_.EXPR[ARG1PTR];
C1H_.ARGNODE[CONST1];
C1L_.ARGNODE[CONST2];
ARGNODE_.EXPR[ARG2PTR];
IF .ARGNODE NEQ 0 THEN
BEGIN
C2H_.ARGNODE[CONST1];
C2L_.ARGNODE[CONST2];
END;
!IF THIS IS DABS SPECIFICALLY SET COPRIX
IF .EXPR[OPERATOR] EQL DABSFNOP THEN
COPRIX_KILDAB
ELSE
COPRIX_KILFOPIX(EXPR);
CNSTCMB();
MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
END
TES);
!NOW LOOK TO SEE IF ANY PROPAGATION TOOK PLACE
!IF IT DID (THE CONSTANTS FOLDED OR COMBINED) THEN
!CHECK TO SEE THAT DEFPOINTS OF ITEMS LEFT ARE SET
IF .OPEXPR NEQ .EXPR THEN
BEGIN
!CHECK TO SEE THAT FOLD WAS INDEED TO A
!DATA ITEM. EXPRESSION AND TRUE FOLDS
!TO EXPRESSION AND SETTING THE VAL FLAG WOULD BE A NO-NO
T _ .OPEXPR [PARENT]; ! LOOK AT PARENT
!THERE MAY BE NO PARENT FOR THIS EXPRESSION, AND IF NOT, WE
! WANT TO SIMPLY RETURN AFTER FOLDING THE CONSTANTS.
IF .T EQL 0 THEN RETURN .EXPR;
IF .EXPR [OPRCLS] EQL DATAOPR
THEN BEGIN
SETPVAL(.OPEXPR); ! SET VAL FLAGS ABOVE
IF .T [OPRCLS] NEQ STATEMENT ! MOVE DEFPT UP
THEN
IF .T [ARG1PTR] EQL .OPEXPR
THEN T [DEFPT1] _ .DEFKEEPER
ELSE T [DEFPT2] _ .DEFKEEPER;
END;
IF .T[OPRCLS] EQL STATEMENT THEN !POINTS BACK TO
!STATEMENT
IF (.T[SRCOPT] NEQ 0) AND (.T[SRCID] NEQ DOID) THEN
T[OPDEF]_(IF .EXPR[OPR1] EQL CONSTFL THEN
.LENTRY ELSE .DEFKEEPER);
END;
.EXPR
END;
ROUTINE CHKPROP=
BEGIN
!IF ELIGIBLE GET A DEFINITION POINT FOR THE GLOBAL
!A1NODE. IF THE DEFINITION POINT IS AN ASSIGNMENT OF
!THE VARIABLE TO A CONSTANT THEN RETURN THE CONSTANT IN
!A1NODE AND 1 ELSE REYURN 0
EXTERNAL GETDEF,ONLIST,A1NODE;
MAP PHAZ2 OLDHEAD:A1NODE;
REGISTER BASE T;
!***********
MACRO IDDOT=0,3,30,6$;
!*********
!QUIT QUICK IF A1NODE STARTS WITH A DOT. WE MAY LOSE
!.O VARS NOW BUT WILL GET THEM WITH DOTOPROPAGATE
IF .A1NODE[IDDOT] EQL SIXBIT"." THEN RETURN;
!OLDHEAD POINTS TO A DO NODE. CHECK FOR THE LEAF
!CHANGING INSIDE THE LOOP
IF NOT ONLIST(.OLDHEAD[DOCHNGL],.A1NODE) THEN
BEGIN
T_GETDEF(.A1NODE,.OLDHEAD,0);
!IF A VALID DEFINITION POINT IS RETURNED
IF .T NEQ 0 THEN
BEGIN
!IS IT AN ASSIGNMENT STATEMENT
IF .T[OPRS] EQL ASGNOS THEN
BEGIN
IF .T[LHEXP] EQL .A1NODE
AND .T[A2VALFLG] THEN
BEGIN
!ASSIGN A1NODE AND TEST FOR
!CONSTANT
A1NODE_.T[RHEXP];
IF .A1NODE[OPR1] EQL CONSTFL THEN
RETURN 1;
END;
END;
END;
END;
END;
ROUTINE GRASPDEF(EXPR,A2FLG)=
BEGIN
!CHECK EXPR FOR POTENTIAL PROPAGATION.
!CHECK ARG 2 IF A2FKG IS SET. SUBSTITUTE THE
!CONSTANT IF PROPAGATED
EXTERNAL A1NODE;
MAP BASE A1NODE:EXPR;
A1NODE_(IF .A2FLG THEN .EXPR[ARG2PTR] ELSE .EXPR[ARG1PTR]);
IF .A1NODE[OPR1] EQL CONSTFL THEN RETURN;
IF CHKPROP() THEN
(IF .A2FLG THEN EXPR[ARG2PTR] ELSE
EXPR[ARG1PTR])_.A1NODE;
END;
ROUTINE GRABDEF(EXPR)=
BEGIN
EXTERNAL DNEGCNST;
MAP PEXPRNODE EXPR;
!EXPR POINTS AT AN EXPRESSION TREE TO BE WALKED
!*****************
!HELPFUL MACROS
!*****************
MACRO SNATCH1=
BEGIN
IF .EXPR[A1VALFLG] THEN
GRASPDEF(.EXPR,0)
ELSE
GRABDEF(.EXPR[ARG1PTR]);
END$;
MACRO SNATCH2=
BEGIN
IF .EXPR[A2VALFLG] THEN
GRASPDEF(.EXPR,1)
ELSE
GRABDEF(.EXPR[ARG2PTR]);
END$;
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
SNATCH1;
SNATCH2;
END;
!DATAOPR
BEGIN END;
!RELATIONAL
BEGIN
SNATCH1;
SNATCH2;
END;
!FNCALL
BEGIN END;
!ARITHMETIC
BEGIN
SNATCH1;
SNATCH2;
END;
!TYPECNV
BEGIN
SNATCH2;
END;
!ARRAYREF
BEGIN
IF .EXPR[ARG2PTR] NEQ 0 THEN
SNATCH2;
END;
!CMNSUB
BEGIN END;
!NEGNOT
BEGIN
SNATCH2;
END;
!SPECOP
BEGIN
SNATCH1;
END;
!FIELDREF NOT IN RELEASE 1
BEGIN END;
!STORECLS
BEGIN END;
!REGCONTENTS
BEGIN END;
!LABOP
BEGIN END;
!STATEMENT
BEGIN END;
!IOLSCLS
BEGIN END;
!INLINFN
BEGIN
SNATCH1;
IF .EXPR[ARG2PTR] NEQ 0 THEN
SNATCH2;
END
TES;
END;
ROUTINE DOPROPAGATE(STMT)=
BEGIN
!TO EXAMINE ALL STATEMENTS IN THE LOOP HEADED BY STMT
!FOR THE PROPAGATION OF VARIABLES
!STMT IS THE DO STATEMENT
EXTERNAL BASE A1NODE;
LOCAL PEXPRNODE P:PB;
MAP PHAZ2 STMT;
IF .STMT[SRCOPT] EQL 0 THEN RETURN;
OLDHEAD_.STMT;
P_.STMT;
PB_.STMT[DOLBL];
PB_.PB[SNHDR];
DO
BEGIN
!WE NOW HANDLE ONLY ASSIGNMENT STATEMENTS AND DO LOOPS
IF .P[SRCID] EQL ASGNID THEN
BEGIN
IF NOT .P[A1VALFLG] THEN
GRABDEF(.P[LHEXP]);
IF NOT .P[A2VALFLG] THEN
GRABDEF(.P[RHEXP])
ELSE
BEGIN
A1NODE_.P[RHEXP];
IF CHKPROP() THEN
ASGNNN(.P);
END;
END ELSE
IF .P[SRCID] EQL DOID THEN
BEGIN
IF .P NEQ .STMT THEN
IF NOT .P[FLCWD] THEN
BEGIN
A1NODE_.P[DOLPCTL];
IF .A1NODE[OPR1] EQL VARFL THEN
BEGIN
IF CHKPROP() THEN
BEGIN
P[DOLPCTL]_.A1NODE;
STMTPROP(.P);
END;
END ELSE
BEGIN
GRABDEF(.P[DOLPCTL]);
!IF IT PROPAGATED WE COULD HAVE
!LEFT A NEG NODE OVER A CONSTANT
!CHECK FOR THAT AS A SPECIFIC CASE
!AND FOLD IT.
A1NODE_.P[DOLPCTL];
IF .A1NODE[OPR1] EQL NEGFL
AND .A1NODE[A2VALFLG] THEN
BEGIN
!LOOK A LEVEL FURTHER FOR THE
!CONSTANT
A1NODE_.A1NODE[ARG2PTR];
IF .A1NODE[OPR1] EQL CONSTFL THEN
P[DOLPCTL]_NEGCNST(A1NODE);
END;
END;
END;
END;
P_.P[SRCLINK];
END UNTIL .P EQL .PB[SRCLINK];
END;
ROUTINE VALCNV(LHSNOD,RHSNOD)=
BEGIN
!WHEN A CONSTANT TO PROPAGATE HAS BEEN FOUND
!WE MUST PERHAPS PERFORM SOME TYPE CONVERSION WONDERS ON
!IT. SINCE ALL CONSTANTS (REAL) ARE CARRIED IN DOUBLE
!PRECISION, WE MUST ROUND BEFORE USE IF THIS IS A REAL
!VARIABLE. IF THE VALUE TYPE ON BOTH SIDES OF THE
!ASSIGNMENT IS NOT THE SAME, WE MUST ALSO CONVERT THE CONSTANT.
!THIS IS FOR CASES LIKE A=.TRUE..
!ALSO WE DO NOT WANT TO CONVERT DP=".........
!OR DP='....'
![761] KTYPCG and KGFRL for folding /GFLOATING constants
%[761]% EXTERNAL KTYPCB,KTYPCG;
%[761]% EXTERNAL COPRIX,C1H,C1L,C2H,C2L,KDPRL,KGFRL,KGFSPR,CNSTCMB;
MAP BASE RHSNOD:LHSNOD;
!SAME VALTYPE, REAL
IF .LHSNOD[VALTYPE] EQL .RHSNOD[VALTYPE] AND .LHSNOD[VALTYPE]
EQL REAL THEN
BEGIN
![761] Fold DP to SP precision based on /GFLOATING
![761] Do not convert DP to actual SP since exponent widths can differ
%[761]% IF .GFLOAT THEN COPRIX_KGFSPR ELSE COPRIX_KDPRL;
C1H_.RHSNOD[CONST1];
C1L_.RHSNOD[CONST2];
CNSTCMB();
RETURN(MAKECNST(REAL,.C2H,.C2L));
END ELSE
BEGIN
!VALTYPES DIFFERENT
IF .LHSNOD[VALTYPE] NEQ .RHSNOD[VALTYPE] THEN
BEGIN
!CHECK FOR THOSE ADDITIONAL ONES NOT TO CONVERT
IF .LHSNOD[VALTYPE] EQL DOUBLPREC AND
%1212% (.RHSNOD[VALTYPE] EQL HOLLERITH OR
.RHSNOD[VALTYPE] EQL DOUBLOCT) THEN
RETURN(.RHSNOD); !NO CONVERSION
!WE ARE HERE AND WANT TO CONVERT
COPRIX_KKTPCNVIX(.LHSNOD[VALTP2],.RHSNOD[VALTP2]);
C1H_.RHSNOD[CONST1];
C1L_.RHSNOD[CONST2];
CNSTCMB();
RETURN(MAKECNST(.LHSNOD[VALTYPE],.C2H,.C2L));
END;
END;
!ELSE ALL IS OK JUST USE CONSTANT AS IS
RETURN(.RHSNOD);
END;
ROUTINE FIX1NN(EXPR,NUMB)=
BEGIN
!CHECK FOR A NEG AND(SHOULD NEVER BE)/OR NOT FLAG
!OVER ARG1 OF EXPR. ARG1 IS A CONSTANT. NEGATE
!OR COMPLEMENT THE CONSTANT AND FIX ARG1PTR.
!NUMB IS THE CONSTANT.
MAP PEXPRNODE EXPR:NUMB;
EXTERNAL DNEGCNST;
IF .EXPR[A1NEGFLG] THEN
BEGIN
EXPR[ARG1PTR]_NEGCNST(NUMB);
EXPR[A1NEGFLG]_0;
END;
IF .EXPR[A1NOTFLG] THEN
BEGIN
EXPR[ARG1PTR]_NOTCNST(NUMB);
EXPR[A1NOTFLG]_0;
END;
END;
ROUTINE CONS1DEF(EXPR)=
BEGIN
!DETERMINE IF A PROPAGATION CAN OCCUR
!AND DO IT FOR THE FIRST ARGUMENT OF EXPR
!OWN DEFKEEPER _ DEFPT2 IF ARG1 IS OR BECOMES A CONSTANT
! DEFPT1 IF ARG1 REMAINS A VARIABLE
EXTERNAL DNEGCNST,CHOSEN,GLOBREG,LENTRY;
MAP PEXPRNODE EXPR;
LOCAL BASE PC:PB:PA;
!WE ARE LOOKING AT A LEAF
!IF IT IS A CONSTANT OR VARIABLE THAT PROPAGATES
!RETURN 1. THIS MAY CAUSE SOME EXTRA WORK
!IN THAT THE VARIABLE CONSTANT COMBO WILL CAUSE
!AN EXTRA CALL TO LOCAL OPTIMIZATION ROUTINES
!BUT IT IS THE ONLY WAY WE CAN FOLD HAIRY EXPRESSIONS
!THAT COLLAPSE UP FROM A SINGLE PROPAGATE.
PC_.EXPR[ARG1PTR];
IF .PC[OPR1] EQL CONSTFL THEN
BEGIN
FIX1NN(.EXPR,.PC);
DEFKEEPER _ .EXPR [DEFPT2];
RETURN(1);
END;
IF .PC[OPR1] EQL VARFL THEN
BEGIN
!THE LEAF IS A VARIABLE
DEFKEEPER _
PA_.EXPR[DEFPT1];
!DONT MISTAKENLY PROPAGATE THE CONSTANT THAT
!MAY SIT AT LENTRY.
IF .PA EQL 0 OR .PA EQL .LENTRY
THEN RETURN (0);
IF .PA[SRCID] EQL ASGNID AND
.PA[LHEXP] EQL .PC THEN
!THE DEFINITION FPOINT IS AN ASSIGNMENT OF THAT
!VARIABLE
BEGIN
PB_.PA[RHEXP];
!LOOK AT THE RIGHT HAND SIDE
IF .PB[OPR1] EQL CONSTFL THEN
BEGIN
!REALLY GOT ONE!
!SAVE DEFINITION POINT
DEFKEEPER_.EXPR[DEFPT2];
PB_VALCNV(.PA[LHEXP],.PB);
EXPR[ARG1PTR]_.PB;
FIX1NN(.EXPR,.PB);
EXPR [DEFPT1] _ .LENTRY;
![714] REMOVE THE CODE WHICH PURPORTS TO "SAVE THE PROPAGATION"
![714] THIS CAN CAUSE PROBLEMS, AND APPEARS TO DO NO GOOD AT ALL!
RETURN(1)
END;
END;
END ELSE
BEGIN
!IF IT WAS A CONSTANT MAKE SURE THAT THERE
!ARE NO NEG OR NOT FLAGS LEFT ABOVE IT. THE
!CASE MAY ARISE IF THE CONSTANT IS A PROPAGATED
!EXPRESSION (LIKE INLINFN). FOR THE NEG OR
!NOT INTO THE CONSTANT
IF .PC[OPR1] EQL CONSTFL THEN
FIX1NN(.EXPR,.EXPR[ARG1PTR]);
END;
END;
ROUTINE FIX2NN(EXPR,NUMB)=
BEGIN
!EXPR[ARG2PTR] IS A CONSTANT. SEE THAT NEG AND NOT FLAGS
!ARE FOLDED INTO THE CONSTANT. NUMB IS EXPR[ARG2PTR].
!EQUIVALENT OF FIX1NN FOR ARG2.
MAP PEXPRNODE EXPR:NUMB;
EXTERNAL DNEGCNST;
IF .EXPR[A2NEGFLG] THEN
BEGIN
EXPR[ARG2PTR]_NEGCNST(NUMB);
EXPR[A2NEGFLG]_0;
END;
IF .EXPR[A2NOTFLG] THEN
BEGIN
EXPR[ARG2PTR]_NOTCNST(NUMB);
EXPR[A2NOTFLG]_0;
END;
END;
ROUTINE CONS2DEF(EXPR)=
BEGIN
!DETERMINE IF A PROPAGATION CAN OCCUR AND DO IT
!FOR THE SECOND ARGUMENT OF EXPR
!OWN DEFKEEPER _ DEFPT1 IF ARG2 IS OR BECOMES A CONSTANT
! DEFPT2 IF ARG2 REMAINS A VARIABLE
! NOTE DEFPT1 _ .LENTRY IN CONS1DEF IF ARG1 BECOMES CONSTANT
EXTERNAL DNEGCNST,CHOSEN,GLOBREG,LENTRY;
MAP PEXPRNODE EXPR;
LOCAL BASE PC:PB:PA;
!WE ARE LOOKING AT A LEAF
!SEE COMMENTS IN FRONT OF CONS1DEF
PC_.EXPR[ARG2PTR];
IF .PC[OPR1] EQL CONSTFL THEN
BEGIN
FIX2NN(.EXPR,.PC);
DEFKEEPER _ .EXPR [DEFPT1];
RETURN(1);
END;
IF .PC[OPR1] EQL VARFL THEN
BEGIN
!THE LEAF IS A VARIABLE
DEFKEEPER _
PA_.EXPR[DEFPT2];
!DO NOT INADVERTENTLY PROPAGATE AN INNOCENT
!ASSIGNMENT AT ENTRY
IF .PA EQL 0 OR .PA EQL .LENTRY
THEN RETURN (0);
IF .PA[SRCID] EQL ASGNID AND .PA[LHEXP] EQL .PC THEN
BEGIN
!THE DEFINITION POINT IS AN ASSIGNMENT OF THAT VARIABLE
PB_.PA[RHEXP];
!LOOK AT THE RIGHT HAND SIDE
IF .PB[OPR1] EQL CONSTFL THEN
BEGIN
!REALLY GOT ONE!
PB_VALCNV(.PA[LHEXP],.PB);
EXPR[ARG2PTR]_.PB;
DEFKEEPER _ .EXPR [DEFPT1];
FIX2NN(.EXPR,.PB);
EXPR [DEFPT2] _ .LENTRY;
![714] REMOVE THE CODE THAT PURPORTS TO "SAVE THE PROPAGATION"
![714] IT APPEARS TO CAUSE PROBLEMS AND DO NO GOOD AT ALL!
RETURN(1);
END;
END;
END ELSE
BEGIN
!IF IF IS ALREADY A CONSTANT (PROPAGATED EXPRESSION)
!MAKE SURE NEG/NOT FLAGS ARE FOLDED INTO IT.
IF .PC[OPR1] EQL CONSTFL THEN
FIX2NN(.EXPR,.EXPR[ARG2PTR]);
END;
END;
!MACROS TO CHECK ARGS AND SET VALFLAGS WHEN NEEDED.
MACRO VAL1FX(EXPR)=
BEGIN
PA_.EXPR[ARG1PTR];
IF .PA[OPRCLS] EQL DATAOPR THEN
EXPR[A1VALFLG]_1;
END$,
VAL2FX(EXPR)=
BEGIN
PA_.EXPR[ARG2PTR];
IF .PA[OPRCLS] EQL DATAOPR THEN
EXPR[A2VALFLG]_1;
END$,
VALBFX(EXPR)=
BEGIN
VAL1FX(EXPR);
VAL2FX(EXPR);
END$;
GLOBAL ROUTINE LOKDEFPT(EXPRNODE)=
BEGIN
EXTERNAL LOOP,RDCTMP,SKERR;
!LOOK AT ALL LEAVES. EXAMINE THE DEFINITION POINT FOR AN ASSIGNMENT
!OF THAT VARIABLE TO A CONSTANT. SUBSTITUTE THAT CONSTANT FOR THE
!VARIABLE. @ROCESSING IS DONE IN MOORE FLOOD ORDER. THIS HOPEFULLY
!INSURES THAT ALL PROPAGATIONS WHICH CAUSE OTHER PROPAGATIONS ARE CAUGHT
REGISTER PEXPRNODE EXPR;
LOCAL BASE PA;
LOCAL WHATSUP;
EXPR_.EXPRNODE;
!INITIALIZE THE LOCAL THAT WILL TELL US IF PROPAGATION
!DID ACTUALLY DID OCCUR.
!FOR EACH OPERCLASS THE ARGS ARE EXAMINED.
!CONS1DEF AND CONS2DEF RETURN A 1 IF A PROPAGATION
!OCCURRED AND A 0 OTHERWISE. IN ALL CASES WE WAIT TO
!FOLD UNTIL BOTH ARGS HAVE BEEN EXAMINED. THIS IS DONE
!FOR TWO REASONS:
! 1. THE NODE MIGHT CHANGE FORM IN THE MIDDLE
! 2.IT SHOULD BE FASTER IF ONLY ONE PROPAGATES
WHATSUP_0;
!GET OUT IF ITS NOT AN EXPRESSION
IF .EXPR[OPRCLS] EQL DATAOPR THEN RETURN(.EXPR);
!HANDLE THE CASE WHERE THEY ARE ALEEADY BOTH CONSTANTS
!AND FOR SOME REASON HAVE NOT BEEN *LOCALLY* FOLDED
IF .EXPR[A1VALFLG] THEN
BEGIN
PA_.EXPR[ARG1PTR];
IF .PA[OPR1] EQL CONSTFL THEN
IF .EXPR[A2VALFLG] THEN
BEGIN
PA_.EXPR[ARG2PTR];
IF .PA[OPR1] EQL CONSTFL THEN
BEGIN
EXPR_FOLDER(.EXPR);
RETURN(.EXPR);
END;
END;
END;
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
IF NOT .EXPR[A1VALFLG] THEN
BEGIN
EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
END;
IF .EXPR[A1VALFLG] THEN
WHATSUP_CONS1DEF(.EXPR);
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END;
!DATAOPR
SKERR();
!RELATIONAL
BEGIN
IF NOT .EXPR[A1VALFLG] THEN
BEGIN
EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
END;
IF .EXPR[A1VALFLG] THEN
WHATSUP_CONS1DEF(.EXPR);
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END;
!FNCALL
BEGIN
EXTERNAL SETPVAL;
!THIS IS VERY SAD. IF A LIBRARY FUNCTION, IT
!COULD BE MOVED TO PROGRAM ENTRY, BUT ARGLISTS
!HAVE NO RROM FOR DEFINITION POINT INFO.
!WE WILL TRY FOR A CONSTANT ARGUMENT
!THIS WILL APPLY ONLY (MOST PROBABLY) TO BENCHMARKS
LOCAL ARGUMENTLIST AG;
AG_.EXPR[ARG2PTR];
!FOR A LIBRARY FUNCTION OF ONE ARGUMENT
IF .EXPR[OPERSP] EQL LIBARY AND .LOOP NEQ 0 THEN
BEGIN
IF .AG[ARGCOUNT] EQL 1 THEN
BEGIN
REGISTER BASE TMP;
TMP_.AG[1,ARGNPTR];
IF .TMP[OPR1] EQL CONSTFL THEN
BEGIN
EXTERNAL GETOPTEMP;
OWN BASE FRONT:STMT;
!SET VAL FLG ON OLD PARENT
SETPVAL(.EXPR);
FRONT_.SORCPTR<LEFT>; !FIRST STATEMENT OF PROG
!THIS COULD BE AN ENTRY FOR A SUBPROGRAM
STMT_.FRONT[SRCLINK];
WHILE .STMT[SRCID] EQL ENTRID DO
BEGIN
FRONT_.STMT; !DEFINE
!FRONT AS THE ENTRY STATEMENT
STMT_.STMT[SRCLINK];
END;
NAME<LEFT>_ASGNSIZ + SRCSIZ;
STMT_CORMAN();
STMT[OPRCLS]_STATEMENT;
STMT[OPERSP]_ASGNID;
STMT[A1VALFLG]_1;
!USE .O INSTEAD OF .R (TO GET CORRECT
! TYPE INFORMATION)
TMP_STMT[RHEXP]_.EXPR;
STMT[LHEXP]_GETOPTEMP(.TMP[VALTYPE]);
!SET THE NEW PARENT OF THE FUNCTION CALL
EXPR[PARENT]_.STMT;
STMT[SRCLINK]_.FRONT[SRCLINK];
FRONT[SRCLINK]_.STMT;
RETURN(.STMT[LHEXP]);
END;
END;
END;
!ZERO ANY DEFINITION POINTS ON EXPRESSION ARGS
!THE CHEAPEST WAY (CODE SIZE-WISE) IS TO CALL
!LOKDEF
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
LOCAL BASE TMP1;
TMP1_.AG[.I,ARGNPTR]; !LOOK AT ARG
IF .TMP1[OPRCLS] NEQ DATAOPR THEN
AG[.I,ARGNPTR]_LOKDEFPT(.TMP1);
END;
RETURN(.EXPR);
END;
!ARITHMETIC
BEGIN
IF NOT .EXPR[A1VALFLG] THEN
BEGIN
EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
END;
IF .EXPR[A1VALFLG] THEN
WHATSUP_CONS1DEF(.EXPR);
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
IF .EXPR[OPR1] EQL MULOPF THEN
EXPR_REDUCE(.EXPR);
END;
!TYPECNV
BEGIN
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END;
!ARRAYREF
BEGIN
IF .EXPR[A2VALFLG] THEN
BEGIN
IF .EXPR[ARG2PTR] NEQ 0 THEN
WHATSUP_CONS2DEF(.EXPR);
END
ELSE
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END;
!CMNSUB
RETURN(.EXPR);
!NEGNOT
BEGIN
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END;
!SPECOP
BEGIN
EXTERNAL INDVARR;
IF NOT .EXPR[A1VALFLG] THEN
BEGIN
EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
END;
IF .EXPR[A1VALFLG] THEN
WHATSUP_CONS1DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
!POTEATIALLY REDUCE IT
IF (.EXPR[OPR1] EQL P2MULOPF) OR (.EXPR[OPR1] EQL P2PL1OPF) THEN
IF (.EXPR[VALTP1] EQL INTEG1) AND (.EXPR[ARG1PTR] EQL .INDVAR) THEN
IF EXTSIGN(.EXPR[ARG2PTR]) GTR 0 THEN
EXPR_REDUCE(.EXPR);
END;
!FIELDREF
RETURN(.EXPR);
!STORECLS
RETURN(.EXPR);
!RECONTENTS
RETURN(.EXPR);
!LABOP
!ILLEGAL
RETURN(.EXPR);
!STATEMENT
!ILLEGAL
RETURN(.EXPR);
!IOLSCLS
RETURN(.EXPR);
!INLINFN
BEGIN
IF NOT .EXPR[A1VALFLG] THEN
BEGIN
EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
END;
IF .EXPR[A1VALFLG] THEN
WHATSUP_CONS1DEF(.EXPR);
IF .EXPR[ARG2PTR] NEQ 0 THEN
IF NOT .EXPR[A2VALFLG] THEN
BEGIN
EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
END;
IF .EXPR[A2VALFLG] THEN
WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
END
TES;
!NOW ONCE MORE LOOK AT WHAT HAS BECOME OF THE EXPRESSION
!AND SET THE VAL FLAGS IF APPROPRIATE. FULL CASE IS NEEDED
!CAUSE PHASE 1 SEEMS TO HAVE THE NTY HABIT OF LEAVING
!JUNK IN ARG1 OF NODES THAT SHOULD HAVE ARG1 ZERO.
CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
VALBFX(EXPR);
!DATAOPR
BEGIN END;
!RELATIONAL
VALBFX(EXPR);
!FNCALL
BEGIN END;
!ARITHMETIC
VALBFX(EXPR);
!TYPECNV
VAL1FX(EXPR);
!ARRAYREF
VAL2FX(EXPR);
!CMNSUB
BEGIN END;
!NEGNOT
VAL2FX(EXPR);
!SPECOP
VAL1FX(EXPR);
!FIELDREF
BEGIN END;
!STORECLS
BEGIN END;
!REGCONTENTS
BEGIN END;
!LABOP
BEGIN END;
!STATEMENT
BEGIN END;
!IOLSCLS
BEGIN END;
!INLINFN
BEGIN
VAL1FX(EXPR);
IF .EXPR[ARG2PTR] NEQ 0 THEN
VAL2FX(EXPR);
END
TES;
RETURN .EXPR
END;
SWITCHES NOSPEC;
!***************************************************
!DELETE A LOGICAL IF FROM THE FLOW OF CONTROL
MACRO WIPEOUT(NUMB)=
BEGIN
HEAD[SRCID]_CONTID;
IF .NUMB LSS 0 THEN
BEGIN
PB_.HEAD[SRCLINK];
HEAD[SRCLINK]_.HEAD[LIFSTATE];
PA_.HEAD[LIFSTATE];
PA[SRCLINK]_.PB;
END;
END$;
ROUTINE ASGNPROP(HEAD)=
BEGIN
!PROPAGATE STUFF FOR AN ASIGNMENT STATEMENT
MAP PHAZ2 HEAD;
LOCAL PHAZ2 PA;
!THIS REGISTER IS TO PREVENT BLISS GENERATION OF
!EXCESSIVE LOCALS
REGISTER TMP;
!LOOK AT THE LEFT HAND SIDE FIRST.
!IF IT IS NOT A LEAF TRY TO PROPAGATE WITH IN THE
!EXPRESSION.
IF NOT .HEAD[A1VALFLG] THEN
BEGIN
PA_.HEAD[LHEXP];
!AN ARRAY REF IS ALL THAT IS LEGEL
!SO WE WILL LOOK ONLY AT ARG2.
!IF IT IS NOT A LEAF PROPAGATE AND REDUCE
IF NOT .PA[A2VALFLG] THEN
BEGIN
TMP_LOKDEFPT(.PA[ARG2PTR]);
PA[ARG2PTR]_.TMP;
END;
!IT HAS NOT BECOME A LEAF, THEREFOR IT
!HAS NOT PROPAGATED, SO TRY A REDUCTION.
IF NOT .PA[A2VALFLG] THEN
BEGIN
TMP_REDUCE(.PA[ARG2PTR]);
PA[ARG2PTR]_.TMP;
END;
END;
!DONE WITH LEFT HAND SIDE. NOW LOOK AT RIGHT HAND SIDE.
!IF IT IS NOT A LEAF TRY PROPAGATION.
IF NOT .HEAD[A2VALFLG] THEN
BEGIN
TMP_LOKDEFPT(.HEAD[RHEXP]);
HEAD[RHEXP]_.TMP;
!IT MAY NOW HAVE BECOME A LEAF. MAKE SURE
!THAT THE NEG ANF NOT FLGS ARE PICKED UP.
IF .HEAD[A2VALFLG] THEN
BEGIN
PA_.HEAD[RHEXP];
IF .PA[OPR1] EQL CONSTFL THEN
ASGNNN(.HEAD);
END;
END ELSE
!IT WAS A LEAF TO BEGIN WITH. PROPAGATE.
STMTPROP(.HEAD);
END;
GLOBAL ROUTINE PROPAGATE=
!THIS IS THE CONTROLLING ROUTINE FOR CONSTANT PROPAGATION
!AND REDUCTION IN STRENGTH
BEGIN
EXTERNAL DFCLEANUP;
EXTERNAL IOGPNR; !WALK I/O LISTS <IOPT>
EXTERNAL BASE LENTRY;
EXTERNAL CHOSEN,GLOBREG,CSTMNT,FOLDAIF,ISN,LOOP,RDUCINIT;
LABEL SELCT;
LOCAL HEAD,PA,PB,PC;
MAP PHAZ2 HEAD:TOP:PC:PA:PB;
MAP BASE CSTMNT;
!THIS REGISTER TO PREVENT BLISS FROM GENERATING EXCESSIVE TEMPS
REGISTER TMP;
!GO THROUGH BUSY LIST TRYING TO PROPAGATE CONSTANTS
!INITIALIZE SPECIAL REDUCTION VARIABLES
RDUCINIT();
HEAD_.TOP;
IF .HEAD[SRCID] EQL DOID THEN
HEAD_.HEAD[BUSY];
DO
BEGIN
CSTMNT_.HEAD;
ISN_.CSTMNT[SRCISN];
SELCT:
SELECT .HEAD[SRCID] OF NSET
ASGNID:
BEGIN
ASGNPROP(.HEAD);
END;
IFLID: BEGIN
!LOOK AT THE EXPRESION. IF ITS A LEAF CALL THE
!STATEMENT PROPAGATION ROUTINE ELSE
!DO THE REGULAR EXPRESSION PROPRAGATION.
PA_.HEAD[LIFEXPR];
IF .PA[OPRCLS] EQL DATAOPR THEN
STMTPROP(.HEAD)
ELSE
BEGIN
TMP_LOKDEFPT(.HEAD[LIFEXPR]);
HEAD[LIFEXPR]_.TMP;
END;
!IF THE EXPRESSION HAS BECOME A CONSTANT
!THEN GET RID OF THE STATEMENT
PA_.HEAD[LIFEXPR];
IF .PA[OPR1] EQL CONSTFL THEN
BEGIN
!MAKE SURE THAT ANY NEG NOT FLAGS ON THE
!STATEMENT HAVE BEEN INCLUDED
IFNN(.HEAD);
![1074] Must reset PA since IFNN may have created a new node with a new type
%[1074]% PA_.HEAD[LIFEXPR];
IF .PA[VALTP1] EQL INTEG1 THEN
WIPEOUT(PA[CONST2])
ELSE
WIPEOUT(PA[CONST1]);
END;
END;
IFAID: BEGIN
!EXAMINE THE EXPRESSION.
PA_.HEAD[AIFEXPR];
IF .PA[OPRCLS] EQL DATAOPR THEN
STMTPROP(.HEAD)
ELSE
BEGIN
!ITS NOT A LEAF, TRY PROPAGATION.
TMP_LOKDEFPT(.HEAD[AIFEXPR]);
HEAD[AIFEXPR]_.TMP;
!LOOK AGAIN TO SEE WHAT THE EXPRESSION HAS BECOMEME
END;
!IF IT REDUCED TO A CONSTANT, FOLD THE
!STATEMENT, CUZ THE CONSTANT WILL NOT BE ALLOCATED
PA_.HEAD[AIFEXPR];
IF .PA[OPR1] EQL CONSTFL THEN
BEGIN
!FIRST MAKE SURE THAT ANY NEG/NOT FLAGS ON THE STATEMENT
!HAVE BEEN PICKED UP.
IFNN(.HEAD);
CSTMNT_.HEAD;
FOLDAIF();
END;
END;
DOID:
BEGIN
!THIS IS AN INNER DO LOOP. LOOK AT THE
!CONTROL EXPRESSION
DOPROPAGATE(.HEAD);
PA_.HEAD[DOLPCTL];
!IT MAY ALREADY BE A CONSTANT IN WHICH
!CASE WE WANT TO QUIT WHILE AHEAD
IF .PA[OPR1] EQL CONSTFL THEN LEAVE SELCT;
HEAD[DOLPCTL]_LOKDEFPT(.HEAD[DOLPCTL]);
PA_.HEAD[DOLPCTL];
IF NOT .HEAD[FLCWD] AND .PA[OPR1] EQL CONSTFL THEN
STMTPROP(.HEAD);
END;
CALLID:
BEGIN
!ZERO OPTIMIZERS INFO IN EXPRESSIONS ON LIST.
!ALSO PROPAGATE CONSTANTS TO EXPRESSIONS ONLY.
!PROPAGATING CONSTANTS TO VARIABLES IS PRECLUDED
!BY THE FACT THAT THERE ARE NO DEFINITION POINTS FOR
!SINGLE VARIABLES ON ARGUMENT LISTS.
IF .HEAD[CALLIST] NEQ 0 THEN
BEGIN
LOCAL ARGUMENTLIST AG;
LOCAL BASE T1;
AG_.HEAD[CALLIST];
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
T1_.AG[.I,ARGNPTR];
IF .T1[OPRCLS] NEQ DATAOPR THEN
AG[.I,ARGNPTR]_LOKDEFPT(.T1);
END;
END;
END;
READID: IOGPNR(.HEAD);
WRITID: IOGPNR(.HEAD);
DECOID: IOGPNR(.HEAD);
ENCOID: IOGPNR(.HEAD);
REREDID: IOGPNR(.HEAD);
TESN;
HEAD_.HEAD[BUSY];
END UNTIL .HEAD EQL 0;
!NOW GO THROUGH ALL THE STATEMENTS CREATED BY THE OPTIMIZER
!THESE ARE NOT IN THE GRAPH
HEAD_.TOP[SRCLINK];
WHILE .HEAD NEQ .BOTTOM DO
BEGIN
!SKIP OVER STATEEMENTS IN INNER DO LOOPS
IF .HEAD[SRCID] EQL DOID THEN
BEGIN
HEAD_.HEAD[DOLBL];
!INDIRECT THROUGH THE SYMBOL TABEL TO GET ENDING STATEMENT
HEAD_.HEAD[SNHDR];
END ELSE
IF .HEAD[SRCOPT] EQL 0 THEN
IF .HEAD[SRCID] EQL ASGNID THEN
ASGNPROP(.HEAD);
HEAD_.HEAD[SRCLINK];
IF .HEAD EQL 0 THEN RETURN;
END;
!CLEAR DEFPT BITS FROM SYMBOL TABLE EXCEPT FOR .O
DFCLEANUP();
END;
ROUTINE DEFSUB(NITIONPT, !DEFINITION POINT
OLDARG)= !OLD ARGUMENT FOR RETURNING
BEGIN
!CHECK TO SEE IF THE DEFINITION POINT PASSED IS AN ASSIGNMENT OF
!OLDARG TO A CONSTANT. IF SO, RETURN CONSTANT ELSE
!RETURN OLDARG.
EXTERNAL DNEGCNST;
MAP BASE NITIONPT;
LOCAL INQUEST; MAP BASE INQUEST;
IF .NITIONPT[SRCID] EQL ASGNID THEN
IF .NITIONPT[LHEXP] EQL .OLDARG THEN
BEGIN
INQUEST_.NITIONPT[RHEXP];
IF .INQUEST[OPR1] EQL CONSTFL THEN
BEGIN
INQUEST_VALCNV(.INQUEST);
IF .NITIONPT[A2NEGFLG] THEN
BEGIN
INQUEST_NEGCNST(INQUEST);
NITIONPT[A2NEGFLG]_0;
END;
IF .NITIONPT[A2NOTFLG] THEN
BEGIN
INQUEST_NOTCNST(INQUEST);
NITIONPT[A2NOTFLG]_0;
END;
RETURN(.INQUEST);
END;
END;
.OLDARG
END;
ROUTINE IFNN(STMT)=
BEGIN
!STMT POINTS TO AN ARITHMETIC OR LOGICAL IF.
!LIFEXPR OR AIFEXPR HAVE BECOME CONSTANTS.
!CHECK THE NEG/NOT FLAGS AND FOLD THEM INTO THE CONSTANT.
MAP BASE STMT;
LOCAL BASE T1;
T1_.STMT[LIFEXPR];
IF .STMT[A1NEGFLG] THEN
BEGIN
STMT[LIFEXPR]_NEGCNST(T1);
STMT[A1NEGFLG]_0;
END;
IF .STMT[A1NOTFLG] THEN
BEGIN
STMT[LIFEXPR]_NOTCNST(T1);
STMT[A1NOTFLG]_0;
END;
END;
ROUTINE ASGNNN(STMT)=
BEGIN
!STMT IS AN ASIGNMENT STATEMENT.
!THE RIGHT HAND SIDE IS A CONSTANT. CHECK THE NEG/NOT FLAGS
!AND FOLD THEM INTO THE CONSTANT.
MAP BASE STMT;
LOCAL BASE T1;
T1_.STMT[RHEXP];
IF .STMT[A2NEGFLG] THEN
BEGIN
STMT[RHEXP]_NEGCNST(T1);
STMT[A2NEGFLG]_0;
END;
IF .STMT[A2NOTFLG] THEN
BEGIN
STMT[RHEXP]_NOTCNST(T1);
STMT[A2NOTFLG]_0;
END;
END;
ROUTINE STMTPROP(STMT)=
BEGIN
!HANDLES A SINGLE VARIABLE AS A STATEMENT EXPRESSION AND TRIES TO
!PROPAGATE IT IF POSSIBLE
EXTERNAL CSTMNT,FOLDAIF,DNEGCNST;
MAP PHAZ2 STMT;
SELECT .STMT[SRCID] OF NSET
ASGNID: BEGIN
LOCAL BASE PA:PB;
PA_.STMT[RHEXP];
IF .PA[OPR1] EQL VARFL THEN
BEGIN
IF .STMT[SRCOPT] EQL 0 THEN RETURN;
PB_.STMT[OPDEF];
IF .PB EQL 0 THEN RETURN;
STMT[RHEXP]_DEFSUB(.PB,.STMT[RHEXP]);
!CHECK FOR NEG AND NOT FLAGS IF IT PROPAGATED
PA_.STMT[RHEXP];
IF .PA[OPR1] NEQ CONSTFL THEN RETURN;
!HERE WE KNOW ITS A CONSTANT
!CATCH THOSE NASTY LITTLE NEG/NOT FLAGS.
ASGNNN(.STMT);
END;
!RESET VAL FLGS
PA_.STMT[RHEXP];
IF .PA[OPRCLS] EQL DATAOPR THEN STMT[A2VALFLG]_1;
END;
DOID: BEGIN
!NUMBER OF TIMES THROUGH A LOOP HAS BECOME A CONSTANT
!BUT THAT MAY NOT BE MEANINGFUL. ON INNER DO LOOPS
!THE FLAG NOFLCWDREG (SET BY P2S) SAYS THAT THIS
!LOOP SHOULD NOT BE AN AOBJN LOOP. THE FLAG WILL BE SET
!1. THE INDEX VARIABLE WAS AT A TOP LEVEL ARITHMETIC IF
!2. THE INDEX VARIABLE WAS AT A TOP LEVEL LOGICAL IF
!3. THE INDEX WAS AN ITEM ON AN I/O (BETTER B O) LIST
!4. THE INDEX WAS AT A TOP LEVEL COMPUTED GO TO
!5. THE INDEX WAS ON THE LHS OF AN ASSIGNMENT
LOCAL BASE PA:PB;
IF .STMT[INNERDOFLG] AND NOT .STMT[NOFLCWDREG] THEN
BEGIN
PA_.STMT[DOLPCTL];
IF .PA[VALTYPE] EQL INTEGER THEN
IF ABS(.PA[CONST2]) GEQ 0 AND ABS(.PA[CONST2]) LEQ #377777
AND .STMT[SSIZONE] THEN
BEGIN
PB_.STMT[DOM1]; !INITIAL VALUE
IF .PB[VALTYPE] EQL INTEGER AND .PB[OPR1] EQL CONSTFL THEN
IF .PB[CONST2] GEQ 0 AND .PB[CONST2] LEQ #377777 THEN
BEGIN
STMT[SSIZONE]_0;
STMT[FLCWD]_1;
STMT[DOLPCTL]_MAKECNST(INTEGER,0,
-(ABS(.PA[CONST2]))^18+.PB[CONST2]);
RETURN(1);
END;
END;
END;
RETURN(0);
END;
IFLID: BEGIN
LOCAL BASE PA:PB;
EXTERNAL FOLDLIF,CSTMNT;
PA_.STMT[OPDEF];
IF .PA EQL 0 THEN RETURN;
STMT[LIFEXPR]_DEFSUB(.PA,.STMT[LIFEXPR]);
PB_.STMT[LIFEXPR];
IF .PB[OPR1] NEQ CONSTFL THEN RETURN;
!FIRST CHECK FOR NOT FLG AND NEG FLG
IFNN(.STMT);
PB_.STMT[LIFEXPR];
PA_.STMT[LIFSTATE]; !SAVE FOR LATER
CSTMNT_.STMT;
FOLDLIF();
!THE OPTIMIZER WILL TRY TO BE CLEVEL
!LIFSTATE WILL BE EXAMINED. IF IT IS AN UNCONDITIONAL BRANCH
!WE WILL DELETE ALL DEAD CODE UP TO THE NEXT LABELED
!STATEMENT.
!A COMPUTED GO TO IS NOT CONSIDIERED AN UNCONDITIONAL
!BRANCH BECAUSE IT MAY GO TO THE NEXT STATEMENT IF THE
!VALUE OF THE VARIABLE IS OUT OF RANGE
!REMEMBER PA IS A POINTER TO THE STATEMENT IN QUESTION
IF .PA[SRCID] EQL GOTOID OR .PA[SRCID] EQL AGOID THEN
BEGIN
PB_.PA[SRCLINK];
WHILE .PB[SRCLBL] EQL 0 DO
BEGIN
PB_.PB[SRCLINK];
END;
PA[SRCLINK]_.PB;
END;
END;
IFAID: BEGIN
LOCAL BASE PA:PB;
PA_.STMT[OPDEF];
IF .PA EQL 0 THEN RETURN;
STMT[AIFEXPR]_DEFSUB(.PA,.STMT[AIFEXPR]);
PB_.STMT[AIFEXPR];
IF .PB[OPR1] NEQ CONSTFL THEN RETURN
!FIRST CHECK FOR NOT FLG AND NEG FLG
IFNN(.STMT);
CSTMNT_.STMT;
FOLDAIF();
END;
TESN;
END;
MAP PEXPRNODE INDVAR:LENTRY:LEND;
FORWARD PROPCASE;
ROUTINE BUNCHPROP(STMT)=
BEGIN
!STARTING AT STATEMENT STMT LEAFSUBSTITUTE
!ITEMS IN THE VECTORS (ITMCT SET UP
!PRIOR TO CALL) THEN USE THE PROPAGATION ROUTINES
!TO FOLD THE PROPAGTED CONSTANTS
EXTERNAL CSTMNT,ISN,SPECCASE,LOWLIM;
EXTERNAL FOLDLIF,FOLDAIF,LOKDEFPT;
MAP BASE STMT:CSTMNT;
SPECCASE_0;
LOWLIM_1;
WHILE .STMT NEQ 0 DO
BEGIN
CSTMNT_.STMT;
ISN_.CSTMNT[SRCISN];
PROPCASE(.STMT);
STMT_.STMT[SRCLINK];
END;
END;
ROUTINE PROPCASE(STMT)=
BEGIN
!CONROL FOR PROPAGATION AND FOLDING OF DOT O VARS
EXTERNAL LEAFSUBSTITUTE,IOSUBSTITUTE,DOVARSUBSTITUTE,
MISCIO,SWAPEM,FOLDLIF,FOLDAIF;
MAP BASE STMT;
REGISTER BASE T;
CASE .STMT[SRCID] OF SET
%ASSIGNMENT%
BEGIN
IF NOT .STMT[A1VALFLG] THEN
BEGIN
LEAFSUBSTITUTE(.STMT[LHEXP]);
STMT[LHEXP]_LOKDEFPT(.STMT[LHEXP]);
END;
LEAFSUBSTITUTE(.STMT[RHEXP]);
STMT[RHEXP]_LOKDEFPT(.STMT[RHEXP]);
%[1104]% T_.STMT[RHEXP];
%[1104]% IF .T[OPR1] EQL CONSTFL THEN
%[1104]% ASGNNN(.STMT) !CATCH NEG/NOT NASTIES
END;
%ASSIGN%
BEGIN END;
%CALL%
BEGIN
LOCAL BASE TMP;
LOCAL ARGUMENTLIST AG;
IF (AG_.STMT[CALLIST]) NEQ 0 THEN
BEGIN
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
TMP_.AG[.I,ARGNPTR];
IF .TMP[OPRCLS] EQL LABOP THEN
ELSE
IF .TMP[OPRCLS] EQL DATAOPR THEN
AG[.I,ARGNPTR]_SWAPEM(.TMP)
ELSE
LEAFSUBSTITUTE(.TMP);
END;
END;
END;
%CONTINUE%
BEGIN END;
%DO%
DOVARSUBSTITUTE(.STMT);
%ENTRY%
BEGIN END;
%COMNSUB%
BEGIN END;
%GO TO%
BEGIN END;
%ARITHMETIC GO TO%
BEGIN END;
%COMPUTED GO TO%
BEGIN END;
%ARITHMETIC IF%
BEGIN
LEAFSUBSTITUTE(.STMT[AIFEXPR]);
STMT[AIFEXPR]_LOKDEFPT(.STMT[AIFEXPR]);
T_.STMT[AIFEXPR];
IF .T[OPR1] EQL CONSTFL THEN
BEGIN
IFNN(.STMT);
FOLDAIF();
END;
END;
%LOGICAL IF%
BEGIN
EXTERNAL CSTMNT;
LEAFSUBSTITUTE(.STMT[LIFEXPR]);
CSTMNT_.STMT[LIFSTATE];
PROPCASE(.CSTMNT);
CSTMNT_.STMT;
STMT[LIFEXPR]_LOKDEFPT(.STMT[LIFEXPR]);
T_.STMT[LIFEXPR];
IF .T[OPR1] EQL CONSTFL THEN
BEGIN
IFNN(.STMT);
FOLDLIF();
END;
END;
%RETURN%
IF .STMT[RETEXPR] NEQ 0 THEN LEAFSUBSTITUTE(.STMT[RETEXPR]);
%STOP%
BEGIN END;
%READ%
BEGIN
MISCIO(.STMT);
T_.STMT[IOLIST];
WHILE .T NEQ 0 DO
BEGIN
IOSUBSTITUTE(.T);
T_.T[CLINK];
END;
END;
%WRITE%
BEGIN
MISCIO(.STMT);
T_.STMT[IOLIST];
WHILE .T NEQ 0 DO
BEGIN
IOSUBSTITUTE(.T);
T_.T[CLINK];
END;
END;
%DECODE%
BEGIN
MISCIO(.STMT);
T_.STMT[IOLIST];
WHILE .T NEQ 0 DO
BEGIN
IOSUBSTITUTE(.T);
T_.T[CLINK];
END;
END;
%ENCODE%
BEGIN
MISCIO(.STMT);
T_.STMT[IOLIST];
WHILE .T NEQ 0 DO
BEGIN
IOSUBSTITUTE(.T);
T_.T[CLINK];
END;
END;
%REREAD%
BEGIN
MISCIO(.STMT);
T_.STMT[IOLIST];
WHILE .T NEQ 0 DO
BEGIN
IOSUBSTITUTE(.T);
T_.T[CLINK];
END;
END;
%FIND% BEGIN END;
%CLOSE% BEGIN END;
%INPUT% BEGIN END;
%OUTPUT% BEGIN END;
%BACKSPACE% BEGIN END;
%BACK FILE% BEGIN END;
%REWIND% BEGIN END;
%SKIP FILE% BEGIN END;
%SKIPRECORD% BEGIN END;
%UNLOAD% BEGIN END;
%RELEASE% BEGIN END;
%END FILE% BEGIN END;
%END% BEGIN END;
%PAUSE% BEGIN END;
%SFN% BEGIN END;
%OPEN% BEGIN END
TES;
END;
ROUTINE ELIGIBLE(LNODE,RNODE)=
BEGIN
!CHECK LNODE AND RNODE
!FOR THE FOLLOWING COMBINATIONS WE WISH TO
!"PROPAGATE":
! LNODE RNODE
! _____ _____
!
! .O NOT FROM .R ANY DATAOPR
! .S .O
! .I .O
MAP BASE LNODE:RNODE;
!QUIT QUICK IF WE ARE NOT EVEN DEALING WITH
!DATA ITEMS
IF .LNODE[OPRCLS] NEQ DATAOPR THEN RETURN;
IF .RNODE[OPRCLS] NEQ DATAOPR THEN RETURN;
!CHECK .O ON LEFT HAND SIDE
!CAN'T PROPAGATE .O IF IT CAME FROM A .R
IF .LNODE [IDDOTO] EQL SIXBIT ".O"
THEN
IF .LNODE [ORFIXFLG]
THEN RETURN 0
ELSE RETURN 1;
!CHECK .O ON RIGHT WITH OTHERS SPECIFICALLY ON LEFT
IF .RNODE[IDDOTO] EQL SIXBIT".O" THEN
IF .LNODE[IDDOTO] EQL SIXBIT".I"
OR
.LNODE[IDDOTO] EQL SIXBIT".S" THEN
RETURN 1;
0
END;
GLOBAL ROUTINE DOTOPROPAGATE=
BEGIN
!ROUTINE TO CAUSE .O VARIABLES TO PROPAGATE THROUGHOUT
!THE PROGRAM UNIT
EXTERNAL VERYFRST,GLOBREG,CHOSEN,PREV,ITMCT;
OWN GOTSUM,STMT,OLDSTMT,HEAD;
MAP BASE STMT:PREV;
!*!*!*!*!*!*!*!*!*!*START OF LOCAL ROUTINE!*!*!*!*!*!*!
ROUTINE RUBOUT(STSUB)=
BEGIN
!STSUB IS THE STATEMENT AT WHICH
!TO START THE SUBSTITUTION SHOULD WE
!HAVE TO
LABEL SETCHOSEN;
EXTERNAL SAVSPACE;
REGISTER BASE RHNOD:LHNOD;
RHNOD_.STMT[RHEXP];
LHNOD_.STMT[LHEXP];
!MAKE THE STATEMENT A CONTINUE
!IF RHNOD=LHNOD AND THERE ARE NO
!$%&#' NEG OR NOT FLAGS SET
IF .RHNOD EQL .LHNOD THEN
BEGIN
IF (.STMT[A1NGNTFLGS] EQL 0)
AND
(.STMT[A2NGNTFLGS] EQL 0)
THEN
STMT[SRCID]_CONTID;
END ELSE
!IS LEFT HAND .O AND
!RIGHT HAND CONSTANT
!ALSO CHECK THE %&$#" NEG/NOTS AGAIN
IF ELIGIBLE(.LHNOD,.RHNOD)
AND (.STMT[A1NGNTFLGS] EQL 0)
AND (.STMT[A2NGNTFLGS] EQL 0) THEN
BEGIN
!DO NOT ALLOCATE THE .O VARIABLE
!AND REMOVE THE ASSIGNMENT FROM THE
!LOOP
LHNOD[IDATTRIBUT(NOALLOC)]_1;
![661] IF THE STATEMENT IS LABELED, TRY TO MOVE THE LABEL TO THE
![661] NEXT STATEMENT; OTHERWISE MAKE IT A CONTINUE.
%[661]% IF .STMT[SRCLBL] NEQ 0 THEN
%[661]% BEGIN !TRY TO REMOVE THE LABEL
%[661]% LOCAL BASE NXTSTMT;
%[661]% NXTSTMT_.STMT[SRCLINK];
%[661]% IF .NXTSTMT[SRCLBL] NEQ 0 THEN !BOTH LABELED
%[661]% STMT[SRCID]_CONTID !NO LUCK, JUST MAKE CONTINUE NODE
%[661]% ELSE (NXTSTMT[SRCLBL]_.STMT[SRCLBL];
%[661]% STMT[SRCLBL]_0)
%[661]% END;
%[661]%
%[661]% IF .STMT[SRCLBL] EQL 0 THEN !RECLAIM SPACE AND RELINK
%[661]% BEGIN
%[661]% PREV[SRCLINK]_.STMT[SRCLINK];
%[661]%
%[661]% !GIVE BACK THE SPACE FOR THE ASSIGNMENT
%[661]% SAVSPACE(ASGNSIZ+SRCSIZ-1,.STMT);
%[661]% STMT_.PREV
%[661]% END;
!QUEUE THE INFO IN THE SUBSTITUTION
!VECTORS
GLOBREG[.HEAD]_.LHNOD;
SETCHOSEN:
BEGIN
INCR I FROM 1 TO .HEAD DO
BEGIN
IF .GLOBREG[.I] EQL
.RHNOD THEN
BEGIN
CHOSEN[.HEAD]_.CHOSEN[.I];
LEAVE SETCHOSEN
END
END;
CHOSEN[.HEAD]_.RHNOD
END;
!IF THE QUEUE IS FULL PROCESS IT
IF .HEAD EQL 15 THEN
BEGIN
GOTSUM_1;
ITMCT_15;
OLDSTMT_.STMT;
BUNCHPROP(.STSUB);
HEAD_1;
END ELSE
HEAD_.HEAD+1;
END; !LINKING AND QUING
END;
!*!*!*!*!*!*!*!*!*!END OF LOCAL ROUTINE!*!*!*!*!
!FIRST CHECK TO BE SURE THERE WERE ANY .O VARIABLES AT ALL
IF .VERYFRST EQL 0 THEN RETURN;
DOTOHFLG_1;
!SET UP ITERATION CONTROL
GOTSUM_1;
WHILE .GOTSUM DO
BEGIN
%[775]% OLDSTMT_0; ! Reset pointer for each pass
GOTSUM_0;
HEAD_1;
PREV_STMT_.SORCPTR<LEFT>;
!FOR ALL STATEMENTS
WHILE .STMT NEQ 0 DO
BEGIN
!IS IT AN ASSIGNMENT
IF .STMT[OPRS] EQL ASGNOS
THEN
BEGIN
RUBOUT(IF .OLDSTMT EQL 0
THEN .SORCPTR<LEFT>
ELSE .OLDSTMT
);
END
ELSE
%1447% BEGIN !Its an assignment
!CHECK FOR AN I/O AND WALK THE I/O LIST
%1447% IF .STMT[OPRS] GEQ READOS THEN
%1447% IF .STMT[OPRS] LEQ REREDOS THEN
%1447% IF .STMT[IOLIST] NEQ 0
%1447% THEN
BEGIN
LOCAL OPREV,OOLD,OSTMT;
!SAVE CONTROLLING POINTERS
OPREV_.PREV;
OSTMT_.STMT;
!NEED TO SAVE THIS CUZ WE CANNOT
!COPE WITH REMAINDERS THAT COULD
!POTENTIALLY START IN THE MIDDLE OF
!AN I/O LIST
OOLD_.OLDSTMT;
!SET UP POINTERS ON I/O LIST
PREV_.STMT[IOLIST];
STMT_.PREV[CLINK];
!EXAMINE I/O LIST
WHILE .STMT NEQ 0 DO
BEGIN
IF .STMT[OPRS] EQL ASGNOS THEN
RUBOUT(
IF .OOLD EQL 0 THEN
.SORCPTR<LEFT> ELSE
.OOLD);
PREV_.STMT;
STMT_.STMT[SRCLINK];
END;
!RESTORE OLD POINTERS
PREV_.OPREV;
STMT_.OSTMT;
OLDSTMT_.OOLD;
END;
%1447% END; !Its an assignment
PREV_.STMT;
STMT_.STMT[SRCLINK];
END; !WHILE ON STMT
!ARE THERE SOME LEFT IN THE QUEUE ALTHOUGH WE HAVE LOOKED
!AT THE WHOLE PROGRAM
IF .HEAD NEQ 1 THEN
BEGIN
!MAKE SURE WE GO AROUND AGAIN TO
!.OX=.OX IF NOTHING ELSE
GOTSUM_1;
ITMCT_.HEAD-1;
BUNCHPROP(IF .OLDSTMT EQL 0 THEN .SORCPTR<LEFT> ELSE .OLDSTMT);
END;
END; !WHILE ON GOTSUM
DOTOHFLG_0;
END; !DOTOPROPAGATE
END
ELUDOM