Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/iopt.bli
There are 12 other files named iopt.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974, 1987
!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: H. P. WEISS/NEA/DCE/JNG/EGM/EDS/TFV/TJK/CDM

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

GLOBAL BIND IOPTV = #11^24 + 0^18 + #2527;	! Version Date:	1-Jan-86

%(

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

1	-----	-----	CREATION
2	-----	-----	SET CSTMNT FOR ALL CALLS TO COMSUB ROUTINES
			REMOVE PARAMTER FROM GLDOFOLD
			FIX TYPO IN GLEXREDUCE
3	-----	-----	FIX GLEXDFPT TO CHECK FOLDED DO LOOPS
			DO NOT STORE DEFPTS IN SRCISN
4	-----	-----	INTERFACE TO TEST REPLACEMENT
5	-----	-----	GIVE GLDOFOLD A BETTER NAME (GLDOFIND)
			CALL GLOBDEPD AND MOVCNST IN "RIGHT" ORDER
6	-----	-----	INCLUDE E1LISTCALL AND E2LISTCALL NODE
			IN CONTROL ROUTINES FOR GLOBAL ELIMINATION
			AND PROPAGATION
7	-----	-----	FOLD PRIMITIVE DO LOOPS
8	-----	-----	MORE OF 7
9	-----	-----	MORE OF 8
10	-----	-----	ADD CONTROL ROUTINES TO FOLD OUTER LEVEL
			OF I/O LISTS
11	-----	-----	CONTINUATION OF ABOVE
12	-----	-----	FIX HANDLING OF LOCAL COMMON SUB EXPRESSIONS
13	-----	-----	NO ALLOCATE DOCTLVAR FOR FOLDED LOOPS
14	-----	-----	DO NOT RECURSE ON ARRAYREFS WITH CONSTANT
			INDEX
15	-----	-----	DO NOT CREATE NEGATE NODES OVER NEGATE NODES
			TYPE NEGATE NODES IN MAKELIST
16	-----	-----	DIFFERENTIATE READ/DECODE FROM WRITE/ENCODE
17	-----	-----	SUPPLANT WHEREVER POSSIBLE
18	-----	-----	MAKE SURE ALL I/O LISTS START WITH A
			CONTINUE NODE
19	-----	-----	RESET IMPLDO AND CNSMOVFLG AFTER
			SECOND CALL TO MOVCNST
20	-----	-----	MOVE COLLAPSE LOGIC UNDER IOCLEAR
			TO TAKE FULL ADVANTAGE OF
			PROPAGATION
21	-----	-----	NOALLOC INDVAR IF IT IS A .R TEMPORARY
22	-----	-----	FAKE OUT SETGTRD BY BREAKING I/O LIST
			AT CURRENT ELEMENT IN IOEXDFPT
23	-----	-----	SET GLOBAL CELMNT IN GLOBAL DEFPT,
			ELIMINATION AND PROPAGATION ROUTINES
24	-----	-----	ADD REREDID
25	-----	-----	DO NOT REA DOLPTCTL EXPRESSION IN IOGELM AND
			GLSTELIM (NOTE: AFTER WE PROPAGATE THROUGH
			.O VARIABLES, THIS CODE SHOULD BE PUT BACK)
26	-----	-----	CONVERT IMPLDO TO A BIT IN IOPTFLG
			PARAMETERIZE IOCLEAR
27	-----	-----	SET A2VALFLG IN CMNSUB EXPRESSION FOR
			DOM1 AND DOM3 IN MAKELIST
28	-----	-----	SET VALFLAG OVER CMNSUB NODES IN
			CMNRPLC
29	-----	-----	DO NOT CREATE E2LISTS OUT OF SINGLE DATACALLS
30	-----	-----	TAKE OUT 29
31	-----	-----	DOCUMENTATION AND MINOR CORRECTIONS
32	-----	-----	FIX .ARGNPTR BUGS
33	-----	-----	FIX GLDOFIND TO CLEAR HASH TABLE BEFORE
			MOVING CONSTANT COMPUTATIONS
34	-----	-----	SIZE REDUCTIONS AND RELATED IMPROVEMENTS
35	-----	-----	ADD ROUTINE PUTBAK TO ELIMINATE EXTRA
			ASSIGNMENTS TO .O VARIABLES IN NON
			FOLDING LOOPS
36	-----	-----	FIX LOCAL DEPENDENCY ANALYSIS FOR
			COMMON SUBEXPRESSIONS
37	-----	-----	FIX TYPO IN GLSTDFPT
38	-----	-----	FIX INCREMENT FOR DOUBLE WORD ARGUMENTS IN
			E1LISTCALL AND E2LISTCALL NODES
39	-----	-----	FIX CALLS TO CMNRPLC IN PUTBAK
			ELIMINATE COMMON SUBEXPRESSIONS IN
			LOOP CONTROL
40	-----	-----	FURTHER IMPROVEMENTS TO PUTBAK
41	-----	-----	FIX EDIT 38 FOR E2LISTCALL NODES
42	-----	-----	IMPROVE ANALYSIS OF WHEN DOUBLED INCREMENT
			USED IN A DO LOOP WHEN COLLAPSING LISTS
43	-----	-----	REMOVE TIME BOMB IN FOLDING NESTED
			ELISTS
44	-----	-----	FIX COLLAPSE TO CORRECTLY TEST FOR
			COLLAPSING OF NESTED IMPLIED DO'S
			CONATINING DOUBLE WORD DATA ITEMS
45	-----	-----	FIX BUG INTODUCED BY EDIT 43
46	-----	-----	RECLASSIFY ITEMS UNDER ELISTCALLS
			AS SINGLE OR DOUBLE WORD FOR COLLAPSING
47	-----	-----	DEPENDENCY COUNTS NOT CORRECT. NEED
			TO ITERATE ON DEPDCMN CALLS IN CMNDEPD.
			WILL SEE IF A SINGLE ITERATION IS ENOUGH.
48	322	16688	ADD A CHECK FOR DISJOINT IOLISTS IN LOOPS SUCH
			AS (I,A(I),A(I),J=1,2)
49	406	18978	FIX NESTED ARRAY REFERENCES IN IOLISTS
50	435	18964	FIX IO LIST INCREMENTS NOT EQUAL TO 1, (DCE)
51	475	20813	REMOVE EDIT 322, FIX THE MORE GENERAL CASE., (JNG)

***** Begin Version 5A *****

52	612	23263	EDIT 406 NEEDS INITIALIZATION OF ARRCOUNT.

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

53	630	10962	REMOVE 406, 612, TRY TO FIX GENERAL CASE AND
			CATCH ALL CASES OF IMPLIED DO'S THAT CANNOT BE
			CONVERTED TO SLISTS OR ELISTS.  CASES LIKE
			A(-I) AND A((I-1)*3+1) WERE FAILING., (JNG)
54	651	25062	DO NOT COLLAPSE A LIST IF DEPENDENCIES EXIST
			INVOLVING AN IOLSCLS NODE AND A COMMON SUBEXPR, (DCE)
55	731	28246	MAKE SAVSTMNT A GLOBAL (FOR XPUNGE), (DCE)
56	743	-----	EDIT 651 WAS A BIT TOO AMBITIOUS - ONLY
			CATCH .O VARS (NOT .R), (DCE)
57	753	29028	CHECK FOR .O VARIABLES IN IO LIST INITIAL VALUE, (EGM)

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

58	774	EGM	12-Jun-80	14244
	Do not allow expressions involving variables appearing in Input stmnts
	to be common subed and moved out of the I/O stmnt node.

59	1007	EGM	6-Aug-80	10-29681
	Link DATACALL nodes that are candidates for common sub replacement to
	an IOLSTCALL node so that the common sub information can be correctly
	saved.

60	1036	DCE	31-Dec-80	QAR-1348
	Fix edit 1007 to make ALL backpointers availible - even those in
	innermore loops.  This makes insertion of the IOLSTCALL node correct
	in the more obscure cases.

61	1041	DCE	14-Jan-81	-----
	Fix optimizer bug so that ((A(I),I),J=1,2) knows that the A(I) 
	depends on the subsequent value of I which is read.

63	1111	EDS	15-Jul-81	10-31190
	Fix optimizer bug so that ((A(J,K),J=1,2,I),K=1,2,I) with I in
	common does not create a common subexpression which is only used
	once.  Keep the assignment of the expression to the .O variable
	instead of building a common sub node.

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

62	1207	DCE	3-Apr-81	-----
	Add a lot of code to handle potential zero trip ELISTs and SLISTs.
	Generate the final loop value code (what a pain), catch dependencies
	introduced by same.  Add routine DOVARASGN.

1530	TFV	4-May-82
	Setup IOLSTATEMENT field in IOLSCLS nodes.  Remove SIZOFENTRY, use
	NAME<LEFT> instead.

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

2046	TJK	28-Mar-84
	DOVARASGN was  creating  assignment  statements  with  a  zero
	parent pointer  in the  RHS.  Fix  it to  fill in  the  parent
	pointer.


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

2332	TJK	30-Mar-84
	Fix some bugs in MAKELIST  where parent pointers aren't  being
	set up properly.

2372	TJK	14-Jun-84
	Add support of character data to first part of IOPT (i.e., the
	routines called before IOCLEAR).

2400	TJK	18-Jun-84
	Add support of character  data to second  part of IOPT  (i.e.,
	the IOCLEAR routines which create E1LISTCALL, E2LISTCALL,  and
	IOLSTCALL nodes).  Fix  some bugs.   Change interpretation  of
	the increment fields of  E1 and E2  lists.  They now  indicate
	the word or  byte displacement  to use, instead  of the  array
	element displacement.   Also,  EDBLELEM nodes  are  no  longer
	used, since  there  is no  longer  any need  to  differentiate
	between single and double elements (not to mention character).
	Also, remove a  lot of  the distasteful  code associated  with
	EDBLELEM nodes.

2406	TJK	21-Jun-84
	Fix problems in GLEXDFPT.   Specifically, have it worry  about
	common/equivalence and functions with potential side  effects.

2410	TJK	22-Jun-84
	Fix a few more bugs.   Make ISOLATE handle substrings  better,
	so we can make E1 and E2 lists of substrings from an array.

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

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

***** Begin Version 11 *****

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].  The lengths will be one
	(word) until a later edit, which will store and use long symbols.

ENDV11
)%

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

%(***BRIEF FUNCTION DESCRIPTION OF IOPT

IOPT CONTAINS ROUTINES TO

1) EXTEND THE ALGORITHMS USED BY THE GLOBAL OPTIMIZER
   FOR COMMON SUBEXPRESSION ELIMINATION AND PROPAGATION AND REDUCTION
   OF EXPRESSIONS IN A LOOP AND TEST REPLACEMENT OF THE LOOP INDEX
   TO IMPLIED LOOPS WITHIN AN I/O LIST

2) FOLD INDIVIDUAL LOOPS WITHIN THE I/O LIST INTO
   SINGLE CALLS TO THE FORTRAN OBJECT TIME SYSTEM (FOROTS)

3) FOLD SEVERAL ADJACENT CALLS TO THE FORTRAN OBJECT TIME SYSTEM
   INTO A SINGLE CALL TO THE OBJECT TIME SYSTEM WHERE SUITABLE
   CONDITIONS OF INDEPENDENCE HOLD

FUNCTIONALLY, THE OPTIMIZATION AND FOLDING ROUTINES ARE INDEPENDENT
WITH THE EXCEPTION OF SEVERAL SHARED LOCAL VARIABLES AND IF
THE APPRIATE VARIABLES ARE MADE GLOBAL OR DUPLICATED THE MODULE MAY BE
SPLIT.

THE OPTIMIZATION ALGORITHMS USED ARE IDENTICAL TO THOSE EMPLOYED
ELSEWHERE IN THE GLOBAL OPTIMIZATION PROCESS. HOWEVER, SINCE THE
ONLY PERMISSABLE FORM OF CONTROL EXPRESSION ALLOWED ON AN I/O LIST
IS A DO LOOP, WE DO NOT NEED AND DO NOT USE THE GRAPHING
ALGORITHM EMPLOYED IN THE OPTIMIZATION OF EXPLICIT DO LOOPS.
CONSEQUENTLY, THE DEFINITION POINT AND COMMON SUBEXPRESSION MOTION
ALGORITHMS ARE SOMEWHAT SIMPLER THAN THOSE
USED IN THE OPTIMIZATION OF EXPLICIT DO LOOPS. WHEREVER POSSIBLE
THE I/O LIST OPTIMIZATION PACKAGE USES ROUTINES ALREADING
EXISTING IN OTHER OPTIMIZATION MODULES. WHEN DOING SO THE
FLAG IMPLDO IS SET TO INDICATE WHICH PARTS OF THE EXPLCIT
LOOP ALGORITHMS ARE TO BE IGNORED. HOWEVER, IT HAS BEEN NECESSARY TO
WRITE NEW DRIVING ROUTINES AT THE EXPRESSION LEVEL FOR THE
DEFINITION POINT AND REDUCTION ALGORITHMS ALTHOUGH THE
BASIC ALGORITHM HAS REMAINED UNCHANGED.

A LOOP WITHIN AN I/O LIST WILL BE FOLDED INTO AN E1LISTCALL
OR E2LISTCALL NODE IF

	A) THERE ARE NO FUNCTION CALLS WITHIN THE LOOP

	B) NO DATACALL WITHIN THE LOOP IS DEPENDENT UPON A
	   PREVIOUS DATACALL IN THE LOOP

	C) NO ASSIGNMENT STATEMENTS APPEAR WITHIN THE LOOP
	   EXCEPT OPTIMIZER CREATED ASSIGNMENTS OF POTENTIAL
	   LOCAL COMMON SUBEXPRESSIONS

	D) NO SLISTCALL NODES APPEAR WITHIN THE LOOP

	E) ALL REFERENCES TO THE LOOP INCREMENT VARIABLE
	   OR REDUCED FORMS THEREOF APPEAR UNDER ARRAY REFERENCES
	   IN THE LOOP AND IN EXPRESSIONS OF THE FORM
	   E1 + R WHERE R REPRESENTS THE INCREMENT VARIABLE OR
	   A REDUCED FORM THEREOR AND E1 IS
	   AN EXPRESION NOT INVOLVINMG R OR ANY OTHER
	   FORM OF THE INCREMENT VARIABLE (E1 MAY BE 0)

SEVERAL IOLSCLS NODES WILL BE FOLDED INTO A SINGLE IOLSTCALL
NODE IF CONDITIONS A) AND B) ABOVE ARE MET AND THE DATACALL
NODES ARE ADJACENT.

BOTH FOLDING ALGORITHMS DESCRIBED ABOVE ARE EMBEDDED IN THE
ROUTINE COLLAPSE WHICH FIRST BUILDS IOLSTCALL NODES OUT OF
IOSCLS NODES WITHIN THE LOOP AND THEN CALLS THE ROUTINE MAKELIST
TO TRANSFORM THE WHOLE LOOP INTO AN E1LISTCALL
OR E2LISTCALL NODE IF SUCH IS POSSIBLE.

THE CONTROL PROCEDURE FOR LIST OPTIMIZATION IS AS FOLLOWS:

1) INVOKE SKOPTIO DURING THE FIRST WALK OVER THE TREE TO
   PERFORM SKELETAL OPTIMIZATION OF EXPRESSIONS WITHIN
   THE LIST

2) SKOPTIO INVOKES GLDOFIND WHICH DOES A SIMPLE WALK DOWN THE
   I/O LIST LOOKING FOR IMPLIED LOOPS

3) WHEN THE END OF AN IMPLIED LOOP IS DETECTED, GLDOFIND
   CALLS THE DEFINITION POINT (GLSTDFPT), COMMON SUBEXPRESION
   ELIMINATION (GLSTELIM), PROPAGATION AND REDUCTION (GLSTREDUCE) AND
   TEST REPLACEMENT (TESTREPLACE) ROUTINES TO OPTIMIZE THE LOOP

DURING THE DEFINITION POINT, OPTIMIZATION, AND PROPAGATION AND
REDUCTION WALKS THE GLOBAL OPTIMIZER CALLS THE ROUTINES IOSTDFPT,
IOGELO, IOGELM, AND IOGPNR TO INCLUDE EXPRESSIONS UNDER THE I/O LIST
IN THE GLOBAL OPTIMIZATION ALGORITHM

AFTER ALL OPTIMIZATION IS COMPLETE (INCLUDING PROPAGATION) THE
OPTIMIZER INVOKES THE FOLLOWING CONTROL PROCEDURE TO FOLD GROUPS OF
IOLSCLS NODES AND COLLAPSE LOOPS WITHIN THE LIST:

1) FOR EACH I/O LIST INVOKE THE ROUTINE IOCLEAR

2) IOCLEAR IN TURN INVOKES THE ROUTINE FOLDUP
   WHICH PERFORMS AN IDENTICAL WALK TO THAT PERFORMED
   BY GLDOFIND. FOR EACH LOOP FOUND, FOLDUP CALLS THE
   ROUTINE COLLAPSE WHICH FOLDS GROUPS OF IOLSCLS NODES AND
   COLLAPSES LOOPS WHEN POSSIBLE BY CALLING MAKELIST.

3) AFTER ALL LOOPS HAVE BEEN PASSED THROUGH COLLAPSE, FOLDUP
   INVOKES THE ROUTINE CMNELIM FOR EACH IOLSCLS NODES IN THE
   LIST TO FOLD AND ELIMINATE LOCAL COMMON SUBEXPRESSIONS
   CREATE IN THE IOLIST AND ELIST GENERATION PROCESS
   INTO EACH OTHER VIA A SIMPLE LOCAL DEPENDENCY ALGORITHM


***)%

%(***DEFINE ROUTINES IN THE MODULE AS FORWARD***)%

FORWARD

			%OPTIMIZATION ROUTINES
			 ------------ --------%

			%ROUTINES CALLED BY THE OPTIMIZER TO
			FIND DEFINITION POINTS FOR, HASH, PROPAGATE
			AND REDUCE EXPRESSIONS ON AN I/O LIST%

	IOGELO,		%DRIVING ROUTINE TO HASH ALL EXPRESSIONS
			ON THE RIGHT HALF OF ASSIGNMENTS
			TO .O VARIABLES ON THE I/O LIST%
	IOGELM,		%DRIVING ROUTINE TO HASH ALL EXPRESSIONS
			EXCEPT THOSE ON THE RIGHT HALF OF
			ASSIGNMENTS TO .O VARIABLES ON THE
			I/O LIST%
	IOGPNR		%DRIVING ROUTINE TO PROPAGATE AND REDUCE
			ALL EXPRESSIONS ON THE I/O LIST%,
	IOEXDFPT,	%RECURSIVE ROUTINE TO DEFINITION POINTS
			OF LEAVES UNDER EXPRESSIONS ON AN I/O
			LIST%
	IOSTDFPT,	%DRIVING ROUTINE TO LOCATE DEFINITION
			POINTS FOR ALL EXPRESSIONS
			ON AN I/O LIST%

			%ROUTINES CALLED TO PERFORM GLOBAL
			OPTIMIZATION OF LOOPS IN AN I/O LIST%

	GLEXDFPT,	%RECURSIVE ROUTINE TO LOCATE LOCAL
			DEFINITION POINTS OF LEAVES UNDER
			EXPRESSIONS WITHIN A LOOP ON AN I/O LIST%
	GLEXREDUCE,	%RECURSIVE ROUTINE TO REDUCE EXPRESSIONS
			WITHIN A LOOP ON AN I/O LIST%
	GLSTDFPT,	%DRIVING ROUTINE TO LOCATE LOCAL DEFINITION
			POINTS FOR STATEMENTS WITHIN A LOOP
			ON AN I/O LIST%
	GLSTELIM,	%DRIVING ROUTINE TO DO GLOBAL ELIMINATION
			OF EXPRESSIONS WITHIN A LOOP ON AN
			I/O LIST%
	GLSTREDUCE,	%DRIVING ROUTINE TO PROPAGATE AND
			REDUCE EXPRESSIONS UNDER STATEMENTS WITHIN
			A LOOP ON AN I/O LIST%
	GLDOFIND,	%ROUTINE TO RECURSIVE WALK AN I/O LIST
			AND LOCATE AND GLOBALLY OPTIMIZE
			LOOPS WITHIN THE I/O LIST%
	SKOPTIO,	%CONTROLLING ROUTINE FOR SKELETAL AND
			GLOBAL OPTIMIZATION OF LOOPS AND
			EXPRESSIONS ON AN I/O LIST. REPALCE
			SKIOLIST IN THE LOCAL OPTIMIZER%


			%LOOP FOLDING AND COLLAPSING ROUTINES
			 ---- ------- --- ---------- --------%

	ISOLATE,	%ROUTINE TO ISOLATE THE INCREMENT EXPRESSION
			UNDER A DATACALL NODE%
	LCLLNK,		%ROUTINE TO LINK COMMON SUBEXPRESSION NODES
			ONTO AN IOLSCLS NODE%
	CHNINIT,	%ROUTINE TO INITIALIZE COMMON SUBEXPRESSION
			CHAINS FOR LOOP FOLDING%
	CHNLNK,		%ROUTINE TO LINK A COMMON SUBEXPRESSION
			NODE ONTO THE APPROPRIATE COMMON SUBEXPRESSION
			CHAIN%
	MRGCHN,		%ROUTINE TO MERGE THE COMMON SUBEXPRESSION
			CHAINS INTO THE IOLSCLS NODE%
	FINDASGN,	%ROUTINE TO FIND AS ASSIGNMENT OF A VALUE
			TO A SPECIFIED VARIABLE WITHIN THE CURRENT
			LOOP%
	ELIMTEMP,	%ROUTINE TO ELIMINATE THE ASSIGNMENT STATEMENT
			OF A VALUE TO A VARIABLES
			AND GENERATE A COMMON SUBEXPRESSION%
	ELIMSTEP,	%ROUTINE TO ELIMINATE THE INCREMENT ASSIGNMENT
			FOR A REDUCTION VARIABLE IN A LOOP AND CREATE
			A COMMON SUBEXPRESSION%
%2400%	!DIV2CMN,	%ROUTINE TO BUILD A COMMON SUBEXPRESSION
	!		NODE FOR A VALUE DIVIDED BY 2%
