Google
 

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

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1983
!AUTHOR: NORMA ABEL/HPWD/DCE/SJW/JNG/EGM/EDS/AHM

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

!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND TSTRV = 7^24 + 0^18 + #1505;	! Version Date:	9-Dec-82

%(

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

25	-----	-----	REFER TO GLOBAL RDCLNK
26	-----	-----	SET A2VALFLG IN REDUCTION INITIALIZATION IF
			REQUIRED
27	-----	-----	RESET INDVAR IN SUPPLANT
28	-----	-----	FIX REDUCE TO LOOK FOR TRANSMOGRIFIED VARIABLES
			ON I/O LISTS IN THE LOOP
29	-----	-----	FIX SUPPLANT SO THAT IF RINCR IS LABELED
			WE DO NOT THROW THE LABEL AWAY
30	-----	-----	FIX REDUCE TO MOVE A LABEL ON A REDUCTION
			ASSIGNMENT BACK TO OTHER REDUCTIONS
31	-----	-----	ADD TEST ON DOTOHFLG TO REDUCE
32	-----	-----	REDUCE P2 ADN P2+1 OPS
33	-----	-----	FIX SUPPLANT TO CORRECTLY INITIALIZE AN
			INCREMENT TEMPORARY FOR A REPLACED INDEX
34	-----	-----	FIX REDUCE NOT TO REDUCE .O TEMPS WITHIN THE 
			CURRENT LOOP AND TO SAVSPACE THE REDUCED EXPRS.
35	-----	-----	MAKE LOKINDVAR A GLOBAL ROUITNE TO BE CALLED FROM
			HAULASS
36	-----	-----	MAKE REDUCE DEAL WITH THE NEG/NOT FLAGS
			WHEN MAKING THE INITIALIZATIONS.
37	-----	-----	MAKE SUPPLANT AWARE OF THE NEG/NOT FLAGS
			SET BY PATCH 36
38	-----	-----	CAUSE REDUCE TO INSERT THE .R INITILAIZATION
			AFTER OTHER OPTIMIZER STATEMENTS IF THE
			REDUCTION CONSTANT IS NOT A NUMERIC CONSTANT
39	-----	-----	[EXPLITIVE DELETED] TBLSEARCH TAKES THE VARIABLE TYPE
			OUT OF THE GLOBAL SYMTYPE. MAKE SURE THAT
			RDCTMP SETS THE GLOBAL.
40	-----	-----	REDUCTION ANDTESTREPLACEMENT ARE
			LOSING ON NEGATIVE STEP SIZES.
41	-----	-----	LOOKING AT ARGUMENT LISTS IS LOSING
			CUZ IT DOES NOT LOOK AT ANY BUT THE FIRST
			ARG.
42	-----	-----	LOKINDVAR SHOULD BE ORING RESULTS
			NOT ADDING THEM CUZ SOME TRUES ARE 1 AND SOME
			ARE -1.
43	-----	-----	DO NOT TESTREPLACE A FORMAL VARIABLE DO LOOP INDEX
			IF THE LOOP CONTAINS A RETURN
44	-----	-----	TRANSMOGRIFIED .O VARIBALES ON I/O LISTS
			THAT ARE BRANCHES OF A LOGICAL IF ARE LOSING
45	276	-----	MAKE SURE THE NEGFLG ON A REPLACEMENT GETS SET ON
			AN EXPRESSION NODE AND NOT A DATAOPR
46	321	17005	SCAN FOR THE INDUCTION VARIABLE IN OPEN/CLOSE, (JNT)
47	346	17928	PASS RETURN INFORMATION TO OUTER DO LOOPS ,(DCE)
48	354	18015	DECREMENT LABEL COUNT CORRECTLY (BY 1), (DCE)
49	370	17938	FIX MOTION PLACE FOR .R VARIABLES, (DCE)
50	VER5	-----	KEEP .R USE CNT IN 2ND WORD OF RDCLST ,(SJW)
			GLOBAL ROUTINE DOTRCNTOK
			.R DEFPT <- 0 IF IN + EXPR
			              .TOP ELSE
51	456	QA784	GIVE FINDTHESPOT 2ND PARAM = TOP IN REDUCE ,(SJW)
52	500	20818	ONLY COMPARE SRCID TO READID IN REDUCE IF
			OPRCLS EQL STATEMENT (COULD BE IOLSCLS). ,(JNG)
53	501	21113	DON'T REDUCE .O'S IF NOT IN AN INNER DO LOOP. ,(JNG)

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

54	577	22352	IF DO LOOP MATERIALIZATION NEEDED, NO TEST
			REPLACEMENT IS POSSIBLE FOR LOOP INDEX ,(DCE)
55	605	23478	REDUCE MUST BE MORE CAREFUL WITH SPECOPS, (DCE)

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

56	773	EGM	12-Jun-80	14234
	Always set def point for reduced expression to TOP, and add reduction
	variable to DOCHNGL list to prevent assignment motion out of the loop.

57	1011	DCE	7-Sep-80	-----
	Allow TESTREPLACEMENT in implied loops (fix edit 577)

58	1012	DCE	7-Sep-80	-----
	If SPECOP, attempt reduction in strength only if type is integer.

59	1023	DCE	6-Nov-80	-----
	Fix edit 1012 - allow type index (of arrays) as well as integer.
	This makes edit 1011 work again!

60	1057	EDS	10-Mar-80	Q20-01410
	Fix LOKINDVAR to check initial value, upper limit, step size 
	and loop control for DO loops.

61	1110	EGM	15-Jul-81	--------
	Do not attempt to update the DOCHNGL list for implied DO lists.
	Refer to edit 773.

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

62	1462	DCE	20-Jan-82	-----
	Prevent Testreplacement of DO loop variables if F77 specified.  This
	is because the loop variable ALWAYS needs to retain its value after
	the loop is executed.  We simply cannot do a full reduction in
	strength replacement.

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

1166	CDM	9-Dec-82
	Enlarge RCDLST by 1.

1505	AHM	13-Mar-82
	Make RDCTMP set the psect index for temps it creates to PSDATA
	so that the variables go into .DATA.

ENDV7

)%

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


