Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_V7wLink_Feb83 - pnropt.bli
There are 12 other files named pnropt.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: NORMA ABEL/HPW/MD/SJW/JNG/DCE/TFV/EGM/SRM/CDM/RVM

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

!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND PNROPV = 7^24 + 0^18 + #1542;	! Version Date:	25-May-82

%(

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

113	-----	-----	MAKE REDUCE A GLOBAL FOR I/O OPTIMIZATION
114	-----	-----	CALL ARSKOPT TO DO PHASE 2 SKELETON FOR
			EXPRESSIONS CREATED BY REDUCE
115	-----	-----	INTERFACE TO IOGPNR TO PROPAGATE AND REDUCE
			EXPRESSIONS ON I/O LISTS
116	-----	-----	MAKE LOKDEFPT A GLOBAL ROUTINE
117	-----	-----	TAKE OUT REDUCE TO PUT IT IN TSTR
118	-----	-----	MAKE FOLDER GLOBAL
119	-----	-----	FIXES TO FOLDER FOR DATAOPR, ARRAYREF, IOLSCLS
120	-----	-----	CALL IOGPNR FOR READ/WRITE/ENCODE/DECODE
121	-----	-----	ADD RERED TO IOGPNR
122	-----	-----	STOP LOKDEFPT FROM BOMBING ON A DATAOPR
123	-----	-----	TYPO IN DOPROPAGATE CAUSING VALFLGS ON SYMBOL NODES
124	-----	-----	ZERO DEFPT1 ON AN ARRAYREF
125	-----	-----	FORGOT ASGNPROP IN 124
126	-----	-----	FOR ALL LOOPS OR MAINS ZERO DEFPTS
			BETWEEN LENTRY AND TOP
127	-----	-----	ADD POTENTIAL TO REDUCE P2MUL AND P2+1 MULS
128	-----	-----	PROPAGATE THRU DO LOOPS BETTER AND THROUGH
			.O VARIBALES
129	-----	-----	NEXT DAY CONTINUE ON 128
130	-----	-----	REDUCE SPECIAL SPECIAL OPS
131	-----	-----	DO NOT PROPAGATE INTO LOOPS ANY VARIABLE
			THAT STARTS WITH A DOT .
132	-----	-----	MAKE OLDHEAD A MODULE OWN INSTEAD OF EXTERNAL
133	-----	-----	MAKE DOTOPROPAGATE LOOK AT I/O LISTS AND
			ALSO PROPAGATE .O=.O,.O=.R,.S=.O,.I=.O
134	-----	-----	IF MULTIPLE OF 133 HAVE OCCURRED THEN
			ELIMINATE .OX=.OX BY MAKING IT A CONTINUE
135	-----	-----	FIX DOTOPROPAGATE SO WE DO NOT BLOW I/O LISTS
136	-----	-----	FIX 135
137	-----	-----	FIX RUBOUT TO CHECK IF VARIABLE BEING
			PROPAGATED WAS ALREADY PROPAGATED TO
138	-----	-----	TAKE INCORRECT CALL TO ASGNNN OUT OF
			DOPROPAGATE
139	-----	-----	MAKE PROPCASE LOOK AT LH SIDES WHEN PROPAPAGATING TO GET ARRAYREFS
140	-----	-----	DOTOPROPAGATE LOSES NEGS/NOTS. STOP IT.
141	-----	-----	FOLD DABS
142	-----	-----	FOLD PROPAGATED DO LOOP CONTROLS WITH
			THE NEG NODE ABOVE THEM
143	-----	-----	IN 142 CHECK FOR FULL NEGATIVE NOT
			JUST OPERSP. STUPID!

***** Begin Version 4A *****

144	 234	14167	FIX PROPAGATION OF LIB FUNCTION CALLS
			WITH CONSTANT ARGUMENT TO PROGRAM ENTRY., (NEA/MD)
145	375	18450	USE .O VAR INSTEAD OF .R FOR CONSTANTS, (DCE)
146	VER5	-----	DON'T ZERO DEFPTS IN CONS1DEF,LOK1DEFPT,
			  LOK2DEFPT, ASGNPROP
			MOVE DEFPT UP WHEN FOLDEE BECOMES A LEAF
			SET DEFKEEPER FOR FOLDER
			SET DEFPT OF CONSTANT PROPERLY
			CALL DFCLEANUP SO .O FLAGS NOT CLEARED, (SJW)
147	421	QA651	DON'T DOTOPROPAGATE .O WHICH CAME FROM .R
			  (ORFIXFLG => NOT ELIGIBLE), (SJW)
148	465	20657	ZERO INDVAR BEFORE CALLING REDUCE FOR
			STATEMENTS BEFORE THE LOOP, SINCE WE OTHERWISE
			MIGHT FIND SOME REDUCTIONS (!!!)
149	466	VER5	DON'T TRY TO ZERO DEF POINTS FOR STATEMENTS
			BETWEEN LENTRY AND TOP (REMOVES EDIT 465), (SJW)

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

150	562	22540	WHEN FOLDING CONSTANTS, TAKE CARE OF EXPRESSIONS
			WHICH HAVE NO PARENT POINTER (FIELD IS ZERO), (DCE)

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

151	661	24100	DO NOT THROW AWAY LABELED STATEMENTS, (DCE)
152	714	26498	INTERNAL PROBLEM WITH DEF POINTS, (DCE)

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

153	761	TFV	1-Mar-80	-----
	Add indices for folding /GFLOATING constants

154	775	EGM	17-Jun-80	10-29566
	Make DOTOPROPAGATE work reliably for the second and subsequent walks
	through the statement nodes.

155	1022	TFV	27-Oct-80	------
	Preserve the bit patterns for octals and literals assigned to reals
	under GFLOATING.  

156	1060	DCE	6-Apr-81	-----
	Fix bug with constant specop negative-number (A*0.5 where A has
	a known propagated constant value).

157	1074	SRM	27-May-81	-----
	Fix bug in folding logical IFs when the condition is NOT of
	a REAL or DP. In PROPAGATE, it was assumed that IFNN would not
	alter the data type of the constant; but .NOT. (REAL) has
	type logical.

159	1104	EGM	25-Jun-81	--------
	When propagating .O variables, handle the neg/not correctly for
	assignments.

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

158	1212	TFV	29-Apr-81	------
	Replace LITERAL with HOLLERITH.

160	1270	CDM	6-Oct-81	------
	In FOLDER, for type conversion nodes, do no conversions to arguments
	for nodes that want real and have octal constant arguments.

161	1415	RVM	9-Nov-81
	In VALCNV, preserve the bit pattern for logical constants that are
	propagated under GFLOATING.  This edit is related to edit 1414.
	See REVHST.MAC.

162	1447	CDM/CKS	12-Dec-81
	In DOTOPR, change 
	IF () AND () AND () THEN 
	to 
	IF () THEN  IF () THEN  IF () THEN
	so that the last clause is not evaluated unless the first  two
	are true.   Was getting  an illegal  memory read  for  reading
	beyond what actually existed  for a continue statement.   Also
	some needed prettying of code.

1542	RVM	25-May-82
	In VALCNV, always convert OCTAL, HOLLERITH, LOGICAL, and
	CONTROL expressions to REAL, even under /GFLOATING.  This
	removes edits 1022 and 1415 from this module.

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

)%

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


EXTERNAL CNSTCMB,COPRIX,SPKABA,C1H,C1L,C2H,C2L,CMBEQLARGS,BLCMB,ARCMB,
TBLSEARCH,PREV,LOOPNO;
OWN DEFKEP,DEFKEEPER;
OWN OLDHEAD;
OWN PAPPY;		!PARENT POINTER
EXTERNAL INDVAR,CORMAN;
EXTERNAL TOP,BOTTOM,LEND,LENTRY;
MAP PEXPRNODE TOP:LENTRY:LEND;
EXTERNAL MAKPR1;
EXTERNAL REDUCE;
FORWARD FIX1NN,FIX2NN;
FORWARD STMTPROP,ASGNNN;
EXTERNAL QQ;
MAP PHAZ2 QQ;
FORWARD IFNN;


!MACRO TO CALL MAKPR1 TO MAKE A NEG OR NOT NODE AND RETURN IT
MACRO MAKNEGNOT(WHICH)=
	MAKPR1(.DAD,NEGNOT,WHICH,.SON[VALTYPE],0,.SON)$;

ROUTINE SETPNOT(DAD,SON)=
BEGIN
	!THIS ROUTINE EXAMINES DAD, DETERMINES IF SON IS
	!ARG1 OR ARG 2 AND 
	!COMPLEMENT THE NOTFLG OF THE CORRECT ARGUMENT
	EXTERNAL TAKNOTARG;
	EXTERNAL SKERR;
	MAP BASE DAD:SON;

	!IF ITS A STATEMENT LOOK AT ASSIGNEMNT
	!LOGICAL AND ARITHMETIC IF.
	IF .DAD[OPRCLS] EQL STATEMENT THEN
	BEGIN
		IF .DAD[SRCID] EQL ASGNID THEN
		BEGIN
			IF .SON EQL .DAD[RHEXP] THEN
			BEGIN
				IF NOT .DAD[A2NEGFLG] THEN
					DAD[A2NOTFLG]_NOT .DAD[A2NOTFLG]
				ELSE
					DAD[RHEXP]_MAKNEGNOT(NOTOP);
			END
			ELSE
			BEGIN
				IF NOT .DAD[A1NEGFLG] THEN
					DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
				ELSE
					SKERR();
			END;
		END ELSE
		IF .DAD[SRCID] EQL IFLID THEN
			DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
		ELSE
		IF .DAD[SRCID] EQL IFAID THEN
			DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG];
	END ELSE
	!IT MUST BE AN EXPRESSION. IT HAD BETTER NOT BE
	!A FUNCTION CALL (FNCALL)

	IF .DAD[ARG1PTR] EQL .SON THEN
	BEGIN
		IF TAKNOTARG(.DAD) AND NOT .DAD[A1NEGFLG] THEN
			DAD[A1NOTFLG]_NOT .DAD[A1NOTFLG]
		ELSE
			DAD[ARG1PTR]_MAKNEGNOT(NOTOP);
	END
	ELSE
	BEGIN
		IF TAKNOTARG(.DAD) AND NOT .DAD[A2NEGFLG] THEN
			DAD[A2NOTFLG]_NOT .DAD[A2NOTFLG]
		ELSE
			DAD[ARG2PTR]_MAKNEGNOT(NOTOP);
	END;
END;