%2400%	!CHKDBLSUB,	%ROUTINE TO DETERMINE IF AN EXPRESSION
	!		IS A DOUBLE PRECISION ARRAYREF WITH AN
	!		UNFOLDED MULTIPLICATION BY TWO IN THE
	!		SUBSCRIPT COMPUTATION%
	MAKELIST,	%ROUTINE TO FOLD AN IMPLIED LOOP INTO
			AN E1LISTCALL OR E2LISTCALL IOLSCLS NODE%
	ELIMCONT,	%ROUTINE TO ELIMINATE CONTINUE
			STATEMENTS WITHIN A LOOP%
	EXPEXP,		%ROUTINE TO DETERMINE IF THE PRODUCT
			OF TWO EXPRESSIONS IS A LEAF%
	IOCONTVAR,	%CHECK IF IOLSCLS ELEMENT CONTAINS
			 A REFERNCE TO A VARIABLE%
	PUTBAK,		%CONVERTS GLOBAL COMMON SUBEXPRESSIONS
			 TO LOCAL COMMON SUBEXPRESSIONS%
	COLLAPSE,	%CONTROL ROUTINE FOR THE FOLDING
			OF SEVERAL IOLSCLS NODES INTO A SINGLE
			IOLSTCALL NODE AND THE FOLDING OF LOOPS
			INTO E1LISTCALL OR E2LISTCALL NODES%
	RPLCMN,		%ROUTINE TO MERGE LOCALLY DEPENDENT COMMON
			SUBEXPRESSIONS UNDER AN IOLSCLS NODE%
	CMNRPLC,	%ROUTINE TO SUBSTITUTE COMMON SUBEXPRESSION
			NODES FOR LEAVES IN AN IOLSCLS NODE AND
			VICA-VERSA%
	DEPDCMN,	%ROUTINE TO PERFORM LOCAL DEPENDENCY
			WITHIN COMMON SUBEXPRESSIONS%
	CMNDEPD,	%ROUTINE TO PERFORM LOCAL DEPENDENCY
			ANALYSIS FOR COMMON SUBEXPRESSION NODES
			UNDER AN IOLSCLS NODE%
	CMNELIM,	%CONTROL ROUTINE FOR THE LOCAL DEPENDENCY
			ANALYSIS AND FOLDING OF
			COMMON SUBEXPRESSION NODES%
	FOLDUP,		%RECURSIVE ROUTINE TO LOCATE AND FOLD
			LOOPS UNDER AN I/O LIST%
	IOCLEAR;	%CONTROLLING ROUTINE FOR LOOP FOLDING AND
			MERGING OF IOLSCLS NODES ON AN I/O LIST%



%(***DEFINE EXTERNAL VARIABLES AND ROUTINES USED BY I/O OPTIMIZATION
     PACKAGE)%

EXTERNAL
%1530%	TOPIO,		! Pointer to I/O statement above an IOLSCLS node
	SLINGHASH,		!CLEAR THE EXPRESSION HASH TABLE <COMSUB>
	SCRUBARRAY,		!CLEANUP AFTER ARRAY REF COMMON SUB
				!PROCESSING <GCMNSB>
	CELMNT,			!CURRENT ELEMENT IN GLOBAL ELIMINATION <GLOBAL>
	LOWLIM,			!GLOBAL FOR SUBSTITUTION <GLOBAL>
	INPFLAG,		!SET IF DECODE OR READ STATEMENT <GLOBAL>
	ARSKOPT,		!SKELETAL STUFF FOR ARITHMETIC EXPRESSION <SPS21>
	SWAPEM,			!SWAP EXPRESSION IF SUBSTTUTED <UTIL>
	RDUCINIT,		!INITIALIZE REDUCTION GLOBALS <TSTR>
	IODEPNDS,		!TEST INTERDEPENDENCE OF TWO IOLSCLS
				!NODES <SKSTMN>
%1207%	LPVARDEPNDS,		!SAME AS IODEPNDS, BUT ONLY CHECKS
				!LOOP VAR DEPENDENCIES <SKSTMN>
	CONTVAR,		!DOES EXPRESSION CONTAIN VARIABLE
	MAKEPR,			!MAKE EXPRESSION NODE <MAKEPR>
	MAKPR1,			!MAKE EXPRESSION NODE<MAKEPR>
	PROPNEG,		!PROPAGATE NEGATIVE <UTIL>
	CHOSEN[32],		!GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
	GLOBREG[16],		!GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
	SPECCASE,		!GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
	ITMCT,			!GLOBAL FOR LEAFSUBSTITUTE <GLOBAL>
	LEAFSUBSTITUTE,		!LEAF SUBSTITUTION ROUTINE <UTIL>
	IOSUBSTITUTE,		!CONTROL ROUTINE FOR LEAFSUBSTITUTION <UTIL>
	RDCLNK,			!FIRST INCREMENT ASSIGNMENT OF A .R
				!TEMPORARY CREATED BY REDUCE <TESTR>
	NAME,			!GLOBAL FOR CORMANAGER <GLOBAL>
	CORMAN,			!COR ALLOCATOTR <SRCA>
	SAVSPACE,		!CORE DEALLOCATOR <SRCA>
	CONTFN,			!EXPRESSION CONTAINS A FUNCTION CALL <UTIL>
	SKERR,			!ERROR
	LPRDCCT,		!LOOP REDUCTION COUNT <GLOBAL>
	RDCCT,			!REDUCTION COUNT <GLOBAL>
	TESTREPLACE,		!CAN LOOP INDEX CAN BE REPLACED? <TSTR>
	SUPPLANT,		!REPLACE LOOP INDEX <TSTR>
	LOKDEFPT,		!PROPAGATE AND REDUCE <PNROPT>
	GETDEF,			!NORMAL DEFINITION POINT ALGORITHM <DEFPT>
	SETGTRD,		!TEST IF A VARIABLE WAS READ <DEFPT>
	TREEPTR,		!GLOBAL POINTER FOR SETGTRD <GLOBAL>
	GLOBDEPD,		!COLLECT COMMON SUBS <COMSUB>
	REDUCE,			!REDUCE AN EXPRESSION <TSTR>
	MOVCNST,		!MOVE CONSTANT COMPUTATONS <COMSUB>
	REA,			!EXPRESSION OPTIMIZER <COMSUB>
	TOP,			!CURRENT DO LOOP NODE <GLOBAL>
	BOTTOM,			!STATEMENT AFTER DO LOOP <GLOBAL>
	LENTRY,			!STATEMENT BEFORE DO LOOP <GLOBAL>
	LEND,			!CONTINUE NODE AT END OF LOOP <GLOBAL>
	INDVAR,			!INDUCTION VARIABLE <GLOBAL>
	BACKST,			!GLOBAL OPTIMIZATION SWITCH <GLOBAL>
	ARGCONE,		!TEST IF LIB FUNCTION WITH 1 ARG <GOPT2>
	MAKCONTINUE,		!MAKE A CONTINUE NODE <GOPT2>
	CSTMNT,			!CURRENT STATEMENT <GLOBAL>
	NEGFLG,			!NEG FLAG FOR CURRENT EXPR <GLOBAL>
	NOTFLG,			!NOT FLAG FOR CURRENT EXPR <GLOBAL>
	P2SKL1DISP,		!DISPATCH FOR P2 SKELETON <P2S1>
	P2SKSTMNT;		!DISPATCH FOR P2 SKELETON <SKSTMN>



%(***DEFINE LOCAL VARIABLES USED IN THE I/O LIST OPTIMIZATION PHASE***)%
%731%	GLOBAL SAVSTMNT; ! POINTS TO CURRENT I/O STATEMENT

OWN
%1041% ENDDOPTRS,	!PTR TO DO END,,PTR TO SUCCESSOR
	IONODE,		!IOLSCLS NODE BEGIN BUILT
	PREVELEM,	!PREVIOUS ELEMENT IN I/O LIST
	CURRELEM;	!CURRENT ELEMENT IN I/O LIST

MAP BASE SAVSTMNT:PREVELEM:IONODE:CURRELEM;
MAP PHAZ2 TOP:BOTTOM:LEND:LENTRY:INDVAR:CSTMNT;




GLOBAL ROUTINE IOGELO(STMT)=
%(**********************************************************************

	CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM GLOBAL
	COMMON SUBEXPRESSION ELIMINATION OF RIGHT
	HAND EXPRESSIONS UNDER ASSIGNMENT STATEMENTS
	TO OPTIMIZER CREATED GLOBAL COMMON SUBEXPRESSIONS


**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
%[774]%	SAVSTMNT _ .STMT;	! Save the I/O node location
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
	IF .ELEM[OPRS] EQL ASGNOS THEN
	BEGIN
		LOCAL BASE TMP;
		TMP_.ELEM[LHEXP];
		IF .TMP[IDDOTO] EQL SIXBIT ".O" THEN
		BEGIN
			REA(.ELEM[RHEXP])
		END
	END
	ELSE
	IF .ELEM[OPRS] EQL DOOS THEN
	BEGIN
		ELEM_.ELEM[DOLBL];	!COLLAPSE
		ELEM_.ELEM[SNHDR]	!DO NODE
	END;
	ELEM_.ELEM[SRCLINK]
END
END;






GLOBAL ROUTINE IOGELM(STMT)=
%(**********************************************************************

	CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM GLOBAL
	COMMON SUBEXPRESSION ELIMINATION OF ALL EXPRESSIONS EXCEPT
	THOSE ON THE RIGHT HAND SIDE OF ASSIGNMENT
	STATEMENTS TO OPTIMIZER CREATED GLOBAL COMMON
	SUBEXPRESSIONS

**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
	IF .ELEM[OPRS] EQL ASGNOS THEN
	BEGIN
		LOCAL BASE TMP;
		TMP_.ELEM[LHEXP];
		IF .TMP[IDDOTO] NEQ SIXBIT ".O" THEN
		BEGIN
			REA(.ELEM[LHEXP]);
			REA(.ELEM[RHEXP])
		END
	END
	ELSE
	IF .ELEM[OPRS] EQL DOOS THEN
	BEGIN
		REA(.ELEM[DOLPCTL]);	!TRY CTL EXPRESSION
		ELEM_.ELEM[DOLBL];
		ELEM_.ELEM[SNHDR]	!COLLAPSE DO LOOP
	END
	ELSE
	IF .ELEM[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		CASE .ELEM[OPERSP] OF SET
	%DATACALL%	REA(.ELEM[DCALLELEM]);
	%SLISTCALL%	BEGIN
				REA(.ELEM[SCALLCT]);
				REA(.ELEM[SCALLELEM])
			END;
	%IOLSTCALL%	SKERR();		!SHOULD NOT APPEAR
	%E1LISTCALL%	SKERR();		!SHOULD NOT APPEAR
	%E2LISTCALL%	SKERR();		!SHOULD NOT APPEAR
	%ESNGLELEM%	SKERR();	!SHOULD NOT APPEAR
	%EDBLELEM%	SKERR()		!SHOULD NOT APPEAR
		TES
	END;
	ELEM_.ELEM[SRCLINK]
END
END;







GLOBAL ROUTINE IOGPNR(STMT)=
%(**********************************************************************

	CONTROL ROUTINE TO WALK I/O LISTS AND PERFORM PROPAGATION
	AND REDUCTION FOR ALL EXPRESSIONS

**********************************************************************)%
BEGIN
MAP PHAZ2 STMT;
REGISTER PHAZ2 ELEM;
IF (ELEM_.STMT[IOLIST]) EQL 0 THEN RETURN;
UNTIL (CELMNT_.ELEM) EQL 0 DO
BEGIN
	IF .ELEM[OPRS] EQL ASGNOS THEN
	BEGIN
		ELEM[LHEXP]_LOKDEFPT(.ELEM[LHEXP]);
		ELEM[RHEXP]_LOKDEFPT(.ELEM[RHEXP])
	END
	ELSE
	IF .ELEM[OPRS] EQL DOOS THEN
	BEGIN
		ELEM[DOLPCTL]_LOKDEFPT(.ELEM[DOLPCTL])
	END
	ELSE
	IF .ELEM[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		CASE .ELEM[OPERSP] OF SET
	%DATACALL%	ELEM[DCALLELEM]_LOKDEFPT(.ELEM[DCALLELEM]);
	%SLISTCALL%	BEGIN
				ELEM[SCALLELEM]_LOKDEFPT(.ELEM[SCALLELEM]);
				ELEM[SCALLCT]_LOKDEFPT(.ELEM[SCALLCT])
			END;
	%IOLSTCALL%	SKERR();
	%E1LISTCALL%	SKERR();
	%E2LISTCALL%	SKERR();
	%ESNGLELEM%	SKERR();
	%EDBLELEM%	SKERR()
		TES
	END;
	ELEM_.ELEM[SRCLINK]
END
END;






GLOBAL ROUTINE IOEXDFPT(EXPRNODE,DFPT)=
%(**********************************************************************

	RECURSIVE ROUTINE TO LOCATE ALL LEAVES IN EXPRESSIONS
	ON AN I/O LIST AND ESTABLISH DEFINITION POINTS FOR
	THEM VIA THE STANDARD DEFINITION POINT ALGORITHM
	(GETDEF)

	RETURNS AS THE DEFINITION POINT EITHER A NODE
	IN FRONT OF THE I/O STATEMENT OR THE I/O STATEMENT
	IF THE LEAF IS READ IN FRONT OF THE ELEMENT
	IN THE I/O LIST FOR WHICH WE ARE CURRENTLY COMPUTING
	DEFINITION POINTS

**********************************************************************)%
BEGIN
MAP BASE DFPT;
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
		EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
		EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
		END;
%DATAOPR%	BEGIN
		%(

		WE HAVE REACHED A LEAF UNDER THE CURRENT I/O
		LIST ELEMENT

		SINCE WE WANT GETDEF TO LOOK ONLY AT STATEMENTS
		OR I/O LISTS ELEMENTS IN FRONT OF THE CURRENT
		ELEMENT WE WILL PRETEND THAT
		THE I/O LIST ENDS AT THE ELEMENT IN
		FRONT OF THE CURRENT ELEMENT (PREVELEM)
		BY SUBSTITUTING ZERO FOR THE LINK FIELD OF
		PREVELEM BEFORE CALLING GETDEF AND
		RESTORING THE LINK AFTER THE CALL TO GETDEF.

		IF WE ARE IN A LOOP, THE CLEARING IS NOT POSSIBLE,
		BUT A ZERO LINK FIELD HAS ALREADY BEEN SUBSTITUTED
		AFTER THE LOOP (JUST AS IT SHOULD BE!).

		)%

		LOCAL BASE SAVDEFPT;

![1041]	If in a loop, (A(I), I) represents a dependency,
![1041]	so we do not break the stmnt chain here; rather
![1041]	we do it when encountering an outermost loop out in
![1041]	IOSTDFPT.  The chain is broken after the loop in that
![1041]	case so that ((A(I),I),J=1,2) gets correct dependency.
%[1041]%	IF .ENDDOPTRS EQL 0 THEN PREVELEM[CLINK]_0;

		SAVDEFPT_GETDEF(.EXPR,.SAVSTMNT,.DFPT);
		PREVELEM[CLINK]_.CURRELEM;	!RESTORE THE LINK
		RETURN .SAVDEFPT
		END;
%RELATIONAL%	BEGIN
		EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
		EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
		END;
%FNCALL%	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.EXPR[ARG2PTR];
		IF ARGCONE(.EXPR) THEN
		 EXPR[DEFPT2]_IOEXDFPT(.AG[1,ARGNPTR],.EXPR[DEFPT2])
		ELSE
		INCR I FROM 1 TO .AG[ARGCOUNT] DO
			IOEXDFPT(.AG[.I,ARGNPTR],0);
		END;
%ARITHMETIC%	BEGIN
		EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
		EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
		END;
%TYPECNV%	EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%ARRAYREF%	BEGIN
%2372%		IF .EXPR[ARG2PTR] NEQ 0
%2372%		THEN EXPR[DEFPT2] = IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%2372%		EXPR[DEFPT1] = IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
		END;
%CMNSUB%	EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%NEGNOT%	EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%SPECOP%	EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN
		CASE .EXPR[OPERSP] OF SET
	%DATACALL%	IOEXDFPT(.EXPR[DCALLELEM],0);
	%SLISTCALL%	BEGIN
				IOEXDFPT(.EXPR[SCALLELEM],0);
				IOEXDFPT(.EXPR[SCALLCT],0)
			END;
	%IOLSTCALL%	SKERR();
	%E1LISTCALL%	SKERR();
	%E2LISTCALL%	SKERR();
	%ESNGLELEM%	SKERR();
	%EDBLELEM%	SKERR()
		TES
		END;
%INLINFN%	BEGIN
		EXPR[DEFPT1]_IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		 EXPR[DEFPT2]_IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2])
		END;

%SUBSTRING%
%2372%		BEGIN
%2372%		EXPR[DEFPT1] = IOEXDFPT(.EXPR[ARG1PTR],.EXPR[DEFPT1]);
%2372%		EXPR[DEFPT2] = IOEXDFPT(.EXPR[ARG2PTR],.EXPR[DEFPT2]);
%2372%		EXPR[DEFPTSS] = IOEXDFPT(.EXPR[ARG4PTR],.EXPR[DEFPTSS]);
%2372%		END;

%CONCATENATION%
%2372%		BEGIN
%2372%		LOCAL ARGUMENTLIST AG;
%2372%		AG = .EXPR[ARG2PTR];
%2372%		INCR I FROM 2 TO .AG[ARGCOUNT]		! Skip first argument
%2372%		DO IOEXDFPT(.AG[.I,ARGNPTR],0);
%2372%		END;

TES;
RETURN 0		!ONLY DATAOPR'S CAN HAVE DEFPTS
END;








GLOBAL ROUTINE IOSTDFPT(STMTNODE)=
%(**********************************************************************

	ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
	IN THE I/O LIST AND PASS THEM TO IOEXDFPT

**********************************************************************)%
BEGIN

%[1041]%	MACRO	ENDLP = LEFT$,		! PTR to end of outermost DO loop
%[1041]%	DOSUCC = RIGHT$;		! PTR to successor for loop
%[1041]%	MAP BASE ENDDOPTRS;		! ENDLP,,DOSUCC

MAP PHAZ2 STMTNODE;
REGISTER PHAZ2 STMT;
PREVELEM_SAVSTMNT_.STMTNODE;	!MARK THE STATEMENT
INPFLAG_IF .STMTNODE[SRCID] EQL READID OR .STMTNODE[SRCID] EQL REREDID OR .STMTNODE[SRCID] EQL DECOID THEN 1 ELSE 0;
STMT_.STMTNODE[IOLIST];	!LOCATE I/O LIST
%[1041]%	ENDDOPTRS_0;

UNTIL (CURRELEM_CELMNT_.STMT) EQL 0 DO
BEGIN

%[1041]% IF .STMT EQL .ENDDOPTRS<ENDLP> THEN ! At the end of outermost loop
%[1041]% BEGIN	! Restore I/O list to original state
%[1041]%	STMT[CLINK]_.ENDDOPTRS<DOSUCC>;
%[1041]%	ENDDOPTRS_0
%[1041]% END;

	IF .STMT[OPRS] EQL ASGNOS THEN
	BEGIN
		IOEXDFPT(.STMT[LHEXP],0);	!FILL IN LH DEFPTS
		IOEXDFPT(.STMT[RHEXP],0)	!FILL IN RH DEFPTS
	END
	ELSE
	IF .STMT[OPRS] EQL DOOS THEN
	BEGIN

%[1041]%	IF .ENDDOPTRS EQL 0 THEN
%[1041]%	BEGIN	! Set up for outermost loop (break chain)
%[1041]%		LOCAL BASE T;
%[1041]%		T_.STMT[DOLBL]; ! Label for end of DO loop
%[1041]%		ENDDOPTRS<ENDLP>_T_.T[SNHDR]; ! Stmnt at end of loop
%[1041]%		ENDDOPTRS<DOSUCC>_.T[CLINK]; ! Stmnt after loop
%[1041]%		T[CLINK]_0 ! Ignore stmnts after end of loop
%[1041]%	END;

		IOEXDFPT(.STMT[DOLPCTL],0)
	END
	ELSE
	IF .STMT[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		IOEXDFPT(.STMT,0)
	END;
	PREVELEM_.STMT;
	STMT_.STMT[CLINK]
END
END;





GLOBAL ROUTINE GLEXDFPT(EXPRNODE)=
%(**********************************************************************

	ROUTINE TO COMPUTE PSEUDO-DEFINITION POINTS
	FOR DATA REFERENCES ON THE I/O LIST

	DEFINITION POINTS MAY BE AT:

	1) AN EARLIER SLISTCALL OR DATACALL NODE WITHIN THE
	   CURRENT LOOP
	2) AT A STATEMENT WITHIN THE LOOP
	3) AT THE LOOP ITSELF (TOP)
	4) OUTSIDE THE LOOP (LENTRY)

	COMPUTATION OF DEFINITION POINTS IS EMBEDDED WITHIN
	ROUTINE TO WALK AN EXPRESSION TREE AND CALL GLEXDEFPT
	FOR EACH LEAF

**********************************************************************)%
BEGIN
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
		EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
		EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
		END;
%DATAOPR%	IF .EXPR[OPERSP] EQL VARIABLE OR
		.EXPR[OPERSP] EQL FNNAME OR
		.EXPR[OPERSP] EQL FORMLVAR THEN
  %VARIABLE%	BEGIN
  %FORMLVAR%		LOCAL BASE DEFPT;
  %FNNAME%		LOCAL BASE ELEM;
%2406%			LOCAL PASTCURR;		! TRUE when past CSTMNT
%2406%			LOCAL REDEFINED;	! TRUE when EXPR is redefined

			%(
			DEFINITION POINT FOR THE LOOP INDEX IS THE
			DO LOOP NODE (TOP) 
			)%

			IF .EXPR EQL .INDVAR THEN RETURN .TOP;

%2406%			! Give up if EXPR is in common or equivalence
%2406%
%2406%			IF .EXPR[IDATTRIBUT(INCOM)]
%2406%				OR .EXPR[IDATTRIBUT(INEQV)]
%2406%			THEN RETURN .CSTMNT;			! Punt
%2406%
%2406%			! Now try to compute the definition point.  If
%2406%			! EXPR becomes redefined  after its  reference
%2406%			! (i.e., after CSTMNT), then  we have to  give
%2406%			! up and use  CSTMNT as  the definition  point
%2406%			! since we're in a DO-loop.  Otherwise we  use
%2406%			! the last potential redefinition.
%2406%
%2406%			DEFPT = .LENTRY;	! Initially assume LENTRY
%2406%			PASTCURR = FALSE;	! Haven't reached CSTMNT yet
%2406%			ELEM = .TOP[SRCLINK];	! Start looking here
%2406%
%2406%			DO
%2406%			BEGIN	! For each statement or IOLSCLS node
%2406%
%2406%				! See if we've reached CSTMNT yet
%2406%
%2406%				IF .ELEM EQL .CSTMNT THEN PASTCURR = TRUE;
%2406%
%2406%				REDEFINED = FALSE;	! Assume not redefined
%2406%
%2406%				IF .ELEM[OPRCLS] EQL STATEMENT
%2406%				THEN
				BEGIN
					IF .ELEM[SRCID] EQL ASGNID THEN
					BEGIN
%2406%						IF .ELEM[LHEXP] EQL .EXPR
%2406%
%2406%						! Note that the LHS is a
%2406%						! DATAOPR, but for the future:
%2406%
%2406%							OR CONTFN(.ELEM[LHEXP])
%2406%							OR CONTFN(.ELEM[RHEXP])
%2406%						THEN REDEFINED = TRUE;
					END
					ELSE
					IF .ELEM[SRCID] EQL DOID THEN
					BEGIN
