Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/ph3g.bli
There are 12 other files named ph3g.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!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/DCE/SJW/JNG/EGM/TFV/RVM/AHM/TJK/AlB/CDM/MEM

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

!	REQUIRES FIRST, TABLES, OPTMAC

GLOBAL BIND PH3GV = #11^24 + 0^18 + #4527;	! Version Date:	1-Jan-86

%(

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

184	-----	-----	INSERTING PRELOADS AT WRONG PLACE IN STRANGE CASE
185	-----	-----	FIX GETPRELOAD NOT TO FALSELY PRELOAD A SUBSET
			OF THE ASGN4USED VARIABLES.
186	-----	-----	FIX A ' THAT SHOLD BE " IN SORTNMAKE
			PLUS FIX RAYMERIT TO PROPERLY CREDIT
			LOCAL COMMON SUBS AS SUBSCRIPTS
187	-----	-----	FIX GETPRELOAD IN SKIPMAT AREAS
188	-----	-----	FIXENTRY IS MISSING PRELOADS
189	-----	-----	TRY AGAIN ON 188
190	-----	-----	MISPLACED END IN FIXENTRY
191	-----	-----	CONCEPTUAL ERROR IN MATERIALIZATIONS
			CAUSED BY SUBTLE LOOP STRUCTURE TOGETHER
			WITH SUBSUMPTION
192	-----	-----	USE NOINDVARFLG TO PREVENT BAD REGCONTETNS
			SUBSTITUTIONS
193	-----	-----	MODIFY MATERIALIZATION CONDITIONS ON
			INNER LOOPS ONLY OF A NEST
194	-----	-----	IN CASES 2 AND 4 TURN OFF MATRLZ BIT ONLY
			IF INDVAR IS GLOBALLY ALLOCATED.
195	-----	-----	MAKE LEAFLOOKER A CASE STATEMENT AND FIX
			SOME MINOR UNOPTIMALITIES
196	-----	-----	SET NOALLOC ON .R VARS GLOBALLY ALLOCATED
196	----	-----	FIX BOOLEAN NOT TO DO LOADS AND STORES
			'TWEEN CALLS
197	-----	-----	GUESS
198	-----	-----	CHECK FOR GLOBALLY ALLOCATED DO INDEX
			IN DETERMINING LOWEST AVAILABLE REGISTER
			TO GLOBALLY ALLOCATE
199	-----	-----	FIX A COUPLE OF BENCHMARKS PROBLEMS
			IN PRELOADING, SAVING, RESTORING
			AND MATERIALIZATION
200	-----	-----	REFINE VALUE SUBTRACTED FOR USE AS LIB
			FUNCTION ARG AND DO NOT ALLOCATE IF
			MERIT ISNT BETTER THAN SIMPLE MOVE
201	-----	-----	IN AN ASSIGNMENT STATEMENT WITH USER FUNCTION
			REFERENCES, NOT IMMEDIATELY FOLLOWED BY A CALL
			OR ANOTHER STATEMENT WITH A USER FUNCTION
			REF  SAVE ONLY GLOBALLY ALLOCATED
			ARGUMENTS TO THOSE FUNCTIONS
202	-----	-----	FIX 201
203	----	-----	ONE MORE TIME ON 201
204	-----	-----	ADD BUBBLE SORT TO DO CONBINATION
			OF LEAFSUBSTITUTE AND SAVE RESTORE
			PUT IT ALL INTO FLIPCODES
205	-----	-----	PUNT
206	-----	-----	DO NOT INCREMENT CALLREFNO IF THERE ARE
			NO ARGUMENTS
207	-----	-----	FIX REFERENCES TO PROEPITYP AND PROGNAME
208	-----	-----	DO NOT ALLOCATE A LOOP THAT HAS A USER FUNC.
			REFERENCE AS PART OF THE LOOP CONTROL. USRFNREF
209	-----	-----	MACRO CHKGIX WAS ERROREOUSLY CHECKING
			GLOBREG INSTEAD OF CHOSEN
			FLAG GETS VERY CONFUSED.
210	-----	-----	COMPLEXITY OF DO LOOP ITSELF NO BEING PROPERLY
			CONSIDERED

211	-----	-----	CALL DATPROC WHETHER OR NOT A REL FILE IS BEING PRODUCED
212	-----	-----	IN DOUBLE NEST ALLOCATION SAV .OS ASSIGNED
			BEFORE LENTRY. THIS IMPLIES THEY HAVE
			BEEN SUBSUMBED AND MAY BE USED LATER TOO.
213	-----	-----	USED4ASGND ANALYSIS INCOMPLETE FOR STATEMENTS
			THAT CONTAIN USER FUNCTION REFERENCES.
214	-----	-----	OUTER LOOP INDEX ALWAYS GETTING NO PRELOAD
			SET. NEED TO CHECK USED4ASGND TOO.
215	-----	-----	MESSING UP RESTORE OF ALLOCATED VARS
			IF CALL, USER FUNC REF CASE.
216	-----	-----	212 HAD A SIDE EFFECT THAT NEED CORRECTING
			FOR GUIDE 2 AND 4.
217	-----	-----	1. DO NOT GLOBALLY ALLOCATE IF BOUNDS SWITCH
			IS USED
			2. FIX CALLS SO THAT THE SAVE/RESTORE
			SEQUENCES WILL WORK WITH NO ARGS
218	-----	-----	ITEM MISSING FROM CASE IN CREDIT
219	-----	-----	BUG THAT SKIPS A REAL STATEMENT WHEN IT
			THINKS ITS SKIPPING A MATERIALIZATION
220	-----	-----	NOT SAVING AND RESTORING REGS ON A CALL WITH
			NO ARGS. CALL COULD CLOBBER REGS
221	-----	-----	IN SETTING UP PREVIOUS BASIC BLOCK POINTERS
			LOGICAL IFS WITH BRANCHS ARE NOT TAKEN
			INTO ACCOUNT PROPERLY
222	-----	-----	REGISTER PRELOADS ARE BEING INSERTED IN
			FRONT OF LOGICAL IFS WITH BRACHES AS THE
			TRUE BRANCH
223	-----	-----	NOT PROPERLY HANDLING LOOPS IN WHICH THE INDEX
			IS NEITHER GLOBALLY OR LOCALLY ALLOCATED.
224	-----	-----	BLEW 223 FOR MAIN PROGRAM WITH SINGLE LOOP
225	-----	-----	EMPTY SUBROUTINE DID NOT GET OPTIMIZED. DONT
			TRY TO ALLOCATE IT EITHER
226	-----	-----	DO NOT ALLOCATE ANY VARIABLE THAT DOES NOT
			AT LEAST SAVE A MOVEM
227	-----	-----	INSERT REGMASK NODE IF BASIC
			BLOCK STARTS WITH A LOGICAL IF WITH A BRANCH. 
			ALSO CLEAN UP GETPRELOAD BY MAKING THE REGMASK
			SET UP CODE A MACRO
228	-----	-----	MAKE SETDOIREG COGNISCENT OF DOUBLE PRECISION
			INDICES NEEDING AN EVEN ODD PAIR.
229	-----	240	NOT LEAVING TWO PAIR AND NOT DELETEING
			LOCALLY ALLOCATED DO LOOP INDEX REG
			FROM GLOBAL CONSIDERATION IF IT IS NOT
			WITHIN THE FIRST 10 OF
			THE UNSORTED LIST
230	15209	246	BRANCHES IN LOOPS ARE NOT FORCING USED4ASGND ON
231	15952	266	FIX INSERTIONS OF PRELOAD NODES AFTER REGMASK WHEN THERE 
 			ARE NO PREVIOUS LOOP MATERIALIZATIONS TO SKIP
232	16112	277	FIX SUBSTITUTIONS OF REGISTERS TO BE ONLY THE ONES
			TO BE SAVED
233	QAR	316	FIX 277 TO DO IT CORRECTLY, USING THE RIGHT BITS, (JNT)
234	17045	332	MAKE LEAFLOOKER TREAT ASSIGN STATEMENTS PROPERLY, (DCE)
235	17545	347	CHANGE RANGE OF SUBSTITUTION OF REGISTERS
			TO NOT INCLUDE LOGICAL IF'S AT BEGINNING, (DCE)
236	17545	350	FOR COMMON SUBS, DON'T FORGET TO SET THE
			FLAG TO CAUSE PRELOADING IF APPROPRIATE, (DCE)
237	18007	352	FIX EDIT 266 TO WORK CORRECTLY, (DCE)
238	18004	353	FIX ARGUMENTS TO SECOND OF TWO CONSECUTIVE CALLS, (DCE)
239	18704	400	FIX LOGICAL IF BEFORE NESTED DO LOOP, (DCE)
240V	-----	VER5	RAISE PRIORITY OF ASSIGNMENT TO MEMORY IN
			REGISTER ALLOCATION IN ASCRIBE, (SJW)
240	18869	404	FIX ASSOCIATE VARIABLES (CANNOT LIVE IN REG), (DCE)
241	19121	431	FIX REGSUBDRIVER TO MATERIALIZE VARIABLES THAT
			HAVE BEEN ALLOCATED TO REGISTERS AND ARE
			INITIALIZED BEFORE THE OUTER LOOP OF A CASE 6
			PROGRAM (NESTED DO LOOPS)., (JNG)
242	19484	444	DON'T FORCE PRELOAD OF COMPILER VARIABLES IN
			GOTOFORCELOAD IF A GOTO IS ENCOUNTERED., (JNG)
243	19699	454	DON'T SKIP 1 TOO MANY STATEMENTS WHEN PLACING
			A PRELOAD AFTER A DO LOOP., (JNG)
244	20463	502	SORT SAVED VS NON-SAVED REGS CORRECTLY IN
			  FLIPCODES & FAKE ALL NECESSARY COUNTS, (DCE)

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

245	23116	615	WHEN PRELOADING REGISTERS, BE CAREFUL WITH
			THE PLACEMENT OF LABELS., (DCE)

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

246	11277	634	SET USED4ASGND INSTEAD OF ASGND4USED IF
			THE ASSIGNMENT IS FOUND IN THE OBJECT
			STATEMENT OF A LOGICAL IF, SINCE IT MIGHT
			NOT GET EXECUTED., (JNG)
247	25010	641	FIX REG ALLOCATION FOR CALL AS OBJECT OF LOGICAL
			IF STMNT JUST BEFORE DO LOOP, (DCE)
248	11427	660	IF(FN(I))GOTO 10 WHERE I IS IN REG GIVES BAD CODE, (DCE)
249	25245	662	PREVENT ILL MEM REF IF DO LOOP DELETED, (DCE)
250	26409	716	CHECK FOR LEGALITY BEFORE OPTIMIZING OUTERMOST LOOP,
			(DCE)
251	13537	740	DO REGISTER ALLOCATION FOR UNIT NUMBERS (VARIABLES)
			IN OPEN AND CLOSE STATEMENTS., (DCE)

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

252	776	EGM	20-Jun-80	10-29609
	Preserve CLOGIF when processing the true node of a logical IF.

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

254	1051	EGM	9-Feb-81	--------
	Make sure loop register globally allocated gets flaged in DO node
	(more of local edit 209). Do not do global register optimization
	for single loop programs that have CALLs with alternate return
	labels (more of edit 716).

1152	EGM	29-Mar-82
	Check all OPEN/CLOSE arguments for register substitution, instead
	of just UNIT.

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

255	1245	TFV	24-Jun-81	------
	Add code to MRP3G to generate high seg descriptors for character
	constants, scalars and arrays

256	1406	TFV	27-Oct-81	------
	Call HSDDESC to output .Dnnnn variable compile-time-constant
	character descriptors to the HISEG.

257	1454	RVM	7-Jan-82
	Do not allocate formats until after optimization is done.  This is
	necessary so the optimizer, which uses the label fields filled-in
	during format allocation, does not cause the compiler to forget
	that format labels have had their values nailed down.

***** end V7 Development *****

1726	DCE	9-Feb-83	-----
	Put out a JRST around an ENTRY statement when registers are allocated
	around the statement.  This prevents reinitialization when falling
	through the ENTRY statement.
	
1742	TFV	14-Apr-83
	Fix calls to MISCIO.  It handles the IOLIST now.

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

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

2204	TFV	20-Jun-83
	Fix ASCRIBE  to count  I/O  statements as CALLs.   STOP,  PAUSE,
	OPEN, CLOSE, and INQUIRE are  one call; READ through REREAD  are
	at least two calls (e.g.  IN.  and IOLST.).  Fix MATLOK to  test
	all I/O statement END and ERR labels.  It has to generate a  new
	label for the materializations.

2210	AHM	27-Jul-83
	Rename DUMPFORMAT to DMPFORMAT to reserve DUMP?? for SIX12.

2211	TFV	18-Aug-83
	Add INQUIRE to case statement  in LEAFLOOKER.  Calls MISCOCI  to
	do the work.

2237	TJK	14-Nov-83
	Rewrite code  in SORTNMAKE  (defined in  GBLALLOC) which  puts
	elements of CHOSEN with highest merit in GLOBREG.   Previously
	it  stopped  looking  after  GLOBREG  was  full,  which  could
	severely pessimize the final choices made.  It also wrote  one
	entry too many,  a dangerous  practice.  In  addition to  this
	change, remove some code from ASCRIBE added in edit 2204.

2270	AlB	13-Jan-84
	Removed routine NAMESET, which was setting the INNAM attribute
	in the symbol table entries of all items in a namelist.  That
	INNAM bit is now being set in routine NAMESTA during the syntax
	parsing.
	Routine:
		NAMESET

2334	AHM	5-Apr-84
	Under /EXTEND, allocate the object program's entry vector in
	the .DATA. psect before the call to HISEGBLK in MRP3G.

2355	AHM	3-May-84
	Use the symbol ENTAUXSIZE to allocate additional words after
	the /EXTEND entry vector.  The only auxiliary word for now is
	an EFIW for the reenter address.

2375	TJK	15-Jun-84
	Allow the global register allocator to handle character data.
	Never globally allocate a character variable to a register.

2507	CDM	21-DEC-84
	Move IDDOT to FIRST.

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

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

***** Begin Version 11 *****

4502	MEM	22-Jan-85
	Modified LEAFLOOKER for DELETE statement.

4503	MEM	22-Jan-85
	Modified LEAFLOOKER for REWRITE statement.

4504	MEM	22-Jan-85
	Modified LEAFLOOKER for UNLOCK statement.

4517	MEM	4-Oct-85
	In routine ASCRIBE, if we have a 1-char asmnt then set PC to arg under
	the CHAR node instead of to the whole LHEXP of the asmnt.
	Don't try to substitute registers for character variables in
	REGSUBDRIVER.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].  The lengths will be one
	(word) until a later edit, which will store and use long symbols.

ENDV11
)%


! MAIN ROUTINE NAMED CHANGED TO MRP3G FOR SINGLE SEGMENT

!THE MAIN ROUTINE IN THIS MODULE IS MRP3G WHICH IS CALLED FROM PHAZONTROL.
!IT IS THE ONLY GLOBAL ROUTINE IN THE MODULE. THE ROUTINE AUDITOR DOES ALL
!THE REAL WORK OF COMPUTING MERITS, SELECTING ALLOCATIONS AND SUBSTITUTING
!REGCONTENTS NODES FOR THE VARIABLES

!THE MERIT ON A CALL OR FUNCTION IS ACTUALLY NEGATIVE.  THIS IS HANDLED IN
!AUDITOR BY SUBTRACTING THE CUMULATED VALUE OF THE NUMBER OF FUNCTION
!REFERENCES (FNREFNO) TIMES THE MERIT FROM THESE TABLES

!THE VECTOR CHOSEN IS USED TO HOLD INFORMATION ABOUT VARIABLES WITH
!GREATEST MERIT.  THE ROUTINE LOOKUP (ALSO USED IN DEFINITION POINT
!COMPUTATION) CAN BE USED FOR THE LINEAR SEARCH.

!FORMAT OF CHOSEN

!*************************
!            *           *
!    MERIT   *     PTR   *
!            *           *
!*************************

!PTR POINTS TO SYMBOL TABLE ENTRY

!WHILE THE RUNNING TALLY IS IN PROGRESS THE CELL MINWD CONTAINS THE MINIMUM
!MERIT ON THE LIST AND THE INDEX OF THAT ITEM ON THE LIST

!MINWD

!**********************************
!                 *               *
!    MIN MERIT    *      INDEX    *
!                 *               *
!**********************************

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

FORWARD
	GOTOINSERT(3),
	PLUSUNFLDO(1),
	ASCRIBE(1),
	ASSOCIA(1),
	USRFNWALK(1),
	CREDIT(1),
	RAYMERIT(1),
	CHKMAXLST(1),
	MINCOMPUTE,
	MELDPLEX,
	GRABFNREF(1),
	FLIPCODES,
	REGSUBDRIVER,
	FIXENTRY,
	MAKREGMASK,
	SKIPMATERIALIZATION(1),
	GETPRELOAD,
	GETMATERIAL,
	GBLALLOC,
	BLDREGCONTENTS(1),
	GOTOFORCELOAD,
	LEAFLOOKER(1),
	CALLSAVE(1),
	CALRESTORE(1),
	LABLLOK(3),
	MAKRETU(1),
	MAKSTASH(1),
!	NAMESET,	![2270] No longer needed
	STOWONRETURN,
	MATERIALIZE,
	MATLOK(3),
	INITEM,
	MRP3G;

EXTERNAL
	BOTTOM,
%1245%	CHDECL,		! Flag for character declaration seen
	CHOSEN,
%4517%	CGERR,
	CORMAN,
	DATPROC,
%2334%	ENTADDR,	! Object address of entry vector
	GLOBREG,
%1245%	HDRFLG,		! Flag for heading has been output
%1245%	HILOC,		! Current high seg break
%1245%	HSCHD,		! Routine to generate high seg descriptors for
			! character scalars and arrays
%1406%	HSDDESC,	! Routine to generate high seg descriptors for
			! .Dnnnn compile-time-constant character
			! descriptors
%1245%	HSLITD,		! Routine to generate high seg descriptors for
			! character constants
	ITMCT,
	LENTRY,
%1245%	LOWLOC,		! Current low seg break
	LOOKUP,
	MAKPR1,
	BASE PREV,
	QQ,
	SPECCASE,
%1245%	TCNT,		! Count of temporaries on a line
	TOP;

BIND				!USED AS INDICES INTO THE MERIT TABLES
	LHSUSE=0,		!KAMERIT & KIMERIT
	DEXUSE=1,
	LCTLUSE=2,
	FUNUSE=3,
	PLAINUSE=4,
	ASGNMEM=5;

!FOR VALUES OF THE VARIOUS MERITS ASSIGNED
BIND MERITVAL=PLIT ( 3,		!USE ON LHS
		     3,		!USE AS INDEX
		     6,		!LOOP CONTROL
		     6,		!CALL OR FUNCTION REFERENCE
		     0,		!OTHERS
		     4);	! ASSGN TO MEM


OWN
%776%	BASE CLOGIF,	!Logical If node being processed by LEAFLOOKER
	CALLREFNO,	!NUMBER OF CALLS IN THE LOOP
	CALLSEEN,	!INDICATES 2 CALLS (OR THE LIKE) IN A ROW
	CLEANSLATE,
	FNREFNO,	!NUMBER OF USER FUNCTION REFERENCES
			!INNN FRONT OF GBLALLOC.
	GUIDE,		!INDICATES EXACT ALLOCATION SITUATION. SEE COMMANTS
	HEAD,
	LASTAT,
	LIBFNREFNO,	!LIBRARY FUNCTION REFERENCE.
	MAXCOMPLEX[10],
	MINWD,
	OLDCSTMNT,	!TO SAVE VALUE OF CSTMNT WHEN NEEDED
	P,
