Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-BB_1985_short - comsub.bli
There are 12 other files named comsub.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!AUTHOR: NORMA ABEL/HPW/DCE/SJW/TFV/MEM/TJK/CDM

MODULE COMSUB(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN



GLOBAL BIND COMSUV = #10^24 + 0^18 + #2507;	! Version Date:	21-Dec-84

%(

***** Begin Revision History *****

198	-----	-----	ADD INTERFACE TO I/O LIST OPTIMIZER
199	-----	-----	FIX MOVCNST TO SUBSUME
200	-----	-----	EXTEND XPUNGE TO COMPUTE PLACE FOR
			EXPRESSIONS ON AN I/O LIST
201	-----	-----	CORRECTED TYPOS FROM 199
202	-----	-----	REMOVED BAD DOT IN DOTOHASGN
203	-----	-----	REMOVED BAD COMPARE FROM UNRYMATCH
			MAKE PHI A PARAMETER TO CMNMAK
204	-----	-----	FIX MOVCNST TO DELETE HASH ENTRIES
			MOVE EHASHP TO BEGINNING OF MODULE
205	-----	-----	INTERFACE TO IOGELM TO WALK I/O LISTS AND
			DO GLOBAL SUBEXPRESSION ELIMINATION
206	-----	-----	MAKE DOTOHASGN AWARE OF I/O LISTS
			MAKE GLOBELIM AWARE OF I/O LISTS
207	-----	-----	WRONG PARAMETER IN CALL TO DOTOHASGN IN MATCHER
208	-----	-----	REARRANGE INTERACTION OF GLOBLDEPD,CHKHAIR AND
			MOVCNST
209	-----	-----	FIX SLINGHASH
210	-----	-----	FIX MOVCNST INPROVEMENT MADE IN 208
211	-----	-----	MORE TO COMPLETE 208 CORRECTLY
212	-----	-----	ADD AN ITERATION BETWEEN MOVCNST AND GLOBDEPD
213	-----	-----	ANOTHER FIX TO EDIT 208
214	-----	-----	ANOTHER ONE
216	-----	-----	REDEFINE CNSMOVFLG TO BE A BIT IN IMPLDO
217	-----	-----	FIX CHKDOMINANCE TO WORK CORRECTLY WITH
			CNSMOVFLG
215	-----	-----	AGAIN
218	-----	-----	MAKE THE ROUTINES FOR GLOBAL CMN ONLY INTO
			A SEPARATE MODULE
219	-----	-----	ADD THE VARIABLE OR EXPRESSION TO BE LINKED
			TO THE LIST OF PARAMETERS FOR CMNLNK
220	-----	-----	FIX CALL TO DOTOHASGN SO IT IS ONLY CALLED ONCE
221	-----	-----	DONT USE IDADDR FIELD SO DATA OPTS CAN BE DONE
222	-----	-----	MAKE NEXTUP LOOK AT SKEWED TREES FOR ARITHMETICS
223	-----	-----	CALL IOGELM FOR READ/WRITE/ENCODE/DECODE
224	-----	-----	ADD REREDID TO IOGELM
225	-----	-----	FIX ELIM TO TEST GCALLSLFLG
226	-----	-----	REEXAMINE DEFPTS IF OPTIMIZING IN HASHIT
227	-----	-----	ADD ARRAY REFERENCE PROCESSING
228	-----	-----	FIX TYPOS IN 227
229	-----	-----	MORE OF 228
230	-----	-----	CORRECT NEWCOPY TO RETURN POINTER TO NODE BUILT
231	-----	-----	ADD ROUTINE SCRUBARRAY AND MAKE CMNMAK GLOBAL
232	-----	-----	PUT ARRAY STUFF UNDER OPTIMIZER SWITCH.
			DELETE ARRAY SPECIFIEC ROUTINES.
233	----	-----	FIX ARRAY HASH KEY TO INCLUDE OFFSET
234	-----	-----	ADD ARRAYREF FUNCTION STUFF AND FIX
			NARY2 TO PUT ARRAY STUFF BACK INTO NODES
235	-----	-----	MAKE CHKHAIR AND MAKETR AWARE OF TREE SHAPE
236	-----	-----	CMNMAK IS BLOWING ARRAY REPLACEMENT
237	-----	-----	MAKE NEXTUP LOOK UP AS WELL AS DOWN FOR
			SKEWED EXPRESSIONS
238	-----	-----	MAKE MAKETRY TAKE BLKID FROM ENTRY OS ARRAYS
			WILL MATCH
239	-----	-----	IN MATCHER BUILD NARY EXPRESSION WITH ARG1
			AND ARG2 IN THE RIGHT PLACE
240	-----	-----	FIX MATCHER TO DEAL CORECTLY WITH
			NEXTUP NARY2 INTERFACE
241	-----	-----	SET NOHHASSLE BIT IN CMNMAK
242	-----	-----	FIX RANDOM P IN DELETE (V1 BUG TOO)
243	-----	-----	FIX LINKING OUT OF NODE TO BE DELETED
			IN ROUTINE DELETE
244	-----	-----	FIX HASHIT SO THAT A+B==-(A+B) IS
			FOUND AS A COMMON SUB
245	-----	-----	LIKE ARRAYREF NODES TOGETHER WHEN MATCHED
			AND RETRIEVE FROM LINKED LIST WHEN NEEDED.
			PARENT FIELD IS LINK
246	-----	-----	IN UNRYMATCHER IN LOCL CASE WE WILL MISS
			(MESS) BECAUSE T GET S CONFUSED
247	-----	-----	FIX NEGNOT FLAG BUG WITH SPECOPS
248	-----	-----	FIX MORE NEGNOT PROBLEMS WITH TYPCONV
			AND NEGNOTS
249	-----	-----	NEGNOTS ON SKEWED TREES MESSED UP
250	-----	-----	PUNT!
251	-----	-----	CMNMAK SHOULD CALL PUTBACKARRAY TO PUT THE
			ARRAREF BACK. ALL THE RIGHT LOGIC IS THERE.
252	-----	-----	THE RIGHT LOGIC MAY THERE IN EDIT 251 BUT
			ITS FOR THE WRONG (POTENTIALLY) EXPRESSION.
253	-----	-----	LOK1SUBS CASE STATEMENT IS
			MISSING ARRAYREF
254	-----	-----	UNARY MATCHER IS CALLING NEXTUP
			IMPROPERLY FOR A LOCAL SPECIAL CASE
255	371	18471	FIX CSE FOR STRAIGHT NON-SKEWED CASE, (DCE)
256V	VER5	-----	X OP .R -> .R OP X
			FIND CSE'S CONTAINING ARRAYREFS IF OPTIMIZING
			RETURN OMOVDCNS FOR LOK1/2SUBS TO GLOBDEPD
			DON'T ELIM I/O STATEMENTS ON 2ND GLOBELIM, (SJW)
256	405	18967	FIX IOLISTS WITH STAR1 AND STAR2 SHAPES, (DCE)
257	427	18771	FIX IOLISTS WITH COMMON SUBS WHICH ARE
			SHAPES GREATER THAN SKEW, (DCE)
258	442	19233	FIX DELETE SO IT DOESN'T LOSE SOME HASH
			ELEMENTS OTHER THAN ONE BEING DELETED, (DCE)
259	450	QA784	DON'T NEXTUP AN ARRAYREF INSIDE AN IOLIST, (SJW)
260	456	QA784	PASS ENTIRE HASH ENTRY TO GLOBMOV IN CMNMAK
			  FOR FINDPA FOR FINDTHESPOT, (SJW)

***** Begin Version 5A *****	 7-Nov-76

261	520	21271	RELATIONAL COMMON SUBS CANNOT HAVE NEG FLAGS SET, (DCE)
262	524	QA876	PUT BACK ARRAY REF IN STPRECLUDE AFTER A MATCH
			  SO CAN NEXTUP THE EXPR CONTAINING THE ARRAY
			  REF AND NOT RUN INTO A HASH TABLE ENTRY
			CALL STPRECLUDE BEFORE CMNMAK CHANGES NEG
			  FLAGS IN MATCHER, (SJW)
263	566	22701	SKEWED COMSUBS INVOLVING NOTFLAGS ARE NOT
			HASHED UNIQUELY - USE THE CORRECT FLAGS!, (DCE)
264	602	22700	FIX SKEWED EXPRESSIONS IN IOLISTS WITH
			CORRECT DEFINITION POINT CALCULATION, (DCE)
265	620	23720	D.P. ARRAY REF IN IO LIST CAUSES PROBLEMS, (DCE)
266	644	25390	IN LINE FUNCTIONS NEED TO BE MORE CAREFUL WITH
			NEG FLAGS WHEN DOING CSE HASHING., (DCE)
267	701	22582	.R VARS TOO EAGERLY SWAPPED WHEN
			OPERATION IS ** OR -, (DCE)
268	715	12743	NEG FLAG IN SKEWED TREE CAN SPELL BAD CODE., (DCE)
269	725	27403	WHEN WE NEXTUP, BE SURE THAT CSTMNT IS CORRECT., (DCE)
270	731	28246	PREVENT HASHING I/O EXPR WITH DEF PT ON STMNT., (DCE)

***** Begin Version 7 *****

271	1253	CKS	11-Aug-81
	Don't make a common sub out of I in C(I) if C is type character.  This
	optimization is worthless for character arrays since the index ADJBP
	clobbers the subscript expression.

272	1431	CKS	4-Dec-81
	Add code for substring nodes to all CASEs on OPRCLS.  Also add null
	cases for concatenation OPRCLS.

1474	TFV	15-Mar-82
	Add code for concatenation OPRCLS.  REA walks down the  argument
	list looking at the  arguments.  It does  nothing for the  first
	argument which is the descriptor for the result.

***** End V7 Development *****

2057	MEM	11-Jun-84
	Add a parameter to LOKCALST so that concatenation argument
	lists can be walked properly.


***** Begin Version 10 *****

2373	TJK	14-Jun-84
	Make NEXTUP more paranoid about character expressions.

2507	CDM	21-Dec-84
	Move IDDOTR to FIRST.

***** End V10 Development *****

***** End Revision History *****

)%


SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES  NOSPEC;


	!****************************************************************
	! Common sub  expression elimination  module.  Local  and  global
	! both included together with motion of constant expressions  out
	! of loops  in the  global case.   The local  control routine  is
	! locelim.  The global control routine is globelim.
	!
	! Note:
	!	There are two ways used to  distinguish between the local
	!	and global cases:
	!
	!		1. BACKST = 0			- global case
	!		   BACKST # 0			- local case
	!		2. FLGREG<OPTIMIZE> = 1		- global case
	!		   FLGREG<OPTIMIZE> = 0		- local case
	!
	!	Tests on these  are made interchangably.   The two  ways
	!	are present for historic reasons.
	!***************************************************************

FORWARD
	CMNMAK(3),
	STPRECLUDE(1),
	NARY2(1),
	NEXTUP(1),
	UNRYMATCH(3),
	CHK4OPS(1),
	MATCHER(4),
	CMNLNK(5),
	CHKHAIR(3),
	HASHIT(2),
	XPUNGE(2),
	ELIM(1),
	LOCELIM(1),
	REA(1),
	REAIO(1),
	LOCELMIO(1),
	SLINGHASH,
	TBLSRCH,
	MAKETRY(3),
	DELETE(2),
	LOCLMOV(1),
	ARGCMN(2),
	LOK1SUBS(2),
	LOK2SUBS(2),
	DELLNK(1),
	LOCLDEPD;

EXTERNAL
	A1ARREF,
	A2ARREF,
	ARGCONE,
	BACKST,
%725%	BOTTOM,
	CGERR,
	CHKDOMINANCE,
	CHKINIT,
	CHOSEN,
%725%	CORMAN,
%725%	CSTMNT,
	DOTOHASGN,
	EHASH,
	EHASHP,
	FINDTHESPOT,
	FNARRAY,
	GETOPTEMP,
	GLOBDEPD,
	GLOBMOV,
	GLOBREG,
	IOCLEAR,	! Collapse i/o lists if gcallslflg is set
	IOGELM,		! Walk i/o lists (iopt)
	ITMCT,
	LEND,
%725%	PEXPRNODE LENTRY,
	LOCLNK,
	LOKCALST,
	LOOP,
	LOOPNO,
	MAKEPR,
	MAKPR1,
	NAN,
	NEWCOPY,
	OLDHEAD,
	PEXPRNODE PHI,
	PREV,
	PUTBACKARRAY,
%725%	PEXPRNODE QQ,
	REDEFPT,
	REPLACARG,
	SAVSPACE,
%731%	SAVSTMNT,
	SETNEG,
	SKERR,
	SPECCASE,
%725%	TOP,
%725%	PHAZ2 TPREV;

OWN
	MOREFLG,
	NEDCOR,		! Flag set by  tblsrch to indicate  if the  hash
			! table has  a free  reusable space  or core  is
			! needed for the entry (i.e. = 1).
	PEXPRNODE P,
	PEXPRNODE P1,
	PEXPRNODE P2,
	PEXPRNODE PA,
	PEXPRNODE PAE,
	PEXPRNODE PB,
	PEXPRNODE PC,
	PEXPRNODE PO,
	SAVCSTMNT,
	STHASCMN,	! Used by local commonsub expressions to to save
			! a scan of ehash if the statement was not  even
			! one   that    potentailly   had    a    common
			! sub-expression (like end)
	T,
	TALLY,
	THISBLK,
	TS,		! Temporary used through out
	VARHOLDER;	! Used in special local cases see unrymatcher

GLOBAL ROUTINE CMNMAK(PAE,NAN,PHI)=
BEGIN
	!****************************************************************
	! Create a common sub-expression node pointing to the expression.
	! A common sub-expression node has:
	!	OPRCLS - CMNSUB
	!	OPERSP - NULL
	!	A single argument (ARG2PTR) pointing to the expression
	!	(or single variable)
	!****************************************************************

	MAP
		PEXPRNODE PAE,
		PHAZ2 PHI;

	! This routine is  called in  both the global  and local  cases.
	! This is  the point  at which  they diverge.   A pointer  to  a
	! cmnsub expression  node  is returned  in  the local  case.   A
	! pointer to a .O temporary in  the global case.  In both  cases
	! phi[temper] is set correctly and returned.

	! If doing an array  reference pick up the  pointer to the  hash
	! table and the arrayreference itself.  This adjustment is  made
	! to the expression before any other processing here.

	! If the flag nan (needs a negate) is set, complement/reset  the
	! negflags in  the  expression  before  it  becomes  the  common
	! subexpression.

	IF .NAN THEN
	BEGIN	! For an add complement the flags

		IF .PAE[OPR1] EQL ADDOPF
		THEN
		BEGIN
			PAE[A1NEGFLG] = NOT .PAE[A1NEGFLG];
			PAE[A2NEGFLG] = NOT .PAE[A2NEGFLG];
		END
		ELSE	IF (.PAE[OPRCLS] EQL ARITHMETIC) OR
		  	(.PAE[OPRCLS] EQL SPECOP) OR
		  	(.PAE[OPRCLS] EQL TYPECNV) OR
		  	(.PAE[OPRCLS] EQL NEGNOT)
			THEN
			BEGIN	! Multiple, divide, exponentiate

				PAE[A1NEGFLG] = 0;
				PAE[A2NEGFLG] = 0;
			END;

	END;	! For an add complement the flags

	IF NOT .FLGREG<OPTIMIZE>
	THEN
	BEGIN	! Local case

		NAME<LEFT> = 4;
		P = CORMAN();
		P[OPRCLS] = CMNSUB;
		P[ARG2PTR] = .PAE;

		IF .PAE[VALTYPE] NEQ CONTROL
		THEN	P[VALTYPE] = .PAE[VALTYPE]
		ELSE	P[VALTYPE] = LOGICAL;

		IF .PAE[OPRCLS] EQL DATAOPR THEN P[A2VALFLG] = 1;
		PHI[TEMPER] = .P;

		! Call routine that will add expression to linked list

		LOCLMOV(.P);

	END	! Local case
	ELSE
	BEGIN	! Global case

		IF .ARREFCMNSBFLG
		THEN
		BEGIN
			NOHHASSLE = 1;

			! Take care of  potential array references.   We
			! know the shape if this is the first expression
			! but this does not relate (necessarily) to  PAE
			! so we will explicitly  examine PAE to put  the
			! arrayref back.

			! Is it  the arrayref  hash entry?   Coincidence
			! between  HOP  and   OPRCLS  makes  this   test
			! possible.

			IF (P = .PAE[ARG1PTR]) NEQ 0 THEN
			IF .P[OPRCLS] EQL ARRAYREF
			THEN PAE[ARG1PTR] = NEWCOPY(.P,.PAE);

			! It could also be that PAE is a function ref

			IF .PAE[OPRCLS] EQL FNCALL
			THEN	PUTBACKARRAY(.PHI,STGHT)
			ELSE	IF (P = .PAE[ARG2PTR]) NEQ 0 THEN
				IF .P[OPRCLS] EQL ARRAYREF
				THEN PAE[ARG2PTR] = NEWCOPY(.P,.PAE);

		END;

		P = PHI[TEMPER] = GETOPTEMP(IF .PAE[VALTYPE] EQL CONTROL
						THEN LOGICAL
						ELSE .PAE[VALTYPE]);

		P[IDOPTIM] = .PAE;

		! Call routine  that  creats  and  links  in  assignment
		! statement.  Pass GLOBMOV the entire hash entry so  can
		! do FINDPA for FINDTHESPOT

		GLOBMOV (.PAE, .PHI, .P);

	END;	! Global case

	RETURN .PHI[TEMPER]

END;	! of CMNMAK


ROUTINE STPRECLUDE(CNODE)=
BEGIN
	!***************************************************************
	! Part of the count hassle.  If a common sub expression has just
	! been found that is part of an nary structure it may have to be
	! deleted.  For the global case it must be deleted to prevent it
	! from appearing to  be a  constant computation.   In the  local
	! case it  may occur  when an  nary entry  has been  made  while
	! walking one tree  and it is  discovered while walking  another
	! tree, that the whole thing collapses upward as a common sub.
	!***************************************************************

	MAP
		BASE QQ,
		BASE TS,
		BASE CNODE;

	QQ = .CNODE[PARENT];

	IF .QQ EQL 0 THEN SKERR();	! Check for error

	! Return if not nary

	IF .QQ [OPR1] NEQ .CNODE [OPR1] THEN RETURN;

	IF .QQ [A2VALFLG]
	THEN
	BEGIN	! It is nary so check for b op b op b
	
		IF (.CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]) AND
		   (.CNODE[ARG2PTR] EQL .QQ[ARG2PTR])
		THEN RETURN;	! Get the #$$$() out

		HASHIT(.QQ,SKEW);
		TS = TBLSRCH();

		! If it is this one (judging by shape) and not a  common
		! sub in its  own right already  for other reasons  then
		! delete it

		IF .FLAG THEN
		IF .TS[TEMPER] EQL 0 AND .TS[NBRCH]
		THEN DELETE(.TS,1);

	END;	! It is nary so check for b op b op b

	! If /OPT, must check if expression  is a op b op arrayref.   If
	! it is, must  drop USECNT of  hash entry for  arrayref by 1  so
	! maybe the arrayref will be put back in place of the hash table
	! entry

	IF NOT .FLGREG<OPTIMIZE> THEN RETURN;

	HASHIT(.QQ, SKEW);
	TS = TBLSRCH();

	IF .FLAG THEN
	IF .TS [TEMPER] EQL 0 THEN
	IF .TS [NBRCH]
	THEN DELETE (.TS, 1);