%2406%						IF .ELEM[DOSYM] EQL .EXPR
%2406%						    OR CONTFN(.ELEM[DOLPCTL])
%2406%						THEN REDEFINED = TRUE;
					END
				END

%2406%				ELSE IF CONTFN(.ELEM)
%2406%				THEN REDEFINED = TRUE

%2406%				ELSE IF .INPFLAG
%2406%				THEN IF .ELEM[OPRCLS] EQL IOLSCLS
%2406%				THEN
				CASE .ELEM[OPERSP] OF SET
%2406%			%DATACALL%	IF .ELEM[DCALLELEM] EQL .EXPR
%2406%					THEN REDEFINED = TRUE;
%2406%			%SLISTCALL%	IF .ELEM[SCALLELEM] EQL .EXPR
%2406%					THEN REDEFINED = TRUE;
			%IOLSTCALL%	SKERR();
			%E1LISTCALL%	SKERR();
			%E2LISTCALL%	SKERR();
			%ESNGLELEM%	SKERR();
			%EDBLELEM%	SKERR()
				TES;

%2406%				IF .REDEFINED
%2406%				THEN
%2406%				BEGIN	! ELEM potentially redefines EXPR
%2406%
%2406%					IF .PASTCURR
%2406%					THEN RETURN .CSTMNT	! Punt
%2406%					ELSE DEFPT = .ELEM;	! Save it
%2406%
%2406%				END;	! ELEM potentially redefines EXPR

				ELEM_.ELEM[CLINK]

%2406%			END	! For each statement or IOLSCLS node
%2406%			UNTIL .ELEM EQL .BOTTOM;
%2406%
%2406%			RETURN .DEFPT;
		END
		ELSE
  %OTHERWISE%	RETURN .LENTRY;
%RELATIONAL%	BEGIN
		EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
		EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
		END;
%FNCALL%	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.EXPR[ARG2PTR];
		IF ARGCONE(.EXPR) THEN
		 EXPR[DEFPT2]_GLEXDFPT(.AG[1,ARGNPTR])
		ELSE
		INCR I FROM 1 TO .AG[ARGCOUNT] DO
			GLEXDFPT(.AG[.I,ARGNPTR]);
		END;
%ARITHMETIC%	BEGIN
		EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
		EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
		END;
%TYPECNV%	EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%ARRAYREF%	![2372] Note--filling in DEFPT1 might not be safe here.
		![2372] It also might prevent E1 or E2 list creation.
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%CMNSUB%	EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%NEGNOT%	EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR]);
%SPECOP%	EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN END;
%INLINFN%	BEGIN
		EXPR[DEFPT1]_GLEXDFPT(.EXPR[ARG1PTR]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		 EXPR[DEFPT2]_GLEXDFPT(.EXPR[ARG2PTR])
		END;

%SUBSTRING%
%2372%		BEGIN
%2372%		EXPR[DEFPT1] = GLEXDFPT(.EXPR[ARG1PTR]);
%2372%		EXPR[DEFPT2] = GLEXDFPT(.EXPR[ARG2PTR]);
%2372%		EXPR[DEFPTSS] = GLEXDFPT(.EXPR[ARG4PTR]);
%2372%		END;

%CONCATENATION%
%2372%		BEGIN
%2372%		LOCAL ARGUMENTLIST AG;
%2372%		AG = .EXPR[ARG2PTR];
%2372%		INCR I FROM 2 TO .AG[ARGCOUNT]		! Skip first argument
%2372%		DO GLEXDFPT(.AG[.I,ARGNPTR]);
%2372%		END;

TES;
RETURN 0		!ONLY DATAOPR'S CAN HAVE DEFPTS
END;

GLOBAL ROUTINE GLEXREDUCE(EXPRNODE)=
%(**********************************************************************

	ROUTINE TO FIND ALL EXPRESSIONS UNDER STATEMENTS
	IN AN I/O LIST AND CALL REDUCE FOR ALL REDUCIBLE
	EXPRESSIONS

	REDUICIBLE EXPRESSIONS ARE:

	1) ARITHMETIC MULTIPLY
	2) SPECIAL OPERATORS - P2MUL AND P2PL1 MUL

**********************************************************************)%
BEGIN
REGISTER PHAZ2 EXPR;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
		EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
		EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
		END;
%DATAOPR%	BEGIN END;
%RELATIONAL%	BEGIN
		EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
		EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
		END;
%FNCALL%	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.EXPR[ARG2PTR];
		INCR I FROM 1 TO .AG[ARGCOUNT] DO
		 AG[.I,ARGNPTR]_GLEXREDUCE(.AG[.I,ARGNPTR]);
		END;
%ARITHMETIC%	BEGIN
		EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
		EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
		IF .EXPR[OPERSP] EQL MULOP THEN 
		 RETURN REDUCE(.EXPR)
		END;
%TYPECNV%	EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%ARRAYREF%	IF .EXPR[ARG2PTR] NEQ 0 THEN
		EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%CMNSUB%	EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%NEGNOT%	EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR]);
%SPECOP%	BEGIN
		EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
		IF .EXPR[OPERSP] EQL P2MULOP OR .EXPR[OPERSP]
		 EQL P2PL1OP THEN RETURN REDUCE(.EXPR)
		END;
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN END;
%INLINFN%	BEGIN
		EXPR[ARG1PTR]_GLEXREDUCE(.EXPR[ARG1PTR]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		 EXPR[ARG2PTR]_GLEXREDUCE(.EXPR[ARG2PTR])
		END;

%SUBSTRING%
%2372%		BEGIN
%2372%		EXPR[ARG1PTR] = GLEXREDUCE(.EXPR[ARG1PTR]);
%2372%		EXPR[ARG2PTR] = GLEXREDUCE(.EXPR[ARG2PTR]);
%2372%		EXPR[ARG4PTR] = GLEXREDUCE(.EXPR[ARG4PTR]);
%2372%		END;

%CONCATENATION%
%2372%		BEGIN
%2372%		LOCAL ARGUMENTLIST AG;
%2372%		AG = .EXPR[ARG2PTR];
%2372%		INCR I FROM 2 TO .AG[ARGCOUNT]		! Skip first argument
%2372%		DO AG[.I,ARGNPTR] = GLEXREDUCE(.AG[.I,ARGNPTR]);
%2372%		END;

TES;
RETURN .EXPR		!RETURN EXPR
END;

GLOBAL ROUTINE GLSTDFPT=
%(**********************************************************************

	ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
	AND ILSCLS NODES IN THE I/O LIST AND PASS THEM
	TO GLEXDFPT TO COMPUTE "LOCAL" DEFINITION POINTS

**********************************************************************)%
BEGIN
REGISTER PHAZ2 STMT;
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
	IF .STMT[OPRS] EQL ASGNOS THEN
	BEGIN
		GLEXDFPT(.STMT[LHEXP]);		!DO LEFT HALF
		STMT[SRCISN]_
		 GLEXDFPT(.STMT[RHEXP])	!DO RIGHT HALF
	END
	ELSE
	IF .STMT[OPRS] EQL DOOS THEN
	BEGIN
		GLEXDFPT(.STMT[DOLPCTL]);	!DO CONTROL EXPRESSION
		STMT_.STMT[DOLBL];		!SKIP INNER LOOPS
		CSTMNT_STMT_.STMT[SNHDR]	!SKIP INNER LOOPS
	END
	ELSE
	IF .STMT[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		CASE .STMT[OPERSP] OF SET
	%DATACALL%	GLEXDFPT(.STMT[DCALLELEM]);
	%SLISTCALL%	BEGIN
				GLEXDFPT(.STMT[SCALLCT]);
				GLEXDFPT(.STMT[SCALLELEM])
			END;
	%IOLSTCALL%	SKERR();
	%E1LISTCALL%	SKERR();
	%E2LISTCALL%	SKERR();
	%ESNGLELEM%	SKERR();
	%EDBLELEM%	SKERR()
		TES
	END;
	CSTMNT_STMT_.STMT[CLINK]
END
END;

GLOBAL ROUTINE GLSTELIM=
%(**********************************************************************

	ROUTINE TO FIND EXPRESSIONS UNDER STATEMENTS
	AND IOLSCLS NODES IN AN I/O LIST AND
	PERFORM "LOCAL" GLOBAL COMMON SUBEXPRESSION
	ELIMINATION

**********************************************************************)%
BEGIN
REGISTER PHAZ2 STMT;
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
	IF .STMT[OPRS] EQL ASGNOS THEN
	BEGIN
		REA(.STMT[LHEXP]);		!ELIMINATE COMMON SUBS
		REA(.STMT[RHEXP])		!ELIMINATE COMMON SUBS
	END
	ELSE
	IF .STMT[OPRS] EQL DOOS THEN
	BEGIN
		REA(.STMT[DOLPCTL]);		!ELIMINATE COMMON SUBS
		STMT_.STMT[DOLBL];		!SKIP INNER LOOPS
		CSTMNT_STMT_.STMT[SNHDR]	!SKIP INNER LOOPS
	END
	ELSE
	IF .STMT[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		CASE .STMT[OPERSP] OF SET
	%DATACALL%	REA(.STMT[DCALLELEM]);
	%SLISTCALL%	BEGIN
				REA(.STMT[SCALLCT]);
				REA(.STMT[SCALLELEM])
			END;
	%IOLSTCALL%	SKERR();
	%E1LISTCALL%	SKERR();
	%E2LISTCALL%	SKERR();
	%ESNGLELEM%	SKERR();
	%EDBLELEM%	SKERR()
		TES
	END;
	CSTMNT_STMT_.STMT[CLINK]
END
END;

GLOBAL ROUTINE GLSTREDUCE=
%(**********************************************************************

	ROUTINE TO FIND ALL EXPRESSIONS UNDER STATEMENTS
	AND IOLSCLS NODES IN THE I/O LIST AND PASS
	THEM TO GLEXREDUCE FOR REDUCTION AND PROPAGATION

**********************************************************************)%
BEGIN
REGISTER BASE IOARRAY;
REGISTER PHAZ2 STMT;
RDUCINIT();			!INITIALIZE REDUCTION GLOBALS
CSTMNT_STMT_.TOP[SRCLINK];
UNTIL .STMT EQL .LEND DO
BEGIN
	IF .STMT[OPRS] EQL ASGNOS THEN
	BEGIN
		STMT[LHEXP]_GLEXREDUCE(.STMT[LHEXP]);	!REDUCE EXPRESSIONS
		STMT[RHEXP]_GLEXREDUCE(.STMT[RHEXP])	!REDUCE EXPRESSIONS
	END
	ELSE
	IF .STMT[OPRS] EQL DOOS THEN
	BEGIN
		STMT[DOLPCTL]_GLEXREDUCE(.STMT[DOLPCTL]);	!REDUCE EXPRESSIONS
		STMT_.STMT[DOLBL];		!SKIP INNER LOOPS
		CSTMNT_STMT_.STMT[SNHDR]	!SKIP INNER LOOPS
	END
	ELSE
	IF .STMT[OPRCLS] EQL IOLSCLS THEN
	BEGIN
		CASE .STMT[OPERSP] OF SET
	%DATACALL%	STMT[DCALLELEM]_GLEXREDUCE(.STMT[DCALLELEM]);
	%SLISTCALL%	BEGIN
				STMT[SCALLCT]_GLEXREDUCE(.STMT[SCALLCT]);
				STMT[SCALLELEM]_GLEXREDUCE(.STMT[SCALLELEM])
			END;
	%IOLSTCALL%	SKERR();
	%E1LISTCALL%	SKERR();
	%E2LISTCALL%	SKERR();
	%ESNGLELEM%	SKERR();
	%EDBLELEM%	SKERR()
		TES
	END;
	CSTMNT_STMT_.STMT[CLINK]
END
END;

GLOBAL ROUTINE GLDOFIND=
%(**********************************************************************

	CONTROLLING ROUTINE FOR OPTIMIZATION OF IMPLIED
	DO LOOPS

	THIS ROUTINE PERFORMS A SIMPLE RECURSIVE STACK WALK OF
	THE I/O LIST SEARCHING FOR DO LOOPS
	AND PERFORMING SKELETAL OPTIMIZATIONS FOR ALL
	STATEMENTS AND IOLSCLS NODES ON THE I/O LIST

	WHEN THE END OF AN IMPLIED DO LOOP IS DETECTED, THE
	OPTIMIZER GLOBALS LENTRY, TOP, INDVAR, LEND,
	AND BOTTOM ARE INITIALIZED FOR THE LOOP JUST DETECTED
	AND THE ROUTINES GLSTDFPT, GLSTELIM, GLSTREDUCE, AND
	TESTREPLACE ARE CALLED TO PERFORM GLOBAL COMMON SUBEXPRESSION
	ELIMINATE, PROPAGATION, REDUCTION, AND TEST REPLACEMENT
	FOR THE LOOP

	AFTER ALL LOOPS HAVE BEEN DETECTED AND OPTIMIZED, GLDOFIND
	RETURNS TO THE CALLING ROUTINE

**********************************************************************)%
BEGIN
LOCAL BASE PREVCONT;		!LOCATION OF CONTINUE IN FRONT OF DO
LOCAL BASE CURRDO;		!LOCATION OF CURRENT DO NODE
LOCAL PEXPRNODE ARGNODE;	!POINTS TO EXPR FOR P2SKELETON
EXTERNAL OBJECTCODE DOWDP;	!GLOBAL DO LOOP
IF .CURRELEM[OPRS] EQL DOOS THEN
BEGIN

	%(
	INSERT A CONTINUE NODE IN THE TREE
	IN FRONT OF THE DO LOOP. THIS NODE BECOMES LENTRY WHEN
	WE CALL THE OPTIMIZATION ROUTINES
	)%

	PREVCONT_MAKCONTINUE();		!CREATE A CONTINUE NODE
	IF .PREVELEM EQL .SAVSTMNT THEN 
	 SAVSTMNT[IOLIST]_.PREVCONT ELSE
	 PREVELEM[CLINK]_.PREVCONT;	!RELINK PREVIOUS ELEMENT
	PREVCONT[SRCLINK]_.CURRELEM;	!LINK CONTINUE TO DO
	CURRELEM[DOPRED]_.PREVCONT;	!LINK DO TO CONTINUE
	CURRDO_.CURRELEM;		!REMEMBER DO NODE ADR
	PREVELEM_.CURRELEM;		!POINT TO NEW PREVIOUS NODE
	CURRELEM_.CURRELEM[CLINK];	!POINT TO NEXT NODE

END
ELSE CURRDO_0;


%(
SEARCH FOR ANOTHER DO NODE OR THE END OF THE CURRENT
LOOP
)%

WHILE 1 DO
BEGIN
	CSTMNT_.CURRELEM;		!MARK CURRENT ELEMENT
	IF .CURRELEM[OPRCLS] EQL STATEMENT THEN
	BEGIN
		P2SKSTMNT();		!DO SKELETAL OPTIMIZATIONS

		%(
		RECURSIVE IF AN INNERMORE DO IS ENCOUNTERED
		)%

		IF .CURRELEM[SRCID] EQL DOID THEN
		BEGIN
			GLDOFIND()	!FIND INNER DO
		END
		ELSE

		%(
		CHECK FOR END OF CURRENT DO
		)%

		IF .CURRDO NEQ 0 THEN
		IF .CURRELEM[SRCID] EQL CONTID THEN
		IF .CURRELEM[SRCLBL] EQL .CURRDO[DOLBL] THEN
		BEGIN

			%(

			END OF LOOP DETECTED
			OPTIMIZE THE LOOP
			--------  --- ----

			)%

			TOP_.CURRDO;	!SET GLOBAL POINTERS
			LENTRY_.PREVCONT;
			LEND_.TOP[DOLBL];
			LEND_.LEND[SNHDR];
			IF (BOTTOM_.LEND[SRCLINK]) EQL 0 THEN
			 BOTTOM_LEND[SRCLINK]_MAKCONTINUE();
			INDVAR_.TOP[DOSYM];

			GLSTDFPT();	!FILL IN DEF POINTS
			GLSTELIM();	!ELIMINATE COMMON SUBS
			MOVCNST();	!MOVE CONSTANT COMPUTATIONS
			GLOBDEPD();	!COLLECT COMMON SUBS
			SCRUBARRAY();	!CLEAN UP ARRAYREFS
			SLINGHASH();	!CLEAR HASH TABLE

			%(
			HASH EXPRESSIONS CREATED BY G;LOBDEPD
			INTO THE HASH TABLE
			)%

			IMPLDO_0;	!CLEAR IMPLIED DO FLAG
			CNSMOVFLG_1;	!SET CNSMOVFLG
			CSTMNT_.TOP;	!MARK CURRENT STATEMEMENT
			WHILE .CSTMNT NEQ .BOTTOM DO
			BEGIN
				IF .CSTMNT[OPRS] EQL ASGNOS THEN
					REA(.CSTMNT[RHEXP]);	!REHASH
				CSTMNT_.CSTMNT[SRCLINK]
			END;

			MOVCNST();	!MOVE CONSTANT ASSIGNMENTS
			CNSMOVFLG_0;	!CLEAR CMNMOVFLG
			IMPLDO_1;	!RESET IMPLIED DO

			GLOBDEPD();	!COLLECT COMMON SUBS
			SCRUBARRAY();	!CLEAN UP ARRAYREFS
			SLINGHASH();	!CLEAR HASH TABLE

			LPRDCCT_.RDCCT;	!SET UP REPLACEMENT GLOBALS
			GLSTREDUCE();	!REDUCE EXPRESSIONS
					!REPLACE AND SUPPLANT
					!LOOP INDEX
			IF TESTREPLACE() NEQ 0 THEN SUPPLANT();
			RETURN

			%(
			END OF LOOP OPTIMIZATION
			--- -- ---- ------------
			)%

		END
	END
	ELSE	IF .CURRELEM[OPRCLS] EQL IOLSCLS
	THEN
	BEGIN	! IOLSCLS node

%1530%		! Setup pointer to I/O statement above the IOLSCLS node

%2400%		CURRELEM[IOLSTATEMENT] = .TOPIO;

		IF .CURRELEM[OPERSP] EQL DATACALL THEN
		BEGIN	! DATACALL node

			%(
			DO SKELETAL OPTIMIZATIONS FOR DATACALL NODE
			)%

			NEGFLG_NOTFLG_FALSE;
			ARGNODE_.CURRELEM[DCALLELEM];
			ARGNODE_CURRELEM[DCALLELEM]_(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
			IF .ARGNODE EQL .DOWDP[DOINDUC] THEN DOWDP[DONOAOBJN]_1;
		END;	! DATACALL node

	END;	! IOLSCLS node

	%(
	UPDATE ELEMENT POINTERS
	)%

	IF (PREVELEM_.CURRELEM) EQL 0 THEN RETURN;
	IF (CURRELEM_.CURRELEM[CLINK]) EQL 0 THEN RETURN
END
END;

GLOBAL ROUTINE SKOPTIO=
%(**********************************************************************

	ROUTINE INVOKED BY OPTIMIZE SWITCH TO

	1) PERFORM PHASE 2 SKELETON ON ALL EXPRESSIONS UNDER AN
	   I/O LIST
	2) PERFORM GLOBAL OPTIMIZATION OF IMPLIED DO LOOPS ON
	   AN I/O LIST

	CALLS GLDOFIND TO MAKE A RECURSIVE STACK WALK
	OVER THE I/O LIST AND CALL SKELETAL OPTIMIZATION AND
	GLOBAL OPTIMIZATION ROUTINES

	CALLED WITH THE GLOBAL CSTMNT POINTING TO A STATEMENT
	WITH A POTENTIAL I/O LIST

**********************************************************************)%
BEGIN
IF (CURRELEM_.CSTMNT[IOLIST]) NEQ 0 THEN
BEGIN					!AN I/O LIST IS PRESENT
	IMPLDO_1;			!SET IMPLIED DO OPTIMIZATION
	BACKST_0;			!GLOBALLY OPTIMIZE
	SAVSTMNT_.CSTMNT;		!REMEMBER THE I/O STATEMENT
	IF .CURRELEM[OPRS] NEQ CONTOS THEN	!START LIST WITH CONTINUE
	BEGIN					!NODE
		CURRELEM_MAKCONTINUE();		!INSERT A CONTINUE NODE
		CURRELEM[SRCLINK]_.CSTMNT[IOLIST];
		CSTMNT[IOLIST]_.CURRELEM
	END;
	GLDOFIND();			!FIND IMPLIED DO LOOPS
					!RECURSIVELY
	IMPLDO_0;			!CLEAR IMPLIED DO
	CSTMNT_.SAVSTMNT		!RESTORE CSTMNT
END
END;


%(**********************************************************************

THE MODULE IOPT MAY BE SPLIT HERE TO SEPERATE THE OPTIMIZING
AND I/O LIST COLLPSING ROUTINES

**********************************************************************)%

OWN
	INCEXPR,	!EXPRESSION IN WHICH INCREMENTED VARIABLE
			!WAS DETECTED
	INCVAR,		!INCREMENTED VARIABLE DETECTED
%[630]%	INCBADFORM,	!FLAG THAT THE INCREMENTED VARIABLE HAS
%[630]%			!BEEN USED IN A WAY THAT PRECLUDES INCLUSION
%[630]%			!OF THIS EXPRESSION IN AN SLIST OR ELIST.
	INCCOUNT,	!NUMBER OF INCREMENTED VARIABS DETECTED
	INCFNCTN;	!FLAG IF A FUNCTION CALL WAS DETECTED IN
			!THE EXPRESSION TREE

%[630]%	MAP BASE INCEXPR:INCVAR:INCBADFORM:INCCOUNT:INCFNCTN;

GLOBAL ROUTINE ISOLATE(EXPRNODE,PRNT,FLAGS)=	![630]
%(**********************************************************************

	ISOLATES EXPRESSIONS OF THE FORM
	INDVAR, .R, INDVAR OP, OR .R OP
	IN AN EXPRESSION TREE

	RETURNS:

	INCEXPR		- THE EXPRESSION IN WHICH
			  THE INCREMENTED VARIABLES WAS DETECTED
	INCVAR		- THE INCREMENTED VARIABLE DETETCED
[630]	INCBADFORM	- FLAG IF SOMETHING LIKE A(-I), A((I-1)*3+1),
[630]			  OR I**3 HAS BEEN DETECTED
	INCCOUNT	- THE NUMBER OF INCREMENTED VARIABLES DETETCED
	INCFNCTN	- FLAG IF A FUNCTION CALL WAS SEEN IN THE
			  TREE

	THIS ROUTINE IS USED BY THE COLLAPSING LOGIC TO
	DETERMINE IF AN ARBITRARY DATACALL MEETS THE CONDITIONS
	WHICH ALLOW THE LOOP TO BE COLLAPSED INTO AN
	E1LISTCALL OR E2LISTCALL NODE

	CALLED WITH AN EXPRESSION (POTENTIALLY A LEAF) IN
	EXPRNODE AND THE "PARENT" OF THAT EXPRESSION
	IN PRNT

**********************************************************************)%
BEGIN
LABEL RASGNFIND;
LABEL OASGNFIND;
MAP BASE EXPRNODE:PRNT:FLAGS;	![630] SEE LINES BELOW FOR FLAGS
MACRO ARRSEENFLG=35,1$,		![630] ARRAYREF NODE HAS BEEN SEEN ABOVE
      OPNOTADDFLG=0,1$;		![630] * ETC. SEEN ABOVE. MUST BE BIT 35
REGISTER BASE EXPR;

	EXPR_.EXPRNODE;
	CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
%[630]%		FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]%		ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
		END;
%DATAOPR%	BEGIN

%2400%		IF .EXPR[OPERSP] EQL CONSTANT THEN RETURN;

		%(
		FOR A .O VARIABLE, WE MUST
		IN THE LOOP TO SEE IF THE EXPRESSION ASSIGNED
		TO THE .O VARIABLE IS INCREMENTED IN THE LOOP
		)%

		IF .EXPR[IDDOTO] EQL SIXBIT ".O" THEN
		BEGIN
			LOCAL BASE ASGN;
			ASGN_.TOP[SRCLINK];	!LOOK FOR ASSIGNMENT
	OASGNFIND:	WHILE .ASGN NEQ .LEND DO
			BEGIN
				IF .ASGN[OPRS] EQL ASGNOS THEN
				IF .ASGN[LHEXP] EQL .EXPR THEN
				BEGIN

					%(
					THE .O VARIABLE IS ASSIGNED
					IN THE LOOP. LOOK IN
					THE RIGHT HAND EXPRESSION FOR AN
					INCREMENTED VARIABLE
					)%

%[630]%					ISOLATE(.ASGN[RHEXP],.ASGN,.FLAGS);
					LEAVE OASGNFIND
				END;
				ASGN_.ASGN[SRCLINK]
			END
		END
		ELSE

		%(
		IF THE LEAF IS THE LOOP INDUCTION VARIABLE
		INDVAR, WE HAVE FOUND AN INCREMENTED VARIABLE.
		SET THE OWNS ACCORDINGLY
		)%

		IF .EXPR EQL .INDVAR THEN
		BEGIN
			INCVAR_.EXPR;
			INCEXPR_.PRNT;
%[630]%			IF .FLAGS<OPNOTADDFLG> OR NOT .FLAGS<ARRSEENFLG>
%[630]%				THEN INCBADFORM_TRUE;
			INCCOUNT_.INCCOUNT+1
		END
		ELSE

		%(
		FOR A .R VARIABLE, WE MUST LOOK IN THE
		LOOP TO SEE IF THIS VARIABLE IS INCREMENTED IN
		THE LOOP. IF SO, WE HAVE FOUND AN INCREMENTED
		VARIABLE. SETS THE OWN ACCORDINGLY
		)%

		IF .EXPR[IDDOTO] EQL SIXBIT ".R" THEN
		BEGIN
			LOCAL BASE ASGN;
			ASGN_.TOP[SRCLINK];
	RASGNFIND:	WHILE .ASGN NEQ .LEND DO
			BEGIN
				IF .ASGN[OPRS] EQL ASGNOS THEN
				IF .ASGN[LHEXP] EQL .EXPR THEN
				BEGIN

					%(
					THE .R VARIABLE IS INCREMENTED
					IN THE LOOP
					)%

					INCVAR_.EXPR;
					INCEXPR_.PRNT;
%[630]%					IF .FLAGS<OPNOTADDFLG> OR NOT .FLAGS<ARRSEENFLG>
%[630]%						THEN INCBADFORM_TRUE;
					INCCOUNT_.INCCOUNT+1;
					LEAVE RASGNFIND
				END;
				ASGN_.ASGN[SRCLINK]
			END
		END
		END;
%RELATIONAL%	BEGIN
%[630]%		FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]%		ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
		END;
