Google
 

Trailing-Edge - PDP-10 Archives - BB-4157F-BM_1983 - fortran/compiler/util.bli
There are 13 other files named util.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

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

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

GLOBAL BIND UTILV = 7^24 + 0^18 + #1535;	! Version Date:	11-Jan-83


%(

***** 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.

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

1167	TFV	11-Jan-83	20-18247
	Fix CONTVAR code for E1/E2LISTCALLs and make it handle arrayrefs
	properly.

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

90	1210	DCE	6-Apr-81	-----
	For ELISTs, do regsubstitution into the assignment statements which
	set up final loop values.

91	1406	TFV	27-Oct-81	------
	Write   NEWDVAR   to   create   a   .Dnnnn   variable   for    a
	compile-time-constant character descriptor.  The entries are all
	linked together.  They have an  OPRCLS of DATAOPR and an  OPERSP
	of VARIABLE.  Either one word  (byte pointer only) or two  words
	(byte pointer  and  length)  are generated  based  on  the  flag
	IDGENLENFLG.  One word .Dnnnn variables are used for  SUBSTRINGs
	with constant lower bounds and non-constant upper bounds.

92	1431	CKS	15-Dec-81
	Add cases for substring and concatenation nodes to the tree walkers
	in LEAFSUBSTITUTE, CONTVAR, and CONTFN.

93	1440	SRM	16-Dec-81
	Fixed the CASE stmt in CONTFN to contain missing cases for:
	FIELDREF, STORECLS, REGCONTENTS, LABOP, STATEMENT, IOLSCLS

94	1406	CDM	18-Dec-81
	Moved routine NEWDVAR to SRCA.

1535	CDM	17-May-82
	Moved MAKLIT to here.
	Then moved it to SRCA!!

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

)%

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

FORWARD UNFLDO;

EXTERNAL
%1006%	C1H,
%1006%	C1L,
%1006%	C2H,
%1006%	C2L,
	CDONODE,
	CGERR,		! Error routine
	CHOSEN,
%1006%	CNSTCM,
%1006%	COPRIX,
%1274%	CORMAN,		! Core manager routine
	CSTMNT,		! Current statement being processed
	DOWDP,
	ENTRY,		!SYMBOL NAME FOR TABLE ROUTINES
	GLOBREG,
	ITMCT,
%1006%	KGFRL,
%1006%	KDPRL,
	LOKCALST,
	LOWLIM,		!GLOBAL REGISTER ALLOCATOR COUNTS FROM
			!	ZERO TO ITMCT.
			!OTHER USES COUNT FROM 1 TO ITMCT
	NEWENTRY,	!Makes new entry for symbol table
	NAME,		!SYMBOL TYPE FOR TABLE ROUTINES <GLOBAL>
			! (used by CORMAN for size of entry)
	QQ,
	REPLACARG,
	SKERR,		!STATEMENT ERROR
	SPECCASE,
	SYMTBL,		!THE SYMBOL TABLE
	THASH,		!COMPUTE HASH TABLE INDEX <SRCA>
	TOP;
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;


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


	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.


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


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;
!SUBSTRING
%1431%	BEGIN				
%1431%		REGISTER BASE A4;
%1431%		LOKA1(.EXPR);
%1431%		LOKA2(.EXPR);
%1431%		A4 _ .EXPR[ARG4PTR];
%1431%		IF .A4[OPRCLS] EQL ARRAYREF
%1431%		THEN IF .A4[ARG2PTR] NEQ 0
%1431%		     THEN LOKA2(.A4);
%1431%	END;
!CONCATENATION
%1431%	BEGIN END
TES;
END;
GLOBAL ROUTINE SWAPEM(VAR)=
BEGIN
	!LOOK THROUGH GLOBREG FOR VAR. IF
	!THERE RETURN CHOSEN ELSE JUST BACK WHAT YOU GOT


	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;


	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

	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;
	MAP BASE TOP:CDONODE:CSTMNT;
	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);