END;	! of STPRECLUDE

ROUTINE NARY2(CNODE)=
BEGIN
	!***************************************************************
	! Routine called from matcher when a match on a skewed tree  has
	! been made.  A skewed  node is op  a op b.   We need to  delete
	! from the hash table used op  anything op a and b op  anything,
	! at the same time being careful not to mess-up b op b op b op b
	! op b.
	!***************************************************************

	OWN BSAMEFLG;

	MAP
		BASE TS,
		PEXPRNODE CNODE;

	ROUTINE BOPBOPB(SHAPE)=
	BEGIN
		! Local  routine  to  save  some  code  space.    Hashes
		! expression of shape  SHAPE, looks it  up in the  table
		! and deletes it.  decrements use count by 1.

		HASHIT(.QQ,.SHAPE);	! Set up hash key
		TS = TBLSRCH();		! Do table lookup

		! If entry was in the table and it matches
		! in shape with the one now considered, then
		! decrease its use count by 1. See documentation
		! for a detailed description of why, who, how.

		IF .FLAG THEN
		IF .TS[TEMPER] EQL 0 THEN
		IF (.SHAPE EQL SKEW AND .TS[NBRCH]) OR
		   (.SHAPE EQL STGHT AND NOT .TS[NBRCH])
		THEN  DELETE(.TS,1);

	END;	! of BOPBOPB

	QQ = .CNODE[ARG1PTR];

	! First decide if this is a op a. It is a problem, if it is

	BSAMEFLG = 0;
	IF .QQ[ARG2PTR] EQL .CNODE[ARG2PTR] THEN BSAMEFLG = 1;

	IF .QQ[A1VALFLG] AND .QQ[A2VALFLG]
	THEN
	BEGIN
		IF .BSAMEFLG AND .QQ[ARG1PTR] EQL .CNODE[ARG2PTR]
		THEN	! We have b op b op b
		ELSE	BOPBOPB(STGHT);
	END
	ELSE
	BEGIN	! Look down one more

		QQ = .QQ[ARG1PTR];

		IF .BSAMEFLG AND .QQ[ARG2PTR] EQL .CNODE[ARG2PTR]
		THEN	! We have b op b op b
		ELSE
		BEGIN
			! For the  hash, which  depends  on QQ  in  this
			! case, move QQ back up

			QQ = .CNODE[ARG1PTR];

			! Looking down may cause an array hash entry  to
			! appear if optimizing.  We will have to special
			! case it here

			IF .FLGREG<OPTIMIZE>
			THEN
			BEGIN
				HASHIT(.QQ,STGHT);

				! Try hashing it straight and see if  it
				! is there with the array bits set

				TS = TBLSRCH();

				IF .FLAG THEN
				IF .TS[A1ARY] OR .TS[A2ARY]
				THEN DELETE(.TS,1);
			END;

			BOPBOPB(SKEW);
		END;

	END;	! Look down one more

	QQ = .CNODE[PARENT];
	IF .QQ[OPR1] EQL .CNODE[OPR1]
	THEN
	BEGIN
		IF .BSAMEFLG AND .QQ[ARG2PTR] EQL .CNODE[ARG2PTR]
		THEN	! Once again b op b op b
		ELSE	BOPBOPB(SKEW);
	END;

END;	! of NARY2


ROUTINE NEXTUP(EXPR)=
BEGIN
	!***************************************************************
	! Case statement control  on looking at  the next expression  up
	! after a match.
	!
	! Macros to  check proper  valflags and  call REA  for the  next
	! level up of an expression that has just been matched.
	!***************************************************************

	MACRO
		ARGSBOTH(NOD)=
			IF .NOD[A1VALFLG] AND .NOD[A2VALFLG] THEN XPUNGE(.NOD,STGHT)$,
		ARGS1(NOD)=
			IF .NOD[A1VALFLG] THEN XPUNGE(.NOD,UNARY)$,
		ARGS2(NOD)=
			IF .NOD[A2VALFLG] THEN XPUNGE(.NOD,UNARY)$;

	MAP
		BASE EXPR,
		BASE QQ;

	IF .EXPR EQL 0 THEN RETURN;