%FNCALL%	BEGIN

		%(
		FUNCTION CALL DETECTED - SET THE
		FUNCTION OWN ACCORDINGLY
		)%

		INCFNCTN_1
		END;
%ARITHMETIC%	BEGIN
%[630]%		IF .EXPR[OPERSP] NEQ ADDOP THEN FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS OR .EXPR[A1NEGFLG]);
%[630]%		ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG])
		END;
%TYPECNV%	BEGIN
%2410%			FLAGS<OPNOTADDFLG> = TRUE;
%2410%			IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM = TRUE;
%2410%			ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS);
		END;
%ARRAYREF%	BEGIN
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		BEGIN
%[630]%			IF .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE
%[630]%				ELSE FLAGS<ARRSEENFLG>_TRUE;
%[630]%			ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG]);
		END;
		END;
%CMNSUB%	BEGIN
%[630]%		ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS OR .EXPR[A2NEGFLG])
		END;
%NEGNOT%	BEGIN
%[630]%		FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
		END;
%SPECOP%	BEGIN
%[630]%		FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS)
		END;
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN END;
%INLINFN%	BEGIN
%[630]%		FLAGS<OPNOTADDFLG>_TRUE;
%[630]%		IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM_TRUE;
%[630]%		ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%[630]%		IF .EXPR[ARG2PTR] NEQ 0 THEN ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS)
		END;

%SUBSTRING%
%2400%		BEGIN
%2410%			LOCAL BOTHFALSE;
%2410%			BOTHFALSE = (NOT .FLAGS<OPNOTADDFLG>)
%2410%					AND (NOT .INCBADFORM);
%2410%
%2400%			FLAGS<OPNOTADDFLG> = TRUE;
%2400%			IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM = TRUE;
%2410%
%2400%			ISOLATE(.EXPR[ARG1PTR],.EXPR,.FLAGS);
%2400%			ISOLATE(.EXPR[ARG2PTR],.EXPR,.FLAGS);
%2410%
%2410%			! If  OPNOTADDFLG  and  INCBADFORM  were  both
%2410%			! FALSE, and if we haven't found an  induction
%2410%			! variable yet, then allow an ARRAYREF as  the
%2410%			! string.
%2410%
%2410%			IF .BOTHFALSE
%2410%			THEN IF .INCCOUNT EQL 0
%2410%			THEN FLAGS<OPNOTADDFLG> = INCBADFORM = FALSE;
%2410%
%2400%			ISOLATE(.EXPR[ARG4PTR],.EXPR,.FLAGS);
%2400%		END;

%CONCATENATION%
%2400%		BEGIN
%2400%			LOCAL ARGUMENTLIST AG;
%2400%			AG = .EXPR[ARG2PTR];
%2400%
%2400%			FLAGS<OPNOTADDFLG> = TRUE;
%2400%			IF NOT .FLAGS<ARRSEENFLG> THEN INCBADFORM = TRUE;
%2400%
%2400%			INCR I FROM 2 TO .AG[ARGCOUNT]	! Skip first arg
%2400%			DO ISOLATE(.AG[.I,ARGNPTR],.EXPR,.FLAGS);
%2400%		END;

	TES
END;



GLOBAL ROUTINE BLDCMN(EXPR1,EXPR2)=
%(**********************************************************************

	BUILD A COMMON SUB NODE WITH EXPRESSIONS
	EXPR1 AND EXPR2 AS ARGUMENTS

**********************************************************************)%
BEGIN
MAP BASE EXPR1;
MAP BASE EXPR2;
REGISTER BASE CMNNODE;		!NODE BEING BUILT
NAME<LEFT>_EXSIZ;		!SET SIZE OF NODE TO BE BUILT
CMNNODE_CORMAN();		!ALLOCATE CORE
CMNNODE[OPRCLS]_CMNSUB;		!SET COMMON SUB
CMNNODE[VALTYPE]_.EXPR2[VALTYPE];	!SET VALTYPE
CMNNODE[ARG1PTR]_.EXPR1;		!SET ARG1
CMNNODE[ARG2PTR]_.EXPR2;		!SET ARG2
IF .EXPR2[OPRCLS] EQL DATAOPR THEN CMNNODE[A2VALFLG]_1
 ELSE EXPR2[PARENT]_.CMNNODE;
RETURN .CMNNODE
END;

GLOBAL ROUTINE LCLLNK(CMNSNODE)=
%(**************************************************************

	LINK A COMMON SUBEXPRESSION NODE OR STRING OF
	COMMON SUBEXPRESSION NODES ONTO THE NODE IONODE

	CALLED WITH CMNSNODE POINTING TO THE FIRST (OR ONLY)
	COMMON SUB NODE IN THE STRING

	RETURNS THE ADDRESS OF THE FIRST COMMON
	SUBEXPRESSION LINKED ONTO THE NODE

**************************************************************)%
BEGIN
MAP BASE CMNSNODE;
REGISTER BASE CMNLST;
IF (CMNLST_.IONODE[SRCCOMNSUB]) EQL 0 THEN
BEGIN

	%(
	COMMON SUB FIELD IS ZERO - SET IT
	TO THE FIRST COMMON SUBEXPRESSION NODE IN THE
	STRING
	)%

	IONODE[SRCCOMNSUB]_.CMNSNODE
END
ELSE
BEGIN

	%(
	COMMON SUBS ALREADY EXIST ON IONODE
	FIND THE LAST COMMON SUB NODE AND LINK
	THE STRING AFTER IT
	)%

	WHILE .CMNLST[SRCLINK] NEQ 0 DO
	BEGIN			!FIND LAST COMMON SUB NODE ON IONODE
		CMNLST_.CMNLST[SRCLINK]
	END;
	CMNLST[SRCLINK]_.CMNSNODE	!LINK STRING ONTO CURRENT COMMON
					!SUBEXPRESSION STRING
END;
RETURN .CMNSNODE	!RETURN POINTER TO FIRST NODE ADDED
END;


%(
ALGORITHM FOR FOLDING A LOOP INTO AN E1LISTCALL OR E2LISTCALL NODE
(MAKELIST)

MAKELIST STARTS WITH A LOOP CONSISTING OF

1) A DO NODE (TOP)
2) A SERIES OF ASSIGNMENT STATEMENTS INITIALIZING
   OPTIMIZER CREATED .O VARIABLES
3) A SINGLE IOLSCLS NODE OF TYPE IOLSTCALL OR E1LISTCALL OR
   E2LISTCALL
4) A SERIES OF ASSIGNMENT STATEMENTS INCREMENTING OPTIMIZER
   CREATED .R VARIABLES
5) A CONTINUE NODE (LEND)

CONTINUE NODES OTHER THAN LEND WERE ELIMINATED
DURING THE LOOP LLAPSING ANALYSIS

MAKELIST

1) RESETS THE OPERATOR FIELD OF THE I/O NODE
   TO E1LISTCALL OR E2LISTCALL IF NECESSARY
2) TRANSFORMS ASSIGNMENT STATEMENTS INITIALIZING THE
   LOOP INCREMENT AND/OR STEPSIZE IF THEY ARE PRESENT
   INTO COMMON SUBEXPRESSIONS
3) TRANSFORMS ALL ASSIGNMENT STATEMENTS IN THE
   LOOP INTO COMMON SUBEXPRESSIONS
4) TRANSFORMS THE LOOP INITIAL VALUE AND INCREMENT EXPRESSIONS
   INTO COMMON SUBEXPRESSIONS
5) COMPUTES THE NUMBER OF ELEMENTS FROM THE LOOP CONTROL EXPRESSION
   AND SETS OR RESETS THE ECNTPTR FIELD OF THE IONODE ACCORDINGLY
6) SUBSTITUTE THE COMMON SUBEXPRESSION NODES
   CREATED IN THE ABOVE STEPS FOR THE VARIABLES WHOSE VALUES THEY
   ASSIGNED IN THE IONODE
7) ELIMINATES TOP AND LEND AND LINKS THE E1LISTCALL OR
   E2LISTCALL NODE CREATED INTO THE TREE

THIS PROCESS HOWEVER, IS REQUIRED TO PRESERVE THE
ORDER IN WHICH THE VARIABLES WERE ASSIGNED IN CREATING
A LINKING THE COMMON SUBEXPRESSION
STATEMENTS REPLACING THE ASSIGNMENT STATEMENTS ONTO THE NODE

TO DO SO, MAKELIST IN FACT BUILDS SIX STRINGS OF
COMMON SUBEXPRESSION NODES AS IT ELIMINATES THE ASIGNMENT
STATEMENTS AND, AFTER ALL SUCH NODES ARE CREATED, LINKS
THEM ONTO THE IONODE

THE ADDRESS OF THE FIRST NODE IN EACH STRING IS MAINTAINED
IN THE OWN VECTOR CHAIN.

THE ROUTINE CHNINIT INITIALIZES THIS VECTOR. CHNLNK IS USED TO
ADD A COMMON SUBEXPRESSION ONTO THE APPROPRIATE CHAIN.
MRGCHN MOVES THESE CHAINS ONTO THE NODE ITSELF.

THE SPECIFIC CHAINS MAINTAINED (IN THE ORDER IN
WHICH THE COMMON SUBEXPRESSION NODES MUST APPEAR ON THE
IONODE) ARE

1) COMMON SUBEXPRESSIONS CREATED FROM THE ASSIGNMENT OF
   A VALUE TO THE LOOP STEPSIZE
2) COMMON SUBEXPRESSIONS CREATD FROM THE ASSIGNMENT OF
   A VALUE TO THE LOOP INCREMENT
3) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENT
   STATEMENT IN FRONT OF THE LOOP INITIALIZING .OPTIMIZER
   CREATED .R VARIABLES
4) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENTS IN
   THE LOOP OF VALUES TO OPTIMIZER CREATED .O VARIABLES
5) ANY COMMON SUBEXPRESSIONS ORIGINALLY APPEARING ON THE NODE
   (FROM FOLDING AN INNER LOOP)
6) COMMON SUBEXPRESSIONS CREATED FROM ASSIGNMENT STATEMENTS
   INCREMENTING THE VALUE OF OPTIMIZER CREATED .R VARIABLES

WHEN CREATED, THE COMMON SUBEXPRESSIONS FOR THE LOOP INCREMENT
AND STEPSIZE VARIABLES ARE LINKED ON THE DOT R VARIABLE CHAIN
SINCE THEY APPEAR ON THE DO NODE WHICH LIES BETWEEN THE
.R INITIALIZING ASSIGNMENT STATEMENTS AND THE .O INITIALIZING
ASSIGNMENT STATEMENTS

THE ROUTINES FINDASGN, ELIMTEMP, AND ELIMSTEP ARE USED
TO LOCATE AND ELIMINATE ASSIGNMENT STATEMENTS

)%

OWN CHAIN[6];	!COMMON SUBEXPRESSION CHAIN VECTOR
		!DEFINE SYMBOLS TO REFER SYMBOLICALLY TO
		!EACH COMMON SUBEXPRESSIONC CHAIN
BIND
	DOTS=0,	!STEPSIZE CHAIN
	DOTI=1,	!INITIAL VALUE CHAIN
	DOTR=2,	!INITIAL .R VARIABLE VALUE CHAIN
	DOTO=3,	!.O VARIABLE VALUE CHAIN
	OLDC=4,	!OLD COMMON SUBEXPRESSIONS
	RINC=5;	!.R VARIABLE INCREMENT CHAIN

GLOBAL ROUTINE CHNINIT=
%(**********************************************************************

	CLEAR THE CHAIN VECTOR AND MOVE THE CURRENT
	COMMON SUBEXPRESSION CHAIN INTO THE OLDC
	CHAIN
**********************************************************************)%
BEGIN
	DECR I FROM 5 TO 0 DO
	BEGIN
		CHAIN[.I]_0
	END;
	CHAIN[OLDC]_.IONODE[SRCCOMNSUB];
	IONODE[SRCCOMNSUB]_0
END;


GLOBAL ROUTINE CHNLNK(CMNSNODE,INDEX)=
%(**********************************************************************

	LINK THE COMMONN SUBEXPRESSION NODE CMNSNODE ONTO
	THE CHAIN WHOSE SYMBOLIC NOME IS INDEX
**********************************************************************)%
BEGIN
MAP BASE CMNSNODE:INDEX;
REGISTER BASE CMNLST;
IF (CMNLST_.CHAIN[.INDEX]) EQL 0 THEN
BEGIN

	%(
	EMPTY CHAIN - INITIALIZE WITH CMNSNODE
	)%

	CHAIN[.INDEX]_.CMNSNODE
END
ELSE
BEGIN

	%(
	SEARCH FOR END OF CHAIN AND LINK
	CMNSNODE ONTO THE CHAIN
	)%

	WHILE .CMNLST[SRCLINK] NEQ 0 DO
	BEGIN
		CMNLST_.CMNLST[SRCLINK]
	END;
	CMNLST[SRCLINK]_.CMNSNODE
END;
RETURN .CMNSNODE	!RETURNS THE ADDRESS OF THE COMMON
			!SUBEXPRESSION NODE LINKED
END;


GLOBAL ROUTINE MRGCHN=
%(**********************************************************************

	LINK THE CHAINS IN THE CORRECT ORDER ON THE
	IONODE USING LCLLNK

**********************************************************************)%
BEGIN
	INCR I FROM 0 TO 5 DO
	BEGIN
		IF .CHAIN[.I] NEQ 0 THEN LCLLNK(.CHAIN[.I])
	END
END;


GLOBAL ROUTINE FINDASGN(VARPTR)=
%(**********************************************************************

	FIND AN ASSIGNMENT STATEMENT OF A VALUE TO
	THE VARIABLE VARPTR IN FRONT OF OR IN THE CURRENT
	LOOP ON THE I/O LIST

	RETURN THE ADDRESS OF THE NODE IN FRONT OF
	THE ASSIGNMENT STATEMENT OR 0 IF NO ASSIGNMENT
	STATEMENT EXISTS

**********************************************************************)%
BEGIN
MAP BASE VARPTR;
LABEL SRCH1;
LOCAL BASE PREVSTMT;
LOCAL BASE CURRSTMT;
PREVSTMT_.SAVSTMNT;		!SEARCH FOR ASSIGNMENT
CURRSTMT_.SAVSTMNT[IOLIST];	!SEARCH FOR ASSIGNMENT
SRCH1:
WHILE .CURRSTMT NEQ .LEND DO		!SEARCH AS FAR AS LEND
BEGIN
	IF .CURRSTMT[OPRS] EQL ASGNOS THEN
	IF .CURRSTMT[LHEXP] EQL .VARPTR THEN
	LEAVE SRCH1;
	PREVSTMT_.CURRSTMT;		!ADVANCE POINTER
	CURRSTMT_.CURRSTMT[SRCLINK]	!ADVANCE POINTER
END;
RETURN IF .CURRSTMT EQL .LEND THEN 0 ELSE .PREVSTMT
END;


GLOBAL ROUTINE ELIMTEMP(VARPTR,ASGNPTR,INDEX)=
%(**********************************************************************

	ROUTINE TO ELIMINATE THE TEMPORARY POINTED BY VARPTR
	AND CREATE A COMMON SUBEXPRESSION NODE OF THE
	ASSIGNMENT OF A VALUE TO THAT TEMPORARY AT THE
	STATEMENT AFTER ASGNPTR

	THE FORMAL INDEX INDICATES WHICH CHAIN THE COMMON
	SUBEXPRESSION IS TO BE LINKED INTO

**********************************************************************)%
BEGIN
MAP BASE VARPTR;
MAP BASE ASGNPTR;
LOCAL BASE ASGNNODE;
LOCAL BASE CMNNODE;
IF .ASGNPTR EQL 0 THEN RETURN;		!NO ASSIGNMENT STATEMENT - DO NOT
					!ELIMINATE VARPTR
ASGNNODE_.ASGNPTR[SRCLINK];		!FIND THE ASSIGNMENT STATEMENT
ASGNPTR[SRCLINK]_.ASGNNODE[SRCLINK];	!LINK THE ASSIGNMENT STATEMENT OUT OF THE TREE
CMNNODE_CHNLNK(BLDCMN(.VARPTR,.ASGNNODE[RHEXP]),.INDEX);	!BUILD AND LINK COMMON SUB NODE
VARPTR[IDATTRIBUT(NOALLOC)]_1;		!NOALLOCATE THE VARIABLE
SAVSPACE(ASGNSIZ+SRCSIZ-1,.ASGNNODE);	!DEALLOCATE THE ASSIGNMENT STATEMENT
RETURN .CMNNODE				!RETURN THE ADDRESS OF THE COMMON SUBEXPRESSION
					!NODE CREATED
END;

GLOBAL ROUTINE ELIMSTEP(VARPTR,ASGNPTR)=
%(**********************************************************************

	ROUTINE TO ELIMINATE THE ASSIGNMENT STATEMENT
	INCREMENTING THE VALUE OF THE .R TEMPORARY
	VARPTR AND GENERATE A COMMON SUBEXPRESSION NODE
	FOR THE INCREMENT EXPRESSION

	VARPTR POINTS TO THE SYMBOL TABLE ENTRY FOR THE
	.R VARIABLE

	ASGNPTR POINTS TO THE STATEMENT IN FRONT OF
	THE ASSIGNMENT STATEMENT TO BE ELIMINATED

**********************************************************************)%
BEGIN
MAP BASE ASGNPTR;
MAP BASE VARPTR;
LOCAL BASE ASGNNODE;
LOCAL BASE CMNEXPR;
LOCAL BASE CMNNODE;
ASGNNODE_.ASGNPTR[SRCLINK];		!LOCATE THE ASSIGNMENT STATEMENT
CMNEXPR_.ASGNNODE[RHEXP];		!ISOLATE THE EXPRESSION .R + I OR I + .R
ASGNPTR[SRCLINK]_.ASGNNODE[SRCLINK];	!LINK THE ASSIGNMENT STATEMENT OUT OF THE TREE
SAVSPACE(ASGNSIZ+SRCSIZ-1,.ASGNNODE);	!DEALLOCATE THE ASSIGNMENT STATEMENT
CMNNODE_CHNLNK(BLDCMN(0,IF .CMNEXPR[ARG1PTR] NEQ .VARPTR THEN
 .CMNEXPR[ARG1PTR] ELSE .CMNEXPR[ARG2PTR]),RINC);	!BUILD AND LINK COMMON SUB NODE
SAVSPACE(EXSIZ-1,.CMNEXPR);		!DEALLOCATE THE .R + I OR
					!I + .R EXPRESSION
RETURN .CMNNODE				!RETURN THE ADDRESS OF THE COMMON
					!SUBEXPRESSION NODE CREATED
END;



!GLOBAL ROUTINE DIV2CMN(CMNNODE,INDEX)=
![2400] This routine is no longer needed
!%(**********************************************************************
!
!	GENERATE A COMMON SUB FOR CMNNODE / 2
!	USING SPECOP P2MULOP
!
!**********************************************************************)%
!BEGIN
!MAP BASE CMNNODE;
!LOCAL BASE DIV2NODE;
!LOCAL BASE DIV2CMNNODE;
!DIV2NODE_MAKEPR(SPECOP,P2MULOP,.CMNNODE[VALTYPE],.CMNNODE,-1);	!GENERATE SPECOP NODE
!DIV2NODE[A1VALFLG]_1;		!SET VALFLG
!DIV2CMNNODE_CHNLNK(BLDCMN(0,.DIV2NODE),.INDEX);	!BUILD AND LINK NEW COMMON
!						!SUB NODE
!RETURN .DIV2CMNNODE
!END;




