Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/doalc.bli
There are 12 other files named doalc.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/MD/DCE/JNG/TFV/AHM/TGS/MEM

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


GLOBAL BIND DOALCV = #11^24 + 0^18 + #4515;	! Version Date:	20-SEP-85

%(

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

95	-----	-----	PUT CHECK INTO "ALCDOS" SO THAT THE FN-VAL RETURN
			REGISTER WILL NEVER BE USED FOR A DO LOOP INDEX OR COUNT
96	-----	-----	FIX STCMSFN TO RESET NAME TO IDTAB PRIOR TO
			EACH CALL TO TBLSEARCH
97	-----	-----	CHANGE REFERENCES RO PROEPITYP AND PROGNAME
98	-----	-----	SET ENTNOCOPYFLG ON ENTRY ARGS THAT AR NOT
			FORMAL ARRAYNAMES AND HAVE NOALLOC SET
99	-----	-----	SET COMPLEXITY FIELD IN DO STMNTS
100	-----	-----	DO NOT ALLOCATE TEMP TO SAVE REG 16 IF REG
			16 WONT BE SAVED
101	-----	-----	IN "ASNFNVAL" - IF THIS STMNT IS TE LAST STMNT
			OF A DO LOOP, CANNOT TREAT IT AS ASSIGNMENT OF FN VAL
102	-----	------	IF A STMNT FN PARAM IS NEVER REFERENCED, DONT
				PICK IT UP (SET FLAG "ENTNOCOPYFLG")
103	-----	-----	DO NOT ALLOCATE A COMMON SUBEXPRESSION ON A DO STMNT
			TO THE REG THAT THE INDEX WILL GO INTO
104	-----	-----	THE TEST FOR ALLOCATING A DO LP CT
			SHOULD NOT BE INSIDE THE CONDITIONAL ON STEP SIZE
			ALSO, THE TEST FOR IMMED CNST SHOULD BE MADE
105	-----	-----	FOR STMNT FNS, SHOULD SET FTEMP TO NXTTTMP
			WHENEVER ANY QTEMPS HAVE BEEN USED
			IN THE PROGRAM AT ALL (CANNOT TELL THAT THIS SFN
			USED ANY QTEMPS SIMPLY BY SEEING IF THE VAL OF LSTLNK
			CHANGED- SINCE THE PREVIOUS SFN MIGHT HAVE
			CALLED NXTTMP AND THEN THIS SFN WILL SIMPLY
			USE THE QTEMP THAT WAS ALREADY CREATED)
106	323	16729	USE .A00NN FOR NAME OF TEMPORARY USED  TO SAVE
			REGISTERS IN PROLOGUE OF A FUNCTION, (MD)
107	332	17045	IN LPIXSUB PROPAGATE REGCONTENTS TO ASSIGN
			STATEMENTS WITH SUBSCRIPTED ARGUMENTS., (DCE)
108	426	18816	DON'T ALLOCATE TEMP STORAGE IN STMNT FN'S FOR
			DOUBLE PRECISION & COMPLEX PARAMETERS - IT
			DOESN'T SOLVE ANYTHING. SET FNCALLSFLG INSTEAD., (JNG)

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

109	726	28283	KA DOUBLE PRECISION AND COMPLEX REALLY DO
			NEED TO BE ALLOCATED (FIX EDIT 426), (DCE)

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

1163	TGS	1-Jul-82	20-17540
	If /DEBUG:INDEX was specified, bypass optimization that substitutes
	a regcontents node using the function return reg for the left hand side
	of an assignment statement to the function variable.

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

110	1245	TFV	3-Aug-81	------
	Redo ALCTEMP; it is now called ALCAVARS.  Have it allocate the
	.A variables and list them.

111	1274	TFV	20-Oct-81	------

	Fix ALCSFN  to  set LASTSFNQ  and  QSFNMAX so  that  the  .Qnnnn
	variables used by  statement functions are  not reused by  other
	statements.

112	1455	TFV	5-Jan-82	------
	Rewrite  STCMSFN  and  ALCSFN  to  handle  character   statement
	functions.  A character statement function is turned into either
	a call to CHSFN.  (the subroutine form of CHASN.)  or a call  to
	CHSFC.  (the subroutine form of CONCA.).  CHSFC.  is used if the
	character expression has concatenations at its top level, CHSFN.
	is used for all other character expressions.

1474	TFV	15-Mar-82
	Add  a  new  argument  to  CMPFNARGS.   Character  concatenation
	expressions also use  CMPFNARGS, the first  argument is not  yet
	allocated for concatenations so it must be ignored by CMPFNARGS.

1505	AHM	12-Mar-82
	Speed up the compiler by changing a LSH -3 followed by a LSH 6
	to a LSH 3 in macro TNAME in routine ALCAVARS.

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

1722	SRM	1-Feb-83	10-33235
	Always copy double precision args to statement functions.
	This is necessary if they are used in relationals.

1742	TFV	14-Apr-83
	Fix LPIXSUB to do  substitution of the  loop index variable  for
	all I/O statement keywords.

1774	CDM	29-Aug-83
	We were alocating a variable to  save register 16 in .A0016  for
	block data subprograms, which is not necessary.

2070	MEM	28-Aug-84
	Prevent extraneous copies of complex and double precision variables,
	that are not referenced. These extra copies of unreferenced variables
	may cause incorrect results in statement functions.

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

2206	TFV	27-Jun-83
	Add case to LPIXSUB for INQUIRE.  It calls MISCOCI a la OPEN/CLOSE.
	Also cleanup ALCAVAR so it uses less code.

2275	CDM	24-Jan-84
	Move  zeroing  of   DOWDP  from   routine  LPIXSUB   (substitute
	REGCONTENTS nodes for DO  induction variable) to routine  CMSTMN
	(complexity walk for  statements).  It was  being zeroed  before
	the complexity for the last statement  of the DO loop was  being
	processed.  This meant that it  was not known in the  processing
	of the last statement of a DO loop that the statement was in  an
	innermost DO loop.

2451	AHM	16-Aug-84
	Remove check from STCMSFN and STCMSUB which prevented them
	from setting ENTNOCOPYFLG on NOALLOC FORMLARRAY's.  This
	caused DMOVE/DMOVEM's to be generated for CHARACTER formals
	which would smash variables allocated to 1' (since unallocated
	two word descriptors have an address of 0').

2543	MEM	9-Aug-85
	Call VARCLOBB on DO variable at end of register allocation for a 
	DO LOOP.

***** End V10 Development *****
***** End Revision History *****
***** Begin Version 11 *****

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

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

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

4515	CDM	20-Sep-85
	Phase I for VMS long symbols.  Create routine ONEWPTR for Sixbit
	symbols.  For now, return what is passed it.  For phase II, return
	[1,,pointer to symbol].

ENDV11
)%

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;
SWITCHES LIST;
FORWARD
	STCMDO,
	ALCDOSTMT,
	ALCDOEND(1),
	STCMRETURN,
	ALCRETURN,
	HDRTMP,
	ALCAVARS,
	STCMSFN,
	ALCSFN,
	STCMSUB,
	LPIXSUB,
	ALCENTRY,
	ALCENLIST(1),	! Routine to determine which registers to use to
			! pick up the params of a function,  subroutine,
			! or statement function
	ARGSIZREST(1),
	FNVALCHK,
	FNVLCH1,
	ASNFNVAL;	! Routine to check whether the statement pointed
			! to by cstmnt  assigns the  function value  and
			! directly precedes a return

EXTERNAL
	ADDREGCANDATE,	! Routine  to  tell  the  basic  block  register
			! allocator that the value  of a given  variable
			! can be left in a register.
	AFREEREG,	! Routine to select  a free register  to use  if
			! possible.  It will  not select  a register  of
			! future use in this basic block.
	ALCASMNT,	! Routine to do register allocation for an assignment
