Google
 

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

!AUTHOR: NORMA ABEL/HPWD/DCE/SJW/JNG/EGM/EDS/AHM/TJK

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

!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND TSTRV = #10^24 + 0^18 + #2377;	! Version Date:	18-Jun-84

%(

***** 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.


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

2211	TFV	18-Aug-83
	Fix  LOKINDVAR.   Add  INQUIRE   case.   Also  check  more   I/O
	specifiers for references to the DO loop index.

2377	TJK	16-Jun-84
	Correct the case for a DO statement in LOKINDVAR added in edit
	1057.  It shouldn't look at DOM2, since this isn't used  after
	DOLPCTL is created.   Also add some  explicit zero returns  in
	TESTREPLACE.

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

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

)%

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

FORWARD
	TESTREPLACE,
	IOLOK(1),
	OPCLOLOK(1),
	LOKINDVAR(1),
	SUPPLANT,
	ONIOLST(2),
	REDUCE(2),
	RDUCINIT,
	RDCTMP,
	DOTRCNTOK(1);

OWN
 	RDCCNT, 
%1166%	RDCLST [19];

EXTERNAL
	ARSKOPT,
	BOTTOM,
	CONTVAR,
	CORMAN,
	CSTMNT,
	DOWDP,
	FINDTHESPOT,
	GENLAB,
	GETOPTEMP,
	INDVAR,
	LENTRY,
	LEND,
	LPRDCCT,
	MAKCONTINUE,
	MAKPR1,
	NEGFLG,
	NOTFLG,
	PREV,
	RDCCT,
	BASE RDCLNK,
	SAVSPACE,
	SYMTYPE,
	TBLSEARCH,
	TOP,
	TRANSMOGRIFY,
	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

	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.

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

	!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
%2377%	IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN RETURN 0;

	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;	! of TESTREPLACE

ROUTINE IOLOK(STMNT)=
BEGIN
	!***************************************************************
	! Look for references to  the DO loop  index in the  expressions
	! under an  I/O statement.   Return 0  if there  are none,  else
	! return 1.
	!***************************************************************

%2211%	! Rewritten by TFV on 18-Aug-83

	MAP BASE STMNT;
	REGISTER
		CONT,		! Flag for does contain references
		BASE TMP;	! Convenient temp

	CONT = 0;	! Reset flag

	IF (TMP = .STMNT[IOUNIT]) NEQ 0		! Check UNIT=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF (TMP = .STMNT[IOFORM]) NEQ 0		! Check FMT=
	THEN IF .TMP NEQ #777777		! Not list-directed
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF (TMP = .STMNT[IORECORD]) NEQ 0	! Check REC=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF (TMP = .STMNT[IOIOSTAT]) NEQ 0	! Check IOSTAT=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	TMP = .STMNT[IOLIST];			! Check IOLIST
	WHILE .TMP NEQ 0 DO
	BEGIN
		IF .TMP[OPRCLS] EQL STATEMENT
		THEN CONT = .CONT OR LOKINDVAR(.TMP)
		ELSE CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

		TMP = .TMP[CLINK];
	END;

	RETURN .CONT
END;	! of IOLOK

ROUTINE OPCLOLOK(STMNT)=
BEGIN
	!***************************************************************
	! Look for references to  the DO loop  index in the  expressions
	! under an OPEN, CLOSE, or INQUIRE statement.  Return 0 if there
	! are none, else return 1.
	!***************************************************************

%2211%	! Rewritten by TFV on 18-Aug-83

	MAP BASE STMNT;
	REGISTER
		CONT,		! Flag for does contain references
		BASE TMP,	! Convenient temp
		OPENLIST ARVALLST;

	CONT = 0;	! Reset flag

	IF (TMP = .STMNT[IOUNIT]) NEQ 0		! Check UNIT=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF (TMP = .STMNT[IOFILE]) NEQ 0		! Check FILE=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF (TMP = .STMNT[IOIOSTAT]) NEQ 0	! Check IOSTAT=
	THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);

	IF .STMNT[OPSIZ] NEQ 0
	THEN
	BEGIN	! Check other specifiers
		ARVALLST = .STMNT[OPLST];	! Get list

		DECR I FROM (.STMNT[OPSIZ] - 1) TO 0 DO		! Check them
		IF (TMP = .ARVALLST[.I,OPENLPTR]) NEQ 0
		THEN CONT = .CONT OR CONTVAR(.TMP,.INDVAR);
	END;	! Check other specifiers

	RETURN .CONT
