Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - gcmnsb.bli
There are 12 other files named gcmnsb.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) DIGITAL EQUIPMENT CORPORATION 1974, 1983
!AUTHOR: NORMA ABEL/HPW/MD/DCE/SJW/JNG/AHM

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

!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND GCMNSV = 7^24 + 0^18 + #1505;	! Version Date:	12-Mar-82

%(

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

18	-----	-----	MAKE T A PARAMETER TO CMNLNK
19	-----	-----	DONT USE IDADDR SO DATA OPTS CAN BE DONE
20	_____	_____	FIX FINDTHESPOT TO HANDLE IOLSCLS NODES
21	-----	-----	IN MOVCNST FIX IDOPTIM SETTING AND SEARCH FOR
			NON-STATEMENT PARENT
22	-----	-----	DONT CALL CHKINIT WITH AN ARG LIST
23	-----	-----	CALL IOGELO FOR READ/WRITE/ENOCDE/DECODE
24	-----	-----	KEEP CNSMOVFLG SET THRU 2ND CALL TO MOVCNST
25	-----	-----	CALL IOGELO FOR RERED STATEMENT
26	-----	-----	IMPLDO NO LONGER A GLOBAL
27	-----	-----	ADD CHK TO DOTOHASGN TO PREVENT SELF LINKING
			WHEN IT EITHER LOOPS OR DELETES
28	-----	-----	ADD CODE TO DOTOHASGN FOR SIMPLE ASSIGNMENT MOTION
29	-----	-----	SAVE AND RESTORE ENTRY[1] IN CHKINIT
			MAKE GLOBDEPD ZERO DEFPTS IN FRONT OF THE LOOP
30	-----	-----	FIX FUMBLE IN 29
31	-----	-----	PATCH CHKDOM FOR 29
32	-----	-----	PATCHES MADE SEPARATELY ON 31,45
33	-----	-----	INSERT CODE TO UNDO ARRAY HASH ENTRIES POINTED
			TO BY EXPRESSION NODES. ROUTINE SCRUBARRAY
			AND CODE IN MOVCNST
34	-----	-----	FORGOT CALL TO SRCUBARRAY LAST TIME
35	-----	-----	FIX UP SOME ARRAY STUFF IN CHKDOM
36	-----	-----	CAUSE GLOBMOV TO SET TOLENTRY BIT IN
			SYMBOL OF .O VARIABLE
37	-----	-----	ADD PUTBACKARRAY, AND STUFF FOR ARRAY REFS
			UNDER FUNCTIONS AS COMMON SUBS
38	-----	-----	FIX PUTBACKARRAY AND SCRUBARRAY
39	-----	-----	ON CONSTANT MOTION ITERATION , SKIP INNER MORE LOOPS
40	-----	-----	ADD EDITS FROM 31,45
41	-----	-----	ADD CALL TO SCRUBARRAY IN FRONT OF SLING HASH
42	-----	-----	MAKE MAKETRY KNOW ABOUT TREE SHAPE
43	-----	-----	REMOVE ARRAY FUDGE IF EXPR DOESNT MAKE IT
			INTO THE HASH TABLE
44	-----	-----	DO NOT NEXTUP ON IOLSCLS NODES
			OUT OF MOVCNST
45	-----	-----	TYPO IN PUTBACKARRAY IS KILLING NODES
46	-----	-----	SET AND TEST NOHHASSLE BIT IN CHKDOMINANCE
47	-----	-----	FIX ORDER OF ARGS WHEN BUILDING STGHT NODES
			FROM ANRY ONES IN MOVCNST
48	-----	-----	MAKE NEWCOPY AND PUTBACKARRAY USE
			LINKED LIST OF ARRAY REFS FROM EXPRESSION
			HASH TABLE
49	_____	_____	MAKE A1 AND A2 ARREF CHECK THE VALFLG ON THE
			ARRAYREF
50	-----	-----	FNARRAY USING ARAYREF TO CALL XPUNGE INSTEAD OF
			FUNCTION REFERENCE
51	-----	-----	PUTBACKARRAY IS NOT ALWAYS
			SETTING ARY BUT ALWAYS ZEROS ARY[USECNT]
52	-----	-----	FIX ERROR MESSAGES
53	-----	-----	DITTO
54	-----	-----	CHKDOMINANCE MUST ZERO PHI FOR INVALID
			ATTEMPTS TO ENTER AN EXPRESSION
55	-----	-----	PASS NEDSANEG FOR CONSTANT MOTION COMPS
56	-----	-----	MAKE DOTOASGN COGNISCENT FO ARRAY REF STUFF
57	-----	-----	FIX A BAD RETURN FROM CHKDOMINANCE THAT DID
			NOT 'TIL NOW ZERO PHI FOR THE ARRAYREF STUFF
58	-----	-----	MAKE SURE DOTOHASGN LOOKS AT ENCODE/DECODE
			AND REREAD
59	-----	-----	FIX 58
60	-----	-----	MAJOR CHANGE IN CONCEPT IN FINDTHESPOT.
			INSERT NEW STATEMENT AFTER ALL OTHERS
			CREATED BY OPTIMIZER AT THIS POINT.
61	-----	-----	REFINE 60 A LITTLE TO PUT THE COMMON SUB
			INFRONT OF THE CURRENT STATEMENT IF WE HAPPEN
			TO RUN INTO IT.
62	-----	-----	IN CHKDOMINANCE, WHEN AN ARRAY EXPRESSION
			FAILS FOR CONSIDERATION AS A COMMON SUB,
			REPLACE THE ARRAY PART (NOW A POINTER TO
			A HASH ENTRY) WITH A UNIQUE ARRAY REF
			BY USING NEWCOPY INSTEAD OF A BLIND SUBS.
			OF THE FIRST ARRAY REF
63	-----	-----	SCAN THE PARENT POINTER CHAIN FOR AN EXPRESSION
			IN CHKDOMINANCE TO MAKE SURE THAT THE
			STATEMENT USED IN DETERMINING THE MOTION PLACE
			AND ALSO ELIGIBILITY FOR MOTION IS THE STATEMENT
			OF WHICH THE EXPRESSION IS A PART. IF CALLED THRU
			NEXTUP NOT DOING THIS MAY CAUSE ERRONEOUS MOTION
			PLACES TO BE ESTABLISHED.
64	-----	-----	63 WILL NOT WORK FOR EXPRESSIONS UNDER AN
			IMPLIED DO LOOP. MAKE SURE OPTIMIZER INFO
			IS THERE TOO.
65	-----	-----	63 IS REALLY A GOOD IDEA USE IT TO PREVENT
			BOGUS ENTRIES WHICH IS , OF COURSE, ITS PURPOSE.
66	-----	-----	MOVCNST IS GETTING CONFUSED  AND  CALLING
			NEXTUP WHEN IT SHOULD NOT
67	243	14916	INT COMP ERROR BECAUSE DOTOHASGN DOES NOT
			TEST FOR FULL OPRS FIELD.
68	244	14940	ADD CONDITION TO FINDTHESPOT
69	340	16989	PREVENT CALL TO MATCHER FROM CHANGING
			THE VALUE OF PHI., (DCE)
70	370	17938	TAKE OUT [244] - IT WAS INCORRECT, (DCE)
71	401	17813	GET HASH PTRS OUT OF TREES (ARRAYREFS), (DCE)
72	VER5	-----	TURN OFF "CSE SEEN" FLAG SO GLOBELIM RECALLABLE
			REMOVE MOVED .O FROM BUSY & POSTDOM LISTS IN DOTOHASGN
			REDUCE .R + X TO .O IN MOVCNST
			FIX DOUBLE WHILE LOOP ERROR IN GLOBDEPD
			CHECK ORFIXFLG & CALL DOTOFIX IN GLOBDEPD
			IGNORE HASH TBL ENTRIES BUILT BY DOTORFIX IN MOVCNST
			FIX BUG SO EMPTY HASH ENTRIES ARE IGNORED IN MOVCNST
			SET NOALLOC ON SUBSUMED .O IN GLOBDEPD
			CHECK GLOBELIM2 IN CHKINIT
			CHECK OMOVDCNS IN GLOBDEPD
			ZERO ONLY EXPRUSE IN GLOBDEPD
			SET OMOVDCNS IN MOVCNST
			RESET OMOVDCNS ON .O WHICH BECOMES CSE IN DOTOHASGN
			DON'T SUBSUME .O = .R + X IN DOTOHASGN
			CALL IOGELO ON 1ST GLOBELIM ONLY IN GLOBELIM &
			  THEN SET/RESET IMPLIED DO FLAG AROUND CALL, (SJW)
73	416	QA650	ZERO USECNT IN HASH TBL FOR .R+X IN MOVCNST
			  IF CAN'T MOVE .R+X SO HASH TBL ENTRY WILL
			  BE IGNORED ON NEXT LOOP THRU TBL, (SJW)
74	437	QA771	DON'T LET DOTOHASGN MOVE .O=EXPR IF .O CAME
			  FROM .R (EXPR CAN MOVE AS CONSTANT), (SJW)
75	440	QA771	DON'T NEXTUP .O IF CAME FROM .R IN MOVCNST, (SJW)
76	455	QA784	CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO IF
			  INSIDE LOGICAL IF, (SJW)
77	456	QA784	FIX FINDTHESPOT SO CALLER TELLS IT WHERE TO STOP
			ADD NEW ROUTINE FINDPA FOR GLOBMOV AND DOTOHASGN
			CALL FINDTHESPOT WITH 2ND PARAM IN GLOBMOV AND
			  DOTOHASGN, (SJW)
100	507	-----	FIX EDIT 440 TO ALLOW NEXTUP OF .O WHICH CAME
			  FROM .R IN MOVCNST IF MOM IS ARITHMETIC, (SJW)
101	513	QA771	IN MOVCNST WHEN .O IS CREATED, PASS ORFIXFLG
			  UP FROM ANY .O BEING SUBSUMED
			CHANGE [507] TO FREE VARAIBLE T IN MOVCNST, (SJW)
102	514	QA806	IN MOVCNST IF NARY, INSURE A .R IS 1ST ARG
			  SINCE [V5] CODE EXPECTS .R + X NOT X + .R, (SJW)

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

103	526	QA1035	IN CHKDOM IF FNARY AND NO MATCH ON "FUNC(ARRAYREF)",
			  PUT BACK ARRAYREF SO HASH ENTRY NOT IN TREE, (SJW)

***** Begin Version 5B *****

104	640	24971	FIX DOTOHASGN TO REMOVE THE .O ASSIGNMENT FROM
			THE DOCHNGL AND BUSY LISTS UNLESS THE ASSIGNMENT
			IS IN AN IMPLIED DO, NOT UNLESS SOME USE OF THE
			COMMON SUB IS IN AN IMPLIED DO., (JNG)
105	643	25201	DURING SECOND PASS OF CSE ELIMINATION, DO NOT
			ALLOW ARRAYREF TO BE PART OF TWO POTENTIAL CSE'S., (DCE)
106	664	QAR	SKEWED EXPRESSION WITH A1NGNTFLG IS DANGEROUS, (DCE)
107	665	QAR118	A/B/C(I)  - NEVER ALLOW B/C(I) TO BECOME CSE, (DCE)
108	706	27170	ONLY NEXTUP IF OPERATION IS ADD/SUB (NOT MUL,DIV,
			OR EXP), (DCE)
109	736	-----	BAD CODE FOR -(.R0-K) USING OPTIMIZER (V5), (DCE)

***** Begin Version 6 *****

110	1101	EGM	12-Jun-81	QAR10-05209
	Alter CHKDOMINANCE to avoid moving the motion place back to the
	expression containing the common sub.

111	1144	EGM	11-Nov-81	Q10-06632
	In MOVCNST, clear ARREFCMNSBFLG properly at the end of hash table
	walk loop. Prevents bizzare calls to NEWCOPY and ICEs.

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

1505	AHM	12-Mar-82
	Make GETOPTEMP set the psect index of optimizer temporaries to
	PSDATA for extended addressing support.

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

)%

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

