Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
comsub.bli
There are 12 other files named comsub.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!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/DCE/SJW/TFV/MEM/TJK/CDM
MODULE COMSUB(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN
GLOBAL BIND COMSUV = #10^24 + 0^18 + #2507; ! Version Date: 21-Dec-84
%(
***** Begin Revision History *****
198 ----- ----- ADD INTERFACE TO I/O LIST OPTIMIZER
199 ----- ----- FIX MOVCNST TO SUBSUME
200 ----- ----- EXTEND XPUNGE TO COMPUTE PLACE FOR
EXPRESSIONS ON AN I/O LIST
201 ----- ----- CORRECTED TYPOS FROM 199
202 ----- ----- REMOVED BAD DOT IN DOTOHASGN
203 ----- ----- REMOVED BAD COMPARE FROM UNRYMATCH
MAKE PHI A PARAMETER TO CMNMAK
204 ----- ----- FIX MOVCNST TO DELETE HASH ENTRIES
MOVE EHASHP TO BEGINNING OF MODULE
205 ----- ----- INTERFACE TO IOGELM TO WALK I/O LISTS AND
DO GLOBAL SUBEXPRESSION ELIMINATION
206 ----- ----- MAKE DOTOHASGN AWARE OF I/O LISTS
MAKE GLOBELIM AWARE OF I/O LISTS
207 ----- ----- WRONG PARAMETER IN CALL TO DOTOHASGN IN MATCHER
208 ----- ----- REARRANGE INTERACTION OF GLOBLDEPD,CHKHAIR AND
MOVCNST
209 ----- ----- FIX SLINGHASH
210 ----- ----- FIX MOVCNST INPROVEMENT MADE IN 208
211 ----- ----- MORE TO COMPLETE 208 CORRECTLY
212 ----- ----- ADD AN ITERATION BETWEEN MOVCNST AND GLOBDEPD
213 ----- ----- ANOTHER FIX TO EDIT 208
214 ----- ----- ANOTHER ONE
216 ----- ----- REDEFINE CNSMOVFLG TO BE A BIT IN IMPLDO
217 ----- ----- FIX CHKDOMINANCE TO WORK CORRECTLY WITH
CNSMOVFLG
215 ----- ----- AGAIN
218 ----- ----- MAKE THE ROUTINES FOR GLOBAL CMN ONLY INTO
A SEPARATE MODULE
219 ----- ----- ADD THE VARIABLE OR EXPRESSION TO BE LINKED
TO THE LIST OF PARAMETERS FOR CMNLNK
220 ----- ----- FIX CALL TO DOTOHASGN SO IT IS ONLY CALLED ONCE
221 ----- ----- DONT USE IDADDR FIELD SO DATA OPTS CAN BE DONE
222 ----- ----- MAKE NEXTUP LOOK AT SKEWED TREES FOR ARITHMETICS
223 ----- ----- CALL IOGELM FOR READ/WRITE/ENCODE/DECODE
224 ----- ----- ADD REREDID TO IOGELM
225 ----- ----- FIX ELIM TO TEST GCALLSLFLG
226 ----- ----- REEXAMINE DEFPTS IF OPTIMIZING IN HASHIT
227 ----- ----- ADD ARRAY REFERENCE PROCESSING
228 ----- ----- FIX TYPOS IN 227
229 ----- ----- MORE OF 228
230 ----- ----- CORRECT NEWCOPY TO RETURN POINTER TO NODE BUILT
231 ----- ----- ADD ROUTINE SCRUBARRAY AND MAKE CMNMAK GLOBAL
232 ----- ----- PUT ARRAY STUFF UNDER OPTIMIZER SWITCH.
DELETE ARRAY SPECIFIEC ROUTINES.
233 ---- ----- FIX ARRAY HASH KEY TO INCLUDE OFFSET
234 ----- ----- ADD ARRAYREF FUNCTION STUFF AND FIX
NARY2 TO PUT ARRAY STUFF BACK INTO NODES
235 ----- ----- MAKE CHKHAIR AND MAKETR AWARE OF TREE SHAPE
236 ----- ----- CMNMAK IS BLOWING ARRAY REPLACEMENT
237 ----- ----- MAKE NEXTUP LOOK UP AS WELL AS DOWN FOR
SKEWED EXPRESSIONS
238 ----- ----- MAKE MAKETRY TAKE BLKID FROM ENTRY OS ARRAYS
WILL MATCH
239 ----- ----- IN MATCHER BUILD NARY EXPRESSION WITH ARG1
AND ARG2 IN THE RIGHT PLACE
240 ----- ----- FIX MATCHER TO DEAL CORECTLY WITH
NEXTUP NARY2 INTERFACE
241 ----- ----- SET NOHHASSLE BIT IN CMNMAK
242 ----- ----- FIX RANDOM P IN DELETE (V1 BUG TOO)
243 ----- ----- FIX LINKING OUT OF NODE TO BE DELETED
IN ROUTINE DELETE
244 ----- ----- FIX HASHIT SO THAT A+B==-(A+B) IS
FOUND AS A COMMON SUB
245 ----- ----- LIKE ARRAYREF NODES TOGETHER WHEN MATCHED
AND RETRIEVE FROM LINKED LIST WHEN NEEDED.
PARENT FIELD IS LINK
246 ----- ----- IN UNRYMATCHER IN LOCL CASE WE WILL MISS
(MESS) BECAUSE T GET S CONFUSED
247 ----- ----- FIX NEGNOT FLAG BUG WITH SPECOPS
248 ----- ----- FIX MORE NEGNOT PROBLEMS WITH TYPCONV
AND NEGNOTS
249 ----- ----- NEGNOTS ON SKEWED TREES MESSED UP
250 ----- ----- PUNT!
251 ----- ----- CMNMAK SHOULD CALL PUTBACKARRAY TO PUT THE
ARRAREF BACK. ALL THE RIGHT LOGIC IS THERE.
252 ----- ----- THE RIGHT LOGIC MAY THERE IN EDIT 251 BUT
ITS FOR THE WRONG (POTENTIALLY) EXPRESSION.
253 ----- ----- LOK1SUBS CASE STATEMENT IS
MISSING ARRAYREF
254 ----- ----- UNARY MATCHER IS CALLING NEXTUP
IMPROPERLY FOR A LOCAL SPECIAL CASE
255 371 18471 FIX CSE FOR STRAIGHT NON-SKEWED CASE, (DCE)
256V VER5 ----- X OP .R -> .R OP X
FIND CSE'S CONTAINING ARRAYREFS IF OPTIMIZING
RETURN OMOVDCNS FOR LOK1/2SUBS TO GLOBDEPD
DON'T ELIM I/O STATEMENTS ON 2ND GLOBELIM, (SJW)
256 405 18967 FIX IOLISTS WITH STAR1 AND STAR2 SHAPES, (DCE)
257 427 18771 FIX IOLISTS WITH COMMON SUBS WHICH ARE
SHAPES GREATER THAN SKEW, (DCE)
258 442 19233 FIX DELETE SO IT DOESN'T LOSE SOME HASH
ELEMENTS OTHER THAN ONE BEING DELETED, (DCE)
259 450 QA784 DON'T NEXTUP AN ARRAYREF INSIDE AN IOLIST, (SJW)
260 456 QA784 PASS ENTIRE HASH ENTRY TO GLOBMOV IN CMNMAK
FOR FINDPA FOR FINDTHESPOT, (SJW)
***** Begin Version 5A ***** 7-Nov-76
261 520 21271 RELATIONAL COMMON SUBS CANNOT HAVE NEG FLAGS SET, (DCE)
262 524 QA876 PUT BACK ARRAY REF IN STPRECLUDE AFTER A MATCH
SO CAN NEXTUP THE EXPR CONTAINING THE ARRAY
REF AND NOT RUN INTO A HASH TABLE ENTRY
CALL STPRECLUDE BEFORE CMNMAK CHANGES NEG
FLAGS IN MATCHER, (SJW)
263 566 22701 SKEWED COMSUBS INVOLVING NOTFLAGS ARE NOT
HASHED UNIQUELY - USE THE CORRECT FLAGS!, (DCE)
264 602 22700 FIX SKEWED EXPRESSIONS IN IOLISTS WITH
CORRECT DEFINITION POINT CALCULATION, (DCE)
265 620 23720 D.P. ARRAY REF IN IO LIST CAUSES PROBLEMS, (DCE)
266 644 25390 IN LINE FUNCTIONS NEED TO BE MORE CAREFUL WITH
NEG FLAGS WHEN DOING CSE HASHING., (DCE)
267 701 22582 .R VARS TOO EAGERLY SWAPPED WHEN
OPERATION IS ** OR -, (DCE)
268 715 12743 NEG FLAG IN SKEWED TREE CAN SPELL BAD CODE., (DCE)
269 725 27403 WHEN WE NEXTUP, BE SURE THAT CSTMNT IS CORRECT., (DCE)
270 731 28246 PREVENT HASHING I/O EXPR WITH DEF PT ON STMNT., (DCE)
***** Begin Version 7 *****
271 1253 CKS 11-Aug-81
Don't make a common sub out of I in C(I) if C is type character. This
optimization is worthless for character arrays since the index ADJBP
clobbers the subscript expression.
272 1431 CKS 4-Dec-81
Add code for substring nodes to all CASEs on OPRCLS. Also add null
cases for concatenation OPRCLS.
1474 TFV 15-Mar-82
Add code for concatenation OPRCLS. REA walks down the argument
list looking at the arguments. It does nothing for the first
argument which is the descriptor for the result.
***** End V7 Development *****
2057 MEM 11-Jun-84
Add a parameter to LOKCALST so that concatenation argument
lists can be walked properly.
***** Begin Version 10 *****
2373 TJK 14-Jun-84
Make NEXTUP more paranoid about character expressions.
2507 CDM 21-Dec-84
Move IDDOTR to FIRST.
***** End V10 Development *****
***** End Revision History *****
)%
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
!****************************************************************
! Common sub expression elimination module. Local and global
! both included together with motion of constant expressions out
! of loops in the global case. The local control routine is
! locelim. The global control routine is globelim.
!
! Note:
! There are two ways used to distinguish between the local
! and global cases:
!
! 1. BACKST = 0 - global case
! BACKST # 0 - local case
! 2. FLGREG<OPTIMIZE> = 1 - global case
! FLGREG<OPTIMIZE> = 0 - local case
!
! Tests on these are made interchangably. The two ways
! are present for historic reasons.
!***************************************************************
FORWARD
CMNMAK(3),
STPRECLUDE(1),
NARY2(1),
NEXTUP(1),
UNRYMATCH(3),
CHK4OPS(1),
MATCHER(4),
CMNLNK(5),
CHKHAIR(3),
HASHIT(2),
XPUNGE(2),
ELIM(1),
LOCELIM(1),
REA(1),
REAIO(1),
LOCELMIO(1),
SLINGHASH,
TBLSRCH,
MAKETRY(3),
DELETE(2),
LOCLMOV(1),
ARGCMN(2),
LOK1SUBS(2),
LOK2SUBS(2),
DELLNK(1),
LOCLDEPD;
EXTERNAL
A1ARREF,
A2ARREF,
ARGCONE,
BACKST,
%725% BOTTOM,
CGERR,
CHKDOMINANCE,
CHKINIT,
CHOSEN,
%725% CORMAN,
%725% CSTMNT,
DOTOHASGN,
EHASH,
EHASHP,
FINDTHESPOT,
FNARRAY,
GETOPTEMP,
GLOBDEPD,
GLOBMOV,
GLOBREG,
IOCLEAR, ! Collapse i/o lists if gcallslflg is set
IOGELM, ! Walk i/o lists (iopt)
ITMCT,
LEND,
%725% PEXPRNODE LENTRY,
LOCLNK,
LOKCALST,
LOOP,
LOOPNO,
MAKEPR,
MAKPR1,
NAN,
NEWCOPY,
OLDHEAD,
PEXPRNODE PHI,
PREV,
PUTBACKARRAY,
%725% PEXPRNODE QQ,
REDEFPT,
REPLACARG,
SAVSPACE,
%731% SAVSTMNT,
SETNEG,
SKERR,
SPECCASE,
%725% TOP,
%725% PHAZ2 TPREV;
OWN
MOREFLG,
NEDCOR, ! Flag set by tblsrch to indicate if the hash
! table has a free reusable space or core is
! needed for the entry (i.e. = 1).
PEXPRNODE P,
PEXPRNODE P1,
PEXPRNODE P2,
PEXPRNODE PA,
PEXPRNODE PAE,
PEXPRNODE PB,
PEXPRNODE PC,
PEXPRNODE PO,
SAVCSTMNT,
STHASCMN, ! Used by local commonsub expressions to to save
! a scan of ehash if the statement was not even
! one that potentailly had a common
! sub-expression (like end)
T,
TALLY,
THISBLK,
TS, ! Temporary used through out
VARHOLDER; ! Used in special local cases see unrymatcher
GLOBAL ROUTINE CMNMAK(PAE,NAN,PHI)=
BEGIN
!****************************************************************
! Create a common sub-expression node pointing to the expression.
! A common sub-expression node has:
! OPRCLS - CMNSUB
! OPERSP - NULL
! A single argument (ARG2PTR) pointing to the expression
! (or single variable)
!****************************************************************
MAP
PEXPRNODE PAE,
PHAZ2 PHI;
! This routine is called in both the global and local cases.
! This is the point at which they diverge. A pointer to a
! cmnsub expression node is returned in the local case. A
! pointer to a .O temporary in the global case. In both cases
! phi[temper] is set correctly and returned.
! If doing an array reference pick up the pointer to the hash
! table and the arrayreference itself. This adjustment is made
! to the expression before any other processing here.
! If the flag nan (needs a negate) is set, complement/reset the
! negflags in the expression before it becomes the common
! subexpression.
IF .NAN THEN
BEGIN ! For an add complement the flags
IF .PAE[OPR1] EQL ADDOPF
THEN
BEGIN
PAE[A1NEGFLG] = NOT .PAE[A1NEGFLG];
PAE[A2NEGFLG] = NOT .PAE[A2NEGFLG];
END
ELSE IF (.PAE[OPRCLS] EQL ARITHMETIC) OR
(.PAE[OPRCLS] EQL SPECOP) OR
(.PAE[OPRCLS] EQL TYPECNV) OR
(.PAE[OPRCLS] EQL NEGNOT)
THEN
BEGIN ! Multiple, divide, exponentiate
PAE[A1NEGFLG] = 0;
PAE[A2NEGFLG] = 0;
END;
END; ! For an add complement the flags
IF NOT .FLGREG<OPTIMIZE>
THEN
BEGIN ! Local case
NAME<LEFT> = 4;
P = CORMAN();
P[OPRCLS] = CMNSUB;
P[ARG2PTR] = .PAE;
IF .PAE[VALTYPE] NEQ CONTROL
THEN P[VALTYPE] = .PAE[VALTYPE]
ELSE P[VALTYPE] = LOGICAL;
IF .PAE[OPRCLS] EQL DATAOPR THEN P[A2VALFLG] = 1;
PHI[TEMPER] = .P;
! Call routine that will add expression to linked list
LOCLMOV(.P);
END ! Local case
ELSE
BEGIN ! Global case
IF .ARREFCMNSBFLG
THEN
BEGIN
NOHHASSLE = 1;
! Take care of potential array references. We
! know the shape if this is the first expression
! but this does not relate (necessarily) to PAE
! so we will explicitly examine PAE to put the
! arrayref back.
! Is it the arrayref hash entry? Coincidence
! between HOP and OPRCLS makes this test
! possible.
IF (P = .PAE[ARG1PTR]) NEQ 0 THEN
IF .P[OPRCLS] EQL ARRAYREF
THEN PAE[ARG1PTR] = NEWCOPY(.P,.PAE);
! It could also be that PAE is a function ref
IF .PAE[OPRCLS] EQL FNCALL
THEN PUTBACKARRAY(.PHI,STGHT)
ELSE IF (P = .PAE[ARG2PTR]) NEQ 0 THEN
IF .P[OPRCLS] EQL ARRAYREF
THEN PAE[ARG2PTR] = NEWCOPY(.P,.PAE);
END;
P = PHI[TEMPER] = GETOPTEMP(IF .PAE[VALTYPE] EQL CONTROL
THEN LOGICAL
ELSE .PAE[VALTYPE]);
P[IDOPTIM] = .PAE;
! Call routine that creats and links in assignment
! statement. Pass GLOBMOV the entire hash entry so can
! do FINDPA for FINDTHESPOT
GLOBMOV (.PAE, .PHI, .P);
END; ! Global case
RETURN .PHI[TEMPER]
END; ! of CMNMAK
ROUTINE STPRECLUDE(CNODE)=
BEGIN
!***************************************************************
! Part of the count hassle. If a common sub expression has just
! been found that is part of an nary structure it may have to be
! deleted. For the global case it must be deleted to prevent it
! from appearing to be a constant computation. In the local
! case it may occur when an nary entry has been made while
! walking one tree and it is discovered while walking another
! tree, that the whole thing collapses upward as a common sub.
!***************************************************************
MAP
BASE QQ,
BASE TS,
BASE CNODE;
QQ = .CNODE[PARENT];
IF .QQ EQL 0 THEN SKERR(); ! Check for error
! Return if not nary
IF .QQ [OPR1] NEQ .CNODE [OPR1] THEN RETURN;
IF .QQ [A2VALFLG]
THEN
BEGIN ! It is nary so check for b op b op b
IF (.CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]) AND
(.CNODE[ARG2PTR] EQL .QQ[ARG2PTR])
THEN RETURN; ! Get the #$$$() out
HASHIT(.QQ,SKEW);
TS = TBLSRCH();
! If it is this one (judging by shape) and not a common
! sub in its own right already for other reasons then
! delete it
IF .FLAG THEN
IF .TS[TEMPER] EQL 0 AND .TS[NBRCH]
THEN DELETE(.TS,1);
END; ! It is nary so check for b op b op b
! If /OPT, must check if expression is a op b op arrayref. If
! it is, must drop USECNT of hash entry for arrayref by 1 so
! maybe the arrayref will be put back in place of the hash table
! entry
IF NOT .FLGREG<OPTIMIZE> THEN RETURN;
HASHIT(.QQ, SKEW);
TS = TBLSRCH();
IF .FLAG THEN
IF .TS [TEMPER] EQL 0 THEN
IF .TS [NBRCH]
THEN DELETE (.TS, 1);
END; ! of STPRECLUDE
ROUTINE NARY2(CNODE)=
BEGIN
!***************************************************************
! Routine called from matcher when a match on a skewed tree has
! been made. A skewed node is op a op b. We need to delete
! from the hash table used op anything op a and b op anything,
! at the same time being careful not to mess-up b op b op b op b
! op b.
!***************************************************************
OWN BSAMEFLG;
MAP
BASE TS,
PEXPRNODE CNODE;
ROUTINE BOPBOPB(SHAPE)=
BEGIN
! Local routine to save some code space. Hashes
! expression of shape SHAPE, looks it up in the table
! and deletes it. decrements use count by 1.
HASHIT(.QQ,.SHAPE); ! Set up hash key
TS = TBLSRCH(); ! Do table lookup
! If entry was in the table and it matches
! in shape with the one now considered, then
! decrease its use count by 1. See documentation
! for a detailed description of why, who, how.
IF .FLAG THEN
IF .TS[TEMPER] EQL 0 THEN
IF (.SHAPE EQL SKEW AND .TS[NBRCH]) OR
(.SHAPE EQL STGHT AND NOT .TS[NBRCH])
THEN DELETE(.TS,1);
END; ! of BOPBOPB
QQ = .CNODE[ARG1PTR];
! First decide if this is a op a. It is a problem, if it is
BSAMEFLG = 0;
IF .QQ[ARG2PTR] EQL .CNODE[ARG2PTR] THEN BSAMEFLG = 1;
IF .QQ[A1VALFLG] AND .QQ[A2VALFLG]
THEN
BEGIN
IF .BSAMEFLG AND .QQ[ARG1PTR] EQL .CNODE[ARG2PTR]
THEN ! We have b op b op b
ELSE BOPBOPB(STGHT);
END
ELSE
BEGIN ! Look down one more
QQ = .QQ[ARG1PTR];
IF .BSAMEFLG AND .QQ[ARG2PTR] EQL .CNODE[ARG2PTR]
THEN ! We have b op b op b
ELSE
BEGIN
! For the hash, which depends on QQ in this
! case, move QQ back up
QQ = .CNODE[ARG1PTR];
! Looking down may cause an array hash entry to
! appear if optimizing. We will have to special
! case it here
IF .FLGREG<OPTIMIZE>
THEN
BEGIN
HASHIT(.QQ,STGHT);
! Try hashing it straight and see if it
! is there with the array bits set
TS = TBLSRCH();
IF .FLAG THEN
IF .TS[A1ARY] OR .TS[A2ARY]
THEN DELETE(.TS,1);
END;
BOPBOPB(SKEW);
END;
END; ! Look down one more
QQ = .CNODE[PARENT];
IF .QQ[OPR1] EQL .CNODE[OPR1]
THEN
BEGIN
IF .BSAMEFLG AND .QQ[ARG2PTR] EQL .CNODE[ARG2PTR]
THEN ! Once again b op b op b
ELSE BOPBOPB(SKEW);
END;
END; ! of NARY2
ROUTINE NEXTUP(EXPR)=
BEGIN
!***************************************************************
! Case statement control on looking at the next expression up
! after a match.
!
! Macros to check proper valflags and call REA for the next
! level up of an expression that has just been matched.
!***************************************************************
MACRO
ARGSBOTH(NOD)=
IF .NOD[A1VALFLG] AND .NOD[A2VALFLG] THEN XPUNGE(.NOD,STGHT)$,
ARGS1(NOD)=
IF .NOD[A1VALFLG] THEN XPUNGE(.NOD,UNARY)$,
ARGS2(NOD)=
IF .NOD[A2VALFLG] THEN XPUNGE(.NOD,UNARY)$;
MAP
BASE EXPR,
BASE QQ;
IF .EXPR EQL 0 THEN RETURN;
%2373% IF .EXPR[VALTYPE] EQL CHARACTER THEN RETURN;
CASE .EXPR[OPRCLS] OF SET
ARGSBOTH(EXPR); ! BOOLEAN
RETURN; ! DATAOPR - ILLEGAL
! RELATIONALS are special. At this point we are only
! interested in the relational itself and not the local
! special single variable case at all REA would include
! this special case. We will call XPUNGE directly to
! prevent this.
IF .EXPR[A1VALFLG] AND .EXPR[A2VALFLG] ! RELATIONAL
THEN XPUNGE(.EXPR,STGHT);
IF ARGCONE(.EXPR) THEN XPUNGE(.EXPR,UNARY); ! FNCALL
BEGIN ! ARITHMETIC - Get the obvious straight case
ARGSBOTH(EXPR) ! This macro expands to IF ... THEN ...
ELSE
BEGIN ! Check array refs
QQ = .EXPR [ARG1PTR];
IF .FLGREG<OPTIMIZE> AND .QQ[OPRCLS] EQL ARRAYREF
THEN A1ARREF (.EXPR)
ELSE
BEGIN
QQ = .EXPR [ARG2PTR];
IF .FLGREG<OPTIMIZE> AND .QQ[OPRCLS] EQL ARRAYREF
THEN A2ARREF(.EXPR)
ELSE
BEGIN ! Try for skewed trees too
QQ = .EXPR[ARG1PTR];
! Check skew properties
IF (.QQ[OPR1] EQL .EXPR[OPR1]) AND
(.QQ[OPR1] NEQ DIVOPF) AND
(NOT .QQ[PARENFLG]) AND
.QQ[A2VALFLG]
THEN XPUNGE(.EXPR,SKEW);
! Look up
IF (QQ = .EXPR[PARENT]) NEQ 0
THEN
BEGIN
IF (.QQ[OPR1] EQL .EXPR[OPR1]) AND
(.QQ[OPR1] NEQ DIVOPF) AND
(NOT .EXPR[PARENFLG]) AND
.QQ[A2VALFLG] AND .EXPR[A2VALFLG]
THEN XPUNGE(.QQ,SKEW);
END;
END;
END;
END; ! Check array refs
END; ! ARITHMETIC - Get the obvious straight case
ARGS2(EXPR); ! TYPECNV
BEGIN ! ARRAYREF
LOCAL BASE MOM;
IF NOT .FLGREG<OPTIMIZE> THEN RETURN;
MOM = .EXPR [PARENT];
IF .MOM [OPRCLS] EQL STATEMENT THEN RETURN;
! Can not NEXTUP arrayref if inside iolist
IF .MOM [OPRCLS] EQL IOLSCLS THEN RETURN;
%2373% IF .MOM[VALTYPE] EQL CHARACTER THEN RETURN;
! Find tree shape and call XPUNGE
IF .MOM [ARG1PTR] EQL .EXPR
THEN A1ARREF(.MOM)
%2373% ELSE IF .MOM [ARG2PTR] EQL .EXPR
%2373% THEN A2ARREF(.MOM);
END;
RETURN; ! CMNSUB - ILLEGAL
ARGS2(EXPR); ! NEGNOT
ARGS1(EXPR); ! SPECOP
RETURN; ! FIELDREF
RETURN; ! STORECLS
RETURN; ! REGCONTENTS
RETURN; ! LABOP
RETURN; ! STATEMENT
RETURN; ! IOLSCLS
BEGIN ! INLINFN
IF .EXPR[ARG2PTR] NEQ 0
THEN
BEGIN
ARGSBOTH(EXPR)
END
ELSE ARGS1(EXPR);
END;
%1431% RETURN; ! SUBSTRING
%1431% RETURN ! CONCATENATION
TES;
END; ! of NEXTUP
ROUTINE UNRYMATCH(CNODE,NAN,PHI)=
BEGIN
!***************************************************************
! Fixes up (performs matcher functions ) for a unary shape (i.e.
! typecnv ,arrayref, special case, library function). PHI is
! pointer to hashed entry (index). NAN should be set only on
! not nodes, typecnv nodes or function calls
!***************************************************************
MAP
PEXPRNODE CNODE,
PEXPRNODE PHI;
! Get out if it is an arrayref
IF .CNODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN
! Better only be here when globally optimizing
IF .FLGREG<OPTIMIZE>
THEN
BEGIN
! Make linked list off of LKER field of PHI
! using parent pointers of arrayref nodes
CNODE[PARENT] = .PHI[LKER];
PHI[LKER] = .CNODE;
END;
RETURN;
END;
! In the global case check the first entry to see if it is an
! assignment to a optimizer .O temporary.
IF .FLGREG<OPTIMIZE> THEN
IF .CNODE[OPRCLS] NEQ DATAOPR AND .PHI[USECNT] EQL 1
THEN
BEGIN
DOTOHASGN(.PHI[LKER],.PHI);
! If subsumption happened then do only the second half
! and quit
IF .PHI[TEMPER] NEQ 0
THEN
BEGIN
PHI[USECNT] = .PHI[USECNT] + 1;
CMNLNK(.PHI[TEMPER],.CNODE,UNARY,.NAN,.PHI);
RETURN;
END;
END;
IF .PHI[USECNT] EQL 1
THEN
BEGIN ! Use count is one
PHI[USECNT] = 2;
! Make cmnsub node and fix up old entry. We must set PC
! before the call to CMNMAK in order to correctly handle
! the special local common sub-expression case of a
! single variable subscript or under a relational. In
! this case PHI[TEMPER] holds the pointer to the
! expression for relinking. CMNMAK will change
! PHI[TEMPER].
IF .CNODE[OPRCLS] EQL DATAOPR
THEN PC = .PHI[TEMPER]
ELSE PC = .PHI[LKER];
! First reset any neg flags on the node we are about to
! make a common sub-expression. QQ is used as a
! temporary
QQ = .PHI[LKER];
IF .QQ[OPRCLS] NEQ DATAOPR
THEN
BEGIN
QQ[A1NEGFLG] = 0;
QQ[A2NEGFLG] = 0;
END;
T = CMNMAK(.PHI[LKER],0,.PHI);
QQ = CMNLNK(.T,.PC,UNARY,.PHI[NEDSANEG],.PHI);
! QQ contains the parent pointer on return. But be
! careful! Check for the special local case of
! relational or arrayref, because QQ will point to the
! relational or arrayref.
IF .CNODE[OPRCLS] NEQ DATAOPR THEN NEXTUP(.QQ);
END ! Use count is one
ELSE PHI[USECNT] = .PHI[USECNT]+1;
T = .PHI[TEMPER];
! Now fix up current reference (in all cases). Note the special
! test for the same reason as described above. VARHOLDER is the
! module own that points to the expression in this case
CMNLNK(.T,IF .CNODE[OPRCLS] EQL DATAOPR
THEN .VARHOLDER
ELSE .CNODE,UNARY,.NAN,.PHI);
END; ! of UNRYMATCH
ROUTINE CHK4OPS(CNODE)=
BEGIN
!***************************************************************
! If we have a op a op a op a, when we are matching a op a with
! a op a, we would enter into the hash table cmn(a op a) op a
! (unless otherwise prevented.) If there is another a op a op a
! op a in the world this will lead to a false match and
! incorrect code. The purpose of this routine is to prevent
! that trouble making entry. A 0 is returned if the entry is
! ok, a 1 if not.
!***************************************************************
MAP
PEXPRNODE CNODE,
PEXPRNODE TS;
IF NOT .CNODE[A1VALFLG]
THEN
BEGIN ! The tree must be skewed.
TS = .CNODE[ARG1PTR];
! Check for a op a. If ARG1 is the node were
! substituting then this is the bad case.
IF .TS[ARG2PTR] EQL .CNODE[ARG2PTR] THEN
IF .TS[ARG1PTR] EQL .T
THEN RETURN(1);
END; ! The tree must be skewed.
END; ! of CHK4OPS
ROUTINE MATCHER(CNODE,SHAPE,NAN,PHI)=
BEGIN
!***************************************************************
! Called on a hit in the hash table. PHI points to the matching
! entry. CNODE is expression node. SHAPE is
! unary,stght(straight), or skew(skewed) of current expression.
! See routine HASHIT for pictures of the tree shapes. NAN is
! needs a negative(negation).
!***************************************************************
MAP
PHAZ2 CNODE,
PHAZ2 PHI,
PHAZ2 T;
IF .SHAPE EQL UNARY
THEN
BEGIN ! Go to special routine if shape is unary
UNRYMATCH(.CNODE,.NAN,.PHI);
RETURN;
END;
! Check for assignment to .O variable
IF .FLGREG<OPTIMIZE> THEN
IF (.SHAPE EQL STGHT)
AND (.PHI[USECNT] EQL 1)
AND NOT .PHI[NBRCH]
THEN DOTOHASGN(.PHI[LKER],.PHI);
IF .PHI[USECNT] EQL 1 AND .PHI[TEMPER] EQL 0
THEN
BEGIN ! Use count is one
PHI[USECNT] = 2;
IF .SHAPE EQL SKEW
THEN
BEGIN ! Skewed tree
! Also catch b*b*b*b, test after NARY2 will stop
! all common subs or merely correct the
! situation for b*b*b, hopefully, this will
! permit b*b*b*b to become (t = b*b,t*t).
IF .CNODE[ARG1PTR] EQL .PHI[LKER]
THEN
BEGIN
PHI[USECNT] = 1;
RETURN; ! Get out
END;
! Preclude triples eliminated by match
NARY2(.CNODE);
IF .PHI[NBRCH]
THEN
BEGIN ! Entry in hash table is also skewed
QQ = .CNODE[ARG1PTR];
! Make a straight one
PB = MAKEPR(.CNODE[OPRCLS],
.CNODE[OPERSP],
.CNODE[VALTYPE],
.QQ[ARG2PTR],
.CNODE[ARG2PTR]);
PB[DEFPT1] = .QQ[DEFPT2];
PB[DEFPT2] = .CNODE[DEFPT2];
PB[A1FLGS] = .QQ[A2FLGS];
PB[A2FLGS] = .CNODE[A2FLGS];
! Eliminate triples precluded by match
! and make a common sub
NARY2(.PHI[LKER]);
T = CMNMAK(.PB,.NAN,.PHI);
PC = .PHI[LKER];
PB[PARENT] = .PC[PARENT];
PHI[LKER] = .PB;
END ! Entry in hash table is also skewed
ELSE
BEGIN ! Fix up tree
! Call STPRECLUDE before CMNMAK changes
! neg flags so hash in STPRECLUDE can
! find the skew piece of tree. Preclude
! if necessary.
STPRECLUDE(.PHI[LKER]);
! Make a cmnsub
T = CMNMAK(.PHI[LKER],.PHI[NEDSANEG],.PHI);
PC = .PHI[LKER];
END; ! Fix up tree
END
ELSE
BEGIN ! Shape is straight
! Make cmnsub node. Take into consideration the
! non-skewed case.
IF .PHI[NBRCH]
THEN
BEGIN
T = CMNMAK(.CNODE,.NAN,.PHI);
! If first node was skewed, make the one
! we keep straight. Also preclude others
! precluded by this match.
NARY2(.PHI[LKER])
END
ELSE
BEGIN
! Call STPRECLUDE before CMNMAK changes
! the neg flags. First node was
! straight but still have the count
! hassle.
STPRECLUDE(.PHI[LKER]);
T = CMNMAK(.PHI[LKER],.PHI[NEDSANEG],.PHI);
END;
PC = .PHI[LKER];
PHI[LKER] = .CNODE
END; ! Shape is straight
! Fix up expression pointers. PC is pointer to the
! expression.
QQ = CMNLNK(.T,.PC,
IF .PHI[NBRCH] THEN SKEW ELSE STGHT,
.PHI[NEDSANEG],.PHI);
! QQ points to parent on return from CMNLNK
IF NOT CHK4OPS(.CNODE)
THEN
%725% BEGIN
%725% ! Before we call NEXTUP, be sure that CSTMNT
%725% ! points to the statement which contains the
%725% ! original instance of the expression. This was
%725% ! carefully saved in the hash entry when it was
%725% ! made.
%725% LOCAL SAVCSTMNT; ! Save CSTMNT for NEXTUP
%725% SAVCSTMNT = .CSTMNT;
%725% CSTMNT = .PHI[HSTMNT]; ! Get statement from which
%725% ! the old expression came
%725% NEXTUP(.QQ); ! Handle old expression
%725% CSTMNT = .SAVCSTMNT; ! Restore CSTMNT to proceed
%725% END
END ! Use count is one
ELSE PHI[USECNT] = .PHI[USECNT] + 1;
! If this is a skewed tree then delete hash entries precluded by
! this match
IF .SHAPE EQL SKEW
THEN NARY2(.CNODE)
ELSE STPRECLUDE(.CNODE);
T = .PHI[TEMPER]; ! Point to temporary for substitution
! Link up the common sub expression (current one)
CMNLNK(.T,.CNODE,.SHAPE,.NAN,.PHI);
END; ! of MATCHER
ROUTINE CMNLNK(T,CNODE,SHAPE,NAN,PHI)=
BEGIN
!***************************************************************
! Link up the common sub-expression in its place
!***************************************************************
MAP
PHAZ2 QQ,
BASE CNODE,
BASE PHI,
BASE T;
OWN
OLDT,
NEGT;
LABEL ADJCTL;
T[EXPRUSE] = .PHI[USECNT];
FLAG = 0; ! Initialize flag
IF .SHAPE EQL SKEW
THEN
BEGIN ! Skewed tree
%715% ! Both neg and not flags have been used in the common
%715% ! sub-expression so turn them both off in the main
%715% ! expression.
%715% CNODE[A2NGNTFLGS] = 0;
IF .NAN
THEN
BEGIN
CNODE[ARG2PTR] = MAKPR1(.CNODE,NEGNOT,NEGOP,.CNODE[VALTYPE],0,.T);
CNODE[A2VALFLG] = 0;
END
ELSE
BEGIN
CNODE[ARG2PTR] = .T;
CNODE[A2VALFLG] = 1;
END;
! The tree looks like this:
! *(CNODE)
! * *
! *(QQ) *(Just became T)
! *(QQ)
! * *
! *(Will become QQ we care about)
! *(Will go away)
QQ = .CNODE[ARG1PTR];
! Save definition point. If QQ[ARG1PTR] is not an
! expression then this becomes the definition point of
! the dataopr, etc.
TS = .QQ[DEFPT1];
! There is yet another hassle - Neg/not flags. We must
! move them up if possible. The conditions are if neg is
! set and CNODE doesnt have not set, complement neg in
! parent else build neg node and insert. The same is
! true for nots. Set refers to the arg1flags of the top
! one of the QQ nodes in the above diagram.
IF .QQ[A1NEGFLG]
THEN
BEGIN
IF NOT .CNODE[A1NOTFLG]
THEN
BEGIN
CNODE[A1NEGFLG] = NOT .CNODE[A1NEGFLG];
QQ = .QQ[ARG1PTR];
END
ELSE QQ = MAKPR1(.CNODE,NEGNOT,NEGOP,.QQ[VALTYPE],0,.QQ);
END
ELSE IF .QQ[A1NOTFLG]
THEN
BEGIN
IF NOT .CNODE[A1NEGFLG]
THEN
BEGIN
CNODE[A1NOTFLG] = NOT .CNODE[A1NOTFLG];
QQ = .QQ[ARG1PTR];
END
ELSE QQ = MAKPR1(.CNODE,NEGNOT,NOTOP,.QQ[VALTYPE],0,.QQ);
END
ELSE QQ = .QQ[ARG1PTR];
CNODE[ARG1PTR] = .QQ;
! Set definition point of node just substituted
CNODE[DEFPT2] = .PHI[STPT];
! Now, depending on whether or not QQ is a dataopr or
! cmnsub set defpt1, valflags and parent pointer
IF .QQ[OPRCLS] EQL DATAOPR OR .QQ[OPRCLS] EQL CMNSUB
THEN
BEGIN
CNODE[DEFPT1] = .TS;
CNODE[A1VALFLG] = 1;
END
ELSE
BEGIN ! An expression
CNODE[DEFPT1] = .QQ[DEFPT1];
QQ[PARENT] = .CNODE;
END;
! Make sure QQ points to CNODE parent before return as
! this feature is used by NEXTUP. In this skewed case
! the expression we want to examine is the one in which
! the substitution has occurred.
QQ = .CNODE;
END ! Skewed tree
ELSE
BEGIN ! Balanced tree
! Here, once again, we have the special local (single
! variable) case. CNODE is a pointer to the expression
! and will itself function as the parent. No other case
! looks for common subs in an arrayref or relational.
! This is an important concept. The global case does
! look for relationals so an additional test on BACKST
! is also necessary.
OLDT = .T; ! Save value of t
IF (.CNODE[OPRCLS] EQL ARRAYREF OR
.CNODE[OPRCLS] EQL RELATIONAL) AND
.BACKST NEQ 0
THEN
BEGIN
QQ = .CNODE;
CNODE = .PHI[LKER];
! If it is a relational we must set a special
! flag so that the register allocator will know
! that it may have to be moved to another
! register if this is an AOBJN loop.
IF .QQ[OPRCLS] EQL RELATIONAL THEN T[CSFULLWDFLG] = 1;
END
ELSE
BEGIN
QQ = .CNODE[PARENT];
! If T is a variable (this is the global case),
! do not set the parent to T. Do not set the
! parent at all.
IF .T[OPRCLS] EQL CMNSUB THEN CNODE[PARENT] = .T;
END;
IF .NAN THEN NEGT =
MAKPR1(.QQ,NEGNOT,NEGOP,.CNODE[VALTYPE],0,.T);
IF .QQ[OPRCLS] EQL STATEMENT
THEN
BEGIN
IF .NAN THEN
IF NOT SETNEG(.QQ,0)
THEN
BEGIN
T = .NEGT;
FLAG = 1;
END;
REPLACARG(.QQ,.CNODE,.T);
IF .T[IDDOTO] EQL SIXBIT ".O" THEN
IF .QQ[SRCID] EQL ASGNID THEN
IF .QQ[SRCOPT] NEQ 0
THEN QQ[OPDEF] = .PHI[STPT];
END
ELSE IF .QQ[OPRCLS] EQL FNCALL
THEN
BEGIN
LOCAL ARGUMENTLIST AG;
IF .NAN
THEN
BEGIN
T = .NEGT;
FLAG = 1;
END;
AG = .QQ[ARG2PTR];
! Set up parameters in case we have to call
! LEAFSUBSTITUTE to locate it
ITMCT = 1;
GLOBREG[0] = .CNODE;
CHOSEN[0] = .T;
SPECCASE = 0;
%2057% LOKCALST(.AG,.AG[ARGCOUNT],.CNODE,.T,FALSE);
! Put definition point into node if appropriate
IF ARGCONE(.QQ) THEN QQ[DEFPT2] = .PHI[STPT];
END
ELSE IF .QQ[OPRCLS] EQL IOLSCLS
THEN
BEGIN
! For an IOLSCLS node, we have to be very
! careful with where we tie in the pointer!
IF .NAN
THEN
BEGIN
T = .NEGT;
FLAG = 1;
END;
IF .QQ[SCALLELEM] EQL .CNODE
THEN QQ[SCALLELEM] = .T
ELSE IF .QQ[SCALLCT] EQL .CNODE
THEN QQ[SCALLCT] = .T;
END
ELSE IF .QQ[ARG1PTR] EQL .CNODE AND .QQ[OPRCLS] NEQ ARRAYREF
THEN
BEGIN
IF .NAN THEN
IF NOT SETNEG(.QQ,1)
THEN
BEGIN
T = .NEGT;
FLAG = 1;
END;
QQ[ARG1PTR] = .T;
IF .T[OPRCLS] EQL CMNSUB OR .T[OPRCLS] EQL DATAOPR
THEN QQ[A1VALFLG] = 1;
QQ[DEFPT1] = .PHI[STPT];
END
ELSE
BEGIN
IF .NAN THEN
IF NOT SETNEG(.QQ,0)
THEN
BEGIN
T = .NEGT;
FLAG = 1;
END;
QQ[ARG2PTR] = .T;
IF .T[OPRCLS] EQL CMNSUB OR .T[OPRCLS] EQL DATAOPR
THEN QQ[A2VALFLG] = 1;
QQ[DEFPT2] = .PHI[STPT];
END;
! One more thing. If the parent is a control type
! boolean we have to change it to control, because code
! generation cannot handle a value under a boolean or
! type control
T = .QQ;
ADJCTL:
WHILE .T[OPRCLS] EQL BOOLEAN AND .T[VALTYPE] EQL CONTROL
DO
BEGIN
T[VALTYPE] = LOGICAL; ! Change to logical
T = .T[PARENT]; ! Look at next parent
IF .T EQL 0 THEN LEAVE ADJCTL; ! Check for orphan
END;
! Restore node space freed, if any
IF .NAN THEN
IF NOT .FLAG THEN SAVSPACE(EXSIZ - 1,.NEGT);
T = .OLDT;
IF .T[OPRCLS] EQL CMNSUB
THEN
BEGIN
! The check for the valflg being set on a cmnsub
! node is equivalent to the special case check
! for the local unary subscript or relational.
! It is clear that the space for a symbol table
! node does not get freed.
IF .T[ARG2PTR] NEQ .CNODE
AND NOT .T[A2VALFLG]
THEN SAVSPACE(EXSIZ-1,.CNODE);
END;
END; ! Balanced tree
RETURN .QQ
END; ! of CMNLNK
ROUTINE CHKHAIR(CNODE,PHI,SHAPE)=
BEGIN
!***************************************************************
! Check node for having another common sub-expression under it.
! If it does then set cmnunder flag in hash table node.
!***************************************************************
LOCAL BASE ARGNODE;
MAP
BASE TOP,
BASE PA,
PEXPRNODE CNODE,
PEXPRNODE PHI;
MACRO ARG1CHK=
BEGIN
ARGNODE = .CNODE[ARG1PTR];
IF .ARGNODE[OPRCLS] EQL CMNSUB OR
.ARGNODE[IDDOTO] EQL SIXBIT".O"
THEN PHI[CMNUNDER] = 1;
END$;
MACRO ARG2CHK=
BEGIN
ARGNODE = .CNODE[ARG2PTR];
IF .ARGNODE[OPRCLS] EQL CMNSUB OR
.ARGNODE[IDDOTO] EQL SIXBIT".O"
THEN PHI[CMNUNDER] = 1;
END$;
%1431% MACRO ARG4CHK=
BEGIN
ARGNODE = .CNODE[ARG4PTR];
IF .ARGNODE[OPRCLS] EQL CMNSUB OR
.ARGNODE[IDDOTO] EQL SIXBIT".O"
THEN PHI[CMNUNDER] = 1;
END$;
MACRO CHKBOTH=
BEGIN
ARG2CHK;
IF .SHAPE EQL SKEW
THEN
BEGIN
CNODE = .CNODE[ARG1PTR];
ARG2CHK;
END
ELSE ARG1CHK;
END$;
CASE .CNODE[OPRCLS] OF SET
BEGIN ! BOOLEAN
CHKBOTH;
END; ! BOOLEAN
RETURN; ! DATAOPR
BEGIN ! RELATIONAL
CHKBOTH;
END; ! RELATIONAL
RETURN; ! FNCALL
BEGIN ! ARITHMETIC
CHKBOTH;
END; ! ARITHMETIC
ARG2CHK; ! TYPCNV
RETURN; ! ARRAYREF
RETURN; ! CMNSUB
ARG2CHK; ! NEGNOT
ARG1CHK; ! SPECOP
RETURN; ! FIELDREF
RETURN; ! STORECLS
RETURN; ! RECONTENTS
RETURN; ! LABOP
RETURN; ! STATEMENT
RETURN; ! IOLSCLS
BEGIN ! INLINFN
ARG1CHK;
IF .CNODE[ARG2PTR] NEQ 0 THEN ARG2CHK;
END; ! INLINFN
%1431% BEGIN ! SUBSTRING
%1431% CHKBOTH;
%1431% ARG4CHK;
%1431% END; ! SUBSTRING
%1431% RETURN ! CONCATENATION
TES;
END; ! of CHKHAIR
GLOBAL ROUTINE HASHIT(CNODE,SHAPE)=
BEGIN
!***************************************************************
! Create hash table entry for lookup; the global entry is used.
! entry is filled with the hash key elements. These are the
! operator, arguments and definition points. The macros in this
! routine help assure that arguments are in their proper order.
! Note: no dot is used on assignment to entryp
!***************************************************************
MACRO REVARG=
ENTRYP[HA1] = .CNODE[ARG2PTR];
ENTRYP[HDEF1] = .CNODE[DEFPT2];
ENTRYP[HA2] = .CNODE[ARG1PTR];
ENTRYP[HDEF2] = .CNODE[DEFPT1];$,
REGARG=
ENTRYP[HA1] = .CNODE[ARG1PTR];
ENTRYP[HDEF1] = .CNODE[DEFPT1];
ENTRYP[HA2] = .CNODE[ARG2PTR];
ENTRYP[HDEF2] = .CNODE[DEFPT2];$,
SREVARG=
ENTRYP[HA1] = .CNODE[ARG2PTR];
ENTRYP[HDEF1] = .CNODE[DEFPT2];
ENTRYP[HA2] = .QQ[ARG2PTR];
ENTRYP[HDEF2] = .QQ[DEFPT2];$,
SREGARG=
ENTRYP[HA1] = .QQ[ARG2PTR];
ENTRYP[HDEF1] = .QQ[DEFPT2];
ENTRYP[HA2] = .CNODE[ARG2PTR];
ENTRYP[HDEF2] = .CNODE[DEFPT2];$;
OWN PHAZ2 ENTRYP;
MAP PHAZ2 CNODE;
ENTRY = 0;
ENTRYP = ENTRY;
ENTRY + 1 = 0;
NAN = 0;
IF .FLGREG<OPTIMIZE> AND NOT .IMPLDO THEN REDEFPT(.CNODE,.SHAPE);
ENTRYP[BLKID] = .LOOPNO;
%1431% IF .CNODE[OPRCLS] EQL CONCATENATION ! Concatenation and substring
%1431% OR .CNODE[OPRCLS] EQL SUBSTRING ! should never be CSEs
%1431% THEN CGERR();
CASE .SHAPE OF SET
BEGIN ! UNARY - TYPECNV, ARRAYREF with simple variable as
! resultant subscript also library functions of a single
! argument also special operators which are arg1 types
! instead of arg2.
! If the item is a variable (this is special arrayref
! case)
IF .CNODE[OPRCLS] EQL DATAOPR AND .CNODE[OPERSP] NEQ CONSTANT
THEN
BEGIN
ENTRYP[HOP] = VARFL;
ENTRYP[HDEF1] = 0;
ENTRYP[HA2] = .CNODE;
ENTRYP[HDEF2] = 0;
ENTRYP[HA1] = 0;
END
ELSE IF .CNODE[OPRCLS] EQL ARRAYREF
THEN
BEGIN
! It is not the local special case see if its an
! arrayref (global only)
ENTRYP[HOP] = .CNODE[OPERATOR];
! Fudge the offset into the block id
ENTRYP[BLKID] = .CNODE[TARGADDR];
! But be sure the empty bit is off
ENTRYP[EMPTY] = 0;
REGARG;
END
ELSE IF .CNODE[OPRCLS] EQL FNCALL
THEN
BEGIN
! Not an arrayref, try function reference
REGISTER ARGUMENTLIST AG;
ENTRYP[HOP] = .CNODE[OPERATOR];
ENTRYP[HA1] = .CNODE[ARG1PTR];
ENTRYP[HDEF1] = 0;
AG = .CNODE[ARG2PTR];
ENTRYP[HA2] = .AG[1,ARGNPTR];
ENTRYP[HDEF2] = .CNODE[DEFPT2];
END
ELSE IF .CNODE[OPRCLS] EQL SPECOP
THEN
BEGIN
! Not a function call either. check for special
! operator
IF .CNODE[A1NEGFLG] THEN NAN = 1;
ENTRYP[HOP] = .CNODE[OPERATOR]+.CNODE[A1NOTFLG];
REGARG;
END
ELSE
BEGIN
! Now treat everyone the same (typecnv and
! negnot)
IF .CNODE[A2NEGFLG] THEN NAN = 1;
ENTRYP[HOP] = .CNODE[OPERATOR]+.CNODE[A2NOTFLG];
REGARG;
END;
END; ! Unary case
BEGIN ! STRAIGHT
!
! OP
! * *
! * *
! DATA DATA
IF .CNODE[OPRCLS] EQL ARITHMETIC
THEN
BEGIN ! arithmetic
! Arithmetic nodes are a special case because
! the skeleton optimizer has eliminated subtract
! nodes in favor of adds with proper neg flags
! set. We also wish to recognize a-b and b-a as
! the same expression (plus negate on one of
! them).
! TALLY is the xor of the negate flags present
! in the node.
TALLY = .CNODE[A1NEGFLG] XOR .CNODE[A2NEGFLG];
IF .CNODE[OPR1] EQL ADDOPF
THEN
BEGIN ! Add operation
! Adds are a special case. In all cases
! the expression will be considered to
! be a-b. This is TALLY = 1 and A2NEGFLG
! set. TALLY = 1 and A1NEGFLG set is b-a
! which needs a negation (nan set).
! 0 NAN
! ----- -----
! A+B -(A+B)
! A-B -A+B==B-A
NAN = .CNODE[A1NEGFLG];
ENTRYP[HOP] = .CNODE[OPERATOR]+.TALLY+
.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG]^2;
! Make sure once again that arguments
! are in the correct order. In general,
! they are properly ordered by
! canonicalization. When newly found
! common subs are involved we may need
! to order them here.
IF .CNODE[ARG1PTR] GTR .CNODE[ARG2PTR]
THEN
BEGIN
REVARG;
IF .TALLY THEN NAN = NOT .NAN;
END
ELSE
BEGIN ! Args are already in right order
REGARG;
END;
END ! Add operation
ELSE
BEGIN ! Not add operation
NAN = .TALLY;
ENTRYP[HOP] = .CNODE[OPERATOR]+
.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];
! Multiply is also somewhat special
IF .CNODE[OPR1] EQL MULOPF
THEN
BEGIN ! Check arg order again
IF .CNODE[ARG1PTR] GTR .CNODE[ARG2PTR]
THEN
BEGIN
REVARG;
END
ELSE
BEGIN ! Args in order
REGARG;
END;
END
ELSE
BEGIN ! Not a multiply
REGARG;
END;
END; ! Not add operation
END ! Arithemtic
%644% ELSE IF .CNODE[OPRCLS] EQL INLINFN
%644% THEN
%644% BEGIN
%644% ! In line functions should be treated separately
%644% ! from other Non arithmetic cases which depend
%644% ! more heavily on not flags. In particular, we
%644% ! need to hash differently so that the neg flags
%644% ! are definitely taken into account for cse.
%644% TALLY = 0;
%644% NAN = 0;
%644% ENTRYP[HOP] = .CNODE[OPERATOR]+
%644% .CNODE[A1NEGFLG]^1+.CNODE[A2NEGFLG]^2;
%644% REGARG;
%644% END
ELSE
BEGIN
NAN = 0;
ENTRYP[HOP] = .CNODE[OPERATOR]+
.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];
REGARG;
END;
END; ! Straight case
BEGIN ! SKEWED TREES
!
! OP(CNODE)
! * *
! * *
! OP(QQ) DATA
! *
! *
! DATA
QQ = .CNODE[ARG1PTR];
IF .CNODE[OPRCLS] EQL ARITHMETIC
THEN
BEGIN ! Arithmetic node
! Tally contains the number of negatives on the
! expression
TALLY = .CNODE[A2NEGFLG] XOR .QQ[A2NEGFLG];
IF .CNODE [OPR1] EQL ADDOPF
THEN
BEGIN ! Add operation
ENTRYP[HOP] = .CNODE[OPERATOR]+.TALLY
+.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG]^2;
! TALLY and a negate (gag) on the second
! node determine if a negate is needed
! on the common sub.
NAN = .QQ[A2NEGFLG];
! Insure args are ordered by symbol
! table address
IF .QQ[ARG2PTR] GTR .CNODE[ARG2PTR]
THEN
BEGIN ! They need switching
SREVARG;
IF .TALLY THEN NAN = NOT .NAN;
END
ELSE
BEGIN ! They do not need switching
SREGARG;
END;
END ! Add operation
ELSE
BEGIN ! Not an add
NAN = .TALLY;
ENTRYP[HOP] = .CNODE[OPERATOR]
+.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];
IF .CNODE[OPR1] EQL MULOPF
THEN
BEGIN ! A multiply
! Worry about arg order again
IF .QQ[ARG2PTR] GTR .CNODE[ARG2PTR]
THEN
BEGIN ! Need reordering
SREVARG;
END
ELSE
BEGIN ! No reordering needed
SREGARG;
END
END
ELSE
BEGIN ! Not multiply
SREGARG;
END
END; ! Not add
END ! Arithmetic
ELSE
BEGIN ! Not arithmetic
! Check on the correct flags for hashing
! uniquely
ENTRYP[HOP] = .CNODE[OPERATOR]
+.QQ[A2NOTFLG]^1+.CNODE[A2NOTFLG];
SREGARG;
END;
END ! End skewed tree case
TES;
END; ! of HASHIT
ROUTINE XPUNGE(CNODE,SHAPE)=
BEGIN
!***************************************************************
! Tree has been walked to the leaf*operator*leaf point. The
! expression will now be hashed, etc. The local and global
! cases are distinguished here by a test on the value of BACKST.
! BACKST must be zero in the global case. The check is necessary
! since the global case requires much checking not necessary in
! the local case.
!***************************************************************
LABEL FIND;
MAP PEXPRNODE CNODE;
IF .BACKST NEQ 0 OR .IMPLDO
THEN
BEGIN ! Local case or i/o optimizer case
! We cannot handle shapes greater than skew here, for
! there is no such code in HASHIT. To add code for this
! case, we could use CHKDOMINANCE as a template, but the
! code is extensive. For now simply do not attempt to
! handle cases with shape greater than skew. An example
! is: read() (a(b(i),j),c(b(i),j),j = 1,10)
IF .SHAPE GTR SKEW THEN RETURN;
%731% ! If this is an i/o statement, then avoid hashing if either of
%731% ! the definition points are on the statement itself. This is
%731% ! the case if the definition point algorithm has bailed out (for
%731% ! example, with variables in common).
%731% IF .IMPLDO THEN
%731% IF .CNODE[DEFPT1] EQL .SAVSTMNT
%731% OR .CNODE[DEFPT2] EQL .SAVSTMNT
%731% THEN RETURN; ! Non-hashable node
HASHIT(.CNODE,.SHAPE);
PHI = TBLSRCH();
IF .FLAG
THEN MATCHER(.CNODE,.SHAPE,.NAN,.PHI)
ELSE
BEGIN
PHI = MAKETRY(.PHI,.CNODE,.SHAPE);
IF .SHAPE EQL SKEW THEN PHI[NBRCH] = 1;
IF .NAN THEN PHI[NEDSANEG] = 1;
! Find definition points correctly for star1 and
! star2 cases. This may have to be changed if
! more general expressions are allowed in i/o
! lists. For now it catches the case (a(p(i)),
! i = 1,4) where a is a formal parameter being
! passed.
IF NOT .IMPLDO
THEN PHI[STPT] = 0 ! Local case
ELSE
BEGIN ! I/O list case
LOCAL CN,DF1,DF2;
MAP PEXPRNODE CN;
PA = .LENTRY;
! Here is the main change - we must drop
! down one node prior to grabbing the
! def points for star1 and star2 shapes
! - CN points to the node we want
CN = IF .SHAPE EQL STAR1
THEN .CNODE[ARG1PTR]
ELSE IF .SHAPE EQL STAR2
THEN .CNODE[ARG2PTR]
ELSE .CNODE;
DF1 = .CN[DEFPT1];
DF2 = .CN[DEFPT2];
! If shape is skew, we need to get the
! correct definition point for the left
! hand node. An example case which
! causes this to happen is:
! a(b(l+i-1)),i = j,k; where b is a
! formal array!
IF .SHAPE EQL SKEW
THEN
BEGIN
CN = .CNODE[ARG1PTR];
DF1 = .CN[DEFPT2];
END;
IF .DF1 EQL .DF2
THEN PHI[STPT] = .DF1 ! Done
ELSE
BEGIN
P = IF .DF1 EQL 0 THEN 1 ELSE 0;
IF .DF2 EQL 0 THEN P = .P + 2;
FIND:
WHILE 1 DO
BEGIN
IF NOT .P<0,1> THEN
IF .PA EQL .DF1 THEN P = .P +1;
IF NOT .P<1,1> THEN
IF .PA EQL .DF2 THEN P = .P +2;
IF .P EQL 3 THEN LEAVE FIND;
PA = .PA[CLINK]
END;
PHI[STPT] = .PA
END ! Skew case
END ! I/O list case
END
END
ELSE CHKDOMINANCE(.CNODE,.SHAPE); ! Global case
END; ! of XPUNGE
ROUTINE ELIM(STMT)=
BEGIN
!***************************************************************
! Controlling routine at the statement level for common
! sub-expression elimination, both global and local. Only
! statements mentioned explicitly in this routine can even
! potentially have common sub-expressions.those statement types
! are: assignment,logical if, do, arithmetic if,read, write.
!***************************************************************
MAP
PHAZ2 STMT,
BASE TOP,
BASE BACKST;
IF .STMT[SRCID] EQL ASGNID
THEN
BEGIN ! Assignment statements
PAE = .STMT[LHEXP];
IF .PAE[OPRCLS] EQL ARRAYREF THEN REA(.PAE);
! Special check for variable initialization in the
! global case
IF .STMT[A2VALFLG]
THEN
BEGIN
IF .FLGREG<OPTIMIZE> THEN
IF .STMT[SRCOPT] NEQ 0 THEN
IF .LOOP EQL 0 THEN
IF .STMT[OPDEF] EQL .LENTRY
THEN CHKINIT(.STMT[RHEXP]);
END
ELSE REA(.STMT[RHEXP]);
END; ! Assignment statements
IF .STMT[SRCID] EQL IFLID
THEN
BEGIN ! Logical if
REA(.STMT[LIFEXPR]);
IF NOT .FLGREG<OPTIMIZE>
THEN
BEGIN
! The special check is necessary to avoid
! processing the statement following the logical
! if twice in the global case. The true branch
! is on the processing list as a spearate entity
! by itself in the global case.
! Hook all locals found so far to the if part
LOCLDEPD();
STMT[SRCCOMNSUB] = .BACKST[SRCLINK];
BACKST[SRCLINK] = 0;
LOCLNK = 0;
CSTMNT = .STMT[LIFSTATE];
ELIM(.STMT[LIFSTATE]);
END;
END; ! Logical if
IF .STMT[SRCID] EQL DOID
THEN
BEGIN ! Do statement
REA(.STMT[DOLPCTL]);
END;
IF .STMT[SRCID] EQL IFAID
THEN
BEGIN ! Arithmetic if
REA(.STMT[AIFEXPR]);
END;
! I/O statements
IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID THEN
IF .FLGREG<OPTIMIZE> AND NOT .GLOBELIM2
THEN IOGELM(.STMT)
ELSE
IF .GCALLSLFLG
THEN IOCLEAR(.STMT)
ELSE LOCELMIO(.STMT);
END; ! of ELIM
MAP PEXPRNODE BACKST;
GLOBAL ROUTINE LOCELIM(STMT)=
BEGIN
!***************************************************************
! Control for local common sub-expression elimination
!***************************************************************
MAP
PEXPRNODE STMT,
PEXPRNODE CSTMNT;
SAVCSTMNT = .CSTMNT;
LOCLNK = 0;
STHASCMN = 0;
BACKST[SRCLINK] = 0;
LOOPNO = .CSTMNT[SRCISN];
ELIM(.STMT);
IF .STHASCMN
THEN
BEGIN
LOCLDEPD();
CSTMNT[SRCOPT] = .BACKST[SRCLINK];
END;
CSTMNT = .SAVCSTMNT;
! The above statement either zeroes the pointer to common
! sub-expressions or sets it to point to them correctly.
END; ! of LOCELIM
ROUTINE REA(STKPAE)=
BEGIN
!***************************************************************
! PAE is an expression pointer. This routine is named in honor
! of REA railway express. This is where we attempt to railroad
! everything through! As is not obvious it deals with common
! expression elimination. It does the basic tree walk through
! the trees. It is called by ELIM and calls XPUNGE to hash and
! match the philosophy behind each secton of code is the same.
! Walk the tree based on the setting of the valflgs (says node
! under here is leaf is set). Walk branches before looking at
! current node itself. Also check for the skewed tree case.
!***************************************************************
REGISTER PHAZ2 PAE;
PAE = .STKPAE;
STHASCMN = 1;
CASE .PAE[OPRCLS] OF SET
BEGIN ! BOOLEAN
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
THEN XPUNGE(.PAE,STGHT)
ELSE
BEGIN
QQ = .PAE[ARG1PTR];
! N-ary with leaves
IF .QQ[OPERATOR] EQL .PAE[OPERATOR] AND
.QQ[A2VALFLG] AND .PAE[A2VALFLG]
AND NOT .QQ[PARENFLG]
THEN XPUNGE(.PAE,PSKEW);
END; ! Else part skewed tree
END; ! BOOLEAN
RETURN; ! DATAOPR - Do nothing
BEGIN ! RELATIONAL
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
! Local case test of BACKST. Global case BACKST must be
! zero (0)
IF .BACKST NEQ 0
THEN
BEGIN
VARHOLDER = .PAE;
IF .PAE[A1VALFLG]
THEN
BEGIN
QQ = .PAE[ARG1PTR];
IF .QQ[OPRCLS] EQL DATAOPR AND
.QQ[OPERSP] NEQ CONSTANT
THEN XPUNGE(.QQ,UNARY);
END;
IF .PAE[A2VALFLG]
THEN
BEGIN
QQ = .PAE[ARG2PTR];
IF .QQ[OPRCLS] EQL DATAOPR AND
.QQ[OPERSP] NEQ CONSTANT
THEN XPUNGE(.QQ,UNARY);
END;
END
ELSE
! Global optimizer should find them. Do not consider
! for common subexpressions relational expressions
! involving neg flags. To allow this will cause
! expressions like a .gt. b and -a .gt. b to be
! considered as common subs - clearly wrong!
IF(.PAE[A1NEGFLG] OR .PAE[A2NEGFLG])
THEN RETURN
ELSE IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
THEN XPUNGE(.PAE,STGHT);
END; ! RELATIONAL
BEGIN ! FNCALL - function call
LOCAL ARGUMENTLIST TMP;
! Step through arguments. Each argument has the function
! node as parent
TMP = .PAE[ARG2PTR];
INCR I FROM 1 TO .TMP[ARGCOUNT] DO
BEGIN
! Set up QQ which is a global used throughout
! phase 2.
QQ = .TMP[.I,ARGNPTR];
REA(.QQ);
END;
! If optimizing go off and try for array references.
! This is a no-op unless this is a library function.
IF .FLGREG<OPTIMIZE>
THEN
BEGIN
FNARRAY(.PAE);
RETURN;
END;
! Try to eliminate library functions with one argument.
IF ARGCONE(.PAE) THEN XPUNGE(.PAE,UNARY);
END; ! FNCALL
BEGIN ! ARITHMETIC
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
! Try array references
IF .FLGREG<OPTIMIZE>
THEN
BEGIN
IF NOT .PAE[A1VALFLG] THEN A1ARREF(.PAE);
IF NOT .PAE[A2VALFLG] THEN A2ARREF(.PAE);
END;
! Now regular skewed
IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
THEN
BEGIN
%701% ! Cannot swap arguments unless operation is + or *
%701% IF .FLGREG<OPTIMIZE> AND ADDORMUL(PAE)
THEN
BEGIN ! X OP .R -> .R OP X
REGISTER BASE T1;
T1 = .PAE [ARG2PTR];
IF .T1 [IDDOTR] EQL SIXBIT ".R"
THEN
BEGIN
SWAPARGS(PAE);
T1 = .PAE [DEFPT1];
PAE [DEFPT1] = .PAE [DEFPT2];
PAE [DEFPT2] = .T1;
END;
END;
XPUNGE(.PAE, STGHT);
END
ELSE
BEGIN
QQ = .PAE[ARG1PTR];
IF .QQ[OPR1] EQL .PAE[OPR1] AND .PAE[OPR1] NEQ DIVOPF
AND NOT .QQ[PARENFLG]
AND .QQ[A2VALFLG] AND .PAE[A2VALFLG] ! N-ary with leaves
THEN XPUNGE(.PAE,PSKEW);
! Look down once more
IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
THEN XPUNGE(.PAE,STGHT);
END;
END; ! ARITHMETIC
BEGIN ! TYPCNV
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);
END; ! TYPCNV
BEGIN ! ARRAYREF
IF .PAE[ARG2PTR] EQL 0 THEN RETURN;
IF .PAE[A2VALFLG] AND .BACKST NEQ 0
THEN
BEGIN ! Special case for local only
VARHOLDER = .PAE;
QQ = .PAE[ARG2PTR];
! Its a non-constant leaf. Constant leaves
! should have been folded into the offset.
! The neg and/or not flags cannot be set. We
! are not prepared to hash them. In general this
! will not prevent much because the flags dont
! make a lot of sense on the subscript anyway.
IF .QQ[OPRCLS] EQL DATAOPR AND .QQ[OPERSP] NEQ CONSTANT
%1253% AND .PAE[VALTYPE] NEQ CHARACTER THEN
IF NOT .PAE[A2NEGFLG] AND NOT .PAE[A2NOTFLG]
THEN XPUNGE(.QQ,UNARY);
END
ELSE REA(.PAE[ARG2PTR]);
END; ! ARRAYREF
RETURN; ! CMNSUB - Should not happen
BEGIN ! NEGNOT
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);
END; ! NEGNOT
BEGIN ! SPECOP
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF .PAE[A1VALFLG] THEN XPUNGE(.PAE,UNARY);
END; ! SPECOP
RETURN; ! FIELDREF - Should not happen
RETURN; ! STORECLS
RETURN; ! REGCONTENTS
RETURN; ! LABOP
RETURN; ! STATEMENT
RETURN; ! IOLSCLS - See REAIO
BEGIN ! INLINFN
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF .PAE[A1VALFLG] THEN
IF .PAE[ARG2PTR] EQL 0
THEN XPUNGE(.PAE,UNARY);
IF NOT .PAE[A2VALFLG] THEN
IF .PAE[ARG2PTR] NEQ 0
THEN REA(.PAE[ARG2PTR]);
IF .PAE[A1VALFLG] AND .PAE[A2VALFLG] THEN XPUNGE(.PAE,STGHT);
END; ! INLINFN
%1431% BEGIN ! SUBSTRING
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
QQ = .PAE[ARG4PTR];
IF .QQ[OPRCLS] NEQ DATAOPR THEN REA(.QQ);
%1431% END; ! SUBSTRING
%1474% BEGIN ! CONCATENATION
%1474% LOCAL ARGUMENTLIST TMP;
%1474% ! Step through arguments. Each argument has the function
%1474% ! node as parent. Don't look at the first argument which
%1474% ! is the descriptor for the result.
%1474% TMP = .PAE[ARG2PTR];
%1474% INCR I FROM 2 TO .TMP[ARGCOUNT] DO
%1474% BEGIN
%1474% ! Set up QQ which is a global used throughout
%1474% ! phase 2.
%1474% QQ = .TMP[.I,ARGNPTR];
%1474% REA(.QQ);
%1474% END;
%1474% END ! CONCATENATION
TES;
END; ! of REA
ROUTINE REAIO(CLSTCALL)=
BEGIN
!***************************************************************
! Examine the iolstcall, e1listcall, e2listcall for expressions
! to hash. CLSTCALL is a pointer to an i/o list. Walk that
! tree looking for expressions to expunge.
!***************************************************************
MAP BASE CLSTCALL;
LOCAL BASE P;
IF .CLSTCALL[OPRCLS] EQL STATEMENT THEN RETURN;
STHASCMN = 0;
CASE .CLSTCALL[OPERSP] OF SET
BEGIN ! DATACALL - Legal only recursively
P = .CLSTCALL[DCALLELEM];
IF .P[OPRCLS] NEQ DATAOPR THEN
REA(.P)
END; ! DATACALL
BEGIN ! SLISTCALL - Legal only recursively - nothing to do
END; ! SLISTCALL
BEGIN ! IOLSTCALL
P = .CLSTCALL[IOLSTPTR];
WHILE .P NEQ 0 DO
BEGIN
REAIO(.P);
P = .P[SRCLINK];
END;
END; ! IOLSTCALL
BEGIN ! E1LISTCALL - Nothing to do
END; ! E1LISTCALL
BEGIN ! E2LISTCALL - Nothing to do
END; ! E2LISTCALL
TES;
END; ! of REAIO
GLOBAL ROUTINE LOCELMIO(PO)=
BEGIN
!***************************************************************
! Control finding of common sub expressions in the local case
! (only one done for release one) in i/o lists. Called by ELIM.
! Calls REAIO to walk trees
!***************************************************************
REGISTER BASE IOLSTT;
MAP
BASE PO,
BASE BACKST;
IF .BACKST EQL 0 THEN RETURN;
! Reset the linking pointer for local common subs. This
! precludes LOCELMIO from ever being used recursively
! (correctly, that is).
LOCLNK = 0;
! PO points at i/o statement
! There is never a common sub on an i/o statement itself so we
! will zero the field. This also helps make sure the globally
! used fields are cleared.
PO[SRCOPT] = 0;
! Routine does local elimination on IOLSTCALL. May later do it
! for E1LISTCALL and E2LISTCALL
IF .PO[IOLIST] NEQ 0
THEN
BEGIN
IOLSTT = .PO[IOLIST];
WHILE .IOLSTT NEQ 0 DO
BEGIN
IF .IOLSTT[OPRCLS] NEQ STATEMENT
THEN
BEGIN
IF .IOLSTT[OPERSP] EQL IOLSTCALL
THEN
BEGIN
REAIO(.IOLSTT);
LOCLDEPD();
IOLSTT[SRCCOMNSUB] = .BACKST[SRCLINK];
BACKST[SRCLINK] = 0;
LOCLNK = 0
END;
END;
IOLSTT = .IOLSTT[CLINK];
END;
END;
END; ! of LOCELMIO
! The following few routines are utility routines for dealing
! with the expression hash table.
ROUTINE SLINGHASH=
BEGIN
!***************************************************************
! Clean out the expression hash table
!***************************************************************
MAP BASE PAE;
DECR I FROM EHSIZ - 1 TO 0 DO
BEGIN
PAE = .EHASH[.I];
WHILE .PAE NEQ 0 DO
BEGIN
PAE[EMPTY] = 1;
PAE = .PAE[CLINK];
END;
END;
END; ! of SLINGHASH
GLOBAL ROUTINE TBLSRCH=
BEGIN
!***************************************************************
! Look up an expression in the expression hash table. The
! routine HASHIT has filled in the global entry with the proper
! parameters. Returns flag if found 1 else pointer to entry if
! found. Uses globals ENTRY and FLAG. If FLAG is set TPREV
! points to previous entry on list if any, zero if none
!***************************************************************
LABEL LOKER;
MAP PEXPRNODE P;
LOCAL T;
T = ABS(.(ENTRY+2) XOR .(ENTRY+1)) MOD EHSIZ;
EHASHP = EHASH[.T]<0,0>;
IF .EHASH[.T] EQL 0
THEN
BEGIN
FLAG = 0;
TPREV = EHASH[.T]<0,0>;
NEDCOR = 1;
RETURN(.TPREV);
END
ELSE P = .EHASH[.T];
TPREV = .P;
NEDCOR = 0;
LOKER:
DO
BEGIN
IF .P[EMPTY] THEN LEAVE LOKER;
PC = .P+1;
IF @.PC EQL .(ENTRY+1)
THEN
BEGIN
PC = .PC+1;
IF @.PC EQL .(ENTRY+2)
THEN
BEGIN
PC = .PC+1;
IF @.PC EQL .(ENTRY+3)
THEN
BEGIN
FLAG = 1;
RETURN(.P);
END;
END;
END;
TPREV = .P;
P = .P[CLINK];
END UNTIL .P EQL 0;
FLAG = 0;
IF .P EQL 0 THEN NEDCOR = 1;
RETURN(.TPREV);
END; ! of TBLSRCH
GLOBAL ROUTINE MAKETRY(PLACE,CNODE,SHAPE)=
BEGIN
!***************************************************************
! Enters an entry into hash table. PLACE points to where it
! goes, zero means we need core for it
!***************************************************************
OWN PHAZ2 ENTRYP;
MAP
PEXPRNODE CNODE,
PHAZ2 PLACE;
ENTRYP = ENTRY<0,0>;
IF .NEDCOR
THEN
BEGIN
%725% NAME<LEFT> = HSHSIZ;
PLACE = CORMAN();
TPREV[CLINK] = .PLACE;
END
ELSE IF NOT .PLACE[EMPTY] THEN PLACE = .PLACE[CLINK];
! It is possible that place points to a full entry which
! points to an empty entry. Obviously, it is the empty
! entry that we desire to use.
PLACE[USECNT] = 1;
PLACE[EMPTY] = 0;
PLACE[CMNFLGS] = 0;
PLACE[TEMPER] = 0;
PLACE[BLKID] = .ENTRYP[BLKID];
PLACE[HOP] = .ENTRYP[HOP];
PLACE[HA1] = .ENTRYP[HA1];
PLACE[HA2] = .ENTRYP[HA2];
PLACE[HDEF1] = .ENTRYP[HDEF1];
PLACE[HDEF2] = .ENTRYP[HDEF2];
PLACE[LKER] = .CNODE;
%725% ! Save the statement pointer for the first instance of the
%725% ! expression so that we can NEXTUP later on.
%725% PLACE[HSTMNT] = .CSTMNT;
! If this is an arrayref zero the parent(link) field
IF .CNODE[OPRCLS] EQL ARRAYREF THEN CNODE[PARENT] = 0;
! The special case for local common sub-expressions of a single
! variable as a subscript of under a relational. Set TEMPER to
! the module own VARHOLDER for later use in UNRYMATCHER. This
! is the only place where a dataopr should occur.
IF .CNODE[OPRCLS] EQL DATAOPR
THEN PLACE[TEMPER] = .VARHOLDER
ELSE CHKHAIR(.CNODE,.PLACE,.SHAPE); ! Look to see if this
! one contains another
! one.
RETURN .PLACE
END; ! of MAKETRY
MAP
PHAZ2 P,
PHAZ2 QQ,
PHAZ2 P1,
PHAZ2 PO,
PHAZ2 PREV;
GLOBAL ROUTINE DELETE(NOD,NUMB)=
BEGIN
!***************************************************************
! TPREV points to previous node or node itself initially
! depending on if this is the first node in its hash list. NOD
! points to entry in hash table. Link to beginning of empty
! list. The temp T is necessary to insure a correct negative
! value
!***************************************************************
LOCAL TSAVE;
LOCAL T;
MAP PHAZ2 NOD;
LABEL ENDLOK;
T = .NOD[USECNT]-.NUMB;
IF .T LEQ 0
THEN
BEGIN ! If T became unused
NOD[EMPTY] = 1;
NOD[USECNT] = 0;
! If optimizing we may have to reconstruct an an
! arrayref node
IF .FLGREG<OPTIMIZE>
THEN PUTBACKARRAY(.NOD,(IF .NOD[NBRCH] THEN SKEW ELSE STGHT));
PREV = .NOD[CLINK]; ! Prev is a temporary
IF .PREV EQL 0 THEN RETURN;
IF .PREV[EMPTY] THEN RETURN;
! Link out entry that became empty and put it at the end
! of the list. Note that TPREV was set by TBLSRCH to
! point to the entry before NOD.
TSAVE = TPREV[CLINK] = .PREV;
ENDLOK:
WHILE 1
DO
BEGIN ! Look for end of list
TPREV = .PREV;
PREV = .PREV[CLINK];
IF .PREV EQL 0
THEN
BEGIN
TPREV[CLINK] = .NOD;
NOD[CLINK] = 0;
LEAVE ENDLOK;
END
ELSE IF .PREV[EMPTY]
THEN
BEGIN
NOD[CLINK] = .PREV;
TPREV[CLINK] = .NOD;
LEAVE ENDLOK;
END;
END; ! Look for end of list
! Make the hash pointer correctly point to the new first
! element in the linked list in the case the deleted
! element was first
IF @.EHASHP EQL .NOD
THEN EHASH[.EHASHP-EHASH<0,0>] = .TSAVE;
END ! Entry going empty
ELSE NOD[USECNT] = .T; ! Put new count into node
END; ! of DELETE
! Hash node format
!
! -----------------------------------
! * * *
! * USECNT * CLINK *
! * * *
! -----------------------------------
! * * *
! * BLKID * HOP *
! * * *
! -----------------------------------
! * * *
! * HA1 * HA2 *
! * * *
! -----------------------------------
! * * *
! * HDEF1 * HDEF2 *
! * * *
! ------------------------------------
! * * *
! * TEMPER * LKER *
! * * *
! -----------------------------------
! * * *
! * NBRCH * STPT *
! * * *
! -----------------------------------
! * * *
! * HSTMNT * (EMPTY) *
! * * *
! -----------------------------------
! Note: first bit of blkid is 1 if block deleted
ROUTINE LOCLMOV(CNODE)=
BEGIN
!***************************************************************
! Called only in the local common sub-expression elimination
! case. TEMPER in this case points to a common sub- expression
! node. A linked list of such is made at LOCLNK, BACKST points
! to the top of the list.
!***************************************************************
MAP
BASE CNODE,
BASE LOCLNK,
BASE BACKST;
IF .LOCLNK EQL 0
THEN
BEGIN
LOCLNK = .CNODE;
BACKST[SRCLINK] = .CNODE;
END
ELSE
BEGIN
LOCLNK[SRCLINK] = .CNODE;
CNODE[SRCLINK] = 0;
LOCLNK = .CNODE;
END;
END; ! of LOCLMOV
ROUTINE ARGCMN(ANODE,LG)=
BEGIN
!***************************************************************
! LG is local - global switch. ANODE should be either a pointer
! to a cmnsub node (local) or an optimizer created variable
! starting with .O (global) The routine returns 1 if either of
! these conditions is true. If it is returning a one the global
! QQ also contains the omovdcns & usecnt fields of the symbol
! table entry
!***************************************************************
MAP
BASE ANODE,
BASE T;
IF .LG
THEN
BEGIN
IF OPTMP(ANODE)
THEN
BEGIN
QQ<RIGHT> = .ANODE [EXPRUSE];
QQ<LEFT> = .ANODE [OMOVDCNS];
RETURN(1);
END
ELSE RETURN(0)
END
ELSE
BEGIN ! LG = 0 (local)
IF .ANODE[OPRCLS] EQL CMNSUB
THEN
BEGIN
QQ = .ANODE[EXPRUSE];
RETURN(1);
END
ELSE RETURN(0);
END;
END; ! of ARGCMN
ROUTINE LOK1SUBS(CNODE,LG)=
BEGIN
!***************************************************************
! Determine if arg1 of CNODE is a :
! cmnsub node (if LG = 0)
! a .O temporary (if LG = 1)
! This is the controlling case. The real work is done by ARGCMN.
! This routine returns the logical value returned to it by
! ARGCMN.
!***************************************************************
MAP PEXPRNODE CNODE;
RETURN(
CASE .CNODE[OPRCLS] OF SET
ARGCMN(.CNODE[ARG1PTR],.LG); ! BOOLEAN
0; ! DATAOPR
ARGCMN(.CNODE[ARG1PTR],.LG); ! RELATIONAL
0; ! FNCALL
ARGCMN(.CNODE[ARG1PTR],.LG); ! ARITHMETIC
0; ! TYPECNV
0; ! ARRAYREF
0; ! CMNSUB
0; ! NEGNOT
ARGCMN(.CNODE[ARG1PTR],.LG); ! SPECOP
0; ! FIELDREF
0; ! STORCLS
0; ! REGCONTENTS
0; ! LABOP
0; ! STATEMENT
0; ! IOLCLS
ARGCMN(.CNODE[ARG1PTR],.LG); ! INLINFN
%1431% ARGCMN(.CNODE[ARG1PTR],.LG); ! SUBSTRING
%1431% 0 ! CONCATENATION
TES);
END; ! of LOK1SUBS
ROUTINE LOK2SUBS(CNODE,LG)=
BEGIN
!***************************************************************
! Functions exactly the same as LOK1SUBS, except on arg2 of
! CNODE.
!***************************************************************
MAP BASE CNODE;
RETURN(
CASE .CNODE[OPRCLS] OF SET
ARGCMN(.CNODE[ARG2PTR],.LG); ! BOOLEAN
0; ! DATAOPR
ARGCMN(.CNODE[ARG2PTR],.LG); ! RELATIONAL
0; ! FNCALL
ARGCMN(.CNODE[ARG2PTR],.LG); ! ARITHMETIC
ARGCMN(.CNODE[ARG2PTR],.LG); ! TYPECNV
0; ! ARRAYREF
0; ! CMNSUB
ARGCMN(.CNODE[ARG2PTR],.LG); ! NEGNOT
0; ! SPECOP
0; ! FIELDREF
0; ! STORCLS
0; ! REGCONTENTS
0; ! LABOP
0; ! STATEMENT
0; ! IOLCLS
BEGIN ! INLINFN
IF .CNODE[ARG2PTR] NEQ 0 THEN
ARGCMN(.CNODE[ARG2PTR],.LG)
END;
%1431% ARGCMN(.CNODE[ARG2PTR],.LG); ! SUBSTRING
%1431% 0 ! CONCATENATION
TES);
END; ! of LOK2SUBS
ROUTINE DELLNK(CNODE)=
BEGIN
!***************************************************************
! Remove common sub-expression CNODE from the linked list of
! same headed by BACKST.
!***************************************************************
MAP
BASE BACKST,
BASE PREV,
BASE P1,
BASE CNODE;
! Initialize things
PREV = .BACKST;
P1 = .BACKST[SRCLINK];
! Look through the list
WHILE .P1 NEQ 0 DO
BEGIN
IF .P1 EQL .CNODE
THEN
BEGIN
PREV[SRCLINK] = .CNODE[SRCLINK];
RETURN;
END;
PREV = .P1;
P1 = .P1[SRCLINK];
END;
END; ! of DELLNK
ROUTINE LOCLDEPD=
BEGIN
!***************************************************************
! Examine linked list of common sub-expressions. BACKST is the
! head of the list. Expressions are ordered from the bottom - up
! in the tree sense. This is the controlling routine for the
! general process. Determine if each expression has other
! common-subs under it. If so, look these up in the hash table.
! If the use count of the subordinate equals the usecnt of the
! parent, then remove the little one, and its common
! sub-expression node.
!***************************************************************
OWN PEXPRNODE EXPR;
MAP
BASE T,
BASE PAE,
BASE BACKST;
EXPR = .BACKST[SRCLINK];
! For each expression on the list
WHILE .EXPR NEQ 0 DO
BEGIN
IF .EXPR[A2VALFLG]
THEN HASHIT(.EXPR[ARG2PTR],UNARY)
ELSE HASHIT(.EXPR[ARG2PTR],STGHT);
! Look up the expression in the hash table
PHI = TBLSRCH();
! If there are common subs under it
IF .PHI[CMNUNDER]
THEN
BEGIN
! Look at each arg of the expression. First
! look at real expression
PAE = .EXPR[ARG2PTR];
! LOK1SUBS and LOK2SUBS return 1 if we are
! interested in this one and the use count in
! the global QQ
IF LOK1SUBS(.PAE,0) THEN
IF .QQ EQL .PHI[USECNT]
THEN
BEGIN
T = .PAE[ARG1PTR];
PAE[ARG1PTR] = .T[ARG2PTR];
! Reset valflgs
PAE[A1VALFLG] = 0;
DELLNK(.T);
! Also fix parent
T = .PAE[ARG1PTR];
T[PARENT] = .PAE;
END;
IF LOK2SUBS(.PAE,0) THEN
IF .QQ EQL .PHI[USECNT]
THEN
BEGIN
T = .PAE[ARG2PTR];
PAE[ARG2PTR] = .T[ARG2PTR];
! Reset valflg
PAE[A2VALFLG] = 0;
DELLNK(.T);
! Fix parent too
T = .PAE[ARG2PTR];
T[PARENT] = .PAE;
END;
END;
EXPR = .EXPR[SRCLINK];
END; ! While
! Cleanup the expression nodes that have expruse left in them
EXPR = .BACKST[SRCLINK];
WHILE .EXPR NEQ 0 DO
BEGIN
EXPR[EXPRUSE] = 0;
EXPR = .EXPR[SRCLINK];
END;
! Also go thru the hash table and mark the entries empty
SLINGHASH();
END; ! of LOCLDEPD
END
ELUDOM