Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - defpt.bli
There are 26 other files named defpt.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1986
!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/HPW/JNG/DCE/TFV/EGM/CKS/AHM/TJK/AlB/MEM

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

GLOBAL BIND DEFPTV = #11^24 + 0^18 + #4517;	! Version Date:	4-Oct-85

%(

***** Begin 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, (MD)
116	252	14967	SELECTIT NOT CHECKING FOR SPECOP AND POSSIBLY OTHER OPS,
			(JNT)
117	315	16667	FIX VDEFPT TO RECOGNIZE ARRAYREFS WITH CONSTANT
			SUBSCRIPTS, NOT OPTIMALLY, BUT AT LEAST NOT WRONG, (JNT)
118	453	19695	DON'T CONSIDER THE DEFPT OF VARIABLES MODIFIED
			INSIDE LOOPS TO BE THE DO STATEMENT., (JNG)

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

119	575	22820	MAKE ZAPLEVEL MORE CLEVER IN USE OF THE STACK
			TO PREVENT STACK OVERFLOWS., (DCE)
120	671	NVT	WHEN SWAPPING ARGS, SWAP DEF PTS TOO, (DCE)

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

121	760	TFV	1-Oct-79	------
	Add handling for IOSTAT variable, it's an implicit assignment
	Include all I/O statements in test for END/ERR= branching

122	763	EGM	24-Apr-80	13913
	Cause ENTRY formals to take part in definition point determination

123	1010	EGM	12-Aug-80	10-29839
	Make sure CHKNAML passes only the address of a NAMELIST entry, not the
	full argument word.

124	1034	DCE	4-Dec-80	-----
	Fix function call arguments so that arguments (especially nested
	ones) which change get noticed.  Example F(G(X)) may change X.

125	1113	CKS	17-Jun-81
	Prevent code motion from moving CSEs to statements which have more
	than one successor.  To do this, modify SETONSUC to set ACC bits for
	variables which are assigned in statement STMT in STMT's successors
	and postdominator.  See comments in SPECBRCHK.

126	1126	AHM	22-Sep-81	Q20-01654
	Remove last vestiges of CALL DEFINE FILE in a comment.

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

***** End V7 Development *****

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

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

2204	TFV	20-Jun-83
	Add definition point handling  for  INQUIRE and fix deficiencies
	with I/O definition points.  All I/O statements can have IOSTAT=
	which is the definition point for its argument.  Also must check
	for function call  arguments in the  expressions for UNIT,  FMT,
	REC, and  IOSTAT and  all OPEN/CLOSE/INQUIRE  specifiers.   Most
	INQUIRE arguments are also modified by the INQUIRE statement.

2372	TJK	14-Jun-84
	Restructure to allow the  SETSEL routines to handle  SUBSTRING
	and ARRAYREF nodes (as well as DATAOPRs).  Use DEFPTSS for the
	definition point of ARG4PTR in a SUBSTRING.  Handle  character
	data.  Fix many,  many bugs, mostly  involving missing  checks
	for function references with side effects.  Fix problems  with
	edit 1034.

2427	AlB	17-Jul-84
	Removed reference to IDCHOS in SELECTIT, and reference to IDUSED
	in GETDEF.  These fields were not being used anywhere else, and
	thus do not need to be initialized.

2522	DCE	8-Mar-85	QAR 853010
	Correct definition point algorithm for character assignment
	statements.  Since they are converted to CALL statements, it looked
	as if all of COMMON had to be marked as being possibly redefined
	for every assignment statement, by calling THROINCOMMON.  This is a
	very slow routine, especially when it is called mulitple number of
	times.  This edit does NOT call it for library functions, which the
	character assignment statements are.

2525	DCE	19-Mar-85	QAR 853010
	Speed up optimization of programs with very large symbol tables.
	When the optimizer wants to mark variables in COMMON as potentially
	changed (for a CALL statement, for example), the entire symbol
	table gets searched for variables which are both in COMMON and in
	the CHOSEN list (with DISPIX=1).  This is too time-consuming.  When
	the CHOSEN list is set up, keep a CMNMASK word which indicates which
	elements of the CHOSEN list represent COMMON blocks, and use this
	mask to update the ACC field in THROINCOMMON instead of doing symbol
	table walk(s).

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

2550	MEM	11-Sep-85
	Only parameters of a statement function were used to calculate the
	definition points of variables, however, the body of the statement
	function must be used in definition point calculations also. A 
	variable, other than a parameter to the statement function, may be 
	changed by itself being a parameter in a function call within the
	statement function.

2555	MEM	31-Oct-85
	Correction to edit 2550.

***** End Revision History *****
***** Begin Version 11 *****

4501	MEM 	7-Jan-85
	Modify macro RANDIO so that when it checks if IORECORD is non-zero,
	it will also check if IOKEY is non-zero.

4502	MEM	7-Jan-85
	Add a case for the DELETE statement to the case statement in DEFWORK.

4503	MEM	7-Jan-85
	Add a case for the REWRITE statement to the case statement in DEFWORK.

4517	MEM	4-Oct-85
	In DEFWORK if we have a 1-char asmnt then call SETSEL[.DISPIX] on
	the arg under the CHAR node instead of on the whole LHEXP of the asmnt.

ENDV11

)%

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