%1455%	ALCCALL,	! Routine to do register allocation for a call
	ALCCMNSB,
	ALCINREG,
	ALOCONST,
	CDONODE,
	CGERR,		! Routine for internal compiler error detected
	CHOSEN,
	CLOBBREGS,	! Global containing  a  bit  pattern  indicating
			! which  registers   are   clobbered   in   this
			! subroutine (a bit  is 1  if the  corresponding
			! register gets clobbered)
%1455%	CMPFNARGS,	! Routine to find complexity of function arguments
	CORMAN,
	CSTMNT,
	DBLMODE,
	OBJECTCODE DOWDP,
	ENTRY,
	FNTMP,
	GBSYCT,
	GBSYREGS,
	GLOBREG,
	HDRFLG,
%1245%	HEADCHK,	! Routine to check the amount of space left on a
			! listing page
	ITMCT,
	IOSUBSTITUTE,
	LASTONE,
%1274%	LASTQ,		! Pointer to the  last .Qnnnn  variable used  by
			! the current statement.
%1274%	LASTSFNQ,	! Pointer to the  last .Qnnnn  variable used  by
			! statement  functions.  The  .Qnnnn   variables
			! between QANCHOR and LASTSFNQ can not be reused
			! by other statements.
	LEAFSUBSTITUTE,
%1245%	LISTSYM,	! Routine to list a symbol in the listing
	LOWLOC,
%1245%	LSTHDR,		! Routine to output a header to the listing
%1245%	LSTOUT,
	MAKEPR,
	MAKRC0,		! Routine to build a regcontents 0 node
	MISCIO,
%1742%	MISCOCI,	! Do register subs for OPEN/CLOSE/INQUIRE statements
%4515%	ONEWPTR,	! Returns [1,,pointer] to Sixbit argument
	NAME,
	PREV,
	PROGNAME,
%1274%	QMAX,		! Maximum size of .Q space for all statements
	QQ,
%1274%	QSFNMAX,	! Maximum size  of .Q  space used  by  statement
			! functions.
	REGCLOBB,	! Routine to tell the basic block allocator that
			! the  previous  contents  of  a  register   are
			! clobbered
	RGTOU1,
	SAVEREG,	! Routine to remember that  a given variable  is
			! in a given register
	SETCOMPLEXITY,
	SORCPTR,
	SPECCASE,
	SSIZTMP,
	STBSYR,		! Bit pattern  indicating  which  registers  are
			! legal to use for this statement
	STCMASMNT,
	STCMCSB,
	STRGCT,
	SYMTYPE,
	TBLSEARCH,
%1245%	TCNT,
	TREEPTR,
%2543%	VARCLOBB;

GLOBAL
	ASVCT,		! Number of  assignment statements  that  assign
			! the  value  of  this  function  and   directly
			! precede a return statement.
	RETNCT;		! Number of return statements in the program
GLOBAL ROUTINE STCMDO=
BEGIN
	!PERFORM COMPLEXITY CALCULATIONS FOR DO LOOP
	!THE GLOBAL CSTMNT POINTS AT THE ENCODED SOURCE FOR THE
	!DO STATEMENT.

	MAP BASE CSTMNT;

	OWN
		PEXPRNODE IXSYM,
		PEXPRNODE DOCTL,
		PEXPRNODE PEXPR,
		PEXPRNODE DOINITL,
		PEXPRNODE DOSTEPSIZ;

	DOSTEPSIZ_.CSTMNT[DOSSIZE];
	IXSYM_.CSTMNT[DOSYM];
	DOCTL_.CSTMNT[DOLPCTL];
	DOINITL_.CSTMNT[DOM1];

	%(***FOR AN AOBJN LOOP, ALLOCATE CORE FOR THE AOBJN CONSTANT***)%
	IF .CSTMNT[FLCWD] THEN ALOCONST(.CSTMNT[DOLPCTL])
	ELSE
	BEGIN
		IF .DOCTL[OPRCLS] NEQ DATAOPR THEN
		BEGIN
			TREEPTR_.DOCTL;
			CSTMNT[SRCCMPLX]_SETCOMPLEXITY()
				+ (IF .IXSYM[DBLFLG]
				   THEN 2	!2 REGS USED FOR DP INDEX
				  ELSE 1);	!1 REG FOR INDEX OTHERWISE

		END;

		%(***IF THE INITIAL VAL IS A CONSTANT DECIDE WHETHER TO TREAT IT IMMED
			OR TO ALLOCATE CORE FOR IT***)%
		IF .DOINITL[OPR1] EQL CONSTFL
		THEN
		BEGIN
			IF IMMEDCNST(DOINITL)
			THEN
			%(***IF INTIAL VAL IS AN IMMEDIATE SIZE CONSTANT***)%
			BEGIN
				IF .DOINITL[VALTP1] EQL INTEG1 AND .DOINITL[CONST2] LSS 0
				THEN
				%(***FOR NEGATIVE INTEGERS - TO HANDLE IMMED MODE, MUST
					USE THE ABSOLUTE VAL PICKED UP NEGATED***)%
				BEGIN
					CSTMNT[INITLNEG]_1;
					CSTMNT[DOM1]_MAKECNST(.DOINITL[VALTYPE],0,-.DOINITL[CONST2]);
				END;
				CSTMNT[INITLIMMED]_1;
			END
			ELSE
			%(***IF INITIAL VAL IS A CONSTANT NOT IMMED, ALLOCATE CORE FOR IT***)%
			ALOCONST(.DOINITL);
		END;

		%(***IF THE STEP SIZE IS A CONSTANT, DECIDE WHETHERTO USE IT IMMED OR ALLOCATE CORE
			FOR IT*****)%
		IF .DOSTEPSIZ[OPR1] EQL CONSTFL AND (NOT .CSTMNT[SSIZONE]
		OR .DOSTEPSIZ[VALTYPE] EQL DOUBLPREC)
		THEN
		BEGIN
			IF IMMEDCNST(DOSTEPSIZ)
			THEN
			BEGIN
				IF .DOSTEPSIZ[VALTP1] EQL INTEG1 AND .DOSTEPSIZ[CONST2] LSS 0
				THEN
				BEGIN
					CSTMNT[SSIZNEGFLG]_1;
					CSTMNT[DOSSIZE]_MAKECNST(.DOSTEPSIZ[VALTYPE],0,-.DOSTEPSIZ[CONST2]);
				END;
				CSTMNT[SSIZIMMED]_1;
			END
			ELSE
			ALOCONST(.DOSTEPSIZ);
		END;


		%(***IF THE CONTROL EXPR IS A CONSTANT, NOT IMMEDIATE SIZE,
			ALLOCATE CORE FOR IT***)%
		IF .DOCTL[OPR1] EQL CONSTFL
		THEN
		BEGIN
			IF IMMEDCNST(DOCTL)
			THEN
			BEGIN
				 CSTMNT[CTLIMMED]_1;
				IF .DOCTL[CONST2] LSS 0		!FOR NEG IMMED
				THEN
				BEGIN
					CSTMNT[CTLNEG]_NOT .CSTMNT[CTLNEG];
					!USE MOVNI OF THE POSITIVE CONST
					CSTMNT[DOLPCTL]_MAKECNST(.DOCTL[VALTYPE],0,-.DOCTL[CONST2]);
					DOCTL_.CSTMNT[DOLPCTL];
				END;
			END
			ELSE ALOCONST(.DOCTL)
		END;
	END;




	!MAKE EXTRA SURE THAT NEDSMATRLZ IS SET IF THE DO LOOP
	!INDEX IS A DOUBLE WORD QUANTITY.
	PEXPR_.CSTMNT[DOSYM];
	IF .PEXPR[DBLFLG] THEN CSTMNT[NEDSMATRLZ]_1;


	!COMPUTE COMPLEXITY OF COMMON SUB-EXPRESSIONS
	STCMCSB();


	!DEFINE THE REG TO BE USED FOR THE LOOP INDEX. THIS MAY BE CHANGED
	! BY THE GLOBAL ALLOCATOR (MUST SPECIFY IT HERE SO CAN SUBSTITUTE
	! REGCONTENTS NODES FOR REFS TO THE VAR)
	CSTMNT[DOIREG]_DOIXREG;


	!IF THE LOOP INDEX OF THIS LOOP WILL LIVE IN A REGISTER, SET A GLOBAL
	! TO ENABLE SUBSTITUTION OF "REGCONTENTS" NODES FOR ALL OCCURRENCES OF
	! THAT INDEX INSIDE OF THE LOOP
	IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY] THEN
	BEGIN
		!SET UP VARIABLES AND FIELDS NECESSARY FOR
		!SUBSTITUTION OF REGCONTENTS NODES.
		CDONODE_.CSTMNT;
		DOWDP[DOREGPTR]_.CSTMNT[DOIREG];
		PEXPR_MAKEPR(REGCONTENTS,0,INDEX,0,.CSTMNT[DOSYM]);
		PEXPR[INREGFLG]_1;
		PEXPR[TARGADDR]_.DOWDP[DOREGPTR];
		PEXPR[TARGTAC]_.DOWDP[DOREGPTR];
		DOWDP[DOREGPTR]_.PEXPR;
		IF .CSTMNT[FLCWD] THEN
		BEGIN
			SPECCASE_2;	!THIS FLAG TELLS "LEAFSUB" TO SET THE
					! IMMEDFLG ABOVE THE REGISTER SUBSTITUTED FOR LOOP INDEX
			PEXPR[VALTYPE]_INDEX;
		END ELSE
		BEGIN
			SPECCASE_0;	!IF "FLCWD" WAS NOT SET IN THE DO NODE, DO
					! NOT WANT TO SET IMMEDFLG OVER REFS TO LOOP INDEX
			DOSTEPSIZ_.CSTMNT[DOSYM];
			PEXPR[VALTYPE]_.DOSTEPSIZ[VALTYPE];
		END;
	END

