!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR NORMA ABEL/HPW/JNG/DCE
MODULE DEFPT(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4)=
BEGIN

GLOBAL BIND DEFPV = 5^24 + 1^18 + 119;	!VERSION DATE: 2-JUN-77


%(
REVISION HISTORY

92	-----	-----	GENERATE DEFPTS IN I/O LISTS
93	-----	-----	REMOVE 2ND PARAMTER TO GETDEF
94	-----	-----	MAKE SETGTRD GLOBAL AND RETURN A VALUE INSTEAD
			OF SETTING GOTVAL
95	-----	-----	ADD ELIST HANDLING TO ALL LEVELS
96	-----	-----	PUT PARAMETER TO GETDEF BACK
97	-----	-----	FIX DEF1 TO PREVENT MOTION INTO DO LOOPS
			THAT HAPPEN TO BE TOP[BUSY] = TOP[SRCLINK]
98	-----	-----	CALL IOSTDFPT FOR ENCODE/DECODE/READ/WRITE
99	-----	-----	EXTRACT CASE STATEMENT FROM SETGTRD AND
			MAKE A GLOBAL ROUTINE READHERE
100	-----	-----	ADD REREDID TO I/O OPTIMIZATIONS
101	-----	-----	FIX SETONSUC SERIOUS CONCEPT PROBLEM
			CAUSING INCORRECT MOTION
102	-----	-----	FIXES TO LOKELIST, READHERE, AND SETGTRD
			FOR I/O OPTIMIZATION
103	-----	-----	SELECT AND SET VARIABLES ASSIGNED ON
			THE I/O LIST
104	-----	-----	CLEAN UP AND CREATE DEFWORK
105	-----	-----	FIX 104
106	-----	-----	ADD CODE FOR MOTION OF SIMPLE ASSIGNMENTS
107	-----	-----	FIX 106
108	-----	-----	ADD CODE FOR ARRAY COMMON SUB EXPRESSIONS
109	-----	-----	MOVE CALL TO CLEABUP OUT OF DEFDRI INTO
			PROPAGATE
110	-----	-----	FIX LABEL TEST IN SPECBRCHK
111	-----	-----	SORT MULTIPLY NODES FOR BETTER REDUCTION
112	-----	-----	MAKE DEF PT STUFF IN GENERAL AWARE OF THE
			FACT THAT AN IMPLIED DO LOOP CHANGES THE
			VALUE OF THE DO LOOP INDEX
113	-----	-----	SELECTIT, ETC. IS MISHANDLING LABELS
114	-----	-----	DEFWORK NOT TAKING ACCOUNT OF ASSIGN
			STATEMENTS
115	235		FIX NAMELIST PROBLEM
116	252	14967	SELECTIT NOT CHECKING FOR SPECOP AND POSSIBLY OTHER OPS
117	315	16667	FIX VDEFPT TO RECOGNIZE ARRAYREFS WITH CONSTANT
			SUBSCRIPTS, NOT OPTIMALLY, BUT AT LEAST NOT WRONG
118	453	19695	DON'T CONSIDER THE DEFPT OF VARIABLES MODIFIED
			INSIDE LOOPS TO BE THE DO STATEMENT.

***** BEGIN VERSION 5A *****

119	575	22820	MAKE ZAPLEVEL MORE CLEVER IN USE OF THE STACK
			TO PREVENT STACK OVERFLOWS.

END OF REVISION HISTORY
)%

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

!THE CONTROLLING ROUTINE IN THIS MODULE IS DEFDRIV. IT IS
!CALLED FROM PHA2. IT DIRECTS THE CALLING OF ALL THE OTHER
!(LOCAL) ROUTINES IN THIS MODULE. THE READER SHOULD START WITH
!THE ROUTINE DEFDRIV. IT APPEARS AT THE END OF THE MODULE
!(SAVE FOR INITDEF).


EXTERNAL LENTRY,QQ;
EXTERNAL ASSOCPT;
OWN PCE;
MAP BASE ASSOCPT;		!USED FOR LINKED LIST OF ASSOCIATE VARIABLES
MAP PEXPRNODE PCE;
OWN P,PA,PB,PC,HEAD,PAE;
OWN MOREFLG,LSTVAR,T;
EXTERNAL TOP,BOTTOM,CHOSEN,LOOPNO,LOOKUP;
MAP PHAZ2 P:QQ:PA:PB:PC:HEAD:PAE;
OWN MASK,CHNGLST;
OWN DISPIX;		!PLIT DISPATCH INDEX
FORWARD CHKNAML,CHKUNIQ;

OWN GOTVAL;		!FLAG FOR ASSIGNED HERE
			!THAT IT GIT IT VALUE HERE

!DISPATCH TO USE FCNLOK TO BOTH SELECT ANS SET BITS.
!A SPACE ECONOMY AT A SLIGHT TRADE OFF IN TIME.

FORWARD SELECTIT,SETIT,SETGOTVAL;
BIND SETSEL = PLIT (
			SELECTIT,
			SETIT,
			SETGOTVAL);


FORWARD DEFWORK;

ROUTINE LOKELIST(EPTR)=
BEGIN
	!EXAMINE E1 AND E2 LISTS AND CALL THE CORRECT
	!SELSEL ROUTINE.
	!EPTR POINTS TO THE ELIST NODE.

	MAP BASE EPTR;

	REGISTER BASE ELEM;

	WHILE .EPTR NEQ 0 DO
	BEGIN
		ELEM_.EPTR[E2ARREFPTR];
		IF .ELEM[OPRCLS] EQL DATAOPR THEN
			(.SETSEL[.DISPIX])(.ELEM)
		ELSE
			(.SETSEL[.DISPIX])(.ELEM[ARG1PTR]);
		EPTR_.EPTR[CLINK];
	END;
END;

!
!
!*****************************************************
!
!
ROUTINE SELECTIT(VAR)=
BEGIN
EXTERNAL CORMAN,UNIQVAL,UNLIST,SAVSPACE;
MAP PHAZ2 CHNGLST:TOP:UNIQVAL;
MAP PEXPRNODE VAR;
!SELECT VARIABLES TO PARTICIPATE IN THE DEFINITION POINT 
!THE FIELD IDCHOS (IN THE SYMBOL TABLE) IS SET TO THE
!LOOP NUMBER TO INDICATE THAT THIS VARIABLE WAS CONSIDERED IN THIS
!LOOP. IDDEF INDICATES THAT THE VARAIBLE HAS PARTICIPATED IN THE
!DEFINITION POINT COMPUTATION.
!32 VARIABLES ARE SELECTED. THERE ADDRESS ARE PUT INTO THE VECTOR CHOSEN.

!AS A VARIABLE IS CHOSEN IT IS ALSO ADDED TO THE LIST OF VARIABLES
!THAT ARE CHANGED IN THIS LOOP WHICH IS KEPT WITH THE DO LOOP
!AFTER PROCESSING AS IT GOES FORTH INTO THE OUTSIDE WORLD.

!THE VARIABLE LSTVAR IS USED TO HOLD THE PLACE OF THE ALGORITHM IN
!PROCESSING STATEMENTS IN CASE MORE THAN 32 EXIST.
!ALGORTHM
	!FIRST CHECK VALIDITY OF PARAMETER. IT SHOULD BE A DATAOPR
	!OR AN ARRAYREF
	IF .VAR[OPRCLS] EQL LABOP THEN
		RETURN
	ELSE
	IF .VAR[OPRCLS] EQL DATAOPR THEN
	BEGIN
		IF .VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN THEN
			RETURN;
	END ELSE
	IF .VAR[OPRCLS] EQL ARRAYREF THEN
	BEGIN
		SELECTIT(.VAR[ARG1PTR]);
		RETURN;