REQUIRE OPTMAC.BLI;



OWN T,TS,LSTWARNLINE,PB,P1,P2,PO;

MAP BASE T:TS:PB:P1:P2:PO;

FORWARD FINDTHESPOT,PUTBACKARRAY;



ROUTINE  FINDPA  (EXPR)  =
BEGIN

!	FIND STATEMENT IN WHICH THIS EXPR IS
!	CALLED BY GLOBMOV AND DOTOHASGN FOR STOPPING POINT FOR
!	  FINDTHESPOT

	MAP PHAZ2  EXPR;
	EXTERNAL SKERR;
	LOCAL PHAZ2  P;

	P _ .EXPR [PARENT];
	WHILE  TRUE  DO
	  BEGIN
	    IF .P EQL 0
	      THEN SKERR ();		! 0 PAPA IS ERROR
	    IF .P [OPRCLS] EQL STATEMENT OR
	       .P [OPRCLS] EQL IOLSCLS
	      THEN RETURN (.P);		! FOUND PAPA STATEMENT
	    P _ .P [PARENT];
	  END;				! OF WHILE  TRUE  DO
END;					! OF ROUTINE FINDPA

ROUTINE DOTOHASGN(EXPR,PHI)=
BEGIN

	!ROUTINE CHECKS THE PARENT OF EXPR.
	!IF THE PARENT IS AN ASSIGNMENT STATEMENT OF THE FORM
	!.OXXX=EXPR THEN PHI[TEMPER] IS SET TO THE .O
	!VARIABLE. THEN THE STATEMENT IS LINKED OUT
	!OF THE TREE WHERE IT IS AND INTO THE TREE AT
	!PHI[STPT]
	!BUT ******* DONT SUBSUME (OR MOVE) .O = .R + X SINCE .R CANT
	!              MOVE OUTSIDE LOOP

	LABEL LINEAR;
	EXTERNAL SKERR,TOP;
	EXTERNAL SAVSPACE,UNLIST,LENTRY,LOOP;

	EXTERNAL  UNBUSY;

	MAP PHAZ2 TOP;
	MAP BASE EXPR:PHI;
	REGISTER BASE T:TS;

	T _ .EXPR [ARG1PTR];
	IF .T [IDDOTO] EQL SIXBIT ".R"
	  THEN RETURN;

	T_.EXPR[PARENT];
	IF .T NEQ 0 THEN
	BEGIN
		IF .T[OPRS] EQL ASGNOS AND .T[SRCISN] EQL 0 THEN
		BEGIN
			TS_.T[LHEXP];
			IF .TS[IDDOTO] EQL SIXBIT".O" THEN
			BEGIN

			!.O=EXPR CAN'T MOVE IF .O CAME FROM .R SINCE THIS ASSIGNMENT
			! STATEMENT IS .R INITIALIZATION.  EXPR CAN MOVE AS CONSTANT
			  IF .TS [ORFIXFLG]
			    THEN RETURN;
			!.O IS NOW A COMSUB EVEN IF IT MOVED AS
			! A CONSTANT TO GET HERE

			  TS [OMOVDCNS] _ 0;

				!GET STOPPING POINT FOR FINDTHESPOT
				P1 _ FINDTHESPOT (.PHI [STPT],
				                  IF .PHI [STPT] EQL .LENTRY
						    THEN .TOP
						    ELSE FINDPA (.PHI [LKER])
						 );
				!LINEAR SEARCH FOR THE STATEMENT IN
				!FRONT OF T
				P2_.TOP;
			LINEAR: WHILE .P2 NEQ 0 DO
				BEGIN
				IF .P2[SRCLINK] EQL .T THEN LEAVE
				 LINEAR;
				IF (.P2[OPRS] GEQ READOS) AND (.P2[OPRS]
				LEQ REREDOS) THEN
				BEGIN
					LOCAL BASE SAVEP2;
					SAVEP2_.P2;
					P2_.P2[IOLIST];
					WHILE .P2 NEQ 0 DO
					BEGIN
						IF .P2[SRCLINK] EQL .T THEN LEAVE LINEAR;
						P2_.P2[SRCLINK]
					END;
					P2_.SAVEP2
				END;
				P2_.P2[SRCLINK]
				END;
				IF .P2 EQL 0 THEN SKERR();
				!SET IDOPTIM FIELD SO THE WE CAN
				!GLOBLDEPD THESE LATER
				TS[IDOPTIM]_.EXPR;

				!CHECK THAT P1 (PLACE GOING) IS
				!NOT ALREADY WHERE IT IS (P2)

				IF .P1 NEQ .P2 THEN
				BEGIN
					TS_.P1[SRCLINK];
					P1[SRCLINK]_.T;
					P2[SRCLINK]_.T[SRCLINK];
					T[SRCLINK]_.TS;
				END;

				PHI[TEMPER]_.T[LHEXP];

				!IF THERE IS AN ARRAY INVOLVED THEN
				!PUT THE ARRAYREFERENCE BACK IN PLACE

				IF .PHI[A1ARY] OR .PHI[A2ARY] THEN
					PUTBACKARRAY(.PHI,STGHT);

				!IF IT MOVED OUT OF THE LOOP, TAKE IT
				!OFF THE LIST OF ITEMS THAT CHANGED IN
				!THE LOOP
				IF .PHI[STPT] EQL .LENTRY AND .LOOP NEQ  0 THEN
				BEGIN
%[640]%					!.TOP[SRCOPT] IS ZERO IF .O
%[640]%					!ASSIGNMENT IS IN AN IMPLIED DO
%[640]%					IF .TOP[SRCOPT] NEQ 0 THEN
					BEGIN
						IF UNLIST(.TOP[DOCHNGL],.T[LHEXP],CHNGSIZ) THEN
						BEGIN
							P1_.TOP[DOCHNGL];
							TOP[DOCHNGL]_.P1[RIGHTP];
							SAVSPACE(CHNGSIZ-1,.P1);
						END;
						UNBUSY (.T);	! REMOVE FROM BUSY LIST
					END;
				END;
						
			END;
		END;
	END;
END;

!**********************************
!
ROUTINE FINDTHESPOT (PLACE, BARRIER) =
!2ND PARAM FOR FINDTHESPOT IS PLACE NOT TO MOVE PAST
BEGIN
	MAP BASE PLACE;
	MAP BASE BARRIER;
	EXTERNAL PREV,CSTMNT;

		!PUT AT THE END OF ALL OTHER
		!POSSIBLE STATEMENTS AT THIS
		!POINT
		!THAT WERE CREATED BY THE OPTIMIZER. THE RATHER
		!SHAKY TEST OF SRCISN==0 IS USED.
		!THE ADDITIONAL CONSTRAINT IS ADDED THAT THE
		! STATEMENT WE ARE ABOUT TO PASS BY IS NOT
		! THE PARAM BARRIER = TOP IF PLACE = LENTRY,
		! ELSE THE STATEMENT THE ORIGINAL EXPR CAME FROM
		! (FOUND BY FINDPA FOR CALLER) FOR COMSUB BEING RELOCATED, IE,
		! CAN'T PUT .O INITIALIZATION AFTER .O USEAGE

		PREV_.PLACE;
		PLACE_.PLACE[SRCLINK];

		!DONT BOTCH UP I/O LISTS EITHER
		WHILE .PLACE[OPRCLS] EQL STATEMENT DO
			IF .PLACE[SRCISN] EQL 0
			 AND .PLACE[SRCID] EQL ASGNID
			AND .PLACE NEQ .BARRIER
			THEN
			BEGIN
				PREV_.PLACE;
				PLACE_.PLACE[SRCLINK];
			END ELSE
				RETURN(.PREV);

			.PREV