ROUTINE SETPNEG(DAD,SON)=
BEGIN
	EXTERNAL SETNEG;
	!THIS ROUTINE EXAMINES DAD, DETERMINES IF SON IS
	!ARG1 OR ARG 2 AND CALLS THE ROUTINE SETNEG TO
	!COMPLEMENT THE NEGFLG OF THE CORRECT ARGUMENT
	MAP BASE DAD:SON;

	!IF ITS A STATEMENT LOOK AT ASSIGNEMNT
	!LOGICAL AND ARITHMETIC IF.
	IF .DAD[OPRCLS] EQL STATEMENT THEN
	BEGIN
		IF .DAD[SRCID] EQL ASGNID THEN
		BEGIN
			IF .SON EQL .DAD[RHEXP] THEN
			BEGIN
				IF NOT .DAD[A2NOTFLG] THEN
					DAD[A2NEGFLG]_NOT .DAD[A2NEGFLG]
				ELSE
					DAD[RHEXP]_MAKNEGNOT(NEGOP);
			END
			ELSE
				DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG];
		END ELSE
		IF .DAD[SRCID] EQL IFLID THEN
			DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG]
		ELSE
		IF .DAD[SRCID] EQL IFAID THEN
			DAD[A1NEGFLG]_NOT .DAD[A1NEGFLG];
	END ELSE
	!IT MUST BE AN EXPRESSION. IT HAD BETTER NOT BE
	!A FUNCTION CALL (FNCALL)

	IF .DAD[ARG1PTR] EQL .SON THEN
	BEGIN
		IF SETNEG(.DAD,1) THEN ELSE DAD[ARG1PTR]_MAKNEGNOT(NEGOP);
	END

	ELSE
	BEGIN
		IF SETNEG(.DAD,0) THEN ELSE DAD[ARG2PTR]_MAKNEGNOT(NEGOP);
	END;

END;

GLOBAL ROUTINE FOLDER(EXPR)=
BEGIN
	EXTERNAL SETPVAL;
![761] KSPECG, KILFBG, KTYPCG for folding /GFLOATING constants
%[761]%	EXTERNAL KSPECB,KSPECG,DNEGCNST,KILFBA,KILFBR,KILFBG;
%[761]%	EXTERNAL RELSKOPT,BLSKOPT,ARSKOPT,KTYCM,KTYPCB,KTYPCG;
	EXTERNAL NEGFLG,NOTFLG;
	MAP PEXPRNODE EXPR;
	!A CONSTANT HAS JUST PROPAGATED
	!CHECK FOR AND PERFORM ANY POSSIBLE FOLDING ETC
	!