%**;[252],DEFPT,JNT,05-MAR-75%
%**;[251],IN SELECTIT @ 3634%
	END ELSE	![252] IF NONE OF THE ABOVE
	RETURN;		![252] THEN GET OUT

	!HERE WE HAVE A SYMBOL TABLE ENTRY
	!SO WE WILL PROCESS IT.

	VAR[IDCHOS]_.LOOPNO;
	IF .T LSS 32 AND NOT .VAR[IDDEF] THEN
	BEGIN

		!EQUIVALENCED VARIABLES ARE NOT HANDLED
		IF .VAR[IDATTRIBUT(INEQV)] THEN RETURN;

		IF .VAR[IDATTRIBUT(INCOM)] THEN 
			PC_.VAR[IDCOMMON] ELSE
			PC_.VAR;
		INCR K FROM 0 TO 31 DO
			IF .CHOSEN[.K] EQL .PC THEN
			BEGIN
				CHKUNIQ(.PC);
				RETURN;
			END;

		!IF WE ARE HERE THE VARIBALE IS NOT ALREADY
		!SELECTED. SO WE WILL DO THAT NOW
			CHOSEN[.T]_.PC;
			VAR[IDDEF]_1;
			T_.T+1;
			!ADD THIS VARIABLE TO THE LIST OF
			!CHANGED IN THIS LOOP
			PC_.CHNGLST;
			NAME<LEFT>_CHNGSIZ;
			CHNGLST_CORMAN();
			IF .PC NEQ 0 THEN
				PC[RIGHTP]_.CHNGLST
			ELSE
				TOP[DOCHNGL]_.CHNGLST;
			CHNGLST[LEFTP]_.VAR;
			IF .T EQL 32 THEN LSTVAR_.P;

			!BUILD ITEM ON UNIQUE VALUE LIST TOO.

			PC_.UNIQVAL;
			NAME<LEFT>_UNIQSIZ;
			UNIQVAL_CORMAN();
			UNIQVAL[RIGHTP]_.PC;
			!PUT VARIABLE IN IN ALL CASES
			UNIQVAL[LEFTP]_.VAR;
			!SAVE ISN
			UNIQVAL[OPTISNVAL]_.ISN;
	END ELSE
	!THIS IS POTENTIALLY AN ADDITIONAL ASSIGNMENT AND WE NEED
	!TO TAKE IT OFF THE UNIQUE VALUR LIST
	CHKUNIQ(.VAR);
END;


ROUTINE CHKUNIQ(VAR)=
BEGIN

	EXTERNAL UNIQVAL,SAVSPACE,UNLIST;
	MAP PHAZ2 UNIQVAL:PC:VAR;

	!REMOVE VAR FROM UNIQUE VALUE LIST

		PC_.UNIQVAL;
		WHILE .PC NEQ 0 DO
		BEGIN
			!IF ITS ON THE LIST AND THE ISNS DO NOT MATCH
			!TAKE IT OFF
			IF .PC[LEFTP] EQL .VAR THEN
			BEGIN
				IF .PC[OPTISNVAL] NEQ .ISN THEN
					IF UNLIST(.UNIQVAL,.VAR,UNIQSIZ)
					THEN
					BEGIN
						PC_.UNIQVAL;
						UNIQVAL_.UNIQVAL[RIGHTP];
						SAVSPACE(UNIQSIZ-1,.PC);
					END;
					RETURN;
			END;
			PC_.PC[RIGHTP];
		END;
END;

!*****************************************************
ROUTINE THROINCOMMON=
BEGIN
	!PUT COMMON VARIABLES ON THE CHOOSEN LIST

	MAP BASE PCE;

		!DONT DO IT FOR HEARVALUED STUFF (DISPIX=2)
		IF .DISPIX EQL 2 THEN RETURN;

		INCR K FROM 0 TO SSIZ-1 DO
		BEGIN
			PCE_.SYMTBL[.K];
			WHILE .PCE NEQ 0 DO
			BEGIN
				IF .PCE[IDATTRIBUT(INCOM)] THEN
					(.SETSEL[.DISPIX])(.PCE);
				PCE_.PCE[CLINK];
			END;
		END;
END;
ROUTINE ANPARMS(ARGLSTPT)=
BEGIN
	!PUT THE PARAMETERS ON THE PARAMTER LIST (ARGLSTPT)
	!ON THE CHOSEN LIST

	MAP ARGUMENTLIST ARGLSTPT;

	MAP BASE PCE;
			INCR K FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
			BEGIN
				(.SETSEL[.DISPIX])(.ARGLSTPT[.K,ARGNPTR]);
			END;
END;

ROUTINE RSORT(CNODE)=
BEGIN

	!SORT THIS MULTIPLY NODE SO THAT THE DO LOOP
	!INDUCTION VARIABLE (INDVAR) IS ON THE TOP
	!OF ANY NARY TREE. IT WILL ALSO PUT IT TO THE
	!RIGHT ON BINARY TREES.

	EXTERNAL SWAP2DOWN,INDVAR;

	MAP BASE CNODE;

	REGISTER BASE T;

	!IS IT A BOTTOM MOST TREE
	IF .CNODE[A1VALFLG] AND .CNODE[A2VALFLG] THEN
	BEGIN
		!SWITCH ARGS IF THE DO LOOP VARIABLE IS
		!ARG1
		IF .CNODE[ARG1PTR] EQL .INDVAR THEN
		SWAPARGS(CNODE);
	END ELSE
	BEGIN
		!IT IS NOT A BOTTOM-MOST TREE. CHECK FOR NARY
		!DOWNWARD

		T_.CNODE[ARG1PTR];

		IF NARYNODE(T,CNODE) THEN
		BEGIN
			!IF THE LOWER BRANCH IS A LEAF AND THE INDUCION
			!VARIABLE THEN SWITCH THEM
			IF .T[ARG2PTR] EQL .INDVAR THEN
				SWAP2DOWN(.CNODE,.T);
		END;
	END;
END;