FORWARD
	LOKELIST(1),
	SELECTIT(1),
	CHKUNIQ(1),
	THROINCOMMON,
	ANPARMS(1),
	RSORT(1),
	FCNLOK(1),
	ASSOCIA,
	DEF0 ,
	SETIT(1),
	DEFCHANGE(1),
	ONLYONEPRED(1),
	ZAPLEVEL(1),
	SWAMP,
	DEF1 ,
	SETGOTVAL(1),
	READHERE(1),
	SETGTRD(1),
	HEREVALUED(2),
	GETDEF(3),
	VDEFPT(1),
	DEFPT(1),
	DEFDRIV,
	CHKNAML(1),
	SETONSUC(1),
	SPECBRCHK,
%2204%	DEFIO(1),	! Definition points for I/O specifiers
%2204%	DEFOCI(1),	! Definition points for OPEN/CLOSE/INQUIRE specifiers
	DEFWORK(1);

!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
	BASE ASSOCPT,	! Used for linked list of ASSOCIATE variables
	BOTTOM,
	CHOSEN,
	LENTRY,
	LOOKUP,
	LOOPNO,
	PHAZ2 QQ,
%2372%	SKERR,		! Used to ICE the compiler
	TOP,
%2372%	BASE TREEPTR;	! Used as a global.  Moved EXTERNAL here.

OWN PEXPRNODE PCE;
OWN P,PA,PB,PC,HEAD,PAE;
OWN MOREFLG,LSTVAR,T;
MAP PHAZ2 P:PA:PB:PC:HEAD:PAE;
OWN MASK,CHNGLST;
OWN DISPIX;		!PLIT DISPATCH INDEX

OWN 	GOTVAL,		!FLAG FOR ASSIGNED HERE
			!THAT IT GIT IT VALUE HERE
%2525%	CMNMASK;	! Mask of COMMON blocks in CHOSEN


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

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



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];
%2372%		(.SETSEL[.DISPIX])(.ELEM);
		EPTR_.EPTR[CLINK];
	END;
END;	! of LOKELIST

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 
!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

%2372%	IF .VAR[OPRCLS] EQL SUBSTRING
%2372%	THEN VAR = .VAR[ARG4PTR];	! Get get full string
%2372%
%2372%	IF .VAR[OPRCLS] EQL ARRAYREF
%2372%	THEN VAR = .VAR[ARG1PTR];	! Get array name
%2372%
%2372%	IF .VAR[OPRCLS] NEQ DATAOPR
%2372%	THEN RETURN;
%2372%
%2372%	IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372%	THEN RETURN;

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

!	VAR[IDCHOS]_.LOOPNO; %2427 removed%
	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;

%2525%			! Mark COMMON blocks in CMNMASK for use by THROINCOMMON
%2525%			IF .VAR[IDATTRIBUT(INCOM)]
%2525%			THEN CMNMASK = SETBIT(.CMNMASK,.T);

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

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

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

%2372%	! Note that a check for EQUIVALENCE is missing here.  However,
%2372%	! GETDEF ends up using the current statement as the definition
%2372%	! point for variables in COMMON or EQUIVALENCE anyway, so this
%2372%	! whole routine  is useless.   But, it  could be  made  useful
%2372%	! someday...

	MAP BASE PCE;

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

%2525%		! We may be trying to set bits in the ACC field (for
%2525%		! DISPIX=1).  Rather than walking the entire symbol table,
%2525%		! use the saved bit mask of all COMMON blocks in CHOSEN
%2525%		! which we built up when DISPIX=0.  This speeds up
%2525%		! compilation substantially for programs with large symbol
%2525%		! tables.

%2525%		IF .DISPIX EQL 1
%2525%		THEN
%2525%		BEGIN
%2525%			P[ACC] = .P[ACC] OR .CMNMASK;
%2525%			RETURN
%2525%		END;

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

ROUTINE ANPARMS(ARGLSTPTR)=
BEGIN

%2372%	! Edit 1034 had a lot of problems.  This edit is a rewrite  of
%2372%	! this routine, and should correct those problems.  Basically,
%2372%	! any parameter which may have its value altered must be noted
%2372%	! (by  the  SETSEL   dispatch  call),   and  nested   function
%2372%	! references must be  noted (by the  FCNLOK call).  Sorry,  no
%2372%	! time to add a full routine header.

	MAP ARGUMENTLIST ARGLSTPTR;
	REGISTER BASE ARGPTR;

	INCR I FROM 1 TO .ARGLSTPTR[ARGCOUNT]
	DO
	BEGIN	! For each argument

		ARGPTR = .ARGLSTPTR[.I,ARGNPTR];	! Get the argument
		(.SETSEL[.DISPIX])(.ARGPTR);		! It may be changed
		FCNLOK(.ARGPTR);		! Check for nested functions

	END;	! For each argument

END;	! of ANPARMS

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
![671] WHEN SWAPPING ARGS, SWAP DEF PTS TOO
%671%		(SWAPARGS(CNODE);
%671%		T_.CNODE[DEFPT2];
%671%		CNODE[DEFPT2]_.CNODE[DEFPT1];
%671%		CNODE[DEFPT1]_.T);
	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;	! of RSORT

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;
%2372%	REGISTER ARGUMENTLIST ARGLSTPTR;	! Pointer to argument list

	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
%2550%		LOCAL BASE ARG1:SFNODE;
%2372%		ARGLSTPTR = .EXPR[ARG2PTR];

		IF .EXPR[OPERSP] NEQ LIBARY THEN
		BEGIN
			THROINCOMMON();
%2372%			ANPARMS(.ARGLSTPTR);
%2550%			ARG1 = .EXPR[ARG1PTR];	! Function name
%2550%			IF .ARG1[IDATTRIBUT(SFN)]
%2550%			THEN
%2550%			BEGIN
%2550%				SFNODE = .ARG1[IDSFNODE]; ! SFN node
%2555%				IF .SFNODE[USRFNREF]
%2555%				THEN
%2555%				BEGIN
%2555%					SFNODE = .SFNODE[SFNEXPR]; ! ASMNT NODE
%2555%					FCNLOK(.SFNODE[RHEXP]);		
%2555%				END;
%2550%			END;
		END