!**;[1207], IOSUBSTITUTE, DCE, 6-Apr-81
!**;[1207], Substitute into assignment statement(s) for final loop value(s)
%[1207]%	TMP_.CSTMNT;
%[1207]%	CSTMNT_.CLSTCALL[ELPFVLCHAIN];
%[1207]%	WHILE .CSTMNT NEQ 0 DO
%[1207]%	BEGIN
%[1207]%		LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
%[1207]%		LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
%[1207]%		CSTMNT_.CSTMNT[CLINK]
%[1207]%	END;
%[1207]%	CSTMNT_.TMP;

	END;
	!E2LISTCALL
	BEGIN
		IOCS(.CLSTCALL[SRCCOMNSUB]);
		E1ORE2(.CLSTCALL);
!**;[1207], IOSUBSTITUTE, DCE, 6-Apr-81
!**;[1207], Substitute into assignment statement(s) for final loop value(s)
%[1207]%	TMP_.CSTMNT;
%[1207]%	CSTMNT_.CLSTCALL[ELPFVLCHAIN];
%[1207]%	WHILE .CSTMNT NEQ 0 DO
%[1207]%	BEGIN
%[1207]%		LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
%[1207]%		LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
%[1207]%		CSTMNT_.CSTMNT[CLINK]
%[1207]%	END;
%[1207]%	CSTMNT_.TMP;
	END;
	TES;