!GLOBAL ROUTINE CHKDBLSUB(EXPR)=
![2400] This routine is no longer needed
!%(**********************************************************************
!
!	ROUTINE TO DETERMINE IF AN EXPRESSION IS A DOUBLE PRECISION
!	ARRAYREFERENCE WITH A MULTIPLICATION BY 2
!	AS THE FIRST EXPRESSION UNDER THE SUBSCRIPT
!
!	RETURNS 0 IF THE EXPRESSION IS NOT A DOUBLE WORD ARRAYREF
!	WITH A MULTIPLICATION BY 2 FOLDED INTO THE SUBSCRIPT
!
!**********************************************************************)%
!BEGIN
!MAP BASE EXPR;		!MAP THE EXPRESSION NODE
!IF .EXPR[OPRCLS] EQL ARRAYREF THEN		!TEST FOR ARRAYREF
!IF .EXPR[ARG2PTR] NEQ 0 THEN			!WITH A SUBSCRIPT
!IF DBLFROMVAL(.EXPR[VALTYPE]) THEN		!CHECK THAT ARRAY IS
!						!DOUBLE PRECISION OR COMPLEX
!BEGIN
!	LOCAL BASE SBSCRPT;			!ALLOCATE TEMP FOR SUBSCRIPT
!	SBSCRPT_.EXPR[ARG2PTR];			!LOOK AT SUBSCRIPT
!	IF .SBSCRPT[OPR1] EQL MULOPF THEN	!IF THIS IS A MULTIPLY
!	BEGIN
!		LOCAL BASE SUBARG;		!ALLOW A LOCAL
!		SUBARG_.SBSCRPT[ARG1PTR];	!LOOK AT FIRST ARG
!		IF .SUBARG[OPR1] EQL CONSTFL THEN
!		IF .SUBARG[CONST1] EQL 0 AND
!		 .SUBARG[CONST2] EQL 2 THEN
!		 RETURN 0;
!		SUBARG_.SBSCRPT[ARG2PTR];	!LOOK AT 2ND ARG
!		IF .SUBARG[OPR1] EQL CONSTFL THEN
!		IF .SUBARG[CONST1] EQL 0
!		 AND .SUBARG[CONST2] EQL 2 THEN
!		 RETURN 0
!	END;
!	RETURN 1		!ARRAYREF WITH MULTIPLICATION BY 2
!				!FOLDED
!END;
!RETURN 0
!END;





GLOBAL ROUTINE MAKELIST(LCLASS)=
%(**********************************************************************

	ROUTINE TO TRANSFORM A LOOP INTO AN
	E1LISTCALL OR E2LISTCALL NODE

	CALLED FROM COLLAPSE UNDER THE FOLLOWING:

	LCLASS		CONDITION
	------		---------

	0		AN INNER LOOP HAS ALREADY BEEN FOLDED
			INTO AN E1LISTCALL OR E2LISTCALL
			NODE. MAKELIST WILL DO COMMON SUBEXPRESSION
			GENERATION AND UPDATE THE COUNT
			EXPRESSION FOR THE ELISTCALL
			NODE
	1		INNERMOST LOOP TO BE FOLDED INTO
			AN E1LISTCALL NODE
	2		INNERMOST LOOP TO BE FOLDED INTO AN
			E2LISTCALL NODE

	IF LCLASS EQL 1 OR 2, THE LOOP CONTAINS EXACLTY ONE
	IOSLCLS NODE OF TYPE IOLSTCALL TO BE TRANSFORMED
	INTO AN E1LISTCALL OR E2LISTCALL NODE. WHEN COLLPASE
	GENERATED THIS NODE IT ALLOWED AN EXTRA WORD FOR THE
	E1INCR AND ECNTPTR FIELDS WHICH DO NOT NORMALLY
	APPEAR IN AN IOLSTCALL NODE

	SEE DOCUMENTATION IN FRONT OF ROUTINE LCLLNK
	FOR A BASIC FUNCTIONAL DESCRIPTION OF
	MAKELIST

**********************************************************************)%
BEGIN
%1207%	EXTERNAL DOVARASGN,MAKASGN;
%4527%	MAP BASE INDVAR;	! Note BASE is NOT PHAZ2.
MAP BASE LCLASS;
LOCAL BASE PREV;
LOCAL BASE CURR;

%(***INITIALIZE COLLECTION OF COMMON SUBS***)%

CHNINIT();


%(***RESET OPERATOR FIELD OF NODE IF NECESSARY***)%

IF .LCLASS NEQ 0 THEN
BEGIN
	IONODE[OPERATOR]_IF .LCLASS EQL 1 THEN E1LISTCFL ELSE E2LISTCFL
END;

%(***COLLECT ALL POTENTIAL COMMON SUBS UNDER THE ELISTNODE***)%

IF .TOP[INITLTMP] THEN		!ELIMINATE INCREMENT TEMPORARY
BEGIN
	ELIMTEMP(.TOP[DOM1],FINDASGN(.TOP[DOM1]),DOTI)
END;
IF .TOP[SSIZINTMP] THEN		!ELIMINATE STEPSIZE TEMPORARY
BEGIN
	ELIMTEMP(.TOP[DOM3],FINDASGN(.TOP[DOM3]),DOTS)
END;

CURR_.IONODE[ELSTPTR];			!RECLASSIFY DATACALL NODES
WHILE .CURR NEQ 0 DO
BEGIN
%2400%	CURR[OPERSP] = ESNGLELEM;
	CURR_.CURR[CLINK]
END;

PREV_.TOP;			!ELIMINATE ASSIGNMENT STATEMENTS TO
				!OPTIMIZER CREATED TEMPORARIES IN THE LOOP
WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
	IF .CURR[OPRS] EQL ASGNOS THEN
	BEGIN
		LOCAL BASE VARPTR;
		VARPTR_.CURR[LHEXP];

		%(
		CONVERT ASSIGNMENTS TO .O
		VARIABLES INTO COMMON SUBS
		)%

		IF .VARPTR[IDDOTO] EQL SIXBIT ".O" THEN
		BEGIN
			ELIMTEMP(.VARPTR,FINDASGN(.VARPTR),DOTO)
		END
		ELSE

		%(
		ANY ASSIGNMENT STATEMENTS TO .R TEMPORARIES
		DETECTED IN THE LOOP ARE INCREMENT EXPRESSION

		FIRST LOCATE AND TRANSFORM INTO
		A COMMON EXPRESSION THE ASSIGNMENT STATEMENT
		OUTSIDE THE LOOP INITIALIZING THE
		.R TEMPORARY

		THEN, GENERATE A COMMON SUBEXPRESSION NODE
		VIA ELIMSTEP FOR THE INCREMENT

		IF LCLASS IS NOT 0 SUBSTITUTE THIS EXPRESSION
		IN THE E2INCR FIELD FOR ALL ARRAYS INCREMENTED
		BY THE .R VARIABLE

		)%

		IF .VARPTR[IDDOTO] EQL SIXBIT ".R" THEN
		BEGIN

			!LOCATE AND ELIMINATE THE ASSIGNMENT
			!STATEMENT INITIALIZING THE .R
			!VARIABLE

			ELIMTEMP(.VARPTR,FINDASGN(.VARPTR),DOTR);

			!ELIMINATE THE INCREMENTING ASSIGNMENT
			!STATEMENT AND SUBSTITUTE FOR THE
			!INCREMENT EXPRESSION IN THE APPROPRIATE
			!ELIST SUBNODES

			!ALSO GENERATE A COMMON SUB FOR
			!INCREMENT DIVIDED BY 2 IN CASE TWO
			!WORD ELEMENT

			IF .LCLASS NEQ 0 THEN
			BEGIN
				LOCAL BASE CMNNODE;
				LOCAL BASE IOARRAY;
				CMNNODE_ELIMSTEP(.VARPTR,.PREV);
				IOARRAY_.IONODE[ELSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
%2400%					IF .IOARRAY[E2INCR] EQL .VARPTR
%2400%					THEN IOARRAY[E2INCR] = .CMNNODE;
					IOARRAY_.IOARRAY[CLINK]
				END
			END
			ELSE
			BEGIN
				PREV[SRCLINK]_.CURR[SRCLINK];
				SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR)
			END
		END
		ELSE
		BEGIN
			PREV_.PREV[SRCLINK]
		END
	END
	ELSE
	BEGIN
		PREV_.PREV[SRCLINK]
	END
END;

%(***GENERATE A COMMON SUBEXPRESSION FOR THE LOOP INCREMENT FOR
     AN E1LISTCALL OR E2LISTCALL NODE***)%

IF .LCLASS NEQ 0 THEN
BEGIN
	LOCAL BASE CMNNODE;
	CMNNODE_CHNLNK(BLDCMN(0,.TOP[DOM3]),DOTR);	!BUILD INITIAL COMMON SUB NODE
	%(
	SUBSTITUTE COMMON SUBEXPRESSION FOR ELIST SUB NODES
	WHOSE INCREMENT VARIABLE WAS THE TOP LOOP INDUCTION
	VARIABLE
	OR SET E1INCR
	)%

	CURR_.IONODE[ELSTPTR];
	WHILE .CURR NEQ 0 DO
	BEGIN
		IF .LCLASS EQL 1 THEN		!SET E1INCR
		BEGIN
			CURR[E2INCR]_0;		!CLEAR E2INCR
%2400%			IONODE[E1INCR] = .CMNNODE;
		END
		ELSE
		IF .LCLASS EQL 2 THEN
		BEGIN
			IF .CURR[E2INCR] EQL .INDVAR THEN
%2400%			CURR[E2INCR] = .CMNNODE;
		END;
		CURR_.CURR[CLINK]
	END
END;

%(***GENERATE A COMMON SUBEXPRESSION NODE FOR THE INITIAL
    VALUE OF THE LOOP INDUCTION VARIABLE***)%

CHNLNK(BLDCMN(.INDVAR,.TOP[DOM1]),DOTR);	!BUILD AND LINK NODE
IF .INDVAR[IDDOTO] EQL SIXBIT ".R" THEN INDVAR[IDATTRIBUT(NOALLOC)]_1;	!NOALLOC OPTIMIZER CREATED INDUCTION VARIABLE