FORWARD LOKINDVAR;

OWN
 	RDCCNT, 
%1166%	RDCLST [19];

EXTERNAL
	CORMAN,
	MAKPR1,
	BASE RDCLNK,
	TBLSEARCH,
	UNFLDO;

GLOBAL ROUTINE TESTREPLACE=
BEGIN
	!DRIVE ROUTINE LOKINDVAR TO EXAMINE
	!ALL SATEMENTS BETWEEN TOP AND BOTTOM FOR
	!REMAINING REFERENCES TO INDVAR
	!ONE OF THREE VALUES IS RETURNED
	!0	NO TEST REPLACEMENT IS POSSIBLE. THAT IS, REFERENCES
	!	TO THE DO LOOP INDEX REMAIN
	!1	A UNIQUE TEST REPLACEMENT IS POSSIBLE
	!2	A NON-UNIQUE TEST REPLACEMENT IS POSSIBLE


	EXTERNAL RDCCT,LPRDCCT,TOP,CSTMNT,BOTTOM,INDVAR;

	MAP BASE TOP:CSTMNT:INDVAR;

!**;[1462], TESTREPLACE @3902, DCE, 20-Jan-82
	![1462] No test replacement is possible if F77 specified.  The
	![1462] loop variable ALWAYS needs to be made available.

%1462%	IF F77 THEN RETURN 0;	! No test replacement possible

	!IF THE DO LOOP INDEX IS A FORMAL AND THE LOOP
	!CONTIANS A RETURN THAN DO NOT TESTREPLACE IT.

	IF .INDVAR[FORMLFLG] AND .TOP[HASRTRN] THEN RETURN;

	!IF LOOP INDEX IS MARKED FOR MATERIALIZATION (DUE TO A CALL
	! STATEMENT IN THE LOOP FOR INSTANCE), THEN NO TEST REPLACEMENT
	! IS POSSIBLE, SO WE SHOULD JUST GET OUT HERE.
![1011] IF IN AN IMPLIED LOOP, IGNORE NEDSMATRLZ AND MATRLZIXONLY
%[1011]% IF NOT .IMPLDO THEN
	IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN RETURN;

	IF .INDVAR NEQ 0 THEN
	BEGIN
		CSTMNT_.TOP;
		DO
		BEGIN
			IF LOKINDVAR(.CSTMNT) NEQ 0  THEN RETURN 0;
			IF .CSTMNT[SRCID] EQL IFLID THEN
				IF LOKINDVAR(.CSTMNT[LIFSTATE]) THEN RETURN 0;

			!WHILE WALKING THE DO LOOPS, PASS OUT INFORMATION
			! ABOUT ANY INNER RETURN STATEMENTS TO OUTER DO LOOPS
			IF .CSTMNT[SRCID] EQL DOID
				THEN IF .CSTMNT[HASRTRN]
				THEN BEGIN
					TOP[HASRTRN]_1; !SET OUTER FLAG
					IF .INDVAR[FORMLFLG] THEN RETURN 0;
					!FORCE MATERIALIZATION OF INDEX
				     END;
			CSTMNT_.CSTMNT[SRCLINK];
		END UNTIL .CSTMNT EQL .BOTTOM;
	END;
	!THERE ARE NO REFERENCES TO THE DO LOOP INDEX

	!SEE IF THE REDUCTION VARIABLE IS UNITQE TO THIS LOOP
	!IF THERE WAS ONLY ONE REDUCTION THE TEST REPLACEMENT IS UNIQUE
	!SO RETURN 1 ELSE RETURN 2
	IF .LPRDCCT EQL .RDCCT-1 THEN RETURN 1 ELSE RETURN 2;