ROUTINE FCNLOK(EXPR)=
BEGIN
	!EXAMINE EXPRESSION EXPR FOR FUNCTION REFERENCES
	!IF ANY ARE FOUND PUT COMMON AND THE PARAMETERS ON THE
	!SELECTED LIST (THE VECTOR CHOSEN).

	MAP BASE EXPR;

	CASE .EXPR[OPRCLS] OF SET
	!BOOLEAN
	BEGIN
		FCNLOK(.EXPR[ARG1PTR]);
		FCNLOK(.EXPR[ARG2PTR]);
	END;
	!DATAOPR
		RETURN;
	!RELATIONAL
	BEGIN
		FCNLOK(.EXPR[ARG1PTR]);
		FCNLOK(.EXPR[ARG2PTR]);
	END;
	!FNCALL
	BEGIN
		IF .EXPR[OPERSP] NEQ LIBARY THEN
		BEGIN
			THROINCOMMON();
			ANPARMS(.EXPR[ARG2PTR]);
		END;
	END;
	!ARITHMETIC
	BEGIN
		FCNLOK(.EXPR[ARG1PTR]);
		FCNLOK(.EXPR[ARG2PTR]);

		!IF WE ARE SELECTING (DISPIX=0) THEN
		!SORT MULTIPLIES TO IMPROVE REDUCTIONS

		IF .DISPIX EQL 0 THEN
			CASE .EXPR[OPERSP] OF SET
			%ADD% ;
			%SUB% ;
			%MULTIPLY%
			RSORT(.EXPR);
			%DIV% ;
			%EXP% BEGIN END
			TES;
	END;
	!TYPECNV
		FCNLOK(.EXPR[ARG2PTR]);
	!ARRAYREF
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			FCNLOK(.EXPR[ARG2PTR]);
	!CMNSUB
		RETURN;
	!NEGNOT
		FCNLOK(.EXPR[ARG2PTR]);
	!SPECOP
		FCNLOK(.EXPR[ARG1PTR]);
	!FIELDREF
		RETURN;
	!STORECLS
		RETURN;
	!REGCONTENTS
		RETURN;
	!LABOP
		RETURN;
	!STATEMENT
		RETURN;
	!IOLSCLS
		RETURN;
	!INLINFIN
	BEGIN
		FCNLOK(.EXPR[ARG1PTR]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		FCNLOK(.EXPR[ARG2PTR]);
	END
	TES;
END;

ROUTINE ASSOCIA=
BEGIN
	!LOOK AT LINKED LIS OF ASSOCIATE VARIABLES (FROM OPENS OR
	!DEFINE FILES AND SELECT, SET OF INDICATE SET HERE FOR
	!THESE VARIABLES. THE MODULE OWN DISPIX IS SET TO CALL THE
	!CORRECT ROUTINE BY THE CALLER OF THIS ROUITNE.

	REGISTER BASE LP;

	LP_.ASSOCPT;
	WHILE .LP NEQ 0 DO
	BEGIN
		(.SETSEL[.DISPIX])(.LP[LEFTP]);
		LP_.LP[RIGHTP];
	END;
END;

!MACRO TO TEST RANDOM ACCESS PROPERTY OF AN I/O STATEMENT
!POINTED TO BY P AND CALL THE CORRECT SETSEL ROUTINE

MACRO RANDIO(P)=
BEGIN
	IF .P[IORECORD] NEQ 0 THEN
	BEGIN
		ASSOCIA();
		THROINCOMMON();
	END;
END$;

ROUTINE DEF0 =

BEGIN
	!LOOK AT STATEMENTS THAT POTENTAILLY ASSIGN A VALUE TO A
	!VARIABLE. CALL THE ROUTINE SELECTIT TO SELECT THE
	!VARIABLE. FUNCTIONS WITH SIDE EFFECTS WILL PRODUCE
	!BAD RESULTS.

	EXTERNAL CSTMNT,ISN;
	MAP BASE CSTMNT;

	MAP BASE PCE;

	MAP PHAZ2 TOP;

	!SET DISPATCH INDEX TO EXECUTE SELECTIT
	DISPIX_0;
	LSTVAR_-1;		!INITIALIZE LSTVAR
	!ALSO INITIALIZE CHOSEN
	DECR I FROM 31 TO 0 DO
		CHOSEN[.I]_0;
	!MAKE SURE WE GET THE INDUCTION VARIABLE
	IF .TOP[SRCID] EQL DOID THEN
		SELECTIT(.TOP[DOSYM]);

	!PICK FIRST 32 UNIQUE LHS TO PROCESS
	DO
	BEGIN
		CSTMNT_.P;
		ISN_.P[SRCISN];
		DEFWORK(.P);

		!TEST FOR JUST HAVING FILLED UP THE 32
		!IF WE DONT TEST NOW BY THE TIME WE UPDATE
		!P WE WILL HAVE PASTED LSTVAR

		IF .P EQL .LSTVAR THEN
		BEGIN
			MOREFLG_1;
			RETURN;
		END;

		P_.P[BUSY];
	END UNTIL  .P EQL 0 OR .P EQL .LSTVAR;
	IF .P EQL 0 THEN MOREFLG_0;
END;

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

ROUTINE SETIT(VAR)=
BEGIN
	!SET THE BIT IN THE ACC FIELD OF THE MODULE-OWN,P,
	!TO INDICATE THAT THE VARIABLE VAR IS DEFINED AT
	!SOME PREDECESSOR OF P.

	MAP BASE VAR; MAP PHAZ2 P;

	LOCAL I;

	IF .VAR[IDDEF] THEN		!THIS VARIABLE IS ELIGIBLE FOR
					!CONSIDERATION
	BEGIN
		I_LOOKUP(.VAR);

		IF .I LSS 32 THEN
			P[ACC]_SETBIT(.P[ACC],.I);
	END;
END;

ROUTINE DEFCHANGE(STMT)=
BEGIN
	!EXAMINE STATEMENTS THAT CAUSE VALUES OF VARAIBLES TO CHANGE
	!AND CALL SETIT OR SETREAD TO SET BITS IN THE MASK FOR THAT
	!WORD. MASK EXPLAINED IN COMMENTS THAT GO WITH DEF1.
	!NOTE:
	!THE BIT WILL BE SET IN THE MASK ASSOCIATED WITH THE MODULE
	!OWN P WI;HICH POINTS TO A STATEMENT.
	MAP PHAZ2 STMT;
	IF .STMT[SRCID] GTR REREDID THEN RETURN;

	!NOTHING ABOVE REREAD IS OF CONCERN

		!SET MODULE OWN THAT IS INDEX TO DISPATCH
		DISPIX_1;

	DEFWORK(.STMT);
END;


ROUTINE ONLYONEPRED(NODE)=
BEGIN
	!A VERSION TWO ROUTINE TO CHECK IF A NODE
	!HAS ONLY ONE PREDECESSOR. CURRENTLY ONLY USED IN
	!CONJUNCTION WITH ZAPLEVEL (IMMEDIATELY FOLLOWING)
	!IF THE NODE HAS A SINGLE PREDECOSSOR A POINTER
	!TO THAT PREDECESSOR IS RETURN ELSE 0 IS RETURNED.

	!THE GLOBAL QQ IS USED AS A TEMP.

	EXTERNAL QQ;
	REGISTER PHAZ2 T;
	MAP PHAZ2 NODE:QQ;

	T_.NODE[PREDPTR];		!START OF PREDECESSOR CHAIN
	QQ_.T[CESLNK];			!LINK TO NEXT ON CHAIN
	!IF QQ IS POINTING TO A ZERO WORD THERE IS ONLY ONE PREDECESSOR
	IF .QQ[CESLNK] EQL 0 THEN
		RETURN (.T[CESSOR])  	!RETURN THAT PREDECESSOR
	ELSE
		RETURN 0
END;

ROUTINE ZAPLEVEL(PRED)=
BEGIN
	!ROUTINE ZEROES THE LEVEL FIELD FOR ALL NODES ON ALL
	!PATHS BETWEEN PRED (A STATEMENT NODE) AND .P[PREDOM].
	!P IS SET UP EXTERNALLY TO THIS ROUTINE. AN EFFORT
	!IS MADE NOT TO RECURSE FOR STRAIGHT LINE PATHS,
	!THUS MINIMIZING THE STACK REQUIRED.

	MAP PHAZ2 PRED;
	OWN NODE,SINGLPRED;
	MAP PHAZ2 NODE;
!**;[575], ZAPLEVEL @4058, DCE, 2-JUN-77
!**;[575], REMOVE THE LOCAL SYMBOL PLSTPTR SO THAT LESS STACK SPACE
!**;[575], WILL BE USED DURING RECURSIVE CALLS OF THIS ROUTINE.  THE
!**;[575], VARIABLE PRED WILL NOW DO DOUBLE DUTY - COMING IN AS THE
!**;[575], STATEMENT NODE, AND BEING USED TO CYCLE THROUGH ALL OF THE
!**;[575], PREDECESSORS OF THE ORIGINAL PARAMETER.  THIS CHANGE
!**;[575], REDUCES THE STACK SPACE USED FROM 4 TO 3 LOCATIONS PER CALL
!**;[575], TO THIS ROUTINE.


%[575]%	PRED_.PRED[PREDPTR];
!**;[575], PRED IS NOW THE PTR TO THE PREDECESSOR LIST OF THE ORIGINAL PRED

	!FOR EACH PREDECESSOR ON THE LIST
%[575]%	WHILE .PRED[CESLNK] NEQ 0 DO
	BEGIN
		!POINTER TO AN ACTUAL PREDECESSOR
%[575]%		NODE_.PRED[CESSOR];

		!SET THE FLAG THAT HELPS US ITERATE INSTEAD OF RECURSING
		SINGLPRED_1;

		!NOW ITERATE
		WHILE .SINGLPRED DO
		BEGIN
			!IS THIS NODE ELIGIBLE, I.E.
			!	IS IT NOT P[PREDOM]
			!	DOES THE LEVEL FIELD NEED TO BE  ZEROED
			IF .NODE NEQ .P[PREDOM] AND .NODE[LEVEL] NEQ 0 THEN
			BEGIN
				!YES TEH NODE IS ELIGIBLE
				!ZERO THE LEVEL FIELD
				NODE[LEVEL]_0;
				!NOW SEE IF IT HAS A SINGLE PREDECESSOR
				IF (QQ_ONLYONEPRED(.NODE)) NEQ 0 THEN
					!SET NODE TO THE PREDECESSOR
					!RETURNED BY ONLYONEPRED AND
					!ITERATE
					NODE_.QQ
				ELSE
				BEGIN
					!THERE IS MORE THAN ONE
					!PREDECESSOR, SO WE MUST RECURSE
					ZAPLEVEL(.NODE);
					!RESET THE FLAG INDICATING ITERATION
					!RATHER THAN RECURSION.
					SINGLPRED_0;
				END;
			END ELSE
				!THE NODE IS NOT ELIGIBLE
				!RESET FLAG TO STOP LOOP
				SINGLPRED_0;
		END;		!WHILE ON SONGLPRED

		!NOW LOOK AT THE NEXT PREDECESSOR ON THE LIST
!**;[575], ZAPLEVEL @4106, DCE, 2-JUN-77
%[575]%		PRED_.PRED[CESLNK];
	END;		!WHILE THERE ARE PREDECESSORS
END;	!ROUTINE ZAPLEVEL


ROUTINE SWAMP=
BEGIN
	!MAKE AND FOLLOW A MOORE FLOOD ORDERING OF NODES BETWEEN
	!P AND P[PREDOM] SETTING BITS IN THE MASK AT P FOR
	!VARIABLES CHANGED AT ANY OF THE NODES TRAVERSED.

	MAP PHAZ2 P:T;
	OWN PHAZ2 TAIL;

	TAIL_HEAD_.P;

	!WHILE CONDITION WILL STOP ON ZERO OR THE FIELD SET TO 1 (PROCESSED MARK).
	WHILE .HEAD GTR #1000 DO
	BEGIN
		!PROCESS THE PREDECESSORS OF HEAD
		T_.HEAD[PREDPTR];
		WHILE .T[CESLNK] NEQ 0 DO
		BEGIN
			PA_.T[CESSOR];
			!PA IS NOW A REAL SUCCESSOR
			!IF IT IS NOT ALREADY DONE OR THE PREDOMINAATOR OF P
			!PROCESS IT
			IF .PA NEQ .P[PREDOM] THEN
			BEGIN
				IF .PA[LEVEL] EQL 0 THEN
				BEGIN
					!NOTE PA PROCESSED BY SETTING LEVEL NON-ZERO
					PA[LEVEL]_1;
					!ADD IT TO THE END OF THE CHAIN
					TAIL[LEVEL]_.PA;
					!UPDATE THE TAIL OF THE CHAIN
					TAIL_.PA;
					!SET THE %&$#% BIT
					DEFCHANGE(.PA);
				END;
			END;
			T_.T[CESLNK];
		END;
		HEAD_.HEAD[LEVEL];
	END;		!WHILE ON HEAD;
!**;[453] Insert @ line 4130 in SWAMP	JNG	18-Sep-76
%[453]%	!IF P'S PREDOMINATOR IS A DO STATEMENT WHICH ISN'T TOP, THEN
%[453]%	!SET THE BITS IN P FOR ALL VARS CHANGED IN THE LOOP.
%[453]%	PA_.P[PREDOM];
%[453]%	IF (.PA NEQ .TOP) AND (.PA[SRCID] EQL DOID) THEN
%[453]%		DEFCHANGE(.PA);
END;

FORWARD SPECBRCHK;
ROUTINE DEF1 =
BEGIN
	 MAP PHAZ2 T;
	!
	!INITIALIZE ACC FOR DEFINITION POINT CALCULATION
	!DETERMINE IF THERE IS AN INTERFERRING
	!ASSIGNMENT BETWEEN NODE AND IMMEDIATE
	!PREDOMINATOR

	!THE INITIALIZATION ALGORITHM IS:
	!1.	LOOK AT ALL IMMEDIATE PREDECESSORS OF A NODE
	!2.	IF THE PREDECESSOR IS NOT THE PREDOMINATOR THEN
	!	SET THE BIT IN THE MASK WHICH CORRESPOND TO ANY
	!	VARIABLE ASSIGNED A VALUE AT THAT PREDECESSOR.

	!A SPECIAL CASE IS THE FIRST STATEMENT AFTER THE DO LOOP
	!TO PREVENT COMPUTATIONS THAT ARE COMPOSED OF VARIABLES
	!ASSIGNED IN THE LOOP FROM ERRONEOUSLY MOVING OUTSIDE THE LOOP
	!THIS STATEMENT WILL HAVE THE BITS SET FOR ALL THE VARIABLES
	!ON THE DOCHNGL LIST TOO.

	MAP PHAZ2 TOP;
	EXTERNAL CSTMNT,ISN;
	LOCAL BASE ITM;
	MAP BASE CSTMNT;
	!
	P_.TOP;
	P[ACC]_0;
	P_.TOP[BUSY];
	!THE SPECIAL CASE

	IF .P EQL .TOP[SRCLINK] THEN
	BEGIN
		LOCAL SAVP;

		SAVP_.P;

		!A SPECAIL CASE OF THE SPECIAL CASE
		!IF THIS IS A DO LOOP SET THE BITS ON THE
		!CONTINUE AND NOT ON THE LOOP

		IF .P[SRCID] EQL DOID THEN
		BEGIN
			P_.P[DOLBL];
			P_.P[SNHDR];
		END;

		ITM_.TOP[DOCHNGL];
		WHILE .ITM NEQ 0 DO
		BEGIN
			!DOCHNGL IS A LINKED LIST
			!THE LEFT HALF OF THE WORD
			!POINTS TO THE VARIABLE, THE RIGHT
			!HALF TO THE NEXT LIST ITEM. IT IS
			!TERMINATED WITH A ZERO

			SETIT(.ITM[LEFTP]);
			ITM_.ITM[RIGHTP];
		END;
	IF .TOP[SRCID] EQL DOID THEN SETIT(.TOP[DOSYM]);
	!RESTORE SAVED VALUE OF P AND PROCEED
	P_.SAVP;
	END;

	!THE CAST OF CHARACTERS FOR THE NEXT WHILE LOOP IS
	!P THE STATEMENT ON WHICH MASK BITS ARE INITIALIZED
	!IF THE PREDECESSOR IS THE PREDOMINATOR SET NO BITS
	!IF  NOT ZERO THE LEVEL FIELD OF THE
	!OPTIMIZERS WORDS AND USE IT TO FLOOD AND SET BITS
	!FOR ALL VARIABLES ASSIGNED AT ALL NON_PREDOMINATING
	!PREDECESORS.
	!FOR ALL STATEMENTS
	DO
	BEGIN
		!FOR A DO LOOP THAT IS NOT TOP SET THE BITS ON THE
		!DO LOOP TOO INCASE SOMETHING BELOW THE TERMINATOR
		!IS NOT PREDOMINATED BY THE YERMINATOR

		IF .P NEQ .TOP AND .P[SRCID] EQL DOID THEN
		BEGIN
			ITM_.P[DOCHNGL];
			WHILE .ITM NEQ 0 DO
			BEGIN
				!DOCHNGL IS A LINKED LIST
				!THE LEFT HALF OF THE WORD
				!POINTS TO THE VARIABLE, THE RIGHT
				!HALF TO THE NEXT LIST ITEM. IT IS
				!TERMINATED WITH A ZERO
	
				SETIT(.ITM[LEFTP]);
				ITM_.ITM[RIGHTP];
			END;
		END;

		!TRY TO ELIMINATE SOME TIME AND EFFORT BY NOT
		!DOING THIS FOR A NODE IF IT HAS 1 PREDECESSOR
		!WHICH (BY DEFINITION) IS ITS PREDOMINATOR
		!SET THE LEVEL FIELD OF P[PREDOM] TO BE NON-ZERO
		T_.P[PREDOM];
		T[LEVEL]_1;
		!NOW START CHECKING ON PREDECESSORS
		T_.P[PREDPTR];
		!T IS A POINTER TO THE PREDECESSOR LIST
		PA_.T[CESLNK];
		!PA POINTS TO THE NEXT LINK
		T_.T[CESSOR];
		!T POINTS TO FIRST PREDECESSOR
		!MAKE SURE THERE ARE NONE OTHERS
		!PA POINTS TO NEXT LINK WORD. IF THERE IS ONLY ONE
		!PA IS A POINTER TO A WORD OF ZEROES.
		!THIS IS A DOUBLE SAFE CHECK. IF BLISS EVER DOES BETTER
		!ON BOOLEANS IT WILL ELIMINATE BUMMERS FAST.
		IF .T NEQ .P[PREDOM] OR .PA[CESLNK] NEQ 0  THEN
		BEGIN
			!TO INSURE AGAINST A FLUKE
			P[LEVEL]_0;
			ZAPLEVEL(.P);
			SWAMP();
		END
		!ON THE OTHERHAND IF THIS IS A SINGLE  PREDECESSOR
		!AND IT IS THE PREDOMINATOR AND IT IS A DO LOOP
		!WE WANT TO SET THE BITS FOR ALL VARIABLES IN THE LOOP
		ELSE
			IF .PA[CESLNK] EQL 0 AND .T[SRCID] EQL DOID THEN
				DEFCHANGE(.T);
		P_.P[BUSY];
	END UNTIL .P EQL 0;

	!CALL ROUTINE TO CHECK BRANCHES THAT SET VALUES
	!SEE COMMENTS IN CALLED ROUTINE FOR DETAILS

	SPECBRCHK();
END;


!*******************************************************
!
!*******************************************************
!
MAP PHAZ2 PB;
ROUTINE SETGOTVAL(VAR)=
BEGIN
	!THE GLOBAL TREEPTR POINTS TO S SYMBOL TABLES ENTRY.
	!IF  IT EQUALS VAR THEN SET GOTVAL TO 1
	EXTERNAL TREEPTR;

	IF .VAR EQL .TREEPTR THEN GOTVAL_1;
END;

GLOBAL ROUTINE READHERE(IOLSTT)=
%(**********************************************************************

	ROUTINE TO DETERMINE IF A VARIABLE WAS INITIALIZED
	AT THE IOLSCLS ELEMENT IOLSTT

**********************************************************************)%
BEGIN
EXTERNAL TREEPTR;
MAP BASE IOLSTT;
	CASE .IOLSTT[OPERSP] OF SET
%DATACALL%	BEGIN
		LOCAL BASE ELEM;
		ELEM_.IOLSTT[DCALLELEM];
		IF .ELEM[OPRCLS] EQL DATAOPR THEN
			(.SETSEL[.DISPIX])(.ELEM)
		ELSE
			(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
		END;
%SLISTCALL%	BEGIN
		LOCAL BASE ELEM;
		ELEM_.IOLSTT[SCALLELEM];
		IF .ELEM[OPRCLS] EQL DATAOPR THEN
			(.SETSEL[.DISPIX])(.ELEM)
		ELSE
			(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
		END;
%IOLSTCALL%	BEGIN
		LOCAL BASE IOELEM;
		IOELEM_.IOLSTT[IOLSTPTR];
		WHILE .IOELEM NEQ 0 DO
		BEGIN
			READHERE(.IOELEM);
			IOELEM_.IOELEM[CLINK]
		END
		END;
%E1LISTCALL%	BEGIN
		LOKELIST(.IOLSTT[ELSTPTR])
		END;
%E2LISTCALL%	BEGIN
		LOKELIST(.IOLSTT[ELSTPTR])
		END
	TES
END;


GLOBAL ROUTINE SETGTRD(IOLSTT)=
BEGIN
	!EXAMINE THE IOLIST POINTED TO BY IOLSTT FOR
	!A SINGLE VARIABLE TREEPTR.

	EXTERNAL INPFLAG;

	MAP BASE IOLSTT;

	WHILE .IOLSTT NEQ 0 DO
	BEGIN
		IF .IOLSTT[OPRCLS] NEQ STATEMENT THEN 
		BEGIN
			IF .INPFLAG THEN
				READHERE(.IOLSTT)
		END
		ELSE
		IF .IOLSTT[OPRS] EQL ASGNOS THEN
		BEGIN
			LOCAL BASE ELEM;
			ELEM_.IOLSTT[LHEXP];
			IF .ELEM[OPRCLS] EQL DATAOPR THEN
			(.SETSEL[.DISPIX])(.ELEM)
			ELSE
			(.SETSEL[.DISPIX])(.ELEM[ARG1PTR])
		END ELSE
		!TAKE NOTE OF THE FACT THAT THE DO LOOP
		!INDEX CHANGES IF THIS IS A LOOP

		IF .IOLSTT[OPRS] EQL DOOS THEN
			(.SETSEL[.DISPIX])(.IOLSTT[DOSYM]);
		IOLSTT_.IOLSTT[CLINK];
	END
END;	!SETGTRD


ROUTINE HEREVALUED(STMT, VAR)=
BEGIN
		!SEE IF THE VARIABLE VAR GETS A VALUE AT STATEMENT STMT.
		!IF SO RETURN 1 ELSE RETURN 0


	EXTERNAL TREEPTR;
	MAP BASE VAR:STMT;

	IF .STMT[SRCID] GTR REREDID THEN RETURN 0;

	!SET TREEPTR TO VAR FOR USE IN DEEPER ROUTINES
	TREEPTR_.VAR;
	!INITIALIZE GOTVAL TO 0
	GOTVAL_0;

	!SET DISPIX
	DISPIX_2;

	DEFWORK(.STMT);

	.GOTVAL
END;

GLOBAL ROUTINE GETDEF(CNODE,STMT,CDEFPT)=
BEGIN
EXTERNAL INDVAR;	!THE DO INDUCTION VARIABLE
LOCAL PDE;		!A TEMPORARY

REGISTER PHAZ2 TSTMT;

!COMPUTE ACTUAL DEFINITION POINT OF A LEAF NODE
!THIS ALGORITHM IS:
	!LOOK UP THE VARIABLE IN QUESTION (CNODE)
	!IF IT IS IN CHOSEN THEN CREATE A 36 BIT MASK WHICH HAS
	!THE BIT CORRESPONDING TO THE VARIABLE ON IN THE MASK.
	!STARTING WITH THE ACC OF THE CURRENT STATEMENT AND
	!THIS MASK WITH SUCCESSIVE ACC FIELDS ON THE PREDOMINATOR
	!CHAIN OF THE STATEMENT UNTIL THE MASK IS NOT ZERO. THIS
	!INDICATES AN INTERFERRING ASSIGNMENT IN THAT INTERVAL.
	!RETURN THE DEFINITION POINT AS THIS PLACE.

EXTERNAL PHAZ2 TOP;
MAP PHAZ2 CNODE;
!
	IF .CNODE[OPRCLS] EQL REGCONTENTS THEN RETURN(.TOP);
	IF .CNODE[OPRCLS] NEQ DATAOPR THEN RETURN(0)
	ELSE

	!IT SHOULD NOT BE A CONSTANT OR FORMAL FUNCTION

	IF .CNODE[OPERSP] EQL CONSTANT OR
	   .CNODE[OPERSP] EQL FORMLFN THEN RETURN(.LENTRY);


	IF .CNODE EQL .INDVAR THEN RETURN(.TOP);
	IF NOT .CNODE[IDDEF] THEN
	BEGIN
		IF NOT .MOREFLG THEN
		BEGIN
			CNODE[IDUSED]_1;
			IF .CNODE[IDATTRIBUT(INCOM)] OR
			   .CNODE[IDATTRIBUT(INEQV)] THEN
			RETURN(.STMT)
			ELSE
			!IF THE DO STATEMENT IS LABELED
			!WE MIGHT BE IN ROUTBLE IF WE SAY LENTRY
			!SPECIALLY IF LENTRY IS AN ASSIGNMENT OF THAT
			!VARIABLE TO A CONSTANT (I.E. IT WILL
			!GET PROPAGATED.
			RETURN(IF .TOP[SRCLBL] NEQ 0 THEN .TOP ELSE .LENTRY);
		END;
	END ELSE
	BEGIN
	!JUST TO MAKE SURE AVOID EQUIVALENCE LIKE THE PLAQUE.
	!EQUIVALENCE LISTS ARE NOT PROCESSED UNTIL REGISTER
	!ALLOCATION
	IF .CNODE[IDATTRIBUT(INCOM)] THEN RETURN(.STMT);
	IF .CNODE[IDATTRIBUT(INEQV)] THEN RETURN(.STMT);
	PDE_LOOKUP(.CNODE);
	IF .PDE GTR 32 THEN RETURN .CDEFPT;
	MASK_0;
	MASK_SETBIT(.MASK,.PDE);
	TSTMT_.STMT;			!PT TO STATEMENT
	WHILE 1 DO
	BEGIN
		IF (.TSTMT[ACC] AND .MASK) NEQ 0 THEN RETURN(.TSTMT);
		IF .TSTMT EQL .TOP THEN RETURN(.LENTRY);
		IF HEREVALUED(.TSTMT,.CNODE) THEN RETURN(.TSTMT);
		TSTMT_.TSTMT[PREDOM];
	END;
	END;
	.CDEFPT		!JUST IN CASE
END;
!**********************************************************
!
ROUTINE VDEFPT(PNODE)=
BEGIN
!WALK AN EXPRESSION TREE COMPUTING DEFINITION POINTS OF LEAFS (VARIABLES)
EXTERNAL ARGCONE;
REGISTER PHAZ2 P;
P_.PNODE;
		CASE .P[OPRCLS] OF SET

			!BOOLEAN
			BEGIN
			IF .P[A1VALFLG] THEN
				P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
			ELSE
			VDEFPT(.P[ARG1PTR]);
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);
			END;

			!DATAOPR
				RETURN;

			!RELATIONAL
			BEGIN
			IF .P[A1VALFLG] THEN
				P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
			ELSE
			VDEFPT(.P[ARG1PTR]);
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);
			END;

			!FNCALL
			BEGIN
				LOCAL ARGUMENTLIST AG;
				AG_.P[ARG2PTR];
				INCR I FROM 1 TO .AG[ARGCOUNT] DO
					VDEFPT(.AG[.I,ARGNPTR]);
				!GIVE ARG A DEFPT ON SINGLE
				!ARGUMENT LIBRARY FUNCTIONS
				IF ARGCONE(.P) THEN
					P[DEFPT2]_GETDEF(.AG[1,ARGNPTR],.PAE,.P[DEFPT2]);
			END;

			!ARITHMETIC
			BEGIN
			IF .P[A1VALFLG] THEN
				P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
			ELSE
			VDEFPT(.P[ARG1PTR]);
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);
			END;

			!TYPCNV
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);

			!ARRAYREF
			BEGIN
				IF .P[A2VALFLG] THEN
%**;[315],DEFPT,JNT,10-JUL-75%
%**;[315],IN VDEFPT @ 4515 IN !ARRAYREF%
					IF .P[ARG2PTR] EQL 0	![315] IF ITS A CONSTANT SS
					THEN	![315] WE WOULD LIKE IT TO BE LENTRY
					![315] BUT THAT BOMBS AND WE WANT THIS IN V4A
						P[DEFPT2]_.PAE	![315] SO SETTLE FOR WHAT WORKS
					ELSE	![315]
						P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])	![315]
				ELSE
				VDEFPT(.P[ARG2PTR]);
				!LOOK AT ARRAYNAME TOO
				P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1]);
			END;

			!CMNSUB
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);

			!NEGNOT
			IF .P[A2VALFLG] THEN
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
			ELSE
			VDEFPT(.P[ARG2PTR]);

			!SPECOP
			IF .P[A1VALFLG] THEN
				P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
			ELSE
			VDEFPT(.P[ARG1PTR]);

			!FIELDREF
			BEGIN END;	!NOT RELEASE 1

			!STORECLS
			BEGIN END;

			!REGCONTENTS
			!IT MUST BE THE INDUCTION VARIABLE
			BEGIN END;	!SHOULDNT GET HERE

			!LABOP
			BEGIN END;

			!STATEMENT
			BEGIN END;

			!IOLSCLS
			BEGIN END;

			!INLINFN
			BEGIN
				IF .P[A1VALFLG] THEN
					P[DEFPT1]_GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
				ELSE
				VDEFPT(.P[ARG1PTR]);
				IF .P[ARG2PTR] NEQ 0 THEN
				BEGIN
					IF .P[A2VALFLG] THEN
					P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
					ELSE
					VDEFPT(.P[ARG2PTR]);
				END;
			END
			TES;