END;
GLOBAL ROUTINE CONTVAR(CNODE,VAR)=
%(***************************************************************************
	ROUTINE TO CHECK WHETHER THE EXPRESSION NODE CNODE CONTAINS THE VARIABLE
	VAR ANYWHERE UNDER IT.
***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE ARGNODE;
	MAP PEXPRNODE CNODE;
	LOCAL ARGUMENTLIST ARGLST;

%1167%	MAP BASE VAR;

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

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

%1167%	! If var is an arrayref, use the arrayname

%1167%	IF .VAR[OPRCLS] EQL ARRAYREF
%1167%	THEN VAR = .VAR[ARG1PTR];

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

		WHILE .ARGNODE NEQ 0 DO
		BEGIN
			QQ_.QQ OR CONTVAR(.ARGNODE[DCALLELEM],.VAR);
			ARGNODE_.ARGNODE[CLINK];
		END;

		RETURN(.QQ);
	END;

	!E1LISTCALL
	BEGIN
		QQ_0;
		ARGNODE_.CNODE[ELSTPTR];

%1167%		WHILE .ARGNODE NEQ 0 DO
%1167%		BEGIN
%1167%			QQ = .QQ OR CONTVAR(.ARGNODE[E2ARREFPTR],.VAR);
%1167%			ARGNODE = .ARGNODE[CLINK];
%1167%		END;

		RETURN(.QQ OR CONTVAR(.CNODE[ECNTPTR],.VAR) OR
%1167%			CONTVAR(.CNODE[E1INCR],.VAR));
	END;

	!E2LISTCALL
	BEGIN
		QQ_0;
		ARGNODE_.CNODE[ELSTPTR];
		WHILE .ARGNODE NEQ 0 DO
		BEGIN
%1167%			QQ = .QQ OR 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;

%1431%	%(***FOR SUBSTRING***)%
%1431%	BEGIN
%1431%		IF CONTVAR(.CNODE[ARG1PTR],.VAR) THEN RETURN TRUE;
%1431%		IF CONTVAR(.CNODE[ARG2PTR],.VAR) THEN RETURN TRUE;
%1431%		IF CONTVAR(.CNODE[ARG4PTR],.VAR) THEN RETURN TRUE;
%1431%		RETURN FALSE;
%1431%	END;

	%(***FOR CONCATENATION***)%
	BEGIN 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
%1440%	ROUTINE FNINLIST( ARGNODE ) =
%1440%	! Routine walks a linked list of nodes checking for function calls
%1440%	BEGIN	! FNINLIST
%1440%
%1440%		MAP PEXPRNODE ARGNODE;
%1440%		REGISTER FNFOUND;		! TRUE iff FOUND a fncall
%1440%		FNFOUND = FALSE;
%1440%		WHILE .ARGNODE NEQ 0 DO
%1440%		BEGIN
%1440%			FNFOUND = .FNFOUND OR CONTFN( .ARGNODE );
%1440%			ARGNODE = .ARGNODE[ CLINK ];
%1440%		END;
%1440%		RETURN .FNFOUND;
%1440%	END;	! of FNINLIST

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

%1440%	%(***FOR FIELDREF - NOT SUPPORTED***)%
%1440%	CGERR();
%1440%
%1440%	%(***FOR STORECLS***)%
%1440%	RETURN CONTFN(.CNODE[ARG2PTR]);
%1440%
%1440%	%(***FOR REGCONTENTS***)%
%1440%	RETURN FALSE;
%1440%
%1440%	%(***FOR LABEL***)%
%1440%	RETURN FALSE;
%1440%
%1440%	%(***SHOULD NEVER BE CALLED FOR A STATEMENT***)%
%1440%	CGERR();
%1440%
%1440%	%(***FOR AN IOLIST-CLASS NODE***)%
%1440%	BEGIN	! IOLIST-class nodes
%1440%		CASE .CNODE[OPERSP] OF SET
%1440%
%1440%		!DATACALL
%1440%		RETURN CONTFN( .CNODE[ DCALLELEM ] );
%1440%		
%1440%		!SLISTCALL
%1440%		RETURN ( CONTFN( .CNODE[ SCALLELEM ] ) OR
%1440%			CONTFN( .CNODE[ SCALLCT ] ) );
%1440%
%1440%		!IOLSTCALL
%1440%		! Search the linked list of IOLSCLS nodes under this node
%1440%		RETURN FNINLIST(  .CNODE[IOLSTPTR] );
%1440%
%1440%		!E1LISTCALL
%1440%		! Search the linked list of array ref nodes
%1440%		RETURN FNINLIST ( .CNODE[ELSTPTR] );
%1440%
%1440%		!E2LISTCALL
%1440%		BEGIN	! E2LISTCALL
%1440%			REGISTER FNFOUND;
%1440%			REGISTER PEXPRNODE ARGNODE;
%1440%
%1440%			! Search the linked list of nodes that point
%1440%			!  to arrayrefs and counts. Only need to look
%1440%			!  at the ARRAYREFs.
%1440%			FNFOUND = FALSE;
%1440%			ARGNODE = .CNODE[ELSTPTR];
%1440%			WHILE .ARGNODE NEQ 0 DO
%1440%			BEGIN
%1440%				FNFOUND =.FNFOUND OR
%1440%					  CONTFN(.ARGNODE[E2ARREFPTR] );
%1440%				ARGNODE = .ARGNODE[ CLINK ];
%1440%			END;
%1440%			RETURN .FNFOUND;
%1440%		END;	! E2LISTCALL
%1440%
%1440%		TES;
%1440%	END;	!IOLIST-class nodes

%1431%	%(***FOR AN INLINE FN***)%
%1431%	BEGIN
%1431%		IF CONTFN(.CNODE[ARG1PTR]) THEN RETURN TRUE;
%1431%		IF .CNODE[ARG2PTR] NEQ 0
%1431%		THEN RETURN CONTFN(.CNODE[ARG2PTR])
%1431%		ELSE RETURN FALSE;
%1431%	END;

%1431%	%(***FOR SUBSTRING***)%
%1431%	BEGIN
%1431%		IF CONTFN(.CNODE[ARG1PTR]) THEN RETURN TRUE;
%1431%		IF CONTFN(.CNODE[ARG2PTR]) THEN RETURN TRUE;
%1431%		IF CONTFN(.CNODE[ARG4PTR]) THEN RETURN TRUE;
%1431%		RETURN FALSE;
%1431%	END;

%1431%	%(***FOR CONCATENATION***)%
%1431%	RETURN TRUE    ! (temp)

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