Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/pha2.bli
There are 12 other files named pha2.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/SRM/SJW/DCE/TFV/EGM

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

!	REQUIRES FIRST, TABLES,OPTMAC

GLOBAL BIND PHA2V = 6^24 + 0^18 + #1633;	! Version Date:	1-Sep-82

%(

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

94	-----	-----	CALL I/O OPTIMIZER TO FOLD OUTERMOST
			LEVEL OF I/O LISTS
95	-----	-----	REVISION TO ORIGINAL EDIT 94
96	-----	-----	ADD REREDID TO IOCLEAR
97	-----	-----	ADD SETTING/RESETTING OF GCALLSLFLG AND PARAMETER
			TI IOCLEAR
98	-----	-----	DO NOT SAVESPACE ON LOGICAL IF IF SRCOPT IS
			ZERO. OCCURS IN ERROR CASE
99	-----	-----	INSERT A CONTINUE AFTER EVERY DO NODE
			TO BE ABLE TO SET BITS ON IT
			AND STILL DO COMMON SUBS ON THE FIRST
			STATEMENT IN THE LOOP
100	-----	-----	ADJUST FOR NEW GRAPH STRUCTURE
101	-----	-----	CALL DOTOPROPAGATE AND DO NOT ADJUST THE STACK
102	-----	-----	FIX UP ERROR MESSAGE CALLS AND TESTREPLACEMENT
			ON LOOPS WITH EXITS
103	-----	-----	PUNT!
104	-----	-----	SAVSPACE EXPRESSION HASH ENTRIES
105	-----	-----	FIX ROTTEN TEST FOR SUPPLANTING AND
			MAKE SPECIAL CASE IN CONTINUE
			GENERATION THAT WILL NOT GENERATE SO MANY
106	-----	-----	FIX SPECIAL CASE MENTIOMED IN 105
107	-----	-----	FIX REFERENCE TO MAIN. AS NAME OF MAIN PROGRAM
108	263	15865	FIX VALUE SAVED FOR STACK RESTORE

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

109	VER5	-----	RECALL GLOBELIM WITH STARTING VALUE OF VERYFRST
			  FOR GLOBDEP
			CALL ZTREE TO ZERO DEFPTS & CLEAN UP .O SYMTBL
			SET/RESET GLOBELIM2 TO FLAG 2ND GLOBELIM, (SJW)
110	425	QA714	CALL ZTREE TO CLEAR DEFPTS IF OPTIMIZATIONS
			  DISCONTINUED IN OPTERR, (SJW)

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

111	720	27830	GIVE BETTER CODE FOR ASSIGNED GO TO STMNT /OPT, (DCE)

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

112	760	TFV	1-Feb-80	-----
	Fix edit 720 so it only throws away created lists

113	1047	EGM	22-Jan-81	Q10-05325
	Add support for TOPS-10 execute only.

114	1066	EGM	12-May-81	Q10-05202
	Do not use ISN in error messages if not pertinent.

115	1105	DCE	26-Jun-81	-----
	Correct label count for DO loops ending on same label.

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

1633	TFV	1-Sep-82
	Count number of executable statements.

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

)%

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

%1633%	EXTERNAL STCNT;

EXTERNAL SAVE17;		!TO SAVE STACK REGISTER IN CASE OF
				!EMERGENCY EXIT
%(********************************************
	OPTIMIZER OVERLAY
*************************************************)%

EXTERNAL DWP,WALKER,GPHBLD,LOOP,TOP,BOTTOM,INDVAR,
	LENTRY,LEND,DOPARMS,GREGALC,FLOOD,LOOPNO,GLOBELIM,
	DEFDRIV,PROPAGATE,DOCOLLAPSE,RGRAPH,FGRAPH;


	EXTERNAL POOL,PROGNAME;

	MACHOP POPJ=#263;
MAP BASE LOOP:LENTRY:TOP;
EXTERNAL CSTMNT,P2SKSTMNT,LOCELIM;
MAP BASE CSTMNT;

!**********************
!EXIT MACRO
!************************