END;
!************************************************************
!

!TO MAKE CODE LOOK NEATER THIS MACRO IS USED 
MACRO DATAGET=
	IF .P[OPRCLS] EQL DATAOPR THEN RETURN
	ELSE VDEFPT(.P)$;
ROUTINE DEFPT(STMT)=
BEGIN
!AFTER INTERFERING ASSIGNMENT INFORMATION IS COLLECTED
!USE IT TO COMPUTE DEFINITION POINTS FOR LEAVES AND EXPRESIONS
!CONTROL AT THE STATEMENT LEVEL
!THIS IS THE STATEMENT LEVEL ROUTINE AS OPPOSED TO THE
!EXPRESSION LEVEL ROUTINE WHICH IS VDEFPT (VARIABLE DEFPT).

EXTERNAL IOSTDFPT;	!COMPUTE DEFPTS IN I/O LIST <IOPT>
MAP BASE TOP;
MAP PHAZ2 STMT;
PAE_.STMT;		!PAE USED IN LOWER ROUTINES
IF .STMT[SRCID] EQL ASGNID THEN
BEGIN
	P_.STMT[LHEXP];
	IF .P[OPRCLS] EQL ARRAYREF THEN
		VDEFPT(.P);
	P_.STMT[RHEXP];
	IF .P[OPRCLS] EQL DATAOPR THEN STMT[OPDEF]_GETDEF(.P,.STMT,0)
	ELSE
	VDEFPT(.P);