%4527%	BASE PA,
	PB,
	PC,
	PD,
	BASE PREVBB,	!POINTS TO THE PASIC BLOCK INFRONT OF A 
			!DO THAT IS BEING ALLOCATED.
	RAISE,
	REGAVAIL,
	REGTOALC,	!NUMBER OF REGISTERS ALLOCATED
	SAVCODE,	!CODE TO DIRECT SAVING,RESTORING,PRELOADING AND
			!MATERIALIZATION FO REGISTERS
	SAVHITCH,
	SECIDX,		!INDEX OF SECOND LEVEL LOOP
	BASE STARTSUB,
	BASE STOPSUB,	!START REGCONTENTS SUBSTIRUTION AT STARTSUB AND STOP 
			! IT AT STOPSUB
	BASE T,		!GENERAL TEMP
	THISTAT,
	BASE WAYBBB;	!POINTS TO BASIC BLOCK IN FRONT FOR PREVBB
			!*WAY* *B*ACK *B*ASIC *B*LOCK

MAP PEXPRNODE P:PB:PC:PD:THISTAT:LASTAT;


!**;[1726], PH3G @4671(4047 in V6), DCE, 9-Feb-83
!**;[1726], ROUTINE to insert a new GOTO statement
GLOBAL ROUTINE GOTOINSERT(PREV,NEXT,DEST)=
BEGIN

!	This routine will create and insert a (new) GOTO statement
!	into a program.  PA will point to the newly created GOTO statement.

!	Parameters:
!	PREV points to the statement before the newly created GOTO statement.
!	NEXT points to the statement after the GOTO statement.
!	DEST points to the statement that the GOTO needs to reach; there
!	may or may not be an existing label on statement DEST.  If there
!	is no label, one is created.  PD will point to the label.

	EXTERNAL GENLAB;
	MAP BASE PREV:NEXT:DEST;

!	Do we need to create a label?

	IF .DEST[SRCLBL] NEQ 0
	THEN
	BEGIN
		PD=.DEST[SRCLBL];	! Label already exists
		PD[SNREFNO]=.PD[SNREFNO]+1
	END
	ELSE
	BEGIN
		DEST[SRCLBL]=PD=GENLAB();	! Create new label
		PD[SNHDR]=.DEST;
		PD[SNREFNO]=2
	END;

!	Create the GOTO Statement

	NAME<LEFT>=GOTOSIZ+SRCSIZ;
	PA=CORMAN();
	PA[OPRCLS]=STATEMENT;
	PA[SRCID]=GOTOID;
	PA[GOTOLBL]=.PD;

!	Link in the GOTO statement node

	PREV[SRCLINK]=.PA;
	PA[SRCLINK]=.NEXT

END;	!Of GOTOINSERT

!MACRO TO DETERMINE IF IT IS LEGAL TO ALLOCATE A LOOP.
!HAVING AN ENTRANCE OR A RETURN MAKES IT ILLEGAL
MACRO LEGALALLOC(NOD)=
	(NOT (NOD[HASENT] OR NOD[HASRTRN] OR NOD[USRFNREF]))$;

!MACRO TO COMPARE SAVCODE WITH CODE IN NODE
MACRO CODEMATCH(ITEM)=
	(ITEM<ALCFLG> EQL .SAVCODE)$;

!MACRO TO CHECK IF THE DO LOOP INDEX WAS GLOBALLY ALLOCATED
!AND SET THE FIELD IN THE DO LOOP NODE.
!ON THE OTHERHAND IF THE INDEX IS NEITHER LOCALLY NOR GLOBALLY
!ALLOCATED THE DOIREG FIELD MUST BE SET TO THE FIRST FREE REG
!SO THAT THERE IS NOT A CONFLICT.
!THE MODULE OWN MINWD CONTAINS THIS REGISTER NUMBER.
!IF THE INDEX IS DOUBLE PRECISION ALSO ASSURE THAT AN EVEN REG IS
!CHOSEN

MACRO SETDOIREG=
	BEGIN
		EXTERNAL BASE INDVAR;
		EXTERNAL BASE QQ;
		DECR I FROM .REGTOALC-1 TO 0 DO
			IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
			BEGIN
				QQ_.CHOSEN[.I];
				TOP[DOIREG]_.QQ[TARGTAC];
			END;
		IF NOT .TOP[IXGALLOCFLG] THEN
			IF .TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY] THEN
				TOP[DOIREG]_(IF .MINWD AND .INDVAR[DBLFLG] THEN .MINWD+1 ELSE .MINWD);
	END$;

!MACRO TO SEARCH GLOBALLY ALLOCATED LIST AND SET BIT IN LUP NODE
!IF THE INDEX IS GLOBALLY ALLOCATED
MACRO CHKGIX=
	BEGIN
%[1051]%		DECR I FROM 31 TO 0 DO
			IF .CHOSEN[.I]<RIGHT> EQL .INDVAR THEN
				TOP[IXGALLOCFLG]_1;
	END$;

!MACRO TO MAKE CODE DONE IN TWO PLACES EASIER TO READ
MACRO EASY1=
	BEGIN
		STARTSUB_.TOP;
		STOPSUB_.BOTTOM;
		REGSUBDRIVER();
		FLAG_0;
		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			T_.GLOBREG[.I]<RIGHT>;
			IF .T[IDATTRIBUT(INDATA)] THEN
			BEGIN
				GLOBREG[.I]<ALCFLG>_PRELOAD;
				FLAG_1;
			END;
		END;

		SAVCODE_PRELOAD;
		GBSYREGS_.CLEANSLATE;
		IF .FLAG THEN
			CALRESTORE(.TOP);
	END$;

!MACRO TO CASE THE STATEMENT AFTER THE ONE  POINTED TO BY LOCLNK TO BE LABELED
MACRO LABFRST=
	BEGIN
		MAP BASE LOCLNK;
		REGISTER BASE T;
		T_GENLAB();
		T[SNHDR]_.LOCLNK;
		LOCLNK[SRCLBL]_.T;
		T[SNREFNO]_2;
		.T
	END$;


!MACROS DEFINING THE BITS SET IN THE LEFT HAVE OF A GLOBREG WORLD
!THAT GOVERN SAVES, RESTORES, PRELOADS, MATERIALIZATIONS,
!AND INDICATE VARIOUS PROPERTIES OF THE VARIABLE.
MACRO
	AWL=12$,		!ALL 
	PRELOAD=2$,		!PRELOAD THIS ONE
	MATRLZ=1$,		!MATERIALIZE THIS ONE

!DECLARED IN OPTMAC
!	ALCFLG=32,4$,	!THE FIELD THAT CONTAINS AWL,PRELOAD OR MATRLZ
!	ALCFLGS=ALCFLG$,
	NOTFORML=31,1$,		!NOT A FORMAL VARIABLE
	PROGVAR=30,1$,		!A PROGRAM DEFINED VARIABLE
	NOPRELOAD=29,1$,	!DO NOT PRELOAD THIS ONE

!	FLAGS DEFINED IN TABLES BUT PART OF THIS WORD
!	ASGND4USED=27,1$,	!VARIABLE RECEIVES
				!A VALUE PRIOR TO ITS FIRST REFERENCE
				!IN THIS CONTEXT
!	USED4ASGND=28,1$,	!VARIABLE IS REFERENCED BEFORE
				!AN ASSIGNMENT IN THIS CONTEXT
%[634]%	NOTYETSEEN=26,1$,	!NEITHER OF ABOVE TWO FLAGS HAS YET
%[634]%				!BEEN SET. USED ONLY IN IFLID CASE OF
%[634]%				!LEAFLOOKER.  NOT GENERALLY CORRECT.

	NEDSAV=18,1$;		!THIS NEEDS TO BE SAVED ANY WAY


!IN THE ELSE CONDITION, A REGCONTENTS NODE WAS
!SUBSTITUTED DURING COMPLEXITY AND WE MUST
!SET THE GLOBALLY ALLOCATED FLAG AND TAKE THE REGISTER
!FROM THE POOL.
!MACRO TO GET PLACE AT WHICH ALLOCATION IS TO START
MACRO LOWERBD(NOD)=
	(IF NOD[NEDSMATRLZ] OR NOD[MATRLZIXONLY]
	 OR NOD[DOIREG] LSS .MINWD THEN .MINWD
	ELSE
	BEGIN
		CLEANSLATE_CLRBIT(.CLEANSLATE,NOD[DOIREG]);
		IF .INDVAR[DBLFLG] THEN
			CLEANSLATE_CLRBIT(.CLEANSLATE,NOD[DOIREG]+1);
		NOD[DOIREG]+1+.INDVAR[DBLFLG]
	END)$;


!MACRO TO DELETE INNERDO LOOP INDEX FROM LIST OF VARIABLE WITH
!MERIT IF IT WAS LOCALLY ALLOCATED.
!UPDATED IN EDIT 240 TO LOOK AT COMPLETE LIST
MACRO REMOVINDVAR=
	BEGIN
	IF NOT .TOP[NEDSMATRLZ] AND NOT .TOP[MATRLZIXONLY]  THEN
		DECR I FROM 31 TO 0 DO

			IF .CHOSEN[.I]<RIGHT> EQL .INDVAR THEN
			BEGIN
				CHOSEN[.I]_0;
				REGTOALC_.REGTOALC-1;
				IF .REGTOALC LEQ 0 THEN RETURN;
			END;
	END$;

!MACRO TO SWITCH AROUND TWO ENTRIES IN GLOBREG AND CHOSEN.  ALSO RESET
!NEDSMATRLZ ON PARAMETER LUP.
!TRADE GINX1 AND GINX2 ENTRIES OF GLOBREG AND CHOSEN

MACRO SWAPG(LUP,GINX1,GINX2)=
	BEGIN
		REGISTER T;
		LUP[NEDSMATRLZ]_0;
		LUP[MATRLZIXONLY]_0;
		T_.GLOBREG[GINX1]<0,36>;
		GLOBREG[GINX1]_.GLOBREG[GINX2]<0,36>;
		GLOBREG[GINX2]_.T<0,36>;
		GLOBREG[GINX2]<NOPRELOAD>_1;
		T_.CHOSEN[GINX1];
		CHOSEN[GINX1]_.CHOSEN[GINX2];
		CHOSEN[GINX2]_.T;
	END$;
ROUTINE PLUSUNFLDO(STMT)=
BEGIN
	!UNDO THE AOBJN LOOP ENDING.
	!USED WHEN WE ARE NOT 100% SURE THAT WE CAN DO AN AOBJN
	!SOME OF THESE CASES ARE:
	!	1.NEDSMATRLZ WAS SET BY P2S SO THE UNFLDO CONDITION
	!	  WAS NOT ALSO FOUND
	!	2.ITS THE OUTER LOOP OF TWO BEING ALLOCATED

	EXTERNAL UNFLDO;

	MAP BASE STMT;

	UNFLDO(.STMT);
	STMT[SSIZONE]_1;
	STMT[INITLIMMED]_1;
	STMT[SSIZIMMED]_1;

END;	! of PLUSUNFLDO
ROUTINE ASCRIBE(P)=
BEGIN
	!**************************************************************
	! Tally merit  by  statement.   Set  merit  to  plainuse  first.
	! Change wherever necessary.
	!**************************************************************

%2204%	! Restructure to generate better code, removing a SELECT with
%2204%	! an ALWAYS clause.

	MAP PEXPRNODE P;
	REGISTER
		I,
		BASE TMP;

	RAISE = .MERITVAL[PLAINUSE];

	! If complexity has said this statement needs pairs of regs then
	! set GOTEMDBL flag so we will leave two pairs.

	IF .P[PAIRMODEFLG] THEN GOTEMDBL = 1;

	! First look at any local common subs that may be there
	IF .P[SRCOPT] NEQ 0
	THEN
	BEGIN
		TMP = .P[SRCOPT];
		WHILE .TMP NEQ 0 DO
		BEGIN	! Walk linked list of common subs
			CREDIT(.TMP[ARG2PTR]);
			TMP = .TMP[SRCLINK];
		END;	! Walk linked list of common subs
	END;

	IF .P[SRCID] EQL ASGNID
	THEN
	BEGIN			! ASSIGNMENT
		PC = .P [LHEXP];	! Look at LHS
		IF .PC [OPRCLS] EQL DATAOPR
		THEN
		BEGIN	! It is a variable
			IF .P [MEMCMPFLG]
			THEN RAISE = .MERITVAL [ASGNMEM]
			ELSE RAISE = .MERITVAL [LHSUSE];

			CREDIT(.PC);
		END	! It is a variable
		ELSE	
		BEGIN	! It is not a variable
%4517%			CREDIT(.PC);
		END;

		! Now the right hand  side.  Give more  credit if it  is
		! there all by itself.

		IF .P[A2VALFLG]
		THEN	RAISE = .MERITVAL[LHSUSE] ! More credit as the lhs gets
		ELSE	RAISE = .MERITVAL[PLAINUSE];

		CREDIT(.P[RHEXP]);
	END			! ASSIGNMENT
	ELSE IF .P[SRCID] EQL CALLID
	THEN
	BEGIN			! CALL
		IF .P[CALLIST] NEQ 0
		THEN CALLREFNO = .CALLREFNO + 1;	! Tally number of calls
	END			! CALL
	ELSE IF .P[SRCID] EQL IFAID
	THEN	CREDIT(.P[AIFEXPR])	! ARITHMETIC IF
	ELSE IF .P[SRCID] EQL IFLID
	THEN
	BEGIN			! LOGICAL IF
		CREDIT(.P[LIFEXPR]);
		ASCRIBE(.P[LIFSTATE]);
	END;			! LOGICAL IF

%2237%	! Removed code  for  I/O  statements, which  merely  made  the
%2237%	! global register allocator paranoid about allocating  things,
%2237%	! and resulted pessimal code.

	I = (IF .P[SRCCMPLX] GTR 9 THEN 9 ELSE .P[SRCCMPLX]);
	MAXCOMPLEX[.I] = .MAXCOMPLEX[.I] + 1;

END;	! of ASCRIBE
ROUTINE ASSOCIA(VAR)=
BEGIN
	!CHECK THE LIST OF ASSOCIATE VARIABLES. DO NOT ALLOCATE
	!ANY OF THEM. RETURN 1 TO STOP ALLOCATION

	EXTERNAL ASSOCPTR;

	REGISTER BASE T;

	IF .ASSOCPTR EQL 0 THEN RETURN;

	T_.ASSOCPTR;
	WHILE .T NEQ 0 DO
	BEGIN
		IF .T[LEFTP] EQL .VAR THEN RETURN(1);
		T_.T[RIGHTP];
	END;

END;	! of ASSOCIA
%[660]%	ROUTINE USRFNWALK(CNODE)=
%[660]%	BEGIN
%[660]%
![660] ADD NEW ROUTINE TO HANDLE USER FUNCTIONS WHICH
![660] OCCUR WITHIN IF STATEMENTS - REGISTER ALLOCATION NEEDS IT.
%[660]%
%[660]%		LOCAL ARGUMENTLIST ARGNOD,P;
%[660]%		EXTERNAL CSTMNT;
%[660]%		MAP BASE P:CSTMNT;
%[660]%		MAP PEXPRNODE CNODE;
%[660]%	
%[660]%		CSTMNT[USRFNREF]_1;
%[660]%		FNREFNO_.FNREFNO+1;
%[660]%	
%[660]%		ARGNOD_.CNODE[ARG2PTR]; !PTR TO ARGUMENT LIST
%[660]%	
%[660]%		INCR I FROM 1 TO .ARGNOD[ARGCOUNT] DO
%[660]%		BEGIN
%[660]%			P_.ARGNOD[.I,ARGNPTR]; !GET ACTUAL ARGUMENT
%[660]%			IF .P[OPRCLS] EQL FNCALL THEN CREDIT(.P) !RECUR
%[660]%			ELSE IF .P[OPR1] EQL VARFL THEN
%[660]%				IF .CSTMNT[SRCID] EQL IFAID OR
%[660]%				(.CSTMNT[SRCID] EQL IFLID AND .CSTMNT[TRUEISBR])
%[660]%			THEN P[USRARGUSE]_1	!THIS VARIABLE CANNOT LIVE IN REG
%[660]%		END
%[660]%
%[660]%	END;	!of USRFNWALK
ROUTINE CREDIT(CNODE)=
BEGIN
	!INCREMENT MERIT BY RAISE. WALK TREE THRU AUDITOR
	!CNODE POINTS TO AN EXPRESSION. RAISE IS GLOBAL TO CREDIT
	!AND IS SET BY AUDITOR
	EXTERNAL CSTMNT; MAP BASE CSTMNT;
	MAP PEXPRNODE CNODE;
	CASE .CNODE[OPRCLS] OF SET
	!BOOLEAN
	BEGIN
		CREDIT(.CNODE[ARG1PTR]);
		CREDIT(.CNODE[ARG2PTR]);
	END;
	!DATAOPR
	BEGIN
		IF .CNODE[OPERSP] EQL VARIABLE OR
		.CNODE[OPERSP] EQL FORMLARRAY OR
		.CNODE[OPERSP] EQL FORMLVAR THEN
		BEGIN
%2375%			! Never globally allocate character variables
%2375%			IF .CNODE[VALTYPE] EQL CHARACTER THEN RETURN;

			!FOR THE INITIAL RELEASE GLOBALS WILL BE HANDLED
			!AS COMMON. SOPHISTACATION CAN COME LATER.
			IF .CNODE[IDATTRIBUT(INEQV)] THEN RETURN;
			IF .CNODE[IDATTRIBUT(INCOM)] THEN RETURN;
			IF .CNODE[IDATTRIBUT(INASSI)] THEN RETURN;
			IF .CNODE[IDATTRIBUT(INNAM)] THEN RETURN;
			IF .CNODE[IDATTRIBUT(FENTRYNAME)] THEN RETURN;
			CNODE[MERIT]_.CNODE[MERIT]+.RAISE;!UPDATE MERIT
			!FOR A VARIABLE THAT IS DOUBLE WORD
			!SET THE FLAG AND DIVIDE THE MERIT
			!JUST ADDED BY 2
			IF .CNODE[DBLFLG] THEN
			BEGIN
				CNODE[MERIT]_.CNODE[MERIT]-.RAISE/2;
				GOTEMDBL_1;
			END;
			IF .CNODE[MERIT] NEQ 0 THEN
				CHKMAXLST(.CNODE);
		END;
	END;
	!RELATIONAL
	BEGIN
		CREDIT(.CNODE[ARG1PTR]);
		CREDIT(.CNODE[ARG2PTR]);
	END;
	!FNCALL
		IF .CNODE[OPERSP] NEQ LIBARY THEN
%[660]%		USRFNWALK(.CNODE)
		ELSE
		BEGIN
			!LIBRARY FUNCTION. SET BIT IN SYMBOL
			!TABLE THAT SAYS THIS IS USED
			!AS LIB FUNCTION ARG. SUBTRACT IT AT END
			!AS WITH FNREFNO.

			LOCAL ARGUMENTLIST ARGNOD,P;
			MAP BASE P;
			LIBFNREFNO_.LIBFNREFNO+1;
			ARGNOD_.CNODE[ARG2PTR];	!PTR TO LIST
			INCR I FROM 1 TO .ARGNOD[ARGCOUNT] DO
			BEGIN
				!PICK UP POINTER TO ACTUAL ARG
				P_.ARGNOD[.I,ARGNPTR];
				IF .P[OPR1] EQL VARFL THEN
					P[LIBARGUSE]_1
				ELSE
					!MAKE SURE THAT LIBARG REFS
					!ARE COUNTED FOR CALLS TO LIB
					!THAT ARE FUNCTIONS OF OTHER CALLS TO
					!TO THE LIBRARY
					IF .P[OPRCLS] EQL FNCALL THEN
						CREDIT(.P);
			END;
		END;
	!ARITHMETIC
	BEGIN
		CREDIT(.CNODE[ARG1PTR]);
		CREDIT(.CNODE[ARG2PTR]);
	END;
	!TYPECNV
	BEGIN
		CREDIT(.CNODE[ARG2PTR]);
	END;
	!ARRAYREF