%[1060]% LOCAL PHAZ2 OPEXPR;
%[1060]% REGISTER PHAZ2 T;

	OPEXPR_.EXPR;		!SAVE TO SEE IF IT REALLY FOLDED
	!FOR SOME OPERATIONS WE MAY BE HERE BECAUSE ONE OF
	!TWO CONSTANTS IN THE EXPRESSION FOLDED, BUT NOT
	!NECESSARILY BOTH. THIS IS OK, IN THAT ROUTINES LIKE RELSKOPT,
	!ARSKOPT, ETC HANDLE THIS SITUATION. IT IS NOT
	!ACCEPTABLE, HOWEVER, FOR SPECOPS AND INLINFNS.
	!SO WE WILL TEST FOR THE THREE EXCEPTIONS AND QUIT
	!IF BOTH ARGS ARE NOT CONSTANTS.

	!WE MUST ALSO MAKE SURE THAT NEG/NOT FLAGS ARE FOLDED
	!INTO ANY CONSTANTS THAT ARE CURRENTLY EXTANT OR CREATED.
	EXPR_(
	CASE .EXPR[OPRCLS] OF SET

	!BOOLEAN
	BEGIN
		!FOLD NEG/NOT FLAGS, IF THERE
		T_.EXPR[ARG1PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		T_.EXPR[ARG2PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
		PAPPY_.EXPR[PARENT];
		!SET NOT FLAG FALSE
		NOTFLG_FALSE;
		EXPR_BLSKOPT(.EXPR);
		!IF BLSKOPT SET NOTFLG THEN WE HAVE TO PASS IT BACK UP
		IF .NOTFLG THEN
			SETPNOT(.PAPPY,.OPEXPR);
		.EXPR
	END;

	!DATAOPR
		BEGIN
			RETURN .EXPR
		END;

	!RELATIONAL
	BEGIN
		!FOLD NEG/NOT FLAGS IF THERE
		T_.EXPR[ARG1PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		T_.EXPR[ARG2PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
		RELSKOPT(.EXPR)
	END;

	!FNCALL
		.EXPR;

	!ARITHMETIC
	BEGIN
		!FOLD NEG/NOT FLAGS IF THERE
		T_.EXPR[ARG1PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		T_.EXPR[ARG2PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
		!SAVE PARENT POINTER FOR THE NEGFLAG PROPAGATION HASSLE
		PAPPY_.EXPR[PARENT];
		!SET NEGFLG FALSE
		NOTFLG_FALSE;
		NEGFLG_FALSE;
		EXPR_ARSKOPT(.EXPR);
		!IF NEGFLG IS NOW TRUE WE HAVE TO SET THE NEGFLG ON
		!PAPPY FOR THE CORRECT ARGUMENT. NOT SET BUT COMPLEMENT.
		IF .NEGFLG THEN
			SETPNEG(.PAPPY,.OPEXPR);
		.EXPR
	END;

	!TYPECNV
	BEGIN
		LOCAL BASE ARG2NODE;

		!FOLD NEG/NOT FLAGS, IF THERE
		T_.EXPR[ARG2PTR];
		IF .T[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
		IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);

		!IF THIS IS A CONVERSION FROM LOGICAL (INDICATED BY OPERSP)
		! TO DOUBLE PRECISION DO NOT DO IT ELSE THERE WILL
		! BE ROUNDING ERRORS ON A KA.
		![1270] Also if node wants Real and has non-real constant 
		!  argument then leave before conversions take place.
%1270%		T_.EXPR[ARG2PTR];
		IF (.EXPR[VALTYPE] EQL DOUBLPREC AND
		 .EXPR[OPERSP] EQL LOGICAL) OR
%1270%		 (.EXPR[OPERSP] EQL FROMREAL AND .T[VALTYPE] NEQ REAL)
		THEN RETURN(.EXPR);

		COPRIX_KTPCNVIX(EXPR);
		ARG2NODE_.EXPR[ARG2PTR];
		C1H_.ARG2NODE[CONST1];
		C1L_.ARG2NODE[CONST2];
		CNSTCMB();
		MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
	END;

	!ARRAYREF
		BEGIN
		IF NOT .EXPR[A2VALFLG] THEN 
		BEGIN
			!FOLD NEG/NOT FLAGS, IF THERE
			T_.EXPR[ARG2PTR];
			IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
			EXPR[ARG2PTR]_ARSKOPT(.EXPR[ARG2PTR])
		END;
		RETURN .EXPR
		END;
	!CMNSUB
		RETURN .EXPR;

	!NEGNOT
	BEGIN
		LOCAL BASE ARGNODE;
		!FOLD NEG/NOT FLAGS, IF THERE
		T_.EXPR[ARG2PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
		ARGNODE_.EXPR[ARG2PTR];
		IF .ARGNODE[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
		IF .EXPR[OPERSP] EQL NEGOP THEN
			NEGCNST(ARGNODE)
		ELSE
			NOTCNST(ARGNODE)
	END;

	!SPECOP
	BEGIN
		LOCAL BASE ARG1NODE;
%[1060]%	MACHOP HRREM=#572;
		T_.EXPR[ARG1PTR];
		IF .T[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
		IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		ARG1NODE_.EXPR[ARG1PTR];
		COPRIX_KSPECOPIX(EXPR);
		C1H_.ARG1NODE[CONST1];
		C1L_.ARG1NODE[CONST2];
%[1060]%	T_.EXPR[ARG2PTR];
%[1060]%	HRREM(T,C2L); ! Careful for negative numbers...
		CNSTCMB();
		MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
	END;

	!FIELDREF
	BEGIN
	END;
	!STOERCLS
	BEGIN END;
	!REGCONTENTS
	BEGIN END;
	!LABOP
	BEGIN END;
	!STATEMENT
	BEGIN END;
	!IOLSCLS
		RETURN .EXPR;
	!INLINFN
	BEGIN
		LOCAL BASE ARGNODE;
		EXTERNAL KILDAB;
		T_.EXPR[ARG1PTR];
		IF .T[OPR1] EQL CONSTFL THEN FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		ARGNODE_.EXPR[ARG1PTR];
		IF .ARGNODE[OPR1] NEQ CONSTFL THEN RETURN(.EXPR);
		ARGNODE_.EXPR[ARG2PTR];
		IF .ARGNODE NEQ 0 THEN
		BEGIN
			T_.EXPR[ARG2PTR];
			IF .T[OPR1] EQL CONSTFL THEN FIX2NN(.EXPR,.EXPR[ARG2PTR]);
			IF .ARGNODE[OPR1] NEQ CONSTFL THEN
				RETURN(.EXPR);
		END;
		ARGNODE_.EXPR[ARG1PTR];
		C1H_.ARGNODE[CONST1];
		C1L_.ARGNODE[CONST2];
		ARGNODE_.EXPR[ARG2PTR];
		IF .ARGNODE NEQ 0 THEN
		BEGIN
			C2H_.ARGNODE[CONST1];
			C2L_.ARGNODE[CONST2];
		END;

		!IF THIS IS DABS SPECIFICALLY SET COPRIX
		IF .EXPR[OPERATOR] EQL DABSFNOP THEN
			COPRIX_KILDAB
		ELSE
			COPRIX_KILFOPIX(EXPR);
		CNSTCMB();
		MAKECNST(.EXPR[VALTYPE],.C2H,.C2L)
	END
	TES);
	!NOW LOOK TO SEE IF ANY PROPAGATION TOOK PLACE
	!IF IT DID (THE CONSTANTS FOLDED OR COMBINED) THEN
	!CHECK TO SEE THAT DEFPOINTS OF ITEMS LEFT ARE SET

	IF .OPEXPR NEQ .EXPR THEN
	BEGIN
		!CHECK TO SEE THAT FOLD WAS INDEED TO A 
		!DATA ITEM. EXPRESSION AND TRUE FOLDS
		!TO EXPRESSION AND SETTING THE VAL FLAG WOULD BE A NO-NO

	    T _ .OPEXPR [PARENT];		! LOOK AT PARENT
	!THERE MAY BE NO PARENT FOR THIS EXPRESSION, AND IF NOT, WE
	! WANT TO SIMPLY RETURN AFTER FOLDING THE CONSTANTS.
	    IF .T EQL 0 THEN RETURN .EXPR;
	    IF .EXPR [OPRCLS] EQL DATAOPR 
	      THEN BEGIN
		SETPVAL(.OPEXPR);		! SET VAL FLAGS ABOVE 
		IF .T [OPRCLS] NEQ STATEMENT	! MOVE DEFPT UP
		  THEN 
		    IF .T [ARG1PTR] EQL .OPEXPR
		      THEN T [DEFPT1] _ .DEFKEEPER
		      ELSE T [DEFPT2] _ .DEFKEEPER;
	      END;

		IF .T[OPRCLS] EQL STATEMENT THEN	!POINTS BACK TO
							!STATEMENT
			IF (.T[SRCOPT] NEQ 0) AND (.T[SRCID] NEQ DOID) THEN
			T[OPDEF]_(IF .EXPR[OPR1] EQL CONSTFL THEN
					.LENTRY ELSE .DEFKEEPER);
	END;
	.EXPR
END;

ROUTINE CHKPROP=
BEGIN

	!IF ELIGIBLE GET A DEFINITION POINT FOR THE GLOBAL
	!A1NODE. IF THE DEFINITION POINT IS AN ASSIGNMENT OF
	!THE VARIABLE TO A CONSTANT THEN RETURN THE CONSTANT IN
	!A1NODE AND 1 ELSE REYURN 0

	EXTERNAL GETDEF,ONLIST,A1NODE;

	MAP PHAZ2 OLDHEAD:A1NODE;

	REGISTER BASE T;
	!***********
	MACRO IDDOT=0,3,30,6$;
	!*********

	!QUIT QUICK IF A1NODE STARTS WITH A DOT. WE MAY LOSE
	!.O VARS NOW BUT WILL GET THEM WITH DOTOPROPAGATE

	IF .A1NODE[IDDOT] EQL SIXBIT"." THEN RETURN;


	!OLDHEAD POINTS TO A DO NODE. CHECK FOR THE LEAF
	!CHANGING INSIDE THE LOOP

	IF NOT ONLIST(.OLDHEAD[DOCHNGL],.A1NODE) THEN
	BEGIN
		T_GETDEF(.A1NODE,.OLDHEAD,0);

		!IF A VALID DEFINITION POINT IS RETURNED
		IF .T NEQ 0 THEN
		BEGIN
			!IS IT AN ASSIGNMENT STATEMENT
			IF .T[OPRS] EQL ASGNOS THEN
			BEGIN
				IF .T[LHEXP] EQL .A1NODE
				AND .T[A2VALFLG] THEN
				BEGIN
					!ASSIGN A1NODE AND TEST FOR
					!CONSTANT
					A1NODE_.T[RHEXP];
					IF .A1NODE[OPR1] EQL CONSTFL THEN
					RETURN 1;
				END;
			END;
		END;
	END;
END;

ROUTINE GRASPDEF(EXPR,A2FLG)=
BEGIN
	!CHECK EXPR FOR POTENTIAL PROPAGATION.
	!CHECK ARG 2 IF A2FKG IS SET. SUBSTITUTE THE
	!CONSTANT IF PROPAGATED

	EXTERNAL A1NODE;

	MAP BASE A1NODE:EXPR;

	A1NODE_(IF .A2FLG THEN .EXPR[ARG2PTR] ELSE .EXPR[ARG1PTR]);

	IF .A1NODE[OPR1] EQL CONSTFL THEN RETURN;

	IF CHKPROP() THEN
		(IF .A2FLG THEN EXPR[ARG2PTR] ELSE
			EXPR[ARG1PTR])_.A1NODE;
END;

ROUTINE GRABDEF(EXPR)=
BEGIN
	EXTERNAL DNEGCNST;
	MAP PEXPRNODE EXPR;
	!EXPR POINTS AT AN EXPRESSION TREE TO BE WALKED


	!*****************
	!HELPFUL MACROS
	!*****************

	MACRO SNATCH1=
	BEGIN
		IF .EXPR[A1VALFLG] THEN
			GRASPDEF(.EXPR,0)
		ELSE
			GRABDEF(.EXPR[ARG1PTR]);
	END$;


	MACRO SNATCH2=
	BEGIN
		IF .EXPR[A2VALFLG] THEN
			GRASPDEF(.EXPR,1)
		ELSE
			GRABDEF(.EXPR[ARG2PTR]);
	END$;


	CASE .EXPR[OPRCLS] OF SET

	!BOOLEAN
	BEGIN
		SNATCH1;
		SNATCH2;
	END;

	!DATAOPR
		BEGIN END;

	!RELATIONAL
	BEGIN
		SNATCH1;
		SNATCH2;
	END;

	!FNCALL
		BEGIN END;

	!ARITHMETIC
	BEGIN
		SNATCH1;
		SNATCH2;
	END;

	!TYPECNV
	BEGIN
		SNATCH2;
	END;

	!ARRAYREF
	BEGIN
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			SNATCH2;
	END;

	!CMNSUB
		BEGIN END;

	!NEGNOT
	BEGIN
		SNATCH2;
	END;

	!SPECOP
	BEGIN
		SNATCH1;
	END;

	!FIELDREF		NOT IN RELEASE 1
		BEGIN END;

	!STORECLS
		BEGIN END;

	!REGCONTENTS
		BEGIN END;

	!LABOP
		BEGIN END;

	!STATEMENT
		BEGIN END;

	!IOLSCLS
		BEGIN END;

	!INLINFN
	BEGIN
		SNATCH1;
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			SNATCH2;
	END

	TES;
END;

ROUTINE DOPROPAGATE(STMT)=
BEGIN
	!TO EXAMINE ALL STATEMENTS IN THE LOOP HEADED BY STMT
	!FOR THE PROPAGATION OF VARIABLES
	!STMT IS THE DO STATEMENT

	EXTERNAL BASE A1NODE;
	LOCAL PEXPRNODE P:PB;
	MAP PHAZ2 STMT;
	IF .STMT[SRCOPT] EQL 0 THEN RETURN;

	OLDHEAD_.STMT;

	P_.STMT;
	PB_.STMT[DOLBL];
	PB_.PB[SNHDR];
	DO
	BEGIN
		!WE NOW HANDLE ONLY ASSIGNMENT STATEMENTS AND DO LOOPS
		IF .P[SRCID] EQL ASGNID THEN
		BEGIN
			IF NOT .P[A1VALFLG] THEN
				GRABDEF(.P[LHEXP]);

			IF NOT .P[A2VALFLG] THEN
				GRABDEF(.P[RHEXP])
			ELSE
			BEGIN
				A1NODE_.P[RHEXP];
				IF CHKPROP() THEN
					ASGNNN(.P);
			END;
		END ELSE

		IF .P[SRCID] EQL DOID THEN
		BEGIN
			IF .P NEQ .STMT THEN
			IF NOT .P[FLCWD] THEN
			BEGIN
				A1NODE_.P[DOLPCTL];
				IF .A1NODE[OPR1] EQL VARFL THEN
				BEGIN
					IF CHKPROP() THEN
					BEGIN
						P[DOLPCTL]_.A1NODE;
						STMTPROP(.P);
					END;
				END ELSE
				BEGIN
					GRABDEF(.P[DOLPCTL]);
					!IF IT PROPAGATED WE COULD HAVE
					!LEFT A NEG NODE OVER A CONSTANT
					!CHECK FOR THAT AS A SPECIFIC CASE
					!AND FOLD IT.
					A1NODE_.P[DOLPCTL];
					IF .A1NODE[OPR1] EQL NEGFL
					AND .A1NODE[A2VALFLG] THEN
					BEGIN
						!LOOK A LEVEL FURTHER FOR THE
						!CONSTANT
						A1NODE_.A1NODE[ARG2PTR];
						IF .A1NODE[OPR1] EQL CONSTFL THEN
							P[DOLPCTL]_NEGCNST(A1NODE);
					END;
				END;
			END;
		END;
		P_.P[SRCLINK];
	END UNTIL .P EQL .PB[SRCLINK];
END;

ROUTINE VALCNV(LHSNOD,RHSNOD)=
BEGIN
	!WHEN A CONSTANT TO PROPAGATE HAS BEEN FOUND
	!WE MUST PERHAPS PERFORM SOME TYPE CONVERSION WONDERS ON
	!IT. SINCE ALL CONSTANTS (REAL) ARE CARRIED IN DOUBLE
	!PRECISION, WE MUST ROUND BEFORE USE IF THIS IS A REAL
	!VARIABLE. IF THE VALUE TYPE ON BOTH SIDES OF THE
	!ASSIGNMENT IS NOT THE SAME, WE MUST ALSO CONVERT THE CONSTANT.
	!THIS IS FOR CASES LIKE A=.TRUE..
	!ALSO WE DO NOT WANT TO CONVERT DP=".........
	!OR DP='....'

![761] KTYPCG and KGFRL for folding /GFLOATING constants
%[761]%	EXTERNAL KTYPCB,KTYPCG;
%[761]%	EXTERNAL COPRIX,C1H,C1L,C2H,C2L,KDPRL,KGFRL,KGFSPR,CNSTCMB;
	MAP BASE RHSNOD:LHSNOD;

	!SAME VALTYPE, REAL
	IF .LHSNOD[VALTYPE] EQL .RHSNOD[VALTYPE] AND .LHSNOD[VALTYPE]
	  EQL REAL THEN
	BEGIN
![761] Fold DP to SP precision based on /GFLOATING
![761] Do not convert DP to actual SP since exponent widths can differ
%[761]%		IF .GFLOAT THEN COPRIX_KGFSPR ELSE COPRIX_KDPRL;
		C1H_.RHSNOD[CONST1];
		C1L_.RHSNOD[CONST2];
		CNSTCMB();
		RETURN(MAKECNST(REAL,.C2H,.C2L));
	END ELSE
	BEGIN
		!VALTYPES DIFFERENT
		IF .LHSNOD[VALTYPE] NEQ .RHSNOD[VALTYPE] THEN
		BEGIN
			!CHECK FOR THOSE ADDITIONAL ONES NOT TO CONVERT
			IF .LHSNOD[VALTYPE] EQL DOUBLPREC AND
%1212%		(.RHSNOD[VALTYPE] EQL HOLLERITH OR
			 .RHSNOD[VALTYPE] EQL DOUBLOCT) THEN
				RETURN(.RHSNOD);	!NO CONVERSION

			!WE ARE HERE AND WANT TO CONVERT
			COPRIX_KKTPCNVIX(.LHSNOD[VALTP2],.RHSNOD[VALTP2]);
			C1H_.RHSNOD[CONST1];
			C1L_.RHSNOD[CONST2];
			CNSTCMB();
			RETURN(MAKECNST(.LHSNOD[VALTYPE],.C2H,.C2L));
		END;
	END;
	!ELSE ALL IS OK JUST USE CONSTANT AS IS
	RETURN(.RHSNOD);
END;

ROUTINE FIX1NN(EXPR,NUMB)=
BEGIN
	!CHECK FOR A NEG AND(SHOULD NEVER BE)/OR NOT FLAG
	!OVER ARG1 OF EXPR. ARG1 IS A CONSTANT. NEGATE
	!OR COMPLEMENT THE CONSTANT AND FIX ARG1PTR.
	!NUMB IS THE CONSTANT.

	MAP PEXPRNODE EXPR:NUMB;

	EXTERNAL DNEGCNST;

					IF .EXPR[A1NEGFLG] THEN
					BEGIN
						EXPR[ARG1PTR]_NEGCNST(NUMB);
						EXPR[A1NEGFLG]_0;
					END;
					IF .EXPR[A1NOTFLG] THEN
					BEGIN
						EXPR[ARG1PTR]_NOTCNST(NUMB);
						EXPR[A1NOTFLG]_0;
					END;
END;

ROUTINE CONS1DEF(EXPR)=
BEGIN
	!DETERMINE IF A PROPAGATION CAN OCCUR
	!AND DO IT FOR THE FIRST ARGUMENT OF EXPR

	!OWN DEFKEEPER _ DEFPT2 IF ARG1 IS OR BECOMES A CONSTANT
	!		 DEFPT1 IF ARG1 REMAINS A VARIABLE


	EXTERNAL DNEGCNST,CHOSEN,GLOBREG,LENTRY;
	MAP PEXPRNODE EXPR;
	LOCAL BASE PC:PB:PA;

		!WE ARE LOOKING AT A LEAF
		!IF IT IS A CONSTANT OR VARIABLE THAT PROPAGATES
		!RETURN 1. THIS MAY CAUSE SOME EXTRA WORK
		!IN THAT THE VARIABLE CONSTANT COMBO WILL CAUSE
		!AN EXTRA CALL TO LOCAL OPTIMIZATION ROUTINES
		!BUT IT IS THE ONLY WAY WE CAN FOLD HAIRY EXPRESSIONS
		!THAT COLLAPSE UP FROM A SINGLE PROPAGATE.
		PC_.EXPR[ARG1PTR];
		IF .PC[OPR1] EQL CONSTFL THEN
		BEGIN
			FIX1NN(.EXPR,.PC);
			DEFKEEPER _ .EXPR [DEFPT2];
			RETURN(1);
		END;

		IF .PC[OPR1] EQL VARFL THEN
		BEGIN
			!THE LEAF IS A VARIABLE
			DEFKEEPER _
			  PA_.EXPR[DEFPT1];
			!DONT MISTAKENLY PROPAGATE THE CONSTANT THAT
			!MAY SIT AT LENTRY.
			IF .PA EQL 0 OR .PA EQL .LENTRY
			  THEN RETURN (0);
			IF .PA[SRCID] EQL ASGNID AND
				.PA[LHEXP] EQL .PC THEN
			!THE DEFINITION FPOINT IS AN ASSIGNMENT OF THAT 
			!VARIABLE
			BEGIN
				PB_.PA[RHEXP];
				!LOOK AT THE RIGHT  HAND SIDE
				IF .PB[OPR1] EQL CONSTFL THEN
				BEGIN
					!REALLY GOT ONE!
					!SAVE DEFINITION POINT
					DEFKEEPER_.EXPR[DEFPT2];
					PB_VALCNV(.PA[LHEXP],.PB);
					EXPR[ARG1PTR]_.PB;
					FIX1NN(.EXPR,.PB);
					EXPR [DEFPT1] _ .LENTRY;
![714] REMOVE THE CODE WHICH PURPORTS TO "SAVE THE PROPAGATION"
![714] THIS CAN CAUSE PROBLEMS, AND APPEARS TO DO NO GOOD AT ALL!
					RETURN(1)
				END;
			END;
		END ELSE
		BEGIN
			!IF IT WAS A CONSTANT MAKE SURE THAT THERE
			!ARE NO NEG OR NOT FLAGS LEFT ABOVE IT. THE
			!CASE MAY ARISE IF THE CONSTANT IS A PROPAGATED
			!EXPRESSION (LIKE INLINFN). FOR THE NEG OR
			!NOT INTO THE CONSTANT
			IF .PC[OPR1] EQL CONSTFL THEN
				FIX1NN(.EXPR,.EXPR[ARG1PTR]);
		END;
END;

ROUTINE FIX2NN(EXPR,NUMB)=
BEGIN
	!EXPR[ARG2PTR] IS A CONSTANT. SEE THAT NEG AND NOT FLAGS
	!ARE FOLDED INTO THE CONSTANT. NUMB IS EXPR[ARG2PTR].
	!EQUIVALENT OF FIX1NN FOR ARG2.

	MAP PEXPRNODE EXPR:NUMB;

	EXTERNAL DNEGCNST;

					IF .EXPR[A2NEGFLG] THEN
					BEGIN
						EXPR[ARG2PTR]_NEGCNST(NUMB);
						EXPR[A2NEGFLG]_0;
					END;
					IF .EXPR[A2NOTFLG] THEN
					BEGIN
						EXPR[ARG2PTR]_NOTCNST(NUMB);
						EXPR[A2NOTFLG]_0;
					END;
END;

ROUTINE CONS2DEF(EXPR)=
BEGIN
	!DETERMINE IF A PROPAGATION CAN OCCUR AND DO IT
	!FOR THE SECOND ARGUMENT OF EXPR

	!OWN DEFKEEPER _ DEFPT1 IF ARG2 IS OR BECOMES A CONSTANT
	!                DEFPT2 IF ARG2 REMAINS A VARIABLE
	!  NOTE DEFPT1 _ .LENTRY IN CONS1DEF IF ARG1 BECOMES CONSTANT

	EXTERNAL DNEGCNST,CHOSEN,GLOBREG,LENTRY;
	MAP PEXPRNODE EXPR;
	LOCAL BASE PC:PB:PA;

		!WE ARE LOOKING AT A LEAF
		!SEE COMMENTS IN FRONT OF CONS1DEF

		PC_.EXPR[ARG2PTR];

		IF .PC[OPR1] EQL CONSTFL THEN
		BEGIN
			FIX2NN(.EXPR,.PC);
			DEFKEEPER _ .EXPR [DEFPT1];
			RETURN(1);
		END;

		IF .PC[OPR1] EQL VARFL THEN
		BEGIN
			!THE LEAF IS A VARIABLE
			DEFKEEPER _
			  PA_.EXPR[DEFPT2];
			!DO NOT INADVERTENTLY PROPAGATE AN INNOCENT
			!ASSIGNMENT AT ENTRY
			IF .PA EQL 0 OR .PA EQL .LENTRY
			  THEN RETURN (0);
			IF .PA[SRCID] EQL ASGNID AND .PA[LHEXP] EQL .PC THEN
			BEGIN
				!THE DEFINITION POINT IS AN ASSIGNMENT OF THAT VARIABLE
				PB_.PA[RHEXP];
				!LOOK AT THE RIGHT HAND SIDE
				IF .PB[OPR1] EQL CONSTFL THEN
				BEGIN
					!REALLY GOT ONE!
					PB_VALCNV(.PA[LHEXP],.PB);
					EXPR[ARG2PTR]_.PB;
					DEFKEEPER _ .EXPR [DEFPT1];
					FIX2NN(.EXPR,.PB);
					EXPR [DEFPT2] _ .LENTRY;
![714] REMOVE THE CODE THAT PURPORTS TO "SAVE THE PROPAGATION"
![714] IT APPEARS TO CAUSE PROBLEMS AND DO NO GOOD AT ALL!
					RETURN(1);
				END;
			END;
		END ELSE
		BEGIN
			!IF IF IS ALREADY A CONSTANT (PROPAGATED EXPRESSION)
			!MAKE SURE NEG/NOT FLAGS ARE FOLDED INTO IT.
			IF .PC[OPR1] EQL CONSTFL THEN
				FIX2NN(.EXPR,.EXPR[ARG2PTR]);
		END;
END;

!MACROS TO CHECK ARGS AND SET VALFLAGS WHEN NEEDED.
MACRO VAL1FX(EXPR)=
	BEGIN
		PA_.EXPR[ARG1PTR];
		IF .PA[OPRCLS] EQL DATAOPR THEN
			EXPR[A1VALFLG]_1;
	END$,

	VAL2FX(EXPR)=
	BEGIN
		PA_.EXPR[ARG2PTR];
		IF .PA[OPRCLS] EQL DATAOPR THEN
			EXPR[A2VALFLG]_1;
	END$,

	VALBFX(EXPR)=
	BEGIN
		VAL1FX(EXPR);
		VAL2FX(EXPR);
	END$;


GLOBAL ROUTINE LOKDEFPT(EXPRNODE)=
BEGIN
	EXTERNAL LOOP,RDCTMP,SKERR;


!LOOK AT ALL LEAVES. EXAMINE THE DEFINITION POINT FOR AN ASSIGNMENT
!OF THAT VARIABLE TO A CONSTANT.  SUBSTITUTE THAT CONSTANT FOR THE
!VARIABLE. @ROCESSING IS DONE IN MOORE FLOOD ORDER. THIS HOPEFULLY
!INSURES THAT ALL PROPAGATIONS WHICH CAUSE OTHER PROPAGATIONS ARE CAUGHT

REGISTER PEXPRNODE EXPR;
LOCAL BASE PA;
LOCAL WHATSUP;
EXPR_.EXPRNODE;


	!INITIALIZE THE LOCAL THAT WILL TELL US IF PROPAGATION
	!DID ACTUALLY DID OCCUR.
	!FOR EACH OPERCLASS THE ARGS ARE EXAMINED.
	!CONS1DEF AND CONS2DEF RETURN A 1 IF A PROPAGATION
	!OCCURRED AND A 0 OTHERWISE. IN ALL CASES WE WAIT TO
	!FOLD UNTIL BOTH ARGS HAVE BEEN EXAMINED. THIS IS DONE
	!FOR TWO REASONS:
	!	1. THE NODE MIGHT CHANGE FORM IN THE MIDDLE
	!	2.IT SHOULD BE FASTER IF ONLY ONE PROPAGATES

	WHATSUP_0;

	!GET OUT IF ITS NOT AN EXPRESSION

	IF .EXPR[OPRCLS] EQL DATAOPR THEN RETURN(.EXPR);

	!HANDLE THE CASE WHERE THEY ARE ALEEADY BOTH CONSTANTS
	!AND FOR SOME REASON HAVE NOT BEEN *LOCALLY* FOLDED

	IF .EXPR[A1VALFLG] THEN
	BEGIN
		PA_.EXPR[ARG1PTR];
		IF .PA[OPR1] EQL CONSTFL THEN
			IF .EXPR[A2VALFLG] THEN
			BEGIN
				PA_.EXPR[ARG2PTR];
				IF .PA[OPR1] EQL CONSTFL THEN
				BEGIN
					EXPR_FOLDER(.EXPR);
					RETURN(.EXPR);
				END;
			END;
	END;

	CASE .EXPR[OPRCLS] OF SET
	!BOOLEAN
	BEGIN
		IF NOT .EXPR[A1VALFLG] THEN
		BEGIN
			EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
		END;
		IF .EXPR[A1VALFLG] THEN
			WHATSUP_CONS1DEF(.EXPR);

		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END;

	!DATAOPR
		SKERR();

	!RELATIONAL
	BEGIN
		IF NOT .EXPR[A1VALFLG] THEN
		BEGIN
			EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
		END;
		IF .EXPR[A1VALFLG] THEN
			WHATSUP_CONS1DEF(.EXPR);

		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END;

	!FNCALL
	BEGIN
		EXTERNAL SETPVAL;
		!THIS IS VERY SAD. IF A LIBRARY FUNCTION, IT
		!COULD BE MOVED TO PROGRAM ENTRY, BUT ARGLISTS
		!HAVE NO RROM FOR DEFINITION POINT INFO.
		!WE WILL TRY FOR A CONSTANT ARGUMENT
		!THIS WILL APPLY ONLY (MOST PROBABLY) TO BENCHMARKS

			LOCAL ARGUMENTLIST AG;
			AG_.EXPR[ARG2PTR];

		!FOR A LIBRARY FUNCTION OF ONE ARGUMENT
		IF .EXPR[OPERSP] EQL LIBARY AND .LOOP NEQ 0  THEN
		BEGIN
			IF .AG[ARGCOUNT] EQL 1 THEN
			BEGIN
				REGISTER BASE TMP;
				TMP_.AG[1,ARGNPTR];
				IF .TMP[OPR1] EQL CONSTFL THEN
				BEGIN
					EXTERNAL GETOPTEMP;
					OWN BASE FRONT:STMT;
					!SET VAL FLG ON OLD PARENT
					SETPVAL(.EXPR);
					FRONT_.SORCPTR<LEFT>;	!FIRST STATEMENT OF PROG
					!THIS COULD BE AN ENTRY FOR A SUBPROGRAM
					STMT_.FRONT[SRCLINK];
					WHILE .STMT[SRCID] EQL ENTRID DO
					BEGIN
					FRONT_.STMT;	!DEFINE
					!FRONT AS THE ENTRY STATEMENT
					STMT_.STMT[SRCLINK];
					END;
					NAME<LEFT>_ASGNSIZ + SRCSIZ;
					STMT_CORMAN();
					STMT[OPRCLS]_STATEMENT;
					STMT[OPERSP]_ASGNID;
					STMT[A1VALFLG]_1;
					!USE .O INSTEAD OF .R (TO GET CORRECT
					! TYPE INFORMATION)
					TMP_STMT[RHEXP]_.EXPR;
					STMT[LHEXP]_GETOPTEMP(.TMP[VALTYPE]);
					!SET THE NEW PARENT OF THE FUNCTION CALL
					EXPR[PARENT]_.STMT;
					STMT[SRCLINK]_.FRONT[SRCLINK];
					FRONT[SRCLINK]_.STMT;
					RETURN(.STMT[LHEXP]);
				END;
			END;
		END;
		!ZERO ANY DEFINITION POINTS ON EXPRESSION ARGS
		!THE CHEAPEST WAY (CODE SIZE-WISE) IS TO CALL
		!LOKDEF

		INCR I FROM 1 TO .AG[ARGCOUNT] DO
		BEGIN
			LOCAL BASE TMP1;

			TMP1_.AG[.I,ARGNPTR];	!LOOK AT ARG
			IF .TMP1[OPRCLS] NEQ DATAOPR THEN
			AG[.I,ARGNPTR]_LOKDEFPT(.TMP1);
		END;
		RETURN(.EXPR);
	END;

	!ARITHMETIC
	BEGIN
		IF NOT .EXPR[A1VALFLG] THEN
		BEGIN
			EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
		END;
		IF .EXPR[A1VALFLG] THEN
			WHATSUP_CONS1DEF(.EXPR);

		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
		IF .EXPR[OPR1] EQL MULOPF THEN
		EXPR_REDUCE(.EXPR);
	END;

	!TYPECNV
	BEGIN
		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END;

	!ARRAYREF
	BEGIN
		IF .EXPR[A2VALFLG] THEN
		BEGIN
			IF .EXPR[ARG2PTR] NEQ 0 THEN
				WHATSUP_CONS2DEF(.EXPR);
		END
		ELSE
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;

		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END;

	!CMNSUB
		RETURN(.EXPR);

	!NEGNOT
	BEGIN
		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END;

	!SPECOP
	BEGIN

		EXTERNAL INDVARR;

		IF NOT .EXPR[A1VALFLG] THEN
		BEGIN
			EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
		END;
		IF .EXPR[A1VALFLG] THEN
			WHATSUP_CONS1DEF(.EXPR);

		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
		!POTEATIALLY REDUCE IT
		IF (.EXPR[OPR1] EQL P2MULOPF) OR (.EXPR[OPR1] EQL P2PL1OPF) THEN
		IF (.EXPR[VALTP1] EQL INTEG1) AND (.EXPR[ARG1PTR] EQL .INDVAR) THEN
		IF EXTSIGN(.EXPR[ARG2PTR]) GTR 0 THEN
			EXPR_REDUCE(.EXPR);
	END;

	!FIELDREF
		RETURN(.EXPR);

	!STORECLS
		RETURN(.EXPR);

	!RECONTENTS
		RETURN(.EXPR);

	!LABOP
		!ILLEGAL
		RETURN(.EXPR);

	!STATEMENT
		!ILLEGAL
		RETURN(.EXPR);

	!IOLSCLS
		RETURN(.EXPR);
	!INLINFN
	BEGIN
		IF NOT .EXPR[A1VALFLG] THEN
		BEGIN
			EXPR[ARG1PTR]_LOKDEFPT(.EXPR[ARG1PTR]);
		END;
		IF .EXPR[A1VALFLG] THEN
			WHATSUP_CONS1DEF(.EXPR);

		IF .EXPR[ARG2PTR] NEQ 0 THEN
		IF NOT .EXPR[A2VALFLG] THEN
		BEGIN
			EXPR[ARG2PTR]_LOKDEFPT(.EXPR[ARG2PTR]);
		END;
		IF .EXPR[A2VALFLG] THEN
			WHATSUP_.WHATSUP+CONS2DEF(.EXPR);
		IF .WHATSUP GTR 0 THEN EXPR_FOLDER(.EXPR);
	END
	TES;
	!NOW ONCE MORE LOOK AT WHAT HAS BECOME OF THE EXPRESSION
	!AND SET THE VAL FLAGS IF APPROPRIATE. FULL CASE IS NEEDED
	!CAUSE PHASE 1 SEEMS TO HAVE THE NTY HABIT OF LEAVING
	!JUNK IN ARG1 OF NODES THAT SHOULD HAVE ARG1 ZERO.
	CASE .EXPR[OPRCLS] OF SET
	!BOOLEAN
		VALBFX(EXPR);
	!DATAOPR
		BEGIN END;
	!RELATIONAL
		VALBFX(EXPR);
	!FNCALL
		BEGIN END;
	!ARITHMETIC
		VALBFX(EXPR);
	!TYPECNV
		VAL1FX(EXPR);
	!ARRAYREF
		VAL2FX(EXPR);
	!CMNSUB
		BEGIN END;
	!NEGNOT
		VAL2FX(EXPR);
	!SPECOP
		VAL1FX(EXPR);
	!FIELDREF
		BEGIN END;
	!STORECLS
		BEGIN END;
	!REGCONTENTS
		BEGIN END;
	!LABOP
		BEGIN END;
	!STATEMENT
		BEGIN END;
	!IOLSCLS
		BEGIN END;
	!INLINFN
	BEGIN
		VAL1FX(EXPR);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			VAL2FX(EXPR);
	END
	TES;
	RETURN .EXPR
END;

SWITCHES NOSPEC;

!***************************************************


	!DELETE A LOGICAL IF FROM THE FLOW OF CONTROL
	MACRO WIPEOUT(NUMB)=
	BEGIN
		HEAD[SRCID]_CONTID;
		IF .NUMB LSS 0 THEN
		BEGIN
			PB_.HEAD[SRCLINK];
			HEAD[SRCLINK]_.HEAD[LIFSTATE];
			PA_.HEAD[LIFSTATE];
			PA[SRCLINK]_.PB;
		END;
	END$;

ROUTINE ASGNPROP(HEAD)=
BEGIN
	!PROPAGATE STUFF FOR AN ASIGNMENT STATEMENT
	MAP PHAZ2 HEAD;
	LOCAL PHAZ2 PA;
	!THIS REGISTER IS TO PREVENT BLISS GENERATION OF
	!EXCESSIVE LOCALS
	REGISTER TMP;

		!LOOK AT THE LEFT HAND SIDE FIRST.
		!IF IT IS NOT A LEAF TRY TO PROPAGATE  WITH IN THE
		!EXPRESSION.
			IF NOT .HEAD[A1VALFLG] THEN
			BEGIN
				PA_.HEAD[LHEXP];
				!AN ARRAY REF IS ALL THAT IS LEGEL
				!SO WE WILL LOOK ONLY AT ARG2.
				!IF IT IS NOT A LEAF PROPAGATE AND REDUCE

				IF NOT .PA[A2VALFLG] THEN
				BEGIN
					TMP_LOKDEFPT(.PA[ARG2PTR]);
					PA[ARG2PTR]_.TMP;
				END;
				!IT HAS NOT BECOME A LEAF, THEREFOR IT
				!HAS NOT PROPAGATED, SO TRY A REDUCTION.
				IF NOT .PA[A2VALFLG] THEN
				BEGIN
					TMP_REDUCE(.PA[ARG2PTR]);
					PA[ARG2PTR]_.TMP;
				END;
			END;
			!DONE WITH LEFT HAND SIDE. NOW LOOK AT RIGHT HAND SIDE.
			!IF IT IS NOT A LEAF TRY PROPAGATION.
			IF NOT .HEAD[A2VALFLG] THEN
			BEGIN
				TMP_LOKDEFPT(.HEAD[RHEXP]);
				HEAD[RHEXP]_.TMP;
				!IT MAY NOW HAVE BECOME A LEAF. MAKE SURE
				!THAT THE NEG ANF NOT FLGS ARE PICKED UP.
				IF .HEAD[A2VALFLG] THEN
				BEGIN
					PA_.HEAD[RHEXP];
					IF .PA[OPR1] EQL CONSTFL THEN
						ASGNNN(.HEAD);
				END;
			END ELSE
			!IT WAS A LEAF TO BEGIN WITH. PROPAGATE.
				STMTPROP(.HEAD);
END;

GLOBAL ROUTINE PROPAGATE=
!THIS IS THE CONTROLLING ROUTINE FOR CONSTANT PROPAGATION
!AND REDUCTION IN STRENGTH

BEGIN

EXTERNAL  DFCLEANUP;
EXTERNAL IOGPNR;		!WALK I/O LISTS <IOPT>
EXTERNAL BASE LENTRY;
EXTERNAL CHOSEN,GLOBREG,CSTMNT,FOLDAIF,ISN,LOOP,RDUCINIT;
LABEL SELCT;
LOCAL HEAD,PA,PB,PC;
MAP PHAZ2 HEAD:TOP:PC:PA:PB;
MAP BASE CSTMNT;
!THIS REGISTER TO PREVENT BLISS FROM GENERATING EXCESSIVE TEMPS
REGISTER TMP;

!GO THROUGH BUSY LIST TRYING TO PROPAGATE CONSTANTS

!INITIALIZE SPECIAL REDUCTION VARIABLES
RDUCINIT();

HEAD_.TOP;
IF .HEAD[SRCID] EQL DOID THEN
	HEAD_.HEAD[BUSY];

DO
BEGIN
	CSTMNT_.HEAD;
	ISN_.CSTMNT[SRCISN];

	SELCT:
	SELECT .HEAD[SRCID] OF NSET

	ASGNID:
		BEGIN
			ASGNPROP(.HEAD);
		END;

	IFLID: BEGIN
			!LOOK AT THE EXPRESION. IF ITS A LEAF CALL THE
			!STATEMENT PROPAGATION ROUTINE ELSE
			!DO THE REGULAR EXPRESSION PROPRAGATION.
			PA_.HEAD[LIFEXPR];
			IF .PA[OPRCLS] EQL DATAOPR THEN
			STMTPROP(.HEAD) 
			ELSE
			BEGIN
				TMP_LOKDEFPT(.HEAD[LIFEXPR]);
				HEAD[LIFEXPR]_.TMP;
			END;
			!IF THE EXPRESSION HAS BECOME A CONSTANT
			!THEN GET RID OF THE STATEMENT
			PA_.HEAD[LIFEXPR];
			IF .PA[OPR1] EQL CONSTFL THEN
			BEGIN
				!MAKE SURE THAT ANY NEG NOT FLAGS ON THE
				!STATEMENT HAVE BEEN INCLUDED
				IFNN(.HEAD);
![1074] Must reset PA since IFNN may have created a new node with a new type
%[1074]%			PA_.HEAD[LIFEXPR];
				IF .PA[VALTP1] EQL INTEG1 THEN
					WIPEOUT(PA[CONST2])
				ELSE
					WIPEOUT(PA[CONST1]);
			END;
	  END;
	IFAID:	BEGIN
			!EXAMINE THE EXPRESSION.
			PA_.HEAD[AIFEXPR];
			IF .PA[OPRCLS] EQL DATAOPR THEN
			STMTPROP(.HEAD)
			ELSE
			BEGIN
				!ITS NOT A LEAF, TRY PROPAGATION.
				TMP_LOKDEFPT(.HEAD[AIFEXPR]);
				HEAD[AIFEXPR]_.TMP;
				!LOOK AGAIN TO SEE WHAT THE EXPRESSION HAS BECOMEME
			END;
		!IF IT REDUCED TO A CONSTANT, FOLD THE
		!STATEMENT, CUZ THE CONSTANT WILL NOT BE ALLOCATED
		PA_.HEAD[AIFEXPR];
		IF .PA[OPR1] EQL CONSTFL THEN
		BEGIN
			!FIRST MAKE SURE THAT ANY NEG/NOT FLAGS ON THE STATEMENT
			!HAVE BEEN PICKED UP.
			IFNN(.HEAD);
			CSTMNT_.HEAD;
			FOLDAIF();
		END;
		END;
	DOID:
		BEGIN
			!THIS IS AN INNER DO LOOP. LOOK AT THE
			!CONTROL EXPRESSION
			DOPROPAGATE(.HEAD);

			PA_.HEAD[DOLPCTL];
			!IT MAY ALREADY BE A CONSTANT IN WHICH
			!CASE WE WANT TO QUIT WHILE AHEAD
			IF .PA[OPR1] EQL CONSTFL THEN LEAVE SELCT;
			HEAD[DOLPCTL]_LOKDEFPT(.HEAD[DOLPCTL]);
			PA_.HEAD[DOLPCTL];
			IF NOT .HEAD[FLCWD] AND .PA[OPR1] EQL CONSTFL THEN
				STMTPROP(.HEAD);

		END;
	CALLID:
	BEGIN
		!ZERO OPTIMIZERS INFO IN EXPRESSIONS ON LIST.
		!ALSO PROPAGATE CONSTANTS TO EXPRESSIONS ONLY.
		!PROPAGATING CONSTANTS TO VARIABLES IS PRECLUDED
		!BY THE FACT THAT THERE ARE NO DEFINITION POINTS FOR
		!SINGLE VARIABLES ON ARGUMENT LISTS.

		IF .HEAD[CALLIST] NEQ 0 THEN
		BEGIN
			LOCAL ARGUMENTLIST AG;
			LOCAL BASE T1;
			AG_.HEAD[CALLIST];
			INCR I FROM 1 TO .AG[ARGCOUNT] DO
			BEGIN
				T1_.AG[.I,ARGNPTR];
				IF .T1[OPRCLS] NEQ DATAOPR THEN
					AG[.I,ARGNPTR]_LOKDEFPT(.T1);
			END;
		END;
	END;
	READID:	IOGPNR(.HEAD);
	WRITID:	IOGPNR(.HEAD);
	DECOID:	IOGPNR(.HEAD);
	ENCOID:	IOGPNR(.HEAD);
	REREDID:	IOGPNR(.HEAD);
	TESN;
	HEAD_.HEAD[BUSY];
END UNTIL .HEAD EQL 0;
!NOW GO THROUGH ALL THE STATEMENTS CREATED BY THE OPTIMIZER
!THESE ARE NOT IN THE GRAPH

HEAD_.TOP[SRCLINK];
WHILE .HEAD NEQ .BOTTOM DO
BEGIN
	!SKIP OVER STATEEMENTS IN INNER DO LOOPS
	IF .HEAD[SRCID] EQL DOID THEN
	BEGIN
		HEAD_.HEAD[DOLBL];
		!INDIRECT THROUGH THE SYMBOL TABEL TO GET ENDING STATEMENT
		HEAD_.HEAD[SNHDR];
	END ELSE
	IF .HEAD[SRCOPT] EQL 0 THEN
		IF .HEAD[SRCID] EQL ASGNID THEN
			ASGNPROP(.HEAD);
	HEAD_.HEAD[SRCLINK];
	IF .HEAD EQL 0 THEN RETURN;
END;

	!CLEAR DEFPT BITS FROM SYMBOL TABLE EXCEPT FOR .O
	DFCLEANUP();
END;

ROUTINE DEFSUB(NITIONPT,		!DEFINITION POINT
		OLDARG)=		!OLD ARGUMENT FOR RETURNING
BEGIN

!CHECK TO SEE IF THE DEFINITION POINT PASSED IS AN ASSIGNMENT OF
!OLDARG TO A CONSTANT. IF SO, RETURN CONSTANT ELSE
!RETURN OLDARG.

EXTERNAL DNEGCNST;
MAP BASE NITIONPT;
LOCAL INQUEST; MAP BASE INQUEST;

	IF .NITIONPT[SRCID] EQL ASGNID THEN
		IF .NITIONPT[LHEXP] EQL .OLDARG THEN
		BEGIN
			INQUEST_.NITIONPT[RHEXP];
			IF .INQUEST[OPR1] EQL CONSTFL THEN
			BEGIN
				INQUEST_VALCNV(.INQUEST);
				IF .NITIONPT[A2NEGFLG] THEN
				BEGIN
					INQUEST_NEGCNST(INQUEST);
					NITIONPT[A2NEGFLG]_0;
				END;
				IF .NITIONPT[A2NOTFLG] THEN
				BEGIN
					INQUEST_NOTCNST(INQUEST);
					NITIONPT[A2NOTFLG]_0;
				END;
				RETURN(.INQUEST);
			END;
		END;
	.OLDARG
END;

ROUTINE IFNN(STMT)=
BEGIN
	!STMT POINTS TO AN ARITHMETIC OR LOGICAL IF.
	!LIFEXPR OR AIFEXPR HAVE BECOME CONSTANTS.
	!CHECK THE NEG/NOT FLAGS AND FOLD THEM INTO THE CONSTANT.

	MAP BASE STMT;
	LOCAL BASE T1;
			T1_.STMT[LIFEXPR];
			IF .STMT[A1NEGFLG] THEN
			BEGIN
				STMT[LIFEXPR]_NEGCNST(T1);
				STMT[A1NEGFLG]_0;
			END;
			IF .STMT[A1NOTFLG] THEN
			BEGIN
				STMT[LIFEXPR]_NOTCNST(T1);
				STMT[A1NOTFLG]_0;
			END;
END;

ROUTINE ASGNNN(STMT)=
BEGIN
	!STMT IS AN ASIGNMENT STATEMENT.
	!THE RIGHT HAND SIDE IS A CONSTANT. CHECK THE NEG/NOT FLAGS
	!AND FOLD THEM INTO THE CONSTANT.
	MAP BASE STMT;
	LOCAL BASE T1;

			T1_.STMT[RHEXP];
			IF .STMT[A2NEGFLG] THEN
			BEGIN
				STMT[RHEXP]_NEGCNST(T1);
				STMT[A2NEGFLG]_0;
			END;
			IF .STMT[A2NOTFLG] THEN
			BEGIN
				STMT[RHEXP]_NOTCNST(T1);
				STMT[A2NOTFLG]_0;
			END;
END;

ROUTINE STMTPROP(STMT)=
BEGIN
!HANDLES A SINGLE VARIABLE AS A STATEMENT EXPRESSION AND TRIES TO
!PROPAGATE IT IF POSSIBLE
	EXTERNAL CSTMNT,FOLDAIF,DNEGCNST;

MAP PHAZ2 STMT;

SELECT .STMT[SRCID] OF NSET
ASGNID:	BEGIN
		LOCAL BASE PA:PB;
		PA_.STMT[RHEXP];
		IF .PA[OPR1] EQL VARFL THEN
		BEGIN
			IF .STMT[SRCOPT] EQL 0 THEN RETURN;
			PB_.STMT[OPDEF];
			IF .PB EQL 0 THEN RETURN;
			STMT[RHEXP]_DEFSUB(.PB,.STMT[RHEXP]);
			!CHECK FOR NEG AND NOT FLAGS IF IT PROPAGATED
			PA_.STMT[RHEXP];
			IF .PA[OPR1] NEQ CONSTFL THEN RETURN;
			!HERE WE KNOW ITS A CONSTANT
			!CATCH THOSE NASTY LITTLE NEG/NOT FLAGS.
			ASGNNN(.STMT);
		END;
			!RESET VAL FLGS
			PA_.STMT[RHEXP];
			IF .PA[OPRCLS] EQL DATAOPR THEN STMT[A2VALFLG]_1;
	END;

DOID:	BEGIN
		!NUMBER OF TIMES THROUGH A LOOP HAS BECOME A CONSTANT
	!BUT THAT MAY NOT BE MEANINGFUL. ON INNER DO LOOPS
	!THE FLAG NOFLCWDREG (SET BY P2S) SAYS THAT THIS
	!LOOP SHOULD NOT BE AN AOBJN LOOP. THE FLAG WILL BE SET
	!1. THE INDEX VARIABLE WAS AT A TOP LEVEL ARITHMETIC IF
	!2. THE INDEX VARIABLE WAS AT A TOP LEVEL LOGICAL IF
	!3. THE INDEX WAS AN ITEM ON AN I/O (BETTER B O) LIST
	!4. THE INDEX WAS AT A TOP LEVEL COMPUTED GO TO
	!5. THE INDEX WAS ON THE LHS OF AN ASSIGNMENT

		LOCAL BASE PA:PB;
	IF .STMT[INNERDOFLG] AND NOT .STMT[NOFLCWDREG] THEN
	BEGIN
		PA_.STMT[DOLPCTL];
		IF .PA[VALTYPE] EQL INTEGER THEN
			IF ABS(.PA[CONST2]) GEQ 0 AND ABS(.PA[CONST2]) LEQ #377777
			 AND .STMT[SSIZONE] THEN
			BEGIN
				PB_.STMT[DOM1];	!INITIAL VALUE
				IF .PB[VALTYPE] EQL INTEGER AND .PB[OPR1] EQL CONSTFL THEN
				IF .PB[CONST2] GEQ 0 AND .PB[CONST2] LEQ #377777 THEN
				BEGIN
				STMT[SSIZONE]_0;
				STMT[FLCWD]_1;
				STMT[DOLPCTL]_MAKECNST(INTEGER,0,
						-(ABS(.PA[CONST2]))^18+.PB[CONST2]);
					RETURN(1);
				END;
			END;
	END;
		RETURN(0);
	END;
IFLID:	BEGIN
		LOCAL BASE PA:PB;
		EXTERNAL FOLDLIF,CSTMNT;
		PA_.STMT[OPDEF];
		IF .PA EQL 0 THEN RETURN;
		STMT[LIFEXPR]_DEFSUB(.PA,.STMT[LIFEXPR]);
		PB_.STMT[LIFEXPR];
		IF .PB[OPR1] NEQ CONSTFL THEN RETURN;
		!FIRST CHECK FOR NOT FLG AND NEG FLG
			IFNN(.STMT);
			PB_.STMT[LIFEXPR];
		PA_.STMT[LIFSTATE];	!SAVE FOR LATER
		CSTMNT_.STMT;
		FOLDLIF();
		!THE OPTIMIZER WILL TRY TO BE CLEVEL
		!LIFSTATE WILL BE EXAMINED. IF IT IS AN UNCONDITIONAL BRANCH
		!WE WILL DELETE ALL DEAD CODE UP TO THE NEXT LABELED
		!STATEMENT.
		!A COMPUTED GO TO IS NOT CONSIDIERED AN UNCONDITIONAL
		!BRANCH BECAUSE IT MAY GO TO THE NEXT STATEMENT IF THE
		!VALUE OF THE VARIABLE IS OUT OF RANGE
		!REMEMBER PA IS A POINTER TO THE STATEMENT IN QUESTION

		IF .PA[SRCID] EQL GOTOID OR .PA[SRCID] EQL AGOID THEN
		BEGIN
			PB_.PA[SRCLINK];
			WHILE .PB[SRCLBL] EQL 0 DO
			BEGIN
				PB_.PB[SRCLINK];
			END;
			PA[SRCLINK]_.PB;
		END;
	END;

IFAID:	BEGIN
		LOCAL BASE PA:PB;
		PA_.STMT[OPDEF];
		IF .PA EQL 0 THEN RETURN;
		STMT[AIFEXPR]_DEFSUB(.PA,.STMT[AIFEXPR]);
		PB_.STMT[AIFEXPR];
		IF .PB[OPR1] NEQ CONSTFL THEN RETURN
		!FIRST CHECK FOR NOT FLG AND NEG FLG
		IFNN(.STMT);
		CSTMNT_.STMT;
		FOLDAIF();
	END;
TESN;
END;

MAP PEXPRNODE INDVAR:LENTRY:LEND;
FORWARD PROPCASE;
ROUTINE BUNCHPROP(STMT)=
BEGIN
	!STARTING AT STATEMENT STMT LEAFSUBSTITUTE
	!ITEMS IN THE VECTORS (ITMCT SET UP
	!PRIOR TO CALL) THEN USE THE PROPAGATION ROUTINES
	!TO FOLD THE PROPAGTED CONSTANTS

	EXTERNAL CSTMNT,ISN,SPECCASE,LOWLIM;
	EXTERNAL FOLDLIF,FOLDAIF,LOKDEFPT;

	MAP BASE STMT:CSTMNT;

	SPECCASE_0;
	LOWLIM_1;
	WHILE .STMT NEQ 0 DO
	BEGIN
		CSTMNT_.STMT;
		ISN_.CSTMNT[SRCISN];
		PROPCASE(.STMT);
		STMT_.STMT[SRCLINK];
	END;
END;

ROUTINE PROPCASE(STMT)=
BEGIN
	!CONROL FOR PROPAGATION AND FOLDING OF DOT O VARS

	EXTERNAL LEAFSUBSTITUTE,IOSUBSTITUTE,DOVARSUBSTITUTE,
	MISCIO,SWAPEM,FOLDLIF,FOLDAIF;

	MAP BASE STMT;

	REGISTER BASE T;

	CASE .STMT[SRCID] OF SET

	%ASSIGNMENT%
		BEGIN
			IF NOT .STMT[A1VALFLG] THEN
			BEGIN
				LEAFSUBSTITUTE(.STMT[LHEXP]);
				STMT[LHEXP]_LOKDEFPT(.STMT[LHEXP]);
			END;
			LEAFSUBSTITUTE(.STMT[RHEXP]);
			STMT[RHEXP]_LOKDEFPT(.STMT[RHEXP]);
%[1104]%		T_.STMT[RHEXP];
%[1104]%		IF .T[OPR1] EQL CONSTFL THEN
%[1104]%			ASGNNN(.STMT)	!CATCH NEG/NOT NASTIES
		END;

	%ASSIGN%
		BEGIN END;

	%CALL%
		BEGIN
			LOCAL BASE TMP;
			LOCAL ARGUMENTLIST AG;

			IF (AG_.STMT[CALLIST]) NEQ 0 THEN
			BEGIN
				INCR I FROM 1 TO .AG[ARGCOUNT] DO
				BEGIN
					TMP_.AG[.I,ARGNPTR];
					IF .TMP[OPRCLS] EQL LABOP THEN
					ELSE
					IF .TMP[OPRCLS] EQL DATAOPR THEN
						AG[.I,ARGNPTR]_SWAPEM(.TMP)
					ELSE
						LEAFSUBSTITUTE(.TMP);
				END;
			END;
		END;

	%CONTINUE%
		BEGIN END;

	%DO%
		DOVARSUBSTITUTE(.STMT);


	%ENTRY%
		BEGIN END;

	%COMNSUB%
		BEGIN END;

	%GO TO%
		BEGIN END;

	%ARITHMETIC GO TO%
		BEGIN END;

	%COMPUTED GO TO%
		BEGIN END;

	%ARITHMETIC IF%
		BEGIN
			LEAFSUBSTITUTE(.STMT[AIFEXPR]);
			STMT[AIFEXPR]_LOKDEFPT(.STMT[AIFEXPR]);
			T_.STMT[AIFEXPR];
			IF .T[OPR1] EQL CONSTFL THEN
			BEGIN
				IFNN(.STMT);
				FOLDAIF();
			END;
		END;

	%LOGICAL IF%
		BEGIN
			EXTERNAL CSTMNT;
			LEAFSUBSTITUTE(.STMT[LIFEXPR]);
			CSTMNT_.STMT[LIFSTATE];
			PROPCASE(.CSTMNT);
			CSTMNT_.STMT;
			STMT[LIFEXPR]_LOKDEFPT(.STMT[LIFEXPR]);
			T_.STMT[LIFEXPR];
			IF .T[OPR1] EQL CONSTFL THEN
			BEGIN
				IFNN(.STMT);
				FOLDLIF();
			END;
		END;

	%RETURN%
		IF .STMT[RETEXPR] NEQ 0 THEN LEAFSUBSTITUTE(.STMT[RETEXPR]);

	%STOP%
		BEGIN END;

	%READ%
		BEGIN
			MISCIO(.STMT);
			T_.STMT[IOLIST];
			WHILE .T NEQ 0 DO
			BEGIN
				IOSUBSTITUTE(.T);
				T_.T[CLINK];
			END;
		END;

	%WRITE%
		BEGIN
			MISCIO(.STMT);
			T_.STMT[IOLIST];
			WHILE .T NEQ 0 DO
			BEGIN
				IOSUBSTITUTE(.T);
				T_.T[CLINK];
			END;
		END;

	%DECODE%
		BEGIN
			MISCIO(.STMT);
			T_.STMT[IOLIST];
			WHILE .T NEQ 0 DO
			BEGIN
				IOSUBSTITUTE(.T);
				T_.T[CLINK];
			END;
		END;


	%ENCODE%
		BEGIN
			MISCIO(.STMT);
			T_.STMT[IOLIST];
			WHILE .T NEQ 0 DO
			BEGIN
				IOSUBSTITUTE(.T);
				T_.T[CLINK];
			END;
		END;


	%REREAD%
		BEGIN
			MISCIO(.STMT);
			T_.STMT[IOLIST];
			WHILE .T NEQ 0 DO
			BEGIN
				IOSUBSTITUTE(.T);
				T_.T[CLINK];
			END;
		END;

	%FIND%		BEGIN END;

	%CLOSE%		BEGIN END;

	%INPUT% 	BEGIN END;
	%OUTPUT%	BEGIN END;
	%BACKSPACE%	BEGIN END;
	%BACK FILE%	BEGIN END;
	%REWIND%	BEGIN END;
	%SKIP FILE%	BEGIN END;
	%SKIPRECORD%	BEGIN END;
	%UNLOAD%	BEGIN END;
	%RELEASE%	BEGIN END;
	%END FILE%	BEGIN END;
	%END%		BEGIN END;
	%PAUSE%		BEGIN END;
	%SFN%		BEGIN END;
	%OPEN%		BEGIN END

	TES;
END;

ROUTINE ELIGIBLE(LNODE,RNODE)=
BEGIN
	!CHECK LNODE AND RNODE
	!FOR THE FOLLOWING COMBINATIONS WE WISH TO
	!"PROPAGATE":
	!	LNODE		RNODE
	!	_____		_____
	!
	!	.O NOT FROM .R	ANY DATAOPR
	!	.S		.O
	!	.I		.O

	MAP BASE LNODE:RNODE;

	!QUIT QUICK IF WE ARE NOT EVEN DEALING WITH
	!DATA ITEMS

	IF .LNODE[OPRCLS] NEQ DATAOPR THEN RETURN;
	IF .RNODE[OPRCLS] NEQ DATAOPR THEN RETURN;

	!CHECK .O ON LEFT HAND SIDE

	!CAN'T PROPAGATE .O IF IT CAME FROM A .R
	IF .LNODE [IDDOTO] EQL SIXBIT ".O"
	  THEN
	    IF .LNODE [ORFIXFLG]
	      THEN RETURN 0
	      ELSE RETURN 1;

	!CHECK .O ON RIGHT WITH OTHERS SPECIFICALLY ON LEFT
	IF .RNODE[IDDOTO] EQL SIXBIT".O" THEN
		IF .LNODE[IDDOTO] EQL SIXBIT".I"
		   OR
		   .LNODE[IDDOTO] EQL SIXBIT".S" THEN
			RETURN 1;
	0
END;

GLOBAL ROUTINE DOTOPROPAGATE=
BEGIN
	!ROUTINE TO CAUSE .O VARIABLES TO PROPAGATE THROUGHOUT
	!THE PROGRAM UNIT

	EXTERNAL VERYFRST,GLOBREG,CHOSEN,PREV,ITMCT;

	OWN GOTSUM,STMT,OLDSTMT,HEAD;

	MAP BASE STMT:PREV;

		!*!*!*!*!*!*!*!*!*!*START OF LOCAL ROUTINE!*!*!*!*!*!*!
		ROUTINE RUBOUT(STSUB)=
		BEGIN
				!STSUB IS THE STATEMENT AT WHICH
				!TO START THE SUBSTITUTION SHOULD WE
				!HAVE TO

				LABEL SETCHOSEN;
				EXTERNAL SAVSPACE;

				REGISTER BASE RHNOD:LHNOD;
				RHNOD_.STMT[RHEXP];
				LHNOD_.STMT[LHEXP];

				!MAKE THE STATEMENT A CONTINUE
				!IF RHNOD=LHNOD AND THERE ARE NO
				!$%&#' NEG OR NOT FLAGS SET

				IF .RHNOD EQL .LHNOD THEN
				BEGIN
					IF (.STMT[A1NGNTFLGS] EQL 0)
					   AND
					   (.STMT[A2NGNTFLGS] EQL 0)
					THEN
						STMT[SRCID]_CONTID;
				END ELSE

				!IS LEFT HAND .O AND
				!RIGHT HAND CONSTANT
				!ALSO CHECK THE %&$#" NEG/NOTS AGAIN
				IF ELIGIBLE(.LHNOD,.RHNOD)
				AND (.STMT[A1NGNTFLGS] EQL 0)
				AND (.STMT[A2NGNTFLGS] EQL 0) THEN
				BEGIN

					!DO NOT ALLOCATE THE .O VARIABLE
					!AND REMOVE THE ASSIGNMENT FROM THE
					!LOOP
					LHNOD[IDATTRIBUT(NOALLOC)]_1;
![661] IF THE STATEMENT IS LABELED, TRY TO MOVE THE LABEL TO THE
![661] NEXT STATEMENT; OTHERWISE MAKE IT A CONTINUE.
%[661]%					IF .STMT[SRCLBL] NEQ 0 THEN
%[661]%					BEGIN	!TRY TO REMOVE THE LABEL
%[661]%						LOCAL BASE NXTSTMT;
%[661]%						NXTSTMT_.STMT[SRCLINK];
%[661]%						IF .NXTSTMT[SRCLBL] NEQ 0 THEN !BOTH LABELED
%[661]%						STMT[SRCID]_CONTID !NO LUCK, JUST MAKE CONTINUE NODE
%[661]%						ELSE (NXTSTMT[SRCLBL]_.STMT[SRCLBL];
%[661]%							STMT[SRCLBL]_0)
%[661]%					END;
%[661]%
%[661]%					IF .STMT[SRCLBL] EQL 0 THEN !RECLAIM SPACE AND RELINK
%[661]%					BEGIN
%[661]%						PREV[SRCLINK]_.STMT[SRCLINK];
%[661]%
%[661]%						!GIVE BACK THE SPACE FOR THE ASSIGNMENT
%[661]%						SAVSPACE(ASGNSIZ+SRCSIZ-1,.STMT);
%[661]%						STMT_.PREV
%[661]%					END;

					!QUEUE THE INFO IN THE SUBSTITUTION
					!VECTORS
					GLOBREG[.HEAD]_.LHNOD;
					SETCHOSEN:
					BEGIN
						INCR I FROM 1 TO .HEAD DO
						BEGIN
							IF .GLOBREG[.I] EQL
							.RHNOD THEN
							BEGIN
								CHOSEN[.HEAD]_.CHOSEN[.I];
								LEAVE SETCHOSEN
							END
						END;
						CHOSEN[.HEAD]_.RHNOD
					END;

					!IF THE QUEUE IS FULL PROCESS IT
					IF .HEAD EQL 15 THEN
					BEGIN
						GOTSUM_1;
						ITMCT_15;
						OLDSTMT_.STMT;
						BUNCHPROP(.STSUB);
						HEAD_1;
					END ELSE
						HEAD_.HEAD+1;
				END;	!LINKING AND QUING
		END;

		!*!*!*!*!*!*!*!*!*!END OF LOCAL ROUTINE!*!*!*!*!


	!FIRST CHECK TO BE SURE THERE WERE ANY .O VARIABLES AT ALL

	IF .VERYFRST EQL 0 THEN RETURN;

	DOTOHFLG_1;

	!SET UP ITERATION CONTROL

	GOTSUM_1;

	WHILE .GOTSUM DO
	BEGIN
%[775]%		OLDSTMT_0;	! Reset pointer for each pass
		GOTSUM_0;
		HEAD_1;

		PREV_STMT_.SORCPTR<LEFT>;

		!FOR ALL STATEMENTS
		WHILE .STMT NEQ 0 DO
		BEGIN
			!IS IT AN ASSIGNMENT
			IF .STMT[OPRS] EQL ASGNOS 
			THEN
			BEGIN
				RUBOUT(IF .OLDSTMT EQL 0 
					THEN	.SORCPTR<LEFT> 
					ELSE	.OLDSTMT
					);
			END
			ELSE	
%1447%			BEGIN	!Its an assignment
				!CHECK FOR AN I/O AND WALK THE I/O LIST
%1447%				IF .STMT[OPRS] GEQ READOS THEN
%1447%				IF .STMT[OPRS] LEQ REREDOS THEN
%1447%				IF .STMT[IOLIST] NEQ 0
%1447%				THEN
				BEGIN
					LOCAL OPREV,OOLD,OSTMT;

					!SAVE CONTROLLING POINTERS
					OPREV_.PREV;
					OSTMT_.STMT;
					!NEED TO SAVE THIS CUZ WE CANNOT
					!COPE WITH REMAINDERS THAT COULD
					!POTENTIALLY START IN THE MIDDLE OF 
					!AN I/O LIST
					OOLD_.OLDSTMT;
	
					!SET UP POINTERS ON I/O LIST
					PREV_.STMT[IOLIST];
					STMT_.PREV[CLINK];

					!EXAMINE I/O LIST
					WHILE .STMT NEQ 0 DO
					BEGIN
						IF .STMT[OPRS] EQL ASGNOS THEN
							RUBOUT(
							IF .OOLD EQL 0 THEN
							.SORCPTR<LEFT> ELSE
							.OOLD);
						PREV_.STMT;
						STMT_.STMT[SRCLINK];
					END;

					!RESTORE OLD POINTERS
					PREV_.OPREV;
					STMT_.OSTMT;
					OLDSTMT_.OOLD;
				END;

%1447%			END;	!Its an assignment

			PREV_.STMT;
			STMT_.STMT[SRCLINK];
		END;		!WHILE ON STMT
		!ARE THERE SOME LEFT IN THE QUEUE ALTHOUGH WE HAVE LOOKED
		!AT THE WHOLE PROGRAM

		IF .HEAD NEQ 1 THEN
		BEGIN
			!MAKE SURE WE GO AROUND AGAIN TO
			!.OX=.OX IF NOTHING ELSE
			GOTSUM_1;
			ITMCT_.HEAD-1;
			BUNCHPROP(IF .OLDSTMT EQL 0 THEN .SORCPTR<LEFT> ELSE .OLDSTMT);
		END;
	END;	!WHILE ON GOTSUM
	DOTOHFLG_0;
END;	!DOTOPROPAGATE

END 
ELUDOM