%2373%	IF .EXPR[VALTYPE] EQL CHARACTER THEN RETURN;

	CASE .EXPR[OPRCLS] OF SET

		ARGSBOTH(EXPR);		! BOOLEAN
		RETURN;			! DATAOPR - ILLEGAL

		! RELATIONALS are  special. At  this point  we are  only
		! interested in the relational itself and not the  local
		! special single variable case at all REA would  include
		! this special case.   We will call  XPUNGE directly  to
		! prevent this.

		IF .EXPR[A1VALFLG] AND .EXPR[A2VALFLG]	! RELATIONAL
		THEN XPUNGE(.EXPR,STGHT);

		IF ARGCONE(.EXPR) THEN XPUNGE(.EXPR,UNARY);	! FNCALL

		BEGIN	! ARITHMETIC - Get the obvious straight case

			ARGSBOTH(EXPR)	! This macro expands to IF ... THEN ...
			ELSE
			BEGIN		! Check array refs
			    QQ = .EXPR [ARG1PTR];

			    IF .FLGREG<OPTIMIZE> AND .QQ[OPRCLS] EQL ARRAYREF
			    THEN A1ARREF (.EXPR)
			    ELSE
			    BEGIN
				QQ = .EXPR [ARG2PTR];
				IF .FLGREG<OPTIMIZE> AND .QQ[OPRCLS] EQL ARRAYREF
				THEN A2ARREF(.EXPR)
				ELSE
				BEGIN	! Try for skewed trees too

					QQ = .EXPR[ARG1PTR];

					! Check skew properties

					IF (.QQ[OPR1] EQL .EXPR[OPR1]) AND
					   (.QQ[OPR1] NEQ DIVOPF) AND
					   (NOT .QQ[PARENFLG]) AND
					   .QQ[A2VALFLG]
					THEN XPUNGE(.EXPR,SKEW);

					! Look up

					IF (QQ = .EXPR[PARENT]) NEQ 0
					THEN
					BEGIN
					    IF (.QQ[OPR1] EQL .EXPR[OPR1]) AND
					       (.QQ[OPR1] NEQ DIVOPF) AND
					       (NOT .EXPR[PARENFLG]) AND
					       .QQ[A2VALFLG] AND .EXPR[A2VALFLG]
					    THEN XPUNGE(.QQ,SKEW);
					END;
				END;
			    END;

			END;		! Check array refs

		END;	! ARITHMETIC - Get the obvious straight case

		ARGS2(EXPR);		! TYPECNV

		BEGIN			! ARRAYREF
			LOCAL BASE MOM;

			IF NOT .FLGREG<OPTIMIZE> THEN RETURN;

			MOM = .EXPR [PARENT];

			IF .MOM [OPRCLS] EQL STATEMENT THEN RETURN;

			! Can not NEXTUP arrayref if inside iolist

			IF .MOM [OPRCLS] EQL IOLSCLS THEN RETURN;

%2373%			IF .MOM[VALTYPE] EQL CHARACTER THEN RETURN;

			! Find tree shape and call XPUNGE

			IF .MOM [ARG1PTR] EQL .EXPR
			THEN A1ARREF(.MOM)
%2373%			ELSE IF .MOM [ARG2PTR] EQL .EXPR
%2373%			THEN A2ARREF(.MOM);
		END;

		RETURN;			! CMNSUB - ILLEGAL
		ARGS2(EXPR);		! NEGNOT
		ARGS1(EXPR);		! SPECOP
		RETURN;			! FIELDREF
		RETURN;			! STORECLS
		RETURN;			! REGCONTENTS
		RETURN;			! LABOP
		RETURN;			! STATEMENT
		RETURN;			! IOLSCLS
		BEGIN			! INLINFN
			IF .EXPR[ARG2PTR] NEQ 0
			THEN
			BEGIN
				ARGSBOTH(EXPR)
			END
			ELSE	ARGS1(EXPR);
		END;

%1431%		RETURN;			! SUBSTRING
%1431%		RETURN			! CONCATENATION
	TES;

END;	! of NEXTUP


ROUTINE UNRYMATCH(CNODE,NAN,PHI)=
BEGIN
	!***************************************************************
	! Fixes up (performs matcher functions ) for a unary shape (i.e.
	! typecnv ,arrayref, special  case, library  function).  PHI  is
	! pointer to hashed entry  (index).  NAN should  be set only  on
	! not nodes, typecnv nodes or function calls
	!***************************************************************

	MAP
		PEXPRNODE CNODE,
		PEXPRNODE PHI;

	! Get out if it is an arrayref

	IF .CNODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		! Better only be here when globally optimizing

		IF .FLGREG<OPTIMIZE>
		THEN
		BEGIN
			! Make linked  list off  of  LKER field  of  PHI
			! using parent pointers of arrayref nodes
			CNODE[PARENT] = .PHI[LKER];
			PHI[LKER] = .CNODE;
		END;
		RETURN;
	END;

	! In the global case check  the first entry to  see if it is  an
	! assignment to a optimizer .O temporary.

	IF .FLGREG<OPTIMIZE> THEN
	IF .CNODE[OPRCLS] NEQ DATAOPR AND .PHI[USECNT] EQL 1
	THEN
	BEGIN
		DOTOHASGN(.PHI[LKER],.PHI);

		! If subsumption happened then  do only the second  half
		! and quit

		IF .PHI[TEMPER] NEQ 0
		THEN
		BEGIN
			PHI[USECNT] = .PHI[USECNT] + 1;
			CMNLNK(.PHI[TEMPER],.CNODE,UNARY,.NAN,.PHI);
			RETURN;
		END;
	END;

	IF .PHI[USECNT] EQL 1
	THEN
	BEGIN	! Use count is one

		PHI[USECNT] = 2;

		! Make cmnsub node and fix up old entry.  We must set PC
		! before the call to CMNMAK in order to correctly handle
		! the special  local  common sub-expression  case  of  a
		! single variable subscript  or under  a relational.  In
		! this  case  PHI[TEMPER]  holds  the  pointer  to   the
		! expression   for   relinking.   CMNMAK   will   change
		! PHI[TEMPER].

		IF .CNODE[OPRCLS] EQL DATAOPR
		THEN	PC = .PHI[TEMPER]
		ELSE	PC = .PHI[LKER];

		! First reset any neg flags on the node we are about  to
		! make  a  common  sub-expression.   QQ  is  used  as  a
		! temporary

		QQ = .PHI[LKER];
		IF .QQ[OPRCLS] NEQ DATAOPR
		THEN
		BEGIN
			QQ[A1NEGFLG] = 0;
			QQ[A2NEGFLG] = 0;
		END;

		T = CMNMAK(.PHI[LKER],0,.PHI);
		QQ = CMNLNK(.T,.PC,UNARY,.PHI[NEDSANEG],.PHI);

		! QQ contains  the parent  pointer  on return.   But  be
		! careful!   Check  for  the   special  local  case   of
		! relational or arrayref, because  QQ will point to  the
		! relational or arrayref.

		IF .CNODE[OPRCLS] NEQ DATAOPR THEN NEXTUP(.QQ);

	END	! Use count is one
	ELSE	PHI[USECNT] = .PHI[USECNT]+1;

	T = .PHI[TEMPER];

	! Now fix up current reference (in all cases).  Note the special
	! test for the same reason as described above.  VARHOLDER is the
	! module own that points to the expression in this case

	CMNLNK(.T,IF .CNODE[OPRCLS] EQL DATAOPR
		THEN .VARHOLDER
		ELSE .CNODE,UNARY,.NAN,.PHI);

END;	! of UNRYMATCH


ROUTINE CHK4OPS(CNODE)=
BEGIN
	!***************************************************************
	! If we have a op a op a op a, when we are matching a op a  with
	! a op a, we would  enter into the hash table  cmn(a op a) op  a
	! (unless otherwise prevented.) If there is another a op a op  a
	! op a  in  the  world this  will  lead  to a  false  match  and
	! incorrect code.  The  purpose of  this routine  is to  prevent
	! that trouble making entry.   A 0 is returned  if the entry  is
	! ok, a 1 if not.
	!***************************************************************

	MAP
		PEXPRNODE CNODE,
		PEXPRNODE TS;

	IF NOT .CNODE[A1VALFLG]
	THEN
	BEGIN	! The tree must be skewed.

		TS = .CNODE[ARG1PTR];

		! Check  for  a  op  a.   If  ARG1  is  the  node   were
		! substituting then this is the bad case.

		IF .TS[ARG2PTR] EQL .CNODE[ARG2PTR] THEN
		IF .TS[ARG1PTR] EQL .T
		THEN RETURN(1);

	END;	! The tree must be skewed.

END;	! of CHK4OPS


ROUTINE MATCHER(CNODE,SHAPE,NAN,PHI)=
BEGIN
	!***************************************************************
	! Called on a hit in the hash table.  PHI points to the matching
	! entry.     CNODE    is    expression    node.     SHAPE     is
	! unary,stght(straight), or skew(skewed) of current  expression.
	! See routine HASHIT for  pictures of the  tree shapes.  NAN  is
	! needs a negative(negation).
	!***************************************************************

	MAP
		PHAZ2 CNODE,
		PHAZ2 PHI,
		PHAZ2 T;


	IF .SHAPE EQL UNARY
	THEN
	BEGIN	! Go to special routine if shape is unary

		UNRYMATCH(.CNODE,.NAN,.PHI);
		RETURN;
	END;

	! Check for assignment to .O variable

	IF .FLGREG<OPTIMIZE> THEN
	IF (.SHAPE EQL STGHT)
	   AND (.PHI[USECNT] EQL 1)
	   AND NOT .PHI[NBRCH]
	THEN DOTOHASGN(.PHI[LKER],.PHI);

	IF .PHI[USECNT] EQL 1 AND .PHI[TEMPER] EQL 0
	THEN
	BEGIN	! Use count is one

		PHI[USECNT] = 2;
		IF .SHAPE EQL SKEW
		THEN
		BEGIN	! Skewed tree

			! Also catch b*b*b*b, test after NARY2 will stop
			! all  common   subs  or   merely  correct   the
			! situation  for  b*b*b,  hopefully,  this  will
			! permit b*b*b*b to become (t = b*b,t*t).

			IF .CNODE[ARG1PTR] EQL .PHI[LKER]
			THEN
			BEGIN
				PHI[USECNT] = 1;
				RETURN;		! Get out
			END;

			! Preclude triples eliminated by match

			NARY2(.CNODE);

			IF .PHI[NBRCH]
			THEN
			BEGIN	! Entry in hash table is also skewed

				QQ = .CNODE[ARG1PTR];

				! Make a straight one

				PB = MAKEPR(.CNODE[OPRCLS],
					.CNODE[OPERSP],
					.CNODE[VALTYPE],
					.QQ[ARG2PTR],
					.CNODE[ARG2PTR]);
				PB[DEFPT1] = .QQ[DEFPT2];
				PB[DEFPT2] = .CNODE[DEFPT2];
				PB[A1FLGS] = .QQ[A2FLGS];
				PB[A2FLGS] = .CNODE[A2FLGS];

				! Eliminate triples  precluded by  match
				! and make a common sub

				NARY2(.PHI[LKER]);
				T = CMNMAK(.PB,.NAN,.PHI);
				PC = .PHI[LKER];
				PB[PARENT] = .PC[PARENT];
				PHI[LKER] = .PB;

			END	! Entry in hash table is also skewed
			ELSE
			BEGIN	! Fix up tree

				! Call STPRECLUDE before CMNMAK  changes
				! neg flags  so hash  in STPRECLUDE  can
				! find the skew piece of tree.  Preclude
				! if necessary.

				STPRECLUDE(.PHI[LKER]);

				! Make a cmnsub

				T = CMNMAK(.PHI[LKER],.PHI[NEDSANEG],.PHI);
				PC = .PHI[LKER];

			END;	! Fix up tree
		END
		ELSE
		BEGIN	! Shape is straight

			! Make cmnsub node.  Take into consideration the
			! non-skewed case.

			IF .PHI[NBRCH]
			THEN
			BEGIN
				T = CMNMAK(.CNODE,.NAN,.PHI);

				! If first node was skewed, make the one
				! we keep straight. Also preclude others
				! precluded by this match.

				NARY2(.PHI[LKER])
			END
			ELSE
			BEGIN
				! Call STPRECLUDE before CMNMAK  changes
				! the  neg   flags.   First   node   was
				! straight  but  still  have  the  count
				! hassle.

				STPRECLUDE(.PHI[LKER]);
				T = CMNMAK(.PHI[LKER],.PHI[NEDSANEG],.PHI);
			END;

			PC = .PHI[LKER];
			PHI[LKER] = .CNODE

		END;	! Shape is straight

		! Fix up  expression pointers.   PC  is pointer  to  the
		! expression.

		QQ = CMNLNK(.T,.PC,
			IF .PHI[NBRCH] THEN SKEW ELSE STGHT,
			.PHI[NEDSANEG],.PHI);

		! QQ points to parent on return from CMNLNK

		IF NOT CHK4OPS(.CNODE)
		THEN