END;
GLOBAL ROUTINE LOKINDVAR(STMNT)=
BEGIN

	!ROUTINE WILL DETERMINE IF STMNT CONTAINS A REFERENCE TO
	!THE DO LOOP INDEX. IT RETURNS 0 IF NOT 1 IF IT DOES

	EXTERNAL CONTVAR,INDVAR;

	MAP BASE STMNT;


	!UTILITY MACROS AND ROUTINES

	MACRO CONTUNIT=
		(CONTVAR(.STMNT[IOUNIT],.INDVAR))$;

	ROUTINE IOLOK(STMNT)=
	BEGIN

		MAP BASE STMNT;
		LOCAL SUM,TMP;
		MAP BASE TMP;

		SUM_0;
			TMP_.STMNT[IOLIST];
			WHILE .TMP NEQ 0 DO
			BEGIN
				IF .TMP[OPRCLS] EQL STATEMENT THEN
					SUM_.SUM OR LOKINDVAR(.TMP)
				ELSE
				SUM_.SUM OR CONTVAR(.TMP,.INDVAR);
				TMP_.TMP[CLINK];
			END;
			SUM_.SUM OR CONTUNIT;
			IF .STMNT[IORECORD] NEQ 0 THEN
				SUM_.SUM OR CONTVAR(.STMNT[IORECORD],.INDVAR);
		.SUM
	END;

	ROUTINE OPCLOLOK(STMNT)=	! ROUTINE ADDED FOR OPEN/CLOSE
	BEGIN
		MAP BASE STMNT;
		LOCAL SUM;	! NON-ZERO IF INDVAR IS USED
		SUM_CONTUNIT;	! SEE IF USED AS UNIT
		IF .STMNT[OPSIZ] NEQ 0 THEN	! IF ANY OTHER ARGS
		BEGIN	!  THEN SCAN THEM TOO
			LOCAL OPENLIST ARVALLST;
			ARVALLST_.STMNT[OPLST];	! GET ADDRESS OF LIST
			INCR I FROM 0 TO (.STMNT[OPSIZ]-1) DO	! LOOK AT ALL ARGUMENTS
			SUM_.SUM OR CONTVAR(.ARVALLST[.I,OPENLPTR],.INDVAR);
		END;
		.SUM	! RETURN NET RESULT
	END;	! OF OPCLOLOK

	MACRO CONTIOVAR=
		RETURN(IOLOK(.STMNT))$;



	!START OF ROUTINE LOKINDVAR***********************
	!IF WE ARE IN THE I/O OPTIMIZATIONS WE WILL WALK DOWN
	!TO AN IOLSCLS NODE SO WE MUST MAKE A SPECIAL CHECK AND
	!DO THE CORRECT THING.

	IF .STMNT[OPRCLS] EQL IOLSCLS THEN
		RETURN(CONTVAR(.STMNT,.INDVAR));

	CASE .STMNT[SRCID] OF SET

	!ASSIGNMENT STATEMENT
		RETURN(CONTVAR(.STMNT[LHEXP],.INDVAR) OR CONTVAR(.STMNT[RHEXP],.INDVAR));

	!ASSIGN
		RETURN(CONTVAR(.STMNT[ASISYM],.INDVAR));

	!CALL STATEMENT
	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.STMNT[CALLIST];
		IF .AG NEQ 0 THEN
				INCR I FROM 1 TO .AG[ARGCOUNT] DO
					 IF CONTVAR(.AG[.I,ARGNPTR],.INDVAR) THEN 
						RETURN 1;

	END;

	!CONTINUE
	BEGIN END;

	!DO
	BEGIN
		!!LOOK AT THE STEPSIZE, INITIAL VALUE, UPPER LIMIT
		!AND THE LOOP CONTROL
%[1057]%	RETURN(CONTVAR(.STMNT[DOM1],.INDVAR)
%[1057]%		OR CONTVAR(.STMNT[DOM2],.INDVAR)
%[1057]%		OR CONTVAR(.STMNT[DOM3],.INDVAR)
%[1057]%		OR CONTVAR(.STMNT[DOLPCTL],.INDVAR));
	END;

	!ENTRY
	BEGIN END;

	!COMNSUB
	BEGIN END;

	!GO TO
	BEGIN END;

	!ASSIGNED GO TO
		RETURN( CONTVAR(.STMNT[AGOTOLBL],.INDVAR));

	!COMPUTED GO TO
		RETURN( CONTVAR(.STMNT[CGOTOLBL], .INDVAR));

	!ARITHMETIC IF
		RETURN( CONTVAR(.STMNT[AIFEXPR],.INDVAR));

	!LOGICAL IF
		RETURN( CONTVAR(.STMNT[LIFEXPR],.INDVAR));

	!RETURN
	BEGIN
		IF .STMNT[RETEXPR] NEQ 0 THEN
			RETURN( CONTVAR(.STMNT[RETEXPR],.INDVAR))
		ELSE RETURN 0;
	END;

	!STOP
	BEGIN END;

	!READ
		CONTIOVAR;

	!WRITE
		CONTIOVAR;

	!DECODE
		CONTIOVAR;

	!ENCODE
		CONTIOVAR;

	!REREAD
		CONTIOVAR;

	!FIND
		CONTIOVAR;

	!CLOSE
		RETURN OPCLOLOK(.STMNT);

	!INPUT
	BEGIN END;

	!OUTPUT
	BEGIN END;

	!BACK SPACE
		RETURN CONTUNIT;

	!BACK FILE
		RETURN CONTUNIT;

	!REWIND
		RETURN CONTUNIT;

	!SKIP FILE
		RETURN CONTUNIT;

	!SKIP RECORD
		RETURN CONTUNIT;

	!UNLOAD
		 RETURN CONTUNIT;

	!RELEASE
		RETURN CONTUNIT;

	!END FILE
		RETURN CONTUNIT;

	!END
	BEGIN END;

	!PAUSE
	BEGIN END;

	!OPEN
		RETURN OPCLOLOK(.STMNT);

	TES;
END;