%2372%		ELSE
%2372%		BEGIN	! Check for nested functions
%2372%
%2372%			INCR I FROM 1 TO .ARGLSTPTR[ARGCOUNT]
%2372%			DO FCNLOK(.ARGLSTPTR[.I,ARGNPTR]);
%2372%
%2372%		END;	! Check for nested functions
	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;

%2372%	!SUBSTRING
%2372%	BEGIN
%2372%		FCNLOK(.EXPR[ARG1PTR]);	! Upper bound
%2372%		FCNLOK(.EXPR[ARG2PTR]);	! Lower bound
%2372%		FCNLOK(.EXPR[ARG4PTR]);	! ARRAYREF or DATAOPR
%2372%	END;

%2372%	!CONCATENATION
%2372%	BEGIN
%2372%		ARGLSTPTR = .EXPR[ARG2PTR];
%2372%
%2372%		INCR I FROM 2 TO .ARGLSTPTR[ARGCOUNT]	! Skip first arg
%2372%		DO FCNLOK(.ARGLSTPTR[.I,ARGNPTR]);
%2372%	END;

	TES;
END;	! of FCNLOK

ROUTINE ASSOCIA=
BEGIN
![1126]	!LOOK AT LINKED LIST OF ASSOCIATE VARIABLES (FROM OPENS)
![1126]	!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;	! of ASSOCIA

!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
%4501%	IF  (.P[IORECORD] NEQ 0)
%4501%	AND (.P[IOKEY] EQL 0)
%4501%	THEN
	BEGIN
		ASSOCIA();
		THROINCOMMON();
	END;
END$;

ROUTINE DEF0=
!++
! DEF0 is used to  select  up  to  32  variables  on  which  to  perform
! definition  point  analysis.  It first zeros the global vector CHOSEN,
! which is used to hold pointers to the  selected  variables.   It  also
! initializes  a  few  other  globals and module OWNs.  It then makes an
! explicit call to SELECTIT to select the  DO-variable  of  the  current
! DO-loop  (if  it  hasn't  already  been processed).  It then walks the
! statements of the current DO-loop in BUSY list order, calling  DEFWORK
! (with  DISPIX  set  to  zero, indicating SELECTIT is to be called) for
! each statement.  When  32  variables  have  been  selected,  it  stops
! walking  the statements and remembers where it left off so that it can
! start there when the next  set  of  up  to  32  variables  are  to  be
! selected.
!--
	!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.

BEGIN
	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, which is used to hold pointers to the
	! selected variables.

	DECR I FROM 31 TO 0 
	DO CHOSEN[.I]_0;

%2525%	CMNMASK_0; ! Initialize COMMON mask too.

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

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;

%2372%	IF .VAR[OPRCLS] EQL SUBSTRING
%2372%	THEN VAR = .VAR[ARG4PTR];	! Get get full string
%2372%
%2372%	IF .VAR[OPRCLS] EQL ARRAYREF
%2372%	THEN VAR = .VAR[ARG1PTR];	! Get array name
%2372%
%2372%	IF .VAR[OPRCLS] NEQ DATAOPR
%2372%	THEN RETURN;
%2372%
%2372%	IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372%	THEN RETURN;

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

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;

	!SET MODULE OWN THAT IS INDEX TO DISPATCH
	DISPIX_1;

	DEFWORK(.STMT);
END;	! of DEFCHANGE

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

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] 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%		PRED_.PRED[CESLNK];
	END;		!WHILE THERE ARE PREDECESSORS
END;	! of 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.

	! The main thing  to remember  about SWAMP is  that it  simply
	! follows predecessor pointers up  from P, without looking  at
	! or backing up beyond the immediate pre-dominator of P.   For
	! each statement it  visits, it  sets ACC  bits in  P for  all
	! selected variables  which  potentially become  redefined  at
	! that  statement.    It  doesn't   look  at   the   immediate
	! pre-dominator of P, nor does it look at P itself.

	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;
	!IF P'S PREDOMINATOR IS A DO STATEMENT WHICH ISN'T TOP, THEN
	!SET THE BITS IN P FOR ALL VARS CHANGED IN THE LOOP.
	PA_.P[PREDOM];
	IF (.PA NEQ .TOP) AND (.PA[SRCID] EQL DOID) THEN
		DEFCHANGE(.PA);
END;	! of SWAMP

ROUTINE DEF1=
!++
! DEF1 is used to set the ACC bits for each  statement  in  the  current
! DO-loop.   Each  ACC  bit  (bits  0-32  are  used)  corresponds to the
! variable pointed to by that entry in CHOSEN.   These  bits  are  later
! used by DEFPT to determine the actual definition points.
! 
! The basic idea is that the ACC bit for a variable V in a  statement  S
! will be set if V can potentially become redefined along some path from
! the immediate pre-dominator of S to S.  This path does not include the
! immediate  pre-dominator  of  S,  but  it may include loops through S.
! However, it generally doesn't include S itself.   This  should  become
! clearer when the actual algorithm is described.
!--