%725%		BEGIN
%725%			! Before we  call NEXTUP,  be sure  that  CSTMNT
%725%			! points to  the  statement which  contains  the
%725%			! original instance of the expression.  This was
%725%			! carefully saved in the hash entry when it  was
%725%			! made.

%725%			LOCAL SAVCSTMNT;	! Save CSTMNT for NEXTUP
%725%			SAVCSTMNT = .CSTMNT;
%725%			CSTMNT = .PHI[HSTMNT];	! Get statement from which
%725%						! the old expression came
%725%			NEXTUP(.QQ);		! Handle old expression
%725%			CSTMNT = .SAVCSTMNT;	! Restore CSTMNT to proceed
%725%		END

	END	! Use count is one
	ELSE	PHI[USECNT] = .PHI[USECNT] + 1;

	! If this is a skewed tree then delete hash entries precluded by
	! this match

	IF .SHAPE EQL SKEW
	THEN	NARY2(.CNODE)
	ELSE	STPRECLUDE(.CNODE);

	T = .PHI[TEMPER];	! Point to temporary for substitution

	! Link up the common sub expression (current one)

	CMNLNK(.T,.CNODE,.SHAPE,.NAN,.PHI);

END;	! of MATCHER


ROUTINE CMNLNK(T,CNODE,SHAPE,NAN,PHI)=
BEGIN
	!***************************************************************
	! Link up the common sub-expression in its place
	!***************************************************************

	MAP
		PHAZ2 QQ,
		BASE CNODE,
		BASE PHI,
		BASE T;
	OWN
		OLDT,
		NEGT;

	LABEL ADJCTL;

	T[EXPRUSE] = .PHI[USECNT];
	FLAG = 0;			! Initialize flag

	IF .SHAPE EQL SKEW
	THEN
	BEGIN	! Skewed tree

%715%		! Both neg and not  flags have been  used in the  common
%715%		! sub-expression so  turn  them  both off  in  the  main
%715%		! expression.

%715%		CNODE[A2NGNTFLGS] = 0;

		IF .NAN
		THEN
		BEGIN
			CNODE[ARG2PTR] = MAKPR1(.CNODE,NEGNOT,NEGOP,.CNODE[VALTYPE],0,.T);
			CNODE[A2VALFLG] = 0;
		END
		ELSE
		BEGIN
			CNODE[ARG2PTR] = .T;
			CNODE[A2VALFLG] = 1;
		END;

		! The tree looks like this:
		! 	  *(CNODE)
		!     *        *
		! *(QQ)	  	*(Just became T)

		! 	  *(QQ)
		!     *        *
		!  *(Will become QQ we care about)
		! 			*(Will go away)

		QQ = .CNODE[ARG1PTR];

		! Save  definition  point.  If  QQ[ARG1PTR]  is  not  an
		! expression then this becomes  the definition point  of
		! the dataopr, etc.

		TS = .QQ[DEFPT1];

		! There is yet another hassle - Neg/not flags.  We  must
		! move them up if possible. The conditions are if neg is
		! set and CNODE doesnt have  not set, complement neg  in
		! parent else build  neg node  and insert.  The same  is
		! true for nots. Set refers to the arg1flags of the  top
		! one of the QQ nodes in the above diagram.

		IF .QQ[A1NEGFLG]
		THEN
		BEGIN
			IF NOT .CNODE[A1NOTFLG]
			THEN
			BEGIN
				CNODE[A1NEGFLG] = NOT .CNODE[A1NEGFLG];
				QQ = .QQ[ARG1PTR];
			END
			ELSE	QQ = MAKPR1(.CNODE,NEGNOT,NEGOP,.QQ[VALTYPE],0,.QQ);
		END
		ELSE	IF .QQ[A1NOTFLG]
		THEN
		BEGIN
			IF NOT .CNODE[A1NEGFLG]
			THEN
			BEGIN
				CNODE[A1NOTFLG] = NOT .CNODE[A1NOTFLG];
				QQ = .QQ[ARG1PTR];
			END
			ELSE	QQ = MAKPR1(.CNODE,NEGNOT,NOTOP,.QQ[VALTYPE],0,.QQ);
		END
		ELSE	QQ = .QQ[ARG1PTR];

		CNODE[ARG1PTR] = .QQ;

		! Set definition point of node just substituted

		CNODE[DEFPT2] = .PHI[STPT];

		! Now, depending on whether  or not QQ  is a dataopr  or
		! cmnsub set defpt1, valflags and parent pointer

		IF .QQ[OPRCLS] EQL DATAOPR OR .QQ[OPRCLS] EQL CMNSUB
		THEN
		BEGIN
			CNODE[DEFPT1] = .TS;
			CNODE[A1VALFLG] = 1;
		END
		ELSE
		BEGIN	! An expression

			CNODE[DEFPT1] = .QQ[DEFPT1];
			QQ[PARENT] = .CNODE;
		END;

		! Make sure QQ points to  CNODE parent before return  as
		! this feature is used by  NEXTUP.  In this skewed  case
		! the expression we want to examine is the one in  which
		! the substitution has occurred.

		QQ = .CNODE;

	END	! Skewed tree
	ELSE
	BEGIN	! Balanced tree

		! Here, once again,  we have the  special local  (single
		! variable) case.  CNODE is a pointer to the  expression
		! and will itself function as the parent.  No other case
		! looks for common  subs in an  arrayref or  relational.
		! This is an  important concept.  The  global case  does
		! look for relationals so  an additional test on  BACKST
		! is also necessary.

		OLDT = .T;	! Save value of t

		IF (.CNODE[OPRCLS] EQL ARRAYREF OR
			.CNODE[OPRCLS] EQL RELATIONAL) AND
			.BACKST NEQ 0
		THEN
		BEGIN
			QQ = .CNODE;
			CNODE = .PHI[LKER];

			! If it is  a relational we  must set a  special
			! flag so that the register allocator will  know
			! that it  may  have  to  be  moved  to  another
			! register if this is an AOBJN loop.

			IF .QQ[OPRCLS] EQL RELATIONAL THEN T[CSFULLWDFLG] = 1;
		END
		ELSE
		BEGIN
			QQ = .CNODE[PARENT];

			! If T is a variable (this is the global  case),
			! do not set  the parent  to T. Do  not set  the
			! parent at all.

			IF .T[OPRCLS] EQL CMNSUB THEN CNODE[PARENT] = .T;
		END;

		IF .NAN THEN NEGT = 
			MAKPR1(.QQ,NEGNOT,NEGOP,.CNODE[VALTYPE],0,.T);

		IF .QQ[OPRCLS] EQL STATEMENT
		THEN
		BEGIN
			IF .NAN THEN
			IF NOT SETNEG(.QQ,0)
			THEN
			BEGIN
				T = .NEGT;
				FLAG = 1;
			END;

			REPLACARG(.QQ,.CNODE,.T);

			IF .T[IDDOTO] EQL SIXBIT ".O" THEN
			IF .QQ[SRCID] EQL ASGNID THEN
			IF .QQ[SRCOPT] NEQ 0
			THEN	QQ[OPDEF] = .PHI[STPT];
		END
		ELSE	IF .QQ[OPRCLS] EQL FNCALL
		THEN
		BEGIN
			LOCAL ARGUMENTLIST AG;

			IF .NAN
			THEN
			BEGIN
				T = .NEGT;
				FLAG = 1;
			END;

			AG = .QQ[ARG2PTR];

			! Set up  parameters in  case  we have  to  call
			! LEAFSUBSTITUTE to locate it

			ITMCT = 1;
			GLOBREG[0] = .CNODE;
			CHOSEN[0] = .T;
			SPECCASE = 0;