%(***SET THE # OF ELEMENTS***)%

CURR_.IONODE[ECNTPTR];		!REMMEBER PREVIOUS COUNT FOR LCLASS EQL 0
IONODE[ECNTPTR]_.TOP[DOLPCTL];	!LOCATE COUNT EXPRESSION
				!CONVERT COUNT EXPRESSION TO
				!A POSITIVE EXPRESSION
IF .TOP[FLCWD] THEN
BEGIN
%2400%	! Extract positive count from AOBJN word
%2400%
%2400%	LOCAL BASE CTLCONST;
%2400%	CTLCONST = .IONODE[ECNTPTR];
%2400%	IONODE[ECNTPTR] = MAKECNST(INTEGER,0,
%2400%		-(ARITHSHIFT(.CTLCONST[CONST2],-18)));
END
ELSE
IF  NOT .TOP[CTLNEG] THEN
BEGIN
				!NEGATE THE LOOP CONTROL EXPRESSION
				!IF IT IS NEGATIVE (TOP[CTLNEG]) NOT SET

	LOCAL BASE NEGCNTPTR;
	NEGCNTPTR_.IONODE[ECNTPTR];

				!IF CONTROL EXPRESSION POINTS TO
				!A NEGATE NODE ELIMINATE THE NEGATE
				!NODE

	IF .NEGCNTPTR[OPR1] EQL NEGFL THEN
	BEGIN
%2332%		LOCAL BASE NEGCHILD;
%2332%
%2332%		! Unlink NEGNOT node
%2332%
%2332%		IONODE[ECNTPTR] = NEGCHILD = .NEGCNTPTR[ARG2PTR];
%2332%
%2332%		! Set parent pointer if necessary
%2332%
%2332%		IF .NEGCHILD[OPRCLS] NEQ DATAOPR
%2332%		THEN IF .NEGCHILD[OPRCLS] NEQ CMNSUB
%2332%		THEN NEGCHILD[PARENT] = .IONODE;
%2332%
%2332%		SAVSPACE(EXSIZ-1,.NEGCNTPTR);	! Release NEGNOT node
	END
	ELSE

				!IF CONTROL EXPRESSION IS A
				!CONSTANT GENERATE A POSITIVE CONSTANT
				!VIA NEGCNST

	IF .NEGCNTPTR[OPR1] EQL CONSTFL THEN
	BEGIN
		IONODE[ECNTPTR]_NEGCNST(NEGCNTPTR)
	END
	ELSE

					!TRY TO PROPAGATE A NEGATIVE
					!IF THIS FAILS GENERATE A
					!NEGATE NODE AND PLACE THE
					!ORIGINAL CONTROL EXPRESSION
					!UNDER IT
	BEGIN
		IF NOT PROPNEG(.IONODE[ECNTPTR]) THEN
%2332%		IONODE[ECNTPTR] = MAKPR1(.IONODE,NEGNOT,NEGOP,
%2332%			.NEGCNTPTR[VALTYPE],0,.NEGCNTPTR);
	END
END;

!**;[1207], MAKELIST, DCE, 3-Apr-81
%(***Set up assignment to do loop variable = final value***)%

%[1207]%	IF F77 THEN DOVARASGN();

%(***CREATE NEW COUNT EXPRESSION FOR LCLASS EQL 0***)%

IF .LCLASS EQL 0 THEN
BEGIN

	!BUILD A MULTIPLY OF THE OLD VALUE OF ECNTPTR AND THE
	!NEW VALUE OF ECNTPTR
	!THIS EXPRESSION WILL BE FOLDED DURING THE CALL TO
	!CMNELIM BELOW

%2332%	IONODE[ECNTPTR] = MAKPR1(.IONODE,ARITHMETIC,MULOP,.CURR[VALTYPE],
%2332%		.CURR,.IONODE[ECNTPTR]);
END;

%(***MERGE COMMON SUBEXPRESSION CHAINS***)%

MRGCHN();

%(***SUBSITITUTE THE COMMON SUBEXPRESSIONS INTO THE ELISTCALL NODE***)%

%(
WHEN THE COMMON SUBEXPRESSION NODES WERE GENERATED BY
ELIMTEMP A POINTER TO THE VARIABLE ASSIGNED BY
THE ASSIGNMENT STATEMENT ELIMINATED WAS PLACED IN 
ARG1PTR. FOR EACH COMMON SUBEXPRESSION NODE WITH ARG1PTR NEQ 0
SUBSTITUTE THAT COMMON SUBEXPRESSION NODE FOR ALL
OCCURENCES OF THE VARIABLE POINTED TO BY ARG1PTR

A MODIFIED FORM OF THE LEAFSUBSTITUTION SCHEME USED ELSEWHERE
IN THE OPTIMIZER IS EMPLOYED HERE. THE VECTORS GLOBREG AND
CHOSEN ARFE INITIALIZED TO POINT TO THE VALUES TO BE SUBSTITED
FOR AND THE VALUE SUBSTITUTED. THE GLOBAL ITMCT HOLDS THE NUMBER
OF SUCH ITEMS TO BE SUBSTITUTED. THE ROUTINE CMNRPLC PERFORMS
PARALLEL SUBSTITUION OF THE VALUES IN CHOSEN FOR THE VALUES IN
GLOBREG

)%

CURR_.IONODE[SRCCOMNSUB];
LOWLIM_1;			!SET LOWLIM FOR SWAPEM
SPECCASE_ITMCT_0;
WHILE .CURR NEQ 0 DO
BEGIN

	%(
	INITIALIZE THE VECTORS GLOBREG AND CHOSEN
	)%

	IF .CURR[ARG1PTR] NEQ 0 THEN
	BEGIN
		ITMCT_.ITMCT+1;
		GLOBREG[.ITMCT]_.CURR[ARG1PTR];
		CHOSEN[.ITMCT]_.CURR
	END;
	IF (.CURR[SRCLINK] EQL 0 AND .ITMCT NEQ 0) OR .ITMCT EQL 15 THEN
	BEGIN
		CMNRPLC(.IONODE);	!SUBSTITUTE
		ITMCT_0
	END;
	CURR_.CURR[SRCLINK]
END;

%(***REMOVE TOP AND LEND AND LINK NODE INTO TREE***)%

IF .TOP[SRCLINK] NEQ .IONODE THEN SKERR();	!CONSISTENCY CHECKS
IF .IONODE[SRCLINK] NEQ .LEND THEN SKERR();
IF .LEND[SRCLINK] NEQ .BOTTOM THEN SKERR();
PREVELEM_.SAVSTMNT[IOLIST];		!LOCATE NODE IN FRONT OF THE DO NODE TOP
WHILE .PREVELEM[SRCLINK] NEQ .TOP DO
BEGIN
	PREVELEM_.PREVELEM[SRCLINK]
END;
SAVSPACE(CONTSIZ+SRCSIZ-1,.LEND);	!DEALLOCTE LEND
CURR_.TOP[DOCTLVAR];			!NOALLOCATE THE .S CONTROL
CURR[IDATTRIBUT(NOALLOC)]_1;		!VARIABLE FOR THE LOOP
SAVSPACE(DOSIZ+SRCSIZ-1,.TOP);		!DEALLOCATE TOP
CURRELEM_PREVELEM[SRCLINK]_.IONODE;	!LINK IN THE E1LISTCALL OR
					!E2LISTCALL NODE
IONODE[SRCLINK]_.BOTTOM;		!FORWARD LINK THE ELIST NODE

CMNELIM();			!PERFORM COMMON SUBEXPRESSION ELIMINATION
				!AND LOCAL DEPENDENCY
RETURN .IONODE				!RETURN THE ADDRESS OF THE IONODE
END;








GLOBAL ROUTINE ELIMCONT=
%(**********************************************************************

	ROUTINE TO ELIMINATE CONTINUE STATEMENTS IN A LOOP
	ELIMINATES ALL CONTINUES BETWEEN TOP AND LEND
	EXCEPT CONTINUES TERMINATING INNER LOOPS
	EXCLUSIVE

**********************************************************************)%
BEGIN
LOCAL BASE PREV;
LOCAL BASE CURR;
LABEL SEARCH;
PREV_.TOP;		!POINT AT LOOP START
SEARCH:
WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
	IF .CURR EQL 0 THEN LEAVE SEARCH;
	IF .CURR[OPRS] EQL CONTOS THEN
	BEGIN

		%(
		DELINK AND DEALLOCATE CONTINUE
		STATEMENT
		)%

		PREV[SRCLINK]_.CURR[SRCLINK];
		SAVSPACE(SRCSIZ+CONTSIZ-1,.CURR)
	END
	ELSE
	IF .CURR[OPRS] EQL DOOS THEN
	BEGIN

		%(
		SKIP OVER INNER LOOPS
		)%
		PREV_.CURR[DOLBL];
		PREV_.PREV[SNHDR]
	END
	ELSE
		PREV_.PREV[SRCLINK]
END
END;



GLOBAL ROUTINE EXPEXP(XP1,XP2)=
%(**********************************************************************

	ROUTINE TO FOLD TWO POTENTIAL EXPRESSIONS
	RETURNS A POINTER TO THE FOLDED EXPRESSION
	OR 0 IF EITHER XP1 OR XP2 IS A NOT AN
	INTEGER OR THEIR PRODUCT IS NOT A SINGLE
	DATAOPR

**********************************************************************)%
BEGIN
EXTERNAL NEGFLG;
EXTERNAL NOTFLG;
EXTERNAL ARSKOPT;
LOCAL BASE EXPR;
MAP BASE XP1:XP2;
WHILE .XP1[OPRCLS] EQL CMNSUB DO XP1_.XP1[ARG2PTR];
IF .XP1[OPRCLS] NEQ DATAOPR THEN RETURN 0;
IF .XP1[VALTYPE] NEQ INTEGER THEN RETURN 0;
WHILE .XP2[OPRCLS] EQL CMNSUB DO XP2_.XP2[ARG2PTR];
IF .XP2[OPRCLS] NEQ DATAOPR THEN RETURN 0;
IF .XP2[VALTYPE] NEQ INTEGER THEN RETURN 0;
NEGFLG_NOTFLG_FALSE;

%(
CREATE AND FOLD XP1 * XP2
)%

EXPR_ARSKOPT(MAKPR1(0,ARITHMETIC,MULOP,INTEGER,.XP1,.XP2));
IF .EXPR[OPRCLS] EQL DATAOPR THEN RETURN .EXPR ELSE
BEGIN

	%(
	PRODUCT WAS NOT A DATAOPR 
	ELIMINATE THE EXPRESSION CREATED
	)%

	SAVSPACE(EXSIZ-1,.EXPR);
	RETURN 0
END
END;










GLOBAL ROUTINE IOCONTVAR(ELEM,VAR)=
%(**********************************************************************

	ROUTINE TO CHECK IF AN IOLSCLS ELEMENT CONTAINS THE
	VARIABLE VAR

**********************************************************************)%
BEGIN
MAP BASE ELEM;
MAP BASE VAR;
CASE .ELEM[OPERSP] OF SET
%DATACALL%	RETURN CONTVAR(.ELEM[DCALLELEM],.VAR);
%SLISTCALL%	RETURN CONTVAR(.ELEM[SCALLELEM],.VAR) OR
		CONTVAR(.ELEM[SCALLCT],.VAR);
%IOLSTCALL%	BEGIN
		LOCAL BASE IOARRAY;
		IOARRAY_.ELEM[SRCCOMNSUB];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END;
		IOARRAY_.ELEM[IOLSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF IOCONTVAR(.IOARRAY,.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END
		END;
%E1LISTCALL%	BEGIN
		LOCAL BASE IOARRAY;
		IOARRAY_.ELEM[SRCCOMNSUB];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END;
		IOARRAY_.ELEM[IOLSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF CONTVAR(.IOARRAY[E2ARREFPTR],.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END;
		RETURN CONTVAR(.ELEM[ECNTPTR],.VAR) OR CONTVAR(.ELEM[E1INCR],.VAR)
		END;
%E2LISTCALL%	BEGIN
		LOCAL BASE IOARRAY;
		IOARRAY_.ELEM[SRCCOMNSUB];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF CONTVAR(.IOARRAY[ARG2PTR],.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END;
		IOARRAY_.ELEM[IOLSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN
			IF CONTVAR(.IOARRAY[E2INCR],.VAR) OR
			CONTVAR(.IOARRAY[E2ARREFPTR],.VAR) THEN
			RETURN 1
			ELSE IOARRAY_.IOARRAY[CLINK]
		END;
		RETURN CONTVAR(.ELEM[ECNTPTR],.VAR)
		END;
%ESNGLELEM%	SKERR();
%EDBLELEM%	SKERR()
	TES;
	RETURN 0
END;






GLOBAL ROUTINE PUTBAK=
%(**********************************************************************

	ROUTINE TO PUT BACK COMMON SUBEXPRESSIONS CREATED
	BY THE GLOBAL OPTIMIZER IF THEY ARE IN FACT LOCAL
	COMMON SUBEXPRESSIONS UNDER A SINGLE IOLSCLS NODE

**********************************************************************)%
BEGIN
LOCAL BASE CURR;	!CURRENT NODE
LOCAL BASE PREV;	!PREVIOUS NODE

%(***ESTABLISH BACK POINTERS***)%

CURR_.TOP;		!LOCATE FIRST NODE
PREV_.TOP[SRCLINK];	!LOCATE NEXT NODE
WHILE .PREV NEQ .LEND DO
BEGIN
	PREV[CW0L]_.CURR;
	CURR_.PREV;

![1036], Do not skip over inner loops - we now need complete back pointers
![1036], to implement edit 1007 properly.  Without them we can end up
![1036], stepping on register zero with random consequences (all bad!).
![1036]	IF .PREV[OPRS] EQL DOOS THEN 
![1036]	BEGIN
![1036]		PREV_.PREV[DOLBL];
![1036]		PREV_.PREV[SNHDR];
![1036]	END
![1036]	ELSE

	PREV_.PREV[SRCLINK];
END;

%(
SEARCHING FOR ASSIGNMENTS STATEMENTS BACKWARDS FROM CURR
SEARCH FOR ALL ASSIGNMENTS TO .O VARIABLES IN THE LOOP
)%

WHILE .CURR NEQ .TOP DO
BEGIN
	IF .CURR[OPRS] EQL ASGNOS THEN
	BEGIN
		LOCAL BASE OVAR;
		OVAR_.CURR[LHEXP];	!LOCATE VARIABLE BEGING ASSIGNED
		IF .OVAR[IDDOTO] EQL SIXBIT ".O" THEN
		BEGIN

			%(
			COUNT THE NUMBER OF OTHER ELEMENTS REFERENCING
			OVAR IN THE LOOP
			)%
			LOCAL BASE OCOUNT;	!COUNT OF STATEMENTS
						!REFERENCING OVAR
%[1111]%		LOCAL BASE OSTEP;	!STEP SIZE OVAR SEEN
			LOCAL BASE OSEEN;	!NODE WHERE LAST SEEN
%2400%			LOCAL OCLEVEL;		!Current relative DO level
%2400%			LOCAL OLEVEL;		!Relative DO level where seen
			LOCAL BASE OCURR;	!NODE WE ARE LOOKING AT
%2400%			OCOUNT = OSTEP = OSEEN = OCLEVEL = OLEVEL = 0;
			OCURR_.CURR[SRCLINK];	!INITIALIZE SEARCH
			WHILE .OCURR NEQ .LEND DO
			BEGIN
				IF .OCURR[OPRS] EQL ASGNOS THEN
				BEGIN
					IF CONTVAR(.OCURR[LHEXP],.OVAR)
					OR CONTVAR(.OCURR[RHEXP],.OVAR)
					THEN
					BEGIN
%2400%						OLEVEL = .OCLEVEL;
						OSEEN_.OCURR;
						OCOUNT_.OCOUNT+1
					END
				END
				ELSE
				IF .OCURR[OPRS] EQL DOOS THEN
				BEGIN
					IF CONTVAR(.OCURR[DOLPCTL],.OVAR)
					THEN
					BEGIN
%2400%						OLEVEL = .OCLEVEL;
						OSEEN_.OCURR;
						OCOUNT_.OCOUNT+1
					END;
%[753]%					IF CONTVAR(.OCURR[DOM1],.OVAR)
%[753]%					THEN
%[753]%					BEGIN	! .O IN INITIAL VALUE
%2400%						OLEVEL = .OCLEVEL;
%[753]%						OSEEN_.OCURR;
%[753]%						OCOUNT_.OCOUNT+1
%[753]%					END;
					!WHEN TESTING FOR THE USE OF .O VARIABLES,
					! BE SURE TO CHECK THE INCREMENT FIELD OF
					! REDUCTION IN STRENGTH WHICH MAY OCCUR
					IF CONTVAR(.OCURR[DOM3],.OVAR) 
					THEN
					BEGIN
%[1111]%					OSTEP_1;
%2400%						OLEVEL = .OCLEVEL;
						OSEEN_.OCURR;
						OCOUNT_.OCOUNT+1
					END;

%2400%					OCLEVEL = .OCLEVEL + 1;
				END

%2400%				ELSE IF .OCURR[OPRS] EQL CONTOS
%2400%				THEN
%2400%				BEGIN
%2400%					LOCAL BASE CONTLAB;
%2400%					IF (CONTLAB = .OCURR[SRCLBL]) NEQ 0
%2400%					THEN OCLEVEL = .OCLEVEL - .CONTLAB[SNDOLVL];
%2400%				END

%2400%				ELSE IF .OCURR[OPRCLS] EQL IOLSCLS
%2400%				THEN
				BEGIN
					IF IOCONTVAR(.OCURR,.OVAR) THEN
					BEGIN
![1007] In the unusual case that a DATACALL node points to an array ref
![1007]  and the subscript calculation contains 2 or more references to
![1007]  the same .O variable, a common sub replacement can occur.
![1007]  For such a case, link the DATACALL node under an IOLSTCALL
![1007]  node, so that storing the common sub pointer will not trash
![1007]  some random word.
%[1007]%					IF .OCURR[OPERSP] EQL DATACALL
%[1007]%					THEN
%[1007]%					BEGIN
%[1007]%						LOCAL BASE IOLNODE;
%[1007]%						NAME<LEFT>_IOLCSIZ;		!SETUP IOLSTCALL NODE
%[1007]%						IOLNODE_CORMAN();
%[1007]%						IOLNODE[OPERATOR]_IOLSTCFL;
%[1007]%						IOLNODE[IOLSTPTR]_.OCURR;
%[1007]%						IOLNODE[CLINK]_.OCURR[CLINK];	!LINK IN DATACALL
%2400%							IOLNODE[IOLSTATEMENT] = .SAVSTMNT;
%[1007]%						IOLNODE[CW0L]_.OCURR[CW0L];
%[1007]%						OCURR[CLINK]_0;			!CLEANUP DATACALL LINKS
%[1007]%						OCURR[CW0L]_0;
%[1007]%						PREV_.IOLNODE[CW0L];		!LINK IOLSTCALL TO IOLIST
%[1007]%						PREV[CLINK]_.IOLNODE;
%[1007]%						OCURR_.IOLNODE			!CORRECT CURRENT POINTER
%[1007]%					END;
%2400%						OLEVEL = .OCLEVEL;
						OSEEN_.OCURR;
						OCOUNT_.OCOUNT+1
					END
				END;
				OCURR_.OCURR[SRCLINK]
			END;

			%(
			ELIMINATE UNUSED COMMON EXPRESSIONS
			CREATED BY OPTIMIZER AND OBSOLETED
			BY COLLAPSING OF INNER LOOP
			INTO AN ELISTCALL NODE
			)%

			IF .OCOUNT EQL 0 THEN
			BEGIN
				OVAR[IDATTRIBUT(NOALLOC)]_1;
				PREV_.CURR[CW0L];	!LOCATE NEXT NODE
				PREV[SRCLINK]_.CURR[SRCLINK];
				SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR);
				CURR_.PREV[SRCLINK];
				CURR[CW0L]_.PREV
			END
			ELSE

			%(
			IF OCOUNT IS 1, THEN WE SHOULD ELIMINATE
			THE ASSIGNMENT AND CREATE A COMMON SUBEXPRESSION
			NODE
			)%

%2400%			IF .OCOUNT EQL 1 AND .OSTEP EQL 0 AND .OLEVEL LEQ 0
%2400%			THEN
			BEGIN
				LOCAL BASE CMNPTR;	!CURRENT CMNSUB NODE
				LOCAL BASE CMNNODE;	!NODE CREATED
				LOCAL BASE OEXPR;	!EXPRESSION
				OVAR[IDATTRIBUT(NOALLOC)]_1;	!NOALLOC VAR
				OEXPR_.CURR[RHEXP];	!REMEMBER THE EXPRESSION
				PREV_.CURR[CW0L];	!FIND NODE IN FRONT
				PREV[SRCLINK]_.CURR[SRCLINK];	!LINK OVER NODE
				SAVSPACE(ASGNSIZ+SRCSIZ-1,.CURR);	!DELETE ASSIGNMENT
				CURR_.PREV[SRCLINK];	!FIND NEW CURR
				CURR[CW0L]_.PREV;		!RESET BACK POINTER

				!BUILD COMMON SUB NODE

				IF .OEXPR[OPRCLS] EQL DATAOPR THEN
				BEGIN
					CMNNODE_.OEXPR
				END
				ELSE
				BEGIN
					CMNNODE_BLDCMN(0,.OEXPR);

					!LINK ON FRONT OF CHAIN

					CMNNODE[SRCLINK]_.OSEEN[SRCCOMNSUB];
					OSEEN[SRCCOMNSUB]_.CMNNODE
				END;

				!SUBSTITUTE COMMON SUB NODE FOR
				!VARIABLES

				ITMCT_1;
				CHOSEN[1]_.CMNNODE;
				GLOBREG[1]_.OVAR;

				CMNPTR_.IMPLDO;		!SAVE IMPLDO FLAG
				IMPLDO_1;		!SET IT FOR CMNRPLC
				IF .OSEEN[OPRS] EQL ASGNOS THEN
				BEGIN
					OSEEN[LHEXP]_CMNRPLC(.OSEEN[LHEXP]);
					OSEEN[RHEXP]_CMNRPLC(.OSEEN[RHEXP])
				END
				ELSE
				IF .OSEEN[OPRS] EQL DOOS THEN
				BEGIN
					OSEEN[DOLPCTL]_CMNRPLC(.OSEEN[DOLPCTL]);
%[753]%					OSEEN[DOM1]_CMNRPLC(.OSEEN[DOM1]);
					!DO NOT FORGET THAT A .O VAR MAY BE USED IN THE
					! INCREMENT FIELD OF THE DO LOOP
					OSEEN[DOM3]_CMNRPLC(.OSEEN[DOM3])
				END
				ELSE
				IF .OSEEN[OPRCLS] EQL IOLSCLS THEN
				BEGIN
					CMNRPLC(.OSEEN)
				END;
				IMPLDO_.CMNPTR		!RESET IMPLDO FLAG
			END
			ELSE
				CURR_.CURR[CW0L]
		END
		ELSE
			CURR_.CURR[CW0L]
	END
	ELSE
		CURR_.CURR[CW0L]
END;

%(***CLEAR CW0L FIELD AND ELIMINATE EXTRA COMMON SUBS***)%

IONODE_.TOP;
WHILE .IONODE NEQ .LEND DO
BEGIN
	IONODE[CW0L]_0;
	IF .IONODE[OPRCLS] EQL IOLSCLS THEN CMNELIM();
	IONODE_.IONODE[SRCLINK]
END;

END;
GLOBAL ROUTINE DOVARASGN=

!	Routine to create an assignment statement to establish final loop
!	value for a do loop which is about to be collapsed into an ELIST.
!	This routine is only called if compiling F77.
!	Entire routine added by edit 1207.

BEGIN
	EXTERNAL GETOPTEMP,MAKPR1,MAKASGN;
	LOCAL BASE TC;	! Trip count for loop
	LOCAL BASE ASPTR;

	TC_.IONODE[ECNTPTR]; ! Trip count expression

	! If trip count expression is not a constant, we need to fix
	! it to be MAX ( 0, old-trip-count).  This is so that the final
	! value for the loop variable comes out right (calculated below)
	! when computed as initialvalue + incr*tripcount.

	IF .TC[OPR1] NEQ CONSTFL THEN
		TC_MAKPR1(0,INLINFN,MAXFN,INTEGER,.TC,
			MAKECNST(INTEGER,0,0));

	! Make the trip count a common sub-expression.
	! It is used for the count (on the ELIST), and also as part
	! of the calculation for the final loop value.

	TC_BLDCMN(GETOPTEMP(INTEGER),.TC);

	CHNLNK(.TC,DOTR); ! Put the common sub on the right list
	IONODE[ECNTPTR]_.TC; ! Set up the ELIST count

!	Tie in an assignment statement of the form:
!	FINALVALUE = INITVALUE + INCREMENT*TRIPCOUNT

	ASPTR_IONODE[ELPFVLCHAIN]; ! Address of assignment chain
	WHILE @@ASPTR NEQ 0 DO ASPTR_.ASPTR[CLINK];

%2046%	! Create expression for (INCR * TRIPCOUNT) + INITVALUE.
%2046%
%2046%	TC = MAKPR1(0,ARITHMETIC,ADDOP,INTEGER,		! +
%2046%		MAKPR1(0,ARITHMETIC,MULOP,INTEGER,	! INCR*TRIPCOUNT
%2046%			.TOP[DOM3],.TC),
%2046%		.TOP[DOM1]);				! INITVALUE
%2046%
%2046%	! Create assignment for DOSYM = (INCR * TRIPCOUNT) + INITVALUE.
%2046%	! Also link in assignment and set parent pointer of RHS.
%2046%
%2046%	TC[PARENT] = ASPTR[CLINK] = MAKASGN(.TOP[DOSYM],.TC);

END;



GLOBAL ROUTINE COLLAPSE=
%(**********************************************************************

	CONTROL ROUTINE TO FOLD GROUPS OF DATACALL AND/OR
	SLISTCALL NODES IN IOLSTCALL NODES AND DETERMINE
	IF A LOOP CAN BE COLLAPSED INTO
	AN E1LISTCALL NODE OR E2LISTCALL NODE


	CALLED BY FOLDUP WITH THE GLOBAL TOP POINTING
	TO A DONODE (OR A CONTINUE FOR THE OUTERMOST
	LEVEL OF AN IOLIST) AND LEND POINTING TO THE
	CONTINUE TERMINATING THE
	LOOP

	COLLPASE WALKS THE LOOP COUNTING THE NUMBER
	OF IOLSCLS NODES SEEN AND CREATED AND
	SETTING FLAGS TO INDICATE WHETHER

	TO INDICATE WHETHER

	1) A DATACALL POINTS TO AN ARRAYREF A SUBSRCIPT
	   WHICH CONTAINS A VARIABLE INCREMENTED IN
	   THE LOOP OTHER THAN THE LOOP INDUCTION VARIABLE
	2) AN IOLSCLS NODE OTHER THAN A
	   DATACALL NODES WAS ENCOUNTERED IN THE LOOP
	3) THE CURRENT AND LAST ELEMENTS IN THE LOOP WERE IOLSCLS
	   ELEMENTS
	4) A FUNCTION REFERENCE WAS SEEN ANYWHERE IN THE LOOP
	5) THE CURRENT OR LAST ELEMENTS CONTAINED FUNCTION
	   REFERENCES
	6) A STATEMENT OTHER THAN AS ASSIGNMENT STATEMENT
	   WAS DETECTED IN THE LOOP
	7) A DATACALL CONTAINED MORE THAN ONE VARIABLE
	   INCREMENTED IN THE LOOP
	8) THE EXPRESSION UNDER A DATACALL NODE CONTAINING
	   THE INCREMENT EXPRESSION WAS NIOT AN ADD

	WHENEVER ADJACENT IOLSCLS NODES ARE DETETCED, COLLAPSE
	DETERMINES IF THE CALLS ARE INDEPENDENT
	NODES ARE INDEPENT IF

	A) NEITHER CONTAIN FUNCTION CALLS

	B) ON A READ, THE SECOND NODE DOES NOT USE IN
	   A COMPUTATION ANY VARIABLE INITIALIZED
	   BY THE FIRST

	WHEN INDEPENDENT NODES ARE ENCOUNTERED,
	COLLAPSE MERGES THE TWO NODES INTO A SINGLE
	IOLSTCALL EITHER BY CREATING A IOLSTCALL NODE AND
	LINKING BOTH NODES UNDER THE IOLSTCALL NODE IF THE
	FIRST NODE WAS NOT AN IOLSTCALL NODE OR LINKING
	THE SECOND NODE UNDER THE FIRST IF THE FIRST
	NODE WAS AN IOLSTCALL NODE.


	AFTER ALL THE LOOP ELEMENTS HAVE BEEN EXAMINED
	AND IF WE ARE COLLAPSING A LOOP (WE MIGHT
	BE COLLAPSING NODES OUTSIDE THE OUTERMOST
	LOOP ON THE I/O LIST) COLLAPSE DETERMINES
	IF THE LOOP MAY BE FOLDED BY CHECKING
	THE FLAGS AND COUNTS FOR THE NUMBER OF IOLSCLS NODES
	SEEN AND THE NUMBER OF IOLSTCALL NODES CREATED.

	NO FOLDING WILL OCCUR IF EITHERANY OF THE FUNCTION,
	MORE THAN ONE INCREMENTED VARIABLE, STATEMENT
	OTHER THAN ASSIGNMENT, OR INCREMENTED VARIABLE
	NOT IN AN ADD EXPRESSION FLAGS ARE SET OR IF
	MORE THAN ONE IOLSTCALL NODE WAS CREATED IN THE LOOP
	OTHERWISE, IF ONLY 1 IOLSCLS NODES WAS SEEN
	OF TYPE DATACALL, COLLAPSE WILL GENERATE AND LINK
	INTO THE TREE AN IOLSTCALL NODE OVER THE DATACALL
	NODE TO FORCE COLLPASING OF THE
	LOOP

	LOOP COLLAPSING OCCURS AS FOLLOWS

	1) IF THE LOOP CONTAINED EXACTLY ONME E1LISTCALL OR
	   E2LISTCALL NODE AND NO OTHER IOLSCLS NODES
	   AND THE PRODUCT OF THE NUMBER OF ELEMENTS AND
	   THE INCREMENT EXPRESSION FOR EACH ELEMENT
	   UNDER THE E1LISTCALL OR E2LISTCALL NODE IS
	   THE SAME AS THE LOOP INCREMENT THEN THE OUTER LOOP WILL
	   BE FOLDED INTO THE E1LISTCALL OR E2LISTCALL
	   NODE

	2) IF EXACLTY ONE IOLSTCALL NODE WAS GENERATED
	   IN THE LOOP AND NO IOLSCLS NODES
	   OF TYPE OTHER THAN DATACALL WERE DETECTED
	   IN THE LOOP THEN THE LOOP WILL BE FOLDED INTO AN
	   E1LISTCALL OR E2LISTCALL NODE DEPENDING UPON THE
	   STATE OF THE FLAG INDICATING WHETHER ALL INCREMENTED
	   VARIABLES IN THE LOOP MATCHED THE LOOP INDUCTION
	   VARIABLES

	COLLAPSE CALLS MAKELIST WITH PARAMETER
	0, 1 , OR 2 TO COLLPAAPSE A LOOP INTO AN ALREADY
	EXISTING ELIST OR INTO A E1LISTCALL OR E2LISTCALL
	NODES, RESPECTIVELY

**********************************************************************)%
BEGIN
LOCAL BASE CNSTZERO;	!ADDRESS OF ZERO IN CONSTANT TABLE
LOCAL BASE CURRIOLS;	!LAST IOLSCLS NODE SEEN IN LOOP
LOCAL BASE PREVCURR;	!NODE IN FRONT OF CURRIOLS
LOCAL BASE IOLSTSEEN;	!COUNT OF IOLSCLS ELEMENTS SEEN IN LOOP
LOCAL BASE IOLSTCNT;	!COUNT OF IOLSCLS ELEMENTS BUILT IN LOOP
LABEL E2NLYZ;
LABEL RASGNFND;
LABEL E1LOOP;
LABEL E2LOOP;
LOCAL BASE CURR;	!CURRENT ELEMENT BEING ANALYZED
LOCAL BASE PREV;	!NODE IN FRONT OF CURR
LOCAL BASE PREPREV;	!NODE IN FRONT OF PREV
REGISTER BASE FOLDFLG;	!ANALYSIS FLAGS
MACRO
	INCEXNOTADD=FOLDFLG<0,1>$,	!INCREMENT EXPRESSION NOT ADD FLAG
	IOLSNOTDATA=FOLDFLG<1,1>$,	!IOLSCLS NODE OTHER THAN DATACALL SEEN
	THISIOLS=FOLDFLG<2,1>$,		!CURRENT ELEMENT IS AN IOLSCLS NODE
	LASTIOLS=FOLDFLG<3,1>$,		!PREVIOUS ELEMENT WAS AN IOSCLS NODE
	FUNCSEEN=FOLDFLG<4,1>$,		!FUNCTION CALL IN LOOP
	OTHERSTMT=FOLDFLG<6,1>$,	!STATEMENT OTHER THAN ASSIGNMENT SEEN
	LASTFNCTN=FOLDFLG<7,1>$,	!FUNCTION CALL IN PREVIOUS ELEMENT
	THISFNCTN=FOLDFLG<8,1>$,	!FUNCTION CALL IN CURRENT ELEMENT
	CNTGTRONE=FOLDFLG<9,1>$,	!MORE THAN ONE INCREMENTED VARIABLE
	INCNOTIND=FOLDFLG<10,1>$,	!INCREMENTED VARIABLE OTHER THAN INDVAR IN LOOP
%2400%	!DBLEWORD=FOLDFLG<11,1>$,	!DOUBLE WORD ARG UNDER DATACALL
%2400%	!SNGLWORD=FOLDFLG<12,1>$,	!SINGLE WORD ARG UNDER  DATACALL
	DEPIOLSCLS=FOLDFLG<13,1>$,	!DEPENDENT IOLSCLS NODES SEEN
!**;[1207], COLLAPSE, DCE, 3-Apr-81
%[1207]%	NOTINTLOOP=FOLDFLG<14,1>$;	!Implied do is non-integer


%(***INITIALIZE***)%

	CNSTZERO_MAKECNST(INTEGER,0,0);	!LOCATE ZERO
	ELIMCONT();			!ELIMINATE CONTINUE STATEMENTS IN LOOP
	IOLSTSEEN_IOLSTCNT_FOLDFLG_0;	!CLEAR FLAGS AND COUNTS
	IF NOT .IMPLDO THEN LEND_0;	!SET LEND IF OUTSIDE OUTERMOST LOOP

%(***
EXAMINE EACH NODE IN THE LOOP
FOR EACH NODE, DETERMINE IF A FUNCTION CALL
WAS PRESENT AND SET THE THISFNCTN AND FUNCSEEN
FLAGS ACCORDINGLY

FOR A DATACALL NODE, ISOLATE THE INCREMENTED VARIABLE(S)
AND SET CNTGTRONE, INCEXNOTADD, AND INCNOTIND APPROPRIATELY

FOLD PAIRS OF INDEPENDENT DATACALL NODES
INTO IOLSTCALL NODES
***)%

PREV_.TOP;			!INITIALIZE LOOP SEARCH

!**;[1207], COLLAPSE, DCE, 3-Apr-81
%[1207]%	IF .PREV[OPRS] EQL DOOS THEN
%[1207]%	BEGIN
%[1207]%		CURR_.PREV[DOSYM];	! Get the loop variable
%2400%			IF .CURR[VALTYPE] NEQ INTEGER
%2400%			THEN IF .CURR[VALTYPE] NEQ INDEX
%2400%			THEN NOTINTLOOP = 1;	! Flag bad type
%[1207]%	END;