%2375%	BEGIN
%2375%		! Don't give extra credit for character array indices
%2375%
%2375%		IF .CNODE[VALTYPE] NEQ CHARACTER
%2375%		THEN RAYMERIT(.CNODE)
%2375%		ELSE IF .CNODE[ARG2PTR] NEQ 0
%2375%		THEN CREDIT(.CNODE[ARG2PTR]);
%2375%	END;
	!CMNSUB		!ILLEGAL
	BEGIN
	END;
	!NEGNOT
		CREDIT(.CNODE[ARG2PTR]);
	!SPECOP
		CREDIT(.CNODE[ARG1PTR]);
	!FIELDREF	!RELEASE GTR 1
	BEGIN
	END;
	!STORCLS
	BEGIN
	END;
	!REGCONTENTS
	BEGIN END;
	!LABOP
	BEGIN
	END;
	!STATEMENT
	BEGIN END;
	!IOLSCLS
	BEGIN
	END;
	!INLINFN
	BEGIN END;

%2375%	!SUBSTRING
%2375%	BEGIN
%2375%		CREDIT(.CNODE[ARG1PTR]);	! Upper bound
%2375%		CREDIT(.CNODE[ARG2PTR]);	! Lower bound
%2375%		CREDIT(.CNODE[ARG4PTR]);	! ARRAYREF or DATAOPR
%2375%	END;

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

	TES;

END;	! of CREDIT
ROUTINE RAYMERIT(PC)=
BEGIN
	!COMPUTE ARRAYREF MERIT
	OWN BASE ARGNOD;
	MAP PEXPRNODE PC;

	!COMPUTE MERIT FOR AN ARRAY SUBSRCIPT.
	!FORMALS ARE NOT A SPECIAL CASE HERE AS
	!THEY HAVE THE PSEUDO CREATED NODE POINTED TO BY
	!THE ARADDRVAR FIELD OF THE SYMBOL TABLE. THIS PSEUDO
	!NODE IS IN THE TREE AND WILL GET MERIT.

	!TAKE CARE OF CONSTANT SUBSCRIPT (ARG2PTR = 0)
	IF .PC[ARG2PTR] EQL 0 THEN RETURN;

	ARGNOD_.PC[ARG2PTR];				!SUBSCRIPT
	!ONLY GIVE CREDIT FOR INDEX
	!IF ITS BY ITSELF
	IF .ARGNOD[OPRCLS] EQL DATAOPR THEN
	BEGIN
		RAISE_.MERITVAL[DEXUSE];
		CREDIT(.ARGNOD);
	END ELSE
	IF .ARGNOD[OPRCLS] EQL CMNSUB THEN
	BEGIN
		IF .ARGNOD[A2VALFLG] THEN
		BEGIN
			RAISE_.MERITVAL[DEXUSE];
			CREDIT(.ARGNOD[ARG2PTR]);
		END;
	END ELSE
	BEGIN						!JUST PLAIN USE
		RAISE_.MERITVAL[PLAINUSE];
		CREDIT(.ARGNOD);
	END;
	RAISE_.MERITVAL[PLAINUSE];

END;	! of RAYMERIT
ROUTINE CHKMAXLST(VAR)=
BEGIN
	!LOOK AT LIST OF VARIABLES WHICH ARE CURRENTLY OF GREATEST MERIT.
	!THE LIST IS IN CHOSEN
	!VAR IS THE VARIABLE WHOSE MERIT IS UNDER EXAMINATION
	!
	LOCAL I;
	MAP PEXPRNODE VAR;
	I_LOOKUP(.VAR<RIGHT>);
	IF .I LSS 32 THEN
	CHOSEN[.I]<LEFT>_.VAR[MERIT]
	ELSE
	BEGIN					       !VARIABLE IS NOT ON LIST
		!IF LIST IS NOT YET FULL (HEAD HAS COUNT) ADD TO THE LIST
		IF .HEAD LEQ 31 THEN		!HEAD CONTAINS COUNT
			(
			CHOSEN[.HEAD]<LEFT>_.VAR[MERIT];
			CHOSEN[.HEAD]<RIGHT>_.VAR;
			HEAD_.HEAD+1;)
			ELSE
			!IF THIS ONE HAS GREATER MERIT THAN THE
			!CURRENT MINIMUM ON THE LIST THEN REPLACE THE
			!OLD MINIMUM WITH THIS ONE AND RECOMPUTE THE MINIMUM
			BEGIN
				IF .MINWD EQL 0 THEN MINCOMPUTE();
				IF .VAR[MERIT] GTR .MINWD<LEFT> THEN
				BEGIN
				CHOSEN[.MINWD<RIGHT>]<LEFT>_.VAR[MERIT];
				CHOSEN[.MINWD<RIGHT>]<RIGHT>_.VAR;
				MINCOMPUTE();
				END;	!MIN REPLACEMENT AND RECOMPUTE
			END;
	END;
END;	! of CHKMAXLST
ROUTINE MINCOMPUTE=
BEGIN
			!RECOMPUTE THE MINIMUM OF THE LIST
			MINWD<LEFT>_#100000;
			DECR K FROM 31 TO 0 DO
			BEGIN
				IF .CHOSEN[.K]<LEFT> LSS .MINWD<LEFT> THEN
				(MINWD<LEFT>_.CHOSEN[.K]<LEFT>;
				MINWD<RIGHT>_.K;);
			END;
END;	! of MINCOMPUTE
ROUTINE MELDPLEX=
BEGIN
	!MELD IN CONSIDERATION OF THE COMPLEXITY OF THE
	!EXPRESSIONS INVOLVED AND ADJUST REGTOALC APPROPRIATELY
	!
	!THIS IS STRICTLY A HEURISTIC:
		!THE COMPLEXITY DISTRIBUTION IS EXAMINED.
		!THE NUMBER OF REGISTERS AVAILABLE IS DECREASED BY 1
			!FOR EACH STATEMENT OF COMPLEXITY GREATER
			!THAN THE 4 STANDARD COMPUTATION REGISTERS.
		!REGAVAIL ORIGINALLY CONTAINED THE NUMBER OF REGISTERS
		!IT WAS INTENDED TO ALLOCATE GLOBALLY.
		!REGTOALC CONTAINS THE ACTUALL NUMBER WE WILL ALLOCATE.
	!
	!THIS ROUTINE WILL ALSO DETERMINE THE TRUE VALUE OF
	!REGTOALC, THE NUMBER OF REGISTERS THAT **WILL** BE
	!GLOBALLY ALLOCATED. CHOSEN IS EXAMINED TO DETERMINE
	!IF THERE ARE ANY ENTRIES AT ALL.

	LABEL LOP1;

	LOP1:
	DECR I FROM 9 TO 4 DO
		IF .MAXCOMPLEX[.I] NEQ 0 THEN
		BEGIN
			REGAVAIL_.REGAVAIL-.I;
			LEAVE LOP1;
		END;
	REGTOALC_.REGAVAIL;

	!COUNT NON-ZERO ENTRIES IN CHOSEN
	!USE REGAVAIL AS A TEMP

	REGAVAIL_0;
	DECR I FROM 31 TO 0 DO
		IF .CHOSEN[.I] NEQ 0 THEN
			REGAVAIL_.REGAVAIL+1;
	!NOW SEE IF THIS IS LESS THEN REGTOALC DETERMINED
	!FROM THE COMPLEXITIES

	IF .REGAVAIL LSS .REGTOALC THEN REGTOALC_.REGAVAIL;

END;	! of MELDPLEX

EXTERNAL CLEANUP;
ROUTINE GRABFNREF(EXPR)=
BEGIN

	!EXAMINE EXPR FOR A FUNCTION REFERENCE TO A USER
	!FUNCTION. IF ANY GLOBALLY ALLOCATED VARIABLES ARE
	!ARGUMENTS TO THE FUNCTION CHANGE THEIR SAVCODE
	!<ALCLFG> TO BE MATRLZ

	MAP BASE EXPR;

	CASE .EXPR[OPRCLS] OF SET

	!BOOLEAN
	BEGIN
		GRABFNREF(.EXPR[ARG1PTR]);
		GRABFNREF(.EXPR[ARG2PTR]);
	END;

	!DATAOPR
		RETURN;

	!RELATIONAL
	BEGIN
		GRABFNREF(.EXPR[ARG1PTR]);
		GRABFNREF(.EXPR[ARG2PTR]);
	END;

	!FNCALL
	BEGIN

		REGISTER ARGUMENTLIST AG;
		IF .EXPR[OPERSP] EQL LIBARY THEN
			RETURN;
		!HERE WE HAVE A GENUINE USER FUNCTION REFERENCE
		AG_.EXPR[ARG2PTR];
		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			!FOR EACH GLOBALLY ALLOCATEREG
			INCR ARG FROM 1 TO .AG[ARGCOUNT] DO
			BEGIN
				!FOR EACH ARGUMENT
				IF .AG[.ARG,ARGNPTR] EQL
					.GLOBREG[.I]<RIGHT> THEN
					GLOBREG[.I]<ALCFLG>_MATRLZ;
			END;
		END;
	END;

	!ARITHMETIC
	BEGIN
		GRABFNREF(.EXPR[ARG1PTR]);
		GRABFNREF(.EXPR[ARG2PTR]);
	END;
	
	!TYPECNV
		GRABFNREF(.EXPR[ARG2PTR]);

	!ARRAYREF
	BEGIN
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			GRABFNREF(.EXPR[ARG2PTR]);
	END;

	!CMNSUB
		GRABFNREF(.EXPR[ARG2PTR]);

	!NEGNOT
		GRABFNREF(.EXPR[ARG2PTR]);

	!SPECOP
		GRABFNREF(.EXPR[ARG1PTR]);

	!FIELDREF
		RETURN;
	
	!STORECLS
		GRABFNREF(.EXPR[ARG2PTR]);

	!REGCONTENTS
		RETURN;

	!LABOP
		RETURN;

	!STATEMENT
		RETURN;

	!IOLSCLS
		RETURN;

	!INLINFN
	BEGIN
		GRABFNREF(.EXPR[ARG1PTR]);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
			GRABFNREF(.EXPR[ARG2PTR]);
	END;

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

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

	TES;

END;	! of GRABFNREF
ROUTINE FLIPCODES=
BEGIN
	!STUPID BUT EASIER THAN LOTS MORE BUGS.
	!CODES WERE INITIALIZED TO AWL.
	!SOME MAY HAVE BEEN RESET TO MATRLZ BY GRABFNREF.
	!WE WILL BE SAVING AND RESTORING BASED ON AWL
	!SO MAKE THOSE THAT SAY AWL NOW SAY MATRLZ AND
	!VISA VERSA
	!ALSO SORT GLOBREG SO THAT ALL THAT ARE NOT BEING
	!SAVED ARE LEAFSUBSTITUTED.


	!A MACRO OR TWO FOR LEGIBILITY
	LABEL FIND,CHECK,COUNTEM;
	LOCAL COUNT;

	!REGS THAT ARE SAVED ARE THOSE CONTAINING VARS WHICH ARE ACTUAL
	! ARGS TO FUNCTION
	EXTERNAL  ITMCT;	!SET UP BY SORTNMAKE IN GBLALLOC
				!  TO BE REGTOALC - 1
	MACRO SAVED(INX)=
		.GLOBREG[.INX]<ALCFLG> EQL AWL$;

	MACRO SWAAP(INX1,INX2)=
	BEGIN
		REGISTER T;
		T_.GLOBREG[.INX1]<0,36>;
		GLOBREG[.INX1]<0,36>_.GLOBREG[.INX2]<0,36>;
		GLOBREG[.INX2]<0,36>_.T<0,36>;
		T_.CHOSEN[.INX1];
		CHOSEN[.INX1]_.CHOSEN[.INX2];
		CHOSEN[.INX2]_.T;
	END$;

	DECR I FROM .REGTOALC-1 TO 0 DO
		IF .GLOBREG[.I]<ALCFLG> EQL AWL THEN
			GLOBREG[.I]<ALCFLG>_MATRLZ
		ELSE
			GLOBREG[.I]<ALCFLG>_AWL;

	!SORT GLOBREG SO THAT THOSE THAT ARE NOT SAVED ARE LEAFSUBSTITUTED
	! CALL LEAFLOOKER LOOKING ONLY AT THOSE NOT TO BE SAVED

	CHECK:
	DECR I FROM .REGTOALC-1 TO 0 DO
	BEGIN
		IF NOT SAVED (I) THEN
		FIND:
		BEGIN
			INCR J FROM 0 TO .I DO
			BEGIN
				IF SAVED (J) THEN
				BEGIN
					SWAAP(I,J);	! SORT ITEMS
					LEAVE FIND;	! LEAVE INNER LOOP
				END;
			END;
			LEAVE CHECK;	! FINISHED SORT IF NONE FOUND
		END;
	END;	! HAVE THEM SORTED

	COUNT _ 0;
COUNTEM:	! COUNT THE NUMBER NOT SAVED FOR CALL TO LEAFLOOKER
	DECR I FROM .REGTOALC-1 TO 0 DO
	IF NOT SAVED (I) THEN	! BY SCANNING BACK OVER
	BEGIN			! THOSE TO BE SAVED
		COUNT _ .I + 1;	! I AT FIRST ONE NOT SAVED: COUNT MUST BE 1-RELATIVE

		LEAVE COUNTEM;
	END;

	IF .COUNT NEQ 0 THEN	! IF SOME NOT SAVED THEN
	BEGIN
		LOCAL SAVE;
		SAVE_.REGTOALC;	! SAVE REAL VALUE
		REGTOALC_.COUNT;	! FAKE OUT LEAFLOOKER WITH OUR COUNT
		ITMCT _ .REGTOALC - 1;	!FAKE OUT LEAFSUBSTITUTE'S CALLEES
		LEAFLOOKER(.STARTSUB);	! SUBSTITUTE
		REGTOALC_.SAVE;
		ITMCT _ .REGTOALC - 1;	!RESTORE OLD ITMCT
	END;

END;	! of FLIPCODES
ROUTINE REGSUBDRIVER=
BEGIN
	!DRIVER ROUITNE FOR SUBSTITUTION OF REGCONTENTS NODES.
	!THE SCOPE OF THE SUBSTITUTION STARTS AT STARTSUB AND ENDS AT
	!STOPSUB.

	EXTERNAL CSTMNT,LENTRY;
	LABEL LUP;
%4517%	REGISTER BASE LHS;
	OWN BASE SAVHITCH;
	MAP BASE STARTSUB:STOPSUB;

	!RESET THE FLAG TO INDICATE NO SAVING SEQUENCE DONE
	SAVEDFLG_0;

	CALLSEEN_0; ! INITIALIZE CALLSEEN (NONE YET SEEN)
%[776]%	CLOGIF_0;	!No logical IF nodes are being processed
	!LEAFSUBSTITUTE NEEDS CSTMNT SO WE WILL SAVE THE CURRENT
	!VALUE AND PUT IT BACK WHEN WE ARE DONE HERE

	!MAKE SURE ALL CODES ARE AWL
	DECR I FROM .REGTOALC-1 TO 0 DO
		GLOBREG[.I]<ALCFLG>_AWL;

	SAVCODE_AWL;
	FRSTBB_1;		!SET FIRST BASIC BLOCK FLAG

	!SKIP ANY CALLS THAT ARE AT THE TOP
	WHILE (.STARTSUB[SRCID] EQL CALLID) OR .STARTSUB[USRFNREF]  DO
		STARTSUB_.STARTSUB[SRCLINK];


	!SET FLAG TO INDICATE WE ARE OUTSIDE THE LOOP
	!AND DO NOT WHICH TO SUBSTITUTE INTO STATEMENT
	!WITH RHEXP=REGCONTENTS

	NOINDVARFLG_1;

	!SET FLAG IF THIS IS DOUBLE NEST
	ASGN4LENTRY_(.GUIDE EQL 6);

	OLDCSTMNT_.CSTMNT;
	THISTAT_LASTAT_.STARTSUB;
	WHILE .STARTSUB NEQ .STOPSUB[SRCLINK] DO
	BEGIN
		!RESET NOINDVARFLG IF THIS IS "THE" LOOP WE ARE ALLOCATING
		IF .STARTSUB EQL .TOP THEN
		BEGIN
			 NOINDVARFLG_0;
			!IF ALLOCATING ONLY THE INNER LOOP OF A
			!NEST MARK ITEMS THAT WERE ASSIGNED
			!OUTSIDE THE LOOP AS NEEDING TO
			!TO BE SAVED.

			IF .GUIDE EQL 5 THEN
			BEGIN
				DECR I FROM .REGTOALC-1 TO 0 DO
					IF .GLOBREG[.I]<ASGND4USED> THEN
							GLOBREG[.I]<NEDSAV>_1;
			END;

		END;

		!IF A DOUBLE NEST AND WE HAVE REACHED THE OUTER LOOP
		!THEN WE MUST MARK ALL VARIABLES THAT WERE ALLOCATED TO
		!REGISTERS AND WERE ASSIGNED INTO IN THE BASIC BLOCK
		!PRECEDING THE OUTER LOOP AS NEEDING MATERIALIZATION
		!UNCONDITIONALLY. THIS IS BECAUSE DEFINITION POINT
		!ANALYSIS DID NOT MARK THESE VARIABLES AS BEING MODIFIED
		!INSIDE THE OUTER LOOP, AND SINCE WE HAVE SUBSTITUTED
		!A REGCONTENTS NODE FOR THE ORIGINAL ASSIGNMENT TO
		!MEMORY, THE VARIABLE WILL NEVER END UP IN MEMORY
		!UNLESS WE EXPLICITLY MATERIALIZE IT.

		IF .GUIDE EQL 6 AND .STARTSUB EQL .OLDCSTMNT
		THEN
		BEGIN
			DECR I FROM .REGTOALC-1 TO 0 DO
				IF .GLOBREG[.I]<ASGND4USED> THEN
					GLOBREG[.I]<NEDSAV>_1;
		END;

		!IF A DOUBLE NEST AND WE ARE OUTSIDE THE MOTION PLACE
		!OF UNSUBSUMED ITEMS IN THE OUTER LOOP MARK
		!ANY .O AS NEEDING SAVING

		IF .ASGN4LENTRY THEN
		BEGIN
			!IF THIS IS LENTRY QUIT
			IF .STARTSUB EQL .LENTRY THEN
				ASGN4LENTRY_0
			ELSE
			BEGIN
				IF .STARTSUB[OPRS] EQL ASGNOS THEN
				BEGIN
					IF .STARTSUB[A1VALFLG] THEN
					BEGIN
						T_.STARTSUB[LHEXP];
						IF .T[IDDOTO] EQL
						SIXBIT".O" THEN
						BEGIN
							DECR I FROM .REGTOALC-1 TO 0 DO
							IF .GLOBREG[.I]<RIGHT> EQL .T THEN
								GLOBREG[.I]<NEDSAV>_1;
						END;
					END;
				END;
			END;
		END;

		!SAV WHERE WE START
		CSTMNT_.STARTSUB;
		SAVHITCH_.STARTSUB[SRCLINK];
		!SUBSTITUT IF THERE ARE NO USER FUNCTION REFS

		!IF MORE THAN TWO CALLS OCCUR IN A ROW, WE WANT
		! TO ALLOW REGCONTENTS SUBSTITUTION ON THE FIRST CALL, 
		! NONE FOR ALL THE FOLLOWING CALLS (OR THE LIKE), AND THEN
		! A RESTORE OF THE REGISTERS PRIOR TO CONTINUING.  THE
		! VARIABLE CALLSEEN (SET IN LEAFLOOKER) INDICATES WE ARE
		! IN SUCH A SITUATION, HAVING SUBSTITUTED IN THE FIRST
		! CALL ALREADY.
		IF .CALLSEEN NEQ 0 THEN
		BEGIN
			CALLSEEN_0;
			T_.STARTSUB[SRCLINK];
			WHILE .T[USRFNREF] OR (.T[SRCID] EQL CALLID) DO
			BEGIN
					THISTAT_.T;
					T_.T[SRCLINK];
					END;
			SAVHITCH_.T;
			CALRESTORE(.THISTAT); !RESTORE REGISTERS FINALLY

			SAVEDFLG_0;
			! REINITIALIZE SAVE CODES AFTER RESTORATION
			DECR I FROM .REGTOALC-1 TO 0 DO
				GLOBREG[.I]<ALCFLG>_AWL;
		END  ELSE
		IF NOT .STARTSUB[USRFNREF] THEN
			LEAFLOOKER(.STARTSUB)
		ELSE
		BEGIN
			!TURN ON ALL USED4ASGND BITS. THIS MAY
			!BE NON-OPTIMAL BUT THERE IS NO CONVENIENT,
			!SHORT WAY TO EXAMINE THE EXPRESSIONS AND
			!SET THE BIT ONLY IF WE WANT TO. THOSE
			!NOT ALREADY ASGND4USED WILL, THEREFORE,
			!GET PRELOADED BY GETPRELOAD.

			DECR I FROM .REGTOALC-1 TO 0 DO
				IF NOT .GLOBREG[.I]<ASGND4USED> THEN
					GLOBREG[.I]<USED4ASGND>_1;

			!SET FLAG TO INDICATE THAT THERE ARE
			!SEVERAL IN A ROW

			T_.STARTSUB[SRCLINK];
			FLAG_.T[USRFNREF] OR (.T[SRCID] EQL CALLID);
			!SPECIAL CASE AN ASSIGNMENT WITH USRFNREF SET
			!TO SAVE AND RESTORE ONLY THOSE THAT ARE
			!ARGUMENTS

			IF .STARTSUB[SRCID] EQL ASGNID THEN
			BEGIN
				!IF NEXT STATEMENT DOES NOT ALSO
				!HAVE ONE OR IS NOT A CALL
				!OR ANY PREVIOUS STATEMENT DID NOT
				!CAUSE A STORE ALREADY
				IF NOT .FLAG AND NOT .SAVEDFLG THEN
				BEGIN
					GRABFNREF(.STARTSUB[LHEXP]);
					GRABFNREF(.STARTSUB[RHEXP]);
					FLIPCODES();
				END;
			END;

			!SAVE AND RESTORE AROUND STATEMENT
			!SET SAVE CODE
			SAVCODE_AWL;
			!IF ALL VARIABLES WERE NOT ALREADY MATERIALIZED
			!DO IT NOW.
			IF NOT .SAVEDFLG THEN
			BEGIN
				CALLSAVE(.LASTAT);
				SAVEDFLG_1;
			END;

			!IF ITS AN ASSIGNMENT STATEMENT AND THE LEFT HAND
			!SIDE SHOULD BE A REG THAN MAKE IT A REG AND DONT DO THE RESTORE
			IF (.STARTSUB[SRCID] EQL ASGNID) AND NOT .FLAG THEN
			BEGIN