END;
IF .STMT[SRCID] EQL DOID THEN
!SKIP IT IF THIS IS THE CURRENT DO WE ARE PROCESSING
BEGIN
	IF NOT .STMT[FLCWD] AND .STMT[SRCOPT] NEQ 0 THEN
	BEGIN
		P_.STMT[DOLPCTL];
		IF .P[OPR1] EQL CONSTFL THEN
		!STMT[DOPDEF]_.LENTRY
		ELSE
		IF .P[OPRCLS] EQL DATAOPR THEN
		!STMT[DOPDEF]_GETDEF(.P,.STMT)
		ELSE
		VDEFPT(.P);
	END;
END;
IF .STMT[SRCID] EQL IFLID THEN
BEGIN
	P_.STMT[LIFEXPR];
	DATAGET;
	DEFPT(.STMT[LIFSTATE]);
END;
IF .STMT[SRCID] EQL IFAID THEN
BEGIN
	P_.STMT[AIFEXPR];
	DATAGET;
END;
IF .STMT[SRCID] EQL CALLID THEN
BEGIN
	IF .STMT[CALLIST] NEQ 0 THEN
	BEGIN
		LOCAL ARGUMENTLIST AG;
		AG_.STMT[CALLIST];
		INCR K FROM 1 TO .AG[ARGCOUNT] DO
		BEGIN
			PB_.AG[.K,ARGNPTR];
			IF .PB[OPRCLS] NEQ DATAOPR THEN
			VDEFPT(.PB);
		END;
	END;