BEGIN
	 MAP PHAZ2 T;
	!
	!INITIALIZE ACC FOR DEFINITION POINT CALCULATION
	!DETERMINE IF THERE IS AN INTERFERING
	!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];

	! DEF1  first  makes  some  special  checks  on  TOP  and  the
	! statement after it, setting ACC bits (by a call to SETIT) in
	! the statement following the  DO statement for all  variables
	! changed by  the  DO-loop (if  there  is one).   This  is  to
	! prevent illegal motion out of loops.

	!THE SPECIAL CASE

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

		SAVP_.P;

		!A SPECIAL 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 OF VARIABLES
			!CHANGED IN THIS LOOP.
			!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;

	! It then walks walks the module  OWN P from TOP[BUSY] to  the
	! end of the  BUSY list.

	!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

		! If P points to  a DO statement,  it calls SETIT  for
		! each variable on the change-list (DOCHNGL) for  that
		! DO statement.

		!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 TERMINATOR

		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;

		! Then, regardless of  what P points  to, it does  the
		! following:

		!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

		! The LEVEL field of the immediate pre-dominator of  P
		! is set to 1.

		T_.P[PREDOM];
		T[LEVEL]_1;
		!NOW START CHECKING ON PREDECESSORS
		T_.P[PREDPTR];
		!T IS A POINTER TO THE PREDECESSOR LIST

		! The module OWN PA is  set to the second  predecessor
		! link of P  (i.e., the  CESLNK field  of the  PREDPTR
		! field of P).

		PA_.T[CESLNK];
		!PA POINTS TO THE NEXT LINK
		T_.T[CESSOR];
		!T POINTS TO FIRST PREDECESSOR OF P

		! Make a test  to see  if we can  avoid calling  SWAMP
		! (the routine  which sets  ACC  bits in  the  general
		! case).  If T  is the immediate  pre-dominator of  P,
		! and if PA[CESLNK] is zero (meaning PA must point  to
		! RGRAPH and T is the only predecessor of P), then  it
		! can avoid calling SWAMP.  In this case, it makes one
		! more check to see if PA[CESLNK] is zero and T points
		! to a DO statement.  If so, it calls DEFCHANGE (which
		! calls DEFWORK with DISPIX set to 1), passing it T.

		!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

			! If it cannot avoid the call to SWAMP, it first  sets
			! the LEVEL  field  of  P  to  zero.   It  then  calls
			! ZAPLEVEL,  which  zeros  the  LEVEL  field  of   all
			! statements  on  all  paths  between  the   immediate
			! pre-dominator of P and  P.  Finally, it calls  SWAMP
			! to actually set  the ACC  bits.  To  do this,  SWAMP
			! uses the LEVEL field to create a linked list,  which
			! is basically a reverse BUSY list which stops at  the
			! immediate pre-dominator of  P.  It  first sets  HEAD
			! and TAIL to P.  Then it loops.  For each predecessor
			! PA of HEAD which  isn't the immediate  pre-dominator
			! of P  and which  has a  zero LEVEL  field (i.e.,  it
			! hasn't been visited yet), it sets the LEVEL field to
			! one and the LEVEL field of TAIL to point to PA, then
			! resets TAIL  to  point  to PA.   Finally,  it  calls
			! DEFCHANGE, which will set the ACC bits in P for  all
			! selected variables changed  in PA (DEFCHANGE  merely
			! calls DEFWORK with  DISPIX set to  one).  When  it's
			! finished with all  predecessors of  HEAD, it  resets
			! HEAD to  HEAD[LEVEL]  and loops.   It  decides  it's
			! finished when HEAD  is less  than or  equal to  1000
			! (octal).  This is meant to distinguish pointers from
			! the other values of LEVEL (which should be zero  and
			! 1,  unless   ZAPLEVEL   isn't   working   properly).
			! Finally, after it has finished looping, SWAMP checks
			! to see if the immediate  pre-dominator of P is a  DO
			! statement other than TOP.  If so, it calls DEFCHANGE
			! to set ACC bits in  P for all variables  potentially
			! changed by that DO statement.

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

 	! After DEF1  has  looped  through all  statements,  it  calls
 	! SPECBRCHK to set ACC bits under a number of special cases to
 	! prevent bad code from being generated.

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

	SPECBRCHK();
END;	! of DEF1

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

%2372%	MAP BASE VAR;

%2372%	IF .VAR[OPRCLS] EQL SUBSTRING
%2372%	THEN VAR = .VAR[ARG4PTR];	! Get get full string
%2372%
%2372%	IF .VAR[OPRCLS] EQL ARRAYREF
%2372%	THEN VAR = .VAR[ARG1PTR];	! Get array name
%2372%
%2372%	IF .VAR[OPRCLS] NEQ DATAOPR
%2372%	THEN RETURN;
%2372%
%2372%	IF.VAR[OPERSP] EQL CONSTANT OR .VAR[OPERSP] EQL FORMLFN
%2372%	THEN RETURN;
%2372%
%2372%	IF .VAR EQL .TREEPTR THEN GOTVAL = 1;

END;	! of SETGOTVAL

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

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

**********************************************************************)%
BEGIN
EXTERNAL INPFLAG;
MAP BASE IOLSTT;
	CASE .IOLSTT[OPERSP] OF SET
%DATACALL%	BEGIN
		LOCAL BASE ELEM;
		ELEM_.IOLSTT[DCALLELEM];
%2372%		IF .INPFLAG THEN (.SETSEL[.DISPIX])(.ELEM);
%2372%		FCNLOK(.ELEM);
		END;
%SLISTCALL%	BEGIN
		LOCAL BASE ELEM;
%1034%		IF NOT .INPFLAG THEN RETURN;
		ELEM_.IOLSTT[SCALLELEM];
%2372%		(.SETSEL[.DISPIX])(.ELEM);
		END;
%IOLSTCALL%	BEGIN
		LOCAL BASE IOELEM;
%1034%		IF NOT .INPFLAG THEN RETURN;
		IOELEM_.IOLSTT[IOLSTPTR];
		WHILE .IOELEM NEQ 0 DO
		BEGIN
			READHERE(.IOELEM);
			IOELEM_.IOELEM[CLINK]
		END
		END;
%E1LISTCALL%	BEGIN
%1034%		IF NOT .INPFLAG THEN RETURN;
		LOKELIST(.IOLSTT[ELSTPTR])
		END;
%E2LISTCALL%	BEGIN
%1034%		IF NOT .INPFLAG THEN RETURN;
		LOKELIST(.IOLSTT[ELSTPTR])
		END
	TES
END;	! of READHERE

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 
![1034] Don't forget function calls in I/O statements
%1034%		READHERE(.IOLSTT)
		ELSE
		IF .IOLSTT[OPRS] EQL ASGNOS THEN
		BEGIN
%2372%			(.SETSEL[.DISPIX])(.IOLSTT[LHEXP]);
%2372%
%2372%			! The left hand side should never be an  array
%2372%			! reference, but  just in  case this  changes,
%2372%			! we'll check for function references  anyway.
%2372%			! The  right  hand   side  should  always   be
%2372%			! checked.
%2372%
%2372%			FCNLOK(.IOLSTT[LHEXP]);	! Check LHS just in case
%2372%			FCNLOK(.IOLSTT[RHEXP]);	! RHS must always be checked
		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;	! of SETGTRD

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


	MAP BASE VAR:STMT;

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

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;	%2427 removed%
			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);