GLOBAL ROUTINE SUPPLANT=
BEGIN

	!PERFORM A TEST REPLACEMENT ON THE FIRST ELEMENT IN
	!RDCLST.
	LOCAL BASE RINIT:RINCR:PA:PB;
	EXTERNAL TOP,LEND,LENTRY,PREV,GETOPTEMP,INDVAR;
	EXTERNAL MAKCONTINUE;
	MAP BASE TOP:PREV;

	!FIRST PICK UP A POINTER TO THE REDUCTION SYMBOL

	PA_.RDCLST[1]<LEFT>;

	!EXAMINE STATEMENTS LINKED AT LENTRY UTIL WE FIND
	!THE INITIALIZATION OF THIS REDUCTION VARIABLE

	PB_RINIT_.LENTRY;

	WHILE .RINIT NEQ .TOP DO
	BEGIN
		!CHECK FOR AN ASSIGNMENT TO THIS REDUCTION VARIABLE

		IF .RINIT[OPRS] EQL ASGNOS THEN
			IF .RINIT[LHEXP] EQL .PA THEN

			BEGIN
				!IF WE ARE NOT ABOUT TO MAKE AN
				!EXPRESSION THE INITIAL VALUE IN THE
				!LOOP 
				!LINK OUT THIS INIITIALIZATION
				!ASSIGNMENT STATEMENT
				IF .RINIT[A2VALFLG] THEN
				BEGIN
					PB[SRCLINK]_.RINIT[SRCLINK];
					TOP[DOM1]_.RINIT[RHEXP];
					!IF THE NEGFLG IS INVOLVED SET
					!INITLNEG FOR CODE GENERATION
					IF .RINIT[A2NEGFLG] THEN
						TOP[INITLNEG]_1;
				END ELSE
				!MAKE THE INITIAL VALUT BE THE .R
				!VARIABLE AND LEAVE THE ASSIGNMENT IN.
				!THE BB REG ALLOC WILL MAKE HE CODE
				!PRETTY

				BEGIN
					TOP[DOM1]_.PA;
					TOP[INITLTMP]_1;
				END;

				!SET THE DO SYMBOL
				TOP[DOSYM]_INDVAR_.PA;


				!NOW LOOK AT THE END OF THE LOOP.
				!UNFORTUNATELY, WE HAVE TO START AT
				!TOP. RDCLNK POINTS TO WHERE THE REDUCTIONS
				!ARE LINKED. WE NEED TO KNOW THE STATEMENT
				!INFRONT OF THE REDUCTION IN WHICCH WE ARE
				!INTERESTED. IF IT IS THE FIRST REDUCTION
				!STARTING AT RDCLNK LOSES. SO,-------
				!WE TAKE IT FROM THE TOP.
				PREV_.TOP;

				!WE WILL SEARCH UNTIL RDCLNK
				WHILE .PREV[SRCLINK] NEQ .RDCLNK DO
					PREV_.PREV[SRCLINK];

				!PREV IS NOW THE STATEMENT IN FRONT OF 
				!RDCLNK (THE FIRST REDUCTION).

				RINCR_.PREV[SRCLINK];

				WHILE .RINCR NEQ .LEND DO
				BEGIN
					REGISTER BASE EXPR;
					IF .RINCR[OPRS] EQL ASGNOS THEN
						IF .RINCR[LHEXP] EQL .PA THEN
					BEGIN
						!IF RINCR IS LABELED MAKE
						!A CONTINUE TO HOLD THE
						!PLACE OF THE LABEL
						IF .RINCR[SRCLBL] NEQ 0 THEN
						BEGIN
							REGISTER BASE T;
							!GET THE CONTINUE
							EXPR_MAKCONTINUE();
							!MOVE THE LABEL
							T_EXPR[SRCLBL]_.RINCR[SRCLBL];
							T[SNHDR]_.EXPR;
							RINCR[SRCLBL]_0;

							!LINK CONTINUE INTO
							!TREE
							PREV[SRCLINK]_.EXPR;
							EXPR[SRCLINK]_.RINCR;

							!UPDATE PREV
							PREV_.EXPR;
						END;

						!SET STEPSIZE
						EXPR_.RINCR[RHEXP];
						IF .EXPR[OPRCLS] EQL DATAOPR THEN
						BEGIN
							TOP[DOM3]_.EXPR;
							!KILL THE ASSIGNMENT STATEMENT
							PREV[SRCLINK]_.RINCR[SRCLINK];
						END
						ELSE
						BEGIN
							EXPR_(IF .EXPR[ARG1PTR]
							EQL .PA THEN .EXPR[ARG2PTR] ELSE 
							.EXPR[ARG1PTR]);

							!IF EXPR IS STILL
							!AN EXPRESSION MUST DO
							!ELABORATE HACK
							!TO COMPUTE STEP SIZ
							IF .EXPR[OPRCLS] EQL DATAOPR THEN
							BEGIN
								TOP[DOM3]_.EXPR;
								!TURN OFF SSIZNEG FLAG
								!REDUCE HAS ALREADY TAKEN CARE 
								!OF THIS
								TOP[SSIZNEGFLG]_0;
								PREV[SRCLINK]_.RINCR[SRCLINK];
							END
							ELSE
							BEGIN
							!GET AN OPTIMIZER VARIABLE TO USE AS
							!STEPSIZE
							TOP[DOM3]_
							RINCR[LHEXP]_
							GETOPTEMP(IF .EXPR[VALTYPE] EQL
							 CONTROL THEN LOGICAL ELSE 
							.EXPR[VALTYPE]);
							!TRANSFORM RINCR
							!INTO THE STEPSIZE
							!ASSIGNMENT
							RINCR[RHEXP]_.EXPR;
							!DELINK ASSIGNMENT

							PREV[SRCLINK]_.RINCR[SRCLINK];

							!PUT IT AT PB
							!INFRONT OF THE LOOP
							RINCR[SRCLINK]_.PB[SRCLINK];
							PB[SRCLINK]_.RINCR;

							!RESET FLAGS
							RINCR[EXPFLAGS]_0;
							RINCR[A1VALFLG]_1;
							TOP[SSIZINTMP]_1;
							END;
						END;
						!RESET LOOP FLAGS
						IF .TOP[FLCWD] THEN
							UNFLDO(.TOP);
						TOP[SSIZONE]_0;

						!GET OUT
						RETURN;
					END;	!IF THIS IS THE REDUCTION WE WANT
					PREV_.RINCR;
					RINCR_.RINCR[SRCLINK];
				END;	!WHILE TO FIND INCR AT LOOP END
		END;	!IF STATEMENT ON RINIT
		PB_.RINIT;
		RINIT_.RINIT[SRCLINK];
	END;	!WHILE ON RINIT
END;	!ROUTINE
FORWARD RDCTMP,REDUCE;
EXTERNAL INDVAR,LENTRY,LEND,RDCCT;