END;
IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID THEN
BEGIN
	IF .STMT[IOLIST] NEQ 0 THEN
	BEGIN
		IOSTDFPT(.STMT)
	END
END;
END;
!
!***************************************
!
GLOBAL ROUTINE DEFDRIV=
BEGIN

!CONTROLER FOR THE DEFINITION POINT ALGORITHM

	EXTERNAL CSTMNT,ISN;
	EXTERNAL UNIQVAL;
	MAP PHAZ2 CSTMNT:TOP;

	UNIQVAL_0;
	CHNGLST_0;
	MOREFLG_1;
	P_.TOP[BUSY];
	WHILE .MOREFLG DO
	BEGIN
		T_0;
		!EACH ROUTINE IS A SEPARATE PASS OVER THE
		!ENCODED SOURCE FOR THE CURRENT LOOP
		DEF0();		!PICK 32 VARIALES
		!IF THERE WERE NO VARIABLES (WRITE STATEMENT ONLY,
		!FOR EXAMPLE, QUIT HERE

		IF .T EQL 0 THEN
			MOREFLG_0
		ELSE
		BEGIN
			DEF1();		!INITIALIZE THE MASK
		END;
		!NOW WE ARE READY TO ACRUALLY GET DEFINITION POINTS
		CSTMNT_.TOP[BUSY];		!SKIP CURRENT LOOP
		WHILE .CSTMNT NEQ 0 DO
		BEGIN
			ISN_.CSTMNT[SRCISN];
			DEFPT(.CSTMNT);
			CSTMNT_.CSTMNT[BUSY];
		END;
		P_.LSTVAR;
	END;
END;
!
!*************************************************
!
ROUTINE CHKNAML(NLPTR)=
BEGIN
	!ROUTINE TO CHECK A NAME LIST.
	!IT:
	!	1. DETERMINES IF NLPTR POINTS TO A NAMELIST NAME
	!	   SYMBOL TABLE ENTRY
	!	2. IF SO, IT SEARCHS THE LINKED LIST OF NAMELIST
	!	  STATEMENTS FOR THE MATCHING NAMELIST
	!	3. IT THEN SETS THE BITS (SELECTIT,SETIT,SETGOTVAL)
	!	   USING THE DISPIX SET UP BY THE CALLER
	OWN BASE NPTR;
	LABEL NLLOK;
	MAP BASE NLPTR;

	EXTERNAL NAMLPTR;

	BIND M1RH=#000000777777;	!-1 IN RIGHT HALF WORD

	!FIRST SEE IF NLPTR POINTS TO A NAMELIST SYMBOL TABLE ENTRY

	IF .NLPTR NEQ 0 AND .NLPTR NEQ M1RH THEN
	BEGIN
		IF .NLPTR[IDATTRIBUT(NAMNAM)] THEN
		BEGIN
%**;[235],DEFPT,MD,23-JAN-75%
%**;[235],IN CHKNAML @ 4721%
			NPTR_.NLPTR[IDCOLINK];	![235] GET POINTER

			!WE HAVE LOOKED AT LIST WE HAVE TO QUIT IF
			!NPTR IS ZERO
			IF .NPTR EQL 0 THEN RETURN;
			!NPTR POINTS TO THE NAME LIST STATEMENT ENTRY
			INCR I FROM 0 TO .NPTR[NAMCNT]-1 DO
				(.SETSEL[.DISPIX])(@(.NPTR[NAMLIST]+.I));
		END;
		!ITS NOT A NAME LIST NAME
	END;
END;
ROUTINE SETONSUC(STMT)=
BEGIN
	!COMPANION ROUITNE TO SPECBRCHK
	!OR THE MASK OF STMT INTO EACH OF ITS SUCCESSORS IF IT IS NOT ZERO
	REGISTER SUCLSTPTR,T;
	MAP PHAZ2 STMT:SUCLSTPTR:T;

	IF .STMT[ACC] NEQ 0 THEN
	BEGIN

		!SET IT ON THE POST DOMINATOR JUST TO BE 10000000%
		!SURE

		T_.STMT[POSTDOM];
		T[ACC]_.T[ACC] OR .STMT[ACC];

		SUCLSTPTR_.STMT[SUCPTR];
		!FOLLOW SUCCESSOR CHAIN
		WHILE .SUCLSTPTR[CESLNK] NEQ 0 DO
		BEGIN
			!LOOK AT ACTUAL SUCCESSOR
			T_.SUCLSTPTR[CESSOR];
			T[ACC]_.T[ACC] OR .STMT[ACC];

			!NEXT SUCCESSOR
			SUCLSTPTR_.SUCLSTPTR[CESLNK];
		END;	!WHILE
	END;
END;

ROUTINE SPECBRCHK=
BEGIN
	!ROUTINE CHECKS ALL BRANCHING STATEMENTS.
	!IF SOMETHING IS DEFINED AT A BRANCHING STATEMENT
	!THE APPROPRIATE BIT MUST BE SET ON THE IMMEDIATE
	!SUCCESSORS OF THE BRANCH IN ORDER TO ASSURE THAT
	!CASES SUCH AS THE FOLLOWING DO NOT
	!CAUSE INCORRECT CODE.
	!EXAMPLE:
	!	A LOGICAL IF (CONTAINING A FUNCTION) CALL IS THE
	!	DEFINITION POINT OF AN ARGUMENT TO THE FUNCTION CALL.
	!	WITHOUT THIS ADDITIONAL PROCESSING, IF THE
	!	MOTION PLACE OF AN EXPRESSION WAS THE LOGICAL IF
	!	THE COMPUTATION WOULD BE INSERTED ONLY ON THE
	!	FALSE BRANCH. SETTING THE BITS ON THE SUCCESSORS
	!	INSURES THAT THE LOGICAL IF WILL NOT TURN OUT TO
	!	BE THE MOTION PLACE.

	LABEL L1;
	MAP PHAZ2 P:TOP;

	P_.TOP[BUSY];

	WHILE .P NEQ 0 DO
	BEGIN
		!FIRST A GENERAL BRANCH
		IF .P[SRCID] GEQ GOTOID AND .P[SRCID] LEQ IFLID THEN
			SETONSUC(.P)
		ELSE
		!A CALL
		!WITH LABLE ARGUMENTS
		IF .P[SRCID]  EQL CALLID THEN
		BEGIN
			LOCAL ARGUMENTLIST AG;
			L1:
			IF .P[CALLIST] NEQ 0 THEN
			BEGIN
				AG_.P[CALLIST];
				INCR I FROM 1 TO .AG[ARGCOUNT] DO
				BEGIN
					REGISTER BASE T;

					T_.AG[.I,ARGNPTR];
					IF .T[OPRCLS] EQL LABOP THEN
					BEGIN
						SETONSUC(.P);
						LEAVE L1;
					END;
				END;
			END;
		END ELSE
		IF .P[SRCID] GEQ READID AND .P[SRCID] LEQ CLOSID THEN
		!ITS AN I/O STATEMENT. IT IS A BRANCH IF THERE IS AN
		!END OR ERR SPECIFIED
			IF .P[IOERR] NEQ 0 OR .P[IOEND] NEQ 0 THEN
				SETONSUC(.P);

		!NEXT STATEMENT
		P_.P[BUSY];
	END;			!WHILE
END;


ROUTINE DEFWORK(P)=
BEGIN
	!MAIN ROUITN;INE TO DO ALL THE DEFPOINT WORK.
	!CALLED BY HEREVALUES, DEF0 AND DEFCHANGE

	REGISTER BASE TMP;
	MAP PHAZ2 P;

	EXTERNAL CSTMNT,INPFLAG;
	MAP BASE CSTMNT;



	IF .P[SRCID] GEQ CLOSID THEN RETURN;

	CASE .P[SRCID] OF SET

%ASGNID%
	BEGIN
		TMP_.P[LHEXP];
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			 (.SETSEL[.DISPIX])(.TMP)
		ELSE
			(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
		FCNLOK(.P[RHEXP]);
	END;
%ASSIID%
	BEGIN
		TMP_.P[ASISYM];
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			(.SETSEL[.DISPIX])(.TMP)
		ELSE
		IF .TMP[OPRCLS] EQL ARRAYREF THEN
			(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
	END;
%CALLID%
	BEGIN
		!PUT COMMONIN THE LIST
		THROINCOMMON();
		!PUT PARAMETERS ON THE LIST
		IF .P[CALLIST] NEQ 0 THEN
			ANPARMS(.P[CALLIST]);
	END;

%CONTID%
	BEGIN END;
%DOID%
	BEGIN
		FCNLOK(.P[DOLPCTL]);
		!THIS MUST BE INNER TO THE ONE CURRENTLY BEING
		!PROCESSED
		!MAKE SURE THAT WE NOTE THE VARIABLES CHANGED IN IT
		!IN THE ALGORITHM
		TMP_.P[DOCHNGL];
		WHILE .TMP NEQ 0 DO
		BEGIN
			(.SETSEL[.DISPIX])(.TMP[LEFTP]);
			TMP_.TMP[RIGHTP];
		END;
	END;
%ENTRID%
	BEGIN END;
%COMNSUB%
	BEGIN END;
%GOTOID%
	BEGIN END;
%AGOID%
	FCNLOK(.P[AGOTOLBL]);
%CGOTOID%
	FCNLOK(.P[CGOTOLBL]);
%IFAID%
	FCNLOK(.P[AIFEXPR]);
%IFLID%
	FCNLOK(.P[LIFEXPR]);
%RETUID%
	IF .P[RETEXPR] NEQ 0 THEN
		FCNLOK(.P[RETEXPR]);
%STOPID%
	BEGIN END;
%READID%
	BEGIN
		INPFLAG_1;
		IF .P[IOLIST] NEQ 0 THEN
		BEGIN
			SETGTRD(.P[IOLIST]);
			RANDIO(P);
		END ELSE
			CHKNAML(.P[IONAME]);
	END;
%WRITID%
	BEGIN
	!YOU ARE SURPRISED TO FIND A WRITE HERE. IT IS RELEVANT ONLY
	!IF IT IS RANDOM ACCESS. IN THAT CASE ANY ASSOCIATE VAIABLES
	!MUST BE CONSIDERED. ALSO COMMON

	SETGTRD(.P[IOLIST]);
	RANDIO(P);
	END;

%DECOID%
	BEGIN
		INPFLAG_1;
		SETGTRD(.P[IOLIST]);
	END;
%ENCOID%
	BEGIN
		IF .P[IOVAR] NEQ 0 THEN
		BEGIN
			TMP_.P[IOVAR];
			IF .TMP[OPRCLS] EQL DATAOPR THEN
				(.SETSEL[.DISPIX])(.P[IOVAR])
			ELSE
				(.SETSEL[.DISPIX])(.TMP[ARG1PTR]);
			SETGTRD(.P[IOLIST]);
		END;
	END;
%REREDID%
	BEGIN
		INPFLAG_1;
		SETGTRD(.P[IOLIST]);
	END;


%FINDID%
	RANDIO(P);
	TES;
	INPFLAG_0;
END;
END
ELUDOM