Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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

!COPYRIGHT (C) 1972,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHORS: NORMA ABEL AND SARA MURPHY/HPW/DCE/SJW/EGM/TFV

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

GLOBAL BIND UTILV = 6^24 + 0^18 + 89;	! Version Date:	16-Jul-81


%(

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

72	-----	-----	ADD ROUTINE TRANSMOGRIFY TO RENAME SYMBOLS
73	-----	-----	FIX CONTVAR TO CORRCTLTY HANDLE IOLISTS
74	-----	-----	FIX DOVARSUBSTITUTE TO SET ASGN4USED ON DO LOOP
			INDEX
75	-----	-----	 ADD ROUTINES ALODIMCONSTS,ALDIM1 TO ALLOCATE CORE
			FOR CONSTANTS USED IN SPECIFYING DIMENSION TABLE
			INFORMATION (ROUTINES ARE CALLED WHEN DIMENSION
			INFO WILL BE OUTPUT FOR DEBUGGING PURPOSES
76	-----	----- FIX BUG IN ALDIM1
77	-----	-----	TAKE AWAY ROUTINES USED ONLY IN ALLOCATION
78	-----	-----	FIX 77 BY PUTTING LASTONE BACK IN
79	-----	-----	MAKE IOSUBSTITUTE HANDLE E1 AND E2 LISTS
80	-----	-----	FIX DOVARSUBSTITUTE NOT TO CLOBBER DOIREG
81	-----	-----	CONTFN DOES NOT IGNORE ARG2 OF AN ARRAYREF
			IF IT IS ZERO
82	-----	-----	MOVE LOWLIM TO GLOBAL
83	-----	-----	FIX UNFLDO TO SET SSIZONE. FIX DOVARSUBS
			TO SET INITLIMMED FLAG
84	-----	-----	FOR PROPAGATING .O VARS AND .R AND .S VARS
			MAKE DOVARSUBSTITUTE LOOK AT DOCTLVAR
85	447	19547	DO NOT PROPAGATE NEGS ONTO CERTAIN NODES
			LIKE: I+A(I) WHICH ARE SPECIAL, (DCE)
86	463	19989	IF SUBSTITUTING A REGCONTENTS NODE POINTING TO
			AN AOBJN DO INDEX INTO THE INITIAL VALUE OR
			INCREMENT OF AN IMPLIED DO, SET IMMEDIATE FLAGS
			SO CODE GENERATION WILL ONLY PICK UP RH OF AC., (JNG)

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

87	617	QA2121	ONLY TRY TO SUBSTITUTE THE SUBSCRIPT OF AN
			  ARRAYREF IF IT ISN'T A CONSTANT, (SJW)

***** Begin version 5B *****

88	754	29120	MAKE CONTVAR WALK COMMON SUB EXPRESSION NODES, (EGM)

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

89	1006	TFV	1-Jul-80	------
	Move KISNGL from CGEXPR.BLI and OUTMOD.BLI to this module.
	Make it a global routine.  Note that UTIL is loaded in
	every phase that CGEXPR or OUTMOD is.

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

)%

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

FORWARD UNFLDO;



GLOBAL ROUTINE TRANSMOGRIFY(WHERE,NEWNAME)=
%(**********************************************************************

	ROUTINE TO RENAME A SYMBOL

	CALLED WITH A POINTER TO THE SYMBOL TABLE ENTRY IN
	WHERE AND THE NEW SYMBOL NAME IN NEWNAME

	DELINKS THE SYMBOL AND REHASHES IT

**********************************************************************)%
BEGIN
MAP BASE WHERE:NEWNAME;
EXTERNAL
	SKERR,		!STATEMENT ERROR
	SYMTBL,		!THE SYMBOL TABLE
	THASH,		!COMPUTE HASH TABLE INDEX <SRCA>
	NAME,		!SYMBOL TYPE FOR TABLE ROUTINES <GLOBAL>
	ENTRY;		!SYMBOL NAME FOR TABLE ROUTINES
LOCAL BASE OLDBASE:NEWBASE;

	NAME_IDTAB;		!SET SYMBOL TABLE ACCESS
	ENTRY_.WHERE[IDSYMBOL];	!COMPUTE HASH INDEX FOR OLD ENTRY
	OLDBASE_THASH();	!VIA THASH
	ENTRY_.NEWNAME;		!COMPUTE HASH INDEX FOR NEW ENTRY
	NEWBASE_THASH();	!VIA THASH

	OLDBASE_SYMTBL[.OLDBASE]<0,0>;	!POINT TO SYMBOL TABLE
	NEWBASE_SYMTBL[.NEWBASE]<0,0>;	!POINT TO SYMBOL TABLE

					!FIND HASH ENTRY IN FRONT
					!OF SYMBOL
	WHILE .OLDBASE[IDLINK] NEQ .WHERE DO
	BEGIN
		IF (OLDBASE_.OLDBASE[IDLINK]) EQL 0 THEN SKERR()
	END;

	OLDBASE[IDLINK]_.WHERE[IDLINK];	!LINK SYMBOL OUT OF TABLE

	WHERE[IDSYMBOL]_.NEWNAME;	!RENAME SYMBOL AND
	WHERE[IDLINK]_.NEWBASE[IDLINK];	!LINK IT INTO
	NEWBASE[IDLINK]_.WHERE		!THE SYMBOL TABLE

END;


GLOBAL ROUTINE PROPNEG(CNODE)=
%(***************************************************************************
	PROPAGATE A NEGATIVE OVER THE NODE "CNODE" IF IT IS POSSIBLE TO DO SO.
	THIS ROUTINE ALLOWS FOR NEGFLAGS SET IN THE NODE CNODE.
	IT RETURNS TRUE IF IT WAS ABLE TO PROPAGATE THE NEG, FALSE IF NOT.
***************************************************************************)%
BEGIN
	REGISTER OPERIX;			!FOR ARITHMETIC OPERATORS, THE OPERSP
						! FIELD IS USED AS AN INDEX TO SPECIFY ACTION
						! TO BE TAKEN
	MAP PEXPRNODE CNODE;


	%(***THE FOLLOWING TABLES ARE USED IF CNODE IS AN ARITHMETIC OPERATION****)%

	%(*****TABLE OF WHETHER TO NEGATE ARG1*****)%
	BIND A1NEGTBL=PLIT (
		TRUE,		!FOR ADD, DO
		TRUE,		!FOR SUB, DO
		TRUE,		!FOR MUL, DO
		TRUE,		!FOR DIV, DO
		FALSE);		!FOR EXPONEN, DO NOT

	%(***TABLE OF WHETHER TO NEGATE ARG2***)%
	BIND A2NEGTBL=PLIT (
		TRUE,		!FOR ADD DO
		TRUE,		!FOR SUB DO
		FALSE,		!FOR MUL DO NOT
		FALSE,		!FOR DIV DO NOT
		FALSE );		!FOR EXPONEN, DO NOT

	%(***TABLE OF WHETHER  THE NEGATE WAS SUCCESSFULLY PROPAGATED***)%
	BIND PROPSUCCESS=PLIT (
		TRUE,		!CAN PROPAGATE FOR ADD
		TRUE,		!CAN FOR SUB
		TRUE,		!CAN FOR MUL
		TRUE,		!CAN FOR DIV
		FALSE );		!CAN NOT PROPAGATE NEG ACROSS EXPONEN




	%(***IF ANY "NOT" FLAGS ARE SET IN CNODE, DONT BOTHER***)%
	IF .CNODE[A1NOTFLG] OR .CNODE[A2NOTFLG]
	THEN RETURN FALSE;

	%(****IF CNODE IS AN ARITHMETIC EXPRESSION********)%

	IF .CNODE[OPRCLS] EQL ARITHMETIC
	THEN
	BEGIN
		%(***ALL DECISIONS WILL BE MADE ON THE BASIS OF THE SPECIFIC OPERATOR***)%
		OPERIX_.CNODE[OPERSP];

		%(***PROCESS 1ST ARG UNDER CNODE***)%
		IF .CNODE[A1NEGFLG]
		THEN
		CNODE[A1NEGFLG]_NOT .A1NEGTBL[.OPERIX]		!2 NEGS CANCEL
		ELSE
		IF .CNODE[A1VALFLG]
		THEN
		BEGIN

			!BE CAREFUL HERE, FOR WE CANNOT PROPAGATE DOWN
			! A NEGATIVE ONTO A NODE WHERE THE A1SAMEFLG
			! IS SET AND WHERE ARG1 IS A VARIABLE LIVING
			! IN A REGISTER - ARG2 COULD BE TAKING ADVANTAGE
			! OF THE SAME REGISTER AS IN THE CASE:
			! K2=-JC*(K+NP(K)) WHICH LOSES OUT IN FORTG
			IF .CNODE[A1SAMEFLG] THEN
				IF NOT .CNODE[A1IMMEDFLG]
					THEN RETURN FALSE;
			CNODE[A1NEGFLG]_.A1NEGTBL[.OPERIX];		!CANNOT PROP OVER A VAR
			IF .CNODE[A1NEGFLG] AND.CNODE[A1IMMEDFLG] AND .CNODE[A1SAMEFLG]	!IF ARG1 IS AN IMMED CONST WHOSE
							! VAL WASLEFT IN A REG FROM A PREV STMNT, NO LONGER
							! WANT TOUSE IT FROM THAT REG
			THEN CNODE[A1SAMEFLG]_0;
		END
		ELSE
		IF .A1NEGTBL[.OPERIX]
		THEN
		BEGIN
			IF NOT PROPNEG(.CNODE[ARG1PTR])
			THEN
			CNODE[A1NEGFLG]_1;			!IF CANNOT PROP NEG OVER ARG1
		END;

		%(***PROCESS 2ND ARG UNDER CNODE***)%
		IF .CNODE[A2NEGFLG]
		THEN
		CNODE[A2NEGFLG]_NOT .A2NEGTBL[.OPERIX]		!2 NEGS CANCEL
		ELSE
		IF .CNODE[A2VALFLG]
		THEN
		CNODE[A2NEGFLG]_.A2NEGTBL[.OPERIX]		!CANNOT PROP OVER A VAR
		ELSE
		IF .A2NEGTBL[.OPERIX]
		THEN
		BEGIN
			IF NOT PROPNEG(.CNODE[ARG2PTR])
			THEN
			CNODE[A2NEGFLG]_1;			!IF CANNOT PROP NEG OVER ARG2
		END;

		%(***RETURN TRUE IF SUCESSFULLY PROPAGATED NEGATE ONTO CNODE***)%
		RETURN .PROPSUCCESS[.OPERIX];

	END


	ELSE
	%(*****IF CNODE IS A TYPE-CONVERSION NODE FOR WHICH CODE MUST BE GENERATED
		(TO BE DIFFERENTIATED FROM TYPE CONVERSION NODES THAT
		ARE PRESENT ONLY TO KEEP TRACK OF VALTYPES)***)%
	IF .CNODE[OPRCLS] EQL TYPECNV AND (NOT NOCNV(CNODE))
	THEN
	BEGIN
		%(***IF THE VAL TO BE CONVERTED ALREADY HAD A NEG, THE 2 CANCEL***)%
		IF .CNODE[A2NEGFLG]
		THEN
		CNODE[A2NEGFLG]_0
		ELSE
		%(***CANNOT PROPAGATE A NEG DOWN ANY FURTHER ONTO A VAR***)%
		IF .CNODE[A2VALFLG]
		THEN
		CNODE[A2NEGFLG]_1
		ELSE
		IF NOT PROPNEG(.CNODE[ARG2PTR])
		THEN
		%(***IF WERE UNABLE TO PROPAGATE THE NEG OVER THE SUBNODE UNDER CNODE***)%
		CNODE[A2NEGFLG]_1;

		%(***CAN ALWAYS SUCCESSFULLY PROPAGATE A NEG ONTO A TYPE-CONVERSION***)%
		RETURN TRUE;
	END

	%(***CANNOT SUCCESSFULLY PROPAGATE A NEG OVER ANYTHING OTHER THAN ARITH OR TYPECNV - 
		(NOTE THAT ANY NEGATE NODES WOULD HAVE BEEN REMOVED AT PHASE 2 SKEL)***)%
	ELSE
	RETURN FALSE
END;






GLOBAL ROUTINE NODERR=
BEGIN
	EXTERNAL SKERR;
	SKERR();
END;




GLOBAL ROUTINE SETPVAL(CNODE)=
%(****************************************************
	ROUTINE SETS VAL FLAGS IN THE PARENT OF CNODE.
	CNODE IS THE OLD NODE THAT HAS JUST BEEN
	*FOLDED*.
	IT IS CALLED ONLY WHEN IT IS KNOWN THAT
	CNODE IS A DATAOPR.
*****************************************************)%
BEGIN
	LOCAL ANODE; MAP PEXPRNODE ANODE;
	MAP PEXPRNODE CNODE;

	ANODE_.CNODE[PARENT];
	IF .ANODE[OPRCLS] EQL STATEMENT THEN
	!PARENT POINTS BACK AT THE STATEMENT
	BEGIN
		IF .ANODE[SRCID] EQL ASGNID THEN
		!ASSIGNMENT STATEMENT IS ONLY ONE WITH VAL FLGS
		BEGIN
			IF .CNODE EQL .ANODE[RHEXP] THEN
				ANODE[A2VALFLG]_1
			ELSE
				ANODE[A1VALFLG]_1;
		END ELSE
		IF .ANODE[SRCID] EQL IFAID THEN
			ANODE[A1VALFLG]_1
		ELSE
		IF .ANODE[SRCID] EQL IFLID THEN
			ANODE[A1VALFLG]_1;
	END ELSE
	!IT MUST BE AN EXPRESSION

	%(***IF PARENT IS A FN CALL NODE, MUST SET VAL FLAG IN THE ARG-LIST***)%
	IF .ANODE[OPRCLS] EQL FNCALL
	THEN
	BEGIN
		OWN ARGUMENTLIST ARGLST;
		ARGLST_.ANODE[ARG2PTR];
		INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
		DO
		BEGIN
			IF .ARGLST[.CT,ARGNPTR] EQL .CNODE
			THEN ARGLST[.CT,AVALFLG]_1
		END;
	END

	ELSE
	IF .CNODE EQL .ANODE[ARG1PTR] THEN
		ANODE[A1VALFLG] _ 1
	ELSE
		ANODE[A2VALFLG] _ 1;
END;



GLOBAL ROUTINE SETPIMMED(CNODE)=
%(****************************************************
	ROUTINE SETS IMMED FLAGS IN THE PARENT OF CNODE.
	CNODE IS THE OLD NODE THAT HAS JUST BEEN
	*FOLDED*.
	IT IS CALLED ONLY WHEN IT IS KNOWN THAT
	CNODE IS A DATAOPR.
*****************************************************)%
BEGIN
	LOCAL ANODE; MAP PEXPRNODE ANODE;
	MAP PEXPRNODE CNODE;

	ANODE_.CNODE[PARENT];
	IF .ANODE[OPRCLS] EQL STATEMENT THEN
	!PARENT POINTS BACK AT THE STATEMENT
	BEGIN
		IF .ANODE[SRCID] EQL ASGNID THEN
		!ASSIGNMENT STATEMENT IS ONLY ONE WITH IMMED FLGS
		BEGIN
			IF .CNODE EQL .ANODE[RHEXP] THEN
				ANODE[A2IMMEDFLG]_1
			ELSE
				ANODE[A1IMMEDFLG]_1;
		END ELSE
		IF .ANODE[SRCID] EQL IFAID THEN
			ANODE[A1IMMEDFLG]_1
		ELSE
		IF .ANODE[SRCID] EQL IFLID THEN
			ANODE[A1IMMEDFLG]_1;
	END ELSE
	!IT MUST BE AN EXPRESSION

	%(***IF PARENT IS A FNCALL NODE, DO NOT SET IMMEDFLGS***)%
	IF .ANODE[OPERSP] EQL FNCALL
	THEN
	BEGIN
	END

	ELSE
	IF .CNODE EQL .ANODE[ARG1PTR] THEN
		ANODE[A1IMMEDFLG] _ 1
	ELSE
		ANODE[A2IMMEDFLG] _ 1;
END;


!




!ROUTINES TO PERFORM LEAF SUBSTITUTION
!USED IN THREE PLACES
!	1. FOR STATEMENT FUNCTIONS TO SUBSTITUTE THE NEW
!	  VARIABLES FOR THE FORMALS
!	2. IN GLOBAL REGISTER ALLOCATION TO SUBSTITUTE REGCONTENTS NODES
!	   FOR VARIABLES
!	3. IN DO LOOP OPTIMIZATION IN PHASE 2 SKELETON TO SUBSTITUTE
!	   REGCONTENTS NODES FOR THE INDUCTION VARIBALE WHRE POSSIBLE

!THE VARIBALE SPECCASE IS USED TO HANDLE THE MINOR GLITCHES IN UNIFYING
!THESE THREE USES. 
!SPECCASE=
!	1 FOR THE GLOBAL REGISTER ALLOCATION CASE
!	  TO MATERIALIZE IN FRONT OF A STATEMENT CONTAINING A FUNCTION CALL
!	2 FOR THE PHASE 2 SKELETON DO OPTIMIZATION CASE
!	  TO CAUSE THE CORRECT IMMEDIATE FLAG TO BE SET IN THE PARENT
!	0 FOR STATEMENT FUNCTIONS
!THE GLOBAL QQ IS ALSO USED AS A FLAG BOTH IN THE PHASE 2 SKELETON CASE
!AND THE GLOBAL OPTIMIZER . IN THE LATTER CASE IT PROMPTS RESTORING
!GLOBALLY ASSIGNED QUANTATIES TO REGISTERS. IN PHASE 2 SKELETON
!IT CAUSES THE SUBSTITUTION TO TERMINATE.

	EXTERNAL ITMCT;

	EXTERNAL LOWLIM;	!GLOBAL REGISTER ALLOCATOR COUNTS FROM
			!	ZERO TO ITMCT.
			!OTHER USES COUNT FROM 1 TO ITMCT

	FORWARD LEAFSUBSTITUTE;


	ROUTINE LOOKANYWAY(EXPR)=
	BEGIN
		!FOR THE GLOBAL REGISTER ALLOCATOR ONLY.
		!WE HAVE WALKED DOWN ONTO A DATA ITEM,
		!BECAUSE IT IS A PART OF A STATEMENT, NOT
		!AN EXPRESSION.

		EXTERNAL CHOSEN,GLOBREG,REPLACARG,CSTMNT;

		DECR I FROM .ITMCT TO .LOWLIM DO
			IF .EXPR EQL .GLOBREG[.I]<RIGHT> THEN
				REPLACARG(.CSTMNT,.GLOBREG[.I]<RIGHT>,
						.CHOSEN[.I]);
	END;
	ROUTINE LOKA1(EXPR)=
	BEGIN
		EXTERNAL CHOSEN,GLOBREG,SPECCASE,TOP;
		MAP BASE TOP;
		MAP PEXPRNODE EXPR;
		IF .EXPR[A1VALFLG] THEN
		BEGIN
			DECR I FROM .ITMCT TO .LOWLIM DO
			BEGIN
				IF .EXPR[ARG1PTR] EQL .GLOBREG[.I]<RIGHT> THEN
				BEGIN
					EXPR[ARG1PTR]_.CHOSEN[.I];
					!FOR DO LOOPS ONLY
					!PHASE 2 SKELETON WITH
					!AOBJN TYPE ENDER WORD
					IF .SPECCASE EQL 2 THEN
						EXPR[A1IMMEDFLG]_1
					ELSE
					!GLOBAL ALLOCATION CASE
					IF .SPECCASE EQL 1 THEN
					BEGIN
						IF .GLOBREG[.I]<RIGHT> EQL
						.TOP[DOSYM] AND
						.TOP[FLCWD] THEN
						EXPR[A1IMMEDFLG]_1;
						IF NOT .GLOBREG[.I]<ASGND4USED> THEN
						GLOBREG[.I]<USED4ASGND>_1;
						RETURN;
					END;
				END;
			END;
		END ELSE LEAFSUBSTITUTE(.EXPR[ARG1PTR]);
	END;


	ROUTINE LOKA2(EXPR)=
	BEGIN
		MAP PEXPRNODE EXPR;
		EXTERNAL CHOSEN,GLOBREG,SPECCASE,TOP;
		MAP BASE TOP;
		IF .EXPR[A2VALFLG] THEN
		BEGIN
			DECR I FROM .ITMCT TO .LOWLIM DO
			IF .EXPR[ARG2PTR] EQL .GLOBREG[.I]<RIGHT> THEN
			BEGIN
				EXPR[ARG2PTR]_.CHOSEN[.I];
				!FOR DO LOOPS ONLY
				!PHASE 2 SKELETON WITH AOBJN DO
				!LOOP CONTROL WORD
				IF .SPECCASE EQL 2 THEN
					EXPR[A2IMMEDFLG]_1
				ELSE
				!GLOBAL ALLOCATION
				IF .SPECCASE EQL 1 THEN
				BEGIN
					IF .TOP[DOSYM] EQL .GLOBREG[.I]<RIGHT>
						AND .TOP[FLCWD] THEN
					EXPR[A2IMMEDFLG]_1;
					IF NOT .GLOBREG[.I]<ASGND4USED> THEN
					GLOBREG[.I]<USED4ASGND>_1;
					RETURN;
				END;
			END;
		END ELSE LEAFSUBSTITUTE(.EXPR[ARG2PTR]);
	END;

GLOBAL ROUTINE LEAFSUBSTITUTE(EXPR)=
BEGIN
	!PERFORM LEAF SUBSTITUTION OF ANY REFERENCES TO GLOBREG (A VECTOR LIST)
	!WITHIN EXPR. WITH THE CORRESPONDING ELEMENT IN THE VECTOR CHOSEN
	MAP PEXPRNODE EXPR;
	EXTERNAL CHOSEN,GLOBREG,LOKCALST,QQ;
	!CHOSEN & GLOBREG ARE USED BY OPTIMIZER ALGORITHMS. THEY ARE GLOBAL
	!AND ARE USED HERE (THOUGH INAPPROPRIATELY NAMED) AS A
	!SPACE SAVING DEVICE.
	!THIS ROUTINE IS ALSO USED TO SUBSTITUTE THE REGCONTENTS NODE
	!FOR THE DO INDUCTION VARIABLE ON INNER-MOST DO LOOPS.
	!QQ IS USED AS A FLAG IN THIS CONTEXT TO NOTE WHEN A FUNCTION
	!CALL HAS BEEN PROCESSED TO TERMINATE THE SUBSTITUTION.
	!NOTE THAT THE EXECUTION MAY DIFFER FROM THE OLD COMPILER
	!SINCE THE REMAINDER OF THE STATEMENT IN WHICH THE FUNCTION
	!REFERENCE EXISTS WILL STILL HAVE THE SUBSTITUTION. THIS
	!IS CONSISTENT WITH THE DEFINITION OF FORTRAN, HOWEVER.

	EXTERNAL SPECCASE;

IF .SPECCASE EQL 1 THEN		!GLOBAL REGISTER ALLOCATOR
	LOWLIM_0
ELSE
	LOWLIM_1;

CASE .EXPR[OPRCLS] OF SET
!BOOLEAN
BEGIN
	LOKA1(.EXPR);
	LOKA2(.EXPR);
END;

!DATAOPR
BEGIN
		LOOKANYWAY(.EXPR);
END;

!RELATIONAL
BEGIN
	LOKA1(.EXPR);
	LOKA2(.EXPR);
END;

!FNCALL
BEGIN
	LOCAL ARGUMENTLIST AG;
	AG_.EXPR[ARG2PTR];
	INCR I FROM .LOWLIM TO .ITMCT DO

	LOKCALST(.AG,.AG[ARGCOUNT],.GLOBREG[.I]<RIGHT>,.CHOSEN[.I]);
END;

!ARITHMETIC
BEGIN
	LOKA1(.EXPR);
	LOKA2(.EXPR);
END;

!TYPCNV
	LOKA2(.EXPR);

!ARRAYREF
	!IF SUBSCRIPT IS CONSTANT, ARG2PTR = 0 AND CAN'T SUBSTITUTE
	IF .EXPR [ARG2PTR] NEQ 0
	  THEN LOKA2 (.EXPR);

!CMNSUB
LOKA2(.EXPR);

!NEGNOT
LOKA2(.EXPR);

!SPECOP
LOKA1(.EXPR);

!FIELDREF
	BEGIN END;	!RELEASE GTR 1
!STORECLS
	BEGIN END;	!SHOULD NEVER SEE
!REGCONTENTS
	BEGIN END;	!DO NOTHING
!LABOP
	BEGIN END;	!SHOULD NEVER SEE
!STATEMENT
	BEGIN END;	!SHOULD NEVER SEE
!IOLCLS
	BEGIN END;	!HANDLED BY IOSUBSTITUTE
!INLINFN
	BEGIN
		LOKA1(.EXPR);
		IF .EXPR[ARG2PTR] NEQ 0 THEN
		LOKA2(.EXPR);
	END
TES;
END;


GLOBAL ROUTINE SWAPEM(VAR)=
BEGIN
	!LOOK THROUGH GLOBREG FOR VAR. IF
	!THERE RETURN CHOSEN ELSE JUST BACK WHAT YOU GOT

	EXTERNAL GLOBREG,CHOSEN,SPECCASE,ITMCT;

	INCR I FROM .LOWLIM TO .ITMCT DO
		IF .VAR EQL .GLOBREG[.I]<RIGHT> THEN
		BEGIN
			IF .SPECCASE EQL 1 THEN
				IF NOT .GLOBREG[.I]<ASGND4USED> THEN
					GLOBREG[.I]<USED4ASGND>_1;

			RETURN (.CHOSEN[.I]);
		END;

	.VAR
END;

GLOBAL ROUTINE MISCIO(STMT)=
BEGIN
	!STMT IS AN I/O STATEMENT.
	!THIS ROUTINE CHECKS IORECORD AND IOUNIT FIELDS FOR
	!REGISTERS TO SUBSTITUTE. THE USUAL SHEME APPLIES.
	!GLOBREG CONTIANS THE POINTER TO THE VARIABLE; CHOSEN
	!CONTAINS A POINTER TO THE REGCONTENTS NODE. ITMCT CONTAINS THE
	!NUMBER OF ITEMS IN THE LISTS GLOBREG AND CHOSEN.
	!SPECCASE IS A FLAG WHICH SAYS COUNT FROM 0 (GLOBAL ALLOCA)
	!OR COUNT FROM 1 (STATEMENT FUNCTIONS, LOCAL ALLOC).

	MAP BASE STMT;
	REGISTER BASE TMP;

	EXTERNAL GLOBREG,CHOSEN,ITMCT,SPECCASE;

	LOWLIM_(IF .SPECCASE EQL 1 THEN 0 ELSE 1);

		!IT COULD BE AN EXPRESSION
		IF .STMT[IORECORD] NEQ 0 THEN
		BEGIN
			TMP_.STMT[IORECORD];
			IF .TMP[OPRCLS] EQL DATAOPR THEN
				STMT[IORECORD]_SWAPEM(.TMP)
			ELSE
				LEAFSUBSTITUTE(.TMP);
		END;

		TMP_.STMT[IOUNIT];
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			STMT[IOUNIT]_SWAPEM(.STMT[IOUNIT])
		ELSE
			LEAFSUBSTITUTE(.STMT[IOUNIT]);
END;

GLOBAL ROUTINE DOVARSUBSTITUTE(CLSTCALL)=
BEGIN
	!TO PERFORM REGISTER SUBSTITUTIONS ON ALL FIELDS OF
	!A DO STATEMENT. USED BY IOSUBSTITUTE AND THE GLOBAL
	!REGISTER ALLOCATOR

	EXTERNAL ITMCT,GLOBREG,CHOSEN,SPECCASE,CDONODE;
	MAP BASE CLSTCALL:CDONODE;
	LOCAL BASE P:AOBDOSYM;
	LOWLIM_(IF .SPECCASE EQL 1 THEN 0 ELSE 1);

			P_.CLSTCALL[DOLPCTL];
			IF .P[OPRCLS] NEQ DATAOPR THEN
				LEAFSUBSTITUTE(.P)
			ELSE
				CLSTCALL[DOLPCTL]_SWAPEM(.P);

		%(***NOW TO SUBSTITUTE FOR THE INITIAL VALUE AND STEP
			SIZE FIELDS OF THE DO. IF WE ARE SUBSTITUTING
			A REGCONTENTS NODE THAT POINTS TO THE DO INDEX
			OF THE NEXT OUTER DO, AND THAT DO IS CONTROLLED
			WITH AN AOBJN, THEN MUST MAKE SURE TO SET THE
			APPROPRIATE IMMEDIATE FLAGS IN THIS DO, SO THAT
			CODE GENERATION WILL ONLY PICK UP THE RIGHT HALF
			OF THE AC***)%

		%(***FIRST, SET UP A TEMP THAT CONTAINS A POINTER TO
			THE OUTER DO'S INDEX VAR IF THE OUTER DO IS AN
			AOBJN DO, BUT IS 0 OTHERWISE***)%

		AOBDOSYM _ (IF .CDONODE[FLCWD] THEN .CDONODE[DOSYM]
							ELSE 0);

		P _ SWAPEM(.CLSTCALL[DOM1]);	!CHECK INITIAL VALUE

		IF .CLSTCALL[DOM1] NEQ .P	!IF REGCONTENTS FOUND
		THEN
		BEGIN
			IF .AOBDOSYM EQL .CLSTCALL[DOM1] THEN
				CLSTCALL[INITLIMMED]_1;
			CLSTCALL[DOM1]_.P;
		END;

		P _ SWAPEM(.CLSTCALL[DOSSIZE]);	!CHECK STEP SIZE

		IF .CLSTCALL[DOSSIZE] NEQ .P	!IF DOING SUBSTITUTION
		THEN
		BEGIN
			IF .AOBDOSYM EQL .CLSTCALL[DOSSIZE] THEN
				CLSTCALL[SSIZIMMED]_1;
			CLSTCALL[DOSSIZE]_.P;
		END;

		!IF WE ARE PROPAGATING (OR SUBSUMING) THEN
		!WE COULD ALSO CARE ABOUNT THE DO LOOP CONTROL VARIALE
		!ITSELF

		CLSTCALL[DOCTLVAR]_SWAPEM(.CLSTCALL[DOCTLVAR]);


	!TO TAKE CARE OF GLOBALLY ALLOCATED IMPLIED DOS
	IF .SPECCASE EQL 1 THEN
	BEGIN
		INCR I FROM .LOWLIM TO .ITMCT DO
		BEGIN
			IF .CLSTCALL[DOSYM] EQL .GLOBREG[.I]<RIGHT> THEN
			BEGIN
				P_.CHOSEN[.I];
				CLSTCALL[DOIREG]_.P[TARGTAC];
				CLSTCALL[IXGALLOCFLG]_1;
				IF .CLSTCALL[FLCWD] THEN
				BEGIN
					UNFLDO(.CLSTCALL);
					CLSTCALL[INITLIMMED]_1;
				END;
				IF NOT .GLOBREG[.I]<USED4ASGND> THEN
					GLOBREG[.I]<ASGND4USED>_1;
			END;
		END;
	END;
END;

GLOBAL ROUTINE IOSUBSTITUTE(CLSTCALL)=
BEGIN
	!TO SUBSTITUTE A REGCONTENTS NODE INTO AN I/O STATEMENT

	MAP BASE CLSTCALL;
	EXTERNAL GLOBREG,CHOSEN,ITMCT,SPECCASE,CSTMNT;
	EXTERNAL TOP,QQ,CDONODE;
	MAP BASE TOP:CDONODE:CSTMNT;
	EXTERNAL DOWDP;
	MAP OBJECTCODE DOWDP;
	LOCAL BASE P:TMP;


	!LOCAL ROUTINES TO HELP SHORTEN CODE

	ROUTINE IOCS(CSLST)=
	BEGIN
		!DO THE THING FOR ANY COMMON SUBS

		MAP BASE CSLST;

		WHILE .CSLST NEQ 0 DO
		BEGIN
			IF .CSLST[A2VALFLG] THEN
				CSLST[ARG2PTR]_SWAPEM(.CSLST[ARG2PTR])
			ELSE
				LEAFSUBSTITUTE(.CSLST[ARG2PTR]);

			CSLST_.CSLST[CLINK];
		END;
	END;


	ROUTINE E1ORE2(NOD)=
	BEGIN
		!DO COMMON PROCESSING FOR E1 OR E2 LISTS
		MAP BASE NOD;
		LOCAL BASE TMP:P;
		TMP_.NOD[ELSTPTR];
		WHILE .TMP NEQ 0 DO
		BEGIN
			P_.TMP[E2ARREFPTR];
			IF .P[OPRCLS] EQL DATAOPR THEN
				TMP[E2ARREFPTR]_SWAPEM(.P)
			ELSE
				LEAFSUBSTITUTE(.P);

			P_.TMP[E2INCR];
			IF .P NEQ 0 THEN
				IF .P[OPRCLS] EQL DATAOPR THEN
					TMP[E2INCR]_SWAPEM(.P)
				ELSE
					LEAFSUBSTITUTE(.P);

			TMP_.TMP[CLINK];
		END;

		TMP_.NOD[ECNTPTR];
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			NOD[ECNTPTR]_SWAPEM(.TMP)
		ELSE
			LEAFSUBSTITUTE(.TMP);

	END;

	LOWLIM_(IF .SPECCASE EQL 1 THEN 0 ELSE 1);
	IF .CLSTCALL[OPRCLS] EQL STATEMENT THEN
	BEGIN
		!WE ARE INTERESTED ONLY IF IT IS A DO
		IF .CLSTCALL[SRCID] EQL DOID THEN
		BEGIN
			DOVARSUBSTITUTE(.CLSTCALL);
		END ELSE
		!IT COULD BE AN ASSIGNMENT
		!THE CHEAPEST WAY (CODE SIZE) IS TO SAVE
		!CSTMNT AWAY, POINT IT AT THIS ASSIGNEMNT AND
		!LET LOOKANYWAY AND REPLACARG TAKE CARE OF THE
		!SUBSTITUTION
		IF .CLSTCALL[SRCID] EQL ASGNID THEN
		BEGIN
			TMP_.CSTMNT;
			CSTMNT_.CLSTCALL;
			LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
			LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
			CSTMNT_.TMP;
		END ELSE
		!ITS A CONTINUE STATEMENT
		RETURN
	END ELSE
	CASE .CLSTCALL[OPERSP] OF SET
	!DATACALL
	BEGIN
		P_.CLSTCALL[DCALLELEM];
		IF .P[OPRCLS] NEQ DATAOPR THEN
			LEAFSUBSTITUTE(.P)
		ELSE
			CLSTCALL[DCALLELEM]_SWAPEM(.P);
	END;
	!SLISTCALL
	BEGIN END;
	!IOLSTCALL
	BEGIN
		!LOOK THROUGH THE COMMON SUB-EXPRESSIONS
		!THEY WILL ONLY BE THERE IN THE GLOBAL
		!REGISTER ALLOCATION CASE WITH LOCAL CMNSUBS
		!ON THE I/O LISTS
		IOCS(.CLSTCALL[SRCCOMNSUB]);
		!NOW LOOK AT LIST ITSELF

		P_.CLSTCALL[IOLSTPTR];
		WHILE .P NEQ 0 DO
		BEGIN
			IOSUBSTITUTE(.P);
			P_.P[CLINK];
		END;
	END;

	!E1LISTCALL
	BEGIN
		IOCS(.CLSTCALL[SRCCOMNSUB]);
		E1ORE2(.CLSTCALL);


		TMP_.CLSTCALL[E1INCR];
		IF .TMP[OPRCLS] EQL DATAOPR THEN
			CLSTCALL[E1INCR]_SWAPEM(.TMP)
		ELSE
			LEAFSUBSTITUTE(.TMP);

	END;
	!E2LISTCALL
	BEGIN
		IOCS(.CLSTCALL[SRCCOMNSUB]);
		E1ORE2(.CLSTCALL);
	END;
	TES;
END;



GLOBAL ROUTINE CONTVAR(CNODE,VAR)=
%(***************************************************************************
	ROUTINE TO CHECK WHETHER THE EXPRESSION NODE CNODE CONTAINS THE VARIABLE
	VAR ANYWHERE UNDER IT.
***************************************************************************)%
BEGIN
	EXTERNAL CGERR,QQ;
	LOCAL PEXPRNODE ARGNODE;
	MAP PEXPRNODE CNODE;
	LOCAL ARGUMENTLIST ARGLST;

	%(***DEFINE MACRO TO CHECK BINARY NODES*****)%
	MACRO BINARYCHK=
	(CONTVAR(.CNODE[ARG1PTR],.VAR) OR CONTVAR(.CNODE[ARG2PTR],.VAR))$;

	%(*** DEFINE MACRO TO WALK LINKED LISTS FROM POINTER FIELD
		OF A IOLSCLS NODE QQ IS A GLOBAL USED
		AS A TEMP TO "SUM" THE LOGICAL VALUES***)%
	MACRO IOCHK=
	BEGIN
		WHILE .ARGNODE NEQ 0 DO
		BEGIN
			QQ_.QQ OR CONTVAR(.ARGNODE[DCALLELEM],.VAR);
			ARGNODE_.ARGNODE[CLINK];
		END;
	END$;

	DEBGNODETST(CNODE);	!FOR DEBUGGING ONLY, CHECK THAT CNODE IS NOT 0


	CASE .CNODE[OPRCLS] OF SET

	%(***FOR CNODE A BOOLEAN***)%
	RETURN BINARYCHK;

	%(***FOR DATA ITEM********)%
	RETURN (.CNODE EQL .VAR);

	%(***FOR RELATIONAL***)%
	RETURN BINARYCHK;

	%(***FUNCTION CALL***)%
	BEGIN
		%(***SEARCH THE ARG LIST***)%
		IF (ARGLST_.CNODE[ARG2PTR]) NEQ 0
		THEN
		BEGIN
			INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
			DO 
			BEGIN
				IF CONTVAR(.ARGLST[.CT,ARGNPTR],.VAR) THEN RETURN TRUE;
			END;
			RETURN FALSE
		END
	END;

	%(***FOR AN ARITHMETIC****)%
	RETURN BINARYCHK;

	%(***FOR A TYPECNV***)%
	RETURN CONTVAR(.CNODE[ARG2PTR],.VAR);

	%(***FOR AN ARRAYREF***)%
	BEGIN
		IF .CNODE[ARG2PTR] EQL 0 THEN RETURN (.CNODE[ARG1PTR] EQL .VAR)
		ELSE RETURN BINARYCHK
	END;

	%(***FOR A CMNSUB******)%
%[754]%	RETURN CONTVAR(.CNODE[ARG2PTR],.VAR);

	%(***FOR NEG/NOT***)%
	RETURN CONTVAR(.CNODE[ARG2PTR],.VAR);

	%(***FOR SPECIAL OPERATORS***)%
	RETURN CONTVAR(.CNODE[ARG1PTR],.VAR);


	%(***FOR  FIELD-REF - NOT IN RELEASE 1***)%
	CGERR();

	%(***FOR STORECLS***)%
	RETURN CONTVAR(.CNODE[ARG2PTR],.VAR);

	%(***FOR REGCONTENTS - VAR MAY BE THIS REGCONTENTS NODE***)%
	RETURN (.CNODE EQL .VAR);

	%(***FOR LABEL***)%
	RETURN FALSE;

	%(***SHOULD NOT ENCOUNTER A STATEMENT***)%
	CGERR();

	%(***FOR AN IOLIST-CLASS NODE ***)%
	CASE .CNODE[OPERSP] OF SET

	!DATACALL
		RETURN(CONTVAR(.CNODE[DCALLELEM],.VAR));

	!SLISTCALL
		RETURN(CONTVAR(.CNODE[SCALLELEM],.VAR) OR
			CONTVAR(.CNODE[SCALLCT],.VAR));

	!IOLSTCALL
	BEGIN
		QQ_0;
		ARGNODE_.CNODE[IOLSTPTR];
		IOCHK;
		RETURN(.QQ);
	END;

	!S1LISTCALL
	BEGIN
		QQ_0;
		ARGNODE_.CNODE[ELSTPTR];
		IOCHK;
		RETURN(.QQ OR CONTVAR(.CNODE[ECNTPTR],.VAR));
	END;

	!ELISTCALL
	BEGIN
		QQ_0;
		ARGNODE_.CNODE[ELSTPTR];
		WHILE .ARGNODE NEQ 0 DO
		BEGIN
			QQ_CONTVAR(.ARGNODE[E2INCR],.VAR) OR
			   CONTVAR(.ARGNODE[E2ARREFPTR],.VAR);
			ARGNODE_.ARGNODE[CLINK];
		END;
		RETURN(.QQ OR CONTVAR(.CNODE[ECNTPTR],.VAR));
	END;

	TES;

	%(***FOR AN IN-LINE FN***)%
	BEGIN
		IF .CNODE[ARG2PTR] EQL 0
		THEN RETURN (CONTVAR(.CNODE[ARG1PTR],.VAR))
		ELSE RETURN BINARYCHK
	END;

	TES;
END;


GLOBAL ROUTINE CONTFN(CNODE)=
%(***************************************************************************
	ROUTINE TO CHECK WHETHER THE EXPRESSION NODE CNODE CONTAINS ANY FUNCTION
	CALLS.
	RETURNS TRUE IF IT DOES.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;

	%(***DEFINE MACRO TO CHECK FOR EITHER SUBNODE OF A BINARY NODE***)%
	MACRO	BINARYCHK=
	(CONTFN(.CNODE[ARG1PTR]) OR CONTFN(.CNODE[ARG2PTR]) )$;

	CASE .CNODE[OPRCLS] OF SET

	%(**FOR A BOOLEAN***)%
	RETURN BINARYCHK;

	%(***FOR A DATA ITEM***)%
	RETURN FALSE;

	%(***FOR A RELATIONAL***)%
	RETURN BINARYCHK;

	%(***FOR A FN CALL***)%
	RETURN TRUE;

	%(***FOR AN ARITHMETIC***)%
	RETURN BINARYCHK;

	%(***FOR A TYPE CNV***)%
	RETURN CONTFN(.CNODE[ARG2PTR]);

	%(***FOR AN ARRAYREF***)%
	RETURN
	BEGIN
		IF .CNODE[ARG2PTR] NEQ 0 THEN CONTFN(.CNODE[ARG2PTR])
		ELSE 0
	END;

	%(***FOR A CMNSUB***)%
	RETURN FALSE;

	%(***FOR A NEG/NOT***)%
	RETURN CONTFN(.CNODE[ARG2PTR]);

	%(***FOR A SPECOP (P2MUL OR P2DIV) ***)%
	RETURN CONTFN(.CNODE[ARG1PTR]);

	TES;
END;


GLOBAL ROUTINE UNFLDO(DONODE)=
%(***************************************************************************
	ROUTINE TO CHANGE A DO-LOOP NODE FROM AN AOBJN LOOP TO A NON-AOBJN LOOP.
	THIS ROUTINE CAN ONLY BE CALLED AFTER THE DO-LOOP HAS BEEN EXPANDED BY
	THE SEMANTICS ROUTINE "DOXPN", AND BEFORE REGISTER ALLOCATION HAS BEEN
	PERFORMED FOR THE LOOP (BEFORE THE "COMPLEXITY" PASS.
	IT IS CALLED
		1. IN PHASE 1, WHEN THE LOOP INDEX IS FOUND TO BE REASSIGNED INSIDE THE LOOP
		2. IN PHASE 2 SKELETON, FOR AOBJN LOOPS IN WHICH THE CTL VAL
			IS TO LIVE IN A REGISTER, BUT IS THEN USED IN CONTEXTS THAT
			REQUIRE A WHOLE WORD VALUE (IOLISTS, COMPUTED GOTO)
***************************************************************************)%
BEGIN
	MAP PEXPRNODE DONODE;
	OWN PEXPRNODE CTLCONST;

	IF NOT .DONODE[FLCWD] THEN RETURN;	!IF THIS LOOP ISNT AOBJN, RETURN

	%(***THE CONTROL CONSTANT MUST BE SET TO THE LEFT HALF OF THE AOBJN CONST***)%
	CTLCONST_.DONODE[DOLPCTL];
	DONODE[DOLPCTL]_MAKECNST(INTEGER,0,
				-(ARITHSHIFT(.CTLCONST[CONST2],-18)) );
	DONODE[CTLNEG]_1;
	DONODE[CTLIMMED]_1;
	DONODE[SSIZONE]_1;

	DONODE[FLCWD]_0;
END;
GLOBAL ROUTINE ARGCONE(FNNODE)=
BEGIN
	!EXAMINE THE FUNCTION CALL NODE FNNODE. IF IT IS A 
	!REFERENCE TO A LIBRARY FUNCTION OF 1 ARGUMENT RETURN
	!TRUE ELSE RETURN FALSE.
	!USED IN DEFPT AND COMSUB

	MAP BASE FNNODE;
	REGISTER ARGUMENTLIST AG;

	IF .FNNODE[OPERSP] EQL LIBARY THEN
	BEGIN
		AG_.FNNODE[ARG2PTR];
		IF .AG[ARGCOUNT] EQL 1 THEN
			RETURN(.AG[1,AVALFLG]);
	END;
END;

GLOBAL ROUTINE LASTONE(WD)=
	BEGIN
		!EXAMINE CLOBBREGS TO DETERMINE WHICH REGS NEED TO
		!BE SAVED. FIND THE POSITION OF THE TRAILING ONE.
		!EXAMPLE:
		!	LET USE USE A SIX BIT VALUE OF WD OF 111011.
		!	BITCT INITIALLY BECOMES 3 (BITS NUMBER FROM
		!	LEFT TO RIGHT STARTING AT ZERO.
		!	IN THE UNTIL LOOP, THE FIRST VALUE OF
		!	T1 IS 100000. BITCT THEN BECOMES 4.
		!	THE LOOP TERMINATED SINCE WD^4 = 0. 4
		!	IS THE VALUE RETURNED.
		OWN T1,BITCT,OBIT;
		IF .WD EQL -1 THEN RETURN 13;
		!WD WILL REALLY NEVER BE -1 SINCE A MAX OF
		!13 BITS CAN BE SET IN IT FOR REGS 2-15.
		IF .WD EQL 0 THEN RETURN -1;
		BITCT_FIRSTONE(NOT .WD);
		UNTIL (T1_.WD^.BITCT) EQL 0 DO
		BEGIN
			OBIT_.BITCT;
			BITCT_FIRSTONE(NOT .T1) + .BITCT;
			IF .OBIT EQL .BITCT THEN
				BITCT_.BITCT+1;
		END;
		.BITCT-1
	END;

%[1006]%	GLOBAL ROUTINE  KISNGL(X,Y)=
![1006] ROUTINE TO ROUND UP SINGLE PRECISION FROM DOUBLE PRECISION
%[1006]%	BEGIN
%[1006]%		!X IS THE HIGH ORDER KI-10 CNSTANT, Y IS LOW ORDER WORD
%[1006]%		! Use CNSTCM for folding based on /GFLOATING
%[1006]%		EXTERNAL CNSTCM,C1H,C1L,C2H,C2L,COPRIX,KGFRL,KDPRL;
%[1006]%		C1H_.X;
%[1006]%		C1L_.Y;
%[1006]%		IF .GFLOAT
%[1006]%			THEN COPRIX_KGFRL
%[1006]%			ELSE COPRIX_KDPRL;
%[1006]%		CNSTCM();
%[1006]%		.C2H	! IS RETURNED
%[1006]%	END;

END
ELUDOM