%2057%			LOKCALST(.AG,.AG[ARGCOUNT],.CNODE,.T,FALSE);

			! Put definition point into node if appropriate

			IF ARGCONE(.QQ) THEN QQ[DEFPT2] = .PHI[STPT];
		END
		ELSE	IF .QQ[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN
			! For an  IOLSCLS  node,  we  have  to  be  very
			! careful with where we tie in the pointer!

			IF .NAN
			THEN
			BEGIN
				T = .NEGT;
				FLAG = 1;
			END;

			IF .QQ[SCALLELEM] EQL .CNODE
			THEN	QQ[SCALLELEM] = .T 
			ELSE	IF .QQ[SCALLCT] EQL .CNODE
				THEN QQ[SCALLCT] = .T;
		END
		ELSE	IF .QQ[ARG1PTR] EQL .CNODE AND .QQ[OPRCLS] NEQ ARRAYREF
		THEN
		BEGIN
			IF .NAN THEN
			IF NOT SETNEG(.QQ,1)
			THEN
			BEGIN
				T = .NEGT;
				FLAG = 1;
			END;

			QQ[ARG1PTR] = .T;

			IF .T[OPRCLS] EQL CMNSUB OR .T[OPRCLS] EQL DATAOPR
			THEN QQ[A1VALFLG] = 1;

			QQ[DEFPT1] = .PHI[STPT];
		END
		ELSE
		BEGIN
			IF .NAN THEN
			IF NOT SETNEG(.QQ,0)
			THEN
			BEGIN
				T = .NEGT;
				FLAG = 1;
			END;

			QQ[ARG2PTR] = .T;

			IF .T[OPRCLS] EQL CMNSUB OR .T[OPRCLS] EQL DATAOPR
			THEN QQ[A2VALFLG] = 1;

			QQ[DEFPT2] = .PHI[STPT];
		END;

		! One more  thing.   If the  parent  is a  control  type
		! boolean we have to change it to control, because  code
		! generation cannot handle  a value under  a boolean  or
		! type control

		T = .QQ;
ADJCTL:
		WHILE .T[OPRCLS] EQL BOOLEAN AND .T[VALTYPE] EQL CONTROL
		DO
		BEGIN
			T[VALTYPE] = LOGICAL;	! Change to logical
			T = .T[PARENT];		! Look at next parent
			IF .T EQL 0 THEN LEAVE ADJCTL;	! Check for orphan
		END;

		! Restore node space freed, if any

		IF .NAN THEN
		IF NOT .FLAG THEN SAVSPACE(EXSIZ - 1,.NEGT);

		T = .OLDT;

		IF .T[OPRCLS] EQL CMNSUB
		THEN
		BEGIN
			! The check for the valflg being set on a cmnsub
			! node is equivalent to  the special case  check
			! for the local  unary subscript or  relational.
			! It is clear that the space for a symbol  table
			! node does not get freed.

			IF .T[ARG2PTR] NEQ .CNODE
			AND NOT .T[A2VALFLG]
			THEN SAVSPACE(EXSIZ-1,.CNODE);
		END;

	END;	! Balanced tree

	RETURN .QQ

END;	! of CMNLNK


ROUTINE CHKHAIR(CNODE,PHI,SHAPE)=
BEGIN
	!***************************************************************
	! Check node for having another common sub-expression under  it.
	! If it does then set cmnunder flag in hash table node.
	!***************************************************************

	LOCAL BASE ARGNODE;

	MAP
		BASE TOP,
		BASE PA,
		PEXPRNODE CNODE,
		PEXPRNODE PHI;

	MACRO ARG1CHK=
	BEGIN
		ARGNODE = .CNODE[ARG1PTR];
		IF .ARGNODE[OPRCLS] EQL CMNSUB OR
			.ARGNODE[IDDOTO] EQL SIXBIT".O"
		THEN	PHI[CMNUNDER] = 1;
	END$;

	MACRO ARG2CHK=
	BEGIN
		ARGNODE = .CNODE[ARG2PTR];
		IF .ARGNODE[OPRCLS] EQL CMNSUB OR
			.ARGNODE[IDDOTO] EQL SIXBIT".O"
		THEN	PHI[CMNUNDER] = 1;
	END$;

%1431%	MACRO ARG4CHK=
	BEGIN
		ARGNODE = .CNODE[ARG4PTR];
		IF .ARGNODE[OPRCLS] EQL CMNSUB OR
			.ARGNODE[IDDOTO] EQL SIXBIT".O"
		THEN	PHI[CMNUNDER] = 1;
	END$;

	MACRO CHKBOTH=
	BEGIN
		ARG2CHK;
		IF .SHAPE EQL SKEW
		THEN
		BEGIN
			CNODE = .CNODE[ARG1PTR];
			ARG2CHK;
		END
		ELSE	ARG1CHK;
	END$;


	CASE .CNODE[OPRCLS] OF SET

	BEGIN		! BOOLEAN
		CHKBOTH;
	END;		! BOOLEAN

	RETURN;		! DATAOPR

	BEGIN		! RELATIONAL
		CHKBOTH;
	END;		! RELATIONAL

	RETURN;		! FNCALL

	BEGIN		! ARITHMETIC
		CHKBOTH;
	END;		! ARITHMETIC

	ARG2CHK;	! TYPCNV
	RETURN;		! ARRAYREF
	RETURN;		! CMNSUB
	ARG2CHK;	! NEGNOT
	ARG1CHK;	! SPECOP
	RETURN;		! FIELDREF
	RETURN;		! STORECLS
	RETURN;		! RECONTENTS
	RETURN;		! LABOP
	RETURN;		! STATEMENT
	RETURN;		! IOLSCLS

	BEGIN		! INLINFN
		ARG1CHK;
		IF .CNODE[ARG2PTR] NEQ 0 THEN ARG2CHK;
	END;		! INLINFN

%1431%	BEGIN		! SUBSTRING
%1431%		CHKBOTH;
%1431%		ARG4CHK;
%1431%	END;		! SUBSTRING

%1431%	RETURN		! CONCATENATION

	TES;

END;	! of CHKHAIR



GLOBAL ROUTINE HASHIT(CNODE,SHAPE)=
BEGIN
	!***************************************************************
	! Create hash table entry for lookup; the global entry is  used.
	! entry is  filled with  the hash  key elements.  These are  the
	! operator, arguments and definition points.  The macros in this
	! routine help assure that arguments are in their proper  order.
	! Note: no dot is used on assignment to entryp
	!***************************************************************

MACRO	REVARG=
		ENTRYP[HA1] = .CNODE[ARG2PTR];
		ENTRYP[HDEF1] = .CNODE[DEFPT2];
		ENTRYP[HA2] = .CNODE[ARG1PTR];
		ENTRYP[HDEF2] = .CNODE[DEFPT1];$,

	REGARG=
		ENTRYP[HA1] = .CNODE[ARG1PTR];
		ENTRYP[HDEF1] = .CNODE[DEFPT1];
		ENTRYP[HA2] = .CNODE[ARG2PTR];
		ENTRYP[HDEF2] = .CNODE[DEFPT2];$,

	SREVARG=
		ENTRYP[HA1] = .CNODE[ARG2PTR];
		ENTRYP[HDEF1] = .CNODE[DEFPT2];
		ENTRYP[HA2] = .QQ[ARG2PTR];
		ENTRYP[HDEF2] = .QQ[DEFPT2];$,

	SREGARG=
		ENTRYP[HA1] = .QQ[ARG2PTR];
		ENTRYP[HDEF1] = .QQ[DEFPT2];
		ENTRYP[HA2] = .CNODE[ARG2PTR];
		ENTRYP[HDEF2] = .CNODE[DEFPT2];$;

	OWN PHAZ2 ENTRYP;
	MAP PHAZ2 CNODE;

	ENTRY = 0;
	ENTRYP = ENTRY;
	ENTRY + 1 = 0; 
	NAN = 0;
	IF .FLGREG<OPTIMIZE>  AND NOT .IMPLDO THEN REDEFPT(.CNODE,.SHAPE);
	ENTRYP[BLKID] = .LOOPNO;

%1431%	IF .CNODE[OPRCLS] EQL CONCATENATION	! Concatenation and substring
%1431%	    OR .CNODE[OPRCLS] EQL SUBSTRING	! should never be CSEs
%1431%	THEN CGERR();

	CASE .SHAPE OF SET

	BEGIN	! UNARY -  TYPECNV,  ARRAYREF with  simple  variable  as
		! resultant subscript also library functions of a single
		! argument also special operators  which are arg1  types
		! instead of arg2.

		! If the item  is a variable  (this is special  arrayref
		! case)

		IF .CNODE[OPRCLS] EQL DATAOPR AND .CNODE[OPERSP] NEQ CONSTANT
		THEN
		BEGIN
			ENTRYP[HOP] = VARFL;
			ENTRYP[HDEF1] = 0;
			ENTRYP[HA2] = .CNODE;
			ENTRYP[HDEF2] = 0;
			ENTRYP[HA1] = 0;
		END
		ELSE	IF .CNODE[OPRCLS] EQL ARRAYREF
		THEN
		BEGIN
			! It is not the local special case see if its an
			! arrayref (global only)

			ENTRYP[HOP] = .CNODE[OPERATOR];

			! Fudge the offset into the block id

			ENTRYP[BLKID] = .CNODE[TARGADDR];

			! But be sure the empty bit is off

			ENTRYP[EMPTY] = 0;
			REGARG;
		END 
		ELSE	IF .CNODE[OPRCLS] EQL FNCALL
		THEN
		BEGIN
			! Not an arrayref, try function reference

			REGISTER ARGUMENTLIST AG;

			ENTRYP[HOP] = .CNODE[OPERATOR];
			ENTRYP[HA1] = .CNODE[ARG1PTR];
			ENTRYP[HDEF1] = 0;
			AG = .CNODE[ARG2PTR];
			ENTRYP[HA2] = .AG[1,ARGNPTR];
			ENTRYP[HDEF2] = .CNODE[DEFPT2];
		END
		ELSE	IF .CNODE[OPRCLS] EQL SPECOP
		THEN
		BEGIN
			! Not a function call either. check for  special
			! operator

			IF .CNODE[A1NEGFLG] THEN NAN = 1;
			ENTRYP[HOP] = .CNODE[OPERATOR]+.CNODE[A1NOTFLG];
			REGARG;
		END
		ELSE
		BEGIN
			! Now  treat  everyone  the  same  (typecnv  and
			! negnot)

			IF .CNODE[A2NEGFLG] THEN NAN = 1;
			ENTRYP[HOP] = .CNODE[OPERATOR]+.CNODE[A2NOTFLG];
			REGARG;
		END;

	END;	! Unary case


	BEGIN	! STRAIGHT
		! 
		!       OP
		!     *    *
		!   *        *
		! DATA     DATA

		IF .CNODE[OPRCLS] EQL ARITHMETIC
		THEN
		BEGIN	! arithmetic

			! Arithmetic nodes  are a  special case  because
			! the skeleton optimizer has eliminated subtract
			! nodes in favor of  adds with proper neg  flags
			! set. We also wish to recognize a-b and b-a  as
			! the same  expression (plus  negate on  one  of
			! them).

			! TALLY is the xor  of the negate flags  present
			! in the node.

			TALLY = .CNODE[A1NEGFLG] XOR .CNODE[A2NEGFLG];

			IF .CNODE[OPR1] EQL ADDOPF
			THEN
			BEGIN	! Add operation

				! Adds are a special case.  In all cases
				! the expression will  be considered  to
				! be a-b. This is TALLY = 1 and A2NEGFLG
				! set. TALLY = 1 and A1NEGFLG set is b-a
				! which needs a negation (nan set).
				!   0	  NAN
				! -----	-----
				! A+B	-(A+B)
				! A-B	-A+B==B-A

				NAN = .CNODE[A1NEGFLG];

				ENTRYP[HOP] = .CNODE[OPERATOR]+.TALLY+
					.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG]^2;

				! Make sure  once again  that  arguments
				! are in the correct order. In  general,
				! they   are    properly   ordered    by
				! canonicalization.   When  newly  found
				! common subs are  involved we may  need
				! to order them here.

				IF .CNODE[ARG1PTR] GTR  .CNODE[ARG2PTR]
				THEN
				BEGIN
					REVARG;
					IF .TALLY THEN NAN = NOT .NAN;
				END
				ELSE
				BEGIN 	! Args are already in right order

					REGARG;
				END;

			END	! Add operation
			ELSE
			BEGIN	! Not add operation

				NAN = .TALLY;
				ENTRYP[HOP] = .CNODE[OPERATOR]+
					.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];

				! Multiply is also somewhat special

				IF .CNODE[OPR1] EQL MULOPF
				THEN
				BEGIN	! Check arg order again

					IF .CNODE[ARG1PTR] GTR .CNODE[ARG2PTR]
					THEN
					BEGIN
						REVARG;
					END
					ELSE
					BEGIN	! Args in order

						REGARG;
					END;
				END
				ELSE
				BEGIN	! Not a multiply

					REGARG;
				END;

			END;	! Not add operation

		END	! Arithemtic
%644%		ELSE	IF .CNODE[OPRCLS] EQL INLINFN
%644%		THEN
%644%		BEGIN
%644%			! In line functions should be treated separately
%644%			! from other Non  arithmetic cases which  depend
%644%			! more heavily on not flags.  In particular,  we
%644%			! need to hash differently so that the neg flags
%644%			! are definitely taken into account for cse.

%644%			TALLY = 0;
%644%			NAN = 0;
%644%			ENTRYP[HOP] = .CNODE[OPERATOR]+
%644%				 .CNODE[A1NEGFLG]^1+.CNODE[A2NEGFLG]^2;
%644%			REGARG;
%644%		END
		ELSE
		BEGIN
			NAN = 0;
			ENTRYP[HOP] = .CNODE[OPERATOR]+
				.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];
			REGARG;
		END;

	END;	! Straight case


	BEGIN	! SKEWED TREES
		! 
		!       OP(CNODE)
		!     *    *
		!   *        *
		! OP(QQ)    DATA
		!    *
		!      *
		!     DATA

		QQ = .CNODE[ARG1PTR];
		IF .CNODE[OPRCLS] EQL ARITHMETIC
		THEN
		BEGIN	! Arithmetic node

			! Tally contains the number of negatives on  the
			! expression

			TALLY = .CNODE[A2NEGFLG] XOR .QQ[A2NEGFLG];

			IF .CNODE [OPR1] EQL ADDOPF
			THEN
			BEGIN	! Add operation

				ENTRYP[HOP] = .CNODE[OPERATOR]+.TALLY
					+.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG]^2;

				! TALLY and a negate (gag) on the second
				! node determine if  a negate is  needed
				! on the common sub.

				NAN = .QQ[A2NEGFLG];

				! Insure  args  are  ordered  by  symbol
				! table address

				IF .QQ[ARG2PTR] GTR .CNODE[ARG2PTR]
				THEN
				BEGIN	! They need switching

					SREVARG;
					IF .TALLY THEN NAN = NOT .NAN;
				END
				ELSE
				BEGIN	! They do not need switching

					SREGARG;
				END;

			END	! Add operation
			ELSE
			BEGIN	! Not an add

				NAN = .TALLY;
				ENTRYP[HOP] = .CNODE[OPERATOR]
					+.CNODE[A1NOTFLG]^1+.CNODE[A2NOTFLG];

				IF .CNODE[OPR1] EQL MULOPF
				THEN
				BEGIN	! A multiply

					! Worry about arg order again

					IF .QQ[ARG2PTR] GTR .CNODE[ARG2PTR]
					THEN
					BEGIN	! Need reordering

						SREVARG;
					END
					ELSE
					BEGIN	! No reordering needed

						SREGARG;
					END
				END
				ELSE
				BEGIN	! Not multiply

					SREGARG;
				END

			END;	! Not add

		END	! Arithmetic
		ELSE
		BEGIN	! Not arithmetic

			! Check  on  the   correct  flags  for   hashing
			! uniquely

			ENTRYP[HOP] = .CNODE[OPERATOR]
				+.QQ[A2NOTFLG]^1+.CNODE[A2NOTFLG];
			SREGARG;
		END;

	END	! End skewed tree case
	TES;

