Google
 

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