%2372%		IF .TSTMT EQL .TOP
%2372%		THEN
%2372%		BEGIN	! We've reached TOP
%2372%
%2372%			! Check  to   see  if   the  DO-loop   control
%2372%			! expression might change CNODE (i.e., with  a
%2372%			! function reference).  If so, we can't return
%2372%			! LENTRY,    but    must    instead     return
%2372%			! TOP[SRCLINK],   which   is   the    CONTINUE
%2372%			! statement after TOP.  Note that TOP may be a
%2372%			! CONTINUE if we're at the top-level, in which
%2372%			! case we're safe.
%2372%
%2372%			IF .TOP[SRCID] EQL DOID
%2372%			THEN
%2372%			BEGIN	! TOP is a genuine DO statement
%2372%
%2372%				TREEPTR = .CNODE;	! Test CNODE
%2372%				GOTVAL = 0;		! Initialize result
%2372%				DISPIX = 2;		! Use SETGOTVAL
%2372%				FCNLOK(.TOP[DOLPCTL]);	! Look for FNCALLs
%2372%				IF .GOTVAL THEN RETURN .TOP[SRCLINK];
%2372%
%2372%			END;	! TOP is a genuine DO statement
%2372%
%2372%			RETURN .LENTRY;		! Safe to return LENTRY
%2372%
%2372%		END;	! We've reached TOP

		IF HEREVALUED(.TSTMT,.CNODE) THEN RETURN(.TSTMT);
		TSTMT_.TSTMT[PREDOM];
	END;
	END;
	.CDEFPT		!JUST IN CASE
END;	! of GETDEF

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
	BEGIN END;

	!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
			IF .P[ARG2PTR] EQL 0	!IF ITS A CONSTANT SS
			THEN	!WE WOULD LIKE IT TO BE LENTRY
			!BUT THAT BOMBS AND WE WANT THIS IN V4A
				P[DEFPT2]_.PAE	!SO SETTLE FOR WHAT WORKS
			ELSE
				P[DEFPT2]_GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
		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;

%2372%	!SUBSTRING
%2372%	BEGIN
%2372%		LOCAL BASE ARG4;	! Holds ARG4PTR
%2372%
%2372%		IF .P[A1VALFLG]
%2372%		THEN P[DEFPT1] = GETDEF(.P[ARG1PTR],.PAE,.P[DEFPT1])
%2372%		ELSE VDEFPT(.P[ARG1PTR]);
%2372%
%2372%		IF .P[A2VALFLG]
%2372%		THEN P[DEFPT2] = GETDEF(.P[ARG2PTR],.PAE,.P[DEFPT2])
%2372%		ELSE VDEFPT(.P[ARG2PTR]);
%2372%
%2372%		ARG4 = .P[ARG4PTR];
%2372%		IF .ARG4[OPRCLS] EQL DATAOPR
%2372%		THEN P[DEFPTSS] = GETDEF(.ARG4,.PAE,.P[DEFPTSS])
%2372%		ELSE VDEFPT(.ARG4);
%2372%	END;

%2372%	!CONCATENATION
%2372%	BEGIN
%2372%		LOCAL ARGUMENTLIST AG;
%2372%		AG = .P[ARG2PTR];
%2372%
%2372%		INCR I FROM 2 TO .AG[ARGCOUNT]	! Skip first argument
%2372%		DO VDEFPT(.AG[.I,ARGNPTR]);
%2372%	END;

	TES;
END;	! of VDEFPT

ROUTINE DEFPT(STMT)=
BEGIN
	!***************************************************************
	! After interfering assignment information is collected, compute
	! definition  points  for  leaves  and  expressions  under   the
	! statement.  The defpts  are recorded at  the statement  level.
	! VDEFPT actually computes  the defpts for  the expressions  and
	! leaves.
	!***************************************************************

%2204%	! Rewritten by TFV, on 20-Jun-83

	EXTERNAL IOSTDFPT;	!COMPUTE DEFPTS IN I/O LIST <IOPT>

	REGISTER ARGUMENTLIST AG;

	MAP
		BASE TOP,
		PHAZ2 STMT;

	PAE = .STMT;		!PAE USED IN LOWER ROUTINES

	IF .STMT[SRCID] EQL ASGNID
	THEN
	BEGIN	! Assignment
		P = .STMT[LHEXP];