END;	! of STCMDO
GLOBAL ROUTINE ALCDOSTMT=
BEGIN
	REGISTER PEXPRNODE IXSYM;	!SYM TAB ENTRY FOR LOOP INDEX

	MAP
		PEXPRNODE CSTMNT,
		PEXPRNODE TREEPTR;

	!REGISTER ALLOCATION FOR A DO STATEMENT
	!CSTMNT: POINTS AT DO STATEMENT
	LOCAL SSIZPT;
	LOCAL PEXPRNODE DOCEXPR;
	MAP BASE SSIZPT;


	!DONT USE THE FN RETURN REG FOR THE IX OR CT OF A DO LOOP
	STBSYR_REMRETREG(.STBSYR);
	STRGCT_ONESCOUNT(.STBSYR);



	IXSYM_.CSTMNT[DOSYM];	!PTR TO SYM TAB ENTRY FOR LP IX

	IF NOT BITSET(.STBSYR,.CSTMNT[DOIREG])	!IF THE REG PREVIOUSLY ASSIGNED
							! TO BE USED FOR THE LOOP INDEX IS NOT AVAILABLE
		AND NOT .CSTMNT[IXGALLOCFLG]	! AND THAT REG WAS NOT ASSIGNED BY THE GLOBAL REG ALLOCATOR
	THEN
	BEGIN
		IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY]	!IF HAVE ALREADY
							! SUBSTITUTED REGCONTENTS NODES FOR THE LOOP INDEX
		THEN CGERR();	! HAVE AN INTERNAL COMPILER ERROR

		CSTMNT[DOIREG]_		!PICK ANOTHER REG TO USE
			AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.IXSYM[DBLFLG])
	END;


	!ALLOCATE COMMON SUB-EXPRESSIONS FIRST
	IF BITSET(.STBSYR,.CSTMNT[DOIREG])	!DO NOT WANT TO LEAVE A COMMON
	THEN					! SUB IN THE REG TO BE USED FOR THE LOOP INDEX
	BEGIN
		STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]);	!TAKE THAT REG OUT OF
		STRGCT_.STRGCT-1;			! THE SET OF AVAILABLE REGS TEMPORARILY
		ALCCMNSB();
		STBSYR_SETBIT(.STBSYR,.CSTMNT[DOIREG]);	!THEN PUT IT BAK (MAY HAVE TAKEN
							!  SOME OTHERS OUT IN THE MEANTIME)
		STRGCT_.STRGCT+1;
	END
	ELSE	!IF THAT REG WAS UNAVAILABLE ANY WAY (BECAUSE IT WAS GLOBALLY ALLOCATED)
	ALCCMNSB();


	%(***GET PTR TO EXPRESSION FOR LOOP CTL CT***)%
	DOCEXPR_.CSTMNT[DOLPCTL];

	TREEPTR_.DOCEXPR;

	CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOIREG]);	!THE REG TO BE USED FOR THE LOOP INDEX
					! WAS DETERMINED PREVIOUSLY (EITHER BY THE GLOBAL ALLOCATOR
					! OR IN COMPLEXITY PASS). SET BIT INDICATING THAT THAT
					! REG HAS BEEN CLOBBERED
	IF .IXSYM[DBLFLG]	!IF INDEX TAKES 2 REGS
	THEN CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOIREG]+1);


	IF .CSTMNT[FLCWD] THEN		!NICE AOBJN CASE
	CSTMNT[DOCREG]_.CSTMNT[DOIREG]
	ELSE
	!PERFORM ALLOCATION FOR THE CALCULATION OF THE LOOP CTL COUNT
	BEGIN
		REGISTER RA; !REG TO USE FOR LOOP CTL
		STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]);	!DO NOT USE THE REG CONTAINING THE
							! THE LOOP INDEX IN CALCULATING THE CTL COUNT
		IF .IXSYM[DBLFLG]	!IF INDEX TAKES 2 REGS
		THEN STBSYR_CLRBIT(.STBSYR,.CSTMNT[DOIREG]+1);

		IF .CSTMNT[IXGALLOCFLG]		!IF THE GLOBAL OPTIMIZER HAS DECIDED TO
						! LEAVE THE INDEX OF THIS LOOP IN A REG
			AND NOT .CSTMNT[MATRLZCTLONLY]	! AND HAS ALSO DECIDED TO LEAVE THE CTL-COUNT
						! IN A REG THROUGHOUT THE LOOP
		THEN STBSYR_CLRBIT(.STBSYR,DOIXREG);	! DO NOT PUT THE COUNT INTO THE
						! REG THAT WILL BE USED FOR THE INDICES OF THE INNER DO LOOPS


		RA_AFREEREG(.STBSYR,FALSE,FALSE);	!GET A REG TO USE FOR THE CTL COUNT
		IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN
		BEGIN
			ALCINREG(.RA,.STBSYR,.STRGCT-1);

			%(***IF POSSIBLE USE THE SAME REG INTO WHICH THE CTL EXPR
				WAS CALCULATED FOR THE LOOP CTL REG***)%
			IF .DOCEXPR[INREGFLG] AND NOT .DOCEXPR[ALCRETREGFLG]
			THEN
			BEGIN
				CSTMNT[DOCREG]_.DOCEXPR[TARGTAC];
				CSTMNT[CTLSAMEFLG]_1;
			END
			ELSE
			BEGIN
				RA_RGTOU1(.CSTMNT,.DOCEXPR,.RA,.STBSYR);
				CSTMNT[DOCREG]_.RA;
			END
		END ELSE
			CSTMNT[DOCREG]_.RA;

		!MAKE SURE THE STEP CONSTANT IS ALLOCATED
		SSIZPT_.CSTMNT[DOSSIZE];
		IF .SSIZPT[OPR1] EQL CONSTFL THEN
				ALOCONST(.SSIZPT);
		CLOBBREGS_SETBIT(.CLOBBREGS,.CSTMNT[DOCREG]);
	END;


	%(***IF EITHER LOOP INDEX OR CTL VAR WILL BE MAINTAINED IN A REG THROUGHOUT THE
		THE LOOP, TAKE THOSE REGS OUT OF THE SET OF FREE REGS***)%
	IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZIXONLY]	!IF LP INDEX IS IN A REG
	 THEN
	BEGIN
		REGISTER RI;	!REG USED FOR THE LOOP INDEX
		RI_.CSTMNT[DOIREG];		!REG USED TO HOLD THE  INDEX
		GBSYREGS_CLRBIT(.GBSYREGS,.RI);	!TAKE LOOP INDEX REG OUT OF SET 

						!AVAILABLE FOR LOCAL USE

		IF .IXSYM[DBLFLG] THEN		!IF IX IS DOUBLE-WD, MUST TAKE OUT
		GBSYREGS_CLRBIT(.GBSYREGS,.RI+1); !NEXT REG ALSO

	END;

	IF NOT .CSTMNT[NEDSMATRLZ] AND NOT .CSTMNT[MATRLZCTLONLY]	!IF CTL VAR IN A REG
	THEN
	GBSYREGS_CLRBIT(.GBSYREGS,.CSTMNT[DOCREG]);	!TAKE OUT REG USED FOR LOOP CTL

	GBSYCT_ONESCOUNT(.GBSYREGS);