MAP PEXPRNODE INDVAR:LENTRY:LEND;
ROUTINE ONIOLST(LSTNOD,WHO)=
BEGIN
	!IF WHO IS ON THE I/O LST POINTED TO BY
	!LSTNOD THEN RETURN THE NODE THAT POINTS TO WHO.
	!RETURN 0 AS A FLAG FOR NOT FOUND

	MAP BASE LSTNOD;

	WHILE .LSTNOD NEQ 0 DO
	BEGIN
		IF .LSTNOD[SRCLINK] EQL .WHO THEN
			RETURN(.LSTNOD);
		LSTNOD_.LSTNOD[SRCLINK];
	END;

	0
END;


GLOBAL ROUTINE REDUCE(CNODE)=
BEGIN
EXTERNAL GENLAB,ARSKOPT,DOWDP,TOP,TRANSMOGRIFY;
EXTERNAL SAVSPACE,NEGFLG,NOTFLG;
EXTERNAL FINDTHESPOT;

LABEL CHKREC,LNKOUT;
OWN TEMP;
LOCAL A1NODE,A2NODE,PA,PB,T;
MAP OBJECTCODE DOWDP;
MAP PEXPRNODE CNODE:A1NODE:A2NODE:PA:PB:T;
MAP PHAZ2 TOP;

!INDVAR IS THE INDEX VARIABLE

	!CHECK THAT TWO LEAVES AND INTEGER MULTIPLY

	IF .DOTOHFLG THEN RETURN(.CNODE);

	!IF IT IS A SPECIAL OPERATOR ITS REDUCIBILITY
	!PROPERTIES ARE ALREADY KNOWN TO BE PRESENT. WE
	!WILL SIMPLY RECONVERT TO A MULTIPLY

	IF .CNODE[OPRCLS] EQL SPECOP THEN
	BEGIN

	!THE COMMENT ABOVE IS NOT CORRECT, FOR WE DO NOT
	! KNOW HERE WHETHER WE HAVE SPECOPS WHICH ARE COMING
	! FROM MULTIPLICATIONS OR DIVISIONS, ETC.
	! WE ONLY WANT TO PROCEED IF WE HAVE POTENTIAL MULTIPLIES.
		IF .CNODE[OPERSP] EQL P2DIVOP OR .CNODE[OPERSP] EQL EXPCIOP
	![1023] FOR SPECOP, MAKE SURE TYPE IS INTEGER OR INDEX
	%[1023]%	OR ( .CNODE[VALTYPE] NEQ INTEGER
	%[1023]%		AND .CNODE[VALTYPE] NEQ INDEX)
		THEN RETURN(.CNODE); !NO REDUCTION POSSIBLE

		!PICK UP POWER OF 2
		A2NODE_.CNODE[ARG2PTR];
		!REGENERATE THE CONSTANT
		CNODE[ARG2PTR]_
			MAKECNST(INTEGER,0,(1^(.A2NODE)+(.CNODE[OPERSP] EQL P2PL1OP)));
			CNODE[OPRCLS]_ARITHMETIC;
			CNODE[OPERSP]_MULOP;
	END ELSE
	IF NOT (REDUCOP(CNODE)) THEN RETURN(.CNODE);

	!NOW WE KNOW THAT THERE IS A POTENTIAL REDUCTION

	!LOOK AT THE VARIABLES INVOLVED

	IF .CNODE[ARG2PTR] EQL .INDVAR OR
	   .CNODE[ARG1PTR] EQL .INDVAR THEN
	ELSE
		RETURN(.CNODE);

	!CHECK FOR NOT FLAGS

	IF .CNODE[A1NOTFLG] OR .CNODE[A2NOTFLG] THEN RETURN(.CNODE);

	!FIND THE NODES

	A1NODE_.CNODE[ARG1PTR]; A2NODE_.CNODE[ARG2PTR];


	!PUT THE NODES IN THE RIGHT ORDER

	IF .A1NODE EQL .INDVAR THEN
	BEGIN
		SWAPARGS(CNODE);
		A1NODE_.CNODE[ARG1PTR];
		A2NODE_.CNODE[ARG2PTR];
	END;

	!IN THE EVENT THAT THE OTHER LEAF IS
	!NOT A CONSTANT IT MUST BE A LOOP CONSTANT OR WE ARE NOT
	!INTERESTED IN IT.

CHKREC:
	IF .A1NODE[OPR1] NEQ CONSTFL THEN
	BEGIN

		!MAKE SURE THE RESULT OF THE MULTIPLICATION IS
		!POSITIVE

		IF .CNODE[A1NEGFLG] AND .CNODE[A2NEGFLG]
			THEN
			ELSE
			IF .CNODE[A1NEGFLG] OR .CNODE[A2NEGFLG] THEN
				RETURN(.CNODE);

		%(***IF WE'RE IN AN INNER DO LOOP AND TOLENTRY (INDICATING
			THAT THE VARIABLE IS ASSIGNED OUTSIDE THE LOOP OF
			ITS FIRST USE), THEN CAN REDUCE EXPRESSIONS INVOLVING
			.O VARIABLES. OTHERWISE DON'T TOUCH THEM***)%

		IF .A1NODE[IDDOTO] EQL SIXBIT".O" THEN
		BEGIN
			IF	.TOP[INNERDOFLG]
				AND .A1NODE[IDATTRIBUT(TOLENTRY)]
			THEN
				LEAVE CHKREC	!GOT A SAFE ONE
			ELSE
				RETURN(.CNODE);
		END;

		!LOOK AT THE LIST OF VARIABLES ON THE DOCHNGL LIST
		!FOR THIS LOOP. DEFINITION POINT INFO IS NO LONGER
		!AVAILABLE, NEITHER ARE THE SYMBOL TABLE FLAGS FROM
		!FROM THE DEFINITION POINT ALGORITHM.
		!SEE DEF0, AND DEFCHANGE FOR A DESCRIPTION OF
		!THE DOCHNGL LIST.
		!IF THIS IS ON AN I/O LIST WE ARE IN TROUBLE BECAUSE THE
		!OPTIMIZERS WORDS ARE NOT PRESENT. SO CHECK FOR
		!ZERO AND QUIT. IT IS IMPOSSIBLE FOR THE CONSTANT
		!TO BE DEFINED ON THE LIST (I HOPE)

		IF .TOP[SRCOPT] EQL 0 THEN
			!ASSUME ON I/O LIST
			LEAVE CHKREC;
		PA_.TOP[DOCHNGL];
		WHILE .PA NEQ 0 DO
		BEGIN
			IF .A1NODE EQL .PA[LEFTP] THEN
				RETURN(.CNODE);
			PA_.PA[RIGHTP];
		END;

		!IF WE GOT HERE IT IS A REGION CONSTANT
		!KEEP GOING**********

	END
	ELSE
	BEGIN

		!GENERATE CONSTANT WITH THE RIGHT SIGN

		IF .CNODE[A1NEGFLG] THEN
		BEGIN
			A1NODE_MAKECNST(INTEGER,0,-.A1NODE[CONST2]);
			CNODE[A1NEGFLG]_0
		END;
		IF .CNODE[A2NEGFLG] THEN
		BEGIN
			A1NODE_MAKECNST(INTEGER,0,-.A1NODE[CONST2]);
			CNODE[A2NEGFLG]_0
		END;
	END;