%2372%		IF .P[OPRCLS] NEQ DATAOPR
		THEN VDEFPT(.P);

		P = .STMT[RHEXP];

		IF .P[OPRCLS] EQL DATAOPR
%2372%		THEN STMT[OPDEF] = GETDEF(.P,.STMT,.STMT[OPDEF])
		ELSE VDEFPT(.P);
	END	! Assignment
	ELSE IF .STMT[SRCID] EQL DOID
	THEN
	BEGIN	! DO
		! Skip it if this is the current DO we are processing
		IF NOT .STMT[FLCWD] AND .STMT[SRCOPT] NEQ 0
		THEN
		BEGIN
			P = .STMT[DOLPCTL];

			IF .P[OPRCLS] NEQ DATAOPR
			THEN VDEFPT(.P);
		END;
	END	! DO
	ELSE IF .STMT[SRCID] EQL IFLID
	THEN
	BEGIN	! Logical IF
		P = .STMT[LIFEXPR];

		IF .P[OPRCLS] NEQ DATAOPR
		THEN VDEFPT(.P);

%2372%		! Note that STMT[LIFSTATE] is also on the BUSY list

	END	! Logical IF
	ELSE IF .STMT[SRCID] EQL IFAID
	THEN
	BEGIN	! Arithmetic IF
		P = .STMT[AIFEXPR];

		IF .P[OPRCLS] NEQ DATAOPR
		THEN VDEFPT(.P);
	END	! Arithmetic IF
	ELSE IF .STMT[SRCID] EQL CALLID
	THEN
	BEGIN	! CALL
		IF .STMT[CALLIST] NEQ 0
		THEN
		BEGIN
			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	! CALL
	ELSE IF .STMT[SRCID] GEQ READID AND .STMT[SRCID] LEQ REREDID
	THEN
	BEGIN
		IF .STMT[IOLIST] NEQ 0
		THEN IOSTDFPT(.STMT);
	END;
END;	! of DEFPT