MACRO DEAD=
	BEGIN
		SREG<0,36>_.SAVE17<0,36>;
		POPJ (#17,0);
	END$;

ROUTINE PASSOUT=
BEGIN
	EXTERNAL IOCLEAR,IOPTFLG;
	EXTERNAL CSTMNT,BACKST,LOCELIM,MEMCMCHK;
	MAP BASE CSTMNT;
	EXTERNAL CORMAN,LOCELMIO,LOCLNK;

	!THIS ROUTINE CLEANS UP FOR A GRACEFULL EXIT FROM
	!THE OPTIMIZER. IT IS USED IN THE NORMAL EXIT CASE
	!AFTER THE MAIN CODE AND ALSO FOR ERRORS.
	!THE SERVICES PERFORMED ARE:
	!1.	DO LOCAL COMMON SUBS
	!2.	CLEAR TARGET WORDS
	!3.	CATCH COMPUTATIONS TO MEMORY

	!FIND LOCAL COMMON-SUB EXPRESSIONS IN ALL I/O STATEMENTS
	NAME<LEFT>_4;
	BACKST_CORMAN();
	!GO THROUGH ALL STATEMENTS AND AMKE SURE THAT THE
	!TARGET WORD IS ZERO
	!INITIALIZE THE GLOBAL LOCLNK
	LOCLNK_0;

	CSTMNT_.SORCPTR<LEFT>;
	GCALLSLFLG_1;
	FLGREG<OPTIMIZE>_0;
	WHILE .CSTMNT NEQ 0 DO
	BEGIN

%1633%		STCNT = .STCNT + 1;	! Count executable statements

		!ZERO TARGET FIELD
		CSTMNT[TARGADDR]_0;
		IF .CSTMNT[SRCISN] NEQ 0 THEN
		IF .CSTMNT[SRCID] GEQ READID AND .CSTMNT[SRCID] LEQ REREDID THEN
			IOCLEAR(.CSTMNT)
		 ELSE
![720] WE ARE DONE WITH ANY CREATED LISTS OF ASSIGNED GO TO
![720] LABELS.  THROW AWAY THE POINTER TO THEM SO THAT
![720] WE DO NOT THINK THERE IS AN EXPLICIT LIST IN CODE GENERATION!
![720] THIS RESULTS IN MUCH BETTER CODE OPTIMIZED.
![760] Only throw away list if it was created, not if used specified it
%[760]%			(LOCELIM(.CSTMNT);
%[760]%			IF .CSTMNT[SRCID] EQL AGOID AND .CSTMNT[NOLBLLST]
%[760]%			THEN CSTMNT[GOTOLIST]_0);
		MEMCMCHK();
		CSTMNT_.CSTMNT[SRCLINK];
	END;
	FLGREG<OPTIMIZE>_1;
	GCALLSLFLG_0;
END;

FORWARD UNFUDGDO;
GLOBAL ROUTINE OPTERR(NUMB)=
BEGIN
	!ERROR ROUTINE CALLED BY THE OPTIMIZER.
	!PRINT ERROR MESSAGE, RESTORE STACK TO VALUE IT
	!HAD ON ENTRY TO THIS OVERLAY AND GET OUT******


	EXTERNAL CSTMNT,LOOP;
	MAP BASE CSTMNT;
	EXTERNAL ENTRY,ISN,WARNERR;

	EXTERNAL  ZTREE;


	WARNERR(.ISN,.NUMB);
	!CLEANUP GRAPH POINTERS LEFT IN STATEMENT NODES,ELSE
	!THE REGISTER ALLOCATOR WILL THINK THEY ARE POINTERS TO
	!LOCAL COMMON SUB-EXPRESSIONS.

	ZTREE ();		! CLEAR DEFPTS BEFORE LEAVING

	!IF THIS IS A MAIN CODE SEGMENT  THEN FIX UP
	!THE DO LOOP WE INSERTED SO THAT THE GLOBAL REGISTER
	!ALLOCATOR WILL NOT DIE
	IF .LOOP EQL 0 THEN UNFUDGDO();

	PASSOUT();

	DEAD;
END;

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



!TWO LOCAL ROUTINES TO KLUDGE A PSEUDO DO-LOOP FOR THE MAIN PROGRAM

	ROUTINE FUDGDO=
	BEGIN
		LOCAL BASE P:T:DL;
	EXTERNAL CORMAN,TOP,LEND,QQ,NAME,GENLAB;
		MAP BASE TOP:QQ;

	!	1. THE DUMMY CONTINUE IN FRONT AS LENTRY
	!	2. THE FUDGED DO LOOP NEXT AS TOP
	!	3. BOTTOM WILL POINT TO THE END STATEMENT
	!	4. LEND WILL POINT TO THE FUDGED CONTINUE

		NAME_0;
		NAME<LEFT>_DOSIZ+SRCSIZ;
		TOP_
		P_CORMAN();
		!THIS WILL LOOK LIKE A DO LOOP IN THE SIZE
		!FLAGS AND LABEL FIELD. IT WILL HAVE A SRCID
		!OF A CONTINUE TO PREVENT PHASE 2 SKELETON
		!OPTIMIZATIONS ON IT

		P[SRCID]_CONTID;
		P[OPRCLS]_STATEMENT;
		DL_
		P[DOLBL]_GENLAB();
		!SET SNREFNO SO LABEL WILL BE CONSIDERED LOCAL
		DL[SNREFNO]_2;
		T_.SORCPTR<LEFT>;
		!FOR A SUBPROGRAM, MAKE THE ENTRY STATEMENT LENTRY
		!AND PUT TOP RIGHT AFTER IT, ELSE IF WE MOVE
		!ANYTHING TO LENTRY IT WOULD BE INACCESSIBLE CODE.
		!OPTIMIZING A BLOCK DATA PROGRAM IS ILLEGAL
		IF .FLGREG<PROGTYP> NEQ MAPROG THEN
		BEGIN
			T_.T[SRCLINK];
			WHILE .T[SRCID] EQL ENTRID DO
			BEGIN
				LENTRY_.T;
				IF .T[SRCLINK] EQL 0 THEN
					(PASSOUT(); DEAD;);
				T_.T[SRCLINK];
			END;
		END;
		P[SRCLINK]_.LENTRY[SRCLINK];
		LENTRY[SRCLINK]_.P;
		!GO THROUGH THE WHOLE THING LOOKING FOR
		!THE STATEMENT BEFORE THE LAST TO LINK INTO
		!THE CONTINUE WE WILL MAKE

		!A HALF SPECIAL CASE
		!SUBROUTINE SUB
		!END
		IF .T[SRCLINK] EQL 0 THEN
			(PASSOUT();DEAD;);

		WHILE .T[SRCLINK] NEQ .SORCPTR<RIGHT> DO
			T_.T[SRCLINK];
		!NOW MAKE THE CONTINUE TO GO WITH IT
		NAME<LEFT>_SRCSIZ;
		QQ_CORMAN();
		T[SRCLINK]_.QQ;
		QQ[OPRCLS]_STATEMENT;
		QQ[SRCID]_CONTID;
		QQ[SRCLBL]_.DL;
		QQ[OPTCONFLG]_1;
		!USE T AS A TEMP
		T_.P[DOLBL];
		T[SNHDR]_.QQ;
		BOTTOM_QQ[SRCLINK]_.SORCPTR<RIGHT>;
		!ALSO SET UP LEND
		LEND_.QQ;
	END;

	ROUTINE UNFUDGDO=
	BEGIN
		!UNDO THE DO LOOP FUDGE SO NO ATTEMPT WILL BE MADE TO
		!GENERATE CODE FOR IT

		EXTERNAL SAVSPACE,QQ;
		MAP BASE QQ;
		LOCAL BASE T;
	MAP BASE TOP;

		!UNFORTUNATELY, WE HAVE TO LEAVE THE DUMMY CONTINUE
		!IN THE PROGRAM TREE. BUT IT WILL NOT DEGRADE THE CODE.

		!ALSO GO THROUGH THE REMAINING STATEMENTS AND
		!RETURN THE OPTIMIZERS CORE TO THE FREE LIST
		!AND ZERO SRCOPT (ELSE THE REGISTER ALLOCATOR
		!ETC WILL THINK IT IS A POINTER TO A LOCAL COMNSUB
		!WATCH OUT !********

		T_.TOP;
		WHILE .T NEQ .BOTTOM DO
		BEGIN
			IF .T[SRCOPT] NEQ 0 THEN
			BEGIN
				SAVSPACE(4,.T[SRCOPT]);
				T[SRCOPT]_0;
				IF .T[SRCID] EQL IFLID THEN
				BEGIN
					!LOGICAL IF STATEMENT
					LOCAL BASE T1;
					T1_.T[LIFSTATE];
					IF .T1[SRCOPT] NEQ 0 THEN
					BEGIN
						SAVSPACE(4,.T1[SRCOPT]);
						T1[SRCOPT]_0;
					END;
				END;
			END;
			T_.T[SRCLINK];
		END;
		!LOOK FOR THE STATMENT IN FRONT OF TOP
		!SO TOP CAN BE SWAPPED WITH THE FIRST STATEMENT
		!SO THAT THE REGISTER ALLOCATOR CAN FIND THE
		!BOUNDS OF THE PROGRAM IF REQUIRED
		T_.SORCPTR<LEFT>;
		!LOOK FOR TOP (CODE MAY HAVE BEEN MOVED TO LENTRY)

		WHILE .T[SRCLINK] NEQ .TOP DO
			T_.T[SRCLINK];
		!SWITCH THEM AROUND
		T[SRCLINK]_.TOP[SRCLINK];
		TOP[SRCLINK]_.SORCPTR<LEFT>;
		SORCPTR<LEFT>_.TOP;
	END;

EXTERNAL MAKASSOC;
FORWARD LABLADJ,DRIVDOALLOC,DOALLOCDECIDE;
%[1047]% PORTAL ROUTINE MRP2 =
BEGIN
EXTERNAL DLOOPTREE,INNERLOOP,TESTREPLACE,SUPPLANT;
EXTERNAL DOTOPROPAGATE;
EXTERNAL LPRDCCT,RDCCT;
EXTERNAL QQ;
MAP BASE QQ;
EXTERNAL CORMAN,BACKST,LOCELMIO;
MAP BASE BACKST;
EXTERNAL MEMCMCHK;
EXTERNAL WARNOPT,WARNERR;
EXTERNAL CDONODE;
EXTERNAL DOCNT;


EXTERNAL  ZTREE;
EXTERNAL  VERYFRST;
LOCAL CURVERYFRST;		! VERYFRST SIXBIT VALUE BEFORE GLOBELIM

!GET OUT IF THIS IS BLOCK DATA
IF .FLGREG<PROGTYP> EQL BKPROG THEN RETURN;

DWP_-1;
ISN_1;

!IF PHASE 1 ISSUED WARNINGS THAT MAY HURT OPTIMIZATION, GIVE A
!WARNING OF THAT FACT NOW

%[1066]% IF .WARNOPT THEN WARNERR(0,E78);

INNERLOOP_FALSE;
DOCNT_0;

RGRAPH_0;
FGRAPH_0;

!INITAILIZE A VARIBALE TO STOP RANDOM USE. IT IS USED IN
!P2REGCNTS, A PART OF PHASE 2 SKELETON
NAME<LEFT>_DOSIZ+SRCSIZ;
CDONODE_CORMAN();
!MAKE LIST OF ASSOCIATE (RANDOM ACCESS I/O) VARIABLE
MAKASSOC();

!CREATE UNIQUE LABELS FOR ALL DO TERMIATIONS AND QUESTIONABLE
!STATEMENTS.
!ALSO CAUSE LOCAL OPTIMIZATIONS TO HAPPEN ON ALL STATEMENTS IN THE PROGRAM
LABLADJ();

!DECIDE ON GLOBAL ALLOCATION POSSIBILITIES
IF .DLOOPTREE NEQ 0 THEN DRIVDOALLOC(.DLOOPTREE);


	!CHECK FOR MAIN PROGRAM WITH NO LOOPS
	IF .DLOOPTREE NEQ 0 THEN
	BEGIN
		LOOPNO_1;			!INITIALIZE LOOPNO
		LOOP_WALKER();			!GET A DO LOOP
		WHILE .LOOP NEQ 0 DO
		BEGIN
			!INDICATE COUNT OF LOOPS FOUND
			DOCNT_.DOCNT+1;
			!SAVE REDUCTION VARIABLE COUNTER SO WE KNOW JOW MANY WERE DONE
			LPRDCCT_.RDCCT;
			DOPARMS(.LOOP);
			!PICK UP THE GLOBAL INFO USED
			GPHBLD();			!BUILD DIRECTED GRAPH
			!SAVE LOTS OF USELESS WORK BY
			!LOOKING FOR
			!DO 10
			!DO 10
			!AS A SPECIAL, OFT OCCURRING CASE
			QQ_.TOP[SRCLINK];
			IF .QQ[SRCID] EQL DOID AND
			.QQ[DOLBL] EQL .TOP[DOLBL] THEN
			BEGIN
				!ADD THE INDEX VARIABLE FOR THE LOOP
				!TO THE DOCHNGL LIST OF THE INNER MORE
				!LOOP
				MAP PHAZ2 QQ:TOP;
				LOCAL BASE TMP;
				EXTERNAL NAME,CORMAN;
				!GET CORE FOR ENTRY
				NAME<LEFT>_1;
				TMP_CORMAN();
				!THE LEFTP FIELD POINTS TO THE INDEX
				!VARIABLE FOR THIS LOOP
				TMP[LEFTP]_.TOP[DOSYM];
				!THE RIGHTP FIELD IS THE LINK TO 
				!THE PREVIOUS DOCHNGL LIST. NOTE:
				!THIS WORKS EVEN IF THE PREVIOUS DOCHNGL IS 0.
				TMP[RIGHTP]_.QQ[DOCHNGL];
				TOP[DOCHNGL]_.TMP;
			END
			ELSE
			BEGIN
				FLOOD();			!MOORE FLOOD
				DEFDRIV();			!GET DEFINITION POINTS
				CURVERYFRST _ MAKNAME (VERYFRST);	! TO BE PASSED TO GLOBDEP
				GLOBELIM(.CURVERYFRST);		!COMMON SUBS AND
							!CODE MOTION
				PROPAGATE();			!CONSTANT PROPAGATION
								!AND REDUCTION IN STRENGTH
				!DO TESTREPLACEMENT IF POSSIBLE
				!REDUCTIONS WERE MADE REPLACING ALL
				!OCCURRENCES OF THE INDEX AND THERE
				!WERE NO LOOP EXITS (REQUIRING THE
				!ACTUAL INDEX TO BE IN CORE).

				IF ((TESTREPLACE() NEQ 0) AND NOT .TOP[HASEXIT]) THEN SUPPLANT();
				GLOBELIM2 _ 1;			! FLAG 2ND CALL
				GLOBELIM(.CURVERYFRST);		! RECALL COMMON SUB ELIM 
				GLOBELIM2 _ 0;
			END;
			DOCOLLAPSE();			!REDUCE LOOP TO A
							!SINGLE NODE FOR GRAPH
							!OF NEXT OUTER LOOP
			LOOP_WALKER();
			LOOPNO_.LOOPNO+1;
		END;
	END;
	!NOW WE ARE UP TO THE MAIN PROGRAM
	LENTRY_.SORCPTR<LEFT>;
	!LOOK FOR A DO LOOP AS THE FIRST STATEMENT AND QUIT HERE
	TOP_.LENTRY[SRCLINK];
	!FOR GLOBAL ALLOCATION NEED TO FUDGE AND UNFUDGE A DO
	FUDGDO();
	IF .TOP[SRCID] EQL DOID AND .DOCNT EQL 1 THEN
	ELSE
	BEGIN
	!INDVAR IS USED AS A POINTER. WE MUST MAKE IT SOMETHING
	!THAT WILL NOT BLOW UP WHEN USED AS A POINTER
	!POOL HAS A ZERO IN IT, SO WE WILL USE POOL

	INDVAR_POOL<0,0>;
	GPHBLD();
	FLOOD();			!MOORE FLOOD
	DEFDRIV();		!DEFINITION POINT
	CURVERYFRST _ MAKNAME (VERYFRST);
	GLOBELIM(.CURVERYFRST);		!CODE MOTION AND COMMON SUBS
	PROPAGATE();		!CONSTANT PROPAGATION AND REDUCTION IN STRENGTH
	GLOBELIM2 _ 1;		! FLAG 2ND CALL
	GLOBELIM(.CURVERYFRST);		! COMMON SUBS ELIM AGAIN
	GLOBELIM2 _ 0;
	END;
	!UNFUDG THE DO LOOP
	UNFUDGDO();


	!TRY TO PROPAGATE .O VARS

	DOTOPROPAGATE();

	ZTREE ();		! ZERO DEFPTS BEFORE LEAVE

	!GET OUT SMOOTHLY
	PASSOUT();

FLGREG<OPTIMIZE>_1;

!***********************************!*!*!*!*!*!*!**!*!*!*!
!NOTE:
!	MAY WANT TO DO THIS INSTEAD OF SETINF EMPTY BIT
!!!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*!*

INCR I FROM 0 TO EHSIZ-1 DO
BEGIN
	EXTERNAL EHASH;
	REGISTER BASE T:GP;
	EXTERNAL SAVSPACE;

	T_.EHASH[.I];

	WHILE .T NEQ 0 DO
	BEGIN
		GP_.T[CLINK];
		SAVSPACE(5,.T);
		T_.GP;
	END;
END;
END;			!END OF MRP2

ROUTINE LABLADJ=
BEGIN
	!GIVE EACH LABEL A UNIQUE CONTINUE STATEMENT AND ADJUST ALL
	!DO LOOPS TO END ON THEIR OWN LABELED CONTINUE. AT THE SAME
	!TIME ELIMINATE REFERENCES TO UNREFERENCED LABELS BY ZEROING
	!THE SRCLBL FIELD OF THE NODE AT WHICH THEY ARE DEFINED.

	!THIS PROCESS SAVES MANY SPECIAL CONTEXT CHECKS AND
	!ADJUSTMENTS. IT THUS ELIMINATES HIGH SEG CODE AT THE
	!EXPENSE OF EXPANDING THE LOW SEGMENT. IT REQUIRES ABOUT
	!106 NEW LABELS TO BE AT THE BREAK EVEN POINT IN SIZE.

	!SOME OF THE SPECIAL CONTEXTS HELPED BY THIS DEVICE ARE
	!	1.DO LOOP ENDINGS WITH REDUCTIONS IN STRENGTH
	!	2.COMMON SUB-EXPRESSIONS
	!	3.RECOMPUTING LABLE INFORMATION FOR GLOBAL REG. ALLOC
	!	4.SPECIAL CASING IN GLOBAL ALLOCATION FOR FUNCTION SAVE/RESTORE
	!	5.DO LOOPS ENDING ON A LOGICAL IF

	!IT ALSO PERMITS ADDITIONAL INFORMATION TO BE KEPT WITH THE DATA
	!STRUCTURE THAT IS PASSED BETWEEN OPTIMIZATION AND GLOBAL ALLOCATION
	!AND ADDITIONAL INFORMATION ABOUT DO LOOPS WITHIN THE OPTIMIZER
	!ITSELF. THIS HAPPENS BECAUSE OF THE UNIQUENESS OF THE DO LOOP
	!ENDING AND ITS LABEL.

	!ALSO CALL FOR LOCAL OPTIMIZATIONS ON EACH STATEMENT

	EXTERNAL MAKCONTINUE,GENLAB;
	EXTERNAL P2SKSTMN,ISN;
	OWN BASE PREV:MADLBL:FIRSTCONT;
	MAP BASE PREV:CSTMNT;
	OWN BASE STMTLBL:NEWCONT:DONODECHAIN:DONODE;
	LABEL PROCSLAB,NEWC;

	!GO THROUGH THE ENCODED SOURCE TREE

	PREV_CSTMNT_.SORCPTR<LEFT>;
	WHILE .CSTMNT NEQ 0 DO
	BEGIN
		ISN_.CSTMNT[SRCISN];
		!CALL FOR LOCAL OPTIMIZATIONS
		P2SKSTMN();

		!INSERT A CONTINUE AFTER EACH DO LOOP NODE
		!SO WE CAN SET BITS ON IT IN THE DEFPT
		!ALGORITHM

		IF .CSTMNT[SRCID] EQL DOID THEN
		BEGIN
			NEWCONT_MAKCONTINUE();
			NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
			CSTMNT[SRCLINK]_.NEWCONT;
		END;


		!IS THE STATEMENT LABELED WITH A REFERENCED LABEL
		PROCSLAB:
		IF .CSTMNT[SRCLBL] NEQ 0 THEN
		BEGIN
			!GET THE LABLE TABLE ENTRY
			STMTLBL_.CSTMNT[SRCLBL];
			FIRSTCONT_0;

			!1. DELETE IT IF UNREFERENCED
			IF .STMTLBL[SNREFNO] EQL 1 AND .CSTMNT[SRCID] NEQ FORMID THEN
			BEGIN
				CSTMNT[SRCLBL]_0;
				LEAVE PROCSLAB;
			END;

		!FOR ALL LABELLED DO LOOPS INSERT
		!A CONTINUE IN FRONT OF THE DO AND
		!MOVE THE LABEL TO THE CONTINUE
		IF .CSTMNT[SRCID] EQL DOID THEN
		BEGIN
			NEWCONT_PREV[SRCLINK]_MAKCONTINUE();
			NEWCONT[SRCLBL]_.STMTLBL;
			CSTMNT[SRCLBL]_0;
			STMTLBL[SNHDR]_.NEWCONT;
			NEWCONT[SRCLINK]_.CSTMNT;
			CSTMNT[DOPRED]_.NEWCONT;	!POINTER TO PREDECESSOR
			LEAVE PROCSLAB
		END;

			!LINK ANY FORMATS OUT. EVENTUALLY PHASE 1 WILL
			!DO THIS AND THERE WILL BE NONE TO LINK OUT
			IF .CSTMNT[SRCID] EQL FORMID THEN
			BEGIN
				PREV[SRCLINK]_.CSTMNT[SRCLINK];
				!IF THIS IS DIRECTLY INFRONT OF
				!A DO LOOP THEN WE HAVE TO
				!ADJUST THE DOPRED FIELD OF THE LOOP
				DONODE_.CSTMNT[SRCLINK];
				IF .DONODE[SRCID] EQL DOID AND
					.CSTMNT EQL .DONODE[DOPRED] THEN
						DONODE[DOPRED]_.PREV;

				CSTMNT_.PREV;
				LEAVE PROCSLAB;
			END;

			!2. ITS ALREADY A CONTINUE WITH A SINGLE DO ENDING AT IT
			IF .CSTMNT[SRCID] EQL CONTID AND (.STMTLBL[SNDOLVL] LEQ 1)
			THEN
				LEAVE PROCSLAB;

			!3. ITS AN ASSIGNMENT STATEMENT WITH:
			!	A. NO USER FUNCTION REFERENCES
			!	B. NO DO LOOPS END AT IT
			IF .CSTMNT[SRCID] EQL ASGNID AND
			NOT .CSTMNT[USRFNREF] AND
			.STMTLBL[SNDOLVL] EQL 0 THEN
				LEAVE PROCSLAB;

			NEWC:
			IF .CSTMNT[SRCID] NEQ CONTID THEN
			BEGIN
				!SPECIAL CASE EXACTLY 1 DO LOOP ENDING
				!HERE WHOSE TERMINATION LABEL
				!IS NOT THE OBJECT OF A TRANSFER

				IF (.STMTLBL[SNREFNO] EQL 2)
				   AND
				   (.STMTLBL[SNDOLVL] EQL 1) THEN
				BEGIN
					FIRSTCONT_1;
					LEAVE NEWC;
				END;
				FIRSTCONT_0;

				!HERE WE HAVE AT A MINIMUM TO MOVE THE
				!LABEL BACK (BETWEEN PREV AND CSTMNT)
				!TO A DUMMY CONTINUE

				!MAKE THE DUMMY CONTINUE
				NEWCONT_PREV[SRCLINK]_MAKCONTINUE();
	
				!ADJUST ALL THE CROSS POINTERS
				!AND FINISH LINKING IT IN
				NEWCONT[SRCLBL]_.STMTLBL;
				CSTMNT[SRCLBL]_0;
				STMTLBL[SNHDR]_.NEWCONT;
				NEWCONT[SRCLINK]_.CSTMNT;
				!FIX REFERENCE COUNT ON LABEL
				IF .STMTLBL[SNDOLVL] NEQ 0 THEN
![1105] Get label count exactly right
%[1105]%			STMTLBL[SNREFNO]_.STMTLBL[SNREFNO]
%[1105]%			  -.STMTLBL[SNDOLVL];
			END;


			!WE CAN QUIT IF NO DO LOOPS END HERE
			IF .STMTLBL[SNDOLVL] EQL 0 THEN
				LEAVE PROCSLAB;


			!CHECK FOR SPECIAL CASE (FIRSTCONT=1)
			IF .FIRSTCONT THEN
			BEGIN
				!GENERATE A CONTIUE AND MOVE STMTLBL TO
				!IT
				NEWCONT_MAKCONTINUE();
				NEWCONT[SRCLBL]_.STMTLBL;
				STMTLBL[SNHDR]_.NEWCONT;
				CSTMNT[SRCLBL]_0;
				NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
				CSTMNT_CSTMNT[SRCLINK]_.NEWCONT;
				LEAVE PROCSLAB;
			END;

			!NO, SORRY, THERE ARE DO LOOPS

			! FOLLOW THE LINKED LIST OF DO LOOPS THAT END
			!HERE MAKING A CONTINUE FOR EACH ONE.

			DONODECHAIN_.STMTLBL[SNDOLNK];

			FIRSTCONT_0;


			WHILE .DONODECHAIN NEQ 0 DO
			BEGIN
				!IF THE STATEMENT IS QUESTION IS A 
				!CONTINUE WE WILL SPECIAL CASE OUT
				!MAKING TWO FOR THE SAME PURPOSE
				IF .CSTMNT[SRCID] NEQ CONTID OR .FIRSTCONT THEN
				BEGIN
					!LOOK AT THE NODE ITSELF
					DONODE_.DONODECHAIN[LEFTP];
					!MAKE A LABEL
					MADLBL_GENLAB();
					DONODE[DOLBL]_.MADLBL;
					NEWCONT_MADLBL[SNHDR]_MAKCONTINUE();
					NEWCONT[SRCLINK]_.CSTMNT[SRCLINK];
					MADLBL[SNREFNO]_2;
					NEWCONT[SRCLBL]_.MADLBL;
					!NO DOES NOW END ON STMTLBL
					!SO ZERO THE SNDOLVL FIELD
					!IF ITS NOT ON A CONTINUE THAT
					!STAYS AROUND
					IF .CSTMNT[SRCID] NEQ CONTID THEN
						STMTLBL[SNDOLVL]_0;

					!NOTE THAT CSTMNT IS UPDATED TO POINT TO
					!THE NEW CONTINUE
					CSTMNT_CSTMNT[SRCLINK]_.NEWCONT;
					FIRSTCONT_1;
				END ELSE
				BEGIN
					MADLBL_.STMTLBL;
					MADLBL[SNREFNO]_.MADLBL[SNREFNO]-.STMTLBL[SNDOLVL]+1;
					FIRSTCONT_1;
				END;

				MADLBL[SNDOLVL]_1;
				MADLBL[SNDOLNK]_.DONODECHAIN;

				!UPDATE TO THE NEXT LOOP IN THE CHAIN.
				!ZERO THE LINK FIELD OF THE OLD CHAIN
				!SO THAT THE SNDOLNK JUST MADE TERMINATES
				!WITH A ZERO.
				NEWCONT_.DONODECHAIN;
				DONODECHAIN_.NEWCONT[RIGHTP];
				NEWCONT[RIGHTP]_0;
			END;	!WHILE ON DONODECHAIN
		END;	!THE STATEMENT IS LABELED

		PREV_.CSTMNT;
		CSTMNT_.CSTMNT[SRCLINK];
	END;	!WHILE ON CSTMNT
END;	!ROUTINE
ROUTINE DOALLOCDECIDE(DODEPTHNODE)=
BEGIN
	!ROUTINE CALLED BY DRIVDOALLOC TO TEST ACTUAL DO LOOPS
	!FOR THE PROPERTIES THAT ALLOW EXTENDED GLOBAL REGISTER
	!ALLOCATION TO OCCUR ON THEM.
	!THESE CONDITIONS ARE:
	!	1. IT IS A SECOND LEVEL LOOP
	!	2. IT CONTAINS ONLY ONE INNER LOOP.

	!DODEPTHNODE POINTS AT A NODE OF THE DO DEPTH ANALYSIS TREE

	MAP BASE DODEPTHNODE;
	LOCAL BASE DONODE:INNERSON;

	!LOOP AT THE DO LOOP NODE ITSELF
	DONODE_.DODEPTHNODE[DOSRC];
	!IF IT IS NOT ITSELF INNERMOST
	IF NOT .DONODE[INNERDOFLG] THEN
	BEGIN
		!LOOK AT THE INNERMORE SON
		INNERSON_.DODEPTHNODE[NEXTDO];
		!NOTE THAT WE ARE SURE THIS FIELD IS NOT ZERO

		!IF, ON THE OTHERHAND, INNERSON IS AN INNERDO
		IF .INNERSON[NEXTDO] EQL 0 THEN
		BEGIN
			!IF THERE ARE NODE PARALLEL TO IT
			!DONODE MEETS THE CRITERIA AND GETS THE FLAG SET

			IF .INNERSON[PARLVL] EQL 0 THEN
				DONODE[EXTALLOC]_1
				ELSE
				DRIVDOALLOC(.INNERSON);
		END ELSE
		!THERE ARE MORE FURTHER IN. LOOK AT THEM BY
		!RECURSING ON THE DRIVER
			DRIVDOALLOC(.INNERSON);
	END;
END;
ROUTINE DRIVDOALLOC(DODEPTHNODE)=
BEGIN
	!DRIVE A SEPARATE WALK OF THE DO DEPTH ANALYSIS TREE
	!TO FIND AND MARK LOOPS THAT POTENTIALLY CAN HAVE
	!GLOBAL ALLOCATION EXTENDED TO THEM.

	MAP BASE DODEPTHNODE;

	!ITERATE ON THE PARALLEL LOOPS. IF THERE ARE NONE
	!THE INITIAL CALL TO DRIVDOALLOC IS WITH  DLOOPTREE
	!SO IT WONT BE ZERO AND WE WILL JUST WALK DOWN
	WHILE .DODEPTHNODE NEQ 0 DO
	BEGIN
		DOALLOCDECIDE(.DODEPTHNODE);
		DODEPTHNODE_.DODEPTHNODE[PARLVL];
	END;
END;
SAVE17_.SREG<0,36>;	! SAVE STACK VALUE FOR EXITS
MRP2();
POPJ(#17,0)
END ELUDOM