Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-compiler/comsub.bli
There are 12 other files named comsub.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: NORMA ABEL/HPW/DCE/SJW
MODULE COMSUB(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
GLOBAL BIND COMSUV = 6^24 + 0^18 + 270; ! Version Date: 24-Jul-81
%(
***** 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)
***** 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. FLGRG<OPTIMIZE>=1; GLOBAL CASE
! FLGRG<OPTIMIZE>=0; LOCAL CASE
! TESTS ON THESE ARE MADE INTERCHANGABLY. THE
! TWO WAYS ARE PRESENT FOR HISTORIC REASONS.
EXTERNAL CORMAN,LENTRY,QQ,TOP,BOTTOM,TPREV,CSTMNT;![725]
MAP PEXPRNODE LENTRY;
EXTERNAL GETOPTEMP;
FORWARD TBLSRCH,DELETE,MAKETRY,XPUNGE;
EXTERNAL PHI;
OWN P,PAE,PB,PA,PC,PO,T;
EXTERNAL EHASHP;
EXTERNAL LOCLNK;
OWN P1,P2;
MAP PEXPRNODE P1:P2;
MAP PEXPRNODE P:PHI:PAE:PA:PB:PC:QQ:PO;
EXTERNAL MAKEPR;
MAP PHAZ2 TPREV;
EXTERNAL GLOBMOV,GLOBDEPD,CHKINIT,DOTOHASGN;
FORWARD HASHIT,LOCLMOV,LOCLDEPD;
OWN 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).
EXTERNAL NAN;
OWN TS, !TEMP USED THROUGH OUT
VARHOLDER, !USED IN SPECIAL LOCAL CASES SEE UNRYMATCHER
NEDCOR; !FLAG SET BY TBLSRCH TO INDICATE IF THE
!HASH TABLE HAS A FREE REUSABLE SPACE OR
!CORE IS NEEDED FOR THE ENTRY. 1=LATTER.
EXTERNAL ARGCONE;
EXTERNAL NEWCOPY,A2ARREF,A1ARREF;
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;
MAP PHAZ2 PHI;
EXTERNAL PUTBACKARRAY;
!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 TEMP IN THE GLOBAL CASE.
!IN BOTH CASES PHI[TEMPER] IS SET CORRECTLY AND RETURNED.
!IF DOING AN ARRAY REFERENCE PICK UP THE TO THE HASH TABEL
!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 SUBEXPRSSSION.
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
!MULTIPLE, DIVIDE,EXPONENTIATE
BEGIN
PAE[A1NEGFLG]_0;
PAE[A2NEGFLG]_0;
END;
END;
IF NOT .FLGREG<OPTIMIZE> THEN
BEGIN
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 ELSE !GLOBAL CASE
BEGIN
IF .ARREFCMNSBFLG THEN
BEGIN
NOHHASSLE_1;
!TAKE CARE OF POTENTIAL ARRAY REFERENCES
!WE KNOW THE SHAPE IF THE FIRST EXPRESSION BUT
!THIS DOES NOT RELATE (NECESSARILY) TO PAE
!SO WE WILL EXPLICITLY EXAMINE PAE TO PUT THE
!ARAYREF BACK.
IF (P_.PAE[ARG1PTR]) NEQ 0 THEN
!IS IT THE ARRAYREF HASH ENTRY
!COINCIDENCE BETWEEN HOP AND OPRCLS MAKES
!THIS TEST POSSIBLE
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
BEGIN
IF (P_.PAE[ARG2PTR]) NEQ 0 THEN
IF .P[OPRCLS] EQL ARRAYREF THEN
PAE[ARG2PTR]_NEWCOPY(.P,.PAE);
END;
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 ENTIRE HASH ENTRY SO CAN DO FINDPA FOR FINDTHESPOT
GLOBMOV (.PAE, .PHI, .P);
END;
.PHI[TEMPER]
END;
EXTERNAL FINDTHESPOT;
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 GLOABL 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 THAT (WHILE WALKING ANOTHER TREE)
!THE WHOLE THING COLLAPSES UPWARD AS A COMMON-SUB.
EXTERNAL SKERR;
MAP BASE QQ:TS:CNODE;
QQ_.CNODE[PARENT];
!CHECK FOR ERROR
IF .QQ EQL 0 THEN SKERR();
!SEE IF IT NARY
IF .QQ [OPR1] NEQ .CNODE [OPR1]
THEN RETURN;
IF .QQ [A2VALFLG]
THEN BEGIN
!NOW ITS NARY CHECK FOR B OP B OP B
IF (.CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]) AND
(.CNODE[ARG2PTR] EQL .QQ[ARG2PTR]) THEN
!GET THE #$$$() OUT
RETURN;
HASHIT(.QQ,SKEW);
TS_TBLSRCH();
!IF ITS 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;
!IF /OPT, MUST CHECK IF EXPR 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;
ROUTINE NARY2(CNODE)=
!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 OF
!ANYTHING OP A AND B OP ANYTHING, AT THE SAME TIME
!BEING CAREUL NOT TO *MESS-UP* B OP B OP B OP B OP B.
BEGIN
OWN BSAMEFLG;
MAP BASE TS;
MAP 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 USE COUNT BY 1
!SET UP HASH KEY
HASHIT(.QQ,.SHAPE);
!DO TABLE LOOKUP
TS_TBLSRCH();
!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;
QQ_.CNODE[ARG1PTR];
!FIRST DECIDE IF THIS IS A OP A. IT IS A PROPBLEM, 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
BEGIN
IF .TS[A1ARY] OR .TS[A2ARY] THEN
DELETE(.TS,1);
END;
END;
BOPBOPB(SKEW);
END;
END;
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;
!
!********************************************
!
%*********************************
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)$;
MACRO ARGS1(NOD)=
IF .NOD[A1VALFLG] THEN XPUNGE(.NOD,UNARY)$;
MACRO ARGS2(NOD)=
IF .NOD[A2VALFLG] THEN XPUNGE(.NOD,UNARY)$;
FORWARD CHKHAIR,REA,CMNLNK;
ROUTINE NEXTUP(EXPR)=
BEGIN
!CASE STATEMENT CONTROL ON LOOKING AT THE NEXT EXPRESSION
!UP AFTER A MATCH.
MAP BASE EXPR;
EXTERNAL BASE QQ;
EXTERNAL A1ARREF, A2ARREF;
IF .EXPR EQL 0 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 SPECAIL CASE.
!WE WILL CALL XPUNGE DIRECTLY TO PREVENT THIS
IF .EXPR[A1VALFLG] AND .EXPR[A2VALFLG] THEN XPUNGE(.EXPR,STGHT);
!FNCALL
IF ARGCONE(.EXPR) THEN XPUNGE(.EXPR,UNARY);
BEGIN !ARITHMETIC
!GET THE OBVIOUS STRAIGHT CASE
ARGSBOTH(EXPR)
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;
END;
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'T NEXTUP ARRAYREF IF INSIDE IOLIST
IF .MOM [OPRCLS] EQL IOLSCLS
THEN RETURN;
! FIND TREE SHAPE & CALL XPUNGE
IF .MOM [ARG1PTR] EQL .EXPR
THEN A1ARREF (.MOM)
ELSE 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
TES;
END;
EXTERNAL REPLACARG;
ROUTINE UNRYMATCH(CNODE,NAN,PHI)=
BEGIN
!FIXES UP (PERFORMS MATCHER FUNCTIONS ) FOR A UNARY SHAPE
!(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:PHI;
!GET OUT IF ITS 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 TEMP.
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 A 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
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 TEMP
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, CUZ QQ WILL POINT TO
!THE RELATIONAL OR ARRAYREF.
IF .CNODE[OPRCLS] EQL DATAOPR THEN
ELSE
NEXTUP(.QQ);
END 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;
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 UNLESS OTHERWISE PREVENTED ENTER INTO THE
!HASH TABLE CMN(A OP A) OP A. 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. 0 IS RETURNED IF THE ENTRY IS OK
!1 IF NOT.
MAP PEXPRNODE CNODE:TS;
IF NOT .CNODE[A1VALFLG] THEN
BEGIN
!THE TREE MUST BE SKEWED.
TS_.CNODE[ARG1PTR];
!CHECK FOR A OP A
IF .TS[ARG2PTR] EQL .CNODE[ARG2PTR] THEN
BEGIN
!IF ARG1 IS THE NODE WERE SUBSTITUTING THEN
!THIS IS THE BAD CASE.
IF .TS[ARG1PTR] EQL .T THEN
RETURN(1);
END;
END;
END;
ROUTINE MATCHER(CNODE,SHAPE,NAN,PHI)=
!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 PICRURES OF THE TREE SHAPES
!NAN IS NEEDS A NEGATIVE(NEGATION)
BEGIN
EXTERNAL OLDHEAD;
MAP PHAZ2 CNODE:PHI:T;
!GO TO SPECIAL ROUTINE IF SHAPE IS UNARY
IF .SHAPE EQL UNARY THEN
BEGIN
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
PHI[USECNT]_2;
IF .SHAPE EQL SKEW THEN !SKEWED TREE
BEGIN
!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;
!GET OUT
RETURN;
END;
NARY2(.CNODE); !PRECLUDE TRIPLES ELIMINATED BY MATCH
IF .PHI[NBRCH] THEN !ENTRY IN HASH TABLE IS ALSO SKEWED
BEGIN
QQ_.CNODE[ARG1PTR];
PB_MAKEPR(.CNODE[OPRCLS], !MAKE A STRAIGHT ONE
.CNODE[OPERSP],
.CNODE[VALTYPE],
.QQ[ARG2PTR],
.CNODE[ARG2PTR]);
PB[DEFPT1]_.QQ[DEFPT2];
PB[DEFPT2]_.CNODE[DEFPT2];
PB[A1FLGS]_.QQ[A2FLGS];
PB[A2FLGS]_.CNODE[A2FLGS];
NARY2(.PHI[LKER]); !ELIMINATE TRIPLES PRECLUDED BY MATCH
T_CMNMAK(.PB,.NAN,.PHI); !MAKE A CMN SUB
PC_.PHI[LKER];
PB[PARENT]_.PC[PARENT];
PHI[LKER]_.PB;
END ELSE
BEGIN
!CALL STPRECLUDE BEFORE CMNMAK CHANGES NEG FLAGS SO HASH IN
! STPRECLUDE CAN FIND THE SKEW PIECE OF TREE
!PRECLUDE IF NECESSARY
STPRECLUDE(.PHI[LKER]);
T_CMNMAK(.PHI[LKER],.PHI[NEDSANEG],.PHI); !MAKE A CMNSUB
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;
!FIX UP EXPRESSION PTRS
!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] BEFORE WE NEXTUP, BE SURE THAT CSTMNT POINTS TO THE STATEMENT
![725] WHICH CONTAINS THE ORIGINAL INSTANCE OF THE EXPRESSION.
![725] THIS WAS CAREFULLY SAVED IN THE HASH ENTRY WHEN IT WAS MADE.
%[725]% BEGIN
%[725]% LOCAL SAVCSTMNT; !SAVE CSTMNT SO WE CAN 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 ELSE
PHI[USECNT]_.PHI[USECNT]+1; !USECNT ATR 1
!IF THIS IS A SKEWED TREE DELETE
!HASH ENTRIES PRECLUDED BY THIS MATCH
IF .SHAPE EQL SKEW THEN
NARY2(.CNODE)
ELSE
STPRECLUDE(.CNODE);
T_.PHI[TEMPER]; !POINT TO TEMP FOR SUBSTITUTION
!LINK UP THE COMMON SUB EXPRESSION (CURRENT ONE)
CMNLNK(.T,.CNODE,.SHAPE,.NAN,.PHI);
END; !MATCHER
!*********************************
ROUTINE CMNLNK(T,CNODE,SHAPE,NAN,PHI)=
BEGIN
EXTERNAL LOKCALST,BACKST,ARGCONE;
!LINK UP THE COMMON SUB-EXPRESSION IN ITS PLACE
MAP PHAZ2 QQ;
MAP BASE CNODE:PHI:T;
EXTERNAL MAKPR1,SETNEG,SAVSPACE;
EXTERNAL CHOSEN,GLOBREG,ITMCT,SPECCASE;
OWN OLDT,NEGT;
LABEL ADJCTL;
T[EXPRUSE]_.PHI[USECNT];
!INITIALIZE FLAG TO 0
FLAG_0;
IF .SHAPE EQL SKEW THEN
BEGIN
![715] BOTH NEG AND NOT FLAGS HAVE BEEN USED IN THE COMMON SUB-EXPRESSION
![715] SO TURN THEM BOTH OFF IN THE MAIN 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 LOOKSE LIKE THIS
! *(CNODE)
! * *
!*(QQ) *(JUST BECOME 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 FLGS
!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 ARG1FLGS 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 ELSE
BEGIN
!HERE, ONCE AGAIN, WE HAVE THE SPECAIL 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
!SAVE VALUE OF T
OLDT_.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 CASE9
!DONT SET THE PARENT TO T. DONT 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 SETNEG(.QQ,0) THEN ELSE
(T_.NEGT;FLAG_1;);
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 (T_.NEGT;FLAG_1;);
AG_.QQ[ARG2PTR];
!SET UP PARMS INCASE WE HAVE
!TO CALL LEAFSUBSTITUTE TO LOCATE IT
ITMCT_1;
GLOBREG[0]_.CNODE;
CHOSEN[0]_.T;
SPECCASE_0;
LOKCALST(.AG,.AG[ARGCOUNT],.CNODE,.T);
!PUT DEFINITION POINT INTO NODE IF
!APPROPRIATE
IF ARGCONE(.QQ) THEN
QQ[DEFPT2]_.PHI[STPT];
END ELSE
!IF THIS IS AN IOLSCLS NODE, WE HAVE TO BE VERY CAREFUL
! WITH WHERE WE TIE IN THE POINTER!
IF .QQ[OPRCLS] EQL IOLSCLS THEN
BEGIN
IF .NAN THEN (T_.NEGT; FLAG_1);
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 SETNEG(.QQ,1) THEN ELSE
(T_.NEGT;FLAG_1;);
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 SETNEG(.QQ,0) THEN ELSE
(T_.NEGT;FLAG_1;);
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 TYPR BOOLEAN WE HAVE TO CHANGE IT
!TO CONTROL, CUZ CODE GENERATION CANNOT HANDLEE
!A VALUE UNDER A BOOLEAN OR TYPE CONTROL
T_.QQ;
ADJCTL:
WHILE .T[OPRCLS] EQL BOOLEAN AND .T[VALTYPE] EQL CONTROL
DO
BEGIN
!CHANGE TO LOGICAL
T[VALTYPE]_LOGICAL;
!LOOK AT NEXT PARENT
T_.T[PARENT];
!CHECK FOR ORPHAN
IF .T EQL 0 THEN LEAVE ADJCTL;
END;
!RESTORE NODE SPACE FREED, IF ANY
IF .NAN THEN
IF .FLAG THEN ELSE 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;
.QQ
END;
ROUTINE CHKHAIR(CNODE,PHI,SHAPE)=
BEGIN
LOCAL BASE ARGNODE;
!
!CHECK NODE FOR HAVING ANOTHER COMMON SUB-EXPRESSION UNDER IT
!IF IT DOES SET CMNUNDER FLAG IN HASH TABLE NODE.
EXTERNAL TOP,LENTRY;
MAP BASE TOP:PA;
MAP PEXPRNODE CNODE: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$;
MACRO CHKBOTH=
BEGIN
ARG2CHK;
IF .SHAPE EQL SKEW THEN
BEGIN
CNODE_.CNODE[ARG1PTR];
ARG2CHK;
END ELSE
ARG1CHK;
END$;
CASE .CNODE[OPRCLS] OF SET
!BOOLEAN
BEGIN
CHKBOTH;
END;
!DATAOPR
RETURN;
!RELATIONAL
BEGIN
CHKBOTH;
END;
!FNCALL
RETURN;
!ARITHMETIC
BEGIN
CHKBOTH;
END;
!TYPCNV
ARG2CHK;
!ARRAYREF
RETURN;
!CMNSUB
RETURN;
!NEGNOT
ARG2CHK;
!SPECOP
ARG1CHK;
!FIELDREF
RETURN;
!STORECLS
RETURN;
!RECONTENTS
RETURN;
!LABOP
RETURN;
!STATEMENT
RETURN;
!IOLSCLS
RETURN;
!INLINFN
BEGIN
ARG1CHK;
IF .CNODE[ARG2PTR] NEQ 0 THEN
ARG2CHK;
END
TES;
END;
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 TALLY;
GLOBAL ROUTINE HASHIT(CNODE,SHAPE)=
BEGIN
EXTERNAL LOOPNO,REDEFPT;
OWN PHAZ2 ENTRYP;
MAP PHAZ2 CNODE;
!CREATE HASH TABLE ENTRY FOR LOOKUP; THE GLOBAL ENTRY IS USED.
!ENTRY IS FILLED WITH THE HASH KEY ELEMENTS. THESE ARE
!THE OPERATOR, ARGUMENTS(S) AND DEFINITION POINTS.
!THE MACROS PRECEEDING THIS ROUTINE HELP ASSURE THAT
!ARGUMENTS ARE IN THEIR PROPER ORDER.
!NODE:*******NO DOT ON ASSIGNMENT TO ENTRYP
ENTRY_0; ENTRYP_ENTRY;
ENTRY+1_0;
NAN_0;
IF .FLGREG<OPTIMIZE> AND NOT .IMPLDO THEN
REDEFPT(.CNODE,.SHAPE);
ENTRYP[BLKID]_.LOOPNO;
CASE .SHAPE OF SET
!
!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.
BEGIN
!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
!IT IS NOT THE LOCAL SPECIAL CASE
!SEE IF ITS AN ARRAYREF (GLOBAL ONLY)
IF .CNODE[OPRCLS] EQL ARRAYREF THEN
BEGIN
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
!NOT AN ARRAYREF, TRY FUNCTION REFERENCE
IF .CNODE[OPRCLS] EQL FNCALL THEN
BEGIN
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
!NOT A FUNCTION CALL EITHER. CHECK FOR
!SPECIAL OPERATOR
IF .CNODE[OPRCLS] EQL SPECOP THEN
BEGIN
IF .CNODE[A1NEGFLG] THEN
NAN_1;
ENTRYP[HOP]_.CNODE[OPERATOR]+.CNODE[A1NOTFLG];
REGARG;
END ELSE
!NOW TREAT EVERYONE THE SAME
!(TYPECNV AND NEGNOT
BEGIN
IF .CNODE[A2NEGFLG] THEN NAN_1;
ENTRYP[HOP]_.CNODE[OPERATOR]+.CNODE[A2NOTFLG];
REGARG;
END;
END;
!
!STRAIGHT
!
! OP
! * *
! * *
!DATA DATA
BEGIN
IF .CNODE[OPRCLS] EQL ARITHMETIC THEN
BEGIN
!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
!ADDS ARE A SPECIAL CASE
BEGIN
!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 ARGS 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 !ARGS ARE ALREADY IN RIGHT ORDER
BEGIN
REGARG;
END;
END ELSE !END OF ADD OPERATION CASE
BEGIN
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 !ARGS IN PRDER
BEGIN
REGARG;
END;
END ELSE !NOT A MULTIPLY
BEGIN
REGARG;
END;
END; !END OF NOT ADD BUT STILL ARITHMETIC
END ELSE !END OF ARITHMETIC
![644] IN LINE FUNCTIONS SHOULD BE TREATED SEPARATELY FROM OTHER
![644] NON ARITHMETIC CASES WHICH DEPEND MORE HEAVILY ON NOT FLAGS.
![644] IN PARTICULAR, WE NEED TO HASH DIFFERENTLY SO THAT THE NEG
![644] FLAGS ARE DEFINITELY TAKEN INTO ACCOUNT FOR CSE.
%[644]% IF .CNODE[OPRCLS] EQL INLINFN THEN
%[644]% BEGIN
%[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; !END OF STRAIGHT CASE
!
!SKEWED TREES
!
! OP(CNODE)
! * *
! * *
!OP(QQ) DATA
! *
! *
! DATA
!
BEGIN
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 !AN ADD
ENTRYP[HOP]_.CNODE[OPERATOR]+.TALLY
+.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG]^2;
!TALLY AND A NEGATE (GLAG) 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 !THEY DONT NEED SWITCHING
BEGIN
SREGARG;
END;
END ELSE !NOT AN ADD
BEGIN
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 !NOT MULTIPLY
BEGIN
SREGARG;
END
END;
END ELSE !END ARITHMETIC
BEGIN !NOT ARITHMETIC
ENTRYP[HOP]_.CNODE[OPERATOR]
!CHECK ON THE CORRECT FLAGS FOR HASHING UNIQUELY
+.QQ[A2NOTFLG]^1+.CNODE[A2NOTFLG];
SREGARG;
END;
END !END SKEWED TREE CASE
TES;
END; !HASHIT
!****************************************
EXTERNAL CHKDOMINANCE;
ROUTINE XPUNGE(CNODE,SHAPE)=
BEGIN
LABEL FIND;
%[731]% EXTERNAL SAVSTMNT;
EXTERNAL BACKST;
!TREE HAS BEEN WALKED TO THE LEAF*OPERATOR*LEAF
!POINT. THE EXPRESSION WILL NOW BE HASHED, ETC.
MAP PEXPRNODE CNODE;
!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.
IF .BACKST NEQ 0 OR .IMPLDO THEN !LOCAL CASE OR
!I/O OPTIMIZER CASE
BEGIN
!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 STMNT, THEN AVOID HASHING IF EITHER OF THE
![731] DEFINITION POINTS ARE ON THE STATEMENT ITSELF. THIS IS THE
![731] 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 (CN_.CNODE[ARG1PTR];
DF1_.CN[DEFPT2]);
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
END
END
END ELSE CHKDOMINANCE(.CNODE,.SHAPE); !GLOBAL CASE
END;
!
!****************************************************
!
!
!***************************************************
!
FORWARD LOCELMIO;
ROUTINE ELIM(STMT)=
BEGIN
MAP PHAZ2 STMT;
EXTERNAL IOGELM; !WALK I/O LISTS <IOPT>
EXTERNAL IOCLEAR; !COLLAPSE I/O LISTS IF GCALLSLFLG IS SET
EXTERNAL CSTMNT,BACKST,TOP,LEND,LOOP;
MAP BASE TOP;
MAP BASE BACKST;
!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.
!ASSIGNMENT STATEMENTS
IF .STMT[SRCID] EQL ASGNID THEN
BEGIN
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;
!LOGICAL IF
IF .STMT[SRCID] EQL IFLID THEN
BEGIN
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;
!DO STATEMENT
IF .STMT[SRCID] EQL DOID THEN
BEGIN
REA(.STMT[DOLPCTL]);
END;
!ARITHMETIC IF
IF .STMT[SRCID] EQL IFAID THEN
BEGIN
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; !ELIM
!
!***************************************************
!
!
EXTERNAL BACKST; MAP PEXPRNODE BACKST;
!
OWN SAVCSTMNT;
GLOBAL ROUTINE LOCELIM(STMT)=
BEGIN
EXTERNAL CSTMNT,LOOPNO;
MAP PEXPRNODE STMT:CSTMNT;
!************************************
!CONTROL FOR LOCAL COMMONSUB-EXPRESSION ELIMINATION
!**************************************
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;
!
!********************************************************
!
EXTERNAL EHASH;
ROUTINE REA(STKPAE)=
!PAE IS AN EXPRESSION POINTER
BEGIN
!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.
EXTERNAL FNARRAY;
REGISTER PHAZ2 PAE;
PAE_.STKPAE;
STHASCMN_1;
CASE .PAE[OPRCLS] OF SET
!
!BOOLEAN
!
BEGIN
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];
IF .QQ[OPERATOR] EQL .PAE[OPERATOR]
AND !N-ARY WITH LEAVES
.QQ[A2VALFLG] AND .PAE[A2VALFLG]
AND NOT .QQ[PARENFLG] THEN
XPUNGE(.PAE,PSKEW);
END; !ELSE PART SKEWED TREE
END; !BOOLEAN CLASS OPERATORS
!
!DATAOPR
!
RETURN; !DO NOTHING
!
!RELATIONAL
!
BEGIN
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
!LOCAL CASE TEST OB 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;
!
!FNCALL - FUNCTION CALL
!
BEGIN
LOCAL ARGUMENTLIST TMP;
!STEP THROUGH ARGUMENTS. EACH ARGEUMENT HAS THE FUNCTION
!NODE AS PARENT
TMP_.PAE[ARG2PTR];
INCR I FROM 1 TO .TMP[ARGCOUNT] DO
BEGIN
QQ_.TMP[.I,ARGNPTR];
REA(.QQ);
END;
!IF OPTIMIZING GO OFF AND TRY FOR ARRAY REFS TOO
IF .FLGREG<OPTIMIZE> THEN
BEGIN
FNARRAY(.PAE);
RETURN;
END;
!!TRY TO ELIMINATE LIBRARY FUNCTIONS WITH 1 ARGUMENT
IF ARGCONE(.PAE) THEN XPUNGE(.PAE,UNARY);
END; !FNCALL
!
!ARITHMETIC
!
BEGIN
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
IF .FLGREG<OPTIMIZE> AND
![701] CANNOT SWAP ARGUMENTS UNLESS OPERATION IS + OR *
%[701]% ADDORMUL(PAE)
THEN BEGIN ! X OP .R -> .R OP X
MACRO IDDOTR = 0,3,24,12$;
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 !N-ARY WITH LEAVES
.QQ[A2VALFLG] AND .PAE[A2VALFLG] THEN
XPUNGE(.PAE,PSKEW);
!LOOK DOWN ONCE MORE
IF .PAE[A1VALFLG] AND .PAE[A2VALFLG] THEN
XPUNGE(.PAE,STGHT);
END;
END;
!
!TYPCNV
!
BEGIN
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);
END;
!
!ARRAYREF
!
BEGIN
IF .PAE[ARG2PTR] EQL 0 THEN RETURN;
IF .PAE[A2VALFLG] AND .BACKST NEQ 0 THEN
!SPECIAL CASE FOR LOCAL ONLY
BEGIN
VARHOLDER_.PAE;
QQ_.PAE[ARG2PTR];
!ITS A NON-CONSTANT LEAF. CONSTANT LEAVES SHOULD HAVE
!BEEN FOLDED INTO THE OFFSET.
IF .QQ[OPRCLS] EQL DATAOPR AND .QQ[OPERSP] NEQ CONSTANT THEN
!THE NEG AND/OR NOT FLAGS CANNOT BE SET.
!WE ARE NOT PREPARED TO HASH THEM. IN
!GENERAL THIS WILL NOT PREVENT MUCH CUZ THE
!FLAGS DONT MAKE A LOT OF SENSE ON THE SUBSCRIPT
!ANYWAY.
IF NOT .PAE[A2NEGFLG] AND NOT .PAE[A2NOTFLG] THEN
XPUNGE(.QQ,UNARY);
END ELSE
REA(.PAE[ARG2PTR]);
END;
!
!CMNSUB
!
RETURN; !SHOULDNT HAPPEN
!
!NEGNOT
!
BEGIN
IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);
END;
!
!SPECOP
!
BEGIN
IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
IF .PAE[A1VALFLG] THEN XPUNGE(.PAE,UNARY);
END;
!
!FIELDREF
!
RETURN; !NOT IN RELEASE 1
!
!STORECLS
!
RETURN;
!
!REGCONTENTS
!
RETURN;
!
!LABOP
!
RETURN;
!
!STATEMENT
!
RETURN;
!
!IOLSCLS
!
RETURN; !SEE REAIO
!
!INLINFN
!
BEGIN
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;
TES;
END;
ROUTINE REAIO(CLSTCALL)=
BEGIN
!EXAMINE THEN 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
!DATACALL
BEGIN !LEGAL ONLY RECURSIVELY
P_.CLSTCALL[DCALLELEM];
IF .P[OPRCLS] NEQ DATAOPR THEN
REA(.P)
END;
!
!SLISTCALL
BEGIN !LEGAL ONLY RECURSIVELY
!NOTHING TO DO
END;
!
!IOLSTCALL
BEGIN
P_.CLSTCALL[IOLSTPTR];
WHILE .P NEQ 0 DO
BEGIN
REAIO(.P);
P_.P[SRCLINK];
END;
END;
!
!E1LISTCALL
; !RELEASE >1
!E2LISTCALL
; !RELEASE >1
TES;
END; !REAIO
GLOBAL ROUTINE LOCELMIO(PO)=
!CONTROL FINDING OF COMMON SUB EXPRESSIONS IN THE LOCAL CASE
!(ONLY ONE DONE FOR RELEASE ONE) IN I/O LISTS. CALLED BU ELIM.
!CALLS REAIO TO WALK TREES
BEGIN
MAP BASE PO;
REGISTER BASE IOLSTT;
EXTERNAL BACKST;
MAP BASE BACKST;
IF .BACKST EQL 0 THEN RETURN;
!RESET THE LINKING POINTER FOR LOCAL GOMMON SUBS.
!THIS PRECLUDES LOCELMIO FROM EVER BEING USED RECURSIVELY
!(CORRECTLY, THAT IS).
LOCLNK_0;
!PO POINTS AT IO STATEMENT
!IN RELEASE 1 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 (RELEASE 1)
!E1LISTCALL AND E2LISTCALL (RELEASE >1)
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;
!THE FOLLOWING FEW ROUTINES ARE UTILITY ROUTINES FOR DEALING WITH
!THE EXPRESSION HAS 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;
GLOBAL ROUTINE TBLSRCH=
BEGIN
LABEL LOKER;
MAP PEXPRNODE P;
LOCAL T;
!LOOK UP AN EXPRESSION IN THE EXPRESSION HASH TABLE.
!THE ROUITNE 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
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; !EQL 0
FLAG_0;
IF .P EQL 0 THEN
NEDCOR_1;
RETURN(.TPREV);
END;
OWN THISBLK,MOREFLG;
GLOBAL ROUTINE MAKETRY (PLACE,CNODE,SHAPE)=
BEGIN
EXTERNAL LOOPNO;
OWN PHAZ2 ENTRYP;
MAP PEXPRNODE CNODE;
MAP PHAZ2 PLACE;
!ENTERS AN ENTRY INTO HASH TABLE
!PLACE POINTS TO WHERE IT GOES
!ZERO MEANS WE NEED CORE FOR IT
ENTRYP_ENTRY<0,0>;
IF .NEDCOR THEN
BEGIN
%[725]% NAME<LEFT>_HSHSIZ; PLACE_CORMAN();
TPREV[CLINK]_.PLACE;
END ELSE
!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.
IF NOT .PLACE[EMPTY] THEN PLACE_.PLACE[CLINK];
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
!LOOK TO SEE IF THIS ONE CONTAINS ANOTHER ONE.
CHKHAIR(.CNODE,.PLACE,.SHAPE);
.PLACE
END;
EXTERNAL PREV;
MAP PHAZ2 P:QQ:P1:PO:PREV;
GLOBAL ROUTINE DELETE(NOD,NUMB)=
BEGIN
EXTERNAL PUTBACKARRAY;
LOCAL TSAVE;
LOCAL T;
MAP PHAZ2 NOD;
!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
LABEL ENDLOK;
T_.NOD[USECNT]-.NUMB;
!IF IS BECAME UNUSED
IF .T LEQ 0 THEN
BEGIN
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 TEMP
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 !LOOK FOR END OF LIST
BEGIN
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;
IF @.EHASHP EQL .NOD THEN
!MAKE THE HASH POINTER CORRECTLY POINT TO
! THE NEW FIRST ELEMENT IN THE LINKED LIST
! IN THE CASE THE DELETED ELEMENT WAS FIRST
EHASH[.EHASHP-EHASH<0,0>]_.TSAVE;
END !ENTRY GOING EMPTY
ELSE !PUT NEW COUNT INTO NODE
NOD[USECNT]_.T;
END;
!HASH NODE
!
! -----------------------------------
! * * *
! * USECNT * CLINK *
! * * *
! -----------------------------------
! * * *
! * BLKID * HOP *
! * * *
! -----------------------------------
! * * *
! * HA1 * HA2 *
! * * *
! -----------------------------------
! * * *
! * HDEF1 * HDEF2 *
! * * *
!------------------------------------
! * * *
! * TEMPER * LKER *
! * * *
! -----------------------------------
! * * *
! * NBRCH * STPT *
! * * *
! -----------------------------------
! * * *
! * HSTMNT * (EMPTY) *
! * * *
! -----------------------------------
! 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;
MAP BASE LOCLNK: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;
!
!
!
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
EXTERNAL QQ;
MAP BASE ANODE: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 !LG=0(LOCAL)
BEGIN
IF .ANODE[OPRCLS] EQL CMNSUB THEN
BEGIN
QQ_.ANODE[EXPRUSE];
RETURN(1);
END
ELSE
RETURN(0);
END;
END;
ROUTINE LOK1SUBS(CNODE,LG)=
BEGIN
!DETERMINE IF ARG1 OF CNODE IS A :
! CMNSUB NODE (IF LG=0)
! A .O TEMP (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
TES);
END;
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
TES);
END;
ROUTINE DELLNK(CNODE)=
BEGIN
!REMOVE COMMON SUB-EXPRESSION CNODE FROM THE LINKED LISTOF
!SAME HEADED BY BACKST.
EXTERNAL BACKST;
MAP BASE BACKST:PREV:P1: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;
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 UBDER IT
! IF SO, LOOK THESE UP IN THE HASH TABLE.
! IF THE USE COUNT OF THE SUBORDINATE = THE USECNT OF
! THE PARENT, THEN REMOVE THE LITTLE ONE, AND ITS
! COMMON SUB-EXPRESSION NODE.
OWN PEXPRNODE EXPR;
MAP BASE T:PAE;
EXTERNAL BACKST;
MAP 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;
END
ELUDOM