END;	! of HASHIT


ROUTINE XPUNGE(CNODE,SHAPE)=
BEGIN
	!***************************************************************
	! Tree has  been walked  to  the leaf*operator*leaf  point.  The
	! expression will  now be  hashed, etc.   The local  and  global
	! cases are distinguished here by a test on the value of BACKST.
	! BACKST must be zero in the global case. The check is necessary
	! since the global case requires much checking not necessary  in
	! the local case.
	!***************************************************************

	LABEL FIND;
	MAP PEXPRNODE CNODE;

	IF .BACKST NEQ 0 OR .IMPLDO
	THEN
	BEGIN	! Local case or i/o optimizer case

		! We cannot handle  shapes greater than  skew here,  for
		! there is no such code in HASHIT.  To add code for this
		! case, we could use CHKDOMINANCE as a template, but the
		! code is extensive.  For now  simply do not attempt  to
		! handle cases with shape greater than skew.  An example
		! is: read() (a(b(i),j),c(b(i),j),j = 1,10)

		IF .SHAPE GTR SKEW THEN RETURN;

%731%	! If this is an i/o statement,  then avoid hashing if either  of
%731%	! the definition points  are on the  statement itself.  This  is
%731%	! the case if the definition point algorithm has bailed out (for
%731%	! example, with variables in common).

%731%		IF .IMPLDO THEN
%731%		IF .CNODE[DEFPT1] EQL .SAVSTMNT 
%731%			OR .CNODE[DEFPT2] EQL .SAVSTMNT
%731%		THEN RETURN;	 ! Non-hashable node

		HASHIT(.CNODE,.SHAPE);
		PHI = TBLSRCH();

		IF .FLAG
		THEN MATCHER(.CNODE,.SHAPE,.NAN,.PHI)
		ELSE
		BEGIN
			PHI = MAKETRY(.PHI,.CNODE,.SHAPE);
			IF .SHAPE EQL SKEW THEN PHI[NBRCH] = 1;
			IF .NAN THEN PHI[NEDSANEG] = 1;

			! Find definition points correctly for star1 and
			! star2 cases.  This may  have to be changed  if
			! more general  expressions are  allowed in  i/o
			! lists.  For now it catches the case  (a(p(i)),
			! i = 1,4) where a  is a formal parameter  being
			! passed.

			IF NOT .IMPLDO
			THEN PHI[STPT] = 0	! Local case
			ELSE
			BEGIN	! I/O list case

				LOCAL CN,DF1,DF2;
				MAP PEXPRNODE CN;

				PA = .LENTRY;

				! Here is the main change - we must drop
				! down one  node prior  to grabbing  the
				! def points for star1 and star2  shapes
				! - CN points to the node we want

				CN = IF .SHAPE EQL STAR1
					THEN .CNODE[ARG1PTR]
					ELSE IF .SHAPE EQL STAR2
					THEN .CNODE[ARG2PTR]
					ELSE .CNODE;

				DF1 = .CN[DEFPT1];
				DF2 = .CN[DEFPT2];

				! If shape is skew,  we need to get  the
				! correct definition point for the  left
				! hand  node.   An  example  case  which
				! causes    this    to    happen     is:
				! a(b(l+i-1)),i =  j,k;  where  b  is  a
				! formal array!

				IF .SHAPE EQL SKEW
				THEN
				BEGIN
					CN = .CNODE[ARG1PTR];
					DF1 = .CN[DEFPT2];
				END;

				IF .DF1 EQL .DF2
				THEN PHI[STPT] = .DF1	! Done
				ELSE
				BEGIN
					P = IF .DF1 EQL 0 THEN 1 ELSE 0;
					IF .DF2 EQL 0 THEN P = .P + 2;

FIND:
					WHILE 1 DO
					BEGIN
						IF NOT .P<0,1> THEN
						IF .PA EQL .DF1 THEN P = .P +1;

						IF NOT .P<1,1> THEN
						IF .PA EQL .DF2 THEN P = .P +2;

						IF .P EQL 3 THEN LEAVE FIND;
						PA = .PA[CLINK]
					END;
					PHI[STPT] = .PA

				END	! Skew case

			END	! I/O list case

		END
	END
	ELSE CHKDOMINANCE(.CNODE,.SHAPE);	! Global case

END;	! of XPUNGE


ROUTINE ELIM(STMT)=
BEGIN
	!***************************************************************
	! Controlling  routine  at  the   statement  level  for   common
	! sub-expression  elimination,  both  global  and  local.   Only
	! statements mentioned  explicitly  in  this  routine  can  even
	! potentially have common sub-expressions.those statement  types
	! are: assignment,logical if, do, arithmetic if,read, write.
	!***************************************************************

	MAP
		PHAZ2 STMT,
		BASE TOP,
		BASE BACKST;

	IF .STMT[SRCID] EQL ASGNID
	THEN
	BEGIN	! Assignment statements

		PAE = .STMT[LHEXP];
		IF .PAE[OPRCLS] EQL ARRAYREF THEN REA(.PAE);

		! Special  check  for  variable  initialization  in  the
		! global case

		IF .STMT[A2VALFLG]
		THEN
		BEGIN
			IF .FLGREG<OPTIMIZE> THEN
			IF .STMT[SRCOPT] NEQ 0 THEN
			IF .LOOP EQL 0 THEN
			IF .STMT[OPDEF] EQL .LENTRY
			THEN CHKINIT(.STMT[RHEXP]);
		END
		ELSE	REA(.STMT[RHEXP]);

	END;	! Assignment statements

	IF .STMT[SRCID] EQL IFLID
	THEN
	BEGIN	! Logical if

		REA(.STMT[LIFEXPR]);
		IF NOT .FLGREG<OPTIMIZE>
		THEN
		BEGIN
			! The  special  check  is  necessary  to   avoid
			! processing the statement following the logical
			! if twice in the  global case. The true  branch
			! is on the processing list as a spearate entity
			! by itself in the global case.

			! Hook all locals found so far to the if part

			LOCLDEPD();
			STMT[SRCCOMNSUB] = .BACKST[SRCLINK];
			BACKST[SRCLINK] = 0;
			LOCLNK = 0;
			CSTMNT = .STMT[LIFSTATE];
			ELIM(.STMT[LIFSTATE]);
		END;

	END;	! Logical if

	IF .STMT[SRCID] EQL DOID
	THEN
	BEGIN	! Do statement

		REA(.STMT[DOLPCTL]);
	END;

	IF .STMT[SRCID] EQL IFAID
	THEN
	BEGIN	! Arithmetic if

		REA(.STMT[AIFEXPR]);
	END;

	! I/O statements

	IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID THEN
	IF .FLGREG<OPTIMIZE> AND NOT .GLOBELIM2
	THEN	IOGELM(.STMT)
	ELSE
		IF .GCALLSLFLG
		THEN IOCLEAR(.STMT)
		ELSE LOCELMIO(.STMT);

END;	! of ELIM


MAP PEXPRNODE BACKST;


GLOBAL ROUTINE LOCELIM(STMT)=
BEGIN
	!***************************************************************
	! Control for local common sub-expression elimination
	!***************************************************************

	MAP
		PEXPRNODE STMT,
		PEXPRNODE CSTMNT;

	SAVCSTMNT = .CSTMNT;
	LOCLNK = 0;
	STHASCMN = 0;
	BACKST[SRCLINK] = 0;
	LOOPNO = .CSTMNT[SRCISN];
	ELIM(.STMT);

	IF .STHASCMN
	THEN
	BEGIN
		LOCLDEPD();
		CSTMNT[SRCOPT] = .BACKST[SRCLINK];
	END;

	CSTMNT = .SAVCSTMNT;

	! The above  statement  either  zeroes  the  pointer  to  common
	! sub-expressions or sets it to point to them correctly.

END;	! of LOCELIM


ROUTINE REA(STKPAE)=
BEGIN
	!***************************************************************
	! PAE is an expression pointer.  This routine is named in  honor
	! of REA railway express.  This is where we attempt to  railroad
	! everything through!  As  is not obvious  it deals with  common
	! expression elimination.  It does  the basic tree walk  through
	! the trees.  It is called by ELIM and calls XPUNGE to hash  and
	! match the philosophy behind each  secton of code is the  same.
	! Walk the tree based on the  setting of the valflgs (says  node
	! under here is leaf  is set). Walk  branches before looking  at
	! current node itself.  Also check for the skewed tree case.
	!***************************************************************

	REGISTER PHAZ2 PAE;

	PAE = .STKPAE;
	STHASCMN = 1;

	CASE .PAE[OPRCLS] OF SET

	BEGIN	! BOOLEAN

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);

		IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
		THEN XPUNGE(.PAE,STGHT)
		ELSE
		BEGIN
			QQ = .PAE[ARG1PTR];

			! N-ary with leaves

			IF .QQ[OPERATOR] EQL .PAE[OPERATOR] AND
				.QQ[A2VALFLG] AND .PAE[A2VALFLG] 
				AND NOT .QQ[PARENFLG]
			THEN	XPUNGE(.PAE,PSKEW);

		END;	! Else part skewed tree

	END;	! BOOLEAN
 
	RETURN;	! DATAOPR -  Do nothing
 
	BEGIN	! RELATIONAL

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);

		! Local case test of BACKST.  Global case BACKST must be
		! zero (0)

		IF .BACKST NEQ 0
		THEN
		BEGIN
			VARHOLDER = .PAE;
			IF .PAE[A1VALFLG]
			THEN
			BEGIN
				QQ = .PAE[ARG1PTR];
				IF .QQ[OPRCLS] EQL DATAOPR AND
					.QQ[OPERSP] NEQ CONSTANT
				THEN XPUNGE(.QQ,UNARY);
			END;
			IF .PAE[A2VALFLG]
			THEN
			BEGIN
				QQ = .PAE[ARG2PTR];
				IF .QQ[OPRCLS] EQL DATAOPR AND
					.QQ[OPERSP] NEQ CONSTANT
				THEN XPUNGE(.QQ,UNARY);
			END;
		END
		ELSE
		! Global optimizer should  find them.   Do not  consider
		! for  common   subexpressions  relational   expressions
		! involving  neg  flags.   To  allow  this  will   cause
		! expressions like  a  .gt.  b  and  -a  .gt.  b  to  be
		! considered as common subs - clearly wrong!
		IF(.PAE[A1NEGFLG] OR .PAE[A2NEGFLG])
		THEN	RETURN
		ELSE	IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
			THEN XPUNGE(.PAE,STGHT);

	END;	! RELATIONAL

	BEGIN	! FNCALL - function call 

		LOCAL ARGUMENTLIST TMP;

		! Step through arguments. Each argument has the function
		! node as parent

		TMP = .PAE[ARG2PTR];

		INCR I FROM 1 TO .TMP[ARGCOUNT] DO
		BEGIN
			! Set up QQ  which is a  global used  throughout
			! phase 2.

			QQ = .TMP[.I,ARGNPTR];
			REA(.QQ);
		END;

		! If optimizing  go off  and try  for array  references.
		! This is a no-op unless this is a library function.

		IF .FLGREG<OPTIMIZE>
		THEN
		BEGIN
			FNARRAY(.PAE);
			RETURN;
		END;

		! Try to eliminate library functions with one argument.

		IF ARGCONE(.PAE) THEN XPUNGE(.PAE,UNARY);

	END;	! FNCALL
 
	BEGIN	! ARITHMETIC

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);

		! Try array references

		IF .FLGREG<OPTIMIZE>
		THEN
		BEGIN
			IF NOT .PAE[A1VALFLG] THEN A1ARREF(.PAE);
			IF NOT .PAE[A2VALFLG] THEN A2ARREF(.PAE);
		END;

		! Now regular skewed

		IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
		THEN
		BEGIN
%701%			! Cannot swap arguments unless operation is + or *