GLOBAL ROUTINE DEFDRIV=
!++
! The top-level routine in DEFPT is  DEFDRIV.  This routine is called  from
! MRP2 to calculate definition points for the current DO-loop.  It requires
! the forward and reverse program graphs  for the current DO-loop, as  well
! as the pre- and post-dominators for the current DO-loop.
!
! There are basically three passes to the definition point algorithm.   The
! first pass  (DEF0)  selects  up  to 32  variables  for  definition  point
! analysis.  The second  pass (DEF1)  sets the  ACC bits  in the  optimizer
! words for  each  statement indicating  which  of those  variables  become
! redefined on some path  between that statement's immediate  pre-dominator
! and that statement  (possibly passing  through that  statement more  than
! once).  The third pass (DEFPT)  actually fills in the definition  points.
! This three-pass process repeats  for each set of  32 variables until  all
! variables in the currentDO-loop have been processed.
!--


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];

	! If 32 variables were selected, loop back to step 2 to process the
	! next set of 32.

	WHILE .MOREFLG DO
	BEGIN
		T_0;
		!EACH ROUTINE IS A SEPARATE PASS OVER THE
		!ENCODED SOURCE FOR THE CURRENT LOOP

		! Call DEF0 to  select up to  32 variables.  Each  selected
		! variable is  added  to  the list  of  currently  selected
		! variables.  It is also marked as having been selected  so
		! it never becomes selected again (for example, in the next
		! batch of 32 variables that are selected).

		DEF0();		!PICK 32 VARIALES

		!IF THERE WERE NO VARIABLES (WRITE STATEMENT ONLY,
		!FOR EXAMPLE, QUIT HERE

		! If some variables were selected, call DEF1 to set the ACC
		! bits indicating where they become redefined.

		IF .T EQL 0 THEN
			MOREFLG_0
		ELSE
		BEGIN
			DEF1();		!INITIALIZE THE MASK
		END;

		!NOW WE ARE READY TO ACTUALLY GET DEFINITION POINTS

		! Visit all statements in the current DO-loop in BUSY  list
		! order.   For  each  statement,  call  DEFPT  to  fill  in
		! definition  points   for  all   selected  variables   and
		! constants (this  is  done  even if  DEF1  is  skipped  so
		! constants don't get missed).

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

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
			NPTR_.NLPTR[IDCOLINK];	!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
%1010%			(.SETSEL[.DISPIX])(.(.NPTR[NAMLIST]+.I)<RIGHT>);
		END;
		!ITS NOT A NAME LIST NAME
	END;
END;	! of CHKNAML

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;
	LOCAL PHAZ2 SAVEP;
	LOCAL ACCSAVE;

%1113%	ACCSAVE _ .STMT[ACC];		! SAVE ACC BITS

%2372%	! Edit 1113 was  making a  bad test,  since the  last link  in
%2372%	! every successor list is FGRAPH.  This test has been removed.
%2372%	! Perhaps a better test will be added someday.

%1113%	SAVEP _ .P;			! SAVE P, ARG TO DEFCHANGE
%1113%	P _ .STMT;			! SET ACC BITS IN STMT FOR EACH
%1113%	DEFCHANGE(.STMT);		!   VARIABLE ASSIGNED BY STMT
%1113%	P _ .SAVEP;			! RESTORE P

	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;
%1113%	STMT[ACC] _ .ACCSAVE;
END;	! of SETONSUC

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.
        !
        ![1113] ADDITIONALLY, SET ACC BITS FOR EACH VARIABLE ASSIGNED
        !BY THE BRANCHING STATEMENT ITSELF.
	!       
        !THIS BUSINESS IS NECESSARY TO PREVENT A STATEMENT WHICH BOTH
	!BRANCHES AND ASSIGNS VALUES FROM BECOMING THE DEF POINT FOR ANY
	!VARIABLE.  IF SUCH A STATEMENT WERE CHOSEN AS THE MOTION PLACE FOR A
	!CSE, THE CSE CALCULATION WOULD HAVE TO BE PUT ON EACH SUCCESSOR OF THE
	!STATEMENT.  INSTEAD, THIS SCHEME PREVENTS A STATEMENT WITH MULTIPLE
	!SUCCESSORS FROM BEING IDENTIFIED AS THE DEF POINT OF THE VARIABLES
	!WHICH IT ASSIGNS.  ACC BITS ARE SET IN EACH SUCCESSOR (SO THAT CSE
	!MOVEMENT WILL STOP WHEN IT HITS THE SUCCESSOR) AND THE POSTDOMINATOR
	!(SO THAT MOVEMENT OF CSES WHICH OCCUR AFTER THE POSTDOMINATOR WILL HIT
	!THE POSTDOMINATOR AND STOP THERE).

	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
%760%		IF (.P[SRCID] GEQ READID AND .P[SRCID] LEQ ENDFID) OR
%2204%		    .P[SRCID] EQL OPENID OR .P[SRCID] EQL INQUID
%760%		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;	! of SPECBRCHK

ROUTINE DEFIO(P)=
BEGIN
%2204%	! Written by TFV on 20-Jun-83

	!***************************************************************
	! Check  definition  points  for  UNIT,  FMT,  REC,  and  IOSTAT
	! specifiers for an I/O statement.  Look for function  arguments
	! that might be  modified.  The IOSTAT  variable or arrayref  is
	! always modified.
	!***************************************************************

	REGISTER BASE TMP;
	MAP PHAZ2 P;

	! Check for function calls.

%2372%	IF (TMP = .P[IOUNIT]) NEQ 0
%2372%	THEN
%2372%	BEGIN	! Non-zero UNIT
%2372%
%2372%		FCNLOK(.TMP);
%2372%
%2372%		IF .TMP[VALTYPE] EQL CHARACTER
%2372%		THEN IF .P[SRCID] EQL WRITID
%2372%		THEN (.SETSEL[.DISPIX])(.TMP);	! Internal file WRITE
%2372%
%2372%	END;	! Non-zero UNIT

	IF (TMP = .P[IOFORM]) NEQ 0
	THEN IF .TMP NEQ #777777	! Not list directed either
	THEN FCNLOK(.TMP);

	IF (TMP = .P[IORECORD]) NEQ 0 THEN FCNLOK(.TMP);

	IF (TMP = .P[IOIOSTAT]) NEQ 0
	THEN
	BEGIN	! IOSTAT was specified

		FCNLOK(.TMP);		! Check it for function calls

		! It's always modified by the I/O statement

%2372%		(.SETSEL[.DISPIX])(.TMP);

	END;	! IOSTAT was specified

END;	! of DEFIO

ROUTINE DEFOCI(P)=
BEGIN
%2204%	! Written by TFV on 20-Jun-83

	!***************************************************************
	! Check  definition  points   for  OPEN,   CLOSE,  and   INQUIRE
	! specifiers.   Look  for  function  arguments  that  might   be
	! modified.  The IOSTAT variable or arrayref is always modified.
	! All INQUIRE specifiers except UNIT or FILE are also modified.
	!***************************************************************

	REGISTER
		BASE TMP,
		OPENLIST OPENL,
		ISINQUIRE;	! Convenient flag 

	MAP PHAZ2 P;

	! Check for function calls.

	IF (TMP = .P[IOUNIT]) NEQ 0 THEN FCNLOK(.TMP);
	IF (TMP = .P[IOFILE]) NEQ 0 THEN FCNLOK(.TMP);

	IF (TMP = .P[IOIOSTAT]) NEQ 0
	THEN
	BEGIN	! IOSTAT was specified

		FCNLOK(.TMP);		! Check it for function calls

		! It's always modified by the I/O statement

%2372%		(.SETSEL[.DISPIX])(.TMP);

	END;	! IOSTAT was specified

	OPENL = .P[OPLST];	! pointer to other specifiers
	ISINQUIRE = .P[SRCID] EQL INQUID;	! loop invariant test

	DECR I FROM .P[OPSIZ] - 1 TO 0 DO
	BEGIN	! Walk down specifier list

		! Get specifier expression
		IF (TMP = .OPENL[.I,OPENLPTR]) NEQ 0
		THEN
		BEGIN	! Non-zero specifier
			FCNLOK(.TMP);		! Check it for function calls

%2372%			! INQUIRE  always  modifies  the  variable  or
%2372%			! arrayref, and ASSOCIATE variables are always
%2372%			! modified.
%2372%
%2372%			IF .ISINQUIRE OR .OPENL[.I,OPENLCODE] EQL OPNCASSOCIATE
%2372%			THEN (.SETSEL[.DISPIX])(.TMP);

		END;	! Non-zero specifier
	END;	! Walk down specifier list

END;	! of DEFOCI

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

	REGISTER BASE TMP;
%763%	REGISTER ARGUMENTLIST ALST;	! FOR ENTRY FORMALS
	MAP PHAZ2 P;

	EXTERNAL CSTMNT,INPFLAG;
	MAP BASE CSTMNT;

%2204%	IF .P[SRCID] EQL CLOSID OR .P[SRCID] EQL OPENID OR
%2204%	   .P[SRCID] EQL INQUID
%2204%	THEN
%2204%	BEGIN	! OPEN, CLOSE, or INQUIRE
%2204%		DEFOCI(.P);	! Check the specifiers
%2204%		RETURN		! Done - leave now
%2204%	END;	! OPEN, CLOSE, or INQUIRE

%2204%	IF (.P[SRCID] GEQ READID AND .P[SRCID] LEQ ENDFID)
%2204%	THEN DEFIO(.P);		! I/O statement - check the specifiers

	CASE .P[SRCID] OF SET

	BEGIN	! ASSIGNMENT
%4517%		TMP = .P[LHEXP];
%4517%		IF .TMP[OPR1] EQL CHARFNFL
%4517%		THEN (.SETSEL[.DISPIX])(.TMP[ARG1PTR])	! 1-char assignment
%4517%		ELSE (.SETSEL[.DISPIX])(.TMP);	! non-char assignment
%2372%		FCNLOK(.P[LHEXP]);
%2372%		FCNLOK(.P[RHEXP]);
	END;	! ASSIGNMENT

	BEGIN	! ASSIGN
%2372%		(.SETSEL[.DISPIX])(.P[ASISYM]);
	END;	! ASSIGN

	BEGIN	! CALL

%2372%		! Note that a special check for character  assignments
%2372%		! would make them less pessimal.  This should be added
%2372%		! if character definition points are ever used.

%2522%		! Put COMMON in the list if this is not a character
%2522%		! assignment statement, which would appear as a library
%2522%		! function.  Library functions don't change COMMON!
%2522%
%2522%		TMP = .P[CALSYM];
%2522%		IF NOT .TMP[IDLIBFNFLG] THEN THROINCOMMON();

		! Put PARAMETERs on the list
		IF .P[CALLIST] NEQ 0 THEN ANPARMS(.P[CALLIST]);

	END;	! CALL

	BEGIN END;	! CONTINUE

	BEGIN	! DO
		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;	! DO

%763%	BEGIN	! ENTRY
%763%		IF (ALST _ .P[ENTLIST]) NEQ 0 THEN
%763%		BEGIN
%763%			INCR K FROM 1 TO .ALST[ARGCOUNT] DO
%763%			BEGIN
%2372%				IF (TMP = .ALST[.K,ARGNPTR]) NEQ 0
%2372%				THEN (.SETSEL[.DISPIX])(.TMP);
%763%			END;
%763%		END;
%763%	END;	! ENTRY

	BEGIN END;	! COMMON SUB
	BEGIN END;	! GOTO
	FCNLOK(.P[AGOTOLBL]);	! ASSIGNED GOTO
	FCNLOK(.P[CGOTOLBL]);	! COMPUTED GOTO
	FCNLOK(.P[AIFEXPR]);	! ARITHMETIC IF
	FCNLOK(.P[LIFEXPR]);	! LOGICAL IF

	IF .P[RETEXPR] NEQ 0	! RETURN
	THEN FCNLOK(.P[RETEXPR]);

	BEGIN END;	! STOP

	BEGIN	! READ
		INPFLAG_1;
		IF .P[IOLIST] NEQ 0 THEN
		BEGIN
			SETGTRD(.P[IOLIST]);
			RANDIO(P);
		END ELSE
			CHKNAML(.P[IONAME]);
	END;	! READ

	BEGIN	! WRITE

		! You are  surprised  to  find  a  WRITE  here.   It  is
		! relevant if  it is  random access;  in that  case  any
		! associate vaiables  must be  considered, also  common,
		! also function call arguments may change value -  hence
		! the call to SETGTRD.

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

	BEGIN	! DECODE
		INPFLAG_1;
		SETGTRD(.P[IOLIST]);
	END;	! DECODE

	BEGIN	! ENCODE
		IF .P[IOVAR] NEQ 0 THEN
		BEGIN
%2372%			(.SETSEL[.DISPIX])(.P[IOVAR]);
			SETGTRD(.P[IOLIST]);
		END;
	END;	! ENCODE

	BEGIN	! REREAD
%2372%		SKERR();	! REREAD is really READ now.
	END;	! REREAD

	RANDIO(P);	! FIND

%4502%	BEGIN END;	! CLOSE
%4502%
%4502%	BEGIN		! DELETE
%4502%		IF (.P[IOKEY] EQL 0)
%4502%		THEN
%4502%		BEGIN
%4502%			ASSOCIA();
%4502%			THROINCOMMON();
%4502%		END;
%4502%	END;	
%4503%	BEGIN		! REWRITE
%4503%		SETGTRD(.P[IOLIST]);
%4503%	END;		
%4502%	BEGIN END;	! BACKSPACE
%4502%	BEGIN END;	! BACKFILE
%4502%	BEGIN END;	! REWIND
%4502%	BEGIN END;	! SKIPFILE
%4502%	BEGIN END;	! SKIPRECORD
%4502%	BEGIN END;	! UNLOAD
%4502%	BEGIN END;	! ENDFILE
%4502%	BEGIN END;	! END
%4502%	BEGIN END;	! PAUSE
%4502%	BEGIN END;	! OPEN
%4502%	BEGIN END;	! STATEMENT FUNCTION
%4502%	BEGIN END;	! FORMAT
%4502%	BEGIN END;	! BLTID
%4502%	BEGIN END;	! REGMARK
%4502%	BEGIN END;	! INQUIRE

	TES;
	INPFLAG_0;
END;	! of DEFWORK

END
ELUDOM