!********************************************************
!
!NOW WE HAVE A REDUCTION AND IT IS IN THE ORDER CONSTANT * INDVAR
!
!*******************************************************
	!SEE IF THIS REDUCTION HAS BEEN DONE BEFORE
	TEMP_0;
	!THE FORMAT OF THE LIST IS 
	!	LEFT HALF WORD POINTS TO REDUCTION VARIBALE
	!	RIGHT HALF POINTS TO CONSTANT

	IF .RDCCNT NEQ 0
	  THEN BEGIN
	  LABEL  LINCR;

LINCR:	    INCR I FROM 1 TO .RDCCNT BY 2 DO
	      IF .RDCLST [.I]<RIGHT> EQL .A1NODE 
		THEN BEGIN
		  TEMP _ .RDCLST [.I]<LEFT>;
		  RDCLST [.I+1] _ .RDCLST [.I+1] + 1;	! USE CNT
		  LEAVE LINCR;		! SEARCH DONE
		END;
	  END;

	!CHECK TO SEE IF THIS REDUCTION CAN BE SUBSUMED
	!USE A2NODE (INDVAR AT THIS POINT) AS A FLAG
	A2NODE_0;
	IF .TEMP EQL 0 THEN
	BEGIN
		PA_.CNODE[PARENT];
		!SAFETY CHECK ON THE VALIDITY OF THE POINTER
		IF .PA NEQ 0 THEN
			IF .PA[OPRCLS] EQL STATEMENT THEN
				IF .PA[OPERSP] EQL ASGNID THEN
				BEGIN
					PB_.PA[LHEXP];
					!IS IT A.O VARIABLE
					IF .PB[IDDOTO] EQL SIXBIT".O" THEN
					BEGIN
						!MAKE IT EASIER FOR US TO
						!READ THE CODE BY
						!CALLING IT A .R
						TEMP_.PB;
						TRANSMOGRIFY(.PB,SIXBIT'.R'+MAKNAME(RDCCT));
						!UPDATE RDCCT
						RDCCT_.RDCCT+1;

						!LINK THE .O ASSIGNMENT
						!OUT OF THE TREE
						PB_.TOP;
						LNKOUT:
						UNTIL .PB[SRCLINK] EQL .PA DO
						BEGIN
							!SAVE PB
							A2NODE_.PB;

							!DON'T CHECK FOR AN I/O STATEMENT
							!UNLESS IT'S A STATEMENT
							IF .PB[OPRCLS] EQL STATEMENT THEN

							!IT COULD BE ON AN I/O
							!LIST OR IN THE TREE

							IF (.PB[SRCID] GEQ READID) AND
							(.PB[SRCID] LEQ ENCOID) THEN
							BEGIN
							IF (PB_ONIOLST(.PB[IOLIST],.PA) NEQ 0) THEN
								LEAVE LNKOUT;
							END ELSE  !I/O
							!IT COULD BE ON
							!A LOGICAL IF I/O LIST
							IF .PB[SRCID] EQL IFLID THEN
							BEGIN
							PB_.PB[LIFSTATE];
							IF (.PB[SRCID] GEQ READID) AND
							(.PB[SRCID] LEQ ENCOID) THEN
								IF (PB_ONIOLST(
								.PB[IOLIST],.PA) NEQ 0)
								THEN
								LEAVE LNKOUT;
							END;
							!RESTORE PB
							PB_.A2NODE;
							PB_.PB[SRCLINK];
						END;

						PB[SRCLINK]_.PA[SRCLINK];
						A2NODE_1;
					END;
				END;

		IF .A2NODE EQL 0 THEN
		TEMP_RDCTMP();

		!NOW ADD THIS ONE TO THE LIST. IF THE LIST OVERFLOWS REINITIALIZE
		!AND START AGAIN.

		IF .RDCCNT GEQ 18
		  THEN BEGIN
		    RDCCNT _ 0;
		    INCR I FROM 0 TO 18 DO
		      RDCLST [.I] _ 0;
		  END;
				!WE ARE SURE WE CAN NOW ADD
		IF .RDCCNT EQL 0	! IS LIST EMPTY ?
		  THEN RDCCNT _ 1	!   YES => START @ WORD 1
		  ELSE RDCCNT _ .RDCCNT + 2;	!   NO => NEXT 2 WORDS

		RDCLST [.RDCCNT]<LEFT> _ .TEMP;
		RDCLST [.RDCCNT]<RIGHT> _ .A1NODE;
		RDCLST [.RDCCNT+1] _ 1;		! USE CNT

		NAME<LEFT>_ASGNSIZ+SRCSIZ;
		!BUILD  A NODE OF
		!	TEMP =M1*CONSTANT
		!AND  DO PHASE 2 SKELETON

		PA_CORMAN();
		PA[OPRCLS]_STATEMENT;
		PA[SRCID]_ASGNID;
		PA[LHEXP]_.TEMP;
		PA[A1VALFLG]_1;
		NEGFLG_NOTFLG_FALSE;

		T_PA[RHEXP]_ARSKOPT(MAKPR1(.PA,ARITHMETIC,MULOP,INTEGER,
				.TOP[DOM1],.A1NODE));
		IF .T[OPRCLS] EQL DATAOPR THEN
		BEGIN
			PA[A2VALFLG]_1;
			!IF ANY OF THE %&'#" NEG/NOT FLAGS
			!GOT SET TRANSFER THIS INFO TO THE STATEMENT
			!NODE
			IF .NEGFLG THEN
				PA[A2NEGFLG]_1
			ELSE
			IF .NOTFLG THEN
				PA[A2NOTFLG]_1;
		END;


		!LINK THIS STATEMENT IN FRONT OF THE DO LOOP
		!ALSO MOVE ANY LABEL THAT IS ON THE
		!PHYSICAL SUCCESSOR OF THE PLACE WHERE THE REDUCTION
		!INITILAIZATION IS INSERTED BACK TO THE REDUCTION.

		!IF THE CONSTANT IS NOT A GENUINE NUMERIC CONSTANT
		!THEN INSERT THE REDUCTION AFTER OTHER
		!OPTIMIZER STATEMENTS AT LENTRY OTHERWISE JUST
		!STICK IT AT LENTRY (REG ALLOC. WILL BE BETTER IN THE
		!LATTER CASE 'CUZ ANY INITIAL DO
		!DO VALUE COMPUTATION WILL IMMEDIATELY PRECEDE THE
		!REDUCTION).

		!FIX THE FOLLOWING TEST SO THAT THE MOTION PLACE
		! FOR THE .R VARIABLES IS CORRECT WITH RESPECT TO .O
		! VARIABLES.  THIS IS THE CORRECT FIX FOR
		! SPR 14940, INSTEAD OF [244]
		!THIS KEEPS THE .R ASSIGNMENTS CLOSER TO
		! THE DO LOOP AND ALLOWS CSE WITH .O VARIABLES
		! WHICH ARE MOVED ESSENTIALLY TO THE SAME PLACE.
		IF .T[OPR1] EQL CONSTFL THEN
			T_.LENTRY
		ELSE
			!TELL FINDTHESPOT TO STOP WHEN IT HITS TOP
			T _ FINDTHESPOT (.LENTRY, .TOP);

		!NOW LINK IT IN
		PA[SRCLINK]_.T[SRCLINK];
		T[SRCLINK]_.PA;

		!SET UP T FOR NEXT CODE SEQUENCE
		T_.PA[SRCLINK];

		IF .T[SRCLBL] NEQ 0 THEN
		BEGIN
			PB_PA[SRCLBL]_.T[SRCLBL];
			T[SRCLBL]_0;
			PB[SNHDR]_.PA;
		END;

		!
		!BUILD A NODE FOR
		!	TEMP=TEMP+CONSTANT*M3
		!
		NAME<LEFT>_ASGNSIZ+SRCSIZ;
		PA_CORMAN();
		PA[OPRCLS]_STATEMENT;
		PA[SRCID]_ASGNID;
		PA[LHEXP]_.TEMP;
		PA[A1VALFLG]_1;

		!THIS STATEMENT IS STILL WITHIN THIS LOOP SO IT WILL BE
		!LOCALLY OPTIMIZED NOW

			NEGFLG_NOTFLG_T_0;
		PB_ARSKOPT(MAKPR1(.PA,ARITHMETIC,MULOP,INTEGER,.TOP[DOM3],.A1NODE));

		!IF THE NEGFLG IS SET THEN CHANCES ARE THE STEP SIZE
		!IS -1. MKE SURE THE PROPER NEG FLG IS SET ON THE
		!NODES TO REFLECT THIS

		IF .NEGFLG OR .TOP[SSIZNEGFLG] THEN
			IF .PB[OPRCLS] EQL DATAOPR THEN
				T_1
			ELSE
				PB[A1NEGFLG]_NOT .PB[A1NEGFLG];
		NEGFLG_NOTFLG_FALSE;
		PA[RHEXP]_ARSKOPT(PB_MAKPR1(.PA,ARITHMETIC,ADDOP,INTEGER,.PB,.TEMP));
		!IF WE WERE QUEUING A NEGFLG MAKE THE ADD A SUBTRACT
		IF .T THEN
			PB[A1NEGFLG]_NOT .PB[A1NEGFLG];

		!LINK THIS AT LOOP END
		!WANT TO LINK IT IN FRONT OF LEND. NEED TO FIND
		!THE STATEMENT IN FRONT OF LEND. IT HAS ALREADY
		!BEEN FOUND IF RDCLNK IS NOT ZERO. OTHERWISE WE
		!WILL DO A LINEAR SEARCH FOR IT

		IF .RDCLNK EQL 0 THEN
		BEGIN
			RDCLNK_.TOP;
			WHILE .RDCLNK[SRCLINK] NEQ .LEND DO
				RDCLNK_.RDCLNK[SRCLINK];
		END;

		!RDCLNK NOW POINTS TO THE PLACE
		T_.RDCLNK[SRCLINK];
		RDCLNK[SRCLINK]_.PA;
		PA[SRCLINK]_.T;

		!IF T IS LABELED AND IS NOT LEND THEN IT
		!MUST BE A PREVIOUS REDUCTION. IF IT IS LABELED
		!IT IS BECAUSE LEND WAS LABELED AND REFERENCED AS OTHER
		!THAN THE DO TERMINATOR. WE NEED TO MOVE THE LABEL
		!BACK TO THE NEW REDUCTION TOO.

		IF .T[SRCLBL] NEQ 0 AND .T NEQ .LEND THEN
		BEGIN
			PB_PA[SRCLBL]_.T[SRCLBL];
			T[SRCLBL]_0;
			PB[SNHDR]_.PA;
		END;

		!IF LEND IS LABELED AND THE LABEL IS REFERENCED
		!AS A TRANSFER THEN MOVE THE LABEL BACK
		!TO THE REDUCTION AND MAKE A NEW ONE FOR THE LOOP
		!TERMINATOR

		IF .LEND[SRCLBL] NEQ 0 THEN
		BEGIN
			T_.LEND[SRCLBL];
			IF .T[SNDOLVL] NEQ 0 AND .T[SNREFNO] NEQ 2 THEN
			BEGIN
				PB_GENLAB();
				!MOVE LABEL
				PA[SRCLBL]_.LEND[SRCLBL];
				T[SNHDR]_.PA;
				!MAKE PB THE NEW DO LABEL
				TOP[DOLBL]_.PB;
				PB[SNHDR]_.LEND;
				LEND[SRCLBL]_.PB;
				PB[SNREFNO]_2;
				PB[SNDOLVL]_.T[SNDOLVL];
				PB[SNDOLNK]_.T[SNDOLNK];
				!ZERO DO LOOP STUFF IN OLD
				!LABEL
				T[SNREFNO]_.T[SNREFNO]-1;
				T[SNDOLVL]_T[SNDOLNK]_0;
			END;
		END;
	END;		!HAVE NOT DONE THIS ONE YET


	!FIX UP THE VALFLGAS ON THE PARENT ONCE AND FOR
	!ALL HERE.

	PA_.CNODE[PARENT];
	IF .PA[OPRCLS] EQL STATEMENT THEN
	BEGIN
		IF .PA[SRCID] EQL ASGNID THEN
			PA[A2VALFLG]_1;
	END ELSE
	IF .PA [ARG1PTR] EQL .CNODE
	  THEN BEGIN
	    PA [A1VALFLG] _ 1;