%4517%				LHS = .STARTSUB[ARG1PTR];		
%4517%				IF .LHS[OPR1] EQL CHARFNFL ! 1-char asmnt
%4517%				THEN CGERR() 	!character variables are never 
%4517%					     	!selected for global register 
%4517%					     	!allocation. (see edit 2375).
%4517%				ELSE
%4517%				BEGIN	!non-character assignment
				LUP:
				DECR I FROM .REGTOALC-1 TO 0 DO
					IF .GLOBREG[.I]<RIGHT> EQL
					   .STARTSUB[LHEXP] THEN
					BEGIN
						!DO THE SUBSTITUTION FOR THE
						!SINGLE REFERENCE
						STARTSUB[LHEXP]_
						.CHOSEN[.I];
						!SET THE FIELD SO RESTORE
						!WILL NOT HAPPEN
						GLOBREG[.I]<ALCFLG>_PRELOAD;
						LEAVE LUP;
					END;
%4517%				END
			END;		!ITS AN ASSIGNMENT

			!SKIP TO THE PROPER PLACE TO RESTORE
			IF .FLAG THEN
			BEGIN
				WHILE .T[USRFNREF] OR (.T[SRCID] EQL CALLID) DO
				BEGIN
					THISTAT_.T;
					T_.T[SRCLINK];
				END;
				SAVHITCH_.T;
			END;

			!HAVE NOW SKIPPED ALL OR NONE. DO RESTORE
			CALRESTORE(.THISTAT);
			SAVEDFLG_0;


			!REINITIALIZE SAV CODES

			DECR I FROM .REGTOALC-1 TO 0 DO
				GLOBREG[.I]<ALCFLG>_AWL;

		END;		!USER FUNCTION CASE
		!SKIP OVER POTENTIAL RESTORE STATEMENTS INSERTED
		UNTIL .STARTSUB[SRCLINK] EQL .SAVHITCH DO
		BEGIN
			STARTSUB_.STARTSUB[SRCLINK];
				!THE FLAG SHOULD BE RESET ONLY IF WE
				!HAVE GENERATED THE RESTORES
				SAVEDFLG_0;
		END;

		LASTAT_.STARTSUB;
		THISTAT_STARTSUB_.STARTSUB[SRCLINK];
	END;	!WHILE
	CSTMNT_.OLDCSTMNT;

END;	! of REGSUBDRIVER
ROUTINE FIXENTRY=
BEGIN
	LOCAL T;
	MAP BASE TOP:T;
	OWN ARGUMENTLIST NEWLIST;
	!FOR EACH ENTRY:
	!	FIX THE PROLOGUE
	!	INSERT PRELOADS
	!	INSERT MATERIALIZATIONS

	!*********************
	!MACRO TO SET UP ENTRY LIST INFORMATION
	MACRO SETENTRY=
	BEGIN
		REGISTER BASE REG;
		!LOOK AT THE REGCONTENTS NODE
		!AND PUT THE REGISTER INTO
		!THE ENTAC OF THE ENTRY
		!LIST
		REG_.CHOSEN[.I];
		NEWLIST[.K,ENTAC]_.REG[TARGTAC];
		NEWLIST[.K,ENTGALLOCFLG]_1;
		!SET A FLAG TO HELP LATTER
		GLOBREG[.I]<NOPRELOAD>_1;
	END$;

!**;[1726], FIXENT @5677(5044 in V6), DCE, 9-Feb-83
%1726%	PREV_0;
	T_.TOP;
	WHILE .T NEQ 0 DO
	BEGIN
		IF .T[SRCID] EQL ENTRID THEN
		BEGIN

		!REINITIALIZE FLAGS AND FIELDS IN GLOBREG TO
		!PROPERLY HANDLE MULTIPLE ENTRIES

		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			GLOBREG[.I]<NOPRELOAD>_0;
			GLOBREG[.I]<ALCFLG>_AWL;
			!IF THIS IS A SECONDARY ENTRY RESET ASGND4USED
			!AND SET USED4ASGND
			IF .T[ENTNUM] NEQ 0 THEN
			BEGIN
				GLOBREG[.I]<ASGND4USED>_0;
				GLOBREG[.I]<USED4ASGND>_1;
			END;
		END;

		!CHECK FOR NO PARAMETERS
		IF .T[ENTLIST] NEQ 0 THEN
		BEGIN
			NEWLIST_.T[ENTLIST];
			!FOR EACH ALLOCATED REGISTER LOOK AT THE
			!PARAMETERS
			DECR I FROM .REGTOALC-1 TO 0 DO
			BEGIN
				INCR K FROM 1 TO .NEWLIST[ARGCOUNT] DO
				BEGIN
					!IF A PARAMETER MATCHES AN
					!ALLOCATED VARIABLE
					IF .NEWLIST[.K,ARGNPTR] EQL
					   .GLOBREG[.I]<RIGHT> THEN
					BEGIN
						SETENTRY;
					END ELSE
					BEGIN
						!IF ITS A FORMAL ARRAY
						!WE HAVE TO COMPARE THE
						!KLUDGED ENTRY POINTED TO BY
						!THE DIMENSION TABLE
						REGISTER BASE TMP;
						TMP_.GLOBREG[.I]<RIGHT>;
						IF.TMP[OPERSP] EQL FORMLARRAY THEN
						BEGIN
							TMP_.TMP[IDDIM];
							IF NOT .TMP[ADJDIMFLG] THEN
							IF .TMP[ARADDRVAR] EQL .GLOBREG[.I]<RIGHT> THEN
							SETENTRY;
						END;
					END;
				END;
			END;


		END;		!PARAMETERS

		!PROLOGUE IS FIXED. DO PRELOADS
		FLAG_0;		!USE TO SAY IF THERE ARE SOME
		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			!CHECK ASGND4USED AND SET NOPRELOAD

			IF .GLOBREG[.I]<ASGND4USED> THEN
				GLOBREG[.I]<NOPRELOAD>_1;
		END;

		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			IF NOT .GLOBREG[.I]<NOPRELOAD>
			THEN
			BEGIN
				GLOBREG[.I]<ALCFLG>_PRELOAD;
				FLAG_1;
			END;
		END;

		SAVCODE_PRELOAD;
!**;[1726], FIXENTRY @5759(5126 in V6), DCE, 9-Feb-83
%1726%		IF .FLAG
%1726%		THEN
%1726%		BEGIN
!			Initialize registers at the entry point, but first
!			we must make sure that there will be a jump around the
!			entry point which gets us PAST these initializations!
!			Otherwise we will "initialize" on our way around.
%1726%			GOTOINSERT(.PREV,.T,.T[SRCLINK]); !The jump around
%1726%			PA[SRCLBL]=.T[SRCLBL];	! Put label(s) from ENTRY stmnt
%1726%			T[SRCLBL]=0;		! onto the JRST statement.
%1726%			CALRESTORE(.T);	!The initializations
%1726%		END;	!Of initializing registers

		END;		!AN ENTRY STATEMENT

%1726%		PREV_.T;	!Save previous stmnt pointer
		T_.T[SRCLINK];	!MOVE ON TO NEXT ONE
	END;		!WHILE ON T

	!NOW DO MATERIALIZATIONS
	!USE FLAG TO INDICATE PRESENCE AGAIN
	FLAG_0;
	DECR I FROM .REGTOALC-1 TO 0 DO
	BEGIN
		!IF THERE ARE MULTIPLE ENTRIES WE HAVE TO
		!SAVE THE OPTIMIZER VARIABLES TOO. OTHERWISE
		!WE DO NOT

		IF .FLGREG<MULTENT> THEN
		BEGIN
			IF .GLOBREG[.I]<PROGVAR> THEN
			BEGIN
				FLAG_1;
				GLOBREG[.I]<ALCFLG>_MATRLZ;
			END;
		END ELSE
		BEGIN
			IF .GLOBREG[.I]<NOTFORML> AND
			.GLOBREG[.I]<PROGVAR> THEN
			BEGIN
				GLOBREG[.I]<ALCFLG>_MATRLZ;
				FLAG_1;
			END;
		END;
	END;
	SAVCODE_MATRLZ;
	IF .FLAG THEN
		STOWONRETURN();

END;	! of FIXENTRY
ROUTINE MAKREGMASK=
BEGIN
	!CONSTRUCT AND RETURN A POINTER TO A REGMASK NODE
	REGISTER BASE T;
	EXTERNAL CORMAN;
	NAME<LEFT>_SRCSIZ;
	T_CORMAN();
	T[OPRCLS]_STATEMENT;
	T[SRCID]_REGMASK;
	.T

END;	!of MAKREGMASK
ROUTINE SKIPMATERIALIZATION(STNODE)=
BEGIN
	!SKIP OVER MATERIALIZATION NODES INSERTED BY THE GLOBAL
	!ALLOCATOR. CALLED BY GETPRELOAD TO PREVENT PRELOADS
	!FROM BEING INSERTED IN FRONT OF MATERIALIZATIONS FROM
	!A PREVIOUS (CONTIGUOUS) GLOBALLY ALLOCATED LOOP.

	MAP BASE STNODE;
	REGISTER BASE RHNODE:TMP;

	!MAY ALSO NEED TO SKIP A REGMASK NODE
	TMP_.STNODE;
	IF .STNODE[SRCID] EQL REGMASK THEN
	BEGIN
		STNODE_.STNODE[SRCLINK];
	END;

	WHILE .STNODE[SRCID] EQL ASGNID AND .STNODE[SRCISN] EQL 0 DO
	BEGIN
		IF .STNODE[A1VALFLG] AND .STNODE[A2VALFLG] THEN
		BEGIN
			RHNODE_.STNODE[RHEXP];
			IF .RHNODE[OPRCLS] EQL REGCONTENTS THEN
			BEGIN
				TMP_.STNODE;
				STNODE_.STNODE[SRCLINK]
			END
			ELSE
				RETURN(.TMP);
		END ELSE
		RETURN(.TMP);
	END;
	.TMP

END;	! of SKIPMATERIALIZATION
ROUTINE GETPRELOAD=
BEGIN
	!FOR CASES 5 AND 6 DETERMINE WHICH VARIABLES NEED
	!PRELOADING AND FIND THE SPOT TO INSERT THE PRELOADS
	!CAUSE THE PRELOADS TO HAPPEN

	EXTERNAL BOTTOM;
	MAP BASE T:BOTTOM:PREVBB;
	EXTERNAL INDVAR,LOCLNK,GBSYREGS;
	MAP BASE LOCLNK;
	REGISTER BASE PRELLOC;		!PRELOAD LOCATION


	!**************************
	!USEFUL MACRO
	!**************************
	!
	!INSERT REGMASKNODE AT PRELLOC

	MACRO INSERTMASK=
	BEGIN
		T_MAKREGMASK();
		T[NEWREGSET]_.GBSYREGS<LEFT>;
		T[SRCLINK]_.PRELLOC[SRCLINK];
		PRELLOC[SRCLINK]_.T;
		PRELLOC_.T;
	END$;

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

	!FIRST DETERMINE WHO NEEDS PRELOADING

	!A VARIABLE DOES NOT NEED TO BE PRELOADED IF:
	!	IT IS ASSIGNED BEFORE ITS INITIAL USE 
	!	DURING REGCONTENTS SUBSTITUTION THIS
	!	INFO HAS BEEN COLLECTEDAND LEFT IT BITS IN
	!	GLOBREG.

	T_.PREVBB;
	!IF THIS JUST RANDOMLY HAPPENS TO BE AN ENTRY
	!MOVE T UP BY 1 STATEMENT
	IF .T[SRCID] EQL ENTRID THEN T_.T[SRCLINK];

	!USE FLAG TO TELL WHETHER OR NOT ANY PRELOADS ARE NECESSARY
	FLAG_0;
	!NOW SET FUNCTION INDICATORS
	DECR I FROM .REGTOALC-1 TO 0 DO
		!FIRST A PASS TO CHECK USED4ASGND AND SET NO PRELOAD
		IF .GLOBREG[.I]<ASGND4USED> THEN 
			GLOBREG[.I]<NOPRELOAD>_1
		ELSE
			GLOBREG[.I]<NOPRELOAD>_0;

	DECR I FROM .REGTOALC-1 TO 0 DO
		IF NOT .GLOBREG[.I]<NOPRELOAD> THEN
		BEGIN
			GLOBREG[.I]<ALCFLG>_PRELOAD;
			FLAG_1;
		END;

	!MAKE THE PROPER REGMASK NODE AND 
	!STICK IT IN FRONT

	!IF PREVBB IS A CONTINUE
	!THEN WE CAN STICK THEM AT PREVBB WITH NO HARM
	!UNLESS THERE IS A REGMASK IMMEDIATELY FOLLOWING
	!(E.G. TWO CONTIGUOUS LOOPS) IN WHICH CASE JUST
	!CHANGE THE REGMASK PATTERN
	T_.PREVBB[SRCLINK];
	IF .T[SRCID] EQL REGMASK THEN PREVBB_.T;

	IF .PREVBB[SRCID] EQL CONTID THEN
	BEGIN
		!IF DO LOOPS END HERE OR NOT WE WILL DO THIS
		!SET PRELOAD LOCATION AND
		!TRANSFORM THIS INTO A REGMASK NODE
		IF .PREVBB[SRCLBL] EQL 0 THEN
		BEGIN
			PRELLOC_.PREVBB;
			PREVBB[SRCID]_REGMASK;
			PREVBB[NEWREGSET]_.GBSYREGS<LEFT>;
		END ELSE
		BEGIN
			!LABELED CONTINUE. MAKE A SEPARATE
			!REGMASK NODE AND PUT IT AFTER THE
			!CONTINUE
			PRELLOC_MAKREGMASK();
			PRELLOC[SRCLINK]_.PREVBB[SRCLINK];
			PREVBB[SRCLINK]_.PRELLOC;
			PRELLOC[NEWREGSET]_.GBSYREGS<LEFT>;
		END;
		!UPDATE PRELLOC SO PRELOADS WILL GO
		!AFTER MATERIALIZATIONS (IF ANY).
		PRELLOC_SKIPMATERIALIZATION(.PRELLOC);
	END ELSE
	IF .PREVBB[SRCID] EQL REGMASK THEN
	BEGIN
		! SET REGMASK
		PREVBB[NEWREGSET]_.GBSYREGS<LEFT>;

		!IF THERE ARE PREVIOUSLY INSERTED MATERIALIZATIONS
		! THEN SET THE PLACE FOR INSERTION OF PRELOADS
		! AFTER THE MATERIALIZATIONS.  IF THERE ARE
		! NO MATERIALIZATIONS TO SKIP, PUT THE PRELOADS
		! DIRECTLY AFTER THE REGMASK.
		! THIS WORKS WITH ONLY ONE TO SKIP
		PRELLOC_SKIPMATERIALIZATION(.PREVBB);
	END
	ELSE
	!IF IT IS A DO LOOP. PUT THE PRELOADS HERE AND CHECK 
	!FOR THE DO INDEX BEING GLOBALLY ALLOCATED
	IF .PREVBB[SRCID] EQL DOID THEN
	BEGIN
		PRELLOC_.PREVBB;
		DECR I FROM .REGTOALC-1 TO 0 DO
			IF .GLOBREG[.I]<RIGHT> EQL .PREVBB[DOSYM] THEN
			BEGIN
				T_.CHOSEN[.I];
				PREVBB[DOIREG]_.T[TARGTAC];
				!INSURE NO PRELOAD
				GLOBREG[.I]<ALCFLG>_AWL;
			END;
		INSERTMASK;
	END
	ELSE
	!IF ITS A CALL DONT GO ANY FURTHER EITHER
	IF (.PREVBB[SRCID] EQL CALLID) OR .PREVBB[USRFNREF]  THEN
	BEGIN
		PRELLOC_.PREVBB;

		!SKIP OVER CALLS IN A SEQUENCE
		!OR STATEMENTS WITH USER FUNCTION REFERENCES.
		!THESE WERE SKIPPED IN RECONTENTS SUBSTITUTION TOO.

		WHILE (.PRELLOC[SRCID] EQL CALLID) OR .PRELLOC[USRFNREF] DO
		BEGIN
			PREVBB_.PRELLOC;
			PRELLOC_.PRELLOC[SRCLINK];
		END;
		PRELLOC_.PREVBB;


		INSERTMASK;
	END ELSE

	!IF ITS A LOGICAL IF WITH A BRANCHING STATMENT AS THE
	!TRUE BRANCH, THEN MAKE IT BE THE PRELOAD LOCATION