END;	! of OPCLOLOK

GLOBAL ROUTINE LOKINDVAR(STMNT)=
BEGIN
	!***************************************************************
	! Look for references to  the DO loop  index in the  expressions
	! under a statement.  Return 0 if there are none, else return 1.
	!***************************************************************

%2211%	! Rewritten by TFV on 18-Aug-83

	MAP BASE STMNT;
	REGISTER ARGUMENTLIST AG;

	! If we are in the I/O optimizations, must make a special  check
	! for an IOLSCLS node and call CONTVAR which handles them.

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

	CASE .STMNT[SRCID] OF SET

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

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

	IF (AG = .STMNT[CALLIST]) NEQ 0			! CALL 
	THEN
	BEGIN
		DECR I FROM .AG[ARGCOUNT] TO 1 DO
		IF CONTVAR(.AG[.I,ARGNPTR],.INDVAR)
		THEN RETURN 1;
	END
	ELSE RETURN 0;

	RETURN 0;					! CONTINUE

%2377%	! Only check DOM1, DOM3, and DOLPCTL for DO statements.  DOM2
%2377%	! isn't used after DOXPN.

%1057%	RETURN(CONTVAR(.STMNT[DOM1],.INDVAR) OR		! DO - look at initial,
%2377%		CONTVAR(.STMNT[DOM3],.INDVAR) OR	!  step size, and
%1057%		CONTVAR(.STMNT[DOLPCTL],.INDVAR));	!  loop control

	RETURN 0;					! ENTRY
	RETURN 0;					! COMNSUB
	RETURN 0;					! GOTO
	RETURN(CONTVAR(.STMNT[AGOTOLBL],.INDVAR));	! ASSIGNED GO TO
	RETURN(CONTVAR(.STMNT[CGOTOLBL],.INDVAR));	! COMPUTED GO TO
	RETURN(CONTVAR(.STMNT[AIFEXPR],.INDVAR));	! ARITHMETIC IF
	RETURN(CONTVAR(.STMNT[LIFEXPR],.INDVAR));	! LOGICAL IF

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

	RETURN 0;	! STOP
	RETURN IOLOK(.STMNT);	! READ
	RETURN IOLOK(.STMNT);	! WRITE
	RETURN IOLOK(.STMNT);	! DECODE
	RETURN IOLOK(.STMNT);	! ENCODE
	RETURN IOLOK(.STMNT);	! REREAD
	RETURN IOLOK(.STMNT);	! FIND
	RETURN OPCLOLOK(.STMNT);	! CLOSE
	RETURN 0;		! INPUT
	RETURN 0;		! OUTPUT
	RETURN IOLOK(.STMNT);	! BACKSPACE
	RETURN IOLOK(.STMNT);	! BACKFILE
	RETURN IOLOK(.STMNT);	! REWIND
	RETURN IOLOK(.STMNT);	! SKIPFILE
	RETURN IOLOK(.STMNT);	! SKIPRECORD
	RETURN IOLOK(.STMNT);	! UNLOAD
	RETURN IOLOK(.STMNT);	! RELEASE
	RETURN IOLOK(.STMNT);	! ENDFILE
	RETURN 0;		! END
	RETURN 0;		! PAUSE
	RETURN OPCLOLOK(.STMNT);	! OPEN
	RETURN 0;		! SFN
	RETURN 0;		! FORMAT
	RETURN 0;		! BLT
	RETURN 0;		! 
	RETURN OPCLOLOK(.STMNT);	! INQUIRE

	TES;
END;	! of LOKINDVAR

GLOBAL ROUTINE SUPPLANT=
BEGIN

	!PERFORM A TEST REPLACEMENT ON THE FIRST ELEMENT IN
	!RDCLST.
	LOCAL BASE RINIT:RINCR:PA:PB;
	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;	! of SUPPLANT

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;	! of ONIOLST


GLOBAL ROUTINE REDUCE(CNODE)=
BEGIN
	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;	! of REDUCE


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;	! of RDUCINIT

GLOBAL ROUTINE RDCTMP=
BEGIN
	! Create a reduction in strength temporary
	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;	! of RDCTMP
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