%701%			IF .FLGREG<OPTIMIZE> AND ADDORMUL(PAE)
			THEN
			BEGIN	! X OP .R -> .R OP X

				REGISTER BASE T1;

				T1 = .PAE [ARG2PTR];

				IF .T1 [IDDOTR] EQL SIXBIT ".R"
				THEN
				BEGIN
					SWAPARGS(PAE);
					T1 = .PAE [DEFPT1];
					PAE [DEFPT1] = .PAE [DEFPT2];
					PAE [DEFPT2] = .T1;
				END;
			END;
			XPUNGE(.PAE, STGHT);
		END
		ELSE
		BEGIN
			QQ = .PAE[ARG1PTR];
			IF .QQ[OPR1] EQL .PAE[OPR1] AND	.PAE[OPR1] NEQ DIVOPF
			AND NOT .QQ[PARENFLG]
			AND .QQ[A2VALFLG] AND .PAE[A2VALFLG]	! N-ary with leaves
			THEN XPUNGE(.PAE,PSKEW);

			! Look down once more

			IF .PAE[A1VALFLG] AND .PAE[A2VALFLG]
			THEN XPUNGE(.PAE,STGHT);
		END;

	END;	! ARITHMETIC

	BEGIN	! TYPCNV

		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
		IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);

	END;	! TYPCNV
 
	BEGIN	! ARRAYREF

		IF .PAE[ARG2PTR] EQL 0 THEN RETURN;

		IF .PAE[A2VALFLG] AND .BACKST NEQ 0
		THEN
		BEGIN	! Special case for local only

			VARHOLDER = .PAE;
			QQ = .PAE[ARG2PTR];

			! Its  a  non-constant  leaf.  Constant   leaves
			! should have been folded into the offset.

			! The neg and/or  not flags cannot  be set.   We
			! are not prepared to hash them. In general this
			! will not prevent much  because the flags  dont
			! make a lot of sense on the subscript anyway.

			IF .QQ[OPRCLS] EQL DATAOPR AND .QQ[OPERSP] NEQ CONSTANT
%1253%			   AND .PAE[VALTYPE] NEQ CHARACTER THEN
			IF NOT .PAE[A2NEGFLG] AND NOT .PAE[A2NOTFLG]
			THEN	XPUNGE(.QQ,UNARY);
		END
		ELSE	REA(.PAE[ARG2PTR]);

	END;	! ARRAYREF

	RETURN;	! CMNSUB - Should not happen

	BEGIN	! NEGNOT

		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
		IF .PAE[A2VALFLG] THEN XPUNGE(.PAE,UNARY);

	END;	! NEGNOT

	BEGIN	! SPECOP

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
		IF .PAE[A1VALFLG] THEN XPUNGE(.PAE,UNARY);

	END;	! SPECOP

	RETURN;	! FIELDREF - Should not happen
	RETURN;	! STORECLS
	RETURN;	! REGCONTENTS
	RETURN;	! LABOP
	RETURN;	! STATEMENT
	RETURN;	! IOLSCLS -  See REAIO

	BEGIN	! INLINFN

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);

		IF .PAE[A1VALFLG] THEN
		IF .PAE[ARG2PTR] EQL 0
		THEN	XPUNGE(.PAE,UNARY);

		IF NOT .PAE[A2VALFLG] THEN
		IF .PAE[ARG2PTR] NEQ 0
		THEN	REA(.PAE[ARG2PTR]);

		IF .PAE[A1VALFLG] AND .PAE[A2VALFLG] THEN XPUNGE(.PAE,STGHT);

	END;	! INLINFN

%1431%	BEGIN	! SUBSTRING

		IF NOT .PAE[A1VALFLG] THEN REA(.PAE[ARG1PTR]);
		IF NOT .PAE[A2VALFLG] THEN REA(.PAE[ARG2PTR]);
		QQ = .PAE[ARG4PTR];
		IF .QQ[OPRCLS] NEQ DATAOPR THEN REA(.QQ);

%1431%	END;	! SUBSTRING

%1474%	BEGIN	! CONCATENATION

%1474%		LOCAL ARGUMENTLIST TMP;

%1474%		! Step through arguments.  Each argument has the function
%1474%		! node as parent.  Don't look at the first argument which
%1474%		! is the descriptor for the result.

%1474%		TMP = .PAE[ARG2PTR];

%1474%		INCR I FROM 2 TO .TMP[ARGCOUNT] DO
%1474%		BEGIN
%1474%			! Set up QQ  which is a  global used  throughout
%1474%			! phase 2.

%1474%			QQ = .TMP[.I,ARGNPTR];
%1474%			REA(.QQ);
%1474%		END;

%1474%	END	! CONCATENATION

	TES;

END;	! of REA


ROUTINE REAIO(CLSTCALL)=
BEGIN
	!***************************************************************
	! Examine the iolstcall, e1listcall, e2listcall for  expressions
	! to hash.  CLSTCALL  is a pointer  to an i/o  list.  Walk  that
	! tree looking for expressions to expunge.
	!***************************************************************

	MAP BASE CLSTCALL;
	LOCAL BASE P;

	IF .CLSTCALL[OPRCLS] EQL STATEMENT THEN RETURN;

	STHASCMN = 0;

	CASE .CLSTCALL[OPERSP] OF SET

	BEGIN		! DATACALL -  Legal only recursively

		P = .CLSTCALL[DCALLELEM];
		IF .P[OPRCLS] NEQ DATAOPR THEN
		REA(.P)

	END;		! DATACALL

	BEGIN	! SLISTCALL - Legal only recursively -  nothing to do
	END;	! SLISTCALL

	BEGIN		! IOLSTCALL

		P = .CLSTCALL[IOLSTPTR];
		WHILE .P NEQ 0 DO
		BEGIN
			REAIO(.P);
			P = .P[SRCLINK];
		END;

	END;		! IOLSTCALL

	BEGIN	! E1LISTCALL -  Nothing to do
	END;	! E1LISTCALL

	BEGIN	! E2LISTCALL -  Nothing to do
	END;	! E2LISTCALL

	TES;

END;	! of REAIO


GLOBAL ROUTINE LOCELMIO(PO)=
BEGIN
	!***************************************************************
	! Control finding of  common sub expressions  in the local  case
	! (only one done for release one) in i/o lists. Called by  ELIM.
	! Calls REAIO to walk trees
	!***************************************************************

	REGISTER BASE IOLSTT;

	MAP
		BASE PO,
		BASE BACKST;

	IF .BACKST EQL 0 THEN RETURN;

	! Reset  the  linking  pointer  for  local  common  subs.   This
	! precludes  LOCELMIO   from   ever   being   used   recursively
	! (correctly, that is).

	LOCLNK = 0;

	! PO points at i/o statement

	! There is never a common sub  on an i/o statement itself so  we
	! will zero the field.  This also helps  make sure the  globally
	! used fields are cleared.

	PO[SRCOPT] = 0;

	! Routine does local elimination on IOLSTCALL.  May later do  it
	! for E1LISTCALL and E2LISTCALL

	IF .PO[IOLIST] NEQ 0
	THEN
	BEGIN
		IOLSTT = .PO[IOLIST];
		WHILE .IOLSTT NEQ 0 DO
		BEGIN
			IF .IOLSTT[OPRCLS] NEQ STATEMENT
			THEN
			BEGIN
				IF .IOLSTT[OPERSP] EQL IOLSTCALL
				THEN
				BEGIN
					REAIO(.IOLSTT);
					LOCLDEPD();
					IOLSTT[SRCCOMNSUB] = .BACKST[SRCLINK];
					BACKST[SRCLINK] = 0;
					LOCLNK = 0
				END;
			END;
			IOLSTT = .IOLSTT[CLINK];
		END;
	END;

END;	! of LOCELMIO


	! The following few  routines are utility  routines for  dealing
	! with the expression hash table.

ROUTINE SLINGHASH=
BEGIN
	!***************************************************************
	! Clean out the expression hash table
	!***************************************************************

	MAP BASE PAE;

	DECR I FROM EHSIZ - 1 TO 0 DO
	BEGIN
		PAE = .EHASH[.I];
		WHILE .PAE NEQ 0 DO
		BEGIN
			PAE[EMPTY] = 1;
			PAE = .PAE[CLINK];
		END;
	END;

END;	! of SLINGHASH


GLOBAL ROUTINE TBLSRCH=
BEGIN
	!***************************************************************
	! Look up  an  expression in  the  expression hash  table.   The
	! routine HASHIT has filled in the global entry with the  proper
	! parameters.  Returns flag if found 1 else pointer to entry  if
	! found.  Uses globals  ENTRY and  FLAG.  If FLAG  is set  TPREV
	! points to previous entry on list if any, zero if none
	!***************************************************************

	LABEL LOKER;
	MAP PEXPRNODE P;
	LOCAL T;

	T = ABS(.(ENTRY+2) XOR .(ENTRY+1)) MOD EHSIZ;
	EHASHP = EHASH[.T]<0,0>;
	IF .EHASH[.T] EQL 0
	THEN
	BEGIN
		FLAG = 0;
		TPREV = EHASH[.T]<0,0>;
		NEDCOR = 1;
		RETURN(.TPREV);
	END
	ELSE	P = .EHASH[.T];

	TPREV = .P;
	NEDCOR = 0;
LOKER:
	DO
	BEGIN
		IF .P[EMPTY] THEN LEAVE LOKER;
		PC = .P+1;
		IF @.PC EQL .(ENTRY+1) 
		THEN
		BEGIN
			PC = .PC+1;
			IF @.PC EQL .(ENTRY+2)
			THEN
			BEGIN
				PC = .PC+1;
				IF @.PC EQL .(ENTRY+3)
				THEN
				BEGIN
					FLAG = 1;
					RETURN(.P);
				END;
			END;
		END;
		TPREV = .P;
		P = .P[CLINK];
	END UNTIL .P EQL 0;

	FLAG = 0;
	IF .P EQL 0 THEN NEDCOR = 1;
	RETURN(.TPREV);

END;	! of TBLSRCH



GLOBAL ROUTINE MAKETRY(PLACE,CNODE,SHAPE)=
BEGIN
	!***************************************************************
	! Enters an entry  into hash  table.  PLACE points  to where  it
	! goes, zero means we need core for it
	!***************************************************************

	OWN PHAZ2 ENTRYP;

	MAP
		PEXPRNODE CNODE,
		PHAZ2 PLACE;

	ENTRYP = ENTRY<0,0>;
	IF .NEDCOR
	THEN
	BEGIN
%725%		NAME<LEFT> = HSHSIZ;
		PLACE = CORMAN();
		TPREV[CLINK] = .PLACE;
	END
	ELSE	IF NOT .PLACE[EMPTY] THEN PLACE = .PLACE[CLINK];

	! It is possible that place points to a full entry which
	! points to an empty entry. Obviously, it is the empty
	! entry that we desire to use.

	PLACE[USECNT] = 1;
	PLACE[EMPTY] = 0;
	PLACE[CMNFLGS] = 0;
	PLACE[TEMPER] = 0;
	PLACE[BLKID] = .ENTRYP[BLKID];
	PLACE[HOP] = .ENTRYP[HOP];
	PLACE[HA1] = .ENTRYP[HA1];
	PLACE[HA2] = .ENTRYP[HA2];
	PLACE[HDEF1] = .ENTRYP[HDEF1];
	PLACE[HDEF2] = .ENTRYP[HDEF2];
	PLACE[LKER] = .CNODE;

%725%	! Save the  statement  pointer for  the  first instance  of  the
%725%	! expression so that we can NEXTUP later on.

%725%	PLACE[HSTMNT] = .CSTMNT;

	! If this is an arrayref zero the parent(link) field

	IF .CNODE[OPRCLS] EQL ARRAYREF THEN CNODE[PARENT] = 0;

	! The special case for local common sub-expressions of a  single
	! variable as a subscript of under a relational.  Set TEMPER  to
	! the module own VARHOLDER for  later use in UNRYMATCHER.   This
	! is the only place where a dataopr should occur.

	IF .CNODE[OPRCLS] EQL DATAOPR
	THEN	PLACE[TEMPER] = .VARHOLDER
	ELSE	CHKHAIR(.CNODE,.PLACE,.SHAPE);	! Look to  see  if  this
						! one  contains  another
						! one.
	
	RETURN .PLACE