![641] IF LOGICAL IF STATEMENT HAS A CALL STATEMENT AS ITS
![641] RESULT, WE WANT TO PASS IT BY FOR PRELOADING TO
![641] PREVENT THE PRELOADED REGISTERS FROM GETTING LOADED AFTER
![641] THE MATERIALIZATIONS THAT THE CALL STATEMENT WOULD GENERATE.
%[641]%	IF .PREVBB[SRCID] EQL IFLID THEN
%[641]%	BEGIN
%[641]%		T_.PREVBB[LIFSTATE];
%[641]%		IF .PREVBB[TRUEISBR] OR (.T[SRCID] EQL CALLID)
%[641]%			THEN (PRELLOC_.PREVBB; INSERTMASK)
	END
	ELSE
	BEGIN
		!LOOK FOR THE STATEMENT INFRONT OF PREVBB
		!MAKE A REGMASK NODE, STICK IT IN AND
		!SET PRELLOC TO IT
		!START LOOKING FOR THE STATEMENT IN FRONT OF PREVBB AT
		!WAYBBB
		PRELLOC_.WAYBBB;
		!DO NOT ADJUST IF WAYBBB AND PREVBB ARE THE
		!SAME. IN THIS CASE THEY ARE THE START OF THE PROGRAM
		IF .WAYBBB EQL .PREVBB THEN
		ELSE
		WHILE .PRELLOC[SRCLINK] NEQ .PREVBB DO
			PRELLOC_.PRELLOC[SRCLINK];

		!ALSO GET RID OF STICKING IT IN FRONT OF THE ENTRY
		WHILE .PRELLOC[SRCID] EQL ENTRID DO
			PRELLOC_.PRELLOC[SRCLINK];
		!ALSO CHECK IF PREVBB IS AN ENTRY
		IF .PREVBB[SRCID] EQL ENTRID THEN
			PRELLOC_.PREVBB;
		!ALSO CHECK FOR A DO LOOP AND SET THE DO REGISTER
		!TO USE THE GLOBAL REGISTER IF IT IS ALLOCATED
		IF .PRELLOC[SRCID] EQL DOID THEN
		BEGIN
			DECR I FROM .REGTOALC-1 TO 0 DO
				IF .GLOBREG[.I]<RIGHT> EQL .PRELLOC[DOSYM] THEN
				BEGIN
					T_.CHOSEN[.I];
					PRELLOC[DOIREG]_.T[TARGTAC];
					!DONT PRELOAD IT
					GLOBREG[.I]<ALCFLG>_AWL;
				END;
		END;

		!NOW MAKE THE REGMASK NODE
		INSERTMASK;

		IF .PREVBB[SRCLBL] NEQ 0 THEN

		!WE MUST BE MORE CAREFUL HERE IN CASE THE PRELOAD HAS BEEN
		! DONE AFTER THE STATEMENT AT PREVBB.  THIS MAY BE THE
		! CASE IF THE PREVIOUS BASIC BLOCK BEGINS THE SUBROUTINE,
		! AND IS LABELED.  IN THIS CASE, THE DANGER IS THAT THE LABEL
		! WOULD BE MOVED DOWN IN THE CODE TO THE PRELOAD LOCATION WHICH
		! IS NOT THE INTENT!
		IF .PREVBB[SRCLINK] NEQ .PRELLOC THEN
		BEGIN
			!IF PREVBB WAS LABELED MOVE THE LABEL TO
			!THE NEW NODE JUST MADE
			PRELLOC[SRCLBL]_T_.PREVBB[SRCLBL];
			T[SNHDR]_.PRELLOC;
			PREVBB[SRCLBL]_0;
		END;
	END;
	SAVCODE_PRELOAD;
	!DO ACTUAL PRELOADS ONLY IF FLAG IS SET
	IF .FLAG THEN
		CALRESTORE(.PRELLOC);
	!ONE MORE THING. IF ALLOCATING A LOOP NEST
	!WE MUST INSERT A REGMASK NODE AT THE END OF
	!THE INNER LOOP TO PREVENT THE LOCAL ALLOCATOR
	!FROM ACCIDENTLY RELEASING THE INNER LOOPS INDEX REG
	IF .GUIDE EQL 6 THEN
	BEGIN
		T_MAKREGMASK();
		T[NEWREGSET]_.GBSYREGS<LEFT>;
		!LINK IT IN AT BOTTOM
		T[SRCLINK]_.BOTTOM[SRCLINK];
		BOTTOM[SRCLINK]_.T;
	END;

END;	! of GETPRELOAD
ROUTINE GETMATERIAL=
BEGIN
	!IN CASES 5 AND 6  SET CODES FOR MATERIALIZATION
	!AND CAUSE THEM TO HAPPEN

	EXTERNAL BASE CSTMNT;

	LABEL L1;


	!USE FLAG TO DETERMINE IF THERE ARE ANY
	FLAG_0;
	DECR I FROM .REGTOALC-1 TO 0 DO
	BEGIN
		IF .GLOBREG[.I]<ALCFLG> EQL PRELOAD THEN
		BEGIN
			!SAVE ANY THAT WERE PRELOADED
			GLOBREG[.I]<ALCFLG>_MATRLZ;
			FLAG_1;
		END ELSE
		BEGIN
			T_.CSTMNT[DOLBL];
			!GET THE LIST OF VARIABLES CHANGED IN THIS
			!LOOP FROM THE LABEL TABLE OF THE TERMINATING
			!LABEL
			T_.T[SNSTATUS];
			L1:
			!NOW WALK THE LINKED LIST AND SAVE ALL CHANGED
			WHILE .T NEQ 0 DO
			BEGIN
				IF .GLOBREG[.I]<RIGHT> EQL .T[LEFTP] THEN
				IF .GLOBREG[.I]<PROGVAR> THEN
				BEGIN
					GLOBREG[.I]<ALCFLG>_MATRLZ;
					FLAG_1;
					LEAVE L1;
				END;
				T_.T[RIGHTP];
			END;

			!IF THIS IS AN INNERLOOP ONLY WE WILL
			!ASSUME THAT WE ARE DOING ONLY IT BECAUSE
			!THERE ARE PARALLEL INNER ONES. THE ASSUMPTION
			!CAN DO NO HARM. WE THEN ALSO NEED TO SAVE
			!ANY .O VARIABLES THAT WERE ASSIGNED
			!BEFORE USED AND ALSO SUBSUMED. UNFORTUNATELY
			!WE DO NOT HAVE THIS LATTER INFO SO WE WILL
			!JUST USE THE FIRST AND NOT BE PERFECTLY
			!OPTIMAL.

			IF .GUIDE GEQ 5 THEN
			BEGIN
				IF .GLOBREG[.I]<NEDSAV> THEN
				BEGIN
					GLOBREG[.I]<ALCFLG>_MATRLZ;
					FLAG_1;
				END;
			END;

		END;	!ELSE PART
	END;	!DECR LOOP
	!NOW DO IT
	SAVCODE_MATRLZ;
	IF .FLAG THEN
		MATERIALIZE();

END;	! of GETMATERIAL
ROUTINE GBLALLOC=
BEGIN
	EXTERNAL CSTMNT,GBSYREGS,INDVAR,GBSYCT;
	MAP BASE INDVAR;
	EXTERNAL EXITNO;
	EXTERNAL UNFLDO,LENTRY;
	EXTERNAL DOVARSUBSTITUTE;


	MAP BASE TOP:BOTTOM:CSTMNT:P;