%[773]%	    PA [DEFPT1] _ .TOP;		! Keep it in the loop
%[773]%	  END
%[773]%	  ELSE BEGIN
%[773]%	    PA [A2VALFLG] _ 1;
%[773]%	    PA [DEFPT2] _ .TOP;		! Keep it in the loop
%[773]%	  END;

![1110] For all DOs except those in an I/O list (implied DOs),
![1110]  also add the reduction varaible to the DOCHNGL list in order
![1110]  to keep simple assignments involving .R from leaving the loop.
%[1110]% IF NOT .IMPLDO
%[1110]% THEN
%[1110]% BEGIN
%[1110]%	NAME<LEFT>_CHNGSIZ;
%[1110]%	PA_CORMAN();
%[1110]%	PA[RIGHTP]_.TOP[DOCHNGL];
%[1110]%	TOP[DOCHNGL]_.PA;	! Link it onto top of the list
%[1110]%	PA[LEFTP]_.TEMP		!.R
%[1110]% END;

	!FREE THE SPACE USED BY THE REDUCED NODE
	SAVSPACE(EXSIZ-1,.CNODE);


	!LINK USE OF TEMP INTO THE TREE BY RETURNING IT
	.TEMP
END;
!
!*******************************
GLOBAL ROUTINE RDUCINIT=
BEGIN
	!INITIALIZE REDUCTION STORAGE. CALLED FROM
	!PROPAGATE. IT IS HERE WITH THE CALL IN PROPAGATE
	!TO KEEP THE STORAGE OWN.

	RDCLNK_0 ;
	RDCCNT_0;

	INCR I FROM 0 TO 18 DO
		RDCLST[.I]_0;