END;

ROUTINE GLOBMOV (CNODE, PHI, OTEMP) =
!PASS GLOBMOV ENTIRE HASH ENTRY FROM CMNMAK
!MOVE GLOBAL COMMON SUB-EXPRESSION TO FINAL RESTING PLACE.
BEGIN
	EXTERNAL LOOP,MAKASGN,LENTRY,TOP;
	MAP BASE LOOP;
	MAP PHAZ2 PHI:OTEMP:CNODE;
	LOCAL PHAZ2  PLACE;
!CALLED BY GLOBAL OPTIMIZER ONLY.
!CNODE WILL POINT TO THE COMMON SUB-EXPRESSION ITSELF. (NOT
!A COMMON SUB-EXPRESSION **NODE**.
!PLACE POINTS TO THE PLACE WHERE THE STATEMENT THAT IS BUILT
!WILL BE LINKED IN. OTEMP IS THE LHS OF THE STATEMENT.

!THE BASIC FUNCTION OF THE ROUTINE IS TO BUILD T=CMNSB STATEMENT
!AND LINK IT INTO THE ENCODED SOURCE TREE.

		!GENERATE
		!  T=EXPRESSION NODE
		!MAKE SOURCE NODE
		!****NOTE****
		!CANNOT SET EXPRESSION PARENT
		!AS TEMP IS NOT YET LINKED
		!BACK IN. MUST SET PARENT IN
		!GLOBLDEPD

		P1_.CNODE[PARENT];
		PO_MAKASGN(.OTEMP,.CNODE );
		CNODE[PARENT]_.P1;

		!RETURNS POINTING TO THE PLACE TO
		!PUT IT.
		!CALL FINDTHESPOT WITH 2ND PARAM = PLACE TO STOP
		PLACE _ .PHI [STPT];
		P1 _ FINDTHESPOT (.PLACE,
				  IF .PLACE EQL .LENTRY
				    THEN .TOP
				    ELSE FINDPA (.PHI [LKER])
				 );
		!LINK IT IN

		PO[SRCLINK]_.P1[SRCLINK];
		P1[SRCLINK]_.PO;

		!IF MOVED OUT OF THE LOOP THEN SET TOLENTRY BIT

		IF .PLACE EQL .LENTRY THEN
			OTEMP[IDATTRIBUT(TOLENTRY)]_1;

END;
GLOBAL ROUTINE GETOPTEMP(VTYP)=
BEGIN
! Create a .O temporary for the optimizer
EXTERNAL
	TBLSEARCH,	! Searches hash table NAME for ENTRY
	VERYFRST;	! The counter for naming .Onnnn variables

REGISTER
	BASE HEAD;

	NAME_IDTAB;			! Specify symbol table
	ENTRY_SIXBIT'.O'+MAKNAME(VERYFRST);	! Derive the .Onnnn name
	VERYFRST_.VERYFRST+1;		! Increment the name counter
	HEAD_TBLSEARCH();		! Look it up in the symbol table
	HEAD[VALTYPE]_.VTYP;		! Set the type
%1505%	HEAD[IDPSECT]=PSDATA;		! Put the temp in the .DATA. psect
	RETURN .HEAD
END;
ROUTINE CHKINIT(VAR)=
BEGIN
	!ROUTINE CHECKS TO SEE WHETHER OR NOT VAR IS
	!INITIALIZED

!	NO WARNINGS ON 2ND GLOBELIM SINCE THEY WERE GIVEN ON 1ST PASS

	MAP BASE VAR;
	EXTERNAL WARNERR;
	!IT IS NOT INITIALIZED (WE ALREADY KNOW ITS A MAIN SECTION OF CODE
	!AND THE DEFINITION POINT IS LENTRY) IF
	!	1. IT IS NOT IN A DATA STATEMENT
	!	2. IT IQ NOT A FORMAL
	!	3. IT IS NOT A CONSTANT
	!	4. IT IS NOT IN COMMON
	!	5. IT IS NOT IN AN EQUIVALENCE STATEMENT

	!DO NOT ALLOW CHECK ON COMPILER VAR (.O, .R) !

	!FOR THE ARRAY REFERENCE STUFF, CHECK FOR OPRCLS EQL DATAOPR
	!IF WE ARE PASSING A HASH TABLE ENTRY THE OPRCLS FIELD
	!JUST HAPPEND TO MATCH THE HOP FIELD SO A CHECK ON OPRCLS
	!IS VALID

	MACRO  IDDOT  =  0,3,30,6$;

	IF .GLOBELIM2			! NO WARNINGS ON 2ND PASS
	  THEN RETURN;

	IF .VAR[OPRCLS] NEQ DATAOPR THEN RETURN;

	IF .VAR [IDDOT] EQL SIXBIT "."	! CANT CHECK COMPILER VARS
	  THEN RETURN;

	IF NOT .VAR[IDATTRIBUT(INDATA)] AND
	   .VAR[OPR1] NEQ CONSTFL AND
	   NOT .VAR[FORMLFLG]
	   AND NOT .VAR[IDATTRIBUT(INCOM)]
	   AND NOT .VAR[IDATTRIBUT(INEQV)]
	   AND .LSTWARNLINE NEQ .VAR THEN
	BEGIN
		!NOTE THE MISSING DOT IS DELIBERATE.
		EXTERNAL ISN;
		WARNERR(VAR[IDSYMBOL],.ISN,E79<0,0>);
		LSTWARNLINE_.VAR;
	END;
END;

FORWARD NEWCOPY;
ROUTINE CHKDOMINANCE(CNODE,SHAPE)=
BEGIN


EXTERNAL TOP,LENTRY,MAKETRY,BOTTOM,PHI,NAN,MATCHER,HASHIT,TBLSRCH;
EXTERNAL LOOP,LEND,WARNERR,SKERR,ISN,A1NODE;
MAP BASE A1NODE:PHI;
LOCAL ADJPLACE;		!FLAG TO SET PLACE BACK TO CORRECT PLACE
LOCAL BASE APHI;	!HOLDS HASH POINTER FOR ARRAY ENTRY TO UNDO
MAP PHAZ2 PB;
LOCAL BASE PLACE;
EXTERNAL CSTMNT;	!POINTS TO THE STATEMENT
MAP BASE CSTMNT;
OWN BASE TAININGSTMT;

LOCAL ARGUMENTLIST AG;
	OWN DEF1PLACE,DEF2PLACE;

!******
!MAKE SURE THAT THE PLACE TO WHICH MOTION WOULD OCCUR
!HAS THE CURRENT STATEMENT (CSTMNT POINTS TO IT) AS POSTDOMINATOR.
!THIS INVOLVES:
!	1.DETERMINING THE PLACE TO WHICH MOTION WOULD OCCUR.
!	2.LOOKING FOR CSTMNT ON THE PREDOMINATOR LIST OF
!	  THE PLACE TO WHICH MOTION WOULD OCCUR.
!	3. IF 2 IS FALSE THEN THE PARENFLG IS SET ON THE
!	 STATEMENT (IF AN ASSIGNMENT). THIS IS A FUDGE TO
!	PERMIT LOOKING FOR LOCAL COMMON SUBS IN SUCH
!	STATEMENTS AT THE END OF OPTIMIZATION (PHA2).

MAP PEXPRNODE CNODE;
	!TAKE ARRAY REFERENCES OFF THE TOP

!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*
PHI_0;


IF .SHAPE GTR SKEW THEN
BEGIN

	CASE .SHAPE-STAR1 OF SET

	!STAR1
	!STRAIGHT NODE WITH ARRAYREF AS ARGUMENT 1

	    CHKDOMINANCE(.CNODE[ARG1PTR],UNARY);

	!STAR2
	!STRAIGHT NODE WITH ARRAYREF AS ARGUMENT 2

	    CHKDOMINANCE(.CNODE[ARG2PTR],UNARY);

	!SKAR1
	!SKEWED NODE WITH ARRAYREF AS ARG 1
	BEGIN

		PB_.CNODE[ARG1PTR];
![643] IF WE GET HERE, WE ARE ABOUT TO HASH AN ARRAY REF IN ORDER TO
![643] BUILD A SKAR1 SHAPED HASH ENTRY.  BEFORE DOING THIS, MAKE SURE
![643] THAT THE ARRAY REF HAS NOT ALREADY BEEN HASHED (STRAIGHT)
![643] WITH A LEAF ON ITS OWN LEVEL IN WHICH CASE WE CANNOT
![643] HASH IT AGAIN, SO SET PHI TO ZERO (FAILURE) AND GET OUT!
%[643]%		IF .PB[A1VALFLG] THEN PHI_0 ELSE
		CHKDOMINANCE(.PB[ARG2PTR],UNARY);
	END;

	!SKAR2
	!SKEWED NODE WITH ARRAYREF AS ARG 2

	    CHKDOMINANCE(.CNODE[ARG2PTR],UNARY);

	!FNARY
	!LIBRARY FUNCTION REF WITH ARRAYREF AS ARGUMENT

	BEGIN
		AG_.CNODE[ARG2PTR];
		CHKDOMINANCE(.AG[1,ARGNPTR],UNARY);
	END

	TES;
	IF .PHI NEQ 0 THEN
	BEGIN

		!SAVE HASH POINTER FOR LATER UNDO IF REQUIRED
		APHI_.PHI;

		CASE .SHAPE-STAR1 OF SET

		!STAR1
		    FUDGA1;
		!STAR2
		    FUDGA2;
		!SKAR1
		BEGIN
			A1NODE_.CNODE[ARG1PTR];
			A1NODE[ARG2PTR]_.PHI;
			A1NODE[DEFPT2]_.PHI[STPT];
		END;
		!SKAR2
		    FUDGA2;
		!FNARY
		BEGIN
			AG_.CNODE[ARG2PTR];
			AG[1,ARGNPTR]_.PHI;
			PLACE _ .CNODE [DEFPT2];	! SAVE DEFPT2
			CNODE[DEFPT2]_.PHI[STPT];

			PHI_0;
			CHKDOMINANCE(.CNODE,UNARY);

			IF .PHI NEQ 0
			  THEN PHI [A2ARY] _ 1
			  ELSE BEGIN			! PUT BACK ARRAYREF
			    AG [1,ARGNPTR] _ NEWCOPY (.AG [1,ARGNPTR], .CNODE);	! ARRAYREF'S DAD IS CNODE = FNCALL
			    CNODE [DEFPT2] _ .PLACE;	! RESTORE DEFPT2
			  END;

			RETURN;
		END

		TES;

		PHI_0;

		NOHHASSLE_0;

		CHKDOMINANCE(.CNODE,(IF .SHAPE GEQ SKAR1 THEN SKEW
					ELSE STGHT));
		IF .PHI NEQ 0 THEN
		BEGIN

			!SET COMMENTS IN OPTMAC FOR NOHHASSLE BIT
			!REQUIREMENTS
			!BRIEFLY, PHI COULD POSSIBLY NOT BE
			!'THE' HASH ENTRY FOR THE ARRAY EXPR
			!IT COULD BE AN ENTRY THAT WAS MADE BECAUSE
			!OF ONE OR MORE MATCHES (NEXTUP, ETC.).
			!NOHHASSLE IS SET IF THIS IS A @POSSIBILITY.

			IF .NOHHASSLE THEN RETURN;
			IF .SHAPE EQL STAR1
			    OR .SHAPE EQL SKAR1 THEN
	
			    PHI[AR1ARY]_1
			ELSE
			    PHI[AR2ARY]_1;
		END ELSE
		!THE EXPRESSION A OP ARRAYREF DID NOT
		!QUALIFY TO BE HASHED OR MATCHED (PHI IS 0)
		!SO WE WANT TO UNDO THE ARRAYREF HASH POINTERS
		!FROM THE EXPRESSION NOW.
		BEGIN
			CASE .SHAPE-STAR1 OF SET

			!STAR1
			BEGIN
				CNODE[ARG1PTR]_NEWCOPY(.APHI,.CNODE);
				CNODE[DEFPT1]_0;
			END;

			!STAR2
			BEGIN
				CNODE[ARG2PTR]_NEWCOPY(.APHI,.CNODE);
				CNODE[DEFPT2]_0;
			END;

			!SKAR1
			BEGIN
				A1NODE_.CNODE[ARG1PTR];
				A1NODE[ARG2PTR]_NEWCOPY(.APHI,.A1NODE);
				A1NODE[DEFPT2]_0;
			END;

			!SKAR2
			BEGIN
				CNODE[ARG2PTR]_NEWCOPY(.APHI,.CNODE);
				CNODE[DEFPT2]_0;
			END

			!SHOULD NOT BE HERE WITH FNARY
			TES;
		END;
	END;
	RETURN;
END;
	!IF EITHER DEFPT IS THE CURRENT STATEMENT DO NOT
	!CONSIDER THIS STATEMENT FOR GLOBAL COMMON SUBS.
	!DO NOT SET THE FLAG TO CAUSE IT TO GET LOCAL ONES EITHER.
	!IF SUCH WERE DONE TROUBLE MIGHT INSUE. IT WOULD ALOS WASTE
	!TIME.

	IF
	BEGIN
		%(
		IF NODE IS UNARY OR STGHT WE WANT TO CHECK
		DEFPT1. IF NODE IS SKEW LOOK AT DEFPT2 IN THE
		DAUGHTER OF THE CURRENT EXPRESSION
		)%
		IF .SHAPE NEQ SKEW
		THEN
			.CNODE[DEFPT1] EQL .CSTMNT
		ELSE
		BEGIN
			A1NODE_.CNODE[ARG1PTR];
			.A1NODE[DEFPT2] EQL .CSTMNT
		END
	END
	OR .CNODE[DEFPT2] EQL .CSTMNT THEN RETURN;


	!IN THE FOLLOWING ALGORITHMS, SET TAININGSTMT TO
	!BE THE STATEMENT THAT DOES INDEED CONTAIN THE
	!EXPRESSION WE ARE CONSIDERING.

	TAININGSTMT_.CNODE;

	UNTIL .TAININGSTMT[OPRCLS] EQL STATEMENT
	OR    .TAININGSTMT[OPRCLS] EQL IOLSCLS
	DO
	BEGIN
		TAININGSTMT_.TAININGSTMT[PARENT];
		IF .TAININGSTMT EQL 0 THEN SKERR();
	END;

	IF (.TAININGSTMT[OPRCLS] NEQ STATEMENT)
	OR (.TAININGSTMT[SRCOPT] EQL 0) THEN
	   TAININGSTMT_.CSTMNT;

	!AS A TIME TRADE OFF, LOOK IT UP FIRST. IF ALREADY
	!THERE WE DO NOT HAVE TO HASSLE WITH DETERMINING IF
	!IT SHOULD GO THERE OR NOT

	HASHIT(.CNODE,.SHAPE);
	PHI_TBLSRCH();
	!SAVE VALUE OF PHI AGAINST CHANGE IN CALLS FROM MATCHER
	IF .FLAG THEN BEGIN
	!THE FOLLOWING CODE ENSURES THAT PHI GETS SET TO
	! ZERO IN THE CASE THAT MATCHER FAILED WHEN DEALING WITH AN
	! ARRAY REFERENCE.  IT HAS THE EFFECT OF KEEPING POINTERS TO
	! HASH TABLE ENTRIES (ARRAYREFS) OUT OF THE STATEMENT TREES SO
	! THAT THEY CAN NEVER BE LEFT THERE INADVERTENTLY.
				LOCAL T;
				T_.PHI[USECNT];
				APHI_.PHI;
				MATCHER(.CNODE,.SHAPE,.NAN,.PHI);
				PHI_.APHI;
				IF (.PHI[USECNT] EQL .T) AND
					(.SHAPE EQL SKEW) AND
					.ARREFCMNSBFLG
				THEN PHI_0;
				RETURN
			END;
	BEGIN

		!MUST TAKE SHAPE INTO CONSIDERATION
		IF .SHAPE EQL SKEW THEN
		BEGIN
			A1NODE_.CNODE[ARG1PTR];
			DEF1PLACE_.A1NODE[DEFPT2];
			DEF2PLACE_.CNODE[DEFPT2];
			!MAKE A1NODE BE LOGICAL ARG1
			A1NODE_.A1NODE[ARG2PTR];
		END ELSE
		BEGIN
			DEF1PLACE_.CNODE[DEFPT1];
			DEF2PLACE_.CNODE[DEFPT2];
			A1NODE_.CNODE[ARG1PTR];
		END;
		!IF BOTH DEF POINTS ARE THE SAME NO MORE WORK IS NEEDED
		IF .DEF1PLACE EQL .DEF2PLACE THEN
			PLACE_.DEF1PLACE
		ELSE
		BEGIN


			!UNLESS THE EXPRESSION IS SKEW
			!WE DON'T WANT TO RECONSIDER HER
			IF .CNSMOVFLG THEN RETURN;

			!FOR TYPE CONVERSIONS
			!    NEGNOTS
			!    FUNCTION REFS (LIBRARY)
			!DEF1PLACE IS ZERO. SO, USE DEF2PLACE
			!AND SKIP THE LOOK

			IF (.SHAPE EQL UNARY)
			   AND (.DEF1PLACE EQL 0)
			   AND (.DEF2PLACE NEQ 0) THEN
				PLACE_.DEF2PLACE
			ELSE
			BEGIN
				!CHECK AGAIN NOW THAT SHAPE HAS BEEN
				!CONSIDERED IN SETTING DEF1PLACE
				!AND DEF2PLACE AND WE ARE SURE THAT
				!TAININGSTMT  IS SET UP.

				IF (.DEF1PLACE EQL .TAININGSTMT) OR
				   (.DEF2PLACE EQL .TAININGSTMT) THEN
				BEGIN
					PHI_0;
					RETURN;
				END;

				!NOW ON TO THE REAL ANALYSIS (AT LAST!)
				PB_.TAININGSTMT;		!PB IS TEMP
				DO
					PB_.PB[PREDOM]
				UNTIL .PB EQL .DEF1PLACE
				OR   .PB  EQL .DEF2PLACE
				OR   .PB EQL .TOP;
				PLACE_.PB;
				!WE CAN ONLY LOOK AS FAR AS TOP BUT MAYBE IT IS
				!REALLY SUPPOSED TO BE LENTRY
				IF .PB EQL .TOP THEN
					IF .DEF1PLACE NEQ .TOP THEN
						IF .DEF2PLACE  NEQ .TOP THEN
							PLACE_.LENTRY;
	
			END;
		END;

		!LOOK FOR SPECAIL CONSTANT MOTION CASE.
		!WORK ALREDY DONE JUST SET STPT AND QUIT
		IF .CNSMOVFLG THEN
		BEGIN
			IF .PLACE NEQ .LENTRY THEN RETURN;
			PHI_MAKETRY(.PHI,.CNODE,.SHAPE);
			IF .SHAPE EQL SKEW THEN PHI[NBRCH]_1;
			IF .NAN THEN PHI[NEDSANEG]_1;
			PHI[STPT]_.LENTRY;
			RETURN;
		END;

		!CHECK FOR VARIABLE INITIALIZED
		!NO MATTER THE SHAPE OF THE NODE A1NODE NOW POINTS
		!TO LOGICAL ARG1 AND CNODE[ARG2PTR] TO LOGICAL ARG2.
		!DEF1PLACE AND DEF2PLACE POINT TO THE CORRESPONDING
		!DEFINITION POINTS. WE WILL NOW USE THIS INFO
		!TO CHECK FOR THE VARIBALE BEING INITIALIZED

		IF .LOOP EQL 0 THEN	!MAIN COFE SECTION
		BEGIN
			IF .DEF1PLACE EQL .LENTRY THEN
				CHKINIT(.A1NODE);
			IF .DEF2PLACE EQL .LENTRY THEN
			BEGIN
				!CHECK FOR A FUNCTION CALL
				!AND GET THE ARG
				IF .CNODE[OPRCLS] EQL FNCALL THEN
				BEGIN
					REGISTER ARGUMENTLIST AG;
					AG_.CNODE[ARG2PTR];
					CHKINIT(.AG[1,ARGNPTR]);
				END ELSE
					!REGULAR CASE
					CHKINIT(.CNODE[ARG2PTR]);
			END;
		END;
		!PLACE NOW POINTS TO THE STATEMENT THAT IS THE DEFPT OF THE
		!EXPRESSION.  WE CHECK TO SEE IF PA POSTDOMINATES PLACE
		!IF THIS IS A MAIN PROGRAM LENTRY (WHICH COULD POSSIBLY BE THE
		!VALUE OF PLACE AT THIS POINT) IS THE  DUMMY CONTINUE WHICH
		!DOES NOT HAVE THE OPTIMIZERS WORDS (POSTDOM, PREDOM ,ETC.)
		!THEREFOR, WE WILL TEST AND ADJUST

		IF .PLACE EQL 0 THEN
		BEGIN
			PHI_0;
			RETURN;
		END;

		ADJPLACE_0;
		IF .PLACE EQL .LENTRY THEN
			(PLACE_.TOP;
				ADJPLACE_1);
	
		PB_.PLACE;		!PS IS TEMP AGAIN
		DO
			PB_.PB[POSTDOM]
		UNTIL .PB EQL .TAININGSTMT
		OR    .PB EQL .BOTTOM
		OR    .PB EQL .LEND
		OR    .PB EQL 0;
		IF .PB EQL 0 THEN SKERR();
		!THE GRAPH IS BAD CALL SKERR FOR NOW.
		IF .PB EQL .LEND OR .PB EQL .BOTTOM THEN
		BEGIN
			!MAKE SURE PHI IS ZERO FOR THE UNSUCCESSFUL
			!ATTEMPT.
			PHI_0;
			RETURN;
		END;

		PHI_MAKETRY(.PHI,.CNODE,.SHAPE);
		IF .SHAPE EQL SKEW THEN
		PHI[NBRCH]_1;
		IF .NAN THEN PHI[NEDSANEG]_1;
		IF .ADJPLACE THEN 
			PHI[STPT]_.LENTRY
		ELSE
		BEGIN
			!TO PREVENT MOTION INTO A LOOP.
			!THE POTENTIAL EXISTS IS A STRUCTURE LIKE
			!DO
			!IF () 10,10,20
			!10	CONTINUE
			!20	COMPUTE
			IF (.PLACE NEQ .TOP) AND (.PLACE[SRCID] EQL DOID) THEN
			BEGIN
				PB_.PLACE[DOLBL];
![1101] Fix the modified motion place at the continue of the DO,
![1101] instead of just past it, to avoid the possibility of moving it
![1101] to the actual statement containing the common sub.
%[1101]%			PLACE_.PB[SNHDR]
			END;
			PHI[STPT]_.PLACE;
		END;
	END;
END;
!
!***************************************************
!

EXTERNAL EHASH; 
GLOBAL ROUTINE MOVCNST =
BEGIN
!MOVE ALL REGION CONSTANT EXPRESSIONS OUT OF THE LOOP

	MACRO  IDDOTR  =  0,3,24,12$;
	EXTERNAL  DOTRCNTOK, DOTORFIX;


	LOCAL BASE HASHP;
	EXTERNAL QQ,CSTMNT,ISN,SKERR,CMNMAK;
	LABEL GOT1;
	MAP BASE PB:QQ:CSTMNT:T;
	EXTERNAL EHASHP,LENTRY,MAKEPR,NARY2,STPRECLUDE,CMNLNK,NEXTUP;
	OWN CNSTTOGO;
	EXTERNAL MAKASGN;
	LOCAL BASE CNODE;	!USED TO POINT TO EXPRESSION
	EXTERNAL LOKCALST;

	LOCAL BASE  DOTO;
	LABEL  LWHILE;

	!ITERATE THROUGH THE HASH TABLE UNTIL THERE ARE NO MORE
	!TO MOVE.
	CNSTTOGO_1;
	WHILE .CNSTTOGO DO
	BEGIN
		CNSTTOGO_0;
		INCR K FROM 0 TO EHSIZ-1 DO
		BEGIN
			EHASHP_EHASH[.K]<0,0>;
			HASHP_.EHASH[.K];
			WHILE .HASHP NEQ 0 DO
			BEGIN
LWHILE:			  BEGIN
			    IF .HASHP [EMPTY]		! NOT IN USE ?
			      THEN LEAVE LWHILE;	! IGNORE IT
			    DOTO _ .HASHP [TEMPER];
			    IF .DOTO NEQ 0  THEN
			    IF .DOTO [ORFIXFLG]	! EXPR BUILT BY DOTORFIX
			      THEN LEAVE LWHILE;	! DONT TOUCH IT

				!SET FLAG FOR ARRAY STUFF IS APPROPRIATE

				IF .HASHP[A1ARY] OR .HASHP[A2ARY] THEN
%[1144]%					ARREFCMNSBFLG_1;


				!NOW CHECK FOR CONSTANT MOTION

		GOT1:
				IF (.HASHP[STPT] EQL .LENTRY)		!PLACE TO GO IS ENTRY
				AND
				(.HASHP[USECNT] EQL 1)	!WASN'TA COMMON
							!SUB-EXPRESSION
				THEN
				BEGIN

					!DO NOT BE HASTY. IF THIS IS AN
					!ARRAY REFERENCE, SKIP IT ANYWAY

					IF .HASHP[OPRCLS] EQL ARRAYREF THEN
					BEGIN
						HASHP[USECNT]_0;
						LEAVE GOT1;
					END;

					CNSTTOGO_1;
					!SET FLAG IN HASH TABLE
					!SO WE CAN GLOBDEPD
					HASHP[MOVDCNS]_1;
					!MAKE AN ASSIGNMENT STATEMENT
					!OF .OXXXXX=EXPRESSION
					CNODE_.HASHP[LKER];

					!TRY SUBSUMPTION
					IF NOT .HASHP[NBRCH] THEN
						DOTOHASGN(.CNODE,.HASHP);
					!IF IT WAS SUBSUMED
					DOTO _ .HASHP [TEMPER];
					IF .DOTO NEQ 0 THEN
					BEGIN
						HASHP[USECNT]_0;
						DOTO [OMOVDCNS] _ 1;
						LEAVE GOT1;
					END;



				!IF THE EXPRESSION IS NARY MAKE A
				!STRAIGHT ONE, AND DO THE ELIMINATION
				!HASSLE (SEE MATCHER, NARY2 FOR
				!BLOODY DESCRIPTION OF THE COMPLETE HASSLE).
				IF .HASHP[NBRCH] THEN
				BEGIN		!OMIGOD ITS NARY
					!ON THE OTHERHAND IT MAY
					!HAVE BEEN NARY BUT ISNT ANY
					!MORE. CHECK AND RESET NBRCH
					!FOR FUTURE TESTS.
					IF .CNODE[A1VALFLG] THEN
					BEGIN
						HASHP[NBRCH]_0;
						!SET PB
						PB_.CNODE;
					END
					ELSE
					BEGIN		!U LOSE ITS NARY
						QQ_.CNODE[ARG1PTR];
						!IF NARY INSURE .R IS 1ST ARG SINCE [V5] CODE EXPECTS .R + X
						T _ .CNODE [ARG2PTR];
						IF .T [IDDOTR] EQL SIXBIT ".R" AND
						   .CNODE [OPRCLS] EQL ARITHMETIC
						  THEN BEGIN
						    PB _ MAKEPR (.CNODE [OPRCLS],
								 .CNODE [OPERSP],
								 .CNODE [VALTYPE],
								 .CNODE [ARG2PTR],
								 .QQ [ARG2PTR]);
						    PB [A1FLGS] _ .CNODE [A2FLGS];
						    PB [A2FLGS] _ .QQ [A2FLGS];
						    PB [DEFPT1] _ .CNODE [DEFPT2];
						    PB [DEFPT2] _ .QQ [DEFPT2];
						  END
						  ELSE BEGIN
![664] QUIT IF NGNTFLG SET ON TOP NODE
%[664]%						IF .CNODE[A1NGNTFLGS] NEQ 0 THEN (HASHP[USECNT]_0; LEAVE GOT1);
						PB_MAKEPR(.CNODE[OPRCLS],
						.CNODE[OPERSP],
						.CNODE[VALTYPE],
						.QQ[ARG2PTR],
						.CNODE[ARG2PTR]);
						!SET THE FLAGS
						PB[A1FLGS]_.QQ[A2FLGS];
						PB[A2FLGS]_.CNODE[A2FLGS];
						!SET THE DEFPTS
						PB[DEFPT1]_.QQ[DEFPT2];
						PB[DEFPT2]_.CNODE[DEFPT2];
						  END;
						NARY2(.CNODE);
					END;
				END ELSE
				BEGIN
					!IT STRAIGHT, SO DO THE NARY/
					!STRAIGHT THING. ALSO SET UP PB
					STPRECLUDE(.CNODE);
					PB_.CNODE;
				END;

				!BUILD NODE AND LINK IT IN
						! CHECK .R + X -> .O
				T _ .PB [ARG1PTR];	! REA MAKES .R 1ST ARG
				IF .PB [OPR1] EQL ADDOPF AND
				   .T [IDDOTR] EQL SIXBIT ".R"
				  THEN BEGIN
					! .R USE CNT = 1 IFF ONLY USE OF
					! OF .R IN LOOP IS .R <- .R + Z
				    IF DOTRCNTOK (.T)
![736] IF USING DOTORFIX, THEN MUST BE VERY CAREFUL WITH HOW THE
![736] USAGE OF THE .O VARIABLE GETS SET UP (NAN = 0).
%[736]%				      THEN ( T _ DOTORFIX (.PB, .HASHP);
%[736]%					QQ_CMNLNK(.T,.CNODE,
%[736]%						IF .HASHP[NBRCH] THEN SKEW ELSE STGHT,
%[736]%						0,.HASHP))
				      ELSE BEGIN		! CAN'T TOUCH IT
					HASHP [USECNT] _ 0;	! IGNORE THIS ENTRY ON NEXT PASS
					LEAVE GOT1;
				      END
				  END
				  ELSE
%[736]%				  BEGIN T _ CMNMAK (.PB,		!EXPRESSION
					 .HASHP[NEDSANEG],	!NEEDS A NEG
					 .HASHP);		!POINTER TO HASH


				QQ_CMNLNK(.T,.CNODE,IF .HASHP[NBRCH] THEN SKEW
						ELSE STGHT,.HASHP[NEDSANEG],
%[736]%						.HASHP)
%[736]%				END;


				DOTO _ .HASHP [TEMPER];
				DOTO [OMOVDCNS] _ 1;

				!PASS UP ORFIXFLG FROM ANY .O UNDER THIS ONE
				IF .PB [A1VALFLG]
				  THEN BEGIN
				    T _ .PB [ARG1PTR];
				    IF .T [IDDOTO] EQL SIXBIT ".O"
				      THEN DOTO [ORFIXFLG] _ .DOTO [ORFIXFLG] OR .T [ORFIXFLG];
				  END;
				IF .PB [A2VALFLG]
				  THEN BEGIN
				    T _ .PB [ARG2PTR];
				    IF .T [IDDOTO] EQL SIXBIT ".O"
				      THEN DOTO [ORFIXFLG] _ .DOTO [ORFIXFLG] OR .T [ORFIXFLG];
				  END;

				!CHKDOMINANCE DEPENDS ON CSTMNT
				!POINTING TO THE STATEMENT.THEREFORE,
				!WE WILL FOLLOW THE PARENT LINKS UNTIL
				!!!WE FIND THE STATEMENT
				CSTMNT_.QQ;
				UNTIL .CSTMNT[OPRCLS] EQL STATEMENT OR
					.CSTMNT[OPRCLS] EQL IOLSCLS DO
				BEGIN
					CSTMNT_.CSTMNT[PARENT];
					!!QUIT  ON ERROR
					IF .CSTMNT EQL 0 THEN SKERR();
				END;
				!IF WE ARE AT A STATEMENT THAT IS CURRENTLY
				!BEING OPTIMIZED
				!CAN'T NEXTUP (IE, TRY TO COMBINE INTO BIGGER COMSUB) THIS
				! .O'S MOM IF THIS .O CAME FROM .R SINCE .O NOT REALLY CONSTANT
				!UNLESS MOM IS ARITHMETIC SINCE ADDITIONAL CONSTANT TERMS
				! WILL LEAVE ENTIRE EXPR TO VARY ONLY WITH THE .R INCR
				! WHICH BECAME THIS .O'S INCR AT END OF LOOP
				IF (.CSTMNT[OPRCLS] EQL STATEMENT) AND
				   (.CSTMNT[SRCOPT] NEQ 0)         AND
![706] WE CAN ONLY NEXTUP THIS KIND OF EXPRESSION IF THE
![706] OPERATION IS ADD OR SUBTRACT (NOT MUL,DIV, OR EXP WHICH ARE
![706] BOTH MUCH MORE DIFFICULT AND NOT WORTH THE EFFORT).  MAKE THE
![706] TEST CORRECT - THIS REPLACES PART OF EDIT 513
%[706]%				   (NOT .DOTO [ORFIXFLG] OR ADDORSUB(QQ))
				THEN
				BEGIN
					ISN_.CSTMNT[SRCISN];
					!SEE IF THERE IS NOW ANOTHER
					!ONLY IF CSTMNT IS NOT AN IOLSCLS NODE
					NEXTUP(.QQ);
				END;

				!MAKE SURE WE DO NOT CONSIDER THIS ONE AGAIN
				HASHP[USECNT]_0;
			END;		!IF STATEMENT
			    END;	! OF LWHILE
			  HASHP_.HASHP[CLINK];
%[1144]%			ARREFCMNSBFLG_0;	! MAKE SURE ARRAY FLAG IS OFF
			END;			!WHILE
		END;				!INCR
	END;		!WHILE ON CNSTTOGO
END;
ROUTINE GLOBDEPD (CURVERYFRST) =
BEGIN

	!CURVERYFRST IS SIXBIT VALUE OF VERYFRST BEFORE THIS LOOP WAS
	!  PROCESSED => ONLY GLOBDEP THOSE .O GEQ CURVERYFRST, IE,
	!  ONLY THOSE CREATED FROM THIS LOOP

	!FOR GLOBAL OPTIMIZATION ONLY
	!LOOK FOR GROUPS OF STATEMENTS CREATED BY THE OPTIMIZER
	!FOR COMMON SUB-EXPRESSION ELIMINATION OR CONSTANT COMPUTATIONS.
	!WHEN FOUND, LOOK AT GLOBAL COMMON SUB TEMPS, HASH
	!THE EXPRESSIONS TO WHICH THEY CORRESPOND, LOOK THEM UP.
	!IF USECNT OF DEPENDENT ONE = USECNT OF PARENT ONE THEN
	!SEE IF THE DEPENDENT ONE IS IN THIS GROUP OF STATEMENTS
	!. IF THAT IS TRUE THEN ELIMINATE THE DEPENDENT ONE.


	MACRO  IDVERYFRST  =  0,3,0,24$;	! LAST 4 SIXBIT CHARS

	EXTERNAL TPREV,PHI,PREV;
	OWN PAE;
	MAP BASE PAE:T:P1:PO:TPREV:PHI;

	EXTERNAL SAVSPACE,TOP,LEND,QQ,LOOP,LENTRY;
	EXTERNAL HASHIT,TBLSRCH,LOK1SUBS,LOK2SUBS;
	LABEL WHL1,WHL2;

	LABEL  LWHL;
	EXTERNAL  DOTOFIX;		! FIX .O INCR IF CAME FROM .R


	!MACRO TO SET PARENT POINTERS STRAIGHT

	MACRO SETDAD=
	BEGIN
		IF .PAE[SRCID] EQL ASGNID THEN
			IF NOT .PAE[A2VALFLG] THEN
			BEGIN
				PO_.PAE[RHEXP];
				PO[PARENT]_.PAE;
			END;
	END$;
	OWN GHEAD,SAVTOP;
	LOCAL UPFRONT;

	SAVTOP_.TOP;		!SAVE VALUE OF TOP



	PAE_.LENTRY; PREV_.LENTRY;
	!SET FLAG TO SAY WE ARE IN FRONT OF THE LOOP
	UPFRONT_1;

LWHL:	WHILE .PAE NEQ .LEND DO
	BEGIN
		!PARENT POINTERS COULD NOT BE SET EARLIER. MAKE SURE
		!THEY ARE SET NOW. NEED TO LOOK ONLY AT OPTIMIZER
		!CREATED ASSIGNMENTS BUT WILL DO IT FOR ALL
		!ASSIGNMENTS AS EXTRA ASSURANCE.

		GHEAD_.PAE;
		!FOR ALL THOSE IN THIS GROUP THAT WE ARE INTERESTED IN
		!  IE, OPT ASGN STMT WITH LHEXP = .O & NOT A2VAL

		WHILE OPTCMN(PAE) DO
		BEGIN
			PO_.PAE[RHEXP];
			!NOW, SET THE PARENT OF THE EXPRESSION
			PO[PARENT]_.PAE;
			HASHIT(.PO,STGHT);
			PHI_TBLSRCH();
			!CHECK FOR THERE OR NOT

			IF .FLAG THEN
			IF .PHI[CMNUNDER] THEN
			BEGIN
				IF LOK1SUBS(.PO,1) THEN		! RHS = .O OP Y ?
				BEGIN
					!COMPARE USECNTS
				  IF (.QQ<RIGHT> EQL .PHI[USECNT] AND .PHI [USECNT] NEQ 0)  OR		! QQ = OMOVDCNS,,EXPRUSE OF RHS .O
				     (.QQ<RIGHT> EQL 1 AND .PHI[MOVDCNS])  OR
				     (.PHI [MOVDCNS] AND .QQ<LEFT>)

				    THEN
					BEGIN
						T _ .PO [ARG1PTR];	! .O SYMTAB PTR
						IF .T [IDVERYFRST] GEQ .CURVERYFRST
						THEN BEGIN
						IF .T [ORFIXFLG]	! .O CAME FROM .R ?
						  THEN DOTOFIX (.T, .PAE);	! FIX .O INCR
						TPREV_.PREV;
						P1_.GHEAD;
						WHL1:
						!LOOK FROM THE START OF THE GROUP TO HERE
						WHILE .P1 NEQ .PAE DO
						BEGIN
							IF .P1[LHEXP] EQL
								.PO[ARG1PTR] THEN
							BEGIN
								T [IDATTRIBUT (NOALLOC)] _ 1;
								TPREV[SRCLINK]_.P1[SRCLINK];
								T_.PO[ARG1PTR];
								PO[ARG1PTR]_.T[IDOPTIM];
								PO[A1VALFLG]_0;
								!FIX PARNET
								T_.PO[ARG1PTR];
								T[PARENT]_.PO;
								IF .P1 EQL .GHEAD THEN
								GHEAD_.P1[SRCLINK];
								!IF IN FRONT OF
								!TOP ZERO THE DEFPTS
								IF .UPFRONT THEN
								T[DEFPT1]_
								T[DEFPT2]_
								PO[DEFPT1]_
								0;
								SAVSPACE(ASGNSIZ+SRCSIZ-1,.P1);
								LEAVE WHL1;
							END;
							TPREV_.P1;
							P1_.P1[SRCLINK];
						END;
						END;
					END;
				END;
				!THAT WAS THE FIRST ARG, NOW THE SECOND
				!LOKXSUBS RETURNS YHE USECNT OF THE DEPENDENT
				!EXPRESSION IN QQ.
				IF LOK2SUBS(.PO,1) THEN
				BEGIN
				  IF (.QQ<RIGHT> EQL .PHI[USECNT] AND .PHI [USECNT] NEQ 0)  OR
				     (.QQ<RIGHT> EQL 1 AND .PHI[MOVDCNS])  OR
				     (.PHI [MOVDCNS] AND .QQ<LEFT>)
				  THEN
					BEGIN
						T _ .PO [ARG2PTR];	! .O SYMTAB PTR
						IF .T [IDVERYFRST] GEQ .CURVERYFRST
						THEN BEGIN
						IF .T [ORFIXFLG]	! .O CAME FROM .R ?
						  THEN DOTOFIX (.T, .PAE);	! FIX .O INCR
						TPREV_.PREV;
						P1_.GHEAD;
						WHL2:
						!LOOK FROM THE START TO THIS ONE
						WHILE .P1 NEQ .PAE DO
						BEGIN
							IF .P1[LHEXP] EQL
							.PO[ARG2PTR] THEN
							BEGIN
								T [IDATTRIBUT (NOALLOC)] _ 1;
								TPREV[SRCLINK]_.P1[SRCLINK];
								T_.PO[ARG2PTR];
								PO[ARG2PTR]_.T[IDOPTIM];
								!RESET VALFLG
								PO[A2VALFLG]_0;
								!FIX PARENT
								T_.PO[ARG2PTR];
								IF .P1 EQL .GHEAD THEN
								GHEAD_.P1[SRCLINK];
								!IF IN FRONT OF TOP
								!ZERO THE DEFPTS
								IF .UPFRONT THEN
								T[DEFPT1]_
								T[DEFPT2]_
								PO[DEFPT2]_
								0;
								T[PARENT]_.PO;
								SAVSPACE(ASGNSIZ+SRCSIZ-1,.P1);
								LEAVE WHL2;
							END;
							TPREV_.P1;
							P1_.P1[SRCLINK];
						END;
						END;
					END;
				END;
			END;		!PHI[CMNUNDER]
			PAE_.PAE[SRCLINK];
			IF .PAE EQL .LEND
			  THEN LEAVE LWHL;
		END;
		!RESET FLAG IF WE ARE PASSING THROUGH TOP
		IF .PAE EQL .TOP THEN UPFRONT_0;
		PREV_.PAE;
		PAE_.PAE[SRCLINK];
	END;
	!CLEANUP THE SYMBOL TABLE ENTRIES
	DECR I FROM SSIZ-1 TO 0 DO
	BEGIN
		PAE_.SYMTBL[.I];
		WHILE .PAE NEQ 0 DO
		BEGIN
			IF .PAE[IDDOTO] EQL SIXBIT".O" THEN
				PAE [EXPRUSE] _ 0;	! DONT TOUCH OMOVDCNS,ORFIXFLG
			PAE_.PAE[SRCLINK];
		END;
	END;

	!RESTORE THE VALUE OF TOP
	TOP_.SAVTOP;
END;
FORWARD SCRUBARRAY;
GLOBAL ROUTINE GLOBELIM (CURVERYFRST) =
BEGIN

	!CURVERYFRST IS SIXBIT VALUE OF VERYFRST BEFORE CALLS
	!  HERE ON THIS LOOP: TO BE PASSED TO GLOBDEP SO ONLY .O
	!  CREATED FROM THIS LOOP GET RECOMBINED

	EXTERNAL IOGELO,HAULASS,SLINGHASH;
	LOCAL BASE OLDPO;
	LOCAL PHAZ2 PO;
	EXTERNAL CSTMNT,LOOP,ISN,LENTRY,LEND,BOTTOM,TOP;
	MAP BASE CSTMNT:LENTRY:TOP;
	EXTERNAL ELIM,REA;
!********************************************
	!GLOBAL COMMON SUB-EXPRESSION ELIMINATION CONTROLLER
	!
!**************************************************

	CNSMOVFLG_0;
	LSTWARNLINE_0;
	!PROCESSING ORDER IS :
	!	1. ALL ASSIGNMENTS OF THE FORM .OXXXX=EXPR. THIS
	!	   WILL BE A CHEAT AT SUBSUMPTION
	!	2. ALL SURE TO BE EXECUTED STATEMENTS (POSTDOMINATORS
	!	   OF TOP
	!	3. THEN THE REST IN BUSY ORDER
	PO_.TOP;
	DO
	BEGIN
		CSTMNT_.PO;
		ISN_.CSTMNT[SRCISN];
		IF .ISN EQL 0 THEN
		BEGIN
			IF .PO[SRCID] EQL ASGNID AND .PO[SRCOPT] NEQ 0 THEN
			BEGIN
				ELIM(.PO);
				PO[CSDONE]_1;
			END
		END
		ELSE
		IF .PO[SRCID] GEQ READID AND .PO[SRCID] LEQ REREDID
		   AND NOT .GLOBELIM2
		  !CAN'T MOVE EXPRESSIONS OUT OF IMPLIED DO IF INSIDE LOGICAL IF,
		  ! IE, SRCLINK = 0
		   AND .PO [SRCLINK] NEQ 0 THEN
		BEGIN		! PROCESS I/O STATEMENT ON 1ST GLOBELIM ONLY
			IMPLDO _ 1;	! PROCESSING IMPLIED DO
			IOGELO(.PO);
			IMPLDO _ 0;	! IMPLIED DO DONE
		END;
		PO_.PO[BUSY];
	END UNTIL .PO EQL 0;

	OLDPO_PO_.TOP;
	DO
	BEGIN
		CSTMNT_.PO;
		ISN_.CSTMNT[SRCISN];
		IF .PO[SRCID] NEQ DOID AND NOT .PO[CSDONE] THEN
		BEGIN
			ELIM(.PO);
			PO[CSDONE]_1;
		END;
		OLDPO_.PO;
		PO_.PO[POSTDOM];
	END UNTIL .PO EQL .OLDPO;
	!NOW THE REST IN BUSY ORDER
	PO_.TOP;
	DO
	BEGIN
		IF .PO[SRCID] NEQ DOID THEN
			IF NOT .PO[CSDONE] THEN
			BEGIN
				CSTMNT_.PO;
				ISN_.CSTMNT[SRCISN];
				ELIM(.PO);
			END;
		PO[CSDONE]_0;		! TURN OFF FLAG SO RECALLABLE
		PO_.PO[BUSY];
	END UNTIL .PO EQL 0;
	!WE DO NOT WANT TO MOVE CONSTANT COMPUTATIONS IF THIS IS THE
	!MAIN PROGRAM
	!TO DO SO WOULD PESSIMIZE THE CODE.

	IF .LOOP NEQ 0 THEN
	MOVCNST();

	GLOBDEPD (.CURVERYFRST);

	SCRUBARRAY();
	SLINGHASH();

	!GLOBDEPD MAY HAVE CREATED SOME EXPRESSIONS THAT ARE
	!COMPOSED OF .O VARIABLES THAT COULD MOVE OUT OF THE
	!LOOP AS CONSTANT COMPUTATIONS. WE WILL TRY TO GET THESE NOW.
	!ONCE AGAIN THIS IS VALID ONLY IF WE ARE NOT IN MAIN CODE

	IF .LOOP NEQ 0 THEN
	BEGIN
		CNSMOVFLG_1;
		PO_.TOP;
		WHILE .PO NEQ .BOTTOM DO
		BEGIN
			!THIS CONCERNS ONLY STATEMENTS
			!THAT WERE OPTIMIZER INSERTED
			!SKIP INNER MORE DO LOOPS

			IF .PO[SRCID] EQL DOID THEN
			BEGIN
				PO_.PO[DOLBL];
				PO_.PO[SNHDR];
			END;
			IF .PO[SRCOPT] EQL 0 THEN
				IF .PO[SRCID] EQL ASGNID THEN
					REA(.PO[RHEXP]);
			PO_.PO[SRCLINK];
		END;

		MOVCNST();
		CNSMOVFLG_0;
		GLOBDEPD (.CURVERYFRST);

		!TRY MOVING SIMPLE ASSIGNMENTS
		HAULASS();
	END;

	!CLEAN UP HASH TABEL
	SCRUBARRAY();

	!CLEAN OUT EXPRESSION HASH TABLE
	SLINGHASH();


END;

GLOBAL ROUTINE SCRUBARRAY=
BEGIN
	!GO THROUGH THE EXPRESSION HASH TABLE AND FIX UP 
	!EXPRESSION NODES THAT AHVE BEEN SOILED BY THE
	!ARRAY REFERENCES COMMON SUB PROCESS

	EXTERNAL EHASH;

	EXTERNAL BASE EHASHP;
	MAP BASE P1:P2;

	DECR I FROM EHSIZ-1 TO 0 DO
	BEGIN
		EHASHP_.EHASH[.I];

		WHILE .EHASHP NEQ 0 DO
		BEGIN

			IF NOT .EHASHP[EMPTY] AND .EHASHP[USECNT] EQL 1 THEN
				PUTBACKARRAY(.EHASHP,
				(IF .EHASHP[NBRCH] THEN SKEW
					ELSE STGHT));

			EHASHP_.EHASHP[CLINK];

		END;	!WHILE
	END;		!DECR
END;

GLOBAL ROUTINE A2ARREF(EXPR)=
BEGIN

	!CHECK CONDITIONS FOR A NODE OF THE
	!FORM
	!	    OP
	!	*	*
	!	DATAOPR	ARRAYREF
	!
	!AND
	!	    OP
	!	*	*
	!	OP	ARRAYREF
	!	  *
	!	  DATAOPR
	!

	MAP BASE EXPR;
	REGISTER BASE T;
	EXTERNAL XPUNGE;

	!GET OUT FAST IF ARG2 IS NOT AN ARRAYREF
	T_.EXPR[ARG2PTR];
	IF .T[OPRCLS] NEQ ARRAYREF THEN
		RETURN;

	!ITS AN ARRAYREF. DOES IT HAVE A LEAF AS SUBSCRIPT
	IF NOT .T[A2VALFLG] THEN RETURN;

	!NOW LOOK FOR STRAIGHT CONDITION
	ARREFCMNSBFLG_1;
	IF .EXPR[A1VALFLG] AND NOT .T[PARENFLG] THEN
		XPUNGE(.EXPR,STAR2)
	ELSE
	BEGIN

		T_.EXPR[ARG1PTR];
		IF .T[OPERATOR] EQL .EXPR[OPERATOR]
		AND NOT .T[PARENFLG]
		AND .T[A2VALFLG] THEN
![665] BE SURE THAT THE OPERATOR COMMUTES SO THAT WE DO NOT END
![665] UP EXTRACTING B/C(I) FROM A/B/C(I)!
%[665]%		IF COMMUTATIVE(EXPR) THEN
		XPUNGE(.EXPR,SKAR2);
	END;
	ARREFCMNSBFLG_0;
END;

GLOBAL ROUTINE A1ARREF(EXPR)=
BEGIN

	!CHECK CONDITIONS FOR
	!NODE OF THE FORM
	!	    OP
	!	*	*
	!	ARREF	DATAOPR
	!
	!AND
	!	    OP
	!	*	*
	!	OP	DATAOPR
	!	  *
	!	  ARREF
	!
	!SORT ORDER (CANONICALIZATION) MAKE THIS UNLIKELY
	!BUT OTHER COMMON SUBS COULD MAKE IT HAPPEN
	MAP BASE EXPR;	REGISTER BASE T;

	EXTERNAL XPUNGE;

	IF .EXPR[OPRCLS] EQL SPECOP THEN RETURN;

	IF NOT .EXPR[A2VALFLG] THEN RETURN;

	T_.EXPR[ARG1PTR];
	ARREFCMNSBFLG_1;
	IF .T[OPRCLS] EQL ARRAYREF THEN
	BEGIN
		IF .T[A2VALFLG] THEN
		    XPUNGE(.EXPR,STAR1);
	END
	ELSE
	BEGIN

		IF(.EXPR[OPERATOR] EQL .T[OPERATOR])
		AND NOT .T[PARENFLG] THEN
		BEGIN

			T_.T[ARG2PTR];
			IF .T[OPRCLS] EQL ARRAYREF AND .T[A2VALFLG] THEN
			    XPUNGE(.EXPR,SKAR1);
		END;
	END;
	ARREFCMNSBFLG_0;
END;



GLOBAL ROUTINE NEWCOPY(PHI,DAD)=
BEGIN

	!TAKE AN ARRAYREF OFF OF THE LIST
	!POINTED TO BY THE LKER FIELD OF PHI
	!GIVE IT A DAD OF DAD

	MAP BASE PHI;
	REGISTER BASE T;

	EXTERNAL SKERR;

	IF .PHI[LKER] EQL 0 THEN SKERR();

	!TAKE NEXT NODE
	T_.PHI[LKER];

	!TAKE NODE OFF OF LIST
	PHI[LKER]_.T[PARENT];

	T[PARENT]_.DAD;

	.T
END;

GLOBAL ROUTINE PUTBACKARRAY(HASHPTR,SHAPE)=
BEGIN
	!IF THE HASH ENTRY CONTIANS AN ARRAY REF AS AN
	!AERGUMENT, PUT THE ACTUAL ARRAYREFERENCE NODE
	!BACK IN PLACE IN THE EXPRESSION. WITHOUT THIS
	!ADJUSTMENT THE EXPRESSION IS LEFT POINTING TO A
	!HASH TABLE ENTRY.

	MAP BASE HASHPTR;

	REGISTER BASE ARY:EXPR;

	IF .HASHPTR[A1ARY] THEN
	BEGIN
		!ARGUMENT 1 OF THIS EXPRESSION IS AN ARRAY REF
		!NOTE THAT THIS MAY NOT BE ARG1 (HA1) IN THE
		!HASH TABLE

		!GET EXPRESSION ITSELF
		EXPR_.HASHPTR[LKER];

		!NOW CHECK TREE SHAPE
		IF .SHAPE EQL SKEW THEN
		BEGIN
			EXPR_.EXPR[ARG1PTR];
			!IT IS ARG2 OF THIS EXPR THAT IS
			!ARG1 OF THE EXPRESSION
			ARY_.EXPR[ARG2PTR];
			EXPR[ARG2PTR]_NEWCOPY(.ARY,.EXPR);
		END ELSE
		BEGIN
			ARY_.EXPR[ARG1PTR];
			EXPR[ARG1PTR]_NEWCOPY(.ARY,.EXPR);
		END;

		ARY[USECNT]_0;
	END;

	IF .HASHPTR[A2ARY] THEN
	BEGIN
		!ARGUEMNT 2 IS AN ARRAY REF

		EXPR_.HASHPTR[LKER];

		!NOW A SIDE TRIP FOR A FUNCTION REFERENCE
		IF .HASHPTR[OPRCLS] EQL FNCALL THEN
		BEGIN
			LOCAL ARGUMENTLIST AG;

			AG_.EXPR[ARG2PTR];
			ARY_.AG[1,ARGNPTR];
			AG[1,ARGNPTR]_NEWCOPY(.ARY,.EXPR);
		END ELSE
		BEGIN
			!DOES NOT MATTER IF IT IS STRAIGHT OR SKEW
			!OR UNARY
			ARY_.EXPR[ARG2PTR];
			EXPR[ARG2PTR]_NEWCOPY(.ARY,.EXPR);
		END;

		ARY[USECNT]_0;
	END;
END;

GLOBAL ROUTINE FNARRAY(EXPR)=
BEGIN
	!CALLED OUT OF REA TO HANDLE ARRAY REF SPECIAL CASE
	!UNDER A FUNCTION REF

	MAP BASE EXPR;

	REGISTER BASE TMP;
	REGISTER ARGUMENTLIST AG;

	EXTERNAL XPUNGE;

	!QUIT ON NON-LIBRARY
	IF .EXPR[OPERSP] NEQ LIBARY THEN RETURN;

	!LOOK AT ARG LIST

	AG_.EXPR[ARG2PTR];

	!QUIT IF NOT SINGLE ARG

	IF .AG[ARGCOUNT] NEQ 1 THEN RETURN;

	!NOW ARRAY REF PART

	TMP_.AG[1,ARGNPTR];

	IF .TMP[OPRCLS] EQL ARRAYREF THEN
	BEGIN
		!IF THE SUBSCRIPT IS A LEAF
		IF .TMP[A2VALFLG] THEN
		BEGIN
			!SET FLAG
			ARREFCMNSBFLG_1;
			!TRY TO ELIMINATE
			XPUNGE(.EXPR,FNARY);

			!TURN FLAG OFF
			ARREFCMNSBFLG_0;
		END;
	END ELSE
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			XPUNGE(.EXPR,UNARY);
END;

END
ELUDOM