WHILE (CURR_.PREV[SRCLINK]) NEQ .LEND DO
BEGIN
	LASTIOLS_.THISIOLS;	!SET FLAGS FOR PREVIOUS NODE
	LASTFNCTN_.THISFNCTN;
	THISIOLS_THISFNCTN_0;	!CLEAR FLAGS FOR THIS NODE

		%(
		STATEMENT NODE ENCOUNTERED
		--------- ---- -----------
		)%

	IF .CURR[OPRS] EQL ASGNOS THEN
	BEGIN

![651] IF WE HAVE AN ASSIGNMENT INTO A .O VARIABLE WHICH HAS
![651] BEEN PRECEDED BY SOME IOLSCLS NODE, THEN THE .O VARIABLE
![651] ASSIGNMENT MUST DEPEND UPON THE IOLSCLS (AND HENCE THE VARIABLE
![651] BEING READ), AND SO WE WILL BE UNABLE TO COLLAPSE THIS LOOP
![651] DUE TO THIS DEPENDENCY.  TEST FOR IT HERE AND SET FLAG.
%2400%
![743] MAKE SURE IT IS A .O VARIABLE, SINCE .R VARIABLES ARE POSSIBLE
![743] AND WE DO NOT WANT TO KILL OPTIMIZATION FOR THEM!
%2400%
%2400%		IF .IOLSTSEEN GTR 0 THEN
%[743]%		BEGIN
%[743]%			LOCAL BASE VARPTR;
%[743]%			VARPTR_.CURR[LHEXP];
%[743]%			IF .VARPTR[IDDOTO] EQL SIXBIT ".O"
%[743]%			THEN DEPIOLSCLS_1
%[743]%		END;

		%(
		CHECK FOR FUNCTION CALL
		)%

		IF CONTFN(.CURR[RHEXP]) THEN
		BEGIN
			FUNCSEEN_1;
			THISFNCTN_1
		END;
		IF CONTFN(.CURR[LHEXP]) THEN
		BEGIN
			FUNCSEEN_1;
			THISFNCTN_1
		END
	END
	ELSE
	IF .CURR[OPRS] EQL DOOS THEN
	BEGIN

		%(
		SET OTHERSTMT FOR DO NODE
		)%

		OTHERSTMT_1;

		%(
		COLLAPSE INNER LOOPS
		)%

		PREV_.CURR;		!ADVANCE PREVIOUS NODE POINTER
		CURR_.CURR[DOLBL];	!ADVANCE CURRENT NODE POINTER
		CURR_.CURR[SNHDR]	!TO CONTINUE NODE TERMINATING THE LOOP
	END
	ELSE
	IF .CURR[OPRCLS] EQL IOLSCLS THEN
	BEGIN

		%(
		IOLSCLS NODE ENCOUNTERED
		------- ---- -----------
		)%

		IOLSTSEEN.IOLSTSEEN+1;	!INCREMENT COUNT OF IOLSCLS NODES SEEN
		CURRIOLS_.CURR;		!MARK THIS IOSLCLS NODE AS LAST IOLSCLS NODE SEEN
		PREVCURR_.PREV;		!REMEMBER NODE IN FRONT OF CURRENT NODE
		THISIOLS_1;		!SET THIS NODE IS AN IOLSCLS NODE FLAG

		%(
		CHECK FOR FUNCTION REFERENCE

		IF A DATACALL NODE, ISOLATE
		INCREMENT VARIABLE AND SET E2INCR FIELD. SET
		APPROPRIATE FLAGS FROM INFORMATION RETURNED
		BY ISOLATE
		)%

		CASE .CURR[OPERSP] OF SET
%DATACALL%	BEGIN

		%(
		ANALYZE DATACALL
		)%

		IF .IMPLDO THEN		!DON'T BOTHER IF NO LOOP TO COLLAPSE
		BEGIN
%2400%			! Remove single/double check

%[630]%			INCVAR_INCCOUNT_INCBADFORM_INCEXPR_INCFNCTN_0;	!CLEAR MODULE OWNS FOR ISOLATE
%[630]%			ISOLATE(.CURR[DCALLELEM],.CURR,0);	!FILL IN INFORMATION ABOUT DATACALL ARGUMENT

			%(***

			BBBB  EEEEE W W W  AAA  RRRR  EEEEE
			B   B E     W W W A   A R   R E
			B   B E     W W W A   A RRRR  E
			BBBB  EEEE  W W W AAAAA RR    EEEEE
			B   B E     W W W A   A R R   E
			B   B E     WW WW A   A R  R  E
			BBBB  EEEEE W   W A   A R   R EEEEE


			FOR THE CASE (I,I=1,N) ISOLATE WILL
			RETURN INCVAR AS I AND INCEXPR AS
			.CURR. WE WILL THEREFORE
			SET INCEXNOTADD AND NOT FOLD
			THE LOOP

			***)%

			IF .INCCOUNT GTR 1 THEN CNTGTRONE_1;	!SET CNTGTRONE IF ISOLATE FOUND MORE THAN ONE INCRMENTED VARIABLE

			IF .INCVAR NEQ .INDVAR THEN INCNOTIND_1;!SET INCNOTIND IF INCREMENTED VARIABLE WAS NOT LOOP INDUCTION VARIABLE

			%(
			SET E2INCR FIELD IN DATACALL NODE
			)%

			IF (CURR[E2INCR]_.INCVAR) NEQ 0 THEN
			BEGIN

				%(
				SOME INCREMENTED VARIABLE APPEARS IN
				THE DATACALL - ANALYZE THE EXPRESSION
				IN WHICH IT APPEARS

				SET INCEXNOTADD IF THE EXPRESSION
				IS NEITHER THE DCALLELEM
				OF THE DATACALL NODE OR AN ADD

				E.G. ALL EXPRESSIONS OF THE FORM
				A(I) OR A(I+X) ARE OK (IF I IS INDVAR)
				)%

%[630]%				IF .INCBADFORM THEN %(ISOLATE CHECKED)%
					INCEXNOTADD_1
			END
			ELSE
			BEGIN

				%(
				NO INCREMENTED VARIABLE - INCREMENT
				IS ZERO
				)%

				CURR[E2INCR]_.CNSTZERO
			END;

			%(
			SET FUNCTION FLAGS IF A FUNCTION WAS
			ENCOUNTERED BY ISOLATE
			)%

			IF .INCFNCTN THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
		END
		ELSE

		%(
		OUTSIDE OUTER LOOP - JUST LOOK FOR
		A FUNCTION CALL UNDER THE DATACALL
		NODE
		)%

		IF CONTFN(.CURR[DCALLELEM]) THEN
		BEGIN
			FUNCSEEN_1;
			THISFNCTN_1
		END
		END;

		%(
		FOR IOLSCLS NODES OTHER THAN DATATCALL
		SET THE IOLSNOTDATA FLAG AND LOOK
		FOR A FUNCTION CALL UNDER THE NODE
		)%

%SLISTCALL%	BEGIN
			IOLSNOTDATA_1;
			IF CONTFN(.CURR[SCALLELEM]) THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
			ELSE
			IF CONTFN(.CURR[SCALLCT]) THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
		END;
%IOLSTCALL%	BEGIN
		SKERR()		!SHOULD NEVER SEE AN IOLSTCALL
		END;
%E1LISTCALL%	BEGIN
			IOLSNOTDATA_1;
			IF CONTFN(.CURR[ECNTPTR]) THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
			ELSE
			IF CONTFN(.CURR[E1INCR]) THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
			ELSE
			BEGIN
				LOCAL BASE IOARRAY;
				IOARRAY_.CURR[ELSTPTR];
			E1LOOP:	WHILE .IOARRAY NEQ 0 DO
				BEGIN
					IF CONTFN(.IOARRAY[E2ARREFPTR]) THEN
					BEGIN
						FUNCSEEN_1;
						THISFNCTN_1;
						LEAVE E1LOOP
					END;
					IOARRAY_.IOARRAY[CLINK]
				END
			END
		END;
%E2LISTCALL%	BEGIN
			IOLSNOTDATA_1;
			IF CONTFN(.CURR[ECNTPTR]) THEN
			BEGIN
				FUNCSEEN_1;
				THISFNCTN_1
			END
			ELSE
			BEGIN
				LOCAL BASE IOARRAY;
				IOARRAY_.CURR[ELSTPTR];
			E2LOOP:	WHILE .IOARRAY NEQ 0 DO
				BEGIN
					IF CONTFN(.IOARRAY[E2INCR]) THEN
					BEGIN
						FUNCSEEN_1;
						THISFNCTN_1;
						LEAVE E2LOOP
					END
					ELSE
					IF CONTFN(.IOARRAY[E2ARREFPTR]) THEN
					BEGIN
						FUNCSEEN_1;
						THISFNCTN_1;
						LEAVE E2LOOP
					END;
					IOARRAY_.IOARRAY[CLINK]
				END
			END
		END
		TES;

	%(***FOLD ADJACENT OF NODES IF POSSIBLE***)%

%2410%		! Check for READ (A(A(1)),I=1,10) or
%2410%		! READ (C(ICHAR(C):2),I=1,10)
%2410%
%2410%		IF (IF .INPFLAG AND .IMPLDO
%2410%			THEN IODEPNDS(.CURR,.CURR)
%2410%			ELSE FALSE)
%2410%		THEN DEPIOLSCLS = 1
%2410%		ELSE
		IF .LASTIOLS THEN		!WAS LAST NODE AN IOLSCLS NODE
		IF NOT .LASTFNCTN THEN		!WITHOUT FUNCTION CALLS?
		IF NOT .THISFNCTN THEN		!AND NO FUNCTION CALLS IN THIS NODE?
		IF
		BEGIN

!**;[1207], COLLAPSE @6537, DCE, 3-Apr-81
!**;[1207], Check all the sundry dependencies between adjacent I/O list
!**;[1207], elements - there are many cases, complicated by the 77 standard.
%[1207]%		IF .INPFLAG THEN
%[1207]%			BEGIN ! Input list...
%[1207]%				! Must always check forward dependence
%[1207]%				IF IODEPNDS(.CURR,.PREV) THEN 0 ! dependent
%[1207]%				ELSE
%[1207]%				IF .IMPLDO THEN ! Check A(I),I
%[1207]%					NOT IODEPNDS(.PREV,.CURR)
%[1207]%				ELSE ! Check A(I),(B(I),I=1,10) for F77
%[1207]%				IF F77 THEN NOT LPVARDEPNDS(.PREV,.CURR)
%[1207]%				ELSE 1 ! not dependent
%[1207]%			END ! Of input case
%[1207]%			ELSE
%[1207]%			BEGIN ! Output list
%[1207]%				IF F66 THEN 1 ! not dependent
%[1207]%				ELSE ! Check forward and backward LOOPVAR dependencies
%[1207]%				IF LPVARDEPNDS(.CURR,.PREV) THEN 0
%[1207]%				ELSE NOT LPVARDEPNDS(.PREV,.CURR)
%[1207]%			END ! Of output case
		END
		THEN
		BEGIN				!FOLD THE NODES
						!IS THE NODE IN FRONT
						!OF THIS ALREADY ON IOSLTCALL
						!NODE?
			IF .PREV[OPERSP] EQL IOLSTCALL THEN
			BEGIN			!YES - ADD TO PREVIOUS IOLSTCALL
				LOCAL BASE IOELEM;
						!FIND LAST NODE UNDER
						!IOLSTCALL NODE
				IOELEM_.PREV[IOLSTPTR];
				WHILE .IOELEM[CLINK] NEQ 0 DO
				 IOELEM_.IOELEM[CLINK];
				IOELEM[CLINK]_.CURR;	!LINK NODES
				IF .CURR[OPERSP] EQL E1LISTCALL OR
				.CURR[OPERSP] EQL E2LISTCALL THEN
				IF .CURR[SRCCOMNSUB] NEQ 0 THEN
				BEGIN			!COPY COMMON SUBEXPRESSIONS TO THE 
							!IOLSTCALL NODE
					LCLLNK(.CURR[SRCCOMNSUB]);
							!AND CLEAR THE
							!COMMON SUBEXPRESSION
							!FIELD IN THE NODE BEING
							!LINKED
					CURR[SRCCOMNSUB]_0
				END;
							!RELINK THE TREE
				PREV[SRCLINK]_.CURR[SRCLINK];
							!CLEAR LINK FIELD
							!OF NODE JUYST ADDED
				CURR[SRCLINK]_0;
				CURR_.PREV		!RESET LOOP POINTERS
			END
			ELSE
			BEGIN				!MAKE "IOLSTCALL" NODE
							!"" APPEAR BECAUSE
							!THIS NODES IS 1 WORD
							!LARGER THAN A REAL
							!IOLSTCALL NODE
							!TO ALLOW CONVERTING THE NODE
							!TO AN E1LISTCALL OR E2LISTCALL
							!NODE
				IOLSTCNT_.IOLSTCNT+1;	!COUNT THE NODE
				NAME<LEFT>_ELCSIZ;	!MAY BECOME AN ELIST
				IONODE_CORMAN();	!ALLOCATE CORE
							!IDENTIFY THE NODE
				IONODE[OPERATOR]_IOLSTCFL;
				IONODE[IOLSTPTR]_.PREV;	!LINK PREVIOUS NODE
%2400%				IONODE[IOLSTATEMENT] = .SAVSTMNT;
				PREPREV[SRCLINK]_.IONODE;!LINK INTO TREE
				IF .PREV[OPERSP] EQL E1LISTCALL OR
				.PREV[OPERSP] EQL E2LISTCALL THEN
				IF .PREV[SRCCOMNSUB] NEQ 0 THEN
				BEGIN

					!COPY COMMON SUBEXPRESSION TO
					!IOLSTCALL NODE AND CLEAR
					!COMMON SUBEXPRESSION FIELD

					LCLLNK(.PREV[SRCCOMNSUB]);
					PREV[SRCCOMNSUB]_0
				END;
				IF .CURR[OPERSP] EQL E1LISTCALL OR
				.CURR[OPERSP] EQL E2LISTCALL THEN
				IF .CURR[SRCCOMNSUB] NEQ 0 THEN
				BEGIN

					!COPY COMMON SUBEXPRESSIONS
					!TO IOLSTCALL NODE AND CLEAR
					!COMMON SUBEXPRESSION FIELD

					LCLLNK(.CURR[SRCCOMNSUB]);
					CURR[SRCCOMNSUB]_0
				END;
				IONODE[SRCLINK]_.CURR[SRCLINK];	!LINK INTO TREE
				CURR[SRCLINK]_0;		!CLEAR END OF LIST
				PREV_.PREPREV;			!RESET LOOP POINTERS
				CURR_.IONODE			!RESET LOOP POINTERS
			END
		END
		ELSE DEPIOLSCLS _ 1;	!MARK CAN NEVER MAKE AN ELIST
					!SINCE DEPENDENT IOLSCLS NODES
	END;
	PREPREV_.PREV;		!REMEMBER ONE MORE NODE BACK
	PREV_.CURR		!ADVANCE A NODE
END;

%(***END OF I/O LIST FOLDING***)%


				!IF OUTER LOOP, RESTORE COMMON
				!SUBS AND EXIT
IF NOT .IMPLDO THEN RETURN PUTBAK();

%(***ANALYZE A LOOP WITH JUST 1 IOLSTCALL NODE***)%

IF .IOLSTSEEN EQL 1 THEN		!CHECK FLAGS
IF NOT .INCEXNOTADD THEN
IF NOT .FUNCSEEN THEN
!**;[1207], COLLAPSE, DCE, 3-Apr-81
%[1207]%	IF NOT .NOTINTLOOP THEN
IF NOT .OTHERSTMT THEN
IF NOT .CNTGTRONE THEN
BEGIN
	IF .CURRIOLS[OPERSP] EQL DATACALL THEN
	BEGIN

		%(
		IF EXACTLY ONE DATACALL NODE
		APPEARED IN THE LOOP WE CAN
		MAKE IT INTO AN E1LISTCALL OR
		E2LISTCALL NODE

		HOWEVER, WE MUST FIRST GENERATE
		AN IOLSTCALL NODE.

		GENERATE THE I/O LIST CALL NODE HERE
		PREPERATORY TO THE 1 IOLSTCALL NODE
		CREATED ANALYSIS IN FURTHER
		ON
		)%

		IOLSTCNT_.IOLSTCNT+1;	!COUNT NODE
		NAME<LEFT>_ELCSIZ;	!SET NODE SIZE
		IONODE_CORMAN();	!ALLOCATE CORE FOR NODE
					!IDENTIFY NODE
		IONODE[OPERATOR]_IOLSTCFL;
					!PUT DATACALL UNDER THE NODE
		IONODE[IOLSTPTR]_.CURRIOLS;
					!LINK IONODE INTO TREE
		PREVCURR[SRCLINK]_.IONODE;
					!LINK TREE TO IONODE
%2400%		IONODE[IOLSTATEMENT] = .SAVSTMNT;
		IONODE[SRCLINK]_.CURRIOLS[SRCLINK];
		CURRIOLS[SRCLINK]_0	!CLEAR LINK FIELD OF DATACALL NODE
	END
	ELSE
	IF .CURRIOLS[OPERSP] EQL E1LISTCALL OR
	.CURRIOLS[OPERSP] EQL E2LISTCALL THEN

	%(
	IF EXACLTY ONE E1LISTCALL OR E2LISTCALL NODE
	WAS ENCOUNTERED IN THE LOOP WE CAN FOLD THE
	LOOP INTO THE E1LISTCALL OR E2LISTCALL NODE
	IF THE PRODUCT OF THE NUMBER OF ELEMENTS
	SPECIFIED BY THE ELIST
	AND THE INCREMENT FOR EACH ARRAY BEING
	TRANSFERRED MATCHES THE INCREMENT FOR THE
	LOOP BEGIN ANALYZED

	)%

E2NLYZ:	BEGIN
		LOCAL BASE IOARRAY;

		%(
		FOR AN E1LISTCALL, CHECK THAT THE PRODUCT OF
		E1INCR WHICH IS THE INCREMENT FOR ALL THE DATA ITEMS
		AND THE ELIST COUNT
		MATCHES THE LOOP INCREMENT
		)%

%2400%		IF .CURRIOLS[OPERSP] EQL E1LISTCALL
%2400%		THEN IF EXPEXP(.CURRIOLS[ECNTPTR],.CURRIOLS[E1INCR])
%2400%			NEQ .TOP[DOM3]
%2400%		THEN LEAVE E2NLYZ;

		%(
		FOR EACH SUBELEMENT OF THE ELIST CHECK THAT

		1) IF THE NODE IS AN E1LIST THAT ALL ELEMENTS
		   ARE INCREMENTED BY THE LOOP INDUCTION VARIABLE

		2) IF THE NODE IS AN E2LISTCALL THAT THE PRODUCT OF
		   E2INCR FOR THE SUBNODE AND THE NUMBER OF
		   ELEMENTS IN THE E2LISTCALL NODE MATCHES THE INCREMENT
		   FOR THE INCREMENT VARIABLE FOR THAT SUBNODE
		   IN THE OUTER LOOP

		3) THE INCREMENT VARIABLE APPEARS IN A VALID CONTEXT

		)%

		IOARRAY_.CURRIOLS[ELSTPTR];
		WHILE .IOARRAY NEQ 0 DO
		BEGIN

			%(
			ISOLATE THE INCREMENT VARIABLE
			)%

%[630]%			INCVAR_INCCOUNT_INCBADFORM_INCEXPR_INCFNCTN_0;
%[630]%			ISOLATE(.IOARRAY[E2ARREFPTR],.IOARRAY,0);
			IF .CURRIOLS[OPERSP] EQL E1LISTCALL THEN
			BEGIN

				%(
				MAKE SURE INCVAR IS INDVAR AND THAT
				IT APPEARS IN A VALID CONTEXT
				)%

				IF .INCVAR NEQ .INDVAR THEN LEAVE E2NLYZ;
				IF .INCCOUNT GTR 1 THEN LEAVE E2NLYZ;
%[630]%				IF .INCBADFORM THEN LEAVE E2NLYZ
			END
			ELSE
			BEGIN

				%(
				IF NO INCREMENT IN THIS LOOP THE
				E2INCR FIELD MUST BE ZERO
				)%
				IF .INCVAR EQL 0 THEN
				BEGIN
					IF .IOARRAY[E2INCR] NEQ .CNSTZERO THEN
					 LEAVE E2NLYZ
				END
				ELSE
				BEGIN

					%(
					CHECK THAT INCVAR APPEARS IN A 
					VALID CONTEXT
					)%

					IF .INCCOUNT GTR 1 THEN LEAVE E2NLYZ;
%[630]%					IF .INCBADFORM THEN LEAVE E2NLYZ;

					%(
					FOR INVAR EQL INDVAR, THE INCREMENT
					EXPRESSION IS THE LOOP INCREMENT

					MAKE SURE THE LOOP INCREMENT
					MATCHES THE PRODUCT OF E2INCR
					AND THE ELIST ELEMENT COUNT
					)%

					IF .INCVAR EQL .INDVAR THEN
					BEGIN
%2400%						IF EXPEXP(.CURRIOLS[ECNTPTR],.IOARRAY[E2INCR])
%2400%							NEQ .TOP[DOM3]
%2400%						THEN LEAVE E2NLYZ;
					END
					ELSE

					%(
					IF THE INCREMENTED VARIABLE
					IS A .R TEMPORARY, FIND THE
					INCREMENT EXPRESSION BY
					ISOLATING THE I FROM THE
					.R + I OR I + .R EXPRESSION
					APPEARING IN THE LOOP

					CHECK THAT I MATCHES THE
					PRODUCT OF E2INCR AND THE
					ELIST ELEMENT COUNT
					)%
			RASGNFND:	BEGIN	!LOCATE .R INCREMENT ASSIGNMENT
						CURR_.TOP[SRCLINK];
						WHILE 1 DO
						BEGIN
							IF .CURR[OPRS] EQL ASGNOS THEN
							IF .CURR[LHEXP] EQL .INCVAR THEN

							%(
							COMPUTE PRODUCT OF E2INCR AND
							THE ELIST ELEMENT COUNT
							)%

%2400%							IF EXPEXP(.CURRIOLS[ECNTPTR],.IOARRAY[E2INCR])
							EQL
							BEGIN	!ISOLATE I
								PREV_.CURR[RHEXP];
								IF .PREV[ARG1PTR] EQL .INCVAR
								THEN .PREV[ARG2PTR] ELSE .PREV[ARG1PTR]
							END	!AND CHECK THAT PRODUCT AND
								!I MATCH

							THEN LEAVE RASGNFND ELSE LEAVE E2NLYZ;
							IF (CURR_.CURR[SRCLINK]) EQL .LEND THEN
							 SKERR()	!ERROR IF NO INCREMENT ASSIGNMENT
						END
					END
				END
			END;
			IOARRAY_.IOARRAY[CLINK]
		END;
		IONODE_.CURRIOLS;	!SET IONODE FOR MAKELIST
		RETURN MAKELIST(0)	!FOLD LOOP INTO ELIST NODE
	END