%2237%	ROUTINE SORTNMAKE =
%2237%	BEGIN
%2237%
%2237%	! This routine determines  which entries of  CHOSEN should  be
%2237%	! allocated to registers and makes regcontents nodes for those
%2237%	! that should.  Upon return REGTOALC contains the exact number
%2237%	! of items allocated.
%2237%
%2237%	LABEL INSERT, SEARCH, MAKNODS;
%2237%
%2237%	! Place the  entries  of  CHOSEN with  the  highest  merit  in
%2237%	! GLOBREG, but don't  let GLOBREG grow  larger than  REGTOALC.
%2237%	! The entries in  GLOBREG will  be sorted by  merit.  This  is
%2237%	! essentially a straight insertion sort.
%2237%
%2237%	IF .REGTOALC GTR 0	! Skip insert code if we're not allocating any
%2237%	THEN
%2237%	BEGIN	! Safe to insert
%2237%
%2237%		REGISTER GLOBIX;	! GLOBREG index where we insert choice
%2237%		REGISTER CURMERIT;	! Merit value of choice to be inserted
%2237%		REGISTER GLOBSZ;	! Current size of GLOBREG
%2237%
%2237%		GLOBSZ = 0;		! GLOBREG is initially empty
%2237%
%2237%		INCR CHOICEI FROM 0 TO 31	! Look at each entry in CHOSEN
%2237%		DO IF .CHOSEN[.CHOICEI] NEQ 0	! Ignore zero entries
%2237%		THEN
%2237%	INSERT:	BEGIN	! Non-zero choice
%2237%
%2237%			! Try to insert  the CHOICEI  entry of  CHOSEN
%2237%			! into GLOBREG.
%2237%
%2237%			CURMERIT = .CHOSEN[.CHOICEI]<LEFT>;	! Save merit
%2237%
%2237%			! Now see if  GLOBREG is full.   If it  isn't,
%2237%			! increase the  size.  Otherwise,  see if  the
%2237%			! current choice has more merit than the  last
%2237%			! entry in GLOBREG (which will have the lowest
%2237%			! merit  of  all  GLOBREG  entries).   If   it
%2237%			! doesn't, simply  leave the  insertion  code.
%2237%			! Otherwise continue  without  increasing  the
%2237%			! size of GLOBREG,  which effectively  deletes
%2237%			! the last entry.
%2237%
%2237%			IF .GLOBSZ NEQ .REGTOALC
%2237%			THEN GLOBSZ = .GLOBSZ+1
%2237%			ELSE IF .CURMERIT LEQ .GLOBREG[.GLOBSZ-1]<LEFT>
%2237%			THEN LEAVE INSERT;
%2237%
%2237%			GLOBIX = .GLOBSZ;	! Initialize place to insert
%2237%
%2237%			! Now search through GLOBREG until we find the
%2237%			! position where the  current choice  belongs,
%2237%			! moving GLOBREG  entries  up along  the  way.
%2237%			! When we leave the  loop, GLOBIX will be  the
%2237%			! offset into GLOBREG where the current choice
%2237%			! should be inserted.
%2237%
%2237%		SEARCH:	WHILE (GLOBIX = .GLOBIX-1) GTR 0
%2237%			DO IF .CURMERIT LEQ .GLOBREG[.GLOBIX-1]<LEFT>
%2237%			THEN LEAVE SEARCH
%2237%			ELSE GLOBREG[.GLOBIX] = .GLOBREG[.GLOBIX-1];
%2237%
%2237%			! GLOBIX is now the  GLOBREG offset where  the
%2237%			! current choice will be inserted.
%2237%
%2237%			GLOBREG[.GLOBIX] = .CHOSEN[.CHOICEI];	! Insert it
%2237%
%2237%		END;	! Non-zero choice
%2237%
%2237%		REGTOALC = .GLOBSZ;	! Reset to number we want to allocate
%2237%
%2237%	END;	! Safe to insert

	!NOW REGTOALC HAS THE NUMBER OF VARIABLES THAT
	!WE WANT TO ALLOCATE. SOME MAY BE DOUBLE AND
	!SO ALL WILL NOT ACTUALLY GET ALLOCATED. MAKE
	!THOSE ADJUSTMENTS AND REGCONTENTS NODES FOR THOSE
	!THAT WILL ACTUALLY BE ALLOCATED.
	!MINWD WILL CONTAIN THE NUMBER OF THE REGISTER TO ALLOCATE
	!EACH TIME. HEAD WILL CONTAIN THE LIMIT NUMBER BEYOND WHICH
	!WE SHALL NOT GO. REGS INCLUDING HEAD MAY BE ALLOCATED.

	!MINWD IS SET PRIOR TO THE CALL TO THIS ROUTINE
	!IF THERE WERE DOUBLE WORD QUANTITIES IN THE LOOP
	!WE MUST MAKE SURE THAT THE LOCAL ALLOCATOR IS LEFT
	!AN EVEN-ODD PAIR.
	IF .GOTEMDBL THEN
		HEAD_#10
	ELSE
		HEAD_#12;
	!NOW WE KNOW WHERE TO START AND WHERE TO STOP.
	!START AT MINWD. STOP AT HEAD.

	MAKNODS:
		INCR I FROM 0 TO .REGTOALC-1 DO
		BEGIN
			PD_0;	!SET FLAG
			GLOBREG[.I]<LEFT>_0;	!ZERO MERIT HALF OF WD
			PA_.GLOBREG[.I];
			!IF ITS A DOUBLE WORD MAKE SURE ITS
			!EVEN
			IF .PA[DBLFLG] THEN
			BEGIN
				IF .MINWD THEN
					MINWD_.MINWD+1;
				!IF ITS STILL LEGIT
				IF .MINWD+1 LSS .HEAD THEN
					!SET FLAG
					PD_1;
			END ELSE	!NOT DBLWORD
				PD_(.MINWD LSS .HEAD);

			!PD NOW SAYS IFS IT OK TO ALLOCATE.
			!MINWD POINTS TO THE REGISTER NUMBER
			IF .PD THEN
			BEGIN
				CHOSEN[.I]_BLDREGCONTENTS(.PA);
				MINWD_.MINWD+1+.PA[DBLFLG];
				!ALSO SET SOME FLAGS IN THE LEFT HALF OF
				!OF THE ASSOCIATED GLOBREG ENTRY THAT
				!RECORD SOME OF THE PROPERTIES OF THE
				!VARIABLE JUST ALLOCATED.

				!IS IT A FORMAL
				IF NOT .PA[FORMLFLG] THEN
					GLOBREG[.I]<NOTFORML>_1;
				!IS IT A PROGRAMMER DEFINED VARIABLE
				IF .PA[IDDOT] NEQ SIXBIT"." THEN
					GLOBREG[.I]<PROGVAR>_1
				ELSE
				!IF ITS A .R DO NOT ALLOCATE THE VARAIBLE
				IF .PA[IDDOTO] EQL SIXBIT".R" THEN
					PA[IDATTRIBUT(NOALLOC)]_1;
			END ELSE
			!NOT LEGIT TO ALLOCATE
			BEGIN
				REGTOALC_.I;
				LEAVE MAKNODS;
			END;
		END;	!INCR LOOP

	!REGTOALC AT LAST CONTAINS THE NUMBER WE ARE (WILL BE AND
	!HAVE BEEN) ALLOCATING.

	!SET ITMCT
	ITMCT_.REGTOALC-1;

	!SET GLOBALS INCASE THIS IS GUIDE 1-4 WILL BE RESET ELSEWHERE IF
	!GUIDE IS 5 OR 6
	GBSYREGS_.CLEANSLATE<0,36>;
	GBSYCT_ONESCOUNT(.GBSYREGS);
	END;	! of SORTNMAKE
	!*************************************************


	!AN OUTLINE OF THE PLAN:
	!THE CALLER OF THIS ROUTINE HAS DETERMINED THE CASE (THERE ARE
	!SIX OF THEM AND SET AN INDICATOR(GUIDE). THE PARAMETERS FOR THE
	!BASIC DETERMINATION (TOP, BOTTOM) WERE ALSO SET. ALL CASES
	!FOLLOW THE SAME PATH THROUGH QUITTING IF WE DONT WANT TO
	!ALLOCATE ANY. THEN:
	!CASE 1:
	!	A MAIN PROGRAM WITH NO LOOPS
	!	----------------------------
	!	SORTNMAKE
	!	SUBSTITUTE
	!	PRELOAD THOSE IN DATA

	!CASE 2:
	!	A MAIN PROGRAM WITH A SINGLE LOOP
	!	---------------------------------
	!	RESET BOUNDS
	!	CASE 1

	!CASE 3:
	!	A SUBPROGRAM WITH NO LOOPS
	!	--------------------------
	!	SORTNMAKE
	!	SUBSTITUTE
	!	FOR EACH ENTRY:
	!		FIX PROLOGUE
	!		PRELOAD
	!		MAKE FORMALS NOT ON ALL LISTS
	!	STOWON RETURN (FORMALS MARKED ABOVE + PROGRAMMER VARS.

	!CASE 4:
	!	A SUBPROGRAM WITH A LOOP
	!	------------------------
	!	RESET BOUNDS
	!	CASE 3

	!CASE 5:
	!	AN INNER LOOP ONLY
	!	------------------
	!	IF LOCAL ALLOC INDEX REMOVE IT FROM LIST IF THERE
	!	SET LOWER BOUND OF ALLOCATION REG NUMBER (MINWD)
	!	SORTNMAKE
	!	IF INDEX ON LIST MAKE IT FIRST
	!	SUBSTITUTE
	!	DETERMINE PRELOADS NEEDED (NOT SET IN PREVBB OR 1ST BB)
	!	PRELOAD
	!	MATERIALIZE ON EXITS

	!CASE 6:
	!	OUTER AND INNER LOOPS
	!	---------------------
	!	IF LOCAL ALLOC INDEX TAKE IT OFF LIST IF THERE
	!	SORTNMAKE
	!	IF INNER LOOP INDEX ON LIST MAKE IT FIRST
	!	IF OUTER LOOP INDEX ON LIST MAKE IT SECOND
	!	SUBSTITUTE
	!	DETERMINE PRELOADS NEEDED
	!	PRELOAD
	!	MATERIALIZE ALL AT EXITS FROM BOTH LOOPS

	!BASIC DETERMINATION OF THE DESIRABILITY OF ALLOCATION.
	!DETERMINE VALUE OF RAISE WHICH DEPENDS ON
	! USE OF THE VARIABLE
	!CALLS CREDIT TO WALK TREES ETC.

	IF .FLGREG<BOUNDS> THEN RETURN;

	HEAD_0;			!INITILIZE FOR EXTRIES INTO CHOSEN

	LIBFNREFNO_FNREFNO_CALLREFNO_0;

	!COMPUTE MERITS FOR VARIABLES IN THE LOOP
	P_.TOP[SRCLINK];

	!PUT THE COMPLEXITY OF THE LOOP ITSELF INTO THE DISTRIBUTION

	MAXCOMPLEX[(IF .TOP[SRCCMPLX] GTR 9 THEN 9
			ELSE .TOP[SRCCMPLX])]_1;

	!ALSO CONSIDER IF THE LOOP ITSELF HAS ANY DOUBLE PRECISION
	!INVOLVED IN ANY OF ITS COMPUTATIONS.

	IF .TOP[PAIRMODEFLG] THEN GOTEMDBL_1;

	!MAKE A SPECIAL CASE IF GUIDE IS 6 (ALLOCATING INNER AND
	!OUTER LOOPS BOTH) TO GIVE
	!THE OUTER INDEX A LITTLE CREDIT. BUT NOT A LOT

	IF .GUIDE EQL 6 THEN
	BEGIN
		RAISE_.MERITVAL[LCTLUSE];
		CREDIT(.CSTMNT[DOSYM]);
	END;

	!SAVE CSTMNT
	OLDCSTMNT_.CSTMNT;
	WHILE .P NEQ .BOTTOM[SRCLINK] DO
	BEGIN
		CSTMNT_.P;
		ASCRIBE(.P);
		P_.P[SRCLINK];
	END;
	!RESTORE CSTMNT
	CSTMNT_.OLDCSTMNT;

	!DO NOT BOTHER WITH ANY VARIABLE THAT IS NOT AT LEAST GOING TO
	!SAVE A MOVE (I.E. HAS AT LEAST THE MERIT OF A SINGLE LHS).

	DECR I FROM .HEAD-1 TO 0 DO
	BEGIN
		IF .CHOSEN[.I]<LEFT> LEQ .MERITVAL[LHSUSE]
		!UNDER NO CIRCUMSTANCES CAN AN ASSOCIATE VAR LIVE
		! IN A REGISTER
		OR ASSOCIA(.CHOSEN[.I]<RIGHT>)
			THEN CHOSEN[.I]_0;
	END;

	!NOW SUBTRACT FNREFNO FROM ALL
	!ADJUST FNREFNO TO INCLUDE CALLS TO

	FNREFNO_.FNREFNO+.CALLREFNO;

	!IF ANY GO NEGATIVE DELETE FROM LIST
	!	ADJUST FNREFNO TO REFLECT THE ACTUAL COST OF THE NUMBER OF
	!	FUNCTION REFERENCES AND CALLS

	FNREFNO_.FNREFNO*.MERITVAL[FUNUSE];

	!ALSO ADJUST LIBFNREFNO
	!BUT LIBRARY FUNCTIONS ARE ONLY HALF OF USER FUNCTIONS
	!BECAUSE THERE IS ONLY THE STORE COST

	LIBFNREFNO_.LIBFNREFNO*(.MERITVAL[FUNUSE]/2);

	INCR K FROM 0 TO .HEAD-1 DO
	BEGIN
		IF .CHOSEN[.K]<LEFT> LSS .FNREFNO THEN	!ITS GOING NEGATIVE
		CHOSEN[.K]_0
		ELSE
		BEGIN
		CHOSEN[.K]<LEFT>_.CHOSEN[.K]<LEFT>-.FNREFNO;
		!IF WE ARE STILL IN THE GAME DEDUCT LIBFNREFNO TOO IF
		!IT APPLIES.

		P_.CHOSEN[.K]<RIGHT>;
![660] HAS THE VARIABLE BEEN FLAGGED AS NOT ABLE TO LIVE IN REGISTER?
%[660]%		IF .P[USRARGUSE] THEN CHOSEN[.K]_0 ELSE
		IF .P[LIBARGUSE] THEN
		BEGIN
			IF .CHOSEN[.K]<LEFT> LSS .LIBFNREFNO THEN
				CHOSEN[.K]_0
			ELSE
				CHOSEN[.K]<LEFT>_.CHOSEN[.K]<LEFT>-.LIBFNREFNO;
		END;
		END;

	END;
	!CONSIDER ACTUAL COMPLEXITY OF EXPRESSIONS INVOLVED
	!
	MELDPLEX();
	CLEANUP();

	!END OF DETERMINATION OF BASIC DESIRABILITY SECTION. THIS IS PERFORMED
	!IN ALL CASES.
	CLEANSLATE_.GBSYREGS;


	!DONT BOTHER WITH THE PROCESS, IF WE ARE NOT GOING TO ALLOCATE ANY
	IF .REGTOALC LEQ 0 THEN
	RETURN;
	!NOW WE WILL REALLY ALLOCATE SOMETHING.
	!SET THE CONTROL FIELD ON ALL ALLOCATED VARIABLES TO
	!AWL.

	DECR I FROM .REGTOALC-1 TO 0 DO
		GLOBREG[.I]<ALCFLGS>_AWL;


	!NOW WALK TREE AND PUT IN ALLOCATIONS
	SPECCASE_1;		!FLAG FOR LEAFSUBSTITUTE
	MINWD_2;

	!ZERO LENTRY
	LENTRY_0;

	!NOW DEPENDING ON THE VALUE OF GUIDE FOLLOW THE PLAN OUTLINED
	!ABOVE

	CASE .GUIDE OF SET

	BEGIN END;		!ZERO IS ILLEGAL

	!CASE 1 MAIN PROGRAM WITH NO LOOPS
	BEGIN
		SORTNMAKE();
		EASY1;
	END;

	!CASE 2  MAIN PROGRAM SINGLE LOOP
	BEGIN
		!TAKE INDUCTION VARIABLE FROM LIST IF LOCALLY ALLOCATED
		REMOVINDVAR;
		!UNDO THE AOBJN ENDING IF NEDSMATRLZ WAS SET BY P2S
		!ALSO RESET NEDSMATRLZ AND MATRLZIXONLY
		CHKGIX;
		IF (.TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY]) AND .TOP[IXGALLOCFLG]  THEN
		BEGIN
			PLUSUNFLDO(.TOP);
			TOP[NEDSMATRLZ]_0;
			TOP[MATRLZIXONLY]_0;
			IF .CALLREFNO NEQ 0 THEN TOP[MATRLZCTLONLY]_1;
		END;
		!RESET BOUNDS
		MINWD_LOWERBD(.TOP);
		IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;


		!SET BOTTOM UP TO THE END STATEMENT

		BOTTOM_.SORCPTR<RIGHT>;
		SORTNMAKE();
		SETDOIREG;
		!ALSO EXPAND THE SCOPE FOR THE SUBSTITUTION. UNFUDGDO
		!HAS ADJUSTED SORCPTR LEFT TO POINT TO THE PSEUDO
		!DO LOOP NODE. UNFUDGDO IS IN PHA2.
		TOP_.SORCPTR<LEFT>;

		EASY1;
	END;

	!CASE 3  SUBPROGRAM WITH NO LOOPS
	BEGIN
		SORTNMAKE();
		STARTSUB_.TOP;
		STOPSUB_.BOTTOM;
		REGSUBDRIVER();
		FIXENTRY();
	END;

	!CASE 4  SUBPROGRAM WITH A SINGLE LOOP
	BEGIN
		!SEE COMMENT IN CASE 2
		!TAKE LOCALLY ALLOCATED INDUCTION VARIABLE OFF LIST
		REMOVINDVAR;
		CHKGIX;
		!DONT AOBJN IT NOR MATERIALIZE THE INDEX
		IF (.TOP[NEDSMATRLZ] OR .TOP[MATRLZIXONLY]) AND .TOP[IXGALLOCFLG]  THEN
		BEGIN
			PLUSUNFLDO(.TOP);
			TOP[NEDSMATRLZ]_0;
			TOP[MATRLZIXONLY]_0;
			IF .CALLREFNO NEQ 0 THEN TOP[MATRLZCTLONLY]_1;
		END;
		TOP_.SORCPTR<LEFT>;
		MINWD_LOWERBD(.TOP);
		IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;


		BOTTOM_.TOP[DOLBL];
		BOTTOM_.BOTTOM[SNHDR];
		!SORT, MAKE REGCONTENTS NODES AND SUBSTITUE THEM
		SORTNMAKE();
		STARTSUB_.TOP;
		STOPSUB_.BOTTOM;
		REGSUBDRIVER();
		!SET REG FIELD IN DO NODE IF GLOBALLY ALLOCATED
		SETDOIREG;
		FIXENTRY();
	END;
	!CASE 5  INNER LOOP ONLY
	BEGIN
		!TAKE THE INDEX OFF THE LIST IF IT WAS LOCALLY
		!ALLOCATED
		REMOVINDVAR;
		!SET MINWD
		MINWD_LOWERBD(.TOP);

		IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
		!SORT THE LIST, MAKE REGCONTENTS NODES
		SORTNMAKE();

		!PREVENT ANY FALSE COMPARES
		SECIDX_-1;

		!MAKE THE INDEX VARIABLE FIRST ON THE LIST OF IT IS
		!NOW ON THE LIST AT ALL
		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
			BEGIN
				SWAPG(.TOP,.I,0);
				TOP[IXGALLOCFLG]_1;
				!IF ITS AOBJN AND THERE ARE CALLS
				!MAKE IT NOT AOBJN AND SAVE THE CONTROL
				!WORD ONLY
				IF .TOP[FLCWD] AND .CALLREFNO NEQ 0 THEN
				BEGIN
					PLUSUNFLDO(.TOP);
					TOP[MATRLZCTLONLY]_1;
				END;
				!ALSO SET NOPRELOAD FLAG
				GLOBREG[0]<NOPRELOAD>_1;
			END;
		END;

		!SET THE FIELD OF THE DO LOOP NODE THAT TELLS IT
		!WHICH REGISTER TO USE FOR THE INDEX

		SETDOIREG;

		!SET STARTSUB AND STOPSUB AND DO SUBSTITUTION
		T_.TOP[DOLBL];
		WAYBBB_.T[SN1STLAB];
		PREVBB_STARTSUB_.T[SNNXTLAB];

		!DO NOT ALLOW THE BASIC BLOCK TO BEGIN WITH A
		! LOGICAL IF STATEMENT.  THIS PREVENTS FUTURE PRELOADS
		! OF REGISTERS FROM HAPPENING IN FRONT OF AN IF STATEMENT
		! WHICH MIGHT MEAN POOR CODE.  STEP THE STARTSUB TO THE
		! NEXT STATEMENT INSTEAD.
		IF .STARTSUB[SRCID] EQL IFLID
		THEN STARTSUB_.STARTSUB[SRCLINK];
		STOPSUB_.BOTTOM;

		REGSUBDRIVER();

		!COLLECT AND CAUSE PRELOADS TO HAPPEN
		GETPRELOAD();

		!COLLECT AND CAUSE MATERILIZATIONS TO HAPPEN
		GETMATERIAL();
		!MAKE A REGMASK NODE
		!TO INDICATE END OF SCOPE OF MODIFIED GBSYREGS
		CSTMNT_MAKREGMASK();
		CSTMNT[NEWREGSET]_#177760;
		CSTMNT[SRCLINK]_.BOTTOM[SRCLINK];
		BOTTOM[SRCLINK]_.CSTMNT;
	END;

	!CASE 6 INNER AND OUTER LOOP
	BEGIN
		EXTERNAL CSTMNT; MAP BASE CSTMNT;

		!A SYNOPSIS OF THE CAST
		!TOP- POINTS TO INNER LOOP
		!CSTMNT-POINTS TO OUTER LOOP
		!BOTTOM-POINTS TO END OF INNER LOOP
		!INDVAR-POINTS TO INNER LOOP INDEX VARIABLE

		!TAKE LOCALLY ALLOCATED INDEX FROM LIST
		REMOVINDVAR;

		!UNDO THE AOBJN PART OF THE OUTER LOOP
		!WE CANNOT DO THE ANALYSIS TO PERMIT IT TO STAY
		!AS AN AOBJN. ALSO SETTING THE IMMEDIATE FLAG WOULD
		!BE A DRAG.
		IF .CSTMNT[FLCWD] THEN
			PLUSUNFLDO(.CSTMNT);

		!SET MINWD
		MINWD_LOWERBD(.TOP);

		IF .MINWD NEQ 2 THEN TOP[IXGALLOCFLG]_1;
		!SORT AND MAKE REGCONTENTS NODES
		SORTNMAKE();

		!ESTABLISH SECIDX AS POINTER TO OUTER LOOP INDEX
		SECIDX_.CSTMNT[DOSYM];

		!GET INDEX VARIABLES INTO TOP SPOTS IN GLOBREG
		!IF THEY ARE THER AT ALL

		DECR I FROM .REGTOALC-1 TO 0 DO
		BEGIN
			IF .GLOBREG[.I]<RIGHT> EQL .INDVAR THEN
			BEGIN
				SWAPG(.TOP,.I,0);
				TOP[IXGALLOCFLG]_1;
				IF .CALLREFNO NEQ 0 THEN 
					TOP[MATRLZCTLONLY]_1;
			END
			ELSE
			IF .GLOBREG[.I]<RIGHT> EQL .SECIDX THEN
			BEGIN
					!WE HAVE TO CHECK TO SEE IF THIS
					!IS THE ONLY ONE
					IF .REGTOALC NEQ 1 THEN
					SWAPG(.CSTMNT,.I,1);
					CSTMNT[IXGALLOCFLG]_1;
					CSTMNT[NEDSMATRLZ]_0;
					CSTMNT[MATRLZIXONLY]_0;
					CSTMNT[MATRLZCTLONLY]_1;

					!ALSO SET FIELD IN DO STATEMENT
					!NODE (CSTMNT)
					!THE SWAP HAS ALREADY OCCURRED
					T_.CHOSEN[(QQ_(IF .REGTOALC EQL 1 THEN 0 ELSE 1))];
					CSTMNT[DOIREG]_.T[TARGTAC];
					!SAVE THE CONTOL WORD IF THERE WERE
					!CALLS
					IF .CALLREFNO NEQ 0 THEN
						CSTMNT[MATRLZCTLONLY]_1;
					!ALSO SET NO PRELOAD
					GLOBREG[.QQ]<NOPRELOAD>_1;
			END;
		END;

		!SET THE REGISTER FOR THE DO LOOP INDEX
		SETDOIREG;

		!SET UP PARAMETERS FOR SUBSTITUTION
		T_.CSTMNT[DOLBL];
		WAYBBB_.T[SN1STLAB];
		PREVBB_STARTSUB_.T[SNNXTLAB];
		STOPSUB_.T[SNHDR];

		LENTRY_.CSTMNT[DOPRED];

		!DO NOT ALLOW A LOGICAL IF STATEMENT TO BEGIN THE
		! BASIC BLOCK WHICH PRECEDES THE SET OF NESTED LOOPS
		IF .STARTSUB[SRCID] EQL IFLID THEN STARTSUB_.STARTSUB[SRCLINK];
		REGSUBDRIVER();

		!NOW PRELOAD AS CASE 5
		GETPRELOAD();

		!AND MATERIALIZE AT OUTSIDE OF OUTER LOOP
		TOP_.CSTMNT;
		BOTTOM_.STOPSUB;
		GETMATERIAL();

		!MAKE REGMASK NODE TO RESET GBSYREGS
		CSTMNT_MAKREGMASK();
		CSTMNT[SRCLINK]_.BOTTOM[SRCLINK];
		BOTTOM[SRCLINK]_.CSTMNT;
		CSTMNT[NEWREGSET]_#177760;
	END;

	TES;


END;	! of GBLALLOC
ROUTINE BLDREGCONTENTS(VAR)=
BEGIN
	EXTERNAL CLOBBREGS;
	REGISTER BASE T;
	MAP BASE VAR:QQ;
	!NEED TO COPY VALTYPE STUFF ETC. FROM SYMBOLTABLE
	QQ_MAKPR1(0,REGCONTENTS,0, .VAR[VALTYPE],0, .VAR);
	QQ[TARGTAC]_QQ[TARGADDR]_.MINWD;
	QQ[INREGFLG]_1;

	!RESET BITS IN CLEASLATE IT SAY REGS ARE USED.
	!SET BITS IN CLOBBREGS TO SAY BITS ARE USED.

	CLEANSLATE_CLRBIT(.CLEANSLATE,.MINWD);
	CLOBBREGS_SETBIT(.CLOBBREGS,.MINWD);
	!IF DOUBLE PRECISION DO IT FOR MIN+1 ALSO
	IF .VAR[DBLFLG] THEN
	BEGIN
		CLEANSLATE_CLRBIT(.CLEANSLATE,.MINWD+1);
		CLOBBREGS_SETBIT(.CLOBBREGS,.MINWD+1);
	END;

	.QQ

END;	! of BLDREGCONTENTS
ROUTINE GOTOFORCELOAD=
BEGIN

%ROUTINE TO FORCE PRELOADING OF VARIABLES NOT DEFINED WHEN A BRANCH
 STATEMENT IS ENCOUNTERED%

	DECR I FROM .REGTOALC-1 TO 0 DO
	!NO NEED TO PRELOAD COMPILER VARIABLES JUST ON THE BASIS OF
	!A GOTO, SINCE THE GOTO WAS ALREADY CONSIDERED WHEN PLACING
	!USES AND ASSIGNMENTS OF COMPILER VARIABLES (.O & .R)
	IF .GLOBREG[.I]<PROGVAR> THEN	!IF NOT A COMPILER VARIABLE
		IF NOT .GLOBREG[.I]<ASGND4USED> THEN
			GLOBREG[.I]<USED4ASGND>_1;

END;	! of GOTOFORCELOAD

EXTERNAL LEAFSUBSTITUTE,IOSUBSTITUTE;
ROUTINE LEAFLOOKER(P)=
BEGIN
	!***************************************************************
	! Walks down expression nodes under a statement to perform  leaf
	! substitution for  any  references  within  the  expression  to
	! GLOBREG (a  vector)  with  the corresponding  element  in  the
	! vector CHOSEN.  Also used  to substitute the REGCONTENTS  node
	! for the DO induction variable on innermost DO loops.
	!
	! P   - points to the statement.
	!***************************************************************

	EXTERNAL CSTMNT,MISCIO,DOVARSUBSTITUTE,SWAPEM,LOWLIM;
%1742%	EXTERNAL MISCOCI;
	LOCAL BASE TMP;
	MAP PEXPRNODE P:TOP;
![776] Make CLOGIF a module OWN so REGSUBDRIVER can intialize it

%[776]%	LOWLIM = 0;

	! Look for common sub-expressions that  may be there from  local
	! elimination on statements that  do not postdominate the  entry
	! of their loop.

	IF (TMP = .P[SRCCOMNSUB]) NEQ 0
	THEN DO
	BEGIN
		IF .TMP[A2VALFLG]
		THEN
		BEGIN
			DECR I FROM .ITMCT TO 0 DO
			BEGIN
				IF .TMP[ARG2PTR] EQL .GLOBREG[.I]<RIGHT>
				THEN
				BEGIN
					TMP[ARG2PTR] = .CHOSEN[.I];

			! DON'T FORGET TO SET ASGND4USED HERE TO CAUSE
			! PRELOADING OF REGCONTENTS NODE IF APPROPRIATE.
			! WITHOUT THIS, A STATEMENT LIKE:
			! A(K)=B(K)  WHICH PRECEDES A DO LOOP WITH AN
			! ASSIGNMENT TO K MAY GET BAD CODE GENERATED FOR IT.
			! IN FACT NO PRELOAD OF K WOULD HAPPEN, SO THAT THE
			! ASSIGNMENT WOULD LOOK FOR K IN A REGISTER WHICH
			! HAD NOT BEEN PRELOADED (INITIALIZED).

					IF NOT .GLOBREG[.I]<ASGND4USED>
					THEN GLOBREG[.I]<USED4ASGND> = 1;

					! SET THE IMMED FLAG IF IT IS AN
					! AOBJN GUY.

					IF .TOP[FLCWD] AND
					.GLOBREG[.I]<RIGHT> EQL .TOP[DOSYM]
					THEN TMP[A2IMMEDFLG] = 1;
				END;
			END;
		END
		ELSE LEAFSUBSTITUTE(.TMP[ARG2PTR]);

	END UNTIL (TMP = .TMP[CLINK]) EQL 0;

	CASE .P[SRCID] OF SET

	BEGIN		! Assignment
		TMP = .P[RHEXP];

		IF .TMP[OPRCLS] EQL REGCONTENTS AND .NOINDVARFLG
		THEN RETURN;

		LEAFSUBSTITUTE(.P[RHEXP]);
		LEAFSUBSTITUTE(.P[LHEXP]);

		! RESET BB FLAG. CODE MAY NOT BE IDEAL BUT WILL ALWAYS BE RIGHT
		FRSTBB = 0;
	END;		! Assignment

	LEAFSUBSTITUTE(.P[ASISYM]);	! ASSIGN

	BEGIN		! CALL
		! IF NOT  PREVIOUSLY SAVED  OR NOT  IN THE  FIRST  BASIC
		! BLOCK, SAVE EVERYBODY
		IF NOT .SAVEDFLG AND NOT .FRSTBB
		THEN
		BEGIN
			CALLSAVE(.LASTAT);
			SAVEDFLG = 1;
		END;

		IF .P[CALLIST] NEQ 0
		THEN
		BEGIN
			LOCAL ARGUMENTLIST ARGL;
			ARGL = .P[CALLIST];
			INCR I FROM 1 TO .ARGL[ARGCOUNT] DO
			BEGIN
				TMP = .ARGL[.I,ARGNPTR];
				IF .TMP[OPRCLS] NEQ LABOP AND .TMP[OPRCLS] NEQ DATAOPR
				THEN LEAFSUBSTITUTE(.ARGL[.I,ARGNPTR]);
			END;
		END;

		! ONLY RESTORE IF THE NEXT  STATEMENT WOULD NOT CAUSE  A
		! SAVE AGAIN RIGHT AWAY SET  TMP TO THE NEXT  STATEMENT.
		! IF THIS CALL  WAS THE  TRUE BRANCH OF  THE LOGICAL  IF
		! MAKE IT THE NEXT STATEMENT

		TMP = (IF .P[SRCLINK] NEQ 0
			THEN .P[SRCLINK]
			ELSE IF .CLOGIF NEQ 0
			THEN .CLOGIF[SRCLINK]);

		! SET CALLSEEN IF TWO CALLS IN A ROW (OR THE LIKE)  THIS
		! WILL TRIGGER THE SKIPPING OF ALL CALLS AFTER THE FIRST
		! BACK IN REGSUBDRIVER

		IF .TMP[USRFNREF] OR .TMP[SRCID] EQL CALLID
		THEN CALLSEEN = 1
		ELSE CALRESTORE(IF .P[SRCLINK] NEQ 0
				THEN .P
				ELSE .THISTAT);

		FRSTBB = 0;
	END;		! CALL

	BEGIN END;	! CONTINUE

	BEGIN		! DO
		!CHECK TO MAKE SURE WE SHOULD HAVE ONE
		IF .GUIDE GEQ 5
		THEN DOVARSUBSTITUTE(.P);

		FRSTBB = 0;
	END;		! DO

	FRSTBB = 0;	! ENTRY
	BEGIN END;	! COMMONSUB
	GOTOFORCELOAD();	! GOTO - FORCE PRELOADING

	BEGIN		! ASSIGNED GOTO
		GOTOFORCELOAD();
		LEAFSUBSTITUTE(.P[AGOTOLBL]);
	END;		! ASSIGNED GOTO

	BEGIN		! COMPUTED GOTO
		GOTOFORCELOAD();
		LEAFSUBSTITUTE(.P[CGOTOLBL]);
	END;		! COMPUTED GOTO

	BEGIN		! ARITHMETIC IF
		GOTOFORCELOAD();
		LEAFSUBSTITUTE(.P[AIFEXPR]);
	END;		! ARITHMETIC IF

	BEGIN		! LOGICAL IF
		LEAFSUBSTITUTE(.P[LIFEXPR]);
		!FUDGE CSTMNT TO POINT TO THE OTHER STATEMENT
		CLOGIF = TMP = .CSTMNT;
		CSTMNT = .P[LIFSTATE];
%[634]%		!REMEMBER WHICH GLOBREG'S HAVEN'T YET BEEN SEEN
%[634]%		DECR I FROM .REGTOALC-1 TO 0
%[634]%		DO
%[634]%		BEGIN
%[634]%			IF 	NOT .GLOBREG[.I]<ASGND4USED>
%[634]%			    AND NOT .GLOBREG[.I]<USED4ASGND>
%[634]%			THEN
%[634]%				GLOBREG[.I]<NOTYETSEEN> = TRUE
%[634]%			ELSE
%[634]%				GLOBREG[.I]<NOTYETSEEN> = FALSE
%[634]%		END;
%[634]%		!PROCESS THE OBJECT STATEMENT
		LEAFLOOKER(.P[LIFSTATE]);
%[634]%		!NOW: IF LEAFLOOKER SAW ANY ASSIGNMENTS, WE NEED TO
%[634]%		!CHANGE THEM TO REFERENCES, SINCE THEY MIGHT NOT GET
%[634]%		!EXECUTED.  THEREFORE, SEE IF ANY GLOBREG'S HAVE
%[634]%		!ASGND4USED SET NOW THAT DIDN'T BEFORE.
%[634]%		DECR I FROM .REGTOALC-1 TO 0
%[634]%		DO
%[634]%		BEGIN
%[634]%			IF .GLOBREG[.I]<NOTYETSEEN>
%[634]%			THEN
%[634]%			BEGIN
%[634]%				GLOBREG[.I]<NOTYETSEEN> = FALSE;
%[634]%				IF .GLOBREG[.I]<ASGND4USED>
%[634]%				THEN
%[634]%				BEGIN
%[634]%					GLOBREG[.I]<ASGND4USED> = FALSE;
%[634]%					GLOBREG[.I]<USED4ASGND> = TRUE
%[634]%				END
%[634]%			END
%[634]%		END;
		CSTMNT = .TMP;
%[776]%		CLOGIF = 0;	!Done with logical IF node
	END;		! LOGICAL IF

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

	BEGIN END;	! STOP

	BEGIN		! READ
		FRSTBB = 0;
%1742%		MISCIO(.P);
	END;		! READ

	BEGIN		! WRITE
%1742%		MISCIO(.P);
	END;		! WRITE

	BEGIN		! DECODE
		FRSTBB = 0;
%1742%		MISCIO(.P);
	END;		! DECODE

	BEGIN		! ENCODE
		FRSTBB = 0;
%1742%		MISCIO(.P);
	END;		! ENCODE

	BEGIN		! REREAD
		FRSTBB = 0;
%1742%		MISCIO(.P);
	END;		! REREAD

%1742%	MISCIO(.P);	! FIND
%1742%	MISCOCI(.P);	! CLOSE
%4502%	MISCIO(.P);	! DELETE
%4503%	MISCIO(.P);	! REWRITE
%1742%	MISCIO(.P);	! BACKSPACE
%1742%	MISCIO(.P);	! BACKFILE
%1742%	MISCIO(.P);	! REWIND
%1742%	MISCIO(.P);	! SKIPFILE
%1742%	MISCIO(.P);	! SKIPRECORD
%1742%	MISCIO(.P);	! UNLOAD
%4504%	MISCIO(.P);	! UNLOCK
%1742%	MISCIO(.P);	! ENDFILE

%[740]%	BEGIN END;	! END
%[740]%	BEGIN END;	! PAUSE
%1742%	MISCOCI(.P);	! OPEN
	BEGIN END;	! SFN
	BEGIN END;	! FORMAT
	BEGIN END;	! BLT
	BEGIN END;	! REGMASK - change set of available registers -
			!  inserted by global register allocator
%2211%	MISCOCI(.P);	! INQUIRE

	TES;

	! Reset first basic block flag if statement is labeled
	IF .P[SRCLBL] NEQ 0 THEN FRSTBB = 0;

END;	! of LEAFLOOKER
ROUTINE CALLSAVE(HOOK)=
!MATERIALIZE EVERYTHING IN A REGISTER BEFORE A CALL OR FUNCTION REFERENCE
BEGIN
	MAP BASE PREV;

		!MAKSTASH WILL MAKE THE CORRECT SET OF
		!ASSIGNMENTS AND WILL LINK THEM TO
		!ITS PARAMETER. WE MUST LINK THIS SET OF
		!ASSIGNMENTS TO THE INITIAL VALUE OF HOOK[SRCLINK]
		!MAKSTASH RETURNS A POINTER TO THE LAST STATEMENT
		!IT CREATED.

		MAP BASE HOOK;
		LOCAL T;

		T_.HOOK[SRCLINK];
		HOOK_MAKSTASH(.HOOK);
		HOOK[SRCLINK]_.T;

END;	! of CALLSAVE
ROUTINE CALRESTORE(HOOK)=
BEGIN
	MAP BASE HOOK:PREV:QQ;
	LABEL LOADEM;
	EXTERNAL MAKASGN;
	!PUT VALUES BACK INTO REGISTERS AFTER A FUNCTION CALL OR REFERENCE
	PREV_.HOOK;
	!SAVE THE LINK ON THIS ONE TO LINK UP THE END
	PD_.HOOK[SRCLINK];

	INCR I FROM 0 TO .REGTOALC-1 DO
	LOADEM:
	BEGIN
		IF NOT CODEMATCH(.GLOBREG[.I]) THEN LEAVE LOADEM;
		QQ_MAKASGN(.CHOSEN[.I],.GLOBREG[.I]);
		PREV[SRCLINK]_.QQ;	!LINK UP

		!SET FLAGS AND FIELDS NECESSRY FOR CG
		QQ[A1SAMEFLG]_1;
		QQ[SRCCMPLX]_1;
		T_.CHOSEN[.I];
		QQ[ASMNTREG]_.T[TARGTAC];
		PREV_.QQ;
	END;
	PREV[SRCLINK]_.PD;

END;	! of CALRESTORE
ROUTINE LABLLOK(STMT,LABLE,MATLAB)=

BEGIN
	!LOOK AT LABEL LISTS FOR LABEL.
	!REPLACE IN WITH MATLAB.

	MAP PEXPRNODE STMT;

	!IF THERE IS AN ASSIGNED GO TO WITHOUT ANY ASSIGNS
	!WE COULD STILL BE HERE.  SO WE HAVE TO CHECK FOR
	!THE ABSENCE OF A LIST.
	!A COMPUTES GO TO SHOULD NEVER HAVE GOTOLIST 0
	IF .STMT[GOTONUM] EQL 0 THEN
	BEGIN
		IF .STMT[GOTOLBL] EQL .LABLE THEN
		BEGIN
			STMT[GOTOLBL]_.MATLAB;
			!MAKE THE STATEMENT A STRAIGHT GO TO 
			STMT[SRCID]_GOTOID;
		END;
	END ELSE
	DECR I FROM .STMT[GOTONUM]-1 TO 0 DO

	IF @(.STMT[GOTOLIST]+.I) EQL .LABLE THEN
	BEGIN
		PC_.STMT[GOTOLIST]+.I;
		PC[CESLNK]_.MATLAB;
	END;

END;	!of LABLLOK
ROUTINE MAKRETU(HOOK)=
BEGIN
	!HOOK POINTS TO THE PLACE WE WILL BUILD A RETURN STATEMENT
	!WE WILL RETURNA POINTER TO THE RETURN STATEMENT MADE

	MAP BASE P:HOOK;

	NAME<LEFT>_SRCSIZ+RETUSIZ;
	P_CORMAN();
	P[OPRCLS]_STATEMENT;
	P[SRCID]_RETUID;

	P[SRCLINK]_.HOOK[SRCLINK];
	HOOK[SRCLINK]_.P;
	.P

END;	! of MAKRETU
ROUTINE MAKSTASH(HOOK)=
BEGIN
	!MAKE AND LINK ALL THE ASSIGNMENT STATEMENTS FOR
	!A MATERIALIZATION
	!HOOK IS SET TO THE PLACE TO LINK THE FIRST ONE.
	!MAKSTASH RETURNS A POINTER TO THE LAST ONE MADE

	!ALSO SET LOCLNK TO THE FIRST ASSIGNMENT MADE
	EXTERNAL TOP,INDVAR,LOCLNK,MAKASGN;
	MAP BASE P:TOP:HOOK:LOCLNK;
	LABEL SAVEM;

	LOCLNK_.HOOK;
	PREV_.HOOK;
	DECR K FROM .REGTOALC-1 TO 0 DO
	SAVEM:
	BEGIN

		IF .GLOBREG[.K]<ALCFLG> NEQ .SAVCODE THEN LEAVE SAVEM;
		P_MAKASGN(.GLOBREG[.K],.CHOSEN[.K]);
			!SPECIAL CHECK TO SET FLAGS
			IF .GLOBREG[.K] EQL .INDVAR THEN
				IF .TOP[FLCWD] THEN
					P[A2IMMEDFLG]_1;
		!COMPLETE HOOKUP. MAY BE ALTERED OUTSIDE
		P[SRCLINK]_.HOOK[SRCLINK];
		HOOK[SRCLINK]_.P;
		HOOK_.P;
	END;	!END OF DECR LOOP ON REGTOALC
	!MAKE LOCLNK POINT TO THE FIRST STATEMENT INSERTED
	IF .HOOK NEQ .LOCLNK THEN LOCLNK_.LOCLNK[SRCLINK];
	.HOOK

END;	! of MAKSTASH
%(	This routine removed in edit 2270
ROUTINE NAMESET=
BEGIN
	EXTERNAL NAMLPTR;
	MAP BASE QQ;
	!ONE SMALL CHORE. GO THROUGH ANY NAMELISTS AND SET THE
	!BIT IN THE SYMBOL FOR VARIBALES IN THE NAMELIST

	QQ_.NAMLPTR<LEFT>;
	WHILE .QQ NEQ 0 DO
	BEGIN
		INCR I FROM 0 TO .QQ[NAMCNT]-1 DO
		BEGIN
			REGISTER BASE T1;
			T1_@(.QQ[NAMLIST]+.I);
			T1[IDATTRIBUT(INNAM)]_1;
		END;
		QQ_.QQ[CLINK];
	END;

END;	! of NAMESET
)%
ROUTINE STOWONRETURN=
BEGIN
	!LOOK FOR ALL RETURN STATEMENTS AND STORE ALLOCATED
	!VARIABLES AWAY.

	!MACRO TO TRANSFORM ITS PARAMETER INTO A GO TO STATEMENT.
	!PARAMETER MUST BE MAPPED TO BASE AND BE A RETURN. NOTE THAT
	!THIS WILL NOT WORK IF THE SIZE (RELATIVE) OF THE NODES
	!CHANGES.

	MACRO MAKAGO(NOD,LABLE)=
	BEGIN
		NOD[SRCID]_GOTOID;
		NOD[GOTOLBL]_.LABLE;
	END$;

	LABEL WHLPREV;
	OWN BASE RETSPOT;
	EXTERNAL BASE LOCLNK;
	EXTERNAL GENLAB;
	MAP BASE BOTTOM:PD:TOP;
	LOCAL BASE STMT;
	MAP BASE PREV:HEAD:PA:QQ;


	!BOTTOM SHOULD POINT TO THE STATEMENT BEFORE THE END
	!IF IT DOES NOT MAKE IT DO SO
	UNTIL .BOTTOM[SRCLINK]  EQL .SORCPTR<RIGHT> DO
		BOTTOM_.BOTTOM[SRCLINK];
	!IF IT IS NOT AN ABSOLUTE BRANCH INSERT A RETURN.
	IF .BOTTOM[SRCID] EQL GOTOID OR
	   .BOTTOM[SRCID] EQL STOPID OR
	   .BOTTOM[SRCID] EQL RETUID THEN
		LOCLNK_.BOTTOM
	ELSE
	BEGIN
		LOCLNK_MAKRETU(.BOTTOM);
		LOCLNK[SRCLINK]_.SORCPTR<RIGHT>;
	END;

	RETSPOT_0;	!NO RETURN STORES MADE.
	STMT_.SORCPTR<LEFT>;
	WHILE .STMT NEQ 0 DO
	BEGIN
		HEAD_.STMT;
		PREV_.STMT;
		WHLPREV:
		WHILE 1 DO
		BEGIN
			!SPECIFICALLY QUIT IF A RETURN OR BOTTOM
			IF .PREV[SRCID] EQL ENDID THEN RETURN;
			IF .PREV[SRCID] EQL RETUID THEN LEAVE WHLPREV;
			!THOSE LOGICAL IFS, ONCE AGAIN,
			!CAUSE A SPECIAL SIDE TRIP.
			IF .PREV[SRCID] EQL IFLID THEN
			BEGIN
				PA_.PREV[LIFSTATE];
				!LOOK TO SEE IF TRUE BRANCH IS A RETURN
				IF .PA[SRCID] EQL RETUID THEN
				BEGIN
					!IF WE ALREADY HAVE A SET OF
					!RETURN MATERIALIZATIONS THEY ARE
					!LABELED BY RETSPOT (NON-ZERO)
					!IF THIS IS A RETURN(I) MAKE A
					!SEPARATE ONE TOO
					IF .RETSPOT NEQ 0 AND .PA[RETEXPR] EQL 0  THEN
						MAKAGO(PA,RETSPOT)
					ELSE
					BEGIN
						!MAKE A SET OF MATERIALIZATIONS
						!THROW THEM IN AT THE END
						!SAVE OUR PLACE
						PD_.PREV;
						PREV_MAKSTASH(.LOCLNK);
						!PREV POINTS TO LAST ONE
						!OF ASSIGNMENTS NOW
						!MAKE A RETURN HERE TOO
						PREV_MAKRETU(.PREV);
						!PREV NOW POINTS TO THAT
						!RETURN.
						!SET A FLAG SO WE KNOW WE
						!MADE IT. THIS IS NEEDED
						!SO THAT WHEN IT IS ENCOUNTERED
						!LATER WE DO NOT MAKE AN
						!INFINITE LOOP
						PREV[A2NOTFLG]_1;
						!LABEL THE FIRST SAVE
						QQ_LABFRST;
						!SEE IF THIS A RETURN (I)
						IF .PA[RETEXPR] NEQ 0 THEN
						BEGIN
							PREV[RETEXPR]_.PA[RETEXPR];
							PA[RETEXPR]_0;
						END ELSE
						RETSPOT_.QQ;
						!NOTE THAT
						!THIS TRUE BRANCH
						!CAN NEVER BE LABELED
						!RESET LOCLNK
						LOCLNK_.PREV;
						!RESET PREV
						PREV_.PD;
						MAKAGO(PA,QQ);
					END;
				END;
			END;
			HEAD_.PREV;
			PREV_.PREV[SRCLINK];
		END;		!WHILE 1 DO




		!HEAD NOW POINTS TO THE STATEMENT BEFORE
		!A RETURN AND PREV TO THE RETURN.
		PREV_.HEAD;
		HEAD_.HEAD[SRCLINK];
		! PREV POINTS TO THE STATEMENT BEFORE THE
		!RETURN, HEAD TO THE RETURN ITSELF
		!ON THE OTHERHAND IF WE ALREADY HAVE A SET OF
		!STORES MADE UP, RETSPOT POINTS TO THE LABEL
		!AND WE CAN CHEAPLY MAKE THIS RETURN A GO TO THAT LABEL
		!BUT FIRST WE MUST CHECK THAT THIS IS NOT
		!A RETURN MADE BY A TRUE BRANCH OF A LOGICAL IF
		IF .HEAD[A2NOTFLG] THEN
		BEGIN
			HEAD[A2NOTFLG]_0;	!LETS BE TIDY
			RETURN;
		END;

		IF (.RETSPOT NEQ 0) AND (.HEAD[RETEXPR] EQL 0)  THEN
		BEGIN
			MAKAGO(HEAD,RETSPOT)
		END ELSE
		BEGIN
			!DO IT ALL NOW
			PREV_MAKSTASH(.PREV);
			!LABEL THE FIRST ONE
			QQ_LABFRST;
			IF .HEAD[RETEXPR] EQL 0 THEN RETSPOT_.QQ;
		END;
		!FINAL LINK UP

		PREV[SRCLINK]_.HEAD;
		STMT_.HEAD[SRCLINK];
	END;	!WHILE ON STMT

END;	! of STOWONRETURN
ROUTINE MATERIALIZE=
BEGIN
	EXTERNAL EXITNO;
	MAP BASE EXITNO;
	EXTERNAL GENLAB;
	EXTERNAL INDVAR;

	MAP PHAZ2 TOP;

	EXTERNAL CHOSEN,REGTOALC,GLOBREG,SAVSPACE;
	EXTERNAL LOCLNK;
	MAP BASE LOCLNK;

	MAP BASE BOTTOM:HEAD:PD;
	MAP PEXPRNODE QQ;
	 MAP PEXPRNODE PREV;
	!MATERIALIZE VARIABLES ASSIGNED TO REGISTERS

	ROUTINE SETBBALCFIELDS=
	BEGIN
		!LOCAL ROUITNE TO SET TWO FIELDS IN THE
		!MATERIALIZATION NODES CREATED TO HELP THE
		!BASIC BLOCK ALLOCATOR KEEP GLOBALLY
		!ALLOCATED VARIABLES IN REGISTERS
		PREV_.LOCLNK;
		!THE INSERTED STATEMENTS ARE BETWEEN LOCLNK
		!AND HEAD
		WHILE .PREV NEQ .HEAD DO
		BEGIN
			PREV[SRCSONNXTUSE]_0;
			PREV[SRCSAVREGFLG]_1;
			PREV_.PREV[SRCLINK];
		END;
	END;	! of SETBBALCFIELDS


	!BOTTOM POINTS AT A CONTINUE WHICH HAS A FIELD THAT
	!POINTS TO THE LINKED LISTS OF EXITS.

	!SET UP TWO MODULE OWNS
	PREV_.BOTTOM;
	HEAD_.BOTTOM[SRCLINK];


	!IF THE FULLFILLMENT EXIT IS THE ONLY ONE GET OUT NOW
	IF .BOTTOM[OPTINFO] EQL 0 THEN
	BEGIN
		!FULFILLMENT EXIT ONLY
		SAVCODE_MATRLZ;
		!IF EITHER INDEX IS ON THE LIST
		!DONT LET IT BE SAVED AT ALL
		IF .INDVAR NEQ 0 THEN
			IF .GLOBREG[0]<RIGHT> EQL .INDVAR THEN
				GLOBREG[0]<ALCFLG>_AWL;

		IF .SECIDX NEQ 0 THEN
			IF .GLOBREG[1]<RIGHT> EQL .SECIDX THEN
				GLOBREG[1]<ALCFLG>_AWL
			ELSE
				!IF IT IS THE ONLY ONR ALLOCATED IT IS FIRST
				IF .GLOBREG[0]<RIGHT> EQL .SECIDX THEN
					RETURN;

		PREV_MAKSTASH(.BOTTOM);
		PREV[SRCLINK]_.HEAD;
		SETBBALCFIELDS();
		RETURN;
	END;
	SAVCODE_MATRLZ;
	!GENERATE MATERIALIZATIONS FOR FULLFILLMENT EXIT TOO
	PREV_MAKSTASH(.BOTTOM);

	!NOW THE OTHER (EARLY EXITS) EXITS REMAIN TO BE
	!PROCESSED. AFTER THE MATERIALIZATIONS FROM THE
	!FULLFILLMENT EXIT MAKE A GOTO AROUND THE OTHER
	!MATERIALIZATIONS WE WILL GENERATE.

	!IF THERE ARE MORE EXITS THAN STANDARD THEN
	!	1. MAKE THE STATEMENT AFTER BOTTOM BE A GO TO
	!	   AROUND THE MATERIALIZATIONS
	!	2. CREATE A LABEL FOR THE ATATEMENT AFTER BOTTOM
	!	   IF NECESSARY.

		IF .HEAD[SRCLBL] NEQ 0 THEN
			PD_.HEAD[SRCLBL]
		ELSE
		BEGIN
			PD_GENLAB();
			HEAD[SRCLBL]_.PD;
			PD[SNHDR]_.HEAD;
			PD[SNREFNO]_2;
		END;

		!MAKE THE GO TO
		NAME<LEFT>_GOTOSIZ+SRCSIZ;
		PA_CORMAN();
		PA[OPRCLS]_STATEMENT;
		PA[SRCID]_GOTOID;
		PA[GOTOLBL]_.PD;
		!ADJUST LINKS
		PA[SRCLINK]_.HEAD;
		PREV[SRCLINK]_.PA;
		PREV_.PA;


	!FOR EACH EXIT  MAKE A SET OF
	!ASSIGNMENTS AND A GO TO THE EXIT LABEL
	!THATS THE EASY PART

	EXITNO_.BOTTOM[OPTINFO];
	WHILE .EXITNO NEQ 0 DO
	BEGIN

		OWN BASE THSEXT;	!PTR TO CURRENT ITEM ON EXITLST
		THSEXT_.EXITNO[LEFTP];
		PREV_MAKSTASH(.PREV);

		!MAKE THE GO TO STATEMENT NODE
		NAME<LEFT>_GOTOSIZ+SRCSIZ;
		PA_CORMAN();
		PA[OPRCLS]_STATEMENT;
		!DETERMINE IF IT IS AN ASSIGNED GO TO OR A REGULAR ONE
		!NOTE * NEVER * HERE WITH A COMPUTED GO TO
		IF .THSEXT[OPRCLS] EQL LABOP THEN
			PA[SRCID]_GOTOID
		ELSE
			PA[SRCID]_AGOID;
		PA[GOTOLBL]_.THSEXT;
		PREV[SRCLINK]_.PA;
		PA[SRCLINK]_.HEAD;
		PREV_.PA;
		!NOW THE TIME CONSUMING PART.
		!LOOK A THE ORIGINAL BRANCH STATEMENT.
		!CHANGE IT TO BRANCH TO QQ.
		P_.TOP[SRCLINK];
		QQ_LABFRST;
		WHILE .P NEQ .BOTTOM[SRCLINK] DO
		BEGIN
			MATLOK(.P,.THSEXT,.QQ);
			P_.P[SRCLINK];
		END;
		EXITNO_.EXITNO[RIGHTP];
	END;			!FOR EACH EXIT
		!SET BASIC BLOCK ALLOCATOR FIELDS ON INSERTED STATEMENTS
		SETBBALCFIELDS();
	!THATS ALL!!!!!

END;	! of MATERIALIZE
ROUTINE MATLOK(PB,LABL,NEWLAB)=
BEGIN
	!PB IS POINTER TO THE STATEMENT
	!THIS ROUTINE LOOKS AT ALL POSSIBLE BRANCHES AND SUBSTITUTES
	!NEWLAB FOR AN LABEL REFERENCE THAT MATCHES LABL

	!EXTRA LEVEL NEEDED FOR LOGICAL IF STATEMENT

	MAP PHAZ2 PB;

%2204%	! Look at END and ERR for I/O statements

%2204%	IF (.PB[SRCID] GEQ READID AND .PB[SRCID] LEQ ENDFID) OR
%2204%		.PB[SRCID] EQL OPENID OR .PB[SRCID] EQL INQUID
%2204%	THEN
%2204%	BEGIN	! I/O statement
%2204%		IF .PB[IOERR] EQL .LABL THEN PB[IOERR] = .NEWLAB;
%2204%		IF .PB[IOEND] EQL .LABL THEN PB[IOEND] = .NEWLAB;
%2204%		RETURN;		! Done - return now
%2204%	END;

	SELECT .PB[SRCID] OF NSET		!ALL BRANCHING STATEMENTS

GOTOID:	BEGIN	!GO TO

		IF .PB[GOTOLBL] EQL .LABL THEN
			PB[GOTOLBL]_.NEWLAB;
	END;
CGOID:	BEGIN	!COMPUTED GO TO
		LABLLOK(.PB,.LABL,.NEWLAB);
			!CESLNK IS RIGHT HALF THROUGH THE STRUCTURE
	END;

AGOID:	BEGIN	!ASSIGNED GO TO - OPTIONAL LIST IS PRESENT
	LABLLOK(.PB,.LABL,.NEWLAB);
	END;

IFLID:	BEGIN	!LOGICAL IF
		MATLOK(.PB[LIFSTATE],.LABL,.NEWLAB);
	END;

IFAID:	BEGIN	!ARITHMETIC IF
		IF .PB[AIFLESS] EQL .LABL THEN
		PB[AIFLESS]_.NEWLAB;
		IF .PB[AIFEQL] EQL .LABL THEN
		PB[AIFEQL]_.NEWLAB;
		IF .PB[AIFGTR] EQL .LABL THEN
		PB[AIFGTR]_.NEWLAB;
	END;
CALLID:	BEGIN	!CALL - MAY HAVE LABEL AS PARAMETER
		IF .PB[CALLIST] NEQ 0 THEN
		BEGIN
			LOCAL ARGUMENTLIST ARGL;
			ARGL_.PB[CALLIST];
			INCR J FROM 1 TO .ARGL[ARGCOUNT] DO
			BEGIN
				PA_.ARGL[.J,ARGNPTR];
				IF .PA[OPRCLS] EQL .LABOP THEN
				BEGIN
					IF .PA EQL .LABL THEN
					ARGL[.J,ARGNPTR]_.NEWLAB;
				END;
			END;
		END;
	END;

	TESN;

END;	! of MATLOK
ROUTINE INITEM=
BEGIN
	EXTERNAL GBSYREGS,GBSYCT;

	!REINITIALIZE SOME GLOBALS
	DECR I FROM 31 TO 0 DO
		CHOSEN[.I]_0;
	DECR I FROM 15 TO 0 DO
		GLOBREG[.I]_0;
	GOTEMDBL_0;
	!ALSO SET SOME OWNS
	MINWD_0;
	DECR I FROM 9 TO 0 DO
		MAXCOMPLEX[.I]_0;

	!ALSO INITIALIZE SOME GLOBALS

	CLEANSLATE_
	GBSYREGS_#177760000000;
	GBSYCT_12;
	REGAVAIL_8;

END;	! of INITEM
%[1047]% PORTAL ROUTINE MRP3G=
BEGIN
	LABEL ALCREGS;
%1245%	EXTERNAL ALCAVARS,ALCQVARS,ALCCON,HISEGBLK;
	EXTERNAL RETNCT,ASVCT;
	EXTERNAL INITREGCANDIDATES,CMPBLOCK;
	EXTERNAL ALLOCATE,RELINIT;
	EXTERNAL STBSYR,STRGCT,ALCSTMNT,LENTRY;
	EXTERNAL GBSYREGS,GBSYCT;
%1454%	EXTERNAL FORMPTR;
%2210%	EXTERNAL DMPFORMAT;		! Allocates and writes FORMATs
	EXTERNAL ALCBLOCK,NOBBREGSLOAD,INIRGSTATE;
	EXTERNAL DOCNT,DOWDP;

	!CONTROL GLOBAL REGISTER ALLOCATION

	LABEL EXAMSTAT;

	EXTERNAL CSTMNT,INDVAR,ISN;
	MAP BASE TOP:P:CSTMNT:LENTRY:BOTTOM:WAYBBB;



	DOWDP_0;
	!INITIALIZE THE RELFILE IF ONE WAS REQUESTED

	IF .FLGREG<OBJECT> THEN
		RELINIT();

	!ALLOCATE ARRAYS AND SCALARS, COMMON AND EQUIVALENCE
	ALLOCATE();

%2270	No longer need this routine					%
%2270	NAMESET();	!SET INNAM BIT FOR VARIABLES IN NAMELISTS	%

	RETNCT_0;	!CT OF RETURN STMNTS
	ASVCT_0;	!CT OF ASSIGNMENTS OF THE FN VAL THAT DIRECTLY PRECEDE RETURN STMNTS
	!GET COMPLEXITY FOR ALL STATEMENTS
	INITREGCANDIDATES();
	CSTMNT_.SORCPTR<LEFT>;
	WHILE .CSTMNT NEQ 0 DO
		CMPBLOCK();

	!NOW GO THROUGH ONCE MORE AND SAVE AWAY
	!	1. THE PREVIOUS BASIC BLOCK IN THE LABEL TABLE
	!	2. THE STATEMENT IN FRONT OF THE PREVIOUS BASIC BLOCK

	!FOR THIS PURPOSE THE DEFINITION A BASIC BLOCK IS SLIGHTLY
	!DIFFERENT THAN FOR THE LOCAL ALLOCATOR. A BASIC BLOCK STARTS
	!AT A DO, ENTRY OR LABELED STATEMENT.

	WAYBBB_PREVBB_
	CSTMNT_.SORCPTR<LEFT>;

	WHILE .CSTMNT NEQ 0 DO
	BEGIN
		!IS IT A DO
		IF .CSTMNT[SRCID] EQL DOID THEN
		BEGIN
			!YES, IS IT ONE THAT CAN POTENTAILLY GET ALLOCATED
			IF .CSTMNT[EXTALLOC] OR .CSTMNT[INNERDOFLG] THEN
			BEGIN
				!STASH THINGS AWAY IN THE LABEL TABLE
				!SNNXTLAB POINTS TO PREVIOUS BB
				!SN1STLAB POINTS TO STATEMENT BEFORE
				!PREVIOUS BB.
				T_.CSTMNT[DOLBL];
				!SAVE PREVBB IN SNNXTLAB
				T[SNNXTLAB]_.PREVBB;
				!NOW DO THE FINE TUNING
				IF .WAYBBB NEQ .PREVBB THEN
					UNTIL .WAYBBB[SRCLINK] EQL .PREVBB DO
						WAYBBB_.WAYBBB[SRCLINK];

				!NOW SAVE IT
				T[SN1STLAB]_.WAYBBB;
			END;		!LOOP WE CARE ABOUT
			WAYBBB_.PREVBB;
			PREVBB_.CSTMNT;
		END ELSE	!NOT A DO
![641] BE MORE CAREFUL FOR A LOGICAL IF STATEMENT WITH CALL STATEMENT
![641] AS THE RESULT - DO NOT WANT TO INCLUDE IT FOR REGISTER
![641] SUBSTITUTIONS SINCE IT CAUSES PRELOAD PROBLEMS.
%[641]%		IF .CSTMNT[SRCID] EQL IFLID THEN
%[641]%		BEGIN
%[641]%			T_.CSTMNT[LIFSTATE];
%[641]%			IF .CSTMNT[TRUEISBR] OR (.T[SRCID] EQL CALLID) THEN
%[641]%			(WAYBBB_.PREVBB; PREVBB_.CSTMNT)
%[641]%		END ELSE
		!IS IT LABELED. WE HAVE ALREADY REMOVED UNREFERENCED LABELS
		!IS IT AN ENTRY
		IF (.CSTMNT[SRCID] EQL ENTRID) OR (.CSTMNT[SRCLBL] NEQ 0)
		OR .CSTMNT[USRFNREF]
![641] REMOVE LOGICAL IF CASE (INSERT ABOVE A MORE COMPLETE TEST)
		OR (.CSTMNT[SRCID] EQL CALLID)  THEN
		BEGIN
			WAYBBB_.PREVBB;
			PREVBB_.CSTMNT;
		END;
		!DONE WITH SPECIAL STUFF. LOOK AT NEXT STATEMENT
		CSTMNT_.CSTMNT[SRCLINK];
	END;		!WHILE ON CSTMNT

	NOBBREGSLOAD_FALSE;

	INIRGSTATE();		!INITIALIZE FOR BB REG ALLOCATION

	INITEM();
	GUIDE_0;

	ALCREGS:		!BLOCK IN WHICH REG ALLOC IS PERFORMED
	BEGIN

	IF .DLOOPTREE EQL 0 THEN	!NO LOOPS PRESENT
	BEGIN
		!IT IS EITHER A A MAIN OR SUB PROGRAM.
		!SEE WHICH
		IF .FLGREG<PROGTYP> EQL MAPROG THEN
			GUIDE_1
		ELSE
			!CHECK FOR &$# BLOCK DATA
			IF .FLGREG<PROGTYP> EQL BKPROG THEN
				LEAVE ALCREGS
			ELSE
				GUIDE_3;

		!SET UP GLOBALS FOR ALLOCATION ROUTINE
		LENTRY_TOP_.SORCPTR<LEFT>;
		!PHA2 HAS LEFT THIS AS THE FUDGED DO NODE
		BOTTOM_.TOP[DOLBL];

		!UNLESS THIS IS AN EMPTY SUBPROGRAM. IN THIS CASE
		!IT IS NOT SET UP AND THE LABEL FIELS WILL BE ZERO
		!SO WE WILL QUIT

		IF .BOTTOM EQL 0 THEN LEAVE ALCREGS;

		BOTTOM_.BOTTOM[SNHDR];
		!BOTTOM POINTS TO THE STATEMENT BEFORE THE END STATEMENT

![716] CHECK LEGALITY OF DOING OPTIMIZATIONS FOR OUTERMOST LOOP
%[716]%		IF LEGALALLOC(.TOP) THEN
		GBLALLOC();
	END ELSE
	BEGIN
		!LOOPS ARE PRESENT
		!EXAMINE THE CODE
		CSTMNT_.SORCPTR<LEFT>;
		EXAMSTAT:
		WHILE .CSTMNT NEQ 0 DO
		BEGIN
			!WE ONLY CARE ABOUT DO LOOPS
			IF .CSTMNT[SRCID] EQL DOID THEN
			BEGIN
				GUIDE_0;
				INITEM();
				!IS IT AN INNER ONE
				IF .CSTMNT[INNERDOFLG] THEN
				BEGIN
					T_.CSTMNT[DOLBL];
					!LOOK AT PREVBB STORED IN
					!LABEL TABLE AND SEE IF IT
					!IS A MAIN OR SUB PROGRAM
					IF (.T[SNNXTLAB] EQL .SORCPTR<LEFT>
					 OR .T[SNNXTLAB] EQL 0) AND
					.DOCNT EQL 1   THEN
					BEGIN
						IF .FLGREG<PROGTYP> EQL MAPROG THEN
							GUIDE_2
						ELSE
							GUIDE_4;

![1051]						If it is legal to allocate this
![1051]						loop, then set the parameters
![1051]						and do the optimizations
%[1051]%					IF LEGALALLOC(.CSTMNT) THEN
%[1051]%					BEGIN
%[1051]%						LENTRY_TOP_.CSTMNT;
%[1051]%						BOTTOM_.T[SNHDR];
%[1051]%						INDVAR_.TOP[DOSYM];
%[1051]%						GBLALLOC()
%[1051]%					END;
						LEAVE EXAMSTAT;
					END ELSE
					BEGIN
						!THE PREVIOUS BASIC BLOCK
						!IS A LOOP. SEE IF IT IS
						!LEGAL TO ALLOCATE THE LOOP
						IF LEGALALLOC(.CSTMNT) THEN
						BEGIN
							GUIDE_5;
							LENTRY_TOP_.CSTMNT;
							BOTTOM_.T[SNHDR];
							INDVAR_.TOP[DOSYM];
							GBLALLOC();
						END ELSE
						!CANNOT ALLOCATE IT
						!SO SKIP OVER IT
						CSTMNT_.T[SNHDR];
					END;
				END ELSE
				!IT IS NOT AN INNER LOOP
				BEGIN
					!SEE IF IT IS SECOND LEVEL
					IF .CSTMNT[EXTALLOC] THEN
					BEGIN
						!FIND THE SINGLE INNER ONE
						TOP_.CSTMNT[SRCLINK];
![662] IF AN INNER DO LOOP WAS INACCESSIBLE (AND HENCE THROWN AWAY),
![662] THEN WE MAY END UP WITH ZERO (END OF PROG) - CHECK FOR IT.
%[662]%						WHILE .TOP[SRCID] NEQ DOID AND .TOP NEQ 0 DO
							TOP_.TOP[SRCLINK];
						!TOP NOW POINTS TO THE INNER DO
%[662]%						IF .TOP NEQ 0 THEN
						IF LEGALALLOC(.CSTMNT) AND
						   LEGALALLOC(.TOP) THEN
						BEGIN
							GUIDE_6;
							!SETT UP THE PARMS
							T_.TOP[DOLBL];
							BOTTOM_.T[SNHDR];
							LENTRY_.TOP;
							INDVAR_.TOP[DOSYM];

							GBLALLOC();
						END;
						!WE WILL CATCH THE INNER ONE
						!IF IT ALONE IS LEGAL WHEN WE
						!GET TO IT WITH CSTMNT
					END;
				END;
			END;	!STATEMENT IS A DO LOOP
			CSTMNT_.CSTMNT[SRCLINK];
		END;	!WHILE ON CSTMNT
	END;	!LOOPS PRESENT
	!NOW CLEAN UP THE LABEL TABLE
	INCR I FROM 0 TO LASIZ-1 DO
	BEGIN
		EXTERNAL LABTBL;
		T_.LABTBL[.I];
		WHILE .T NEQ 0 DO
		BEGIN
			T[SNNXTLAB]_0;
			T[SNCADDRWD]_0;
			T_.T[CLINK];
		END;
	END;

	!NOW, ONE MORE PASS TO COMPLETE THE BASIC BLOCK ALLOCATION
	CSTMNT_.SORCPTR<LEFT>;
	!DEPENDING ON THE VALUE OF GUIDE CALL THE LOCAL ALLOCATOR
	!IN A COUPLE OF DIFFERENT WAYS
	IF .GUIDE GEQ 5 THEN
	BEGIN
		GBSYREGS_#177760000000;
		GBSYCT_12;
	END;
	WHILE .CSTMNT NEQ 0 DO
		ALCBLOCK();

	END;		!END OF BLOCK "ALCREGS"

	!ALLOCATE TEMPS AND CONSTANTS ETC.

%1245%	HDRFLG _ 0;	! Heading not output yet
%1245%	TCNT = 0;
%1245%	ALCAVARS();

%1245%	ALCQVARS();

	DATPROC();	!PROCESS DATA STATEMENTS BEFORE CONSTANTS

%1245%	ALCCON();

	! Dump the format statements into the .REL file if there are some

%1454%	IF .FORMPTR NEQ 0
%2210%	THEN DMPFORMAT();

%2334%	IF EXTENDED AND .FLGREG<OBJECT> AND .FLGREG<PROGTYP> EQL MAPROG
%2334%	THEN
%2334%	BEGIN	! EXTENDED MAIN PROGRAM
%2334%		ENTADDR = .LOWLOC;	! Save address of entry vector
%2355%		LOWLOC = .LOWLOC+ENTVECSIZE+ENTAUXSIZE;	! Allocate space for it
%2334%	END;	! EXTENDED MAIN PROGRAM

	HISEGBLK();	!GENERATE THE HISEG BLOCK IN REL FILE
				!TO TELL LOADER SIZE OF LOSEG

%1245%	! Output high seg descriptors for character constants

%1245%	HDRFLG _ 0;	! Heading not output yet
%1245%	HSLITD();

%1245%	! Output high seg descriptors for character scalars and arrays
%1245%	! If we had character declarations in FORTB

%1245%	IF .CHDECL EQL -1 THEN HSCHD();

%1406%	! Output high seg descriptors for .Dnnnn compile-time-constant
%1406%	! character descriptors

%1406%	HSDDESC();


END;	! of MRP3G

!****************************************************
	!THIS IS THE MAIN PROGRAM FOR THE GLOBAL
	!REGISTER ALLOCATION OVERLAY
!*******************************************************

	MACHOP POPJ=#263;

	!CALL THE CONTROL ROUTINE MRP3G

	MRP3G();

	!GO BACK TO THE PHASE CONTROL ROUTINE

	POPJ(#17,0)

END
ELUDOM