END;	! of ALCDOSTMT
GLOBAL ROUTINE ALCDOEND(TLAB)=
BEGIN

	!RETURN REGISTER TO GBSYREGS IF WE ARE ENDING AN INNER DO

	OWN PEXPRNODE DOVAR;		!LOOP INDEX VARIABLE
	OWN RA;				!REG USED TO HOLD LOOP INDEX VAR
	REGISTER TMP,CURDO;
	MAP BASE TLAB:CURDO:TMP;

	IF .TLAB[SNDOLVL] EQL 0 THEN RETURN;	!NO DO'S END HERE

	TMP_.TLAB[SNDOLNK];
	CURDO_.TMP[LEFTP];		!THIS POINTS AT FIRST DO IN LIST

	IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZIXONLY]	!IF LOOP INDEX WAS MAINTAINED IN A REG
	THEN				!RETURN THAT REG TO SET OF FREE REGS
	BEGIN
		DOVAR_.CURDO[DOSYM];	!LOOP INDEX VARIABLE
		RA_.CURDO[DOIREG];		!REG USED TO HOLD LOOP INDEX VAR
		GBSYREGS_SETBIT(.GBSYREGS,.RA);		!RETURN THIS REG TO SET OF AVAILABLE REGS
		IF .DOVAR[DBLFLG]	!FOR LOOP INDEX DP, MUST RETURN THE REG AFTER RA
		THEN			! TO THE SET OF FREE REGS
		GBSYREGS_SETBIT(.GBSYREGS,.RA+1);

	END;

	IF NOT .CURDO[NEDSMATRLZ] AND NOT .CURDO[MATRLZCTLONLY]	!IF CTL VAR WAS IN A REG THROUGHOUT
						! THE LOOP, RETURN THAT REG TO SET OF FREE REGS
	THEN
	 GBSYREGS_SETBIT(.GBSYREGS,.CURDO[DOCREG]);	

	GBSYCT_ONESCOUNT(.GBSYREGS);


	%(***FOR ALL LOOPS THAT END ON THIS LABEL, MUST TELL THE BB ALLOCATOR
		THAT THE REGS USED FOR CALCULATING THE LP INDEX AND THE  LP CT GET
		THEIR PREVIOUS CONTENTS CLOBBERED***)%
	UNTIL .TMP EQL 0	!WALK THRU LINKED LIST OF DO STMNTS THAT TERMINATE ON THIS LABEL
	DO
	BEGIN
		CURDO_.TMP[LEFTP];	!DO STMNT POINTED TO BY THIS ELEM IN LINKED LIST
					! OF DO STMNTS THAT END ON THIS LABEL
		REGCLOBB(.CURDO[DOCREG]);	!REG USED FOR LP CT
		REGCLOBB(.CURDO[DOIREG]);	!REG USED FOR LP IX
		DOVAR_.CURDO[DOSYM];	!VAR USED FOR LP INDEX
		IF .DOVAR[DBLFLG]	!IF LP INDEX IS DP OR COMPLEX
		THEN REGCLOBB(.CURDO[DOIREG]+1);
%2543%		IF NOT .DOVAR[MAYBEZTRIP]
%2543%		THEN VARCLOBB(.DOVAR);
		TMP_.TMP[RIGHTP];	!GO ON TO NEXT LINK IN LIST
	END;

END;	! of ALCDOEND
GLOBAL ROUTINE STCMRETURN=
BEGIN
	!DETERMINE COMPLEXITY FOR A RETURN EXPRESSION
	MAP BASE CSTMNT:TREEPTR;
	REGISTER BASE NXTSTMN;	!NEXT STMNT AFTER THE RETURN

	%(***KEEP A COUNT OF "RETURN" STMNTS. DO NOT COUNT A RETURN THAT PRECEDES THE END STMNT**)%

	NXTSTMN_.CSTMNT[SRCLINK];
	IF .NXTSTMN EQL 0 THEN RETNCT_.RETNCT+1
	ELSE
	%(**SKIP OVER THE CONTINUE INSERTED BY THE OPTIMIZER AT THE END OF THE PROGRAM**)%
	IF .NXTSTMN[SRCID] EQL CONTID AND .NXTSTMN[OPTCONFLG]
	THEN
	BEGIN
		 NXTSTMN_.NXTSTMN[SRCLINK];	
		IF .NXTSTMN[SRCID] NEQ ENDID THEN RETNCT_.RETNCT+1
	END

	ELSE IF .NXTSTMN[SRCID] NEQ ENDID THEN RETNCT_.RETNCT+1;

	!IF THERE IS NO EXPRESSION COMPLEXITY IS ZERO

	IF .CSTMNT[RETEXPR] EQL 0 THEN
		CSTMNT[SRCCMPLX]_0
	ELSE
	BEGIN
		TREEPTR_.CSTMNT[RETEXPR];
		CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
	END;
	!IF ITS A SIMPLE CONSTANT ALLOCATE IT.
	!THIS WILL CAUSE BAD CODE
	!BUT IS EXPEDIENT
	IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);

END;	! of STCMRETURN
GLOBAL ROUTINE ALCRETURN=
BEGIN
	!
	!REGISTER ALLOCATION FOR A RETURN I
	LOCAL RA;
	MAP PEXPRNODE TREEPTR:CSTMNT;


	IF .CSTMNT[RETEXPR] EQL 0 THEN RETURN;
	TREEPTR_.CSTMNT[RETEXPR];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR THEN
	BEGIN
		RA_FIRSTONE(.STBSYR);
		ALCINREG(.RA,.STBSYR,.STRGCT);
	END;

END;	! of ALCRETURN
ROUTINE HDRTMP=
LSTHDR(4,3,PLIT'?M?JTEMPORARIES?M?J?M?J?0');
GLOBAL ROUTINE ALCAVARS=
BEGIN

%1245%	! Rewritten by TFV on 3-Aug-81

	! Allocate temporaries needed for register save and restore if
	! this is a subprogram function

	ROUTINE ALCA(I)=
	BEGIN