END;

%(***CONVERT TO E1LISTCALL OR E2LISTCALL NODE IF POSSIBLE***)%

IF .IOLSTCNT EQL 1 THEN
IF NOT .INCEXNOTADD THEN
IF NOT .IOLSNOTDATA THEN
IF NOT .FUNCSEEN THEN
IF NOT .OTHERSTMT THEN
IF NOT .CNTGTRONE THEN
IF NOT .DEPIOLSCLS THEN			!IF ALL NODES COLLAPSED
BEGIN

	%(
	IF A SINGLE IOLSTCALL NODE WAS CREATED IN THE
	LOOP AND THE FLAGS ARE CORRECT TRANSFORM THE
	IOLSTCALL NODE INTO AN E1LISTCALL OR E2LISTCALL NODE
	)%

%2400%	RETURN MAKELIST(IF .INCNOTIND THEN 2 ELSE 1);
END;

%(***THE LOOP DOES NOT FOLD***)%

RETURN PUTBAK()	!RESTORE COMMON SUBS

END;



%(
ROUTINE TO PERFORM SUBSTITUTION AND LOCAL DEPENDENCY
ELIMINATION OF COMMON SUBEXPRESSION NODES

USED IN TWO CONTEXTS:

1) AFTER AN ELIST NODE HAS BEEN CREATED, WE MUST SUBSTITUTE
   COMMON SUBEXPRESSION NODES FOR THE VARIABLES WHOSE VALUES WERE
   ORIGINALLY SET BY ASSIGNMENT STATEMENTS WE HAVE ELIMINTED

2) AFTER THE SUBSTITION IN 1) WE MUST ELIMINATE ALL
   UNUSED COMMON SUBEXPRESSIONS AND PERFORM LOCAL SUBSTITUTION OF
   THE EXPRESSION UNDER THE COMMON SUBEXPRESSION NODE FOR THE
   COMMON SUBEXPRESSION NODE IF IT IS USED ONLY ONCE

THE ROUTINE RPLCMN AND CMNRPLC PERFORM SUBSTITUTION OF
COMMON SUBEXPRESSION NODES FOR VARIABLES AND ARBITRARY
EXPRESSIONS FOR COMMON SUBEXPRESSION NODES. BOTH ROUTINES RESET THE
VALFLGS IN ALL EXPRESSIONS SINCE WE MAY BE SUBSTITUTING AN EXPRESSION
FOR A DATAOPR OR CMNSUB NODE

THE ROUTINE CMNDEPD PERFORMS A LOCAL DEPENDENCY ANALYSIS BY SETTING
A USE COUNT IN THE ARG1PTR FIELD OF THE COMMON SUBEXPRESSION NODE
WHICH IS CHECKED TO DETERMINE WHICH NODES TO ELIMINATE 

)%

GLOBAL ROUTINE RPLCMN(NODE)=
%(**********************************************************************

	ROUTINE TO SUBSTITUTE COMMON SUBEXPRESSION NODES
	UNDER COMMON SUBEXPRESSION NODES IN AN I/O LIST


**********************************************************************)%
BEGIN
MAP BASE NODE;
REGISTER BASE CMNNODE;
REGISTER BASE ARG;
CMNNODE_.NODE[SRCCOMNSUB];
WHILE .CMNNODE NEQ 0 DO
BEGIN
	ARG_CMNNODE[ARG2PTR]_CMNRPLC(.CMNNODE[ARG2PTR]);	!SUBSTITUTE IN EXPRESSION
								!UNDER THE CMNSUB NODE
	CMNNODE[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);	!RESET THE VALFLG
	CMNNODE_.CMNNODE[CLINK]
END
END;

GLOBAL ROUTINE CMNRPLC(EXPRNODE)=
%(**********************************************************************

	ROUTINE TO SUBSTITUTE FOR COMMON
	SUBEXPRESSION NODES IN AN IOLSCLS NODE


	USED TO

	1) IF IMPLDO - SUBSTITUTE COMMON SUBEXPRESSION NODES
	   FOR DATAOPRS
	2) IF NOT IMPLDO - SUBSTITUTE FOR
	   COMMON SUBEXPRESSIONS IF THEY DEFINE CONSTANTS OR
	   ARE REFERENCED ONLY ONCE


	RESETS VALFLGS IN ALL EXPRESSIONS

**********************************************************************)%
BEGIN
REGISTER PHAZ2 ARG;
REGISTER PHAZ2 EXPR;
MAP BASE EXPRNODE;
EXPR_.EXPRNODE;
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
		ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
		EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
		EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)
		END;
%DATAOPR%	BEGIN
		IF .IMPLDO THEN RETURN SWAPEM(.EXPR)
		END;
%RELATIONAL%	BEGIN
		ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
		EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
		EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)
		END;
%FNCALL%	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.EXPR[ARG2PTR];
		INCR I FROM 1 TO .AG[ARGCOUNT] DO
		BEGIN
		 ARG_AG[.I,ARGNPTR]_CMNRPLC(.AG[.I,ARGNPTR]);
		 AG[.I,AVALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB)
		END;
		RETURN LOKDEFPT(.EXPR)
		END;
%ARITHMETIC%	BEGIN
		ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
		EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
		EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)
		END;
%TYPECNV%	BEGIN
		ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
		EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)

		END;
%ARRAYREF%	BEGIN
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		BEGIN
			ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
			EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
			RETURN LOKDEFPT(.EXPR)
		END
		END;
%CMNSUB%	BEGIN

		%(
		SUBSTITUTE THE EXPRESSION UNDER THE COMMON SUB NODE
		IF

		1) THE NODE IS REFERNCED ONCE

		2) THE EXPRESSION IS A CONSTANT

		)%

		IF NOT .IMPLDO THEN
		BEGIN
			IF .EXPR[ARG1PTR] EQL 1 THEN
			BEGIN
				RETURN .EXPR[ARG2PTR]
			END
			ELSE
			BEGIN
				LOCAL BASE CMNEXPR;
				CMNEXPR_.EXPR[ARG2PTR];
				IF .CMNEXPR[OPR1] EQL CONSTFL THEN
				RETURN .CMNEXPR
			END
		END
		END;
%NEGNOT%	BEGIN
		ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
		EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)
		END;
%SPECOP%	BEGIN
		ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
		EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		RETURN LOKDEFPT(.EXPR)
		END;
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN
	CASE .EXPR[OPERSP] OF SET
	%DATACALL%	EXPR[DCALLELEM]_CMNRPLC(.EXPR[DCALLELEM]);
	%SLISTCALL%	BEGIN
			EXPR[SCALLELEM]_CMNRPLC(.EXPR[SCALLELEM]);
			EXPR[SCALLCT]_CMNRPLC(.EXPR[SCALLCT])
			END;
	%IOLSTCALL%	BEGIN
			RPLCMN(.EXPR);
			EXPR_.EXPR[IOLSTPTR];
			WHILE .EXPR NEQ 0 DO
			BEGIN
				CMNRPLC(.EXPR);
				EXPR_.EXPR[CLINK]
			END
			END;
	%E1LISTCALL%	BEGIN
!**;[1207], CMNRPLC, DCE, 3-Apr-81
%[1207]%			ARG_.EXPR[ELPFVLCHAIN]; ! Save assignment chain ptr
			RPLCMN(.EXPR);
			EXPR[ECNTPTR]_CMNRPLC(.EXPR[ECNTPTR]);
			EXPR[E1INCR]_CMNRPLC(.EXPR[E1INCR]);
			EXPR_.EXPR[ELSTPTR];
			WHILE .EXPR NEQ 0 DO
			BEGIN
				EXPR[E2ARREFPTR]_CMNRPLC(.EXPR[E2ARREFPTR]);
				EXPR_.EXPR[CLINK]
			END;
!**;[1207], CMNRPLC, DCE, 3-Apr-81
%[1207]%			WHILE .ARG NEQ 0 DO
%[1207]%			BEGIN
%[1207]%				ARG[RHEXP]_CMNRPLC(.ARG[RHEXP]);
%[1207]%				ARG_.ARG[CLINK]
%[1207]%			END;
			END;
	%E2LISTCALL%	BEGIN
%[1207]%			ARG_.EXPR[ELPFVLCHAIN]; ! Save assignment chain ptr
			RPLCMN(.EXPR);
			EXPR[ECNTPTR]_CMNRPLC(.EXPR[ECNTPTR]);
			EXPR_.EXPR[ELSTPTR];
			WHILE .EXPR NEQ 0 DO
			BEGIN
				EXPR[E2ARREFPTR]_CMNRPLC(.EXPR[E2ARREFPTR]);
				EXPR[E2INCR]_CMNRPLC(.EXPR[E2INCR]);
				EXPR_.EXPR[CLINK]
			END;
!**;[1207], CMNRPLC, DCE, 3-Apr-81
%[1207]%			WHILE .ARG NEQ 0 DO
%[1207]%			BEGIN
%[1207]%				ARG[RHEXP]_CMNRPLC(.ARG[RHEXP]);
%[1207]%				ARG_.ARG[CLINK]
%[1207]%			END;
			END
		TES
		END;
%INLINFN%	BEGIN
		ARG_EXPR[ARG1PTR]_CMNRPLC(.EXPR[ARG1PTR]);
		EXPR[A1VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		BEGIN
			ARG_EXPR[ARG2PTR]_CMNRPLC(.EXPR[ARG2PTR]);
			EXPR[A2VALFLG]_(.ARG[OPRCLS] EQL DATAOPR OR .ARG[OPRCLS] EQL CMNSUB)
		END;
		RETURN LOKDEFPT(.EXPR)
		END;

%SUBSTRING%
%2400%		BEGIN
%2400%			ARG = EXPR[ARG1PTR] = CMNRPLC(.EXPR[ARG1PTR]);
%2400%			EXPR[A1VALFLG] = (.ARG[OPRCLS] EQL DATAOPR
%2400%						OR .ARG[OPRCLS] EQL CMNSUB);
%2400%			ARG = EXPR[ARG2PTR] = CMNRPLC(.EXPR[ARG2PTR]);
%2400%			EXPR[A2VALFLG] = (.ARG[OPRCLS] EQL DATAOPR
%2400%						OR .ARG[OPRCLS] EQL CMNSUB);
%2400%			EXPR[ARG4PTR] = CMNRPLC(.EXPR[ARG4PTR]);
%2400%			RETURN LOKDEFPT(.EXPR);
%2400%		END;

%CONCATENATION%
%2400%		BEGIN
%2400%			LOCAL ARGUMENTLIST AG;
%2400%			AG = .EXPR[ARG2PTR];
%2400%
%2400%			INCR I FROM 2 TO .AG[ARGCOUNT]	! Skip first arg
%2400%			DO
%2400%			BEGIN	! For each argument
%2400%
%2400%				ARG = AG[.I,ARGNPTR] =
%2400%					LOKDEFPT(.AG[.I,ARGNPTR]);
%2400%
%2400%				AG[.I,AVALFLG] = (.ARG[OPRCLS] EQL DATAOPR
%2400%						OR .ARG[OPRCLS] EQL CMNSUB);
%2400%
%2400%			END;	! For each argument
%2400%
%2400%			RETURN LOKDEFPT(.EXPR);
%2400%		END;

TES;
RETURN .EXPR		!RETURN EXPR
END;


GLOBAL ROUTINE DEPDCMN(EXPR)=
%(**********************************************************************

	ROUTINE TO PERFORM LOCAL DEPENDENCY WITHIN
	COMMON SUBEXPRESSION CHAIN

**********************************************************************)%
BEGIN
MAP BASE EXPR;
REGISTER BASE CMNNODE;
CMNNODE_.EXPR[SRCCOMNSUB];	!LOCATE CHAIN
WHILE .CMNNODE NEQ 0 DO
BEGIN
	IF .CMNNODE[ARG1PTR] NEQ 0 THEN	!IF CMNSUB IS REFERENCED
	CMNDEPD(.CMNNODE[ARG2PTR]);	!SET DEPENDENCY COUNT
					!IN SUB COMMON SUBEXPRESSIONS
	CMNNODE_.CMNNODE[SRCLINK];	!ADVANCE ALONG CHAIN
END;
END;



GLOBAL ROUTINE CMNDEPD(EXPR)=
%(**********************************************************************

	ROUTINE TO SET USE COUNT INTO ARG1PTR OF COMMON
	SUBEXPRESSION NODES APPEARING UNDER AN IOLSCLS
	NODE

**********************************************************************)%
BEGIN
MAP BASE EXPR;
!**;[1207], CMNDEPD, DCE, 3-Apr-81
%[1207]% LOCAL BASE ASTMNT; ! Ptr to assignment stmnt
CASE .EXPR[OPRCLS] OF SET
%BOOLEAN%	BEGIN
		CMNDEPD(.EXPR[ARG1PTR]);
		CMNDEPD(.EXPR[ARG2PTR])
		END;
%DATAOPR%	BEGIN END;
%RELATIONAL%	BEGIN
		CMNDEPD(.EXPR[ARG1PTR]);
		CMNDEPD(.EXPR[ARG2PTR])
		END;
%FNCALL%	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.EXPR[ARG2PTR];
		INCR I FROM 1 TO .AG[ARGCOUNT] DO
		 CMNDEPD(.AG[.I,ARGNPTR])
		END;
%ARITHMETIC%	BEGIN
		CMNDEPD(.EXPR[ARG1PTR]);
		CMNDEPD(.EXPR[ARG2PTR])
		END;
%TYPECNV%	CMNDEPD(.EXPR[ARG2PTR]);
%ARRAYREF%	IF .EXPR[ARG2PTR] NEQ 0 THEN
		CMNDEPD(.EXPR[ARG2PTR]);
%CMNSUB%	EXPR[ARG1PTR]_.EXPR[ARG1PTR]+1;
%NEGNOT%	CMNDEPD(.EXPR[ARG2PTR]);
%SPECOP%	CMNDEPD(.EXPR[ARG1PTR]);
%FIELDREF%	BEGIN END;
%STORECLS%	BEGIN END;
%REGCONTENTS%	BEGIN END;
%LABOP%		BEGIN END;
%STATEMENT%	BEGIN END;
%IOLSCLS%	BEGIN
		CASE .EXPR[OPERSP] OF SET
	%DATACALL%	CMNDEPD(.EXPR[DCALLELEM]);
	%SLISTCALL%	BEGIN
				CMNDEPD(.EXPR[SCALLCT]);
				CMNDEPD(.EXPR[SCALLELEM])
			END;
	%IOLSTCALL%	BEGIN
				LOCAL BASE IOARRAY;
				IOARRAY_.EXPR[IOLSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
					CMNDEPD(.IOARRAY);
					IOARRAY_.IOARRAY[CLINK]
				END;
				DEPDCMN(.EXPR);
				DEPDCMN(.EXPR)
			END;
	%E1LISTCALL%	BEGIN
				LOCAL BASE IOARRAY;
				CMNDEPD(.EXPR[ECNTPTR]);
				CMNDEPD(.EXPR[E1INCR]);
				IOARRAY_.EXPR[ELSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
					CMNDEPD(.IOARRAY[E2ARREFPTR]);
					IOARRAY_.IOARRAY[CLINK]
				END;
				DEPDCMN(.EXPR);
				DEPDCMN(.EXPR);
!**;[1207], CMNDEPD, DCE, 3-Apr-81
%[1207]%				ASTMNT_.EXPR[ELPFVLCHAIN];
%[1207]%				WHILE .ASTMNT NEQ 0 DO
%[1207]%				BEGIN
%[1207]%					CMNDEPD(.ASTMNT[RHEXP]);
%[1207]%					ASTMNT_.ASTMNT[CLINK]
%[1207]%				END;
			END;
	%E2LISTCALL%	BEGIN
				LOCAL BASE IOARRAY;
				CMNDEPD(.EXPR[ECNTPTR]);
				IOARRAY_.EXPR[ELSTPTR];
				WHILE .IOARRAY NEQ 0 DO
				BEGIN
					CMNDEPD(.IOARRAY[E2INCR]);
					CMNDEPD(.IOARRAY[E2ARREFPTR]);
					IOARRAY_.IOARRAY[CLINK]
				END;
				DEPDCMN(.EXPR);
				DEPDCMN(.EXPR);
!**;[1207], CMNDEPD, DCE, 3-Apr-81
%[1207]%				ASTMNT_.EXPR[ELPFVLCHAIN];
%[1207]%				WHILE .ASTMNT NEQ 0 DO
%[1207]%				BEGIN
%[1207]%					CMNDEPD(.ASTMNT[RHEXP]);
%[1207]%					ASTMNT_.ASTMNT[CLINK]
%[1207]%				END;
			END
		TES
		END;
%INLINFN%	BEGIN
		CMNDEPD(.EXPR[ARG1PTR]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN CMNDEPD(.EXPR[ARG2PTR])
		END;

%SUBSTRING%
%2400%		BEGIN
%2400%			CMNDEPD(.EXPR[ARG1PTR]);
%2400%			CMNDEPD(.EXPR[ARG2PTR]);
%2400%			CMNDEPD(.EXPR[ARG4PTR]);
%2400%		END;

%CONCATENATION%
%2400%		BEGIN
%2400%			LOCAL ARGUMENTLIST AG;
%2400%			AG = .EXPR[ARG2PTR];
%2400%
%2400%			INCR I FROM 2 TO .AG[ARGCOUNT]	! Skip first arg
%2400%			DO CMNDEPD(.AG[.I,ARGNPTR]);
%2400%		END;

	TES
END;


GLOBAL ROUTINE CMNELIM=
%(**********************************************************************

	ROUTINE TO ELIMINATE COMMON SUBEXPRESSIONS ON
	IOLSCLS NODES

	A COMMON SUBEXPRESSION MAY BE ELIMINATED IF

	1) IF ITS USED 0 OR 1 TIMES
	2) IF IT DEFINES A CONSTANT AS A COMMON
	   SUBEXPRESSION 

	ADDRESS OF NODE IS IN IONODE

**********************************************************************)%
BEGIN
LOCAL SAVIMPLDO;
LOCAL BASE CMNPREV;
LOCAL BASE CMNNODE;
IF .IONODE[OPERSP] EQL DATACALL OR .IONODE[OPERSP] EQL SLISTCALL THEN RETURN;
IF (CMNNODE_.IONODE[SRCCOMNSUB]) EQL 0 THEN RETURN;
WHILE .CMNNODE NEQ 0 DO
BEGIN				!CLEAR USEFUL FIELDS IN CMNNODES
	CMNNODE[ARG1PTR]_0;
	CMNNODE_.CMNNODE[CLINK]
END;
SAVIMPLDO_.IMPLDO;		!REMEMBER VALUE OF IMPLDO
IMPLDO_0;			!CLEAR FOR CMNRPLC
CMNDEPD(.IONODE);		!SET FIELDS IN CMNSUB NODES
CMNRPLC(.IONODE);		!REPLACE CONSTANT OR NON-COMMON
				!COMMON SUBEXPRESSIONS
IMPLDO_.SAVIMPLDO;		!RESTORE IMPLDO

%(***ELIMINATE EXTRA COMMON SUBEXPRESSIONS***)%

CMNPREV_.IONODE;
CMNNODE_.IONODE[SRCCOMNSUB];
WHILE .CMNNODE NEQ 0 DO
BEGIN
	LOCAL BASE EXPR;
	EXPR_.CMNNODE[ARG2PTR];
	IF .CMNNODE[ARG1PTR] LEQ 1 OR
	(.EXPR[OPRCLS] EQL DATAOPR AND .EXPR[OPERSP] EQL CONSTANT) THEN

	BEGIN

		%(
		ELIMINATE THE COMMON SUB NODE
		)%

		IF .CMNPREV EQL .IONODE THEN IONODE[SRCCOMNSUB]_.CMNNODE[SRCLINK]
		ELSE CMNPREV[SRCLINK]_.CMNNODE[SRCLINK];
		SAVSPACE(EXSIZ-1,.CMNNODE);
		CMNNODE_IF .CMNPREV EQL .IONODE THEN .IONODE[SRCCOMNSUB]
		ELSE .CMNPREV[SRCLINK]
	END
	ELSE
	BEGIN
		CMNNODE[ARG1PTR]_0;
		CMNPREV_.CMNNODE;
		CMNNODE_.CMNNODE[SRCLINK]
	END
END;

END;


GLOBAL ROUTINE FOLDUP=
%(**********************************************************************

	RECURSIVE ROUTINE TO FIND AND FOLD LOOPS ON
	AN I/O LIST

**********************************************************************)%
BEGIN
LOCAL BASE PREVCONT;		!BECOMES LENTRY FOR MAKELIST
LOCAL BASE CURRDO;		!BECOMES TOP FOR MAKELIST
PREVCONT_.PREVELEM;		!REMEMBER PREVIOUS ELEMENT
CURRDO_.CURRELEM;		!REMEMBER CURRENT ELEMENT
IF .CURRELEM[OPRS] EQL DOOS THEN
BEGIN
	PREVELEM_.CURRELEM;	!ADVANCE PAST DO NODE
	CURRELEM_.CURRELEM[SRCLINK]
END;
WHILE .CURRELEM NEQ 0 DO
BEGIN
	IF .CURRELEM[OPRS] EQL DOOS THEN
	BEGIN
		FOLDUP()	!RECURSE A LEVEL
	END
	ELSE
	IF .CURRELEM[OPRS] EQL CONTOS THEN
	IF .CURRDO[OPRS] EQL DOOS THEN
	IF .CURRDO[DOLBL] EQL .CURRELEM[SRCLBL] THEN
	BEGIN
		IMPLDO_1;			!SET IMPLIED DO
		TOP_.CURRDO;			!SET TOP
		INDVAR_.TOP[DOSYM];		!SET INDVAR
		LEND_.CURRELEM;			!SET LEND
		BOTTOM_.CURRELEM[SRCLINK];	!SET BOTTOM
		RETURN COLLAPSE()		!COLLAPSE THE LOOP
	END;
	PREVELEM_.CURRELEM;
	CURRELEM_.CURRELEM[SRCLINK]
END;
IMPLDO_0;		!FOLD OUTER LEVEL
TOP_.PREVCONT;		!SET UP TOP
COLLAPSE()		!COLLAPSE THE OUTER LEVEL

END;

GLOBAL ROUTINE IOCLEAR(STMT)=
%(**********************************************************************

	CONTROLLING ROUTINE TO FOLD AN I/O LIST
	INTO IOLSTCALL, E1LISTCALL, AND E2LISTCALL
	NODES

**********************************************************************)%
BEGIN
MAP BASE STMT;
IF (PREVELEM_.STMT[IOLIST]) NEQ 0 THEN
BEGIN
	SAVSTMNT_.STMT;			!SET STATEMENT ADDRESS
	INPFLAG_.STMT[SRCID] EQL READID OR
	.STMT[SRCID] EQL REREDID OR
	.STMT[SRCID] EQL DECOID;	!SET INPFLAG
	CURRELEM_.PREVELEM[SRCLINK];		!SET UP POINTERS
	FOLDUP()				!FOLD LOOP RECURSIVELY
END
END;

END
ELUDOM