END;	! of MAKETRY

MAP
	PHAZ2 P,
	PHAZ2 QQ,
	PHAZ2 P1,
	PHAZ2 PO,
	PHAZ2 PREV;

GLOBAL ROUTINE DELETE(NOD,NUMB)=
BEGIN
	!***************************************************************
	! TPREV  points  to  previous  node  or  node  itself  initially
	! depending on if this is the first node in its hash list.   NOD
	! points to entry  in hash  table.  Link to  beginning of  empty
	! list.  The temp T  is necessary to  insure a correct  negative
	! value
	!***************************************************************

	LOCAL TSAVE;
	LOCAL T;

	MAP PHAZ2 NOD;
	LABEL ENDLOK;

	T = .NOD[USECNT]-.NUMB;


	IF .T LEQ 0
	THEN
	BEGIN	! If T became unused

		NOD[EMPTY] = 1;
		NOD[USECNT] = 0;

		! If  optimizing  we  may  have  to  reconstruct  an  an
		! arrayref node

		IF .FLGREG<OPTIMIZE>
		THEN PUTBACKARRAY(.NOD,(IF .NOD[NBRCH] THEN SKEW ELSE STGHT));

		PREV = .NOD[CLINK];		! Prev is a temporary

		IF .PREV EQL 0 THEN RETURN;
		IF .PREV[EMPTY] THEN RETURN;

		! Link out entry that became empty and put it at the end
		! of the list.  Note  that TPREV was  set by TBLSRCH  to
		! point to the entry before NOD.

		TSAVE = TPREV[CLINK] = .PREV;

ENDLOK:
		WHILE 1
		DO
		BEGIN	! Look for end of list

			TPREV = .PREV;
			PREV = .PREV[CLINK];

			IF .PREV EQL 0
			THEN
			BEGIN
				TPREV[CLINK] = .NOD;
				NOD[CLINK] = 0;
				LEAVE ENDLOK;
			END
			ELSE	IF .PREV[EMPTY]
				THEN
				BEGIN
					NOD[CLINK] = .PREV;
					TPREV[CLINK] = .NOD;
					LEAVE ENDLOK;
				END;
		END;	! Look for end of list

		! Make the hash pointer correctly point to the new first
		! element in the  linked list  in the  case the  deleted
		! element was first

		IF @.EHASHP EQL .NOD
		THEN EHASH[.EHASHP-EHASH<0,0>] = .TSAVE;

	END	! Entry going empty
	ELSE	NOD[USECNT] = .T;	! Put new count into node

END;	! of DELETE



	! Hash node format
	! 
	! -----------------------------------
	! *                *                *
	! *     USECNT     *     CLINK      *
	! *		   *		    *
	! -----------------------------------
	! *		   *		    *
	! *  BLKID	   *    HOP	    *
	! *		   *		    *
	! -----------------------------------
	! *		   *		    *
	! *    HA1	   *     HA2	    *
	! *		   *		    *
	! -----------------------------------
	! *		   *		    *
	! *    HDEF1	   *     HDEF2	    *
	! *  		   *		    *
	! ------------------------------------
	! *                *                *
	! *     TEMPER     *      LKER      *
	! *		   *		    *
	! -----------------------------------
	! *		   *		    *
	! *   NBRCH	   *	STPT	    *
	! *		   *		    *
	! -----------------------------------
	! *		   *		    *
	! *   HSTMNT	   *	(EMPTY)	    *
	! *		   *		    *
	! -----------------------------------

	! Note: first bit of blkid is 1 if block deleted



ROUTINE LOCLMOV(CNODE)=
BEGIN
	!***************************************************************
	! Called only  in the  local common  sub-expression  elimination
	! case. TEMPER in this case  points to a common sub-  expression
	! node. A linked list of such  is made at LOCLNK, BACKST  points
	! to the top of the list.
	!***************************************************************

	MAP
		BASE CNODE,
		BASE LOCLNK,
		BASE BACKST;

	IF .LOCLNK EQL 0
	THEN
	BEGIN
		LOCLNK = .CNODE;
		BACKST[SRCLINK] = .CNODE;
	END
	ELSE
	BEGIN
		LOCLNK[SRCLINK] = .CNODE;
		CNODE[SRCLINK] = 0;
		LOCLNK = .CNODE;
	END;

END;	! of LOCLMOV


ROUTINE ARGCMN(ANODE,LG)=
BEGIN
	!***************************************************************
	! LG is local - global switch.  ANODE should be either a pointer
	! to a  cmnsub node  (local) or  an optimizer  created  variable
	! starting with .O (global) The  routine returns 1 if either  of
	! these conditions is true.  If it is returning a one the global
	! QQ also contains the  omovdcns & usecnt  fields of the  symbol
	! table entry
	!***************************************************************

	MAP
		BASE ANODE,
		BASE T;

	IF .LG
	THEN
	BEGIN
		IF OPTMP(ANODE)
		THEN
		BEGIN
			QQ<RIGHT> = .ANODE [EXPRUSE];
			QQ<LEFT> = .ANODE [OMOVDCNS];
			RETURN(1);
		END
		ELSE	RETURN(0)
	END
	ELSE
	BEGIN	! LG = 0 (local)

		IF .ANODE[OPRCLS] EQL CMNSUB
		THEN
		BEGIN
			QQ = .ANODE[EXPRUSE];
			RETURN(1);
		END
		ELSE	RETURN(0);
	END;

END;	! of ARGCMN

ROUTINE LOK1SUBS(CNODE,LG)=
BEGIN
	!***************************************************************
	! Determine if arg1 of CNODE is a :
	! 	cmnsub node (if LG = 0)
	! 	a .O temporary (if LG = 1)
	! This is the controlling case. The real work is done by ARGCMN.
	! This routine  returns  the logical  value  returned to  it  by
	! ARGCMN.
	!***************************************************************

	MAP PEXPRNODE CNODE;

	RETURN(
		CASE .CNODE[OPRCLS] OF SET

		ARGCMN(.CNODE[ARG1PTR],.LG);	! BOOLEAN
		0;				! DATAOPR
		ARGCMN(.CNODE[ARG1PTR],.LG);	! RELATIONAL
		0;				! FNCALL
		ARGCMN(.CNODE[ARG1PTR],.LG);	! ARITHMETIC
		0;				! TYPECNV
		0;				! ARRAYREF
		0;				! CMNSUB
		0;				! NEGNOT
		ARGCMN(.CNODE[ARG1PTR],.LG);	! SPECOP
		0;				! FIELDREF
		0;				! STORCLS
		0;				! REGCONTENTS
		0;				! LABOP
		0;				! STATEMENT
		0;				! IOLCLS
		ARGCMN(.CNODE[ARG1PTR],.LG);	! INLINFN
%1431%		ARGCMN(.CNODE[ARG1PTR],.LG);	! SUBSTRING
%1431%		0				! CONCATENATION

		TES);

END;	! of LOK1SUBS

ROUTINE LOK2SUBS(CNODE,LG)=
BEGIN
	!***************************************************************
	! Functions exactly  the same  as LOK1SUBS,  except on  arg2  of
	! CNODE.
	!***************************************************************

	MAP BASE CNODE;

	RETURN(
		CASE .CNODE[OPRCLS] OF SET

		ARGCMN(.CNODE[ARG2PTR],.LG);	! BOOLEAN
		0;				! DATAOPR
		ARGCMN(.CNODE[ARG2PTR],.LG);	! RELATIONAL
		0;				! FNCALL
		ARGCMN(.CNODE[ARG2PTR],.LG);	! ARITHMETIC
		ARGCMN(.CNODE[ARG2PTR],.LG);	! TYPECNV
		0;				! ARRAYREF
		0;				! CMNSUB
		ARGCMN(.CNODE[ARG2PTR],.LG);	! NEGNOT
		0;				! SPECOP
		0;				! FIELDREF
		0;				! STORCLS
		0;				! REGCONTENTS
		0;				! LABOP
		0;				! STATEMENT
		0;				! IOLCLS
		BEGIN				! INLINFN
			IF .CNODE[ARG2PTR] NEQ 0 THEN
				ARGCMN(.CNODE[ARG2PTR],.LG)
		END;
%1431%		ARGCMN(.CNODE[ARG2PTR],.LG);	! SUBSTRING
%1431%		0				! CONCATENATION

		TES);

END;	! of LOK2SUBS

ROUTINE DELLNK(CNODE)=
BEGIN
	!***************************************************************
	! Remove common  sub-expression CNODE  from the  linked list  of
	! same headed by BACKST.
	!***************************************************************

	MAP
		BASE BACKST,
		BASE PREV,
		BASE P1,
		BASE CNODE;

	! Initialize things

	PREV = .BACKST;
	P1 = .BACKST[SRCLINK];

	! Look through the list

	WHILE .P1 NEQ 0 DO
	BEGIN
		IF .P1 EQL .CNODE
		THEN
		BEGIN
			PREV[SRCLINK] = .CNODE[SRCLINK];
			RETURN;
		END;
		PREV = .P1;
		P1 = .P1[SRCLINK];
	END;

END;	! of DELLNK


ROUTINE LOCLDEPD=
BEGIN
	!***************************************************************
	! Examine linked list of  common sub-expressions. BACKST is  the
	! head of the list. Expressions are ordered from the bottom - up
	! in the tree sense.   This is the  controlling routine for  the
	! general process.   Determine  if  each  expression  has  other
	! common-subs under it.  If so, look these up in the hash table.
	! If the use count of the  subordinate equals the usecnt of  the
	! parent,  then   remove  the   little  one,   and  its   common
	! sub-expression node.
	!***************************************************************

	OWN PEXPRNODE EXPR;

	MAP
		BASE T,
		BASE PAE,
		BASE BACKST;

	EXPR = .BACKST[SRCLINK];

	! For each expression on the list

	WHILE .EXPR NEQ 0 DO
	BEGIN
		IF .EXPR[A2VALFLG]
		THEN	HASHIT(.EXPR[ARG2PTR],UNARY)
		ELSE	HASHIT(.EXPR[ARG2PTR],STGHT);

		! Look up the expression in the hash table

		PHI = TBLSRCH();

		! If there are common subs under it

		IF .PHI[CMNUNDER]
		THEN
		BEGIN
			! Look at  each arg  of the  expression.   First
			! look at real expression

			PAE = .EXPR[ARG2PTR];

			! LOK1SUBS and  LOK2SUBS  return  1  if  we  are
			! interested in this  one and the  use count  in
			! the global QQ

			IF LOK1SUBS(.PAE,0) THEN
			IF .QQ EQL .PHI[USECNT]
			THEN
			BEGIN
				T = .PAE[ARG1PTR];
				PAE[ARG1PTR] = .T[ARG2PTR];

				! Reset valflgs
 
				PAE[A1VALFLG] = 0;
				DELLNK(.T);

				! Also fix parent

				T = .PAE[ARG1PTR];
				T[PARENT] = .PAE;
			END;

			IF LOK2SUBS(.PAE,0) THEN
			IF .QQ EQL .PHI[USECNT]
			THEN
			BEGIN
				T = .PAE[ARG2PTR];
				PAE[ARG2PTR] = .T[ARG2PTR];

				! Reset valflg

				PAE[A2VALFLG] = 0;
				DELLNK(.T);

				! Fix parent too

				T = .PAE[ARG2PTR];
				T[PARENT] = .PAE;
			END;
		END;
		EXPR = .EXPR[SRCLINK];

	END;	! While

	! Cleanup the expression nodes that have expruse left in them

	EXPR = .BACKST[SRCLINK];
	WHILE .EXPR NEQ 0 DO
	BEGIN
		EXPR[EXPRUSE] = 0;
		EXPR = .EXPR[SRCLINK];
	END;

	! Also go thru the hash table and mark the entries empty

	SLINGHASH();

END;	! of LOCLDEPD
	
END
ELUDOM