%2206%		REGISTER BASE T;

%2206%		! Define .A00NN temp name to  save the register used  in
%2206%		! the function, where "nn" comes from the argument I.
	
%4515%		ENTRY = ONEWPTR(
%2206%			(SIXBIT '.A0000' OR
%1505%			((.I AND #70)^3) OR
%2206%			((.I AND #7))) );

%2206%		T = TBLSEARCH();	! Get symbol table pointer

		T[IDADDR] = .LOWLOC;	! Allocate one word for .Annnn variable
		LOWLOC = .LOWLOC + 1;
		IF .FLGREG<LISTING>
		THEN
		BEGIN	! List .Annnn variable

			IF .HDRFLG EQL 0
			THEN
			BEGIN	! Output header

				HDRFLG = 1;
				HDRTMP();

			END;	! Output header

			LISTSYM(.T);	! List .Annnn variable
 
			TCNT = .TCNT + 1;

			IF .TCNT GTR 5
			THEN
			BEGIN	! Output CRLF after 5 items

				TCNT = 0;
				CRLF;
				HEADCHK();

			END;	! Output CRLF after 5 items

		END;	! List .Annnn variable
	END;

	! The following code involves saving register values.  If we are
	! not compiling  a  SUBROUTINE or  FUNCTION,  then this  is  not
	! necessary.

	IF .FLGREG<PROGTYP> EQL MAPROG
%1774%		OR .FLGREG<PROGTYP> EQL BKPROG
	THEN RETURN;

	! It is a subprogram  so generate a temporary  for AC16 if  AC16
	! must be  preserved.   Set  symtype  so  that  all  the  .Annnn
	! variables will be a single word.

	SYMTYPE = REAL;
	NAME = IDTAB;

	IF NOT (.BTTMSTFNFLG AND .IOFIRST EQL 0 AND NOT .LIBARITHFLG)
%2206%	THEN ALCA(#16);		! Allocate and list .A0016 variable

	! If multiple entry points then generate a temporary to hold the
	! epilogue address

	IF .FLGREG<MULTENT>
%2206%	THEN ALCA(#17);		! Allocate and list .A0017 variable

	! If  it  is  a  function  then  generate  temporaries  to  save
	! clobbered registers.  Determine how  many and which  registers
	! must be saved by examining CLOBBREGS.

	IF .FLGREG<PROGTYP> EQL FNPROG
%2206%	THEN DECR I FROM LASTONE(.CLOBBREGS) TO 2
%2206%	DO ALCA(.I);		! Allocate and list .Annnn variable

END;	! of ALCAVARS
GLOBAL ROUTINE STCMSFN=
BEGIN

%1455%	! Rewritten by TFV on 5-Jan-82

	! Compute complexity  of  a  statement  function  plus  lots  of
	! subterfuge.  Items of subterfuge include:
	!	1. Substitute a new  variable for each formal.   This is
	!	   done  to   eliminate  confusion   between   statement
	!	   function formals and routine locals of the same name.
	!	2. For  numeric  statement  functions, change  the  slot
	!	   holding the pointer to the expression into a  pointer
	!	   to an assignment statement of the statement  function
	!	   name to the expression.
	!	3. For character  statement functions,  change the  slot
	!	   holding the pointer to the expression into a  pointer
	!	   to a call statement.  It  is either a call to  CHSFN.
	!	   (the subroutine form of CHASN.)  or a call to  CHSFC.
	!	   (the subroutine form of CONCA.).  CHSFC.  is used  if
	!	   the character  expression has  concatenations at  its
	!	   top level,  CHSFN. is  used for  all other  character
	!	   expressions.


%1474%	BIND NOTINCONCAT = FALSE;	! Flag for CMPFNARGS.  It  means
					! that the  first argument  must
					! be processed.

	REGISTER
		NAMER,
		OCSTMNT,
		T;

	LOCAL BASE FNID;	! The identifier name for this function

	OWN BASE COPYARGS;	! Used to determine  if local copies  of
				! the arguments are needed

	MAP
		BASE OCSTMNT,
		ARGUMENTLIST T,
		BASE QQ,	! Convenient temporary
		BASE PREV,	! Convenient temporary
		BASE CSTMNT;

	T = .CSTMNT[SFNLIST];		! Get the argument list
	FNID = .CSTMNT[SFNNAME];	! Get the statement function name

	DECR I FROM .T[ARGCOUNT] TO 1 DO
	BEGIN
		PREV = .T[.I,ARGNPTR];	! Get the argument

		! Add the parameter to the set of variables that can  be
		! left in registers if needed in registers later.

		ADDREGCANDATE(.PREV,.CSTMNT);

		! Init  to  0  the  flag  for  parameter  was   globally
		! allocated (this bit is sometimes left set by phase 1)

		T[.I,ENTGALLOCFLG] = 0;
	END;

	OCSTMNT = .CSTMNT;		! Save pointer to current statement
	CSTMNT = .CSTMNT[SFNEXPR];	! Point cstmnt to assignment  or
					! call node

	IF .FNID[VALTYPE] NEQ CHARACTER
	THEN
	BEGIN	! Numeric statement function

		! Examine the assignment statement of the form SFNNAME =
		! EXPRESSSION. Compute complexity of assignment.

		PREV = .CSTMNT[LHEXP];

		! Insert a regcontents  zero node and  mark the  current
		! statement and the assignment node

		CSTMNT[LHEXP] = MAKRC0(.PREV[VALTYPE]);
		CSTMNT[A1VALFLG] = 1;
		OCSTMNT[VALINR0] = 1;

		STCMASMNT();	! Compute the complexity of the assigment

		COPYARGS = .CSTMNT[RHEXP];	! Pointer to the rhs  of
						! the assignment node

		! We want to  copy the arguments  if there are  function
		! calls under the rhs expression

		COPYARGS = .COPYARGS[FNCALLSFLG];

	END	! Numeric statement function
	ELSE
	BEGIN	! Character statement function

		! Compute the complexity of the argument list

		CSTMNT[SRCCMPLX] = 
			(IF .CSTMNT[CALLIST] EQL 0	
			THEN 0
%1474%			ELSE CMPFNARGS(.CSTMNT[CALLIST],FALSE,NOTINCONCAT));

		STCMCSB();	! Process any common subs

		COPYARGS = 1;	! Make local copies of the arguments

	END;	! Character statement function

	T = .OCSTMNT[SFNLIST];			! Pointer to argument list

	DECR I FROM .T[ARGCOUNT] TO 1 DO
	BEGIN	! Look at each arg

		PREV = .T[.I,ARGNPTR];	! Pointer to this argument

		IF .COPYARGS EQL 1
		THEN			
		BEGIN
			! If local copies of all parameters are  needed,
			! don't bother  for those  never referenced  and
			! hence not allocated.  Also for a formal  array
			! must pick up the pointer.

			IF .PREV[IDATTRIBUT(NOALLOC)]
			THEN T[.I,ENTNOCOPYFLG] =1;
		END
		ELSE
		BEGIN
%726%			IF .PREV[VALTYPE] NEQ COMPLEX
%1722%				AND .PREV[VALTYPE] NEQ DOUBLPREC
			THEN
			BEGIN
%726%				! We need to allocate complex  variables
%1722%				!  and double precision variables
%726%				! because  regular  code  generation  is
%726%				! unprepared   to    cope    with    the
%726%				! complexities  of   picking  up   these
%726%				! special types later on.

				! If   rhs   of   assignment   statement
				! contains  no   function   calls,   the
				! arguments to  this statement  function
				! will  not  need  to  be  copied   into
				! locals.    The   variable   will    be
				! referenced by  @n(16) where  n is  the
				! constant (.I-1).

				PREV[IDATTRIBUT(NOALLOC)] = 1;
				PREV[IDTARGET] = INDBIT + #16^18 + (.I - 1);
				T[.I,ENTNOCOPYFLG] = 1;
			END
%2070%			ELSE IF .PREV[IDATTRIBUT(NOALLOC)]
%2070%			THEN	T[.I,ENTNOCOPYFLG] =1;
		END;
	END;	! Look at each arg

	CSTMNT = .OCSTMNT;	! Restore the current statement pointer
	CSTMNT[SRCCMPLX] = 0;	! Complexity of statement function

END;	! of STCMSFN
GLOBAL ROUTINE ALCSFN=
BEGIN

%1455%	! Rewritten by TFV on 5-Jan-82

	! Register allocation for a  statement function. SFNEXPR  points
	! to either  an assignment  statement  for a  numeric  statement
	! function or to a call to either CHSFN. or CHSFC.

	REGISTER
		BASE FNID,
		OCSTMNT,
		OCLBRGS;

	MAP BASE CSTMNT;

	! Save the old value  of clobbregs.  This  will be non-zero  and
	! cause errors in the globally optimizing case.  Clobbregs  info
	! for the statement function will be saved in the flags field of
	! the statement function node.

	OCLBRGS = .CLOBBREGS;	! Save clobbregs
	CLOBBREGS = 0;		! Zero clobbregs

	ALCENLIST(.CSTMNT[SFNLIST]);	! Decide which registers to  use
					! to pick up the parameters

	OCSTMNT = .CSTMNT;		! Save pointer to the statement
	FNID = .CSTMNT[SFNNAME];	! Get pointer to the function name

	CSTMNT = .CSTMNT[SFNEXPR];	! Point cstmnt to the expression

	IF .FNID[VALTYPE] NEQ CHARACTER
	THEN	ALCASMNT()		! Numeric - allocate assignment
	ELSE	ALCCALL();		! Character - allocate call

	CSTMNT = .OCSTMNT;		! Restore pointer to the statement
	CSTMNT[SFNCLBREG] = .CLOBBREGS<18,18>;	! Save the clobbregs info
	CLOBBREGS = .OCLBRGS;		! Restore the old clobbregs info

%1274%	! If any temps were needed we must prevent reuse of the .Qnnnn
%1274%	! variables generated. If any are generated we set LASTSFNQ to
%1274%	! the last used (i.e. LASTQ).  We also set QSFNMAX to QMAX.

%1274%	LASTSFNQ = .LASTQ;	! Keep track of last .Qnnnn used
%1274%	QSFNMAX = .QMAX;	! Keep track of size of .Q space

END;	! of ALCSFN
GLOBAL ROUTINE STCMSUB=
BEGIN

	MAP BASE CSTMNT;
	LOCAL ARGUMENTLIST ARGLSTPT;
	OWN BASE ARGUMENT;

	CSTMNT[SRCCMPLX]_0;

	IF .CSTMNT[ENTLIST] NEQ 0 THEN
	BEGIN
	ARGLSTPT_.CSTMNT[ENTLIST];
	INCR I FROM 1 TO .ARGLSTPT[ARGCOUNT] DO
	BEGIN
		%(***INIT TO 0 THE FLAG FOR "THIS VAR WAS GLOBALLY ALLOCATED" (NOTE THAT
			PHASE 1 INITS THIS TO 1 BECAUSE IT WOULD BE THE VALFLG IN AN ARGLIST)***)%
		ARGLSTPT[.I,ENTGALLOCFLG]_0;

		ARGUMENT_.ARGLSTPT[.I,ARGNPTR];
		IF .ARGUMENT NEQ 0 THEN
		BEGIN
			!CHECK THIS FOR NO ALLOCATE BIT IF A
			!SYMBOL THAT IS NOT AN ARRAYNAME.
			!ARRAYNAMES CANNOT BE INCLUDED BECAUSE OF
			!THE DUMMY "ADDRESS" ENTRY CREATED FOR THEM.
			!IT IS NOT THE DUMMY ENTRY THAT IS ON THE
			!LIST BUT IS THE DUMMY ENTRY THAT WILL HAVE THE
			!BIT (NOALLOC) RESET.

			IF .ARGUMENT[OPRCLS] EQL DATAOPR
			THEN IF .ARGUMENT[IDATTRIBUT(NOALLOC)]
			THEN ARGLSTPT[.I,ENTNOCOPYFLG]_1;

			IF .CSTMNT[ENTNUM] EQL 0	!IF THIS IS THE 1ST ENTRY TO THE SUBROUTINE
			THEN
			ADDREGCANDATE(.ARGUMENT,.CSTMNT);	! THEN THIS PARAM COULD BE LEFT
						! IN A REG FOR USE LATER IN THE 1ST BASIC BLOCK
		END;
	END;
	END;

END;	! of STCMSUB
GLOBAL ROUTINE LPIXSUB=
BEGIN
	!***************************************************************
	! Substitute REGCONTENTS  nodes in  the innermost  loop for  all
	! references to the induction  variable.  CDONODE points to  the
	! do statement node,  DOWDP contains flags  and pointers.   Flag
	! DOISUBS  is  true  if   index  substitutions  are   performed.
	! DOREGPTR points to the regcontents node to be substituted.
	!***************************************************************

%1742%	! Rewritten by TFV on 14-Apr-83

%1742%	! Fix I/O problems.  Test all I/O statement keywords for substitution.

	MAP BASE CSTMNT:CDONODE;
	REGISTER
		ARGUMENTLIST ARGL,
		BASE TMP;

	IF .DOWDP EQL 0 THEN RETURN;		! Not inside loop

	ITMCT = 1;		! Flag for leafsubstitution
	GLOBREG[1] = .CDONODE[DOSYM];
	CHOSEN[1] = .DOWDP[DOREGPTR];

	IF .CSTMNT[SRCCOMNSUB] NEQ 0
	THEN
	BEGIN	! Look at the common sub-expressions too
		TMP = .CSTMNT[SRCCOMNSUB];
		WHILE .TMP NEQ 0 DO
		BEGIN
			LEAFSUBSTITUTE(.TMP);
			TMP = .TMP[SRCLINK];
		END;
	END;	! Look at the common sub-expressions too

	CASE .CSTMNT[SRCID] OF SET

	BEGIN			! ASSIGNMENT
		LEAFSUBSTITUTE(.CSTMNT[LHEXP]);
		LEAFSUBSTITUTE(.CSTMNT[RHEXP]);
	END;			! ASSIGNMENT

	LEAFSUBSTITUTE(.CSTMNT[ASISYM]);	! ASSIGN with possible arrayref
	BEGIN END;		! CALL
	BEGIN END;		! CONTINUE
	BEGIN END;		! DO
	BEGIN END;		! ENTRY
	BEGIN END;		! COMMONSUB - already done
	BEGIN END;		! GOTO
	LEAFSUBSTITUTE(.CSTMNT[AGOTOLBL]);	! ASSIGNED GOTO
	LEAFSUBSTITUTE(.CSTMNT[CGOTOLBL]);	! COMPUTED GOTO
	LEAFSUBSTITUTE(.CSTMNT[AIFEXPR]);	! ARITHMETIC IF

	BEGIN			! LOGICAL IF
		LEAFSUBSTITUTE(.CSTMNT[LIFEXPR]);	! Conditional expr
		TMP = .CSTMNT;			! Save CSTMNT
		CSTMNT = .CSTMNT[LIFSTATE];	! Get consequent statement
		LPIXSUB();			! Substitute in consequent
		CSTMNT = .TMP;			! Restore CSTMNT
	END;			! LOGICAL IF

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

	IF .CSTMNT[STOPIDENT] NEQ 0	! STOP
	THEN LEAFSUBSTITUTE(.CSTMNT[STOPIDENT]);

	MISCIO(.CSTMNT);	! READ
	MISCIO(.CSTMNT);	! WRITE
	MISCIO(.CSTMNT);	! DECODE
	MISCIO(.CSTMNT);	! ENCODE
	MISCIO(.CSTMNT);	! REREAD
	MISCIO(.CSTMNT);	! FIND
	MISCOCI(.CSTMNT);	! CLOSE
%4502%	MISCIO(.CSTMNT);	! DELETE
%4503%	MISCIO(.CSTMNT);	! REWRITE
	MISCIO(.CSTMNT);	! BACKSPACE
	MISCIO(.CSTMNT);	! BACKFILE
	MISCIO(.CSTMNT);	! REWIND
	MISCIO(.CSTMNT);	! SKIP FILE
	MISCIO(.CSTMNT);	! SKIP RECORD
	MISCIO(.CSTMNT);	! UNLOAD
%4504%	MISCIO(.CSTMNT);	! UNLOCK
	MISCIO(.CSTMNT);	! ENDFILE
	BEGIN END;		! END
	BEGIN END;		! PAUSE
	MISCOCI(.CSTMNT);	! OPEN
	BEGIN END;		! SFN
	BEGIN END;		! FORMAT
	BEGIN END;		! BLT
	BEGIN END;		! REGMASK - change set of available registers -
				!  inserted by global register allocator
%2206%	MISCOCI(.CSTMNT);	! INQUIRE

	TES;

END;	! of LPIXSUB
GLOBAL ROUTINE ALCENTRY=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR THE REGS TO BE USED TO
	PICK UP THE VARS ON THE PARAMETER LIST AT AN ENTRY.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE FOR
	THE ENTRY STATEMENT
***************************************************************************)%
BEGIN
	MAP BASE CSTMNT;

	IF .CSTMNT[ENTLIST] NEQ 0
	THEN ALCENLIST(.CSTMNT[ENTLIST]);	! If  this   entry   has
						! parameters,  determine
						! which registers to use
						! to pick them up

END;	! of ALCENTRY
GLOBAL ROUTINE ALCENLIST(ARGLST)=
%(***************************************************************************
	ROUTINE TO DETERMINE WHICH REGS TO USE TO PICK UP THE
	THE PARAMS OF A FN,SUBR,OR STMNT FN.
	CALLED WITH THE ARG "ARGLST" POINTING TO THE PARAMETER LIST.
***************************************************************************)%
BEGIN
	OWN OSTBSYR;	!SAVE VAL OF STBSYR

	REGISTER PEXPRNODE ARGN;	!PTR TO THE SYMBOL TABLE ENTRY FOR A GIVEN ARG
	MAP ARGUMENTLIST ARGLST;	!PTR TO THE ARG LIST FOR THIS ENTRY



	%(**ALLOW REGS 0 AND 1 TO BE USED FOR PICKING UP ARGS**)%
	OSTBSYR_.STBSYR;
	STBSYR_.STBSYR OR #600000000000;

	%(***ALLOC A REG TO USE TO PICK UP EACH ARG***)%
	INCR I FROM 1 TO .ARGLST[ARGCOUNT]
	DO
	BEGIN
		ARGN_.ARGLST[.I,ARGNPTR];	!SYM TABLE ENTRY FOR THIS ARG

		IF .ARGLST[.I,ENTGALLOCFLG]	!IF THIS PARAM WAS ALREADY ASSIGNED A REG
					! BY THE GLOBAL ALLOCATOR
			OR .ARGLST[.I,ENTNOCOPYFLG]	! OR IF THIS PARAM WONT BE COPIED INTO A LOCAL
		THEN BEGIN END		! LEAVE THAT ASSIGNMENT ALONE

		ELSE
		BEGIN
			OWN RA;	!REG TO USE FOR PICKING UP THE ARG

			RA_AFREEREG(.STBSYR,TRUE,.ARGN[DBLFLG]);	!GET A FREE REG TO USE
			REGCLOBB(.RA);		!IF RA PREVIOUSLY HAD A VAR IN IT
						! IT WILL NOW BE CLOBBERED
			IF .ARGN[DBLFLG] THEN REGCLOBB(.RA+1);	!IF ARG IS DP, CLOBBER 2 REGS
			ARGLST[.I,ENTAC]_.RA;		!SET FIELD IN ARGLIST ENTRY INDICATING REG
			IF .ARGLST[.I,ENTSAVREGFLG]	!IF IT WILL BE USEFUL IN THE 1ST BASIC BLOCK
					! OF THE ROUTINE TO HAVE THIS PARAM LEFT IN A REG
			THEN
			SAVEREG(.RA,.ARGN,0,.ARGLST[.I,ENTSONNXTUSE]);	!REMEMBER THAT THIS REG CONTAINS
							! THE VAL OF THIS ARG
			CLOBBREGS_SETBIT(.CLOBBREGS,.RA);	!REMEMBER THAT THIS REG GETS CLOBBERED
							! WHEN EXECUTING THIS SUBROUTINE
			IF .ARGN[DBLFLG] THEN CLOBBREGS_SETBIT(.CLOBBREGS,.RA+1);
		END;
	END;
	STBSYR_.OSTBSYR

END;	! of ALCENLIST
GLOBAL ROUTINE ARGSIZREST(ENTSTMNT)=
%(***************************************************************************
	FOR THE ENTRY STMNT POINTED TO BY "ENTSTMNT", DETERMINE THE
	MAXIMUM PRECISION OF ANY ARGUMENTS WHOSE VALUES
	MUST BE COPIED BACK AT SUBROUTINE EXIT.
	THUS IF THERE ARE NO PARAMETERS AT THIS ENTRY WHOSE VALS
	ARE MODIFIED IN THE ROUTINE, RETURN 0. IF ONLY SINGLE PRECISION
	PARAMETERS HAVE THEIR VALS MODIFIED RETURN 1. IF DOULBLE-WORD
	PARAMETERS HAVE THEIR VALS MODIFIED RETURN 2.
	ARGS THAT ARE GLOBALLY ALLOCATED TO REGISTERS AND ARGS THAT DO
	NOT HAVE LOCAL COPIES DONT COUNT.
***************************************************************************)%
BEGIN
	MAP BASE ENTSTMNT;
	REGISTER ARGUMENTLIST ARGLST;
	REGISTER SNGLFOUND;	!FLAG FOR "A SINGLE PREC ARG TO BE RESTORED" WAS FOUND

	IF (ARGLST_.ENTSTMNT[ENTLIST]) EQL 0 THEN RETURN 0;	!IF THERE ARE NO PARAMETERS

	SNGLFOUND_FALSE;

	INCR I FROM 1 TO .ARGLST[ARGCOUNT]	!LOOK AT ALL ARGS ON THE LIST
	DO
	BEGIN
		IF .ARGLST[.I,ENTNOCOPYFLG]	!PARAMS THAT DO NOT HAVE LOCAL COPIES
			OR .ARGLST[.I,ENTGALLOCFLG]	! OR THAT ARE GLOBALLY ALLOCATED
			OR .ARGLST[.I,ARGNPTR] EQL 0	! OR THAT ARE LABELS
		THEN BEGIN END		! SHOULD BE IGNORED
		ELSE
		BEGIN
			REGISTER PEXPRNODE SYMENTRY;
			SYMENTRY_.ARGLST[.I,ARGNPTR];
			IF .SYMENTRY[IDATTRIBUT(STORD)]	!IF PARAM IS STORED INTO
				AND .SYMENTRY[OPERSP] EQL FORMLVAR	! AND IS A VARIABLE (NOT AN ARRAY)
			THEN
			BEGIN
				IF .SYMENTRY[DBLFLG]	!IF PARAM IS DOUBLE-WORD
				THEN RETURN 2
				ELSE
				SNGLFOUND_TRUE;
			END
		END
	END;	!END OF INCR LOOP

	IF .SNGLFOUND THEN RETURN 1 ELSE RETURN 0;

END;	! of ARGSIZREST
GLOBAL ROUTINE FNVALCHK=
%(***************************************************************************
	CHECK WHETHER THE ASSIGNMENT STATEMENT POINTED TO BY THE GLOBAL
	"CSTMNT" ASSIGNS THE VALUE TO BE RETURNED BY THIS FUNCTION
	AND WHETHER THE ASSIGNMENT IS IMMEDIATELY FOLLOWED BY A "RETURN".
	IF SO, AND IF THE FUNCTION IS SINGLE ENTRY AND IF REG 0 WILL
	NOT BE NEEDED FOR STORING BACK VALUES OF PARAMETERS, SUBSTITUTE
	A "REGCONTENTS" OF REG 0 ON THE LHS OF THE ASSIGNMENT STMNT AND
	DONT PICK UP THE FN VAL INTO REG 0 WHEN EXITING THE FUNCTION.
***************************************************************************)%
BEGIN
	MAP BASE CSTMNT;
	REGISTER BASE TSTMNT;
	REGISTER PEXPRNODE LHNODE;

%1163% IF .FLGREG<DBGINDX> THEN RETURN;	!/DEB:INDEX - must update function variable

	IF (.RETNCT+1) NEQ .ASVCT	!IF THERE ARE MORE "RETURN" (PLUS "END") STMNTS IN THIS PROGRAM
				! THAN THERE ARE ASSIGNMENTS OF THE VAL DIRECTLY BEFORE RETURN STMNTS
				! CANNOT DO THIS OPTIM
	THEN RETURN;

	IF NOT ASNFNVAL() THEN RETURN;	!IF THE FN VAL IS NOT ASSIGNED BY THIS STMNT OR THIS STMNT DOES
					! NOT PRECEDE A RETURN

	LHNODE_.CSTMNT[LHEXP];	!PTR TO LHS OF ASSIGNMENT

	TSTMNT_.SORCPTR<LEFT>;	!PTR TO 1ST STMNT IN PROGRAM
	WHILE .TSTMNT[SRCID] NEQ ENTRID	!SKIP DUMMY CONTINUES AT START OF PROGRAM
	DO
	BEGIN
		TSTMNT_.TSTMNT[CLINK];	
		IF .TSTMNT EQL 0 THEN CGERR();	!IF REACH END OF PROGRAM AND HAVENT FOUND THE ENTRY
	END;

	IF ARGSIZREST(.TSTMNT) + (1+.LHNODE[DBLFLG])	!SUM OF NUMBER OF REGS NEEDED FOR
			! RESTORING ARGS IN EPILOGUE AND NUMBER OF REGS NEEDED TO HOLD THE FN VAL
		GTR 2	! IF  NEED MORE THAN 2 REGS ALTOGETHER THEN
			! CANT  LEAVE THE FN VAL IN REGS 0-1 WHILE ARGS
			! ARE RESTORED
	THEN RETURN;

	!RETURN IF THERE ARE MULTIPLE ENTRIES
	IF .FLGREG<MULTENT> THEN RETURN;

	IF .TSTMNT[ENTSYM] NEQ .LHNODE THEN CGERR();	!SYMBOL AT THIS ENTRY BETTER BE THE LHS OF
				! THIS ASSIGNMENT OR WE HAVE AN INTERNAL COMPILER ERROR


	TSTMNT[VALINR0]_1;	!SET FLAG IN ENTRY FOR "VAL OF THIS FN ALREADY IN REG 0, NEEDNT PICK IT UP
	CSTMNT[LHEXP]_MAKRC0(.LHNODE[VALTYPE]);	!SUBSTITUTE A REGCONTENTS 0 ON LHS

	IF NOT .CSTMNT[A2VALFLG]	!IF RHS IS NOT A SIMPLE VAR
	THEN
	BEGIN
		REGISTER PEXPRNODE RHNODE;
		RHNODE_.CSTMNT[RHEXP];	!EXPRESSION ON RHS
		RHNODE[RESRFFLG]_0;	! IF HAD FLAG FOR "REF TO LHS VAR OCCURS IN THIS EXPR, CLEAR IT
	END;

END;	! of FNVALCHK
GLOBAL ROUTINE FNVLCH1=
%(***************************************************************************
	ROUTINE CALLED IN "COMPLEXITY" PASS FOR EACH ASSIGNMENT STMNT.
	CHECKS WHETHER THAT STMNT ASSIGNS THE VAL OF THE FN
	DIRECTLY BEFORE A "RETURN". KEEEPS A COUNT OF ALL
	SUCH ASSIGNMENTS.
***************************************************************************)%
BEGIN
	MAP BASE CSTMNT;
	IF ASNFNVAL() THEN ASVCT_.ASVCT+1;

END;	! of FNVLCH1
GLOBAL ROUTINE ASNFNVAL=
%(***************************************************************************
	ROUTINE TO CHECK WHETHER THE STMNT POINTED TO BY CSTMNT 
	ASSIGNS THE VAL OF THIS FN AND
	ITS EXECUTION  DIRECTLY PRECEDES EXECUTION OF A "RETURN"
	STMNT. CSTMNT IS ASSUMED TO PT TO AN ASSIGNMENT STMNT.
***************************************************************************)%
BEGIN
	MAP BASE CSTMNT;
	REGISTER PEXPRNODE LHNODE;
	REGISTER BASE TSTMNT;
	REGISTER PEXPRNODE LABENT;	!LABEL ENTRY FOR LABEL ON THE RETURN(IF THERE IS ONE)
	LHNODE_.CSTMNT[LHEXP];	!LHS OF ASSIGNMENT STMNT
	IF NOT(.LHNODE[OPRCLS] EQL DATAOPR AND .LHNODE[IDATTRIBUT(FENTRYNAME)])	!IF LHS IS NOT THE FN VAL
	THEN
	RETURN FALSE;

	IF (LABENT_.CSTMNT[SRCLBL]) NEQ 0	!IF THIS STMNT HAS A LABEL
	THEN (IF .LABENT[SNDOLVL] NEQ 0		! IF THAT LABEL ENDS ANY DO LOOPS
		THEN RETURN FALSE);		! THEN THE VAR FOR THE FN VAL MIGHT
					! BE USED AGAIN AFTER EXECUTION OF THIS STMNT


	TSTMNT_.CSTMNT[CLINK];	!STMNT AFTER THE ASSIGNMENT
	IF .TSTMNT EQL 0 THEN RETURN FALSE;	!IF THIS ASSIGNMENT WAS UNDER AN IF
	IF .TSTMNT[SRCID] EQL CONTID AND .TSTMNT[OPTCONFLG]	!SKIP THE DUMMY CONTINUE INSERTED BY THE OPTIMIZER
	THEN TSTMNT_.TSTMNT[CLINK];
	IF NOT(.TSTMNT[SRCID] EQL RETUID OR .TSTMNT[SRCID] EQL ENDID)	!IF NEXT STMNT IS NOT RETURN OR END
	THEN RETURN FALSE;

	IF (LABENT_.TSTMNT[SRCLBL]) NEQ 0	!IF THE RETURN HAS A LABEL
	THEN (IF .LABENT[SNREFNO] GTR 1 THEN RETURN FALSE);	! IF THAT LABEL IS REFERENCED, RETURN FALSE

	RETURN TRUE;	!OTHERWISE, DO HAVE THE FN VAL ASSIGNED JUST BEFORE A RETURN
END;	! of ASNFNVAL

END
ELUDOM