END;
GLOBAL ROUTINE RDCTMP=
BEGIN
! Create a reduction in strength temporary
EXTERNAL SYMTYPE;
REGISTER
%1505%	BASE ID;			! Points to STE that is created

	SYMTYPE = INTEGER;
	NAME  =  IDTAB;
	ENTRY = SIXBIT'.R' +MAKNAME(RDCCT);
	RDCCT = .RDCCT+1;
	ID = TBLSEARCH();
%1505%	ID[IDPSECT] = PSDATA;		! Put the temp in .DATA.
%1505%	RETURN .ID			! Return the STE address explicitly
END;
SWITCHES  NOSPEC;

!	CALLED FROM DOTORFIX
!	  RETURNS 1 IF USAGE CNT OF .R (IN RDCLST [+1]) = 1
!	          0 IF USE CNT NEQ 1 OR .R NOT FOUND

GLOBAL ROUTINE  DOTRCNTOK  (R)  =

BEGIN

	INCR I  FROM 1  TO .RDCCNT  BY 2
	  DO BEGIN
	    IF .RDCLST [.I]<LEFT> EQL .R
	      THEN
		IF .RDCLST [.I+1] EQL 1		! USE CNT
		  THEN RETURN 1
		  ELSE RETURN 0;
	  END;					! OF DO
	RETURN 0;			! R NOT FOUND

END;					! OF DOTRCNTOK

END
ELUDOM