Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
pnropt.bli
There are 12 other files named pnropt.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1986
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
!AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
!AUTHOR: NORMA ABEL/HPW/MD/SJW/JNG/DCE/TFV/EGM/SRM/CDM/RVM/TJK/MEM
MODULE PNROPT(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND PNROPV = #11^24 + 0^18 + #4527; ! Version Date: 1-Jan-86
%(
***** 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 V7 Development *****
1742 TFV 14-Apr-83
Fix calls to MISCIO. It handles the IOLIST now.
2001 TJK 22-Sep-83
Fix STMTPROP to correctly construct AOBJN DO-loop control word,
and only when possible.
2031 TJK 6-Jan-84
LOKDEFPT had a bad case for array references. Specifically,
it never called CONS2DEF after a recursive call to itself.
Among other things, this allowed constants with neg flags to
go uncorrected, resulting in bad code.
***** Begin Version 10 *****
2211 TFV 18-Aug-83
Add INQUIRE case to PROPCASE.
2215 TJK 26-Sep-83
Have STMTPROP check for zero-trip (or one-trip for F66)
loops, and have it clear MAYBEZTRIP if not zero-trip.
2217 TJK 28-Sep-83
Have STMTPROP check to see if CTLNEG is set (for DO-loops),
and if so ICE the compiler.
2223 TJK 30-Sep-83
Have STMTPROP check to see if CTLNEG is set (for DO-loops),
and if so have it clear CTLNEG and negate the DO-loop
control expression (which is a constant), instead of
generating an ICE. Also have if defer creating any new
constants until the end of the select case for a DO-loop.
Also remove external decalaration of CGERR.
2374 TJK 15-Jun-84
Allow PNROPT to handle character data. Also fix several bugs.
2507 CDM 20-Dec-84
Remove IDDOT, which is now in FIRST.
***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****
4502 MEM 22-Jan-85
Modified PROPCASE for DELETE statement.
4503 MEM 22-Jan-85
Modified PROPCASE for REWRITE statement.
4504 MEM 22-Jan-85
Modified PROPCASE for UNLOCK statement.
4517 MEM 4-Oct-85
Modify ASGNPROP so it doesn't break when it sees a charfn on lhs
instead of a dataopr or arrayref.
4523 MEM 6-Nov-85
Add propagation of 1-char constants. Remove edit 4517.
When comparing a variable with the location being assigned into in
an asmnt, we must compare it to the arg under the CHAR node in a 1-char
asmnt instead of to the LHEXP of the asmnt. When checking if a variable
is on the left side of the asmnt we must check if either A1VALFLG is
set in the asmnt node or if we have a 1-char asmnt and the A1VALFLG is
set in the CHAR node.
4527 CDM 1-Jan-86
VMS Long symbols phase II. Convert all internal symbols from
one word of Sixbit to [length,,pointer]. The lengths will be one
(word) until a later edit, which will store and use long symbols.
ENDV11
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
FORWARD
SETPNOT(2),
SETPNEG(2),
FOLDER(1),
CHKPROP,
GRASPDEF(2),
GRABDEF(1),
DOPROPAGATE(1),
VALCNV(2),
FIX1NN(2),
CONS1DEF(1),
FIX2NN(2),
CONS2DEF(1),
LOKDEFPT(1),
ASGNPROP(1),
PROPAGATE,
DEFSUB(2),
IFNN(1),
ASGNNN(1),
STMTPROP(1),
BUNCHPROP(1),
PROPCASE(1),
ELIGIBLE(2),
DOTOPROPAGATE;
EXTERNAL
%1742% CSTMNT,
%1742% DOVARSUBSTITUTE,
%1742% FOLDAIF,
%1742% FOLDLIF,
%1742% LEAFSUBSTITUTE,
%1742% MISCIO,
%1742% MISCOCI,
%1742% SWAPEM;
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;
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;
%2374% LOCAL BASE TMP;
%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;
%2374% !SUBSTRING
%2374% RETURN .EXPR;
%2374% !CONCATENATION
%2374% RETURN .EXPR;
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
%2374% IF .OPEXPR NEQ .EXPR
%2374% THEN
%2374% BEGIN ! It changed
%2374%
%2374% ! Check to see that fold was indeed to a DATAOPR. For
%2374% ! example, X .AND. .TRUE. folds to X, and setting the
%2374% ! val flag might be incorrect.
%2374%
%2374% IF (T = .OPEXPR[PARENT]) NEQ 0 ! Make sure there's a parent
%2374% THEN IF .T[OPRCLS] NEQ FNCALL
%2374% THEN IF .T[OPRCLS] NEQ CONCATENATION
%2374% THEN IF .EXPR[OPRCLS] EQL DATAOPR
%2374% THEN
%2374% BEGIN ! EXPR is a DATAOPR
%2374%
%2374% SETPVAL(.OPEXPR); ! Set val flags above
%2374%
%2374% ! Determine new definition point
%2374%
%2374% TMP = (IF .EXPR[OPERSP] EQL CONSTANT
%2374% THEN .LENTRY ELSE .DEFKEEPER);
%2374%
%2374% IF .T[OPRCLS] EQL STATEMENT
%2374% THEN
%2374% BEGIN ! Parent is a statement
%2374%
%2374% IF .T[SRCOPT] NEQ 0
%2374% THEN IF .T[SRCID] NEQ DOID
%2374% THEN T[OPDEF] = .TMP;
%2374%
%2374% END ! Parent is a statement
%2374%
%2374% ELSE IF .T[OPRCLS] NEQ IOLSCLS
%2374% THEN
%2374% BEGIN ! Parent is an expression
%2374%
%2374% IF .T[ARG1PTR] EQL .OPEXPR
%2374% THEN T[DEFPT1] = .TMP
%2374%
%2374% ELSE IF .T[ARG2PTR] EQL .OPEXPR
%2374% THEN T[DEFPT2] = .TMP
%2374%
%2374% ELSE IF .T[OPRCLS] EQL SUBSTRING
%2374% THEN IF .T[ARG4PTR] EQL .OPEXPR
%2374% THEN T[DEFPTSS] = .TMP;
%2374%
%2374% END; ! Parent is an expression
%2374%
%2374% END; ! EXPR is a DATAOPR
%2374%
%2374% END; ! It changed
%2374%
%2374% RETURN .EXPR;
END; ! of FOLDER
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,
%4527% BASE A1NODE;
MAP PHAZ2 OLDHEAD;
REGISTER BASE T;
!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;
%2374% RETURN 0;
END; ! of CHKPROP
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;
%2374% IF CHKPROP()
%2374% THEN
%2374% BEGIN ! Replacing with a constant
%2374%
%2374% IF .A2FLG
%2374% THEN
%2374% BEGIN ! Replacing ARG2
%2374%
%2374% EXPR[ARG2PTR] = .A1NODE;
%2374% FIX2NN(.EXPR,.A1NODE); ! Fold neg/not flags
%2374%
%2374% END ! Replacing ARG2
%2374% ELSE
%2374% BEGIN ! Replacing ARG1
%2374%
%2374% EXPR[ARG1PTR] = .A1NODE;
%2374% FIX1NN(.EXPR,.A1NODE); ! Fold neg/not flags
%2374%
%2374% END; ! Replacing ARG1
%2374%
%2374% END; ! Replacing with a constant
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;
%2374% !SUBSTRING
%2374% BEGIN
%2374% SNATCH1;
%2374% SNATCH2;
%2374% ! Punt on ARG4 for now
%2374% END;
%2374% !CONCATENATION
%2374% BEGIN END; ! Punt for now
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];
%2374% IF CHKPROP()
%2374% THEN
%2374% BEGIN ! Found it
%2374%
%2374% P[RHEXP] = .A1NODE; ! Substitute
%2374% ASGNNN(.P); ! Fix neg/nots
%2374%
%2374% END; ! Found it
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);
%4523% PB = .PA[LHEXP];
%4523% IF .PA[SRCID] EQL ASGNID
%4523% THEN IF .PB EQL .PC
%4523% OR (.PB[OPR1] EQL CHARFNFL AND .PB[ARG1PTR] EQL .PC)
%4523% 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;
%2374% ! Remove some dead code, and add an explicit zero return.
%2374%
%2374% RETURN 0;
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);
%4523% PB = .PA[LHEXP];
%4523% IF .PA[SRCID] EQL ASGNID
%4523% THEN IF .PB EQL .PC
%4523% OR (.PB[OPR1] EQL CHARFNFL AND .PB[ARG1PTR] EQL .PC)
%4523% 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;
%2374% ! Remove some dead code, and add an explicit zero return.
%2374%
%2374% RETURN 0;
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
%2374% IF .EXPR[VALTYPE] NEQ CHARACTER
%2374% THEN 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
%2374% DEFKEEPER = .LENTRY;
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 BASE TMP1;
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;
INCR I FROM 1 TO .AG[ARGCOUNT] DO
BEGIN
TMP1_.AG[.I,ARGNPTR]; !LOOK AT ARG
IF .TMP1[OPRCLS] NEQ DATAOPR
%2374% THEN
%2374% BEGIN ! Not a DATAOPR
%2374%
%2374% AG[.I,ARGNPTR] = TMP1 = LOKDEFPT(.TMP1);
%2374% IF .TMP1[OPRCLS] EQL DATAOPR
%2374% THEN AG[.I,AVALFLG] = 1;
%2374%
%2374% END; ! Not a DATAOPR
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
%2031% IF NOT .EXPR[A2VALFLG]
%2374% THEN IF .EXPR[ARG2PTR] NEQ 0 ! Be paranoid
%2031% THEN EXPR[ARG2PTR] = LOKDEFPT(.EXPR[ARG2PTR]);
%2031%
%2031% ! A2VALFLG may be set by LOKDEFPT, so check again
%2031%
%2031% IF .EXPR[A2VALFLG]
%2031% THEN IF .EXPR[ARG2PTR] NEQ 0
%2031% THEN WHATSUP = CONS2DEF(.EXPR);
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]
%4523% THEN IF .EXPR[OPERATOR] NEQ CHARIFNOP !INTEGER CHAR FN = RHS OF 1-CHAR ASMNT
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;
%2374% !SUBSTRING
%2374% BEGIN
%2374% ! Don't bother with WHATSUP and FOLDER for now. Note
%2374% ! that if we decide to do this, DEFKEEPER will have to
%2374% ! be set up correctly for substrings. However, we
%2374% ! will still create .Dnnnn substring descriptors, so
%2374% ! this is currently a win.
%2374%
%2374% IF NOT .EXPR[A1VALFLG]
%2374% THEN EXPR[ARG1PTR] = LOKDEFPT(.EXPR[ARG1PTR]);
%2374%
%2374% IF .EXPR[A1VALFLG] ! Note that it may be set by LOKDEFPT
%2374% THEN CONS1DEF(.EXPR);
%2374%
%2374% IF NOT .EXPR[A2VALFLG]
%2374% THEN EXPR[ARG2PTR] = LOKDEFPT(.EXPR[ARG2PTR]);
%2374%
%2374% IF .EXPR[A2VALFLG] ! Note that it may be set by LOKDEFPT
%2374% THEN CONS2DEF(.EXPR);
%2374%
%2374% EXPR[ARG4PTR] = LOKDEFPT(.EXPR[ARG4PTR]);
%2374%
%2374% RETURN .EXPR; ! All done
%2374% END;
%2374% !CONCATENATION
%2374% BEGIN
%2374% LOCAL BASE TMP;
%2374% LOCAL ARGUMENTLIST AG;
%2374% AG = .EXPR[ARG2PTR];
%2374%
%2374% INCR I FROM 2 TO .AG[ARGCOUNT] ! Skip first argument
%2374% DO
%2374% BEGIN ! For each argument
%2374%
%2374% AG[.I,ARGNPTR] = TMP = LOKDEFPT(.AG[.I,ARGNPTR]);
%2374% IF .TMP[OPRCLS] EQL DATAOPR
%2374% THEN AG[.I,AVALFLG] = 1;
%2374%
%2374% END; ! For each argument
%2374%
%2374% RETURN .EXPR; ! All done
%2374% 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; ! Never here
!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;
%2374% !SUBSTRING
%2374% BEGIN END; ! Never here
%2374% !CONCATENATION
%2374% BEGIN END; ! Never here
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.
%4523% PA=.HEAD[LHEXP];
IF NOT .HEAD[A1VALFLG]
%4523% OR (.PA[OPR1] EQL CHARFNFL AND NOT .PA[A1VALFLG])
%4523% THEN
BEGIN
%4523% IF .PA[OPR1] EQL CHARFNFL
%4523% THEN
%4523% BEGIN
%4523% PA[ARG1PTR]=LOKDEFPT(.PA[ARG1PTR]);
%4523% PA=.PA[ARG1PTR];!Get arrayref/substring under CHAR node
%4523% END
!AN ARRAY REF IS ALL THAT IS LEGAL
!SO WE WILL LOOK ONLY AT ARG2.
!IF IT IS NOT A LEAF PROPAGATE AND REDUCE
%4523% ELSE 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;
%4523% REGISTER BASE LHS;
IF .NITIONPT[SRCID] EQL ASGNID
THEN
%4523% BEGIN
%4523% LHS = .NITIONPT[LHEXP];
%4523% IF .LHS EQL .OLDARG
%4523% OR (.LHS[OPR1] EQL CHARFNFL AND .LHS[ARG1PTR] EQL .OLDARG)
%4523% THEN
BEGIN
INQUEST_.NITIONPT[RHEXP];
IF .INQUEST[OPR1] EQL CONSTFL THEN
BEGIN
%2374% INQUEST = VALCNV(.NITIONPT[LHEXP],.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;
%4523% 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
%2223% LOCAL BASE OLDCTL:INITIAL, CTLVAL;
%2223%
%2223% STMT[MAYBEZTRIP] = 0; ! Assume not ztrip, then set if ztrip
%2223% OLDCTL = .STMT[DOLPCTL]; ! .OLDCTL points to an INTCONST node
%2223%
%2223% ! Set CTLVAL to the control expression value, and also
%2223% ! absorb CTLNEG and leave it cleared.
%2223%
%2223% IF .STMT[CTLNEG] ! Check CTLNEG
%2223% THEN
%2223% BEGIN
%2223% STMT[CTLNEG] = 0; ! Clear CTLNEG
%2223% CTLVAL = -.OLDCTL[CONST2]; ! Use negated value
%2223% END
%2223% ELSE CTLVAL = .OLDCTL[CONST2];
%2223%
%2223% ! Now .CTLVAL is the negative iteration count
%2223% ! See if the loop is zero-trip (one for F66)
%2223%
%2223% IF .CTLVAL GEQ 0 ! Make it zero-trip (one-trip for F66)
%2223% THEN
%2223% BEGIN
%2223% IF F77 ! Zero-trip loops allowed?
%2223% THEN
%2223% BEGIN
%2223% CTLVAL = 0; ! Zero-trip
%2223% STMT[MAYBEZTRIP] = 1; ! Set flag
%2223% END
%2223% ELSE CTLVAL = -1; ! One-trip
%2223% END;
%2223%
%2223% ! Now see if we can convert this loop to an AOBJN loop
%2223%
%2223% IF .STMT[INNERDOFLG] AND NOT .STMT[NOFLCWDREG]
%2223% THEN IF .CTLVAL GEQ -#377777 AND .STMT[SSIZONE]
%2223% THEN
%2223% BEGIN
%2223% ! So far so good, now check the initial value
%2223%
%2223% INITIAL = .STMT[DOM1]; ! Initial value
%2223%
%2223% IF .INITIAL[OPERATOR] EQL INTCONST
%2223% THEN IF .INITIAL[CONST2] GEQ 0 AND .INITIAL[CONST2] LEQ #377777
%2223% THEN
%2223% BEGIN
%2223% ! The initial value is also OK, convert to AOBJN
%2223%
%2223% STMT[SSIZONE] = 0; ! Clear SSIZONE flag
%2223% STMT[FLCWD] = 1; ! Set AOBJN flag
%2223% CTLVAL = .CTLVAL^18+.INITIAL[CONST2]; ! AOBJN word
%2223% END;
%2223% END;
%2223%
%2223% ! See if the control value has changed, and if so create a
%2223% ! new constant for it.
%2223%
%2223% IF .OLDCTL[CONST2] NEQ .CTLVAL
%2223% THEN STMT[DOLPCTL] = MAKECNST(INTEGER,0,.CTLVAL);
%2223%
%2223% END; ! Of SELECT case DOID
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
!***************************************************************
! Propagation and folding of .Onnnn variables created by the
! optimizer.
!***************************************************************
%1742% ! Rewritten by TFV on 14-Apr-83
MAP BASE STMT;
REGISTER BASE T;
CASE .STMT[SRCID] OF SET
BEGIN ! ASSIGNMENT
IF NOT .STMT[A1VALFLG]
THEN
BEGIN
LEAFSUBSTITUTE(.STMT[LHEXP]);
STMT[LHEXP] = LOKDEFPT(.STMT[LHEXP]);
END;
LEAFSUBSTITUTE(.STMT[RHEXP]);
STMT[RHEXP] = LOKDEFPT(.STMT[RHEXP]);
T = .STMT[RHEXP];
IF .T[OPR1] EQL CONSTFL
THEN ASGNNN(.STMT); ! CATCH NEG/NOT NASTIES
END; ! ASSIGNMENT
BEGIN END; ! ASSIGN
BEGIN ! CALL
LOCAL BASE TMP;
LOCAL ARGUMENTLIST AG;
IF (AG = .STMT[CALLIST]) NEQ 0
THEN
BEGIN
DECR I FROM .AG[ARGCOUNT] TO 1 DO
BEGIN
TMP = .AG[.I,ARGNPTR];
IF .TMP[OPRCLS] NEQ LABOP
THEN IF .TMP[OPRCLS] EQL DATAOPR
THEN AG[.I,ARGNPTR] = SWAPEM(.TMP)
ELSE LEAFSUBSTITUTE(.TMP);
END;
END;
END; ! CALL
BEGIN END; ! CONTINUE
DOVARSUBSTITUTE(.STMT); ! DO
BEGIN END; ! ENTRY
BEGIN END; ! COMMONNSUB
BEGIN END; ! GOTO
BEGIN END; ! ASSIGNED GOTO
BEGIN END; ! COMPUTED GOTO
BEGIN ! ARITHMETIC IF
LEAFSUBSTITUTE(.STMT[AIFEXPR]);
STMT[AIFEXPR] = LOKDEFPT(.STMT[AIFEXPR]);
T = .STMT[AIFEXPR];
IF .T[OPR1] EQL CONSTFL
THEN
BEGIN
IFNN(.STMT);
FOLDAIF();
END;
END; ! ARITHMETIC IF
BEGIN ! LOGICAL IF
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; ! LOGICAL IF
IF .STMT[RETEXPR] NEQ 0 ! RETURN
THEN LEAFSUBSTITUTE(.STMT[RETEXPR]);
BEGIN END; ! STOP
%1742% MISCIO(.STMT); ! READ
%1742% MISCIO(.STMT); ! WRITE
%1742% MISCIO(.STMT); ! DECODE
%1742% MISCIO(.STMT); ! ENCODE
%1742% MISCIO(.STMT); ! REREAD
%1742% MISCIO(.STMT); ! FIND
%1742% MISCOCI(.STMT); ! CLOSE
%4502% MISCIO(.STMT); ! DELETE
%4503% MISCIO(.STMT); ! REWRITE
%1742% MISCIO(.STMT); ! BACKSPACE
%1742% MISCIO(.STMT); ! BACKFILE
%1742% MISCIO(.STMT); ! REWIND
%1742% MISCIO(.STMT); ! SKIP FILE
%1742% MISCIO(.STMT); ! SKIP RECORD
%1742% MISCIO(.STMT); ! UNLOAD
%4504% MISCIO(.STMT); ! UNLOCK
%1742% MISCIO(.STMT); ! ENDFILE
BEGIN END; ! END
BEGIN END; ! PAUSE
%1742% MISCOCI(.STMT); ! OPEN
BEGIN END; ! SFN
BEGIN END; ! FORMAT
BEGIN END; ! BLT
BEGIN END; ! REGMASK - change set of available registers -
! inserted by global register allocator
%2211% MISCOCI(.STMT); ! INQUIRE
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
! .I .O
!
%2374% ! The following combination is no longer allowed:
%2374% !
%2374% ! .S .O
%2374% !
%2374% ! This substitution is incorrect if the .O propagates to a
%2374% ! variable which is redefined within the body of a DO loop,
%2374% ! resulting in a different increment each time through the
%2374% ! loop. However, note that the following could probably be
%2374% ! allowed:
%2374% !
%2374% ! .I any CONSTANT
%2374% ! .S any CONSTANT
%2374% !
%2374% ! This isn't being done in this edit to avoid having to worry
%2374% ! about introducing new neg/not problems, etc. Maybe someday,
%2374% ! though.
%2374% !
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
%2374% IF .RNODE[OPERSP] NEQ CONSTANT
%2374% THEN IF .RNODE[IDDOTO] EQL SIXBIT ".O"
%2374% THEN IF .LNODE[IDDOTO] EQL SIXBIT ".I"
%2374% THEN RETURN 1;
%2374% RETURN 0;
END; ! of ELIGIBLE
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
%2374% BEGIN ! It's not 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;
%2374% END; ! It's not 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