Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/strega.bli
There are 26 other files named strega.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: S. MURPHY/HPW/DCE/SJW/JNG/TFV/EGM/EDS/AHM/CDM/RVM/TJK/MEM

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

GLOBAL BIND STREGV = #11^24 + 0^18 + #4522;	! Version Date: 5-Nov-85

%(

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

178	-----	-----	ADD ROUTINES ALCE1LIST AND ALCE2LIST TO
			PERFORM ALLOCATON FOR E1LISTCALL AND
			E2LISTCALL NODES
179	----	-----	MODIFY "ALCCALL" SO THAT DONT ASSUME ALL
			REGS ARE CLOBBERED BY A CALL TO "ADJ1." AND "ADJG."
			ALSO, INSERT CODE IN CMSTMN TO CHECK WHETHER A STMNT
			INCLUDES ANY FN CALLS AND SET "FNCALLSFLG" IN
			THE STMNT NODE IF IT DOES.
			ALSO, REMOVE CODE FROM "CMSTMN" THAT CAUSED PAIRMODEFLG
			TO NEVER BE SET IN AN IO STMNT (BECAUSE IO
			STMNTS DIDNT HAVE FLAGS FIELDS ONCE UPON A TIME)
185	-----	-----	ADD CODE TO PROCESS COMMON SUBS ON CALL STMNTS
			(HAVE SKIPPED SOME VERSION NUMBERS FOR THE
			EXPERIMENTAL REGISTER 0 VERSION)
186	-----	-----	IN "ALCAIF" IF THE REG TO BE TESTED MUST FIRST
			BE LOADED (IE IF "A1SAMEFLG" IS NOT SET), DO
			NOT ALLOW REGISTER 0 TO BE USED (SINCE WE LOAD
			THE REG WITH A SKIP INSTRUCTION)

187	-----	-----	IN "ALCASMNT", DO NOT CALL "ALCINTMP" TO
			TARGET THE RHS TO THE LHS VAR IF THE LHS IS A
			REGCONTENTS (THIS ONLY OCCURS IF "LHINREGALC"
			HAS FAILED TO TARGET THE RHS TO THE LHS REG)
188	-----	-----	CORRECT TYPO IN 187
189	-----	-----	ADD CODE TO HANDLE AN ARBITRARY EXPRESSION
			AS AN ARG IN AN OPEN STMNT
190	-----	-----	ADD CODE TO HANDLE AN ARBITRARY EXPRESSION
			AS A UNIT NUMBER
191	-----	-----	FIX LHINREG TO CORRECTLY HANDLE DOUBLE
			PRECISION ARRAYREF.
192	-----	-----	FIX ALCIOLIST TO PASS CORRECT DP REG BITS
193	-----	-----	MAKE ARRAY-REFS AS UNITS,RECORDS,AND UNDER OPEN/CLOSE
			WORK BY CALLING "ALCTVARR" SO THAT A PTR TO THE STORECLS
			NODE CAN BE LINKED UNDER THE STMNT NODE
194	-----	-----	CHANGE ALL CALLS TO THE MACRO "CLBNXREG"
			INTO CALLS TO THE ROUTINE "CLOBBNX"
195	-----	-----	IN ALCE1LIST,ALCE2LIST, FOR COUNT OR INCR
			AN ARRAY REF, LINK THE STORECLS NODE IN UNDER
			THE E1/E2LISTCALL NODE
196	-----	-----	IN "LHINREGALC", WHEN ARE TARGETTING TO REG 0,
			ALLOW REG 1 TO BE USED IN THE COMPUTATION
197	-----	-----	IN "ALCASMNT", WHEN CALL "SAVEREG" TO REMEMBER
			THAT THE VAL OF RHS IS IN A REG - IF A1NEGFLG
			WAS SET AND THE VAR IS DOUBLE-PREC, THE REGISTER
			WILL BE NEGATED (SINCE THERE IS NO "MOVN" FOR DP)
			HENCE THE REG WONT CONTAIN THE VAR
198	-----	-----	SAME FIX AS 197 - ANOTHER CALL TO "SAVEREG"
199	-----	-----	ONLY CALL FNVALCH1 IF WE ARE IN A FUNCTION
			INSTEAD OF FOR EVERY ASSIGNMENT
200	-----	-----	IN ALCASMNT, IN LOCAL ROUTINE "SETREGFORA2VAL"
			WHEN CHECK FOR SPECIAL CASE OF NEGATED AOBJN WD,
			MUST NOW LOOK AT "A1NEGFLG" (FORMERLY A2NEGFLG)
201	-----	----	IN STCMOPEN AND ALCOPEN, MUST CHECK FOR THE VAL
			OF AN OPEN PARAM EQUAL TO ZERO BEFORE WALKING
			DOWN THE TREE (SINCE THE ARG "DIALOG" CAN HAVE A 
			NULL VAL)
202	254	15425	FOR RELATIONALS, DO NOT ALLOCATE CMNSUB TO 0 SINCE
			WE MIGHT HAVE JUST MADE A SETO 0,0
203	261	15772	CLEAR REGSTATE EACH STATEMENT IF DEBUG:LABELS
204	270	16013	CLEAR REGSTATE FOR ALL VARIABLES POSSIBLY CLOBBERED
			IN A NAMELIST INPUT STATEMENT.
205	300	-----	FIX 204 TO ONLY CHECK RIGHT HALF FOR -1
206	301	16154	REALIZE THAT FUNCTION CALLS WILL CLOBBER ANY
			ARGUMENTS LEFT IN 1 BY FUNCTION PROLOGS
207	310	16602	ALLOCATE UNIT BEFORE OPEN AND CLOSE ARGS
208	311	16665	ALLOCATE REGS IN ALCIOCALL ONLY FOR NON-DATA ITEMS
209	363	18269	PREVENT COMPLEMENTED VAR FROM BEING SAVED, (DCE)
210	403	18961	BAD CODE FOR I=I/J OR A=B*A, (DCE)
211	446	20652	BAD CODE FOR I=I*3 AND I=I**7 (QAR753), (SJW)
212	471	20309	BAD CODE FOR LOGICAL LHS IN COMMON OR EQUIVALENCE, (DCE)
213	503	19976	ON A(L) = FUNCT. CALL, DON'T LEAVE L IN REG 1.
			IF EVALUATING LH FIRST, (JNG)

***** Begin Version 5A *****	 7-Nov-76

214	522	20819	ON AN ARRAYREF IN AN IOLIST WHEN WE'RE OUT OF
			REGS, CHECK NEGFLGS BEFORE USING EXISTING REG
			CONTAINING DESIRED SUBSCRIPT., (JNG)
215	527	20317	CLOBBER ALL COMMON OR EQUIV VARS ON RANDOM READ,
			WRITE, FIND SINCE ASSOCIATE VAR IS UNKNOWN TO US!
216	532	20323	TREAT ARRAY AS ASSOCIATE VARIABLE CORRECTLY, (DCE)
217	546	22030	FIX OPERATIONS WHICH CLOBBER NEXT REGISTER (IDIV), (DCE)
218	616	22345	BE CAREFUL ALLOCATING NEW REGISTER FOR I/O LIST ELEMENT,
			(DCE)
219	625	23122	SET INREGFLG IN LHINREGALC WHEN WE KNOW THAT
			THE NODE WILL BE CALCULATED TO A REG. THIS
			FIXES LOGICAL EXPRESSIONS LIKE A=A.OR.(X.GT.Y), (JNG)

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

220	721	-----	A=A*B MUST INVALIDATE REGISTER FOR VARIABLE A
			(IN CASE OTHER VARS LIVE THERE TOO)., (DCE)
221	744	28463	DOUBLE WORD ARRAY REFS IN I/O SLISTS AND ELISTS
			MAY DOUBLY USE AN ODD NUMBERED REGISTER., (DCE)

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

222	760	TFV	1-Oct-79	------
	Add handling for IOSTAT= variable, both in comlexity and in allocation
	The variable is always clobbered (implicit assignment)

223	764	EGM	24-Apr-80	29279
	Do not allocate a register for an I/O list element that is an
	immediate array reference

224	1067	EDS	13-May-81	31074
	Do not set register 1 available if there are any common subs
	for this statement which have been allocated to register 1.

226	1123	AHM	21-Sep-81	Q20-01650
	Make ALCIOS work for IOSTAT=arrayref

229	1142	EGM	28-Oct-81	Q10-06254
	Prevent internal error when IOLISTCALL node complexity count is greater
	than 63 (the 6 bits worth which is stored in the field).

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

1161	EGM	25-Jun-82
	Don't forget to invalidate reg contents when LH of assigment is to a
	reg (contents node) and RH references that reg, but not in such a way
	that computation can occur directly to that reg (LHINREGALC fails).

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

225	1220	DCE	2-Jun-81	-----
	Allocate registers for assignment statements to DO variables,
	and for temps for fn calls as top level I/O elements.

227	1274	TFV	20-Oct-81	------
	Fix calls to NXTTMP, the arg is now the size of the temp in words.

228	1404	AHM/TFV	26-Oct-81	------
	Fix ALCIOCALL to agree with ALCIOLST in that IOLIST elements which
	live in AC0 must be stored into a temp.

230	1413	CDM	4-Nov-81
	Fix of
	IF ... (A AND B) ... 
	to
	IF ... (IF A THEN B
			ELSE FALSE) ...
	Because the B clause may reference a field which might not exist
	(?ICE or trash being compared resulting) unless the A clause is true.

231	1475	RVM	8-Feb-82
	Make ALCUNIT call ALCCHARRAY to do allocation for character array
	references.  Before, ALCUNIT called ALCTVARR for any array reference,
	but this is incorrect, as ACLTVARR inserts a store class node above
	a character arrays ref.

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.

1516	CKS	22-Mar-82
	Add CMPFMT and ALCFMT to do complexity and register allocation for
	FMT= expressions.

1555	CKS	10-Jun-82
	Put check in ALCFMT to prevent it trying to allocate absent formats
	or FMT=* formats.  Also don't look at IDATTRIBUT(NAMNAM) without
	checking to be sure the expression is a simple variable.

1561	CKS	15-Jun-82
	Remove call of ALCCHARRAY added by edit 1475.  Always call 
	ALCTVARR and have it call ALCCHARRAY if necessary.

1642	CDM	11-Oct-82
 	Fix ALCDECENC so that it can handle character array refs.  Call
	ALCINREG to decide which array allocation routine to call.

1663	SRM	5-Nov-82
	Fix bug in allocation for implied DO loops that have been
	folded into SLISTs by /OPT. The assignment statement to store
	the final value of the loop was erroneously using ACs that
	were in use holding items preceding the loop in the IO list.
	Added the routine ALCASCHAIN and called it from ALCE1LIST
	and ALCE2LIST.

1700	CKS	23-Nov-82
	Convert STBSYR to double mode before allocating I/O statement
	specifiers if the specifier is double mode.  (Like character
	expressions.)

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

1723	SRM	3-Feb-83
	In allocation for assignment for a function value (in LHINREGALC),
	do not make AC 1 legal if already in double mode.
	The following program erroneously generated a
	call to DFL.1:
		DOUBLE PRECISION FUNCTION DFN(LL,J)
		DOUBLE PRECISION D1(0:10)
		DFN=J*D1(LL)
		END

1753	TFV	19-May-83	20-19158
	Turn on the STOREFLG bit in common subexpressions of loop  index
	variables which have to be put into .Qnnnn variables because  no
	free registers are left.  ((THIS IS A DAY 1 BUG.))

1757	TFV	2-Jun-83	10-33567A
	The assignment a = a * 3 + 4 generates the wrong code /opt if  a
	is targeted to a  register.  The P2PL1 (power  of two plus  one)
	specop must be  computed in  a different  register.  the  specop
	EXPCIOP has the same problem.  ((THIS IS A DAY 1 BUG.))

2000	CDM	15-Sep-83	10-34135
	Statement IF  (I1.EQ.1)  MSK=MSK.AND..NOT.1 generates  bad  code
	because it is  noticed that the  constant 1 already  lives in  a
	register.   This   results  in   setting  both   A1SAMEFLG   and
	A1IMMEDFLG, something  which should  never  be done.   When  the
	"same" is set, we  now clear the  "immed".  Otherwise we  access
	off a  table in  OPGNTA  (accessed by  the  A1* flags)  and  ICE
	(TOPS10) or create bad code (TOPS20).

2023	TJK	12-Dec-83
	Have ALCIOCALL call ALCTARY for character array references  in
	an IO list when there aren't enough free regs.  Previously the
	TARGADDR field wasn't being set, resulting in incorrect  code,
	and sometimes causing an ICE or illegal instruction trap.

2040	TJK	23-Feb-84
	Reorder calls for  complexity, register  allocation, and  code
	generation of I/O keywords.  Most of this was already done  in
	V10 in edit  2201, although register  allocation for FIND  was
	still incorrect.

2041	TJK	23-Feb-84
	Make check for ARG2NODE consistent with check for ARG1NODE  in
	LHINREGALC.  Before this edit, CMPRHINLH was being called when
	it shouldn't.  This  routine was in  turn calling  CMPNODINLH,
	which set TREEPTR to the  ARG2PTR of the expression passed  to
	it for  a  call  to  ALCINREG.  When  the  expression  had  no
	ARG2PTR, TREEPTR was  being set  to zero  and ALCINREG  looped
	recursively until the stack overflowed.

2047	TJK	20-Apr-84
	ALCIOCALL was  allocating  single-word I/O  list  elements  to
	registers when double precision arithmetic was involved.   The
	result was that alternating  registers were being used.   This
	threw off the  complexity calculation, since  there were  many
	free registers  but  not enough  consecutive  register  pairs.
	This edit prevents ALCINREG from being called for an I/O  list
	element if  the I/O  statement has  the PAIRMODEFLG  flag  set
	(i.e., the global flag  PAIRMODE is set)  and there are  fewer
	then 2 free register pairs.

	Note that  this  still  doesn't  correct  all  cases  of  this
	problem.  To  properly handle  all cases,  a routine  must  be
	added which is similar to ALCINTMP but which forces the  value
	to  memory.   In  addition,  register  allocation  for  double
	precision array references  should be improved  to require  no
	more than one free register pair.

2065	MEM	3-Jul-84	10-34774
	ALCIOLST should not allocate a two word .Qnnnn variable
	for character function results or set STOREFLG.

2072	DCE	10-Oct-84
	Prevent a register from being used twice in ALCMEM.  A  separate
	register is  needed, the  allocated  register was  being  loaded
	twice, clobbering the old value.

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

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

2201	TFV	30-Mar-83
	Do complexity and allocation  walks for INQUIRE statement.   Add
	new case to CMSTMN  and ALCSTMN.  The work  is actually done  by
	STCMOPEN and ALCOPEN.

2203	TFV	7-Jun-83
	Fix allocation  for  FMT= and  FILE=  in I/O  statements.   Only
	allocate  a  .Qnnnn  variable  for  character  expressions,  not
	character constants and variables.

2226	TJK	6-Oct-83
	Remove STREGA, an ancient routine which is never called anywhere.

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.
	Move REQUIRE statements to before EXTERNAL declarations.

2302	TJK	2-Feb-84
	Add new flag IDCLOBB to the IDFNATTRIB field of a symbol table
	entry.  This flag is set for certain library routines  (called
	as subroutines).  It indicates that  ACs are not preserved  by
	the call.

	Have CHASGN generate calls to  CASNM.  instead of CHASN.   for
	single-source character  assignments,  and CNCAM.  instead  of
	CONCA. for character concatenation assignments.  Also have  it
	set IDCLOBB for these routines, which don't preserve ACs.

	Replace a check for CONCA. with a check for CNCAM. in  SKCALL.

	Have ALCCALL mark registers 2-15 (octal) as being clobbered if
	IDCLOBB is set.

2314	AHM	26-Feb-84
	Eliminate immediate arguments for OTSKFSIZ (format size)
	FOROTS arguments because size of large arrays don't fit in 18
	bits.  Make CMPFMT fill ARACONSIZ in from ARASIZ for
	non-adjustably dimensioned Hollerith arrays.

2317	AHM	6-Mar-84
	Eliminate immediate values for OTSKEDSIZ (ENCODE/DECODE record
	size) FOROTS arguments because the value need not fit in 18
	bits under extended addressing.  Make CMPDECENC mark constant
	IOCNTs for allocation.

2335	TJK	6-Apr-84
	Change some  AND's to  THEN-IF's in  STCMASMNT to  prevent  an
	illegal memory reference.

2363	TJK	6-Jun-84
	Add code to do  register allocation for arbitrary  expressions
	in E1 lists and E2 lists (ALCE1LIST and ALCE2LIST).  Also move
	some calls to VARCLOBB in ALCIOCALL so that the variables  are
	marked as  clobbered  after  register  allocation  instead  of
	before.

2364	TJK	6-Jun-84
	Add a call  to ENDSMZTRIP  in ALCIOLST.  If  it returns  TRUE,
	mark all registers as being  clobbered since we're at the  end
	of a MAYBEZTRIP DO-loop.

2401	TJK	19-Jun-84
	Add calls  to  DOTDCHECK  in  CMPUNIT,  CMPFMT,  CMPFILE,  and
	STCMOPEN.  DOTDCHECK  tries  to  create  .Dnnnn  compile  time
	constant descriptors for substring references.

2463	AHM	8-Oct-84
	Don't let ARREQLLH believe that ARRAYREFs with different
	OPERSPs are the same.  Not strictly necessary, because
	ARREFBIGs can't be passed to ARREQLLH at the moment, but we
	might as well be safe.

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

2572	MEM	12-Mar-86
	Complexity walk, register allocation and code generation must be done
	in the same order. For the open statement the register allocation was
	done in the reverse order from complexity and code generation.

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

4500	MEM	22-Jan-85
	Added routine CMPOPKEY to compute the complexity of the expressions
	pointed to by the IOKEY field in the source tree node, and added
	routine ALCOPKEY to allocate the registers used by the expressions
	pointed to by IOKEY.

4501	MEM	22-Jan-85
	Added CMPRDKEY to compute the complexity of the expression pointed to
	by the IOKEY field in the source tree node, and added ALCRDKEY to
	allocate the registers used by the expression pointed to by the IOKEY
	field in the source tree node.

4502	MEM	22-Jan-85
	Modified CMSTMN and ALCSTMN for DELETE statement.

4503	MEM	22-Jan-85
	Modified CMSTMN and ALCSTMN for REWRITE statement.

4504	MEM	22-Jan-85
	Modified CMSTMN and ALCSTMN for UNLOCK statement.

4517	MEM	4-Oct-85
	Modify ALCASMNT for register allocation of 1-char asmnts.

4522	MEM	5-Nov-85
	Modify ALCASMNT for register allocation of 1-char asmnts when
	LHS and/or RHS or asmnt may have an unincremented bytepointer.

ENDV11

)%



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

	BIND REG0=0;	!REGISTER 0 - THIS REG IS FREQUENTLY AN EXCEPTION


	FORWARD
		CMSTMN(0),
		ALCTMP(0),
		ALCSTMN(0),
		STCMASMNT(0),
		STCMAGO(0),
		STCMCGO(0),
		STCMSTOP(0),
		CMPDECENC(0),
		STCMCSB(0),
		ALCASMNT(0),
		ALCMEMCMP(0),
		ORDERMEMCMP(0), 
		ALCAGO(0),
		ALCCGO(0),
		ALCDECENC(0),
		ALCOPEN(0),
		ALCCMNSB(0),
		STCMLIF(0),
		STCMAIF(0),
		SCMASSI(0),
		STCMOPEN(0),
		ALCE1LIST(3),
		ALCE2LIST(3),
		ALCASCHAIN(3),
		ALCLIF(0),
		ALCAIF(0),
		ALCASSI(0),
		ALCCALL(0),
		ALCIOLST(0),
		ALCIOCALL(1),
		LHINREGALC(0);

EXTERNAL

	ADDREGCANDATE,	! ROUTINE IN BASIC BLOCK ALLOCATOR WHICH ADDS  A
			! VAR TO THE  SET OF  VARS THAT CAN  BE LEFT  IN
			! REGS
	AFREEREG,	! ROUTINE TO  GET A  FREE  REGISTER TO  USE.  IF
			! POSSIBLE, IT RETURNS A  REG WHICH WILL NOT  BE
			! USEFUL LATER  IN  THIS  BASIC  BLOCK. IF  NOT,
			! RETURNS THE  REG WHOSE  NEXT USE  IS  FURTHEST
			! AWAY
	ALCARRAY,	! Allocation for numeric array refs
	ALCCNT,
	ALCDOEND,
	ALCDOSTMT,
	ALCENTRY,
	ALCFNARGS,
	ALCINREG,	! Allocate into a register
	ALCINTMP,	! Allocate into a temp variable
%4500%	ALCSTAYINTMP,	! Allocate into a temp variable
	ALCNARG,
	ALCRETURN,
	ALCRL1,
	ALCSFN,
	ALCTVARR,	! ALLOCATE THE VAL OF AN ARRAY ELEM TO A TEMP
%1123%	ALCTARY,	! Wedges the address in a temp
	ALOCONST,
	ASSOCPT,	! GLOBAL POINTING TO LIST OF ALL ASSOC VARS
			! IN THIS SUBPROGRAM
	C1H,
	C1L,
%2275%	BASE CDONODE,	! Current Do loop statement, if in an innermost DO.
	CGERR,		! Illegal memory reference message
	CLOBBCOMEQV,
	CLOBBNX,	! NEED THIS TO TEST IF THE NEXT REGISTER WILL BE
			! CLOBBERED.
	CLOBBREGS,	! WD CONTAINING BIT  PTN FOR  REGS CLOBBERED  BY
			! THIS ROUTINE
	CLRRGSTATE,	! ROUTINE TO CLEAR THE BASIC BLOCK ALLOCATOR TABLES
			! SO THAT ALL ASSUMPTIONS ABOUT THE CONTENTS OF REGS
			! ARE NO LONGER HELD
	CMPFNARGS,
	CMPLBL,
	CMPLIOLST,
	CMPLREL,
	CMPLXARRAY,
	BASE CSTMNT,	! Current statement
	DBLMODE,	! THIS FLAG  WORD IS  SET  WHEN A  STATEMENT  IS
			! BEING ALLOCATED DOUBLE-PRECISION MODE (IE  FOR
			! AN   ASSIGNMENT   STMNT   IF   THE   TOP-LEVEL
			! EXPRESSIONS ARE DOUBLE-PRECISION)
	DNEGCNST,
%2401%	DOTDCHECK,	! Tries to create compile time constant .Dnnnn
%2401%			! substring descriptors
%2275%	OBJECTCODE DOWDP, ! Info on compiling in innermost DO loops
%2364%	ENDSMZTRIP,	! Checks if CSTMNT ends a MAYBEZTRIP DO-loop
	EXCHARGS,	! ROUTINE  TO  EXCHANGE  ARG1  AND  ARG2  OF  AN
			! OPERATOR IF POSSIBLE
	FNREF,		! GLOBAL THAT GETS SET  WHEN PROCESSING A  STMNT
			! THAT CONTAINS FN CALLS
	FNVALCHK,	! ROUTINE TO CHECK FOR THE CASE OF AN ASSIGNMENT
			! OF A FN VAL DIRECTLY PRECEEDING A RETURN
	FNVLCH1,	! CHECK FOR ASSIGNMENT OF FN VAL DIRECTLY BEFORE
			! RETURN
	FREEPAIRS,	! ROUTINE TO COUNT  THE NUMBER  OF EVEN-ODD  REG
			! PAIRS INDICATED TO BE FREE BY A BIT PATTERN IN
			! WHICH 0'S REPRESENT  BUSY REGS, 1'S  REPRESENT
			! FREE REGS
	GBSYCT,
	GBSYREGS,
	GETRGPAIR,	! ROUTINE TO GET A PAIR OF FREE REGISTERS
	INPFLAG,	! THIS FLAG IS TRUE WHILE PROCESSING AN  IOLSIST
			! FOR A  STMNT  THAT  DOES  INPUT,  FALSE  WHILE
			! PROCESSING AN  IOLIST FOR  A STMNT  THAT  DOES
			! OUTPUT
	LPIXSUB,	! ROUTINE TO  SUBSTITUTE REGCONTENTS  NODES  FOR
			! REFERENCES TO THE LOOP INDEXIN AN INNERMOST DO
			! LOOP
	MAKEPR,
	MAKPR1,
	NOBBREGSLOAD,	! THIS  FLAG  IS  TRUE  WHEN  NODES  ARE   BEING
			! PROCESSED WHICH ARE  NOT ALWAYS EXECUTED  WHEN
			! THE  BLOCK  IN  WHICH  THE  ARE  CONTAINED  IS
			! EXECUTED (EG FOR  THE STMNT UNDER  A LOG  IF).
			! WHEN THIS FLAG IS SET, CANNOT ASSUME THAT REGS
			! SET BY EVAL OF THE NODE HAVE A GIVEN VAL
	NXTTMP,		! Get an n-word temporary
	PAIRMODE,	! GLOBAL  WHICH  WILL  BE  SET  TO  TRUE   WHILE
			! PERFORMING COMPLEXITY PASS OVER ANY NODE  THAT
			! REQUIRES AN ADJACENT PAIR OF REGISTERS
	PRCNSTARG,
	REGCLOBB,	! THIS ROUTINE IS CALLED WHENEVER AN  ALLOCATION
			! IS PERFORMED  WHICH WOULD  CAUSE THE  PREVIOUS
			! CONTENTS OF A  REG TO BE  CLOBBERED IT  CLEARS
			! THE BB REG ALLOC ENTRIES FOR THAT REG
	REGCONTAINING,	! ROUTINE OF BASIC BLOCK ALLOCATOR WHICH  CHECKS
			! WHETHER ANY REG HOLDS A GIVEN VAR. IF SO IT IT
			! RETURNS THE REG, IF NOT IT RETURNS -1
	REGTOUSE,
	RESNAME,
	RGTOSAVE,
	RGTOU1,
	SAVEREG,	! ROUTINE TO ADD A REGISTER  TO THE SET OF  REGS
			! WHOSE CONTENTS THE BB ALLOCATOR KNOWS ABOUT
	SAVREGCONTAINING,	! ROUTINE  IN   BASIC  BLOCK   ALLOCATOR
				! (MODULE "CMPBLO") WHICH CHECKS WHETHER
				! A VAR COULD  HAVE BEEN LEFT  IN A  REG
				! FROM A PREV STMNT AND IF SO MARKS THAT
				! STMNT TO LEAVE THE VAR
	SETCOMPLEXITY,
	SETTAC,
	SETTARGINREG,
	STBSYR,
	STCMSFN,
	STCMDO,
	STCMRETURN,
	STCMSUB,
	STRGCT,
	PEXPRNODE TREEPTR,
	VARCLOBB;	! THIS ROUTINE  IS  CALLED WHENEVER  A  NODE  IS
			! PROCESSED WHICH  WOULD CLOBBER  THE VAL  OF  A
			! VARIABLE. IT CLEARS ANY BB ALLOC ENTRIES  THAT
			! REFER TO THAT VAR
GLOBAL ROUTINE CMSTMN=
BEGIN
	!***************************************************************
	! Performs complexity analysis on  a statement. Called with  the
	! global CSTMNT pointing to the statement to be processed.   The
	! complexity walk,  allocation walk,  and code  generation  walk
	! must do the fields for each statement in the same order.
	!***************************************************************

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

	GLOBAL FNREF;	!GLOBAL THAT WILL GET SET IF ANY FN CALLS ARE
			! ENCOUNTERED IN PROCESSING A STMNT
	OWN PEXPRNODE RECNO;	!PTR TO SYMBOL TABLE OR CONSTANT TABLE ENTRY
				! FOR A RECORD NUMBER FOR AN IO STMNT

	%(***DEFINE A ROUTINE TO USE TO ALLOCATE CORE FOR ANY CONSTANT USED AS
		A RECORD NUMBER IN AN IO STMNT***)%
	ROUTINE CMPRECNO=
	BEGIN
		IF (RECNO_.CSTMNT[IORECORD]) NEQ 0
		THEN
		BEGIN
			IF .RECNO[OPR1] EQL CONSTFL
			THEN ALOCONST(.RECNO)

			%(***IF RECORD NUMBER IS AN EXPRESSION
				PERFORM COMPLEXITY WALK ON IT***)%
			ELSE
			BEGIN
				TREEPTR_.RECNO;
				SETCOMPLEXITY();
			END;
		END
	END;

	ROUTINE CMPUNIT=
	BEGIN
%2201%		! Rewritten by TFV, on 30-Mar-83
		! Compute complexity of UNIT= if specified

		IF .CSTMNT[IOUNIT] NEQ 0
		THEN
%2401%		BEGIN	! Non-zero UNIT

%2401%			! See if  we have  a  substring which  can  be
%2401%			! replaced with a .Dnnnn compile time constant
%2401%			! descriptor.
%2401%
%2401%			CSTMNT[IOUNIT] = TREEPTR = DOTDCHECK(.CSTMNT[IOUNIT]);

			IF .TREEPTR[OPR1] EQL CONSTFL
			THEN 	ALOCONST(.TREEPTR)
			ELSE 	IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN SETCOMPLEXITY();

%2401%		END;	! Non-zero UNIT

	END;

	ROUTINE CMPFMT=			! [1516] New
	BEGIN
%2314%	REGISTER DIMENTRY DTE;		! Dimension table for Hollerith array

		TREEPTR = .CSTMNT[IOFORM];
		IF .TREEPTR NEQ 0
		THEN IF EXTSIGN(.TREEPTR) NEQ -1
		THEN IF .TREEPTR[OPRCLS] NEQ LABOP
		THEN
		BEGIN
%2401%			! See if  we have  a  substring which  can  be
%2401%			! replaced with a .Dnnnn compile time constant
%2401%			! descriptor.
%2401%
%2401%			CSTMNT[IOFORM] = TREEPTR = DOTDCHECK(.TREEPTR);

			IF .TREEPTR[OPR1] EQL CONSTFL
			THEN ALOCONST(.TREEPTR)
%2314%			ELSE IF .TREEPTR[DATOPS1] EQL ARRAYNM1	! FMT=ARRAY ?
%2314%			THEN				! (Formal or local)
%2314%			BEGIN	! ARRAY

![2314]	Non-adjustably dimensioned Hollerith arrays need a constant
![2314]	allocated for the OTSKFSIZ FOROTS argument.  Create the
![2314]	constant now if some other FMT= hasn't already.

%2314%				DTE = .TREEPTR[IDDIM];	! Point to dim table

%2314%				IF NOT .DTE[ADJDIMFLG]
%2314%					AND .DTE[ARACONSIZ] EQL 0
%2314%				THEN
%2314%				BEGIN	! ALLOCATE
%2314%					DTE[ARACONSIZ] = MAKECNST(INTEGER,
%2314%							0, .DTE[ARASIZ]);
%2314%					ALOCONST(.DTE[ARACONSIZ]);
%2314%				END;	! ALLOCATE
%2314%			END	! ARRAY
			ELSE IF .TREEPTR[OPRCLS] NEQ DATAOPR
			     THEN SETCOMPLEXITY();
		END;
	END;

	ROUTINE CMPFILE=
	BEGIN
%2201%		! Written by TFV, on 30-Mar-83
		! Compute the complexity of FILE= for OPEN/CLOSE/INQUIRE

		IF .CSTMNT[IOFILE] NEQ 0
		THEN
%2401%		BEGIN	! Non-zero FILE

%2401%			! See if  we have  a  substring which  can  be
%2401%			! replaced with a .Dnnnn compile time constant
%2401%			! descriptor.
%2401%
%2401%			CSTMNT[IOFILE] = TREEPTR = DOTDCHECK(.CSTMNT[IOFILE]);

			IF .TREEPTR[OPR1] EQL CONSTFL
			THEN 	ALOCONST(.TREEPTR)
			ELSE 	IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN SETCOMPLEXITY();

%2401%		END;	! Non-zero FILE

	END;

%[760]%	ROUTINE CMPIOS=
%[760]%	%(***Routine to perform complexity walk for an iostat variable which
		is an array-ref***)%
%[760]%	BEGIN
%[760]%		IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]%		THEN
%[760]%		BEGIN
%[760]%			TREEPTR_.CSTMNT[IOIOSTAT];
%[760]%			IF .TREEPTR[OPRCLS] NEQ DATAOPR ! not simple var
%[760]%			THEN SETCOMPLEXITY();
%[760]%		END;
%[760]%	END;
	ROUTINE CMPRDKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
!	TO PERFORM COMPLEXITY PASS FOR THE IOKEY FIELD IN THE SOURCE TREE NODE
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO READ STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--    
	BEGIN !	[4501] New
		IF .CSTMNT[IOKEY] NEQ 0
		THEN
		BEGIN	! Non-zero IOKEY

			! See if  we have  a  substring which  can  be
			! replaced with a .Dnnnn compile time constant
			! descriptor.

			CSTMNT[IOKEY] = TREEPTR = DOTDCHECK(.CSTMNT[IOKEY]);

			IF .TREEPTR[OPR1] EQL CONSTFL
			THEN 	ALOCONST(.TREEPTR)
			ELSE 	IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN SETCOMPLEXITY();

		END;	! Non-zero IOKEY
	END;
 ROUTINE CMPOPKEY=

!++
! FUNCTIONAL DESCRIPTION:
!
!	TO PERFORM COMPLEXITY PASS FOR THE IOKEY FIELD IN THE SOURCE TREE NODE
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--    
BEGIN ! New [4500]
	REGISTER PEXPRNODE KEYVAL;	!PTR TO SYMBOL OR CONSTANT TABLE ENTRY
				! FOR THE VALUE TO BE PASSED TO FOROTS
				! FOR A GIVEN ARG
	REGISTER OPNKEYLIST KEYVALLST;	!LIST OF ARGS UNDER THIS OPEN STMNT
	REGISTER CMPL1;		

	OWN CMPLXMAX;	!MAXIMUM COMPLEXITY OF THE ARGS

	IF .CSTMNT[IOKEY] NEQ 0
	THEN
	BEGIN
		CMPLXMAX=0;

		KEYVALLST=.CSTMNT[IOKEY];
	
		%(***WALK THRU THE LIST OF KEYS - FOR ANY UPPER OR LOWER BOUND
		     OF A KEY THAT IS A CONSTANT OR A LITERAL ALLOCATE CORE 
		     FOR THAT CONSTANT/LITERAL***)%

		INCR I FROM 1 TO (.KEYVALLST[NUMKEYS])
		DO
		BEGIN
			IF .KEYVALLST[.I,KEYLOW] NEQ 0
			THEN
			BEGIN	! Key has a value
	
				! perform complexity pass for lower bound	
		
				! See if  we have  a  substring which  can  be
				! replaced with a .Dnnnn compile time constant
				! descriptor.
	
				KEYVALLST[.I,KEYLOW] = KEYVAL = DOTDCHECK(.KEYVALLST[.I,KEYLOW]);
	
				IF .KEYVAL[OPRCLS] EQL DATAOPR	!VAL A VAR OR CONST
				THEN
				! Allocate core for a constant
				(IF .KEYVAL[OPR1] EQL CONSTFL THEN ALOCONST(.KEYVAL))
				ELSE		!VAL AN EXPRESSION (OR ARRAYREF)
				BEGIN
					! Perform "complexity" pass over  this
					! expression.  If  its  complexity  is
					! greater than the maximum, change the
					! maximum.
	
					TREEPTR=.KEYVAL;
					IF (CMPL1=SETCOMPLEXITY()) GTR .CMPLXMAX
					THEN CMPLXMAX=.CMPL1;
				END;
	
				! perform complexity pass for upper bound	
	
				! See if  we have  a  substring which  can  be
				! replaced with a .Dnnnn compile time constant
				! descriptor.
	
				KEYVALLST[.I,KEYHIGH] = KEYVAL = DOTDCHECK(.KEYVALLST[.I,KEYHIGH]);
	
				IF .KEYVAL[OPRCLS] EQL DATAOPR	!VAL A VAR OR CONST
				THEN
					! Allocate core for a constant
					(IF .KEYVAL[OPR1] EQL CONSTFL THEN ALOCONST(.KEYVAL))
				ELSE		!VAL AN EXPRESSION (OR ARRAYREF)
				BEGIN
					! Perform "complexity" pass over  this
					! expression.  If  its  complexity  is
					! greater than the maximum, change the
					! maximum.

					TREEPTR=.KEYVAL;
					IF (CMPL1=SETCOMPLEXITY()) GTR .CMPLXMAX
					THEN CMPLXMAX=.CMPL1;
				END;
	
			END;	! key has a value 	
		END;

	END;	! IOKEY NEQ 0		
END;	! of CMPOPKEY
	%(***IF WE ARE IN A DO LOOP IN WHICH THE
		LOOP INDEX LIVES IN A REGISTER, SUBSTITUTE "REGCONTENTS" NODES FOR
		ALL REFERENCES TO THE LOOP INDEX THAT OCCUR IN THIS STMNT***)%
	LPIXSUB();

	PAIRMODE_FALSE;	!INIT GLOBAL WHICH WILL BE USED TO DETERMINE WHETHER THIS
			! STATEMENT INCLUDES ANY EXPRESSIONS THAT REQUIRE REGISTER PAIRS
	FNREF_FALSE;	!INIT GLOBAL THAT WILL BE USED TO DETERMINE WHETHER THIS STMNT
			! CONTAINS ANY FN REFERENCES

	%(***SRCID OF STMNT DETERMINES ACTION TO BE TAKEN***)%
	CASE .CSTMNT[SRCID] OF SET

	STCMASMNT();		! ASSIGNMENT	
	SCMASSI();		! ASSIGN

	BEGIN			! CALL
		CSTMNT[SRCCMPLX]_(IF .CSTMNT[CALLIST] EQL 0	
			THEN 0
%1474%			ELSE CMPFNARGS(.CSTMNT[CALLIST],FALSE,NOTINCONCAT));
		STCMCSB();	! PROCESS ANY COMMON SUBS
	END;

	CSTMNT[SRCCMPLX]_0;	! CONTINUE
	STCMDO();		! DO
	STCMSUB();		! ENTRY
	STCMASMNT();		! COMMON SUB (SAME AS ASMNT
	CSTMNT[SRCCMPLX]_0;	! GOTO
	STCMAGO();		! ASSIGNED GOTO
	STCMCGO();		! COMPUTED GOTO
	STCMAIF();		! ARITHMETIC IF
	STCMLIF();		! LOGICAL IF
	STCMRETURN();		! RETURN
	STCMSTOP();		! STOP

	BEGIN			! READ
		CMPUNIT();
%1516%		CMPFMT();	
		CMPRECNO();
%[760]%		CMPIOS();	! set iostat complexity
%4501%		CMPRDKEY();	! set IOKEY complexity
		CMPLIOLST();
	END;

	BEGIN			! WRITE
		CMPUNIT();
%1516%		CMPFMT();	
		CMPRECNO();
%[760]%		CMPIOS();	! set iostat complexity
		CMPLIOLST();
	END;

%[760]%	BEGIN			! DECODE
%1516%		CMPFMT();	
%[760]%		CMPIOS();	! set iostat complexity
%[760]%		CMPDECENC();
%[760]%	END;

%[760]%	BEGIN			! ENCODE
%1516%		CMPFMT();	
%[760]%		CMPIOS();	! set iostat complexity
%[760]%		CMPDECENC();
%[760]%	END;

%[760]%	BEGIN			! REREAD
%[760]%		CMPUNIT();
%1516%		CMPFMT();	
%[760]%		CMPIOS();	! set iostat complexity
%[760]%		CMPLIOLST();
	END;

	BEGIN			! FIND
		CMPUNIT();
		CMPRECNO();
%[760]%		CMPIOS();	! set iostat complexity
	END;

	BEGIN			! CLOSE
		CMPUNIT();
%2201%		CMPFILE();	! set FILE= complexity
%[760]%		CMPIOS();	! set iostat complexity
		STCMOPEN();
	END;

%4502%	BEGIN			! DELETE
%4502%		CMPUNIT();
%4502%		CMPRECNO();
%4502%		CMPIOS();	! set iostat complexity
%4502%	END;

%4503%	BEGIN			! REWRITE
%4503%		CMPUNIT();
%4503%		CMPFMT();	
%4503%		CMPIOS();	! set iostat complexity
%4503%		CMPLIOLST();
%4503%	END;

%[760]%	BEGIN			! BACKSPACE
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%[760]%	BEGIN			! BACKFILE
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%[760]%	BEGIN			! REWIND
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%[760]%	BEGIN			! SKIPFILE
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%[760]%	BEGIN			! SKIP RECORD
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%[760]%	BEGIN			! UNLOAD
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

%4504%	BEGIN			! UNLOCK
%4504%		CMPUNIT();
%4504%		CMPIOS();	! set iostat complexity
%4504%	END;

%[760]%	BEGIN			! ENDFILE
%[760]%		CMPUNIT();
%[760]%		CMPIOS();	! set iostat complexity
%[760]%	END;

	CSTMNT[SRCCMPLX]_0;	! END
	STCMSTOP();		! PAUSE

	BEGIN			! OPEN
		CMPUNIT();
%2201%		CMPFILE();	! set FILE= complexity
%[760]%		CMPIOS();	! set iostat complexity
%4500%		CMPOPKEY();	! set IOKEY= complexity
		STCMOPEN();
	END;

	STCMSFN();		! SFN
	CSTMNT[SRCCMPLX]_0;	! FORMAT
	CSTMNT[SRCCMPLX]_0;	! BLT (NOT IN RELEASE 1)
	CSTMNT[SRCCMPLX]_0;	! GLOBAL ALLOCATOR ID

%2201%	BEGIN			! INQUIRE
%2201%		CMPUNIT();
%2201%		CMPFILE();	! set FILE= complexity
%2201%		CMPIOS();	! set iostat complexity
%2201%		STCMOPEN();
	END;

	TES;

	!If any expressions were encountered that required adjacent reg pairs
	!set flag in stmnt 
	IF .PAIRMODE THEN CSTMNT[PAIRMODEFLG]_1;

	!If any fn calls were encountered set flag in stmnt
	IF .FNREF THEN CSTMNT[FNCALLSFLG]_1;


%2275%	! If we are in  an innermost DO loop  and this statement is  the
%2275%	! terminating statement of  the loop,  then we  are leaving  the
%2275%	! inner  loop.   Turn   off  the   global  variable   containing
%2275%	! information for REGCONTENTS node substitution in an  innermost
%2275%	! DO loop.
%2275%
%2275%	IF .DOWDP NEQ 0					! Innermost DO
%2275%	THEN IF .CSTMNT[SRCLBL] EQL .CDONODE[DOLBL]	! Stmnt's = DO's label?
%2275%	THEN DOWDP = 0;					! Mark; no longer in DO

END;	! of CMSTMN
ROUTINE ALCTMP =		! [1700] New

! Call ALCINTMP for I/O specifier.  Convert
! STBSYR to double mode if expression is double mode.

BEGIN
	LOCAL BSYRG1, FRGCT1;
	IF NOT .TREEPTR[DBLFLG]
	THEN ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT)
	ELSE
	BEGIN
		BSYRG1 = DPBSYREGS(.STBSYR);
		FRGCT1 = ONESCOUNT(.BSYRG1);
		ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1);
	END;

END;	! ALCTMP
GLOBAL ROUTINE ALCSTMN=
	!***************************************************************
	! Routine to perform local register allocation for a  statement.
	! Called with the global CSTMNT pointing to the statement to  be
	! processed, STBSYR  which  has  a bit  set  for  each  register
	! available for  use in  evaluating this  statement, and  STRGCT
	! which is the count of the number of registers available.   The
	! complexity walk,  allocation walk,  and code  generation  walk
	! must do the fields for each statement in the same order.
	!***************************************************************
BEGIN


	ROUTINE ALCUNIT=
	%(***ROUTINE TO PERFORM REG ALLOC FOR A UNIT NUMBER WHICH IS
		AN EXPRESSION OR ARRAYREF***)%
	BEGIN
%2201%		IF (TREEPTR = .CSTMNT[IOUNIT]) NEQ 0
%2201%		THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR	!IF NOT A SIMPLE VAR OR CONST
		THEN
		BEGIN
			IF .TREEPTR[OPRCLS] EQL ARRAYREF
			!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
			THEN CSTMNT[IOUNIT]_ALCTVARR(.STBSYR,.STRGCT)
%1700%			ELSE ALCTMP();	! Allocate a 1 or 2 word .Q temp

		END;

	END;	! of ALCUNIT

	ROUTINE ALCFMT=		! [1516] New
	%(*** Routine to do reg allocation for FMT= expression.  This
		is either a label, array name, scalar, or character expression.
		The only nontrivial case is the character expression. ***)%
	BEGIN
		TREEPTR_.CSTMNT[IOFORM];
%1555%		IF .TREEPTR NEQ 0			! FMT is specified
%1555%		THEN IF EXTSIGN(.TREEPTR) NEQ -1	! FMT is not *
		THEN IF .TREEPTR[VALTYPE] EQL CHARACTER	! FMT is char expr
%2203%		THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR	! is not var or const
%1700%		THEN ALCTMP();				! allocate it
	END;	! ALCFMT


	ROUTINE ALCFILE=
	BEGIN
%2201%		! Written by TFV, on 30-Mar-83
%2201%		! Allocate FILE= for OPEN/CLOSE/INQUIRE

		IF (TREEPTR = .CSTMNT[IOFILE]) NEQ 0	! FILE is specified
%2203%		THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR	! is not var or const
		THEN ALCTMP();
	END;	! of ALCFILE

%[760]%	ROUTINE ALCIOS=
%[760]%	%(*** Routine to perform reg alloc for an iostat variable
		Note that the variable is always clobbered since
		this is an implicit assignment***)%
%[760]%	BEGIN

%[760]%		IF .CSTMNT[IOIOSTAT] NEQ 0
%[760]%		THEN
%[760]%		BEGIN
%[760]%			TREEPTR_.CSTMNT[IOIOSTAT];
%[760]%			IF .TREEPTR[OPRCLS] EQL ARRAYREF
%1123%			THEN	! Store the address of the element and
%1123%				! indirect through it in the arg block
%1123%				CSTMNT[IOIOSTAT]_ALCTARY(.STBSYR,.STRGCT);
%1123%
%[760]%		VARCLOBB(.CSTMNT[IOIOSTAT]);	! always clobber var
%[760]%		END;

%[760]%	END;	! of ALCIOS



	ROUTINE ALCRANDIO=
	%(*************
		PERFORM REG ALLOC FOR RANDOM ACCESS IO.
		MUST  PERFORM ALLOCATION FOR THE CALC OF THE RECORD NUMBER
		AND ALSO BB ALLOCATOR MUST ASSUME THAT THE VALS OF ALL ASSOCIATE
		VARIABLES ARE CHANGED.
	*************)%
	BEGIN
		REGISTER ASSCELEM;	!AN ELEMENT ON THE LINKED LIST OF ASSOC-VAR PTRS

		IF (TREEPTR_.CSTMNT[IORECORD]) EQL 0	!IF DO NOT HAVE RANDOM ACCESS
		THEN RETURN;			! NO PROCESSING IS NEEDED

		IF .TREEPTR[OPRCLS] NEQ DATAOPR	!IF THE RECORD NUMBER IS NOT A SIMPLE VAR OR CONST
		THEN
		BEGIN
			IF .TREEPTR[OPRCLS] EQL ARRAYREF
			!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
			THEN CSTMNT[IORECORD]_ALCTVARR(.STBSYR,.STRGCT)
%1700%			ELSE ALCTMP();	! Allocate a 1 or 2 word .Q temp

		END;


		ASSCELEM_.ASSOCPT;
		UNTIL .ASSCELEM<RIGHT> EQL 0	!LOOK AT ALL ASSOC VARS IN THE PROGRAM
						! RIGHT HALF OF EACH ENTRY ON THE LINKED
						! LIST PTS TO NEXT ELEM
		DO
		BEGIN
			ASSCELEM_@.ASSCELEM<RIGHT>;	!GET THE CONTENTS OF THE NEXT ELEMENT
			VARCLOBB(.ASSCELEM<LEFT>);	!LEFT HALF OF WD ON ASSOC VAR
						! LIST PTS TO SYM TABLE ENTRY FOR THE VAR
		END;
	! IF THE OPEN OCCURS OUTSIDE THIS PROGRAM MODULE, THEN
	!WE MUST ASSUME THAT ALL COMMON/EQUIV VARS ARE CLOBBERED
	!SINCE THEY COULD BE ASSOCIATE VARIABLES!
	CLOBBCOMEQV();
	END;	!of ALCRANDIO


	ROUTINE CHECKNLIST (LISTPTR)=
	%(	CHECK THE LIST OF VARIABLES POINTED TO BY A NAMELIST NAME
		AND CLEAR OUT ANY WHICH ARE CURRENTLY LIVING IN REGISTERS
		SINCE THEY MAY BE CLOBBERED DURING AN INPUT REFERENCING
		THAT NAMELIST NAME.
	*************)%
	BEGIN
		REGISTER T1;
		MAP BASE LISTPTR;
		!LISTPTR POINTS TO A NAMELIST BLOCK CONTAINING POINTERS
		! TO ALL THE VARIBLES SYMBOL TABLE ENTRIES
		INCR I FROM 0 TO .LISTPTR[NAMCNT]-1 DO	!SCAN THRU THE LIST OF POINTERS
		BEGIN
			T1_@(.LISTPTR[NAMLIST]+.I);	!GET THE SYMBOL TABLE POINTER
			VARCLOBB(.T1<RIGHT>);	!GET RID OF IT IF IN REG
		END;

	END;	! of CHECKNLIST
	ROUTINE ALCRDKEY=
!++
! FUNCTIONAL DESCRIPTION:
!
! 	Performs register allocation expression pointed to by the IOKEY field. 
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--

	BEGIN
		IF (TREEPTR = .CSTMNT[IOKEY]) NEQ 0
		THEN IF .TREEPTR[OPRCLS] NEQ DATAOPR	!IF NOT A SIMPLE VAR OR CONST
		THEN
		BEGIN
			IF .TREEPTR[OPRCLS] EQL ARRAYREF
			!FOR AN ARRAYREF - MUST LINK A STORECLS NODE UNDER THE STATEMENT NODE
			THEN CSTMNT[IOKEY]_ALCTVARR(.STBSYR,.STRGCT)
			ELSE ALCTMP();	! Allocate a 1 or 2 word .Q temp

		END;

	END;	! of ALCRDKEY
 ROUTINE ALCOPKEY=

!++
! FUNCTIONAL DESCRIPTION:
!
! 	Performs register allocation  for the lower and upper bounds 
! 	of the keys that are expressions pointed to by the IOKEY field. 
! 	Global INPFLAG is TRUE for INQUIRE and indicates that the 
! 	arguments are modified.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	IMPFLAG		THIS STMNT DOES INPUT
!	CSTMNT		PTR TO OPEN STATEMENT NODE
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--
BEGIN 	! New [4500]
	REGISTER OPNKEYLIST KEYVALLST;	!list of keys

	IF .CSTMNT[IOKEY] NEQ 0
	THEN
	BEGIN
		KEYVALLST = .CSTMNT[IOKEY];! List of arguments under the stmnts
	
		! Walk thru the list  of keys, perform register  allocation
		! for the calculation of any upper and lower bound of a key 
		! that is not a variable or const
	
		DECR I FROM .KEYVALLST[NUMKEYS] TO 1 DO
		BEGIN
			! Expression node for the val of the lower bound of the Ith key
			TREEPTR = .KEYVALLST[.I,KEYLOW];
	
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN
			BEGIN
			    ! Allocate a 1 word .Q temp
			    IF .TREEPTR[OPRCLS] NEQ ARRAYREF
			    THEN ALCSTAYINTMP(NXTTMP(1),.STBSYR,.STRGCT) 

			    ! Allocate variable to temp
			    ELSE KEYVALLST[.I,KEYLOW] = ALCTVARR(.STBSYR,.STRGCT)	
			END;
	
			! INQUIRE clobbers its arguments
	
			IF .INPFLAG THEN VARCLOBB(.TREEPTR);
	
			! Expression node for the val of the upper bound of the Ith key
			TREEPTR = .KEYVALLST[.I,KEYHIGH];
	
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN
			BEGIN
			    ! Allocate a 1 word .Q temp
			    IF .TREEPTR[OPRCLS] NEQ ARRAYREF
			    THEN ALCSTAYINTMP(NXTTMP(1),.STBSYR,.STRGCT) 

			    ! Allocate variable to temp
			    ELSE KEYVALLST[.I,KEYHIGH] = ALCTVARR(.STBSYR,.STRGCT);				
			END;
	
			! INQUIRE clobbers its arguments
	
			IF .INPFLAG THEN VARCLOBB(.TREEPTR);
		END;
	END;	
END;	! of ALCOPKEY




	DBLMODE_FALSE;	!FLAG WILL BE SET TO TRUE WHEN A STATEMENT IS PROCESSED
			! IN DOUBLE-WD MODE (IE USES REG PAIRS). INITIALIZE IT TO FALSE.

	IF .CSTMNT[PAIRMODEFLG]	!IF THIS STATEMENT REQUIRES ANY ADJACENT REG PAIRS
	THEN PAIRMODE_TRUE	! INIT GLOBAL INDICATING THAT AT LEAST
	ELSE PAIRMODE_FALSE;	! ONE FREE PAIR SHOULD ALWAYS BE LEFT


	IF .FLGREG<DBGLABL>	!FORGET ABOUT OPTIMIZING REGISTER
	THEN	!USAGE ACROSS STATEMENTS IF FORDDT MAY CHANGE
	CLRRGSTATE();	!VALUES IN CORE

	%(***ACTION TO BE TAKEN IS DETERMINED BY THE SRCID***)%
	CASE .CSTMNT[SRCID] OF SET

	ALCASMNT();		!ASSIGNMENT
	ALCASSI();		!ASSIGN
	ALCCALL();		!CALL
	BEGIN END;		!CONTINUE
	ALCDOSTMT();		!DO
	ALCENTRY();		!ENTRY
	ALCASMNT();		!COMMON SUB - SAME AS ASSIGNMENT
	BEGIN END;		! GOTO
	ALCAGO();		! ASSIGNED GOTO
	ALCCGO();		! COMPUTED GOTO
	ALCAIF();		! ARITH IF
	ALCLIF();		! LOGICAL IF
	ALCRETURN();		! RETURN
	BEGIN END;		! STOP

	BEGIN			! READ
		ALCUNIT();
		INPFLAG = TRUE;	!SET GLOBAL FLAG TO INDICATE THAT THE IOLIST TO
				! BE PROCESSED DOES INPUT
		IF .CSTMNT[IONAME] NEQ 0	!SEE IF NAMELIST
		AND .CSTMNT[IONAME] NEQ #777777	!TYPE READ
		THEN	!YES
		BEGIN
			LOCAL BASE T1;
			T1_.CSTMNT[IONAME];
%1555%			IF .T1[OPR1] EQL VARFL
			THEN IF .T1[IDATTRIBUT(NAMNAM)] EQL 1
				! SEE IF NAMELIST BIT IS ON IN SYMBOL TABLE 
				! ENTRY THEN CLEAR ANY REGISTERS CONTAINING
				! VARIABLES IN THE NAMELIST
			THEN CHECKNLIST(.T1[IDCOLINK]);
		END;
%1516%		ALCFMT();
		ALCRANDIO();
%[760]%		ALCIOS();	! process iostat
%4501%		ALCRDKEY();	! process IOKEY field
		ALCIOLST();	!PROCESS THE IOLIST		
	END;

	BEGIN			! WRITE
		ALCUNIT();
		INPFLAG = FALSE;	! SET GLOBAL FLAG TO INDICATE THAT THE 
				! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%1516%		ALCFMT();
		ALCRANDIO();
%[760]%		ALCIOS();	! process iostat
		ALCIOLST();		
	END;

	BEGIN			! DECODE
		INPFLAG = TRUE;	!SET GLOBAL FLAG TO INDICATE THAT THE IOLIST
				! TO BE PROCESSED DOES INPUT
%1516%		ALCFMT();
%[760]%		ALCIOS();	! process iostat
		ALCDECENC();	! ENCODE/DECODE
	END;

	BEGIN			! ENCODE
		INPFLAG = FALSE;	! SET GLOBAL FLAG TO INDICATE THAT THE
				! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%1516%		ALCFMT();
%[760]%		ALCIOS();	! process iostat
		ALCDECENC();	! ENCODE/DECODE
	END;

	BEGIN			!REREAD
		ALCUNIT();
		INPFLAG = TRUE;	!SET GLOBAL FLAG TO INDICATE THAT THE IOLIST TO
				! BE PROCESSED DOES INPUT
%1516%		ALCFMT();
%[760]%		ALCIOS();	! process iostat
		ALCIOLST();
	END;

%[760]%	BEGIN			! FIND
%2040%		ALCUNIT();
%2040%		ALCRANDIO();
%2040%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! CLOSE
%[760]%		ALCUNIT();
%2201%		ALCFILE();	! allocate FILE=		
%[760]%		ALCIOS();	! process iostat

%2201%		! Set flag for this statement does not do input
%2201%		INPFLAG = FALSE;
%[760]%		ALCOPEN();
%[760]%	END;

%4502%	BEGIN			! DELETE
%4502%		ALCUNIT();
%4502%		ALCRANDIO();
%4502%		ALCIOS();	! process iostat
%4502%	END;		

%4503%	BEGIN			! REWRITE
%4503%		ALCUNIT();
%4503%		INPFLAG = FALSE;	! SET GLOBAL FLAG TO INDICATE THAT THE 
%4503%				! IOLIST TO BE PROCESSED DOES NOT DO INPUT
%4503%		ALCFMT();
%4503%		ALCRANDIO();
%4503%		ALCIOS();	! process iostat
%4503%		ALCIOLST();		
%4503%
		END;

%[760]%	BEGIN			! BACKSPACE
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! BACKFILE
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! REWIND
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! SKIPFILE
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! SKIPRECORD
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%[760]%	BEGIN			! UNLOAD
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

%4504%	BEGIN			! UNLOCK
%4504%		ALCUNIT();
%4504%		ALCIOS();	! process iostat
%4504%	END;

%[760]%	BEGIN			! ENDFILE
%[760]%		ALCUNIT();
%[760]%		ALCIOS();	! process iostat
%[760]%	END;

	BEGIN END;		! END
	BEGIN END;		! PAUSE

	BEGIN			! OPEN
		ALCUNIT();
%2201%		ALCFILE();	! allocate FILE=		
%[760]%		ALCIOS();	! process iostat
%2201%		! Set flag for this statement does not do input
%2201%		INPFLAG = FALSE;
%4500%		ALCOPKEY();	! allocate KEY=
		ALCOPEN();
	END;

	ALCSFN();		! SFN
	BEGIN END;		! FORMAT
	BEGIN END;		! BLT (NOT IN RELEASE 1)

	BEGIN		! GLOBAL ALLOCATOR ID - INDICATING THAT THE SET of
			! REGISTERS AVAILABLE SHOULD CHANGE SET OF REGS TO BE
			! USED IN STATEMENTS FOLLOWING

		GBSYREGS<LEFT>_.CSTMNT[NEWREGSET];	
		GBSYCT_ONESCOUNT(.GBSYREGS);
	END;

%2201%	BEGIN			! INQUIRE
%2201%		ALCUNIT();
%2201%		ALCFILE();	! allocate FILE=
%2201%		ALCIOS();	! process iostat

%2201%		! Set flag for this statement does input
%2201%		INPFLAG = TRUE;
%2201%		ALCOPEN();
%2201%	END;

	TES;

	%(***IF THIS STATEMENT HAS A LABEL, PERFORM REG ALLOC FOR ANY DO-LOOP TERMINATION
		IMPLIED BY THAT LABEL****)%
	IF .CSTMNT[SRCLBL] NEQ 0
	THEN ALCDOEND(.CSTMNT[SRCLBL]);

END;	! of ALCSTMN
GLOBAL ROUTINE STCMASMNT=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY PASS FOR AN ASSIGNMENT
	STATEMENT.
	DETERMINES THE NUMBER OF REGS  NECESSARY FOR COMPUTATION OF THE
	LEFT AND RIGHT SIDES AND FOR ALL COMMON SUBEXPRESSIONS.
	DETERMINES WHICH SIDE SHOULD BE COMPUTED  FIRST.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE.
	THIS ROUTINE IS NOT CALLED RECURSIVELY.
***************************************************************************)%
BEGIN
	OWN CMPLX1:CMPLX2;
	OWN PEXPRNODE ARG1NODE;
	OWN PEXPRNODE LHNODE;
	OWN PEXPRNODE RHNODE;


	IF .FLGREG<PROGTYP> EQL FNPROG 
	THEN
		FNVLCH1();	!KEEP A CT OF ASSIGNMENTS OF THE FN VAL THAT DIRECTLY
			! PRECEDE RETURN STMNTS
	RHNODE_.CSTMNT[RHEXP];
	LHNODE_.CSTMNT[LHEXP];


	IF .CSTMNT[MEMCMPFLG]	!IF THIS ASSIGNMENT WILL BE PERFORMED TO MEMORY
		AND .RHNODE[OPRCLS] NEQ SPECOP	! AND THE OPERATION IS ARITHMETIC OR BOOLEAN
%4517%		AND .LHNODE[OPR1] NEQ CHARFNFL	! NOT CHAR ASMNT	
	THEN
	BEGIN
		 ORDERMEMCMP();	!ORDER THE ARGS UNDER RHS SO THAT THE ARG THAT MATCHES LHS IS ARG2
		ARG1NODE_.RHNODE[ARG1PTR];	!GET PTR TO ARG NOT IDENTICAL TO LHS

%2335%		! If that  arg is  the integer  constant one  and  the
%2335%		! operation is integer add (or sub) then perform  this
%2335%		! op to  both  rather  than to  memory  (so  that  can
%2335%		! peephole AOS and SOS).
%2335%
%2335%		IF .ARG1NODE[OPERATOR] EQL INTCONST
%2335%		THEN IF .ARG1NODE[CONST2] EQL 1
%2335%		THEN IF .RHNODE[OPERATOR] EQL INTADD
%2335%		THEN RHNODE[OPTOBOTHFLG] = 1;

	END;

	IF .CSTMNT[A1VALFLG]
	THEN
	%(***IF LHS IS A SIMPLE VARIABLE, SET UP PTR TO THE SYMBOL TABLE ENTRY***)%
	BEGIN
		RESNAME_.CSTMNT[LHEXP];
		CMPLX1_0;

	END
	ELSE
	%(***IF LHS REQUIRES EVALUATION (IE IS AN ARRAY REFERENCE), DETERMINE NUMBER OF
		REGS NEEDED FOR THAT CALC***)%
	BEGIN
		TREEPTR_.CSTMNT[LHEXP];
		CMPLX1_SETCOMPLEXITY();
		RESNAME_.LHNODE[ARG1PTR];
	END;

	%(***DETERMINE THE NUMBER OF REGS NECESSARY FOR EVALUATION OF RHS***)%
	IF NOT .CSTMNT[A2VALFLG]
	THEN
	BEGIN
		TREEPTR_.CSTMNT[RHEXP];
		CMPLX2_SETCOMPLEXITY();
	END;

	%(***IF RIGHT HAND SIDE IS A VARIABLE OR A CONSTANT, STILL NEED ONE REG TO LOAD THE VAL INTO***)%
	IF .RHNODE[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		CMPLX2_1;

		%(***IF RHNODE IS A CONSTANT, DETERMINE WHETHER IT IS
			AN IMMED CONSTANT AND IF NOT ALLOCATE CORE FOR IT***)%
		IF .RHNODE[OPR1] EQL CONSTFL
		THEN
		PRCNSTARG(.CSTMNT,.RHNODE,FALSE);


		%(**IF RHS COULD HAVE BEEN LEFT IN A REG EARLIER, DO SO**)%
		SAVREGCONTAINING(.RHNODE);

		%(**IF THE VAR ON THE RHS IS NEEDED LATER, WILL BE ABLE TO USE
			IT FROM THE REG USED FOR THIS ASMNT**)%
		ADDREGCANDATE(.RHNODE,.CSTMNT);


	END;

	%(***IF THE RHS IS DOUBLE-PREC, NEED TWICE AS MANY REGS AS HAVE COMPUTED***)%
	IF .RHNODE[DBLFLG] THEN CMPLX2_2*.CMPLX2;


	%(***SET FIELD IN THE ASSIGNMENT-STMNT NODE TO INDICATE THE NUMBER OF REGS
		NECESSARY TO EVAL THE STMNT EXCLUSIVE OF COMMON SUBEXPRS***)%
	CSTMNT[SRCCMPLX]_
		(IF .CMPLX1 GTR .CMPLX2
		THEN .CMPLX1
		ELSE
		IF .CMPLX2 GTR .CMPLX1
		THEN .CMPLX2
		ELSE .CMPLX1+1 );


	%(***PERFORM COMPLEXITY ANALYSIS FOR EACH COMMON SUBEXPRESSION UNDER
		THIS NODE*******)%
	STCMCSB();

	%(**IF THE LHS VAR IS NEEDED LATER, IT CAN BE USED DIRECTLY FROM THE REG
		USED FOR THIS ASMNT***)%
	IF .CSTMNT[A1VALFLG] THEN ADDREGCANDATE(.LHNODE,.CSTMNT);

END;	! of  STCMASMNT
GLOBAL ROUTINE STCMAGO=
%(***************************************************************************
	ROUTINE TO COMPUTE THE COMPLEXITY OF AN ASSIGNED GOTO
***************************************************************************)%
BEGIN
	%(***COMPUTE COMPLEXITY OF THE ASSIGNED VAL (MAY BE AN ARRAY-REF***)%
	TREEPTR_.CSTMNT[AGOTOLBL];
	IF .TREEPTR[OPRCLS] EQL DATAOPR
	THEN
	CSTMNT[SRCCMPLX]_0
	ELSE
	CSTMNT[SRCCMPLX]_SETCOMPLEXITY();

	%(***FIND COMPLEXITY OF ANY COMMON SUBEXPRS***)%
	STCMCSB();

END;	! of STCMAGO
GLOBAL ROUTINE STCMCGO=
%(***************************************************************************
	ROUTINE TO COMPUTE COMPLEXITY OF A COMPUTED GOTO
***************************************************************************)%
BEGIN
	%(***CALCULATE THE COMPLEXITY OF THE EXPRESSION TO BE COMPUTED***)%
	TREEPTR_.CSTMNT[CGOTOLBL];
	IF .TREEPTR[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
		CSTMNT[SRCCMPLX]_0
	END
	ELSE
	CSTMNT[SRCCMPLX]_SETCOMPLEXITY();

	%(***FIND COMPLEXITY OF ANY COMMON SUBEXPRS***)%
	STCMCSB();

END;	! of STCMCGO
GLOBAL ROUTINE STCMSTOP=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY FOR STOP AND PAUSE.
	THE ARG FOR STOP/PAUSE CAN ONLY BE A VARIABLE OR A CONSTANT OR
	LITERAL (CANNOT BE AN EXPRESSION).
	MUST ALLOCATE THE CONSTANT OR LITERAL IF THERE IS ONE.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE STOPEXPR;

	IF (STOPEXPR_.CSTMNT[STOPIDENT]) NEQ 0
	THEN
	BEGIN
		IF .STOPEXPR[OPR1] EQL CONSTFL
		THEN ALOCONST(.STOPEXPR);
	END;

	CSTMNT[SRCCMPLX]_0;

END;	! of STCMSTOP
GLOBAL ROUTINE STCMLIF=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY PASS FOR A LOGICAL IF.
	DETERMINES THE NUMBER OF REGS NECESSARY FOR COMPUTATION OF
	THE LOGICAL EXPRESSION AND FOR THE SUBSTATEMENT AND FOR ANY COMMON SUBEXPRS.
	SETS THE COMPLEXITY OF THE STATEMENT TO THE MAXIMUM OF THESE.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT TO BE PROCESSED.
	THIS ROUTINE IS NEVER CALLED RECURSIVELY (SINCE IT IS ILLEGAL TO EMBED
	A LOGICAL IF INSIDE ANOTHER)
***************************************************************************)%
BEGIN
	LOCAL CEXPRPAIRMODE;	!VALUE OF "PAIRMODE" FOR THE CONDITIONAL EXPR
				! (TRUE IFF THE COND USES ANY REG PAIRS)
	LOCAL CEXPRFNREF;	!VALUE OF "FNREF" FOR THE CONDITIONAL EXPR (TRUE IFF
				! THERE ARE ANY FN CALLS IN THE CEXPR)
	OWN PEXPRNODE CONDEXPR;
	OWN BASE SAVSTMNT;			!SAVE PTR TO THIS STMNT

	%(***PERFORM COMPLEXITY ANALYSIS ON THE CONDITIONAL EXPR***)%
	CONDEXPR_.CSTMNT[LIFEXPR];
	TREEPTR_.CONDEXPR;

	%(****FOR RELATIONALS AND CONTROL-TYPE BOOLEANS, NEED NEVER COMPUTE A VALUE***)%
	IF .CONDEXPR[VALTYPE] EQL CONTROL
	THEN
	BEGIN
		IF .CONDEXPR[OPRCLS] EQL BOOLEAN
		THEN
		CSTMNT[SRCCMPLX]_CMPLBL()
		ELSE
		IF .CONDEXPR[OPRCLS] EQL RELATIONAL
		THEN
		CSTMNT[SRCCMPLX]_CMPLREL()
		ELSE
		CGERR()
	END

	%(***FOR EXPRESSIONS WHICH DO NOT HAVE VALTYPE CONTROL, WILL COMPUTE A VAL AND TEST IT***)%
	ELSE
	BEGIN
		%(***IF CONDEXPR IS A CONSTANT, THIS STMNT WILL HAVE BEEN FOLDED AWAY IN
			P2SKEL IF P2SKEL IS USED; IF P2SKEL IS NOT USED, A CONSTANT
			CONDEXPR IS ALLOCATED TO CORE****)%
		IF .CONDEXPR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
		CSTMNT[SRCCMPLX]_SETCOMPLEXITY();
	END;


	CEXPRPAIRMODE_.PAIRMODE;	!SAVE KNOWLEDGE OF WHETHER THE COND EXPR USED ANY REG PAIRS
	CEXPRFNREF_.FNREF;		!SAVE KNOWLEDGE OF WHETHER THE COND EXPR HAD ANY FN CALLS

	%(***COMPUTE THE COMPLEXITY OF THE SUBSTATEMNT***)%
	SAVSTMNT_.CSTMNT;			!SAVE PTR TO THIS STMNT

	CSTMNT_.CSTMNT[LIFSTATE];

	CMSTMN();

	%(**THE IF STATEMENT REQUIRES AT LEAST AS MANY REGS AS ARE NECESSARY FOR
		COMPUTATION OF THE SUBSTATEMENT***)%
	IF .SAVSTMNT[SRCCMPLX] LSS .CSTMNT[SRCCMPLX]
	THEN
	SAVSTMNT[SRCCMPLX]_.CSTMNT[SRCCMPLX];

	CSTMNT_.SAVSTMNT;			!RESTORE VAL OF CSTMNT

	%(***PERFORM COMPLEXITY ANALYSIS FOR COMMON SUBEXPRS***)%
	STCMCSB();

	PAIRMODE_.PAIRMODE OR .CEXPRPAIRMODE;	!THE IF REQUIRES A REG PAIR IF EITHER THE COND EXPR
					! OR THE SUBSTMNT REQUIRES ONE
	FNREF_.FNREF OR .CEXPRFNREF;	!THE IF STMNT CONTAINS A FN REF IF EITHER THE
				! COND EXPR OR  THE SUBSTMNT DOES


END;	! of STCMLIF
GLOBAL ROUTINE STCMAIF=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY PASS FOR AN ARITHMETIC IF.
	DETERMINES THE NUMBER OF REGS NECESSARY FOR COMPUTATION OF THE
	ARITHMETIC EXPRESSION AND FOR ANY COMMON SUBEXPRESSIONS.
	SETS THE COMPLEXITY OF THE STATEMENT TO THE MAX OF THESE.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
	WHICH ANALYSIS IS TO BE PERFORMED.
***************************************************************************)%
BEGIN
	%(***PERFORM COMPLEXITY ANALYSIS OF THE ARITH EXPR***)%
	TREEPTR_.CSTMNT[AIFEXPR];

	%(***IF THE ARITH EXPR IS A VARIABLE, WILL STILL USE A REG TO HOLD THE VAL***)%
	IF .TREEPTR[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		SAVREGCONTAINING(.TREEPTR);	!IF BB ALLOCATOR CAN LEAVE THIS VAR IN A
						! REG, HAVE IT DO SO
		%(***IF CONDEXPR IS A CONSTANT, THIS STMNT WILL HAVE BEEN FOLDED AWAY IN 
			P2SKEL IF IT WAS USED; IF P2SKEL NOT USED, A CONSTANT CONDEXPR
			IS ALLOCATED TO CORE****)%
		IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
		CSTMNT[SRCCMPLX]_1
	END
	ELSE
	CSTMNT[SRCCMPLX]_SETCOMPLEXITY();

	%(***PERFORM COMPLEXITY ANALYSIS FOR ANY COMMON SUBEXPRSSIONS***)%
	IF .CSTMNT[SRCCOMNSUB] NEQ 0
	THEN STCMCSB();

END;	! of STCMAIF
GLOBAL ROUTINE SCMASSI=
%(***************************************************************************
	PERFORM COMPLEXITY ANALYSIS FOR AN ASSIGN STMNT.
***************************************************************************)%
BEGIN
	TREEPTR_.CSTMNT[ASISYM];

	%(***IF VAR ASSIGNED TO IS AN ARRAYREF, PERFORM COMPLEXITY ANALYSIS ON IT***)%
	IF .TREEPTR[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		CSTMNT[SRCCMPLX]_CMPLXARRAY();
		IF .CSTMNT[SRCCMPLX] EQL 0 THEN CSTMNT[SRCCMPLX]_1;
	END
	ELSE
	CSTMNT[SRCCMPLX]_1;

END;	! of SCMASSI
GLOBAL ROUTINE STCMOPEN=
%(***************************************************************************
	TO PERFORM COMPLEXITY PASS FOR AN OPEN STATEMENT.
	MUST ALLOCATE ALL CONSTANTS THAT OCCUR UNDER THIS STMNT.
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE ARGVAL;	!PTR TO SYMBOL OR CONSTANT TABLE ENTRY
				! FOR THE VALUE TO BE PASSED TO FOROTS
				! FOR A GIVEN ARG
	REGISTER OPENLIST ARVALLST;	!LIST OF ARGS UNDER THIS OPEN STMNT
	OWN CMPLXMAX;	!MAXIMUM COMPLEXITY OF THE ARGS
	ARVALLST_.CSTMNT[OPLST];

	CMPLXMAX_0;

	%(***WALK THRU THE LIST OF ARGS - FOR ANY ARG THAT IS A CONSTANT OR A LITERAL
		ALLOCATE CORE FOR THAT CONSTANT/LITERAL***)%
	INCR I FROM 0 TO (.CSTMNT[OPSIZ]-1)
	DO
	BEGIN
%2401%		IF (ARGVAL = .ARVALLST[.I,OPENLPTR]) NEQ 0
%2401%		THEN
%2401%		BEGIN	! Specifier has a value

%2401%			! See if  we have  a  substring which  can  be
%2401%			! replaced with a .Dnnnn compile time constant
%2401%			! descriptor.
%2401%
%2401%			ARVALLST[.I,OPENLPTR] = ARGVAL = DOTDCHECK(.ARGVAL);

			IF .ARGVAL[OPRCLS] EQL DATAOPR	!VAL A VAR OR CONST
			THEN
			! Allocate core for a constant
			(IF .ARGVAL[OPR1] EQL CONSTFL THEN ALOCONST(.ARGVAL))
			ELSE		!VAL AN EXPRESSION (OR ARRAYREF)
			BEGIN
				REGISTER CMPL1;

				! Perform "complexity" pass over  this
				! expression.  If  its  complexity  is
				! greater than the maximum, change the
				! maximum.

				TREEPTR_.ARGVAL;
				IF (CMPL1_SETCOMPLEXITY()) GTR .CMPLXMAX
				THEN CMPLXMAX_.CMPL1;
			END;

%2401%		END;	! Specifier has a value

	END;

	CSTMNT[SRCCMPLX]_.CMPLXMAX;

END;	! of STCMOPEN
GLOBAL ROUTINE CMPDECENC=
%(***************************************************************************
	TO PERFORM COMPLEXITY PASS FOR AN ENCODE OR DECODE STMNT.
	THE ENCODE VAR MAY BE AN ARRAY REF THAT NEEDS TO HAVE AN ADDRESS CALC
	PERFORMED.
***************************************************************************)%
BEGIN
	OWN CMPL1;
	OWN PEXPRNODE ENCVAR;
	OWN PEXPRNODE ENCCT;

	ENCVAR_.CSTMNT[IOVAR];		!ENCODE/DECODE VARIABLE
	ENCCT_.CSTMNT[IOCNT];		!CHAR CT

	%(***IF CHAR CT IS AN EXPRESSION, PERFORM COMPLEXITY ANALYSIS FOR ITS
		CALCULATION***)%
	IF .ENCCT[OPRCLS] NEQ DATAOPR
	THEN
	BEGIN
		TREEPTR_.ENCCT;
		SETCOMPLEXITY()
	END
%2317%	ELSE IF .ENCCT[OPR1] EQL CONSTFL	! Is it a constant?
%2317%	THEN ALOCONST(.ENCCT);			! Yes, allocate it to memory

	%(***IF ENCODE/DECODE VARIABLE IS AN ARRAY REF (RATHER  THAN A SYMBOL TABLE
		ENTRY FOR AN ARRAY NAME) - PERFORM COMPLEXITY PASS ON ADDRESS CALCULATION***)%
	IF .ENCVAR[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		TREEPTR_.ENCVAR;
		CMPL1_CMPLXARRAY()
	END
	ELSE
	IF .ENCVAR[OPRCLS] EQL DATAOPR
	THEN CMPL1_0
	ELSE CGERR();

	CMPLIOLST();		!PERFORM COMPLEXITY ANALYSIS ON THE IOLIST
				! LEAVE THE STMNT COMPLEXITY FIELD SET TO THE NUMBER
				! OF REGS NECESSARY FOR COMP OF THE IOLIST

	%(***IF THE ADDR CALC FOR THE ENCODE VAR REQUIRES MORE REGS THAN CALC
		OF THE IOLIST DOES, ADJUST THE COMPLEXITY FIELD OF THE STMNT***)%
	IF .CMPL1  GTR .CSTMNT[SRCCMPLX]
	THEN CSTMNT[SRCCMPLX]_.CMPL1;

END;	! of CMPDECENC
GLOBAL ROUTINE STCMCSB=
%(***************************************************************************
	ROUTINE TO PERFORM COMPLEXITY ANALYSIS FOR EACH COMMON SUBEXPR UNDER THE NODE
	POINTED TO BY CSTMNT.
	LEAVES THE COMPLEXITY FIELD OF THE STATEMENT SET TO THE MAX OF ITS
	INITIAL VAL AND THE MAX COMPLEXITY OF ANY COMMON SUB
***************************************************************************)%
BEGIN
	OWN CMPLX1;
	REGISTER PEXPRNODE  CCMNSUB;

	CCMNSUB_.CSTMNT[SRCCOMNSUB];

	UNTIL .CCMNSUB EQL 0
	DO
	BEGIN
		IF .CCMNSUB[A2VALFLG]	!IF THIS CSB IS A SINGLE VARIABLE
		THEN
		BEGIN
			SAVREGCONTAINING(.CCMNSUB[ARG2PTR]);	!IF THE CSB COULD HAVE BEEN
							! LEFT IN A REG BY A PREV STMNT, DO LEAVE IT
			ADDREGCANDATE(.CCMNSUB[ARG2PTR],.CCMNSUB);	!IF THIS VAR SHOULD BE NEEDED LATER
							! WILL BE ABLE TO USE IT FROM THE
							! REG WHERE THIS STMNT LEFT IT
			CCMNSUB[COMPLEXITY]_0;
		END

		ELSE		!IF THE CSB IS AN EXPRESSION
		BEGIN
			TREEPTR_.CCMNSUB[ARG2PTR];
			CMPLX1_SETCOMPLEXITY();
			IF .CMPLX1 GTR .CSTMNT[SRCCMPLX]
			THEN CSTMNT[SRCCMPLX]_.CMPLX1;

			CCMNSUB[COMPLEXITY]_.CMPLX1;
		END;

		CCMNSUB_.CCMNSUB[CLINK];
	END;

END;	! of STCMCSB
GLOBAL ROUTINE ALCASMNT=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STATEMENT.
	DETECTS OPERATONS OF THE FORM:
		A=A+B+C+...
		A=A*B*C....
	TO BE OPERATIONS TO MEMORY.

	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE FOR
	WHICH ALLOCATION IS TO BE PERFORMED.

	THIS ROUTINE IS NEVER CALLED RECURSIVELY.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE ARGNODE:LHNODE:RHNODE;
	OWN RA,RB;
	OWN PEXPRNODE SUBNODE;
	OWN RSV;
%4517%	LOCAL BASE LHARG1;
%4517%	LOCAL BSYRG1,FRGCT1;


	%(***TO SET THE REG FOR COMPUTATION OF THE STATEMENT TO THE SAME REG
		INTO WHICH THE RIGHT-HAND SIDE WAS COMPUTED***)%
	MACRO SETREGTORH=
	BEGIN
		CSTMNT[ASMNTREG]_.RHNODE[TARGTAC];
		CSTMNT[A2SAMEFLG]_1;
	END$;



	ROUTINE USEAFREEREG=
	%(*****ROUTINE TO GET A LEGAL REG FOR COMPUTATION OF THE ASSIGNMENT AND
		SET THE REG-TO-BE-USED TO THAT REG*****)%
	BEGIN
		RA_REGTOUSE(.CSTMNT,.RHNODE,.LHNODE,.RA,.STBSYR);
		CSTMNT[ASMNTREG]_.RA;	!SET THE REG TO BE USED FOR THE
						! ASSIGNMENT TO RA
		REGCLOBB(.RA);	!MUST ASSUME THAT PREVIOUS CONTENTS OF
						! RA ARE CLOBBERED. CLEAR BASIC BLOCK ALLOC
						! TABLE ENTRIES FOR RA
		IF .RHNODE[DBLFLG]	!IF THE VAL BEING ASSIGNED USES 2 WDS
		THEN				!MUST ALSO ASSUME THAT THE REG AFTER
		REGCLOBB(.RA+1);	! RA IS CLOBBERED

	END;	! of USEAFREEREG


	ROUTINE SETREGFORA2VAL=
	%(***ROUTINE TO SET THE "REG FOR COMP" OF THE STMNT WHEN THE RIGHT HAND SIDE IS
		A VARIABLE OR REGCONTENTS (IE WHEN A2VALFLG IS SET)***)%
	BEGIN
		IF .RHNODE[OPRCLS] EQL REGCONTENTS
		THEN
		%(***IF RHS IS A VAR WHICH LIVES IN A REG, WILL USUALLY WANT TO SET
			REG-FOR-COMP OF STMNT TO THAT REG***)%
		BEGIN
			%(***HAVE THE EXCEPTION THAT IF THE RHS IS AN AOBJN WORD
				FOR A LOOP CONTROL, WANT TO USE ONLY THE RIGHT HALF.
				THIS IS A PROBLEM IFF EITHER A2NEGFLG OR A2NOTFLG IS SET,
				IN WHICH AN EXTRA REG WILL BE NEEDED.
			*******)%
			IF .CSTMNT[A2IMMEDFLG] AND 
				(.CSTMNT[A1NEGFLG] OR .CSTMNT[A1NOTFLG]
				OR .CSTMNT[A2NEGFLG] OR .CSTMNT[A2NOTFLG])
			THEN
			USEAFREEREG()
			ELSE
			SETREGTORH
		END
		ELSE
		IF (RB_REGCONTAINING(.RHNODE)) GEQ 0	!IF THE RIGHT HAND SIDE WAS LEFT IN
							! A REG BY AN EARLIER STMNT IN THIS BASIC BLOCK
			AND .CSTMNT[A2NGNTFLGS] EQL 0	!AND THE RHS WILL NOT BE PICKED UP
							! BY A MOVN
		THEN
		BEGIN
			CSTMNT[ASMNTREG]_.RB;	!USE THAT REG FOR THE ASSIGNMENT
			CSTMNT[A2SAMEFLG]_1;	!NEED NOT RELOAD THE REG
			CSTMNT[A2IMMEDFLG]_0;	!IF THE RHS WAS PREVIOUSLY AN IMMED CONST, WOULD
						! HAVE HAD THIS FLAG SET. MUST BE CAREFUL
						! TO TURN IT OFF BECAUSE THE ONLY PLACE THAT
						! WE CAN HAVE "A2SAMEFLG" AND "A2IMMEDFLG"
						! BOTH SET IS FOR RHS AN AOBJN REG
			REGCLOBB(.RB);		!DELETE THE PREVIOUS ENTRY IN THE "REGSTATE"
						! TABLE FOR RB (SINCE WE CAN ONLY REMEMBER
						! A MAX OF 2 VARS PER REG)
		END
		ELSE
		%(***IF RHS IS A VARIABLE WHICH DOES NOT LIVE IN A REG, SET REG
			FOR COMP OF STMNT TO RA****)%
		USEAFREEREG()

	END;	! of SETREGFORA2VAL






	FNVALCHK();	!IF LHS OF THIS STMNT IS THE FN ENTRY NAME (IE IS THE VAL TO BE RETURNED)
			! AND THE NEXT STMNT IS A RETURN, SUBSTITUTE A REGCONTENTS 0 FOR THE LHS

	RHNODE_.CSTMNT[RHEXP];
	LHNODE_.CSTMNT[LHEXP];

	%(****PERFORM REGISTER ALLOCATION FOR THE COMMON SUBEXPRS UNDER THIS STMNT.****)%
	DBLMODE_FALSE;
	ALCCMNSB();

%4517%	IF .LHNODE[OPR1] EQL CHARFNFL
%4517%	THEN
%4517%	BEGIN	! 1-character assignment
%4517%
%4517%		RA=AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],0);
%4517%
%4517%		IF .LHNODE[A1VALFLG]
%4517%		AND (.CSTMNT[A2VALFLG] OR .RHNODE[A1VALFLG])
%4517%		THEN
%4517%		BEGIN	!LH = variable, RH = constant or variable
%4517%
%4517%			SETTAC(.LHNODE,.RA);	!LHNODE[TARGTAC] = .RA; REGCLOBB(.RA)
%4517%
%4522%			IF NOT .LHNODE[INCRFLG] ! unincremented bp - use IDPB
%4522%			THEN	! and need a second reg to move bp of RHS into
%4522%			BEGIN
%4522%				RA=AFREEREG(CLRBIT(.STBSYR,.RA),.CSTMNT[SRCSAVREGFLG],0);
%4522%				REGCLOBB(.RA);
%4522%			END;
%4517%
%4517%			CSTMNT[ASMNTREG] = .RA;
%4517%
%4517%			IF NOT .CSTMNT[A2VALFLG]
%4517%			THEN
%4517%			BEGIN
%4517%				RHNODE[TARGTAC] = .RA;
%4517%				RHNODE[INREGFLG] = 1;
%4517%			END;
%4522%		END
%4517%		ELSE	! don't have (LH = variable, RH = constant or variable)
%4517%		BEGIN
%4517%			TREEPTR = .RHNODE;
%4517%
%4517%			! allocate regs for RHNODE
%4517%
%4517%			IF .STRGCT LSS .LHNODE[COMPLEXITY]
%4517%			OR .STRGCT LSS .RHNODE[COMPLEXITY]
%4517%			THEN ! there are not enough regs for both LHS and RHS 
%4517%			BEGIN
%4517%				ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT);
%4517%			END
%4517%			ELSE
%4517%			BEGIN
%4517%				ALCINREG(.RA,.STBSYR,.STRGCT); !alloc reg for RHNODE
%4517%				STBSYR = CLRBIT(.STBSYR,.RHNODE[TARGTAC]);
%4517%				STRGCT = .STRGCT - 1;
%4517%				RA=AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],0);
%4517%			END;
%4517%	
%4517%			!Character reg alloc routines expect regs in double 
%4517%			!mode. We did not have to do this for the RHS because
%4517%			!it has an ICHAR over it and ALCILF converts the regs
%4517%			!to double mode
%4517%	
%4517%			BSYRG1 = DPBSYREGS(.STBSYR);
%4517%			FRGCT1 = ONESCOUNT(.BSYRG1);
%4517%		
%4517%			! allocate regs for LHNODE
%4517%
%4517%			IF .LHNODE[A1VALFLG]
%4517%			THEN 	! LH = variable 
%4517%			BEGIN	
%4517%				SETTAC(.LHNODE,.RA);	!LHNODE[TARGTAC] = .RA; REGCLOBB(.RA)
%4517%			END
%4517%			ELSE 	! LH is not variable 
%4517%			BEGIN
%4517%				TREEPTR = LHARG1 = .LHNODE[ARG1PTR];
%4517%				ALCINREG(.RA,.BSYRG1,.FRGCT1);
%4517%				RA = LHNODE[TARGTAC] = .LHARG1[TARGTAC];
%4517%			END;
%4517%
%4517%			! choose ASMNTREG
%4517%
%4517%			IF .CSTMNT[A2VALFLG]
%4517%			THEN 	!RHS is a constant
%4517%			BEGIN
%4517%				IF .LHNODE[A1VALFLG] ! LHS is a variable
%4517%				THEN CSTMNT[ASMNTREG] = .LHNODE[TARGTAC]
%4517%				ELSE
%4517%	 			BEGIN 	! LHS is not a variable
%4517%					CSTMNT[ASMNTREG] = RA = AFREEREG(CLRBIT(.BSYRG1,.RA),.CSTMNT[SRCSAVREGFLG],0);
%4517%					REGCLOBB(.RA);
%4517%				END;
%4517%			END
%4517%			ELSE 	!RHS is not a constant
%4517%				CSTMNT[ASMNTREG] = .RHNODE[TARGTAC]; 
%4517%		END;
%4517%		LHNODE = .LHNODE[ARG1PTR]; !Get whats under CHAR node
%4517%		IF .LHNODE[OPRCLS] EQL SUBSTRING! could be substring?
%4517%		THEN LHNODE = .LHNODE[ARG4PTR]; !get arrayref or variable
%4517%		IF .LHNODE[OPRCLS] EQL ARRAYREF	! could be arrayref?
%4517%		THEN LHNODE = .LHNODE[ARG1PTR];	!get variable
%4517%				   ! value of this variable gets clobbered
%4517%		VARCLOBB(.LHNODE); ! with this assignment
%4517%		RETURN;
%4517%	END;	! 1-character assignment


	%(***IF THIS STATEMENT IS DOUBLE-PREC, ADJUST SET OF BUSY REGS SO
		THAT ONLY EVEN REGS WILL BE ALLOCATED****)%
	IF .RHNODE[DBLFLG]
	THEN
	BEGIN
		STBSYR_DPBSYREGS(.STBSYR);
		STRGCT_ONESCOUNT(.STBSYR);
		DBLMODE_TRUE;
	END
	ELSE DBLMODE_FALSE;








	%(****IF THE LEFT-HAND SIDE OF THE ASSIGNMENT IS A VARIABLE THAT WAS ALLOCATED
		TO LIVE IN A REGISTER, WILL PROCESS THE RIGHT-HAND SIDE IN A SPECIAL
		MANNER*****)%
	IF .LHNODE[OPRCLS] EQL REGCONTENTS
	THEN
	BEGIN
		IF .CSTMNT[MEMCMPFLG]
		THEN
		BEGIN
			CSTMNT[MEMCMPFLG]_0;	!IF IN P2SKEL HAD DECIDED TO PERFORM THIS
						! OP TO MEMORY - UNDO THAT DECISION
			RHNODE[MEMCMPFLG]_0;
			CSTMNT[OPTOBOTHFLG]_0;	! (ALSO UNDO DECISION TO DO OP "TO BOTH")
			RHNODE[OPTOBOTHFLG]_0;
		END;
		IF LHINREGALC() THEN RETURN;
%[1161]%	REGCLOBB(.LHNODE[TARGTAC])	! REGISTER WILL BE TRASHED
	END;


	%(***IF THE RIGHT-HAND SIDE IS TO BE COMPUTED DIRECTLY TO MEMORY*****)%
	IF .CSTMNT[MEMCMPFLG]
	THEN
	BEGIN
		ALCMEMCMP();
		RETURN;
	END;


	RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);

	%(***IF RIGHT HAND SIDE IS AN EXPRESSION WHOSE VAL MUST BE NEGATED BY AN EXTRA MOVN
		(IE IT  IS NOT A DATA ITEM OR ARRAYREF THAT WOULD HAVE TO BE PICKED UP ANYWAY)
		OR IF LEFT HAND SIDE IS AN ARRAYREF (AND HENCE THERE IS NO VALUE IN
		LEAVING ITS VAL IN A REG FOR FUTURE USES) AND THE RHS IS A SIMPLE
		VAR (AND HENCE ITS VAL MIGHT BE USEFUL IN A REG)
		SHOULD DO THE NEGATE AS A PART OF THE STORE OPERATION
		HENCE IN THESE CASES SHOULD PUT NEG (AND NOT) FLAGS OVER LEFT
		RATHER THAN RIGHT HAND SIDE***)%
	IF (.RHNODE[OPRCLS] NEQ DATAOPR AND .RHNODE[OPRCLS] NEQ ARRAYREF)
		OR
			( NOT .CSTMNT[A1VALFLG]
			 AND .CSTMNT[A2VALFLG]		!AND RHS IS A SIMPLE VAR
							! (NB FOR A(I)=-A(I)
							! WANT TO CREATE THE PEEPHOLE
							! MOVN, MOVEM)
			AND NOT (
%1413%				IF (.RHNODE[OPERATOR] EQL INTCONST)
%1413%				THEN .RHNODE[CONST2] EQL 1
%1413%				ELSE FALSE
				)			!AND RHS IS NOT INTEGER 1
							! (BECAUSE WE WANT TO GET THE
							! MOVNI 1, MOVEM PEEPHOLE)
			)

	THEN
	BEGIN
		CSTMNT[A1NEGFLG]_.CSTMNT[A2NEGFLG];	!(A1NEGFLG WOULD NOT HAVE PREVIOUSLY BEEN SET)
		CSTMNT[A1NOTFLG]_.CSTMNT[A2NOTFLG];
		CSTMNT[A2NEGFLG]_0;
		CSTMNT[A2NOTFLG]_0;
	END;



	%(***IF LEFT HAND SIDE OF STATEMENT IS A SIMPLE VARIABLE, PERFORM REGISTER
		ALLOCATION FOR THE RIGHT HAND SIDE****)%

	IF .CSTMNT[A1VALFLG]
	THEN
	BEGIN
		IF .CSTMNT[A2VALFLG]
		THEN
		%(***IF RIGHT-HAND SIDE IS ALSO A SIMPLE VARIABLE***)%
		SETREGFORA2VAL()
		ELSE
		BEGIN
			TREEPTR_.RHNODE;

			%(***IF THERE ARE NO REFERENCES TO THE LHS WITHIN THE EXPRESSION
				ON THE RHS AND THE RHS IS NOT AN ARRAYREF,
				AND THE NEG AND NOT FLAGS IN THE STATEMENT ARE BOTH 0,
				 ALLOCATE THE RHS TO BE COMPUTED TO THE
				VARIABLE ON THE LHS*******)%
			IF NOT .RHNODE[RESRFFLG] AND (NOT .RHNODE[OPRCLS] EQL ARRAYREF)
			!IF LHS OF ASSIGNMENT STMNT IS A LOGICAL VARIABLE,
			! AND IT IS IN COMMON OR EQUIVALENCED, THEN IT COULD
			! BE NEEDED FOR EVALUATION OF RHS, SO PREVENT EARLY
			! INITIALIZATION OF LHS TO -1
				AND NOT(.LHNODE[VALTYPE] EQL LOGICAL
					AND (.LHNODE[IDATTRIBUT(INEQV)] OR
					.LHNODE[IDATTRIBUT(INCOM)]))
				AND (NOT .LHNODE[OPRCLS] EQL REGCONTENTS)
				AND (.CSTMNT[A2NGNTFLGS] EQL 0)
				AND (.CSTMNT[A1NGNTFLGS] EQL 0)
			THEN
			BEGIN
				ALCINTMP(.LHNODE,.STBSYR,.STRGCT);
				IF .RHNODE[TARGTMEM] EQL .LHNODE
				THEN
				%(***IF COULD COMPUTE RHS DIRECTLY TO LHS***)%
				BEGIN
					CSTMNT[MEMCMPFLG]_1;
					VARCLOBB(.LHNODE);	!THE VAL OF THE VAR ON LHS HAS BEEN
								! MODIFIED, CLEAR
								! ANY BB ALLOC ENTRIES THAT REFER
								! TO THAT VAR
					IF .CSTMNT[SRCSAVREGFLG]	!IF VAL OF LHS VAR IS USEFUL TO LEAVE
									! IN A REG
						AND .RHNODE[STOREFLG]	!AND RHS WAS COMPUTED INTO A REG
									! AND THEN STORED INTO LHS VAR
					THEN
					SAVEREG(.RHNODE[TARGTAC],	!REMEMBER THAT LHS VAR
						.LHNODE,0,.CSTMNT[SRCSONNXTUSE]);	!IS IN THAT REG
					RETURN;
				END;
			END

			ELSE
			%(***OTHERWISE, ALLOCATE THE RHS TO BE COMPUTED TO THE REG RA***)%
			ALCINREG(.RA,.STBSYR,.STRGCT);

			%(***DETERMINE REG FOR COMPUTATION OF THE STMNT***)%
			IF .CSTMNT[ALCRETREGFLG]
			THEN
			%(***IF REG FOR COMPUTATION OF STMNT HAS ALREADY BEEN DETERMINED TO
				BE THE FN-RETURN REG****)%
			BEGIN  END
			ELSE
			IF .RHNODE[INREGFLG]
			THEN
			%(***IF RHS IS COMPUTED INTO A REG, USE THAT REG AS REG FOR COMP FOR STMNT***)%
			SETREGTORH
			ELSE
			%(***OTHERWISE USE SOME FREE REG***)%
			USEAFREEREG()
		END;

		VARCLOBB(.LHNODE);	!THE VAL OF THE VAR ON THE LHS HAS BEEN MODIFIED
					! CLEAR ANY BB ALLOC ENTRIES THAT REFER TO IT

		IF .CSTMNT[SRCSAVREGFLG]	!IF VAL OF EITHER VAR ON LHS OR RHS IS OF FUTURE USE
						! TO HAVE IN A REG
			AND .CSTMNT[A1NGNTFLGS] EQL 0	!AND VAL WILL NOT BE STORED WITH "MOVNM"
			AND NOT(.CSTMNT[A2IMMEDFLG] AND .CSTMNT[A2SAMEFLG])	!AND VAL WILL NOT BE STORED
								! WITH "HRRZM" (DUE TO RHS BEING
								! RIGHT HALF OF AOBJN WD)
		THEN
		SAVEREG(.CSTMNT[ASMNTREG],	!REMEMBER THAT REG USED CONTAINS
			.LHNODE,		! VAL OF VAR ON LHS
			(IF .RHNODE[OPRCLS] EQL DATAOPR 	!AND IF RHS IS A VAR
				AND .CSTMNT[A2NGNTFLGS] EQL 0	! AND WAS NOT PICKED UP WITH "MOVN"
				AND NOT (.CSTMNT[A1NEGFLG] AND
					 .LHNODE[VALTYPE] EQL DOUBLPREC)	!AND DONT HAVE TO NEGATE A DP VAL (THERE IS NO MOVNM FOR DP)
			THEN .RHNODE		! IT ALSO CONTAINS VAL OF VAR ON RHS
			ELSE 0),
			.CSTMNT[SRCSONNXTUSE]);	! AND THE NEXT USE OF THAT VAR WAS
						! POINTED TO BY THE ASSIGNMNT STMNT
		RETURN

	END;




	%(***IF LEFT-HAND SIDE IS NOT A SIMPLE VARIABLE, IT MUST BE AN ARRAY****)%
	IF .LHNODE[OPRCLS] NEQ ARRAYREF
	THEN CGERR();


	%(****IF RIGHT HAND SIDE IS A SIMPLE VARIABLE, PERFORM REGISTER ALLOCATION FOR
		LEFT HAND SIDE*******)%

	IF .CSTMNT[A2VALFLG]
	THEN
	BEGIN
		TREEPTR_.LHNODE;
		ALCARRAY(.STBSYR,.STRGCT);

		%(***GET REG FOR COMP FOR STMNT- DO NOT USE THE REG IN WHICH THE
			INDEX INTO THE ARRAY WAS LEFT***)%
		IF .LHNODE[TARGXF] NEQ 0
		THEN
		BEGIN
			 STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF] );
			IF .LHNODE[DBLFLG]	!IF A 2 WD VAL IS TO BE STORED
			THEN		! THEN IF THE INDEX WAS IN AN ODD REG, MUST NOT
			STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]-1)	!USE THE PRECEEDING EVEN
					! REG (IF INDEX IN AN EVEN REG, THEN PRECEEDING REG
					! IS ALREADY OUT OF THE SET BECAUSE IT IS ODD)
		END;

		RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);

		%(***DECIDE WHICH REG TO COMPUTE THE STMNT IN (GIVEN THAT A2VALFLG WAS SET)***)%
		SETREGFORA2VAL();

		VARCLOBB(.LHNODE);	!IF THE ARRAY ON LHS IS IN COMMON OR EQV MUST
					! ASSUME THAT VARS IN COMMON/EQV ARE CLOBBERED

		IF .CSTMNT[SRCSAVREGFLG]	!IF VAR ON RHS IS USEFUL TO LEAVE IN A REG
			AND  .CSTMNT[A2NGNTFLGS] EQL 0	! AND WAS NOT PICKED UP WITH "MOVN"
			AND .RHNODE[OPRCLS] EQL DATAOPR	! AND WAS NOT REPLACED BY A "REGCONTENTS"
			AND NOT (.CSTMNT[A1NEGFLG] AND
				 .LHNODE[VALTYPE] EQL DOUBLPREC)	!AND DONT HAVE TO NEGATE A DP VAL (THERE IS NO MOVNM FOR DP)
		THEN SAVEREG(.CSTMNT[ASMNTREG],		!REMEMBER TAHT REG USED FOR ASSIGNMNET
			.RHNODE,0,.CSTMNT[SRCSONNXTUSE]);	! CONTAINS VAR ON RHS


		RETURN;
	END;


	%(***IF COMPUTATION OF THE RHS WILL CLOBBER ALL REGISTERS AVAILABLE, THEN
		SHOULD ALWAYS COMPUTE RHS BEFORE COMPUTING LHS, SO THAT
		DO NOT NEED TO LEAVE PTR TO LHS IN A TEMPORARY***)%
	IF .RHNODE[COMPLEXITY] GEQ .STRGCT
	THEN CSTMNT[RVRSFLG]_1;




	%(***IF RIGHT HAND SIDE IS COMPUTED BEFORE ADDRESS CALC FOR LEFT HAND SIDE****)%

	IF .CSTMNT[RVRSFLG]
	THEN
	BEGIN
		IF .LHNODE[COMPLEXITY] LSS .STRGCT
		THEN
		%(***IF ADDRESS CALCULATION CAN BE PERFORMED WITHOUT CLOBBERING
			THE REG IN WHICH RIGHT-HAND-SIDE VAL IS LEFT***)%
		BEGIN
			TREEPTR_.RHNODE;
			ALCINREG(.RA,.STBSYR,.STRGCT);

			%(***DETERMINE WHICH (IF ANY) REG MUST BE SAVED WHILE COMPUTING
				THE LHS BECAUSE IT HOLDS EITHER THE VAL OR A PTR TO THE
				VAL OF THE RIGHT-HAND-SIDE***)%
			RSV_RGTOSAVE(.RHNODE);
			IF .RSV NEQ -1
			THEN
			BEGIN
				%(***IF SOME REG MUST BE SAVED, ADJUST SET OF BUSY REGS***)%
				STBSYR_CLRBIT(.STBSYR,.RSV);
				STRGCT_.STRGCT-1;
			END;

			TREEPTR_.LHNODE;
			ALCARRAY(.STBSYR,.STRGCT);
			IF .RHNODE[INREGFLG]
			THEN
			SETREGTORH
			ELSE
			USEAFREEREG()
		END
		ELSE
		BEGIN
			TREEPTR_.RHNODE;

%1274%			! Get 1 or 2 word temp based on DBLFLG

%1274%			IF .TREEPTR[DBLFLG]
%1274%			THEN ALCINTMP(NXTTMP(2),.STBSYR,.STRGCT)
%1274%			ELSE ALCINTMP(NXTTMP(1),.STBSYR,.STRGCT);

			TREEPTR_.LHNODE;
			ALCARRAY(.STBSYR,.STRGCT);
			USEAFREEREG()
		END;

	END

	ELSE

	%(****IF ADDRESS CALC FOR LEFT-HAND SIDE IS PERFORMED BEFORE RIGHT-HAND SIDE IS COMPUTED***)%

	BEGIN
		%(***IF LH'S SUBSCRIPT IS A VARIABLE (LEAF) AND THE RH
			CONTAINS SOME FUNCTION CALLS, THEN WE MUST CLEAR
			THE MEMORY OF AC 1, SO ALCARRAY WON'T TRY TO
			LEAVE THE SUBSCRIPT IN AC 1 IF ITS ALREADY
			THERE (ALCARRAY NEVER LEAVES IT IN AC 0)***)%
		IF .LHNODE[A2VALFLG] AND .RHNODE[FNCALLSFLG]
		THEN REGCLOBB(1);

		%(***CAN ASSUME THAT THE COMPUTATION OF RHS WILL NOT CLOBBER
			THE PTR TO LHS****)%

		%(***PERFORM REG ALLOC FOR COMPUTATION OF THE ADDRESS OF THE LHS***)%
		TREEPTR_.LHNODE;
		ALCARRAY(.STBSYR,.STRGCT);

		%(***IF PTR TO LEFT-HAND-SIDE IS LEFT IN A REG, DO NOT USE THAT REG IN
			COMPUTATION OF RIGHT-HAND-SIDE***)%
		IF .LHNODE[TARGXF] NEQ 0
		THEN
		BEGIN
			STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]);
			IF .LHNODE[DBLFLG]	!IF A 2 WD VAL IS TO BE STORED
			THEN		! THEN IF THE INDEX WAS IN AN ODD REG, MUST NOT
			STBSYR_CLRBIT(.STBSYR,.LHNODE[TARGXF]-1);	!USE THE PRECEEDING EVEN
					! REG (IF INDEX IN AN EVEN REG, THEN PRECEEDING REG
					! IS ALREADY OUT OF THE SET BECAUSE IT IS ODD)
			STRGCT_.STRGCT-1;
		END;

		%(***PERFORM REGISTER ALLOC FOR THE COMPUTATION OF THE RHS***)%
		RA_AFREEREG(.STBSYR,FALSE,.LHNODE[DBLFLG]);
		TREEPTR_.RHNODE;

		ALCINREG(.RA,.STBSYR,.STRGCT);

		IF .RHNODE[INREGFLG]
		THEN
		SETREGTORH
		ELSE
		USEAFREEREG()
	END;

	VARCLOBB(.LHNODE);	!ASSUME VAL OF LHS IS CLOBBERED

END;	! of ALCASMNT
GLOBAL ROUTINE ALCMEMCMP=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STMNT TO BE
	PERFORMED DIRECTLY TO MEMORY. IT IS ASSUMED THAT IF THE
	OPERATION HAS 2 ARGS (IE IS EITHER A BOOLEAN OR ARITHMETIC) THEN  ARG2 UNDER
	THE RIGHT HAND SIDE IS EQUAL TO THE LEFT HAND SIDE.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE ASSIGNMENT STMNT.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE RHNODE:LHNODE:ARG1NODE:ARG2NODE;
	OWN RA,RB;

	RHNODE_.CSTMNT[RHEXP];
	LHNODE_.CSTMNT[LHEXP];
	ARG1NODE_.RHNODE[ARG1PTR];
	ARG2NODE_.RHNODE[ARG2PTR];
	RA_AFREEREG(.STBSYR,.CSTMNT[SRCSAVREGFLG],.LHNODE[DBLFLG]);

	IF CLOBBNX(.RHNODE)	!IF THIS OPERATION CLOBBERS THE REG AFTER THE
				! REG ON WHICH IT IS PERFORMED (IE INTEGER DIVIDE)
		AND .RHNODE[OPTOBOTHFLG]	! AND WE WILL BE GENERATING AN OP-TO-BOTH
				! (RATHER THAN TO MEMORY - SINCE OPS TO MEM DONT CLOBBER THAT REG)
	THEN
	RA_GETRGPAIR(.RA,.STBSYR);	!GET A REG TO USE THAT DOES NOT HAVE A USEFUL VAL
				! IN THE REG FOLLOWING

	%(***FOR P2PL1MUL,SQUARE, AND CUBE - THE ARG THAT IS EQL TO THE LEFT HAND
		SIDE IS ARG1 (AND THIS IS THE ONLY ARG). HENCE DONT HAVE TO
		WORRY ABOUT ALLOCATING THE OTHER ARG***)%
	IF .RHNODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
		RA_RGTOU1(.RHNODE,.RHNODE[ARG1PTR],.RA,.STBSYR);
		SETTAC(.RHNODE,.RA)
	END

	%(***FOR ARITHMETIC AND BOOLEAN OPERATORS***********)%

	ELSE
	BEGIN

		%(***FOR ARITH OPS, CANNOT HAVE NEG ON ARG2. REMOVE A2NEGFLG BY
			A+(-B)=A-B,  A*(-B)=-A*B, A/(-B)=(-A)/B
			 SINCE REMOVING NEG FROM ARG2 MAY CHANGE "A1NEGFLG" MUST DO IT BEFORE
			DECIDE WHETHER CAN USE ARG1 DIRECTLY FROM A GIVEN REG.***)%
		IF .RHNODE[A2NEGFLG] AND .RHNODE[OPRCLS] EQL ARITHMETIC
		THEN
		BEGIN
			IF ADDORSUB(RHNODE)	!MAKE ADD INTO SUB, SUB INTO ADD
			THEN CMPLSP(RHNODE)
			ELSE IF MULORDIV(RHNODE)	!FOR MUL, DIV
			THEN RHNODE[A1NEGFLG]_NOT.RHNODE[A1NEGFLG]	!REVERSE THE NEG ON ARG1
			ELSE CGERR();	!OPS TO MEM CANNOT BE EXPONEN
			RHNODE[A2NEGFLG]_0;
		END;

		%(****PERFORM REGISTER ALLOCATION FOR ARG1 UNDER THE RIGHT HAND SIDE****)%
		IF .RHNODE[A1VALFLG]
		THEN
		BEGIN
			%(***IF ARG1 IS A REGCONTENTS NODE THEN
				1. IF ONLY WANT TO USE THE RIGHT HALF OF TH REG
					THEN MUST MOVE IT INTO RA
				2. IF THE OPERATION CLOBBERS THE REG USED
					THEN MUST MOVE IT TO RA
				3. OTHERWISE, USE THAT REGISTER AS REGFORCOMP
					FOR RHNODE
			********)%
			IF .ARG1NODE[OPRCLS] EQL REGCONTENTS AND NOT .RHNODE[A1IMMEDFLG]
				AND NOT .RHNODE[A1NEGFLG] AND NOT .RHNODE[A1NOTFLG]
				!(DOUBLE-PREC AND COMPLEX OPS TO MEMORY  CLOBBER THE REG)
				AND NOT .RHNODE[DBLFLG]
			THEN
			BEGIN
				RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
				RHNODE[A1SAMEFLG]_1;
			END

			ELSE
			! If arg1 was put in a register earlier in  this
			! basic block, then use the register that it  is
			! already in!
			IF (RB_REGCONTAINING(.ARG1NODE)) GEQ 0
			THEN
			BEGIN
				IF .RHNODE[A1NGNTFLGS] NEQ 0	!IF ARG1 MUST BE NEGATED/COMPLEMENTED
					AND NOT BITSET (.STBSYR,.RB)	! AND WE CANNOT CLOBBER RB
				THEN				! MUST NOT USE RB
				SETTAC(.RHNODE,.RA)	!USE RA
				ELSE
				BEGIN
					SETTAC(.RHNODE,.RB);	!USE THAT REG FOR THIS OP TO MEMORY
					RHNODE[A1SAMEFLG]_1;	!DONT RELOAD THE REG

%2000%					! If we're using a memory location
%2000%					! for arg1, we don't need an immed
%2000%					! instruction.
%2000%					RHNODE[A1IMMEDFLG] = 0;
				END
			END

			%(***IF ARG1 IS A SCALAR, USE RA***)%
			ELSE
			SETTAC(.RHNODE,.RA);


			IF .RHNODE[SAVREGFLG]	!IF VAL OF ARG1 WILL BE USEFUL TO HAVE IN A REG LATER
				AND .ARG1NODE[OPRCLS] EQL DATAOPR
				AND NOT .RHNODE[DBLFLG]	! AND THE OPERATION IS NOT DP OR COMPLEX (WHICH
							! OPS CLOBBER THE REG USED FOR THE OP TO MEMORY)
				AND NOT .RHNODE[OPTOBOTHFLG]	!AND WE HAVE NOT ALREADY DECIDED
							! TO PERFORM THE OPERATION TO BOTH
				! TEST FOR NOT ON PARENT NODE TOO!
				AND NOT .RHNODE[A1NOTFLG]
				AND NOT .RHNODE[A1NEGFLG]	!AND ARG1 WAS NOT PICKED UP BY "MOVN"
			THEN SAVEREG(.RHNODE[TARGTAC],	!REMEMBER THAT THE REG USED
				.ARG1NODE,0,.RHNODE[SONNXTUSE]);	!CONTAINS VAL OF ARG1
		END
		ELSE
		BEGIN
			TREEPTR_.RHNODE[ARG1PTR];
			ALCINREG(.RA,.STBSYR,.STRGCT);
			IF .RHNODE[ALCRETREGFLG]
			THEN
			%(***IF WE DECIDED ON THE COMPLEXITY-PASS TO USE THE FN-RETURN REGISTER
				FOR COMPUTATION OF RHNODE*****)%
			BEGIN END
			ELSE
			IF .ARG1NODE[INREGFLG] AND NOT .ARG1NODE[ALCRETREGFLG]
			THEN
			%(***IF THE LEFT-ARGUMENT OF RHNODE HAD ITS VAL LEFT IN A REG****)%
			BEGIN
				RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
				RHNODE[A1SAMEFLG]_1;
			END
			ELSE
			%(***OTHERWISE USE RA TO COMPUTE RHNODE****)%
			BEGIN
				RA_REGTOUSE(.RHNODE,.RHNODE[ARG1PTR],.RHNODE[ARG2PTR],.RA,.STBSYR);
				SETTAC(.RHNODE,.RA)
			END
		END;
	END;


	%(***IF THIS OPERATION IS MOST OPTIMALLY PERFORMED FROM A REG
		THAT WE CANNOT CLOBBER, THEN WE CANNOT DO IT "TO BOTH"***)%
	IF .RHNODE[OPTOBOTHFLG]
	THEN
	BEGIN
		IF NOT BITSET(.STBSYR,.RHNODE[TARGTAC])	!IF THE REG USED CANNOT BE CLOBBERED
			OR
			(CLOBBNX(.RHNODE)		!OR IF THIS OPERATION WILL CLOBBER
							! THE REG FOLLOWING THE REG USED
			 AND NOT BITSET(.STBSYR,.RHNODE[TARGTAC]+1)	! AND THAT REG CANNOT BE CLOBBERED
			)
		THEN
		(CSTMNT[OPTOBOTHFLG]_0;RHNODE[OPTOBOTHFLG]_0);	!TURN OFF FLAGS FOR
							! "PERFORM OP TO BOTH"
	END;



	%(***IF THE ELEMENT ON THE LHS (WHICH IS ALSO ARG2 UNDER THE RHS) IS
		AN ARRAY REF, PERFORM ALLOC FOR THOSE 2 NODES***)%
	IF NOT .CSTMNT[A1VALFLG]
	THEN
	BEGIN
		OWN BSYRG1;
%2072%		LOCAL	STRCT1,		! Copy of the statement reg count
%2072%			RESERVE;	! Reserved register

		RA_.RHNODE[TARGTAC];
		BSYRG1_CLRBIT(.STBSYR,.RA);	!WHEN COMPUTING THE SS DO NOT USE

%2072%		! The number  of registers  used  for the  operation  to
%2072%		! memory.
%2072%		STRCT1 = .STRGCT-1;

%2072%		! We have "A  = B op  A".  "A" is  an an operation  to
%2072%		! memory.  Make sure  that "A" and  "B" don't use  the
%2072%		! same register in calculations.  This would result in
%2072%		! trashy code, since the register would be  clobbered.
%2072%		! Mark the register in ARG1NODE as being used so  that
%2072%		! we won't try to use it again in ARG2NODE.

%2072%		RESERVE = RGTOSAVE(.ARG1NODE);	! ARG1NODE's register
%2072%		IF .RESERVE NEQ -1
%2072%		THEN 
%2072%		BEGIN	! Register is given to ARG1NODE
%2072%
%2072%			BSYRG1 = CLRBIT(.BSYRG1,.RESERVE);	! Zap register
%2072%			STRCT1 = .STRCT1-1			! Decr count
%2072%		END;

		TREEPTR_.LHNODE;
		IF .TREEPTR[OPRCLS] NEQ ARRAYREF THEN CGERR();
%2072%		ALCARRAY(.BSYRG1,.STRCT1);	! Allocate the array reference

		TREEPTR_(IF .RHNODE[OPRCLS] EQL SPECOP THEN .RHNODE[ARG1PTR] ELSE .RHNODE[ARG2PTR]);
		IF .TREEPTR[OPRCLS] NEQ ARRAYREF THEN CGERR();
		ALCARRAY(.BSYRG1,.STRGCT-1);
		%(***THE FIRST COMPUTATION TO PERFORM SHOULD ALWAYS BE
			THAT OF ARG1 UNDER THE RIGHT-HAND SIDE***)%
		CSTMNT[RVRSFLG]_1;
		RHNODE[RVRSFLG]_0;
	END;

	RHNODE[A2SAMEFLG]_1;		!WILL COMPUTE INTO THE LOC CONTAING ARG2
	RHNODE[MEMCMPFLG]_1;
	VARCLOBB(.LHNODE);	!THE VAL OF THE VAR ON THE LHS OF THIS ASSIGNMENT STMNT
				! HAS NOW BEEN MODIFIED. MUST CLEAR ANY BB ALLOC
				! TABLE ENTRIES THAT REFER TO THAT VAR

	IF .CSTMNT[SRCSAVREGFLG]	!IF THE LHS OF THIS ASSIGNMENT WILL BE
				! USEFUL TO HAVE IN A REG LATER
	   AND .CSTMNT[OPTOBOTHFLG]	! AND THIS OPERATION IS PERFORMED "TO BOTH"
	THEN SAVEREG(.RHNODE[TARGTAC],	!THEN REMEMBER THAT THE REG USED FOR THIS OP
		.LHNODE,0,.CSTMNT[SRCSONNXTUSE]);	! CONTAINS THE VAL OF THE VAR ON THE LHS

END;	! of ALCMEMCMP
ROUTINE ORDERMEMCMP=
%(***************************************************************************
	ROUTINE TO ORDER ARGS OF AN ARITH OR BOOLEAN OP TO MEMORY SO THAT
	ARG2 IS IDENTICAL TO THE LHS OF THE ASSIGNMENT STMNT
	BE PERFORMED TO MEMORY.
***************************************************************************)%
BEGIN
	OWN PEXPRNODE RHNODE:LHNODE:ARG1NODE:ARG2NODE;

	ROUTINE ARREQLLH(NODE)=
	%(***TO DETERMINE IF 'NODE' IS AN ARRAYREF THAT IS IDENTICAL TO AN ARRAYREF
		ON THE LEFT-HAND-SIDE OF THIS ASSIGNMENT STMNT***)%
	BEGIN
		MAP PEXPRNODE NODE;
		IF .NODE[ARGWD] EQL .LHNODE[ARGWD]	!IF ARRAY NAME AND VARIABLE PART
							! OF SS EXPR ARE IDENTICAL
		THEN
		RETURN (.NODE[TARGET] EQL .LHNODE[TARGET]
%2463%			AND .NODE[OPR1] EQL .LHNODE[OPR1])
		ELSE RETURN FALSE
	END;


	RHNODE_.CSTMNT[RHEXP];
	LHNODE_.CSTMNT[LHEXP];
	ARG1NODE_.RHNODE[ARG1PTR];
	ARG2NODE_.RHNODE[ARG2PTR];



	%(***MUST BE SURE THAT THE ARG UNDER RHNODE WHICH IS EQUAL TO THE LEFT-HAND SIDE
		IS THE 2ND ARG (ARGS MAY HAVE BEEN REVERSED SOMETIME SINCE P2SKEL)***)%
	IF .CSTMNT[A1VALFLG]
	THEN
	BEGIN
		IF .ARG2NODE NEQ .LHNODE
		THEN
		BEGIN
			IF .ARG1NODE NEQ .LHNODE THEN CGERR();

			IF NOT EXCHARGS(.RHNODE) THEN CGERR();

			ARG1NODE_.RHNODE[ARG1PTR];
			ARG2NODE_.RHNODE[ARG2PTR];
		END
	END

	ELSE
	%(***FOR THE LEFT HAND SIDE AN ARRAYREF***)%
	IF .LHNODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		IF NOT ARREQLLH(.ARG2NODE)
		THEN
		%(***IF ARG2 IS NOT EQUAL TO LHS***)%
		BEGIN
			%(***IF NEITHER ARG UNDER RHNODE WAS EQL TO LHNODE, SHOULD
				NOT HAVE CALLED THIS ROUTINE***)%
			IF NOT ARREQLLH(.ARG1NODE) THEN CGERR();

			%(***IF ARG1 AND ARG2 CANNOT BE SWAPPED, THEN COULD NEVER
				HAVE HAD THEM REVERSED EARLIER(IN P2SKEL WHEN DETECTED
				THIS COMP TO MEMORY) - HENCE HAVE A COMPILER BUG***)%
			IF NOT EXCHARGS(.RHNODE) THEN CGERR();

			%(***HAVE NOW SWITCHED THE ARGS (EXCHARGS DOES THIS)***)%
			ARG1NODE_.RHNODE[ARG1PTR];
			ARG2NODE_.RHNODE[ARG2PTR];
		END
	END;

END;	! of ORDERMEMCMP
GLOBAL ROUTINE ALCASSI=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGN STATEMENT.
	IF VAR ASSIGNED TO IS AN ARRAYREF, MUST PERFORM ALLOC FOR IT.
	THE "ASSIGN" OPERATION IS ALWAYS PERFORMED IN REGISTER 1.
***************************************************************************)%
BEGIN
	TREEPTR_.CSTMNT[ASISYM];

	IF .TREEPTR[OPRCLS] EQL ARRAYREF
	THEN
	ALCARRAY(.STBSYR,.STRGCT);

	REGCLOBB(1);	!THE CONTENTS OF REG 1 WILL BE CLOBBERED BY EVAL
			! OF THIS STMNT. CLEAR BB ALLOC TABLE ENTRY FOR REG 1
	VARCLOBB(.CSTMNT[ASISYM]);	!THE VARIABLE ASSIGNED HAS HAD ITS VAL MODIFIED.
					! CLEAR ANY BB ALLOC ENTRIES THAT REFER TO THAT VAR

END;	! of ALCASSI
GLOBAL ROUTINE ALCCALL=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR A CALL STMNT.
***************************************************************************)%
BEGIN
	REGISTER PEXPRNODE SYMPTR;	!PTR TO SYMBOL TABLE ENTRY FOR THE
					! SUBROUTINE NAME

	ALCCMNSB();	!PERFORM ALLOCATION FOR ANY COMMON SUBS

	IF .CSTMNT[CALLIST] NEQ 0
	THEN
	BEGIN
		TREEPTR_.CSTMNT[CALLIST];
		ALCFNARGS(.STBSYR,.STRGCT,FALSE);
	END;

	%(**THE SUBROUTINE CALLED CAN POTENTIALLY CLOBBER ALL THE REGS,
		(UNLESS IT'S A LIBRARY SUBROUTINE SUCH AS "ADJ1.")
		HENCE IF THIS IS A FN IT WILL HAVE TO SAVE/RESTORE THEM ALL**)%
	SYMPTR_.CSTMNT[CALSYM];	!SYM TABLE ENTRY FOR ROUTINE NAME

%2302%	! If the routine is not a  library routine, or if the  routine
%2302%	! is a library  routine which  smashes ACs  (i.e., IDCLOBB  is
%2302%	! set), then mark registers 2-15 (octal) as being clobbered.
%2302%
%2302%	IF NOT .SYMPTR[IDLIBFNFLG] OR .SYMPTR[IDCLOBB]
%2302%	THEN CLOBBREGS = .CLOBBREGS OR #177760000000;

END;	! of ALCCALL
GLOBAL ROUTINE ALCAGO=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNED GOTO
	(NOTE THAT THE ASSIGNED VAL MAY BE AN ARRAYREF THAT REQUIRES CALCULATION)
	THE ACTUAL TESTING OF THE VAL WILL ALWAYS BE PERFORMED IN REG 1.
	CALLED WITH THE GLOBALS
		CSTMNT - PTR TO THE STMNT
		STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
			THIS STMNT
		STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
	%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STATEMENT***)%
	ALCCMNSB();

	%(***PERFORM REG ALLOC FOR ACCESSING THE ASSIGNED VAR***)%
	TREEPTR_.CSTMNT[AGOTOLBL];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
	THEN
	ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);

	REGCLOBB(1);	!THE CONTENTS OF REG 1 ARE CLOBBERED BY EVAL OF THIS
			! STMNT. CLEAR BB ALLOC ENTRIES FOR REG 1

END;	! of ALCAGO
GLOBAL ROUTINE ALCCGO=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR A COMPUTED GOTO.
	PERFORMS REGISTER-ALLOCATION FOR THE COMPUTATION OF THE COMPUTED
	EXPRESSION. THAT VAL WILL ALWAYS BE MOVED TO REG #1 (AS PART OF A SKIP
	OPERATION THAT TESTS ITS RANGE) FOR EXCUTION OF THE GOTO
	CALLED WITH THE GLOBALS
		CSTMNT - PTR TO THE STMNT
		STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
			THIS STMNT
		STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
	%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STATEMENT***)%
	ALCCMNSB();

	%(***PERFORM REGISTER ALLOCATION FOR COMPUTATION OF THE COMPUTED EXPR***)%
	TREEPTR_.CSTMNT[CGOTOLBL];
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
	THEN
	ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);

	REGCLOBB(1);	!THE CONTENTS OF REG 1 ARE CLOBBERED BY EVAL OF THIS
			! STMNT. CLEAR BB ALLOC ENTRIES FOR REG 1

END;	! of ALCCGO
GLOBAL ROUTINE ALCLIF=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR A LOGICAL IF STATEMNT.
	CALLED WITH THE GLOBALS
		CSTMNT - PTR TO THE STMNT
		STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE IN COMPUTING
			THIS STMNT
		STRGCT - CT OF REGS AVAILABLE FOR USE IN COMPUTING THIS STMNT
***************************************************************************)%
BEGIN
	OWN PEXPRNODE CONDEXPR;
	OWN BASE SAVSTMNT;
	OWN SAVBSYR,SAVRCT;

	SAVBSYR_.STBSYR;
	SAVRCT_.STRGCT;


	CONDEXPR_.CSTMNT[LIFEXPR];

	%(***IF THIS STATEMENT IS DOUBLE-PREC, ADJUST SET OF BUSY REGS SO
		THAT ONLY EVEN REGS WILL BE ALLOCATED****)%
	IF .CONDEXPR[DBLFLG]
	THEN
	BEGIN
		STBSYR_DPBSYREGS(.STBSYR);
		STRGCT_ONESCOUNT(.STBSYR);
		DBLMODE_TRUE;
	END
	ELSE
	DBLMODE_FALSE;

	%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STMNT***)%
	ALCCMNSB();

	%(***PERFORM REGISTER ALLOCATION FOR THE CONDITIONAL EXPRESSION***)%

	TREEPTR_.CONDEXPR;

	%(***IF THE EXPRESSION IS OF TYPE CONTROL, NEED NEVER COMPUTE A VALUE FOR IT***)%
	IF .CONDEXPR[VALTYPE] EQL CONTROL
	THEN
	BEGIN
		IF .CONDEXPR[OPRCLS] EQL RELATIONAL	!FOR A RELATIONAL
		THEN ALCRL1(.STBSYR,.STRGCT)
		ELSE
		IF .CONDEXPR[OPRCLS] EQL BOOLEAN	!FOR A BOOLEAN
		THEN
		BEGIN
			NOBBREGSLOAD_TRUE;	!CANNOT ASSUME THAT ALL CODE FOR A CONTROL
						! BOOLEAN WILL BE EXECUTED - SO SET FLAG
						! TO MAKE NO ASSUMPTIONS ABOUT REGS BEING LOADED
			ALCCNT(.STBSYR,.STRGCT);
			NOBBREGSLOAD_FALSE;	!CLEAR FLAG
		END
		ELSE CGERR();	!A CONTROL-TYPE EXPR MUST BE BOOLEAN OR RELATIONAL
	END

	%(***OTHERWISE WILL HAVE TO COMPUTE THE VAL AND TEST IT***)%
	ELSE
	BEGIN
		IF .CONDEXPR[OPRCLS] EQL BOOLEAN	!IF THE CONDITIONAL EXPR IS A BOOLEAN
		THEN
		BEGIN
			%(***WHEN BOOLEANS IN WHICH ARG1 IS A MASK AND ARG2 IS OF TYPE CONTROL
				ARE USED IN A LOGICAL IF - THE CODE GENERATED WILL TEST THE
				THE VAL OF THE MASK AND NOT EXECUTE THE  CONTROL PART
				IF ITS NOT NECESSARY
			*****)%
			OWN PEXPRNODE ARG2NODE;
			ARG2NODE_.CONDEXPR[ARG2PTR];
			IF .ARG2NODE[VALTYPE] EQL CONTROL	!AND THE 1ST TERM OF THE BOOLEAN
								! IS A MASK AND THE 2ND IS OF TYPE CONTROL
			THEN
			NOBBREGSLOAD_TRUE			!DONT MAKE ASSUMPTION THAT ALL
								! CODE FOR THIS BOOLEAN IS ALWAYS EXECUTED
		END;
		ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);
	END;

	%(***PERFORM REGISTER ALLOCATION FOR THE SUBSTATEMENT****)%
	SAVSTMNT_.CSTMNT;
	STBSYR_.SAVBSYR;
	STRGCT_.SAVRCT;
	CSTMNT_.CSTMNT[LIFSTATE];

	NOBBREGSLOAD_TRUE;	!DO NOT ASSUME THAT ANY REGS INITIALIZED BY EVALUATION
				! OF THE SUBSTATEMENT CAN BE USED LATER (SINCE THE SUBSTATEMENT
				! IS NOT ALWAYS EVALUATED)
	ALCSTMN();	!PERFORM ALLOCATION FOR EVALUATION OF THE SUBSTATEMENT
	NOBBREGSLOAD_FALSE;	!RESET FLAG SO THAT WILL ONCE AGAIN ASSUME THAT
				! CODE IS EXECUTED (IF THIS BASIC BLOCK IS EXECUTED)

	CSTMNT_.SAVSTMNT;

END;	! of ALCLIF
GLOBAL ROUTINE ALCAIF=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ARITHMETIC IF.
	CALLED WITH THE GLOBALS
		CSTMNT - PTR TO THE STATEMENT
		STBSYR - HAS A BIT SET FOR EACH REG AVAILABLE FOR USE
			IN COMPUTING THIS STMNT
		STRGCT - CT OF REGS AVAILABLE
***************************************************************************)%
BEGIN
	OWN RA,RB;
	TREEPTR_.CSTMNT[AIFEXPR];

	%(*****IF THE VALUE IS DOUBLE-WD, ADJUST THE SET OF REGS SO THAT ONLY EVEN
		REGS WILL BE ALLOCATED*****)%
	IF .TREEPTR[DBLFLG]
	THEN
	BEGIN
		STBSYR_DPBSYREGS(.STBSYR);
		STRGCT_ONESCOUNT(.STBSYR);
		DBLMODE_TRUE;
	END
	ELSE
	DBLMODE_FALSE;

	%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS UNDER THIS STMNT***)%
	IF .CSTMNT[SRCCOMNSUB] NEQ 0 THEN ALCCMNSB();

	%(***PERFORM REGISTER ALLOCATION FOR THE COMPUTATION OF THE ARITHMETIC EXPRESSION***)%

	TREEPTR_.CSTMNT[AIFEXPR];
	RA_AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]);

	ALCINREG(.RA,.STBSYR,.STRGCT);

	%(***DECIDE WHAT REG TO USE WHEN TESTING THE VALUE OF THE EXPR***)%
	TREEPTR_.CSTMNT[AIFEXPR];
	IF .TREEPTR[INREGFLG]
	THEN
	BEGIN
		CSTMNT[AIFREG]_.TREEPTR[TARGTAC];
		CSTMNT[A1SAMEFLG]_1;
	END

	ELSE
	IF (RB_REGCONTAINING(.CSTMNT[AIFEXPR])) GEQ 0	!IF VAR TO BE TESTED WAS LEFT IN A REG
	THEN
	BEGIN
		CSTMNT[AIFREG]_.RB;	!USE THAT REG
		CSTMNT[A1SAMEFLG]_1;	!DONT RELOAD THE REG
	END

	ELSE
	BEGIN
		%(**PICK A REG TO LOAD THE VAL TO BE TESTED - SINCE THE REG
			GETS LOADED WITH A SKIP INSTR, DO NOT ALLOW REG 0 TO BE USED**)%
		RA_RGTOU1(.CSTMNT,.TREEPTR,.RA,CLRBIT(.STBSYR,REG0));
		CSTMNT[AIFREG]_.RA;
		REGCLOBB(.CSTMNT[AIFREG]);	!THE PREVIOUS CONTENTS OF THE
						! REG ASSIGNED WILL BE CLOBBERED.
						! CLEAR BB ALLOC ENTRIES FOR THAT REG
	END;

END;	! of ALCAIF
GLOBAL ROUTINE ALCDECENC=
%(***************************************************************************
	Routine to perform register allocation for ENCODE/DECODE statements.
***************************************************************************)%
BEGIN
	OWN RA;
	OWN PEXPRNODE ENCVAR;
	OWN PEXPRNODE ENCCT;		!EXPRESSION FOR CHAR CT

	ENCVAR_.CSTMNT[IOVAR];
	ENCCT_.CSTMNT[IOCNT];


	%(***IF THE CHARACTER CT IS AN EXPRESSION, PERFORM REGISTER ALLOC FOR
		ITS CALCULATION***)%
	IF .ENCCT[OPRCLS] NEQ DATAOPR
	THEN
	BEGIN
		TREEPTR_.ENCCT;
		ALCINREG(AFREEREG(.STBSYR,FALSE,FALSE),.STBSYR,.STRGCT);

		%(***IF SOME REGISTER MUST BE PRESERVED IN ORDER TO PRESERVE THE
			VAL OF THE COUNT, DONT WANT TO USE THAT REG IN CALCULATING
			THE ARRAY ADDRESS***)%
		IF (RA_RGTOSAVE(.ENCCT)) NEQ -1
		THEN (STBSYR_CLRBIT(.STBSYR,.RA); STRGCT_.STRGCT-1);

	END;

	! If the  ENCODE-array is  an "ARRAYREF"  node (ie  includes  an
	! offset within the array), perform register allocation for  the
	! address calculation

	IF .ENCVAR[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN	! Allocate array ref

		TREEPTR_.ENCVAR;

%1642%		! Call ALCINREG to decide  which routine we really  want
%1642%		! to allocate this.  We pass 0 for the register since we
%1642%		! don't really want  this put  into a  register and  the
%1642%		! routines called for  an array ref  in ALCINREG do  not
%1642%		! use the register value.
%1642%		ALCINREG(0,.STBSYR,.STRGCT);
	END;

	ALCIOLST();	!PERFORM REG ALLOC FOR THE IOLIST

	! FOR ENCODE STMNTS  MUST ASSUME  THAT THE  ARRAY BEING  ENCODED
	! INTO (AND  ANY VARS  POTENTIALLY EQUIVALENCED  TO IT)  HAS  IT
	! CONTENTS MODIFIED.
	IF .CSTMNT[SRCID] EQL ENCOID THEN VARCLOBB(.ENCVAR);

END;	! of ALCDECENC
GLOBAL ROUTINE ALCOPEN=
BEGIN
	!***************************************************************
	! Performs register allocation  for an OPEN,  CLOSE, or  INQUIRE
	! statement  for   the  calculation   of  arguments   that   are
	! expressions.  Global INPFLAG is TRUE for INQUIRE and indicates
	! that the arguments are modified.
	!***************************************************************

	REGISTER OPENLIST ARVALLST;
	ARVALLST = .CSTMNT[OPLST];	! List of arguments under the statement

	! Walk thru the list  of arguments, perform register  allocation
	! for the calculation of any arg that is not a variable or const

%2572%	INCR I FROM 0 TO .CSTMNT[OPSIZ] - 1 DO
	BEGIN
		! Expression node for the val of the Ith arg
		TREEPTR = .ARVALLST[.I,OPENLPTR];

%2201%		IF .TREEPTR NEQ 0
%2201%		THEN
%2201%		BEGIN	! Not DIALOG or READONLY
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN
			BEGIN
			! Be sure to handle array for ASSOCIATE VARIABLE
			! correctly here so that the address is set up rather
			! than the value in the array element
			    IF .TREEPTR[OPRCLS] NEQ ARRAYREF
%1700%			    THEN ALCTMP() ! Allocate a 1 or 2 word .Q temp
			    ELSE IF .ARVALLST[.I,OPENLCODE] EQL OPNCASSOCIATE
				OR .INPFLAG
				THEN ARVALLST[.I,OPENLPTR] = ALCTARY(.STBSYR,.STRGCT)
					! Allocate array address to temp
				ELSE ARVALLST[.I,OPENLPTR] = ALCTVARR(.STBSYR,.STRGCT);
					! Allocate variable to temp
			END;

%2201%			! INQUIRE clobbers its arguments

%2201%			IF .INPFLAG THEN VARCLOBB(.TREEPTR);
		END;
	END;

END;	! of ALCOPEN
GLOBAL ROUTINE ALCCMNSB=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR ALL COMMON SUBEXPRS UNDER
	THE STATEMENT "CSTMNT".
	DEPENDING ON THE NUMBER OF REGS NECESSARY TO COMPUTE THE STATEMENT
	AND THE NUMBER OF REGS AVAILABLE (WHICH IS INDICATED BY THE GLOBAL "STRGCT",
	LEAVES AS MANY COMMON SUBEXPRS AS POSSIBLE IN REGISTERS.
***************************************************************************)%
BEGIN
	OWN RA,RB;
	OWN PEXPRNODE CCMNSUB:ARGNODE;
	OWN BASE CCSTMNT;	! SAVE CSTMNT
	OWN BSYRG1,REGCT1;
	OWN REGSNEEDED;		!NUMBER OF REGISTERS NEEDED (EXCEPT FOR COMMON SUBEXPRS)
			! FOR COMPUTATION OF THIS STMNT
	OWN PAIRSNEEDED;	!FOR STMNTS THAT REQUIRE REG PAIRS, MAX NUMBER OF PAIRS NEEDED
	OWN FREERGPAIRS;	!NUMBER OF REG PAIRS FREE


	CCMNSUB_.CSTMNT[SRCCOMNSUB];
	CCSTMNT_.CSTMNT;	! SAVE CSTMNT FOR ALC TO 0 CHECK

	REGSNEEDED_.CSTMNT[SRCCMPLX];	!NUMBER OF REGS NEEDED FOR THIS STMNT
	PAIRSNEEDED_(.CSTMNT[SRCCMPLX]+1)/2;	!MAX NUMBER OF PAIRS NEEDED


	%(**WALK THRU ALL COMMON SUBS ON THIS STMNT***)%
	UNTIL .CCMNSUB EQL 0
	DO
	BEGIN
		ARGNODE_.CCMNSUB[ARG2PTR];
		TREEPTR_.ARGNODE;


		%(***IF THIS COMMON SUBEXPR IS DOUBLE-PREC AND THE STATEMENT IS NOT,
			THEN MUST ADJUST THE SET OF AVAILABLE REGS TO INCLUDE ONLY EVEN REGS***)%
		IF .ARGNODE[DBLFLG] AND NOT .DBLMODE
		THEN
		BEGIN
			BSYRG1_DPBSYREGS(.STBSYR);
			REGCT1_ONESCOUNT(.BSYRG1);
		END
		ELSE
		BEGIN
			BSYRG1_.STBSYR;
			REGCT1_.STRGCT;
		END;


		%(***IF THIS COMMON SUB WILL BE USED AS A SS, DONT USE REG 0 FOR IT**)%
		IF .CCMNSUB[CSSSFLG]
		THEN
		BEGIN
			IF BITSET(.BSYRG1,0) THEN
			(REGCT1_.REGCT1-1; BSYRG1_CLRBIT(.BSYRG1,0))
		END;


		%(***DETERMINE HOW MANY REG PAIRS ARE NOW AVAILABLE**)%
		FREERGPAIRS_
			IF .DBLMODE OR .ARGNODE[DBLFLG]		!IF BSYRG1 IS ALREADY IN TERMS OF PAIRS
			THEN .REGCT1
			ELSE FREEPAIRS(.STBSYR);


		%(***IF THERE ARE ENOUGH REGISTERS FREE SO THAT THIS THIS EXPRESSION
			CAN BE LEFT IN A REG WHILE CALCULATING THE WHOLE STATEMENT,
			LEAVE THIS EXPR IN A REG.
			OTHERWISE LEAVE IT IN A TEMPORARY.
		********)%
		IF (NOT .PAIRMODE	!WHEN THIS STMNT NEEDS NO ADJACENT PAIRS
			AND .STRGCT GTR .REGSNEEDED+1)	!NUMBER OF REGS LEFT SHOULD BE 
							! GREATER THAN 1 MORE THAN NUMBER NEEDED
		  OR
			(.FREERGPAIRS GTR .PAIRSNEEDED+1)	!IF STMNT WILL NEED PAIRS, SHOULD
							! HAVE AT LEAST  1 EXTRA PAIR BEFORE RISK
							! USING UP A PAIR
		  OR
			(.CCMNSUB[CSSSFLG]	!IF THIS CSB IS USED AS A SUBSCRIPT
			 AND .FREERGPAIRS GTR 2)	!THEN PUT IT IN A REG AS LONG AS
						! 2 PAIRS CAN BE LEFT
		THEN
		BEGIN
			RA_AFREEREG(.BSYRG1,.CCMNSUB[SAVREGFLG],.CCMNSUB[DBLFLG]);
			IF NOT .CCMNSUB[A2VALFLG]
			THEN
			ALCINREG(.RA,.BSYRG1,.REGCT1);

			%(***IF THE COMMON SUB WAS COMPUTED INTO A REG WHERE IT CAN
				BE LEFT - LEAVE IT THERE***)%
			IF .ARGNODE[INREGFLG] AND NOT .ARGNODE[ALCRETREGFLG]
				!IF THE COMMON SUB IS THE RIGHT HALF OF AN AOBJN WD
				! AND IS USED IN A CONTEXT THAT REQUIRES A FULL WD,
				! CANNOT USE THE AOBJN REG
				AND NOT (.CCMNSUB[A2IMMEDFLG] AND .CCMNSUB[CSFULLWDFLG])
			THEN
			BEGIN
				CCMNSUB[TARGTAC]_.ARGNODE[TARGTAC];
				CCMNSUB[TARGADDR]_.CCMNSUB[TARGTAC];
				CCMNSUB[A2SAMEFLG]_1;
			END

			ELSE
			IF (RB_REGCONTAINING(.ARGNODE)) GEQ 0	!IF ARG IS A VAR WHOSE VAL WAS LEFT IN A REG
				AND	! IF IT'S AN ASSIGNMENT STATEMENT
				(IF .CCSTMNT[SRCID] EQL ASGNID AND .CCSTMNT[OPRCLS] EQL STATEMENT
				THEN	! IF THE LEFT HALF IS A REGCONTENTS
				BEGIN	! NODE TO 0
				LOCAL PEXPRNODE T1;
				T1_.CCSTMNT[LHEXP];
				IF .T1[OPRCLS] EQL REGCONTENTS AND .RB EQL 0
				THEN FALSE	! WE CAN'T USE ZERO
				ELSE TRUE	! ANYTHING BUT 0
				END
				ELSE TRUE)
				AND NOT ((.RB EQL RETREG	! THIS IS NOT 0
					OR .RB EQL (RETREG+1))	! OR 1
					AND .CSTMNT[FNCALLSFLG])	! WHEN THERE IS A FUNCTION CALL
								! UNDER THIS NODE
				AND .CCMNSUB[A2NGNTFLGS] EQL 0	! AND ARG NEED NOT BE NEGATED
				AND NOT(.RB EQL 0 AND .CCMNSUB[CSSSFLG])	!AND DO NOT HAVE A VAR WHICH WILL
							! BE USED AS A SS IN REG 0
			THEN
			BEGIN
				CCMNSUB[TARGTAC]_.RB;	!THEN USE THAT REG
				CCMNSUB[TARGADDR]_.RB;
				CCMNSUB[A2SAMEFLG]_1;	!DONT RELOAD THE REG
			END
			ELSE
			BEGIN
				RA_RGTOU1(.CCMNSUB,.ARGNODE,.RA,.BSYRG1);
				SETTARGINREG(.CCMNSUB,.RA)
			END;

			CCMNSUB[INREGFLG]_1;

			RA_.CCMNSUB[TARGTAC];
			%(***REMOVE THE REG HOLDING THIS COMMON SUB FROM THE REG POOL***)%
			STBSYR_CLRBIT(.STBSYR,.RA);
			STRGCT_.STRGCT-1;

			%(***IF THE COMMON SUB IS DOUBLE-WD, REMOVE THE REG HOLDING THE RIGHT HALF
				FROM THE REG POOL***)%
			IF .ARGNODE[DBLFLG]
			THEN
			BEGIN
				STBSYR_CLRBIT(.STBSYR,.RA+1);
				STRGCT_.STRGCT-1;
			END;


			IF .ARGNODE[OPRCLS] EQL DATAOPR	!IF THE COMMON SUB IS A VAR
				AND .CCMNSUB[SAVREGFLG]	! WHICH WILL BE USEFUL IN A REG IN A LATER STMNT
				AND .CCMNSUB[A2NGNTFLGS] EQL 0	! AND  WAS NOT PICKED UP WITH "MOVN"
			THEN SAVEREG(.CCMNSUB[TARGTAC],	!REMEMBER THAT THIS REG
				.ARGNODE,		! CONTAINS THE VAL OF THAT VAR
				0,.CCMNSUB[SONNXTUSE]);

		END

		ELSE
		%(***IF CANNOT SPARE A REG TO LEAVE THIS COMMON SUBEXPR IN****)%
		BEGIN
			IF .CCMNSUB[A2VALFLG]
			THEN
			BEGIN
				%(***IF THIS ARG IS THE RIGHT HALF OF AN AONJN WD
					AND WE WILL NEED THE WHOLE THING, MUST LOAD AND STORE IT***)%
				IF .CCMNSUB[A2IMMEDFLG] AND .CCMNSUB[CSFULLWDFLG]
				THEN
				BEGIN

					! Choose a register for the common sub
					CCMNSUB[TARGTAC] = RA = AFREEREG(.BSYRG1,.CCMNSUB[SAVREGFLG],FALSE);
					! The register's previous contents
					! are clobbered.
					REGCLOBB(.RA);
					! Get 1 word .Qnnnn temporary
%1274%					CCMNSUB[TARGADDR] = NXTTMP(1);
					! Set flag to store AC into .Qnnnn var
%1753%					CCMNSUB[STOREFLG] = 1;
				END
				ELSE
				%(***IF THE COMMON SUB IS A REGCONTENTS THAT CAN BE USED, USE IT**)%
				IF .ARGNODE[OPRCLS] EQL REGCONTENTS
				THEN
				BEGIN
					CCMNSUB[TARGET]_.ARGNODE[TARGET];
					CCMNSUB[A2SAMEFLG]_1;
				END

				ELSE
				BEGIN
					CCMNSUB[TARGET]_.ARGNODE;
					CCMNSUB[A2SAMEFLG]_1;
				END
			END
			ELSE
			BEGIN
%1274%				! Get 1 or 2 word temp based on DBLFLG

%1274%				IF .TREEPTR[DBLFLG]
%1274%				THEN ALCINTMP(NXTTMP(2),.BSYRG1,.REGCT1)
%1274%				ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.REGCT1);

				CCMNSUB[TARGET]_.ARGNODE[TARGET];
				CCMNSUB[A2SAMEFLG]_1;
			END;
		END;

		CCMNSUB_.CCMNSUB[CLINK];

	END;

END;	! of ALCCMNSB
GLOBAL ROUTINE ALCIOLST=
%(***************************************************************************
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN IOLIST.
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT FOR
	WHICH AN IOLIST IS TO BE PROCESSED.
	CALLED WITH THE GLOBALS STBSYR AND STRGCT INDICATING WHICH REGS
	ARE AVAILABLE FOR USE.
***************************************************************************)%
BEGIN

	LOCAL BASE IOLELEM;
	LOCAL SAVSTMNT,SAVBSYR,SAVRGCT;
%2047%	LOCAL SAVEPAIRMODE;

	%(***GET PTR TO 1ST ELEM ON IOLIST TO BE PROCESSED***)%
	IOLELEM_.CSTMNT[IOLIST];

	%(****SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS ON THE IOLIST
		WILL CLOBBER CSTMNT,STBSYR,STRGCT)*****)%
	SAVSTMNT_.CSTMNT;
	SAVBSYR_.STBSYR;
	SAVRGCT_.STRGCT;

	%(*****WALK THRU THE ELEMENTS ON THE IOLIST******)%
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN
		IF .IOLELEM[OPRCLS] EQL STATEMENT
		THEN
		BEGIN
			CSTMNT_.IOLELEM;
%2047%			SAVEPAIRMODE = .PAIRMODE;
			ALCSTMN();
%2047%			PAIRMODE = .SAVEPAIRMODE;

			%(**IF THIS STMNT IS A DO STMNT, MUST TERMINATE THE PREVIOUS BASIC BLOCK
				(SINCE SOME VAR MIGHT BE CLOBBERED LATER IN THE LIST AND ON
				LOOPING BACK MIGHT MAKE A FALSE ASSUMPTION ABOUT ITS VAL
				BEING IN A REG)
			***)%

%2364%			! CSTMNT and IOLELEM both point to the current
%2364%			! statement  under   the   I/O   list.    Call
%2364%			! ENDSMZTRIP (which looks at CSTMNT) to see if
%2364%			! this statement  ends a  MAYBEZTRIP  DO-loop.
%2364%			! If  so,   mark   all  registers   as   being
%2364%			! clobbered.
%2364%
%2364%			IF ENDSMZTRIP()
%2364%			THEN CLRRGSTATE()
%2364%			ELSE IF .IOLELEM[SRCID] EQL DOID
			THEN
			BEGIN
				CLRRGSTATE();	!MUST DELETE ALL ASSUMPTIONS ABOUT
							! THE CONTENTS OF REGISTERS

				IF .IOLELEM[SAVREGFLG]	!IF THE DO INDEX WILL BE USEFUL
							! LATER, REMEMBER WHAT REG ITS IN
				THEN SAVEREG(.IOLELEM[DOIREG],
					.IOLELEM[DOSYM],0,.IOLELEM[SRCSONNXTUSE],
					FALSE);
			END;

		END

		ELSE
		IF .IOLELEM[OPRCLS] EQL IOLSCLS
		THEN
		BEGIN
			CASE .IOLELEM[OPERSP] OF SET

			%(***FOR A DATACALL NODE - PERFORM REG ALLOC FOR THE
				EXPRESSION UNDER THIS NODE*****)%
			BEGIN
				TREEPTR_.IOLELEM[DCALLELEM];
				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN
				BEGIN
					LOCAL STBSY1,STRG1;
					IF .TREEPTR[DBLFLG] THEN
					BEGIN
						STBSY1_DPBSYREGS(.STBSYR);
						STRG1_ONESCOUNT(.STBSY1);
					END ELSE
					BEGIN
						STBSY1_.STBSYR;
						STRG1_.STRGCT;
					END;
					ALCINREG(AFREEREG(.STBSY1,FALSE,.TREEPTR[DBLFLG]),.STBSY1,.STRG1);

%1220%					! Put fn calls out into a temp.

%1220%					TREEPTR_.IOLELEM[DCALLELEM];
%1220%					IF .TREEPTR[ALCRETREGFLG] THEN
%1220%					BEGIN
%1274%						! Get 1 or 2 word temp based on DBLFLG
%2065%						! DBLFLG - except for character
%2065%						! functions

%2065%						IF .TREEPTR[VALTYPE] NEQ CHARACTER
%2065%						THEN
%1274%							TREEPTR[TARGTMEM] =
%1274%							IF .TREEPTR[DBLFLG]
%1274%							THEN NXTTMP(2)
%1274%							ELSE NXTTMP(1);
%2065%						! Don't store control or character
%2065%						! results


%1220%						IF .TREEPTR[VALTYPE] NEQ CONTROL
%2065%						THEN IF .TREEPTR[VALTYPE] NEQ CHARACTER
%2065%						THEN TREEPTR[STOREFLG]_1;

%1220%						TREEPTR[TARGTAC]_RETREG;
%1220%					TREEPTR[INREGFLG]_0
%1220%				END
				END;
				IF .INPFLAG	!IF INPUT IS BEING PERFORMED
				THEN VARCLOBB(.IOLELEM[DCALLELEM])	!THE VAL OF THE VAR WILL BE
							! CLOBBERED, HENCE MUST FORGET ASSUMPTIONS
							! ABOUT THAT VAR BEING IN SOME REG
			END;

			%(***FOR AN SLISTCALL NODE - PERFORM REG ALLOC FOR THE OPERATION
				TO CALCULATE THE NUMBER OF ELEMS IN THE ARRAY (IF ARRAY
				HAS VARIABLE BOUNDS)****)%
			BEGIN
				TREEPTR_.IOLELEM[SCALLCT];
				IF .TREEPTR[OPRCLS] NEQ DATAOPR
				THEN
				ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);

				IF .INPFLAG	!IF INPUT IS BEING PERFORMED
				THEN VARCLOBB(.IOLELEM[SCALLELEM]);	!MUST ASSUME THAT ELEMENTS OF THE
								! ARRAY AND ALL VARS EQUIVALENCED TO THEM
								! ARE CLOBBERED
			END;

			%(***FOR AN IOLSTCALL NODE***************)%
			ALCIOCALL(.IOLELEM);

			%(****FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				SAVCSTMNT_.CSTMNT;
				CSTMNT_.IOLELEM;
				ALCCMNSB();
				CSTMNT_.SAVCSTMNT;
				ALCE1LIST(.IOLELEM,.STBSYR,.STRGCT);
!**;[1220], ALCIOLST, DCE, 2-Jun-81
%[1220]%			CSTMNT_.SAVCSTMNT;
			END;

			%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				SAVCSTMNT_.CSTMNT;
				CSTMNT_.IOLELEM;
				ALCCMNSB();
				CSTMNT_.SAVCSTMNT;
				ALCE2LIST(.IOLELEM,.STBSYR,.STRGCT)
			END

			TES;
		END;

		%(***RESTORE STBSYR,STRGCT FOR THE NEXT ELEM ON IOLIST***)%
		STBSYR_.SAVBSYR;
		STRGCT_.SAVRGCT;

		%(***GO ON TO NEXT ELEMENT****)%
		IOLELEM_.IOLELEM[CLINK];

	END;

	CSTMNT_.SAVSTMNT;

END;	! of ALCIOLST
GLOBAL ROUTINE ALCIOCALL(IOLSNODE)=
%(***************************************************************************
	TO PERFORM REGISTER ALLOCATION FOR AN IOLSTCALL NODE.
	THE ARG IOLSNODE PTS TO AN IOLSTCALL NODE.
	FOR IOLIST ELEMENTS THAT REQUIRE COMPUTATION, LEAVE AS MANY
	AS POSSIBLE IN THE REGS IN WHICH THEY WERE COMPUTED (RATHER THAN
	STORING THEM IN TEMPORARIES). ALSO LEAVE AS MANY ARRAY OFFSETS
	AS POSSIBLE IN REGISTERS.
***************************************************************************)%
BEGIN
	MAP BASE IOLSNODE;
	MAP PEXPRNODE TREEPTR;
	OWN BASE IOLELEM;
	OWN REGSREQ;
	OWN FREGCT,BSYREGS;	!REGISTERS AVAILABLE FOR USE AT THE CURRENT PT IN
				! THE IOLIST (AS EARLY ELEMS GET LEFT IN REGS,
				! THESE VARIABLES ARE ADJUSTED SO THAT LATER ELEMS
				! WONT CLOBBER THOSE REGS)
	OWN FRGCT1,BSYRG1;	!FOR A DATACALL NODE - THESE ARE ADJUSTED TO ACCOUNT
				! FOR  A DOUBLE PRECISION EXPRESSION
	OWN RA;
	OWN PEXPRNODE ARGNODE;
	OWN SAVSTMNT;

%2047%	REGISTER FREERGPAIRS;	! Number of free register pairs

	%(***SAVE VAL OF THE GLOBAL CSTMNT***)%
	SAVSTMNT_.CSTMNT;

	%(***PERFORM REGISTER ALLOCATION FOR ANY COMMON SUBEXPRS ON THIS IOLST***)%
	CSTMNT_.IOLSNODE;
	ALCCMNSB();

	%(***GET NUMBER OF REGS REQUIRED FOR REST OF THIS IOLSTCALL***)%
	REGSREQ_.IOLSNODE[SRCCMPLX];

	BSYREGS_.STBSYR;
	FREGCT_.STRGCT;

	%(***WALK THRU ELEMENTS ON THIS IOLSTCALL***)%
	IOLELEM_.IOLSNODE[IOLSTPTR];
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN
		CASE .IOLELEM[OPERSP] OF SET

		%(***FOR A DATACALL NODE****)%
		BEGIN
			TREEPTR_.IOLELEM[DCALLELEM];
			ARGNODE_.TREEPTR;

			IF .ARGNODE[OPRCLS] NEQ DATAOPR	! IF NEED TO CALCULATE
			! DO NOT NEED TO GET A NEW REGISTER IF THIS ELEMENT IS A REGCONTENTS NODE
			THEN IF .ARGNODE[OPRCLS] NEQ REGCONTENTS
![764] NO REGISTER IS NEEDED FOR AN IMMEDIATE ARRAY REFERENCE
%[764]%			THEN IF NOT (.ARGNODE[OPRCLS] EQL ARRAYREF AND
%[764]%				     .ARGNODE[ARG2PTR] EQL 0)
			THEN	! THE VALUE OF THIS ITEM
			BEGIN	! THEN ALLOCATE THE REGS

				%(***IF THIS ELEMENT IS DOUBLE-PREC - MUST ADJUST SET OF FREE REGS***)%
				IF .ARGNODE[DBLFLG]
				THEN
%2047%				BEGIN	! Double
%2047%
%2047%					BSYRG1 = DPBSYREGS(.BSYREGS);
%2047%					FREERGPAIRS = FRGCT1 = ONESCOUNT(.BSYRG1);
%2047%
%2047%				END	! Double
%2047%				ELSE
%2047%				BEGIN	! Non-double
%2047%
%2047%					BSYRG1 = .BSYREGS;
%2047%					FRGCT1 = .FREGCT;
%2047%					FREERGPAIRS = FREEPAIRS(.BSYREGS);
%2047%
%2047%				END;	! Non-double

				%(***IF THERE ARE ENOUGH REGS TO LEAVE ALL FURTHER ARGS IN REGS***)%
![1142] Since the complexity count is only 6 bits worth, the field may
![1142]  overflow for a complicated IOLISTCALL node, and the number of
![1142]  registers required may appear as 0, or the correct number modulo 64.
![1142]  Check for these cases, and leave two free registers so that the temp
![1142]  allocator can still succeed with array refs.

%2047%				IF .REGSREQ GTR 0
%2047%					AND .REGSREQ LSS .FREGCT-1
%2047%					AND (NOT .PAIRMODE
%2047%						! Need one pair left over
%2047%						OR .FREERGPAIRS GTR 1)
				THEN
				BEGIN
					ALCINREG(AFREEREG(.BSYRG1,FALSE,.TREEPTR[DBLFLG]),.BSYRG1,.FRGCT1);

					%(***IF THIS ARG WAS LEFT IN A REG, MUST TAKE THAT REG
						OUT OF THE SET OF REGS AVAILABLE FOR USE FOR
						LATER ELEMENTS****)%
%1220%					! If value left in fn return reg, must use a temp instead.

%1220%					IF .ARGNODE[ALCRETREGFLG] THEN
%1220%					BEGIN 
%1274%						! Get 1 or 2 word temp based on DBLFLG

%1274%						ARGNODE[TARGTMEM] =
%1274%						IF .ARGNODE[DBLFLG]
%1274%						THEN NXTTMP(2)
%1274%						ELSE NXTTMP(1);

%1404%						IF .ARGNODE[VALTYPE] NEQ CONTROL
						THEN ARGNODE[STOREFLG]_1;

%1220%						ARGNODE[TARGTAC]_RETREG;
%1220%						ARGNODE[INREGFLG]_0
%1220%					END;
					RA_RGTOSAVE(.ARGNODE);
					IF .RA NEQ -1
					THEN
					BEGIN
						BSYREGS_CLRBIT(.BSYREGS,.RA);

						%(***IF THIS ARG WAS DOUBLE-PREC MUST ALSO
							REMOVE THE REG AFTER RA FROM THE SET***)%
						IF .ARGNODE[DBLFLG]
						THEN
						BEGIN
							BSYREGS_CLRBIT(.BSYREGS,.RA+1);
							FREGCT_.FREGCT-2;
							REGSREQ_.REGSREQ-2;
						END
						ELSE
						BEGIN
							FREGCT_.FREGCT-1;
							REGSREQ_.REGSREQ-1;
						END;
					END;
				END

				%(***IF THERE ARE NOT ENOUGH REGS, THEN IF THIS ELEM IS COMPUTED,
					LEAVE IT IN A TEMP***)%
				ELSE
				BEGIN
					IF .TREEPTR[OPRCLS] EQL ARRAYREF
					THEN
					%(***FOR AN ARRAYREF - IF THE SS IS ALREADY IN A REG, CAN PASS
						FOROTS ARG IN THE FORM "ADDR(R)"
						OTHERWISE, MUST MATERIALIZE THE ADDRESS REFERENCED***)%
					BEGIN
						IF .TREEPTR[A2VALFLG] AND NOT .TREEPTR[A2NEGFLG]
%2023%							AND .TREEPTR[VALTYPE] NEQ CHARACTER
						THEN
						BEGIN
							OWN PEXPRNODE SSNODE;
							SSNODE_.TREEPTR[ARG2PTR];
							IF (.SSNODE[OPRCLS] EQL REGCONTENTS) OR 
								(.SSNODE[OPRCLS] EQL CMNSUB
									AND .SSNODE[INREGFLG])
							THEN
							BEGIN 
								%(***SET THE "INDEX" FIELD TO
									BE USED TO REFERENCE THE ELEMENT
									TO THE REG THAT HOLDS THE SS***)%
								TREEPTR[TARGXF]_.SSNODE[TARGTAC];
								TREEPTR[A2SAMEFLG]_1
							END

							ELSE IOLELEM[DCALLELEM]_ALCTARY(.BSYRG1,.FRGCT1)
						END
						ELSE
						IOLELEM[DCALLELEM]_ALCTARY(.BSYRG1,.FRGCT1)
					END
					ELSE
%1274%						! Get 1 or 2 word temp based on DBLFLG

%1274%						IF .TREEPTR[DBLFLG]
%1274%						THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%1274%						ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);

					%(***IF AN ARG THAT MIGHT HAVE BEEN LEFT IN A REG WAS
						LEFT IN A TEMP, CAN REDUCE THE NUMBER OF FUTURE REGS
						REQUIRED BY 1***)%
					IF .TREEPTR[OPRCLS] NEQ DATAOPR AND .TREEPTR[OPRCLS] NEQ CMNSUB
					THEN
					BEGIN
						IF .TREEPTR[COMPLEXITY] NEQ 0
						THEN
						BEGIN
							%(***FOR DOUBLE-WD VAL HAVE 2 EXTRA REGS**)%
							IF .TREEPTR[DBLFLG]
							THEN REGSREQ_.REGSREQ-2
							ELSE REGSREQ_.REGSREQ-1;
						END
					END;
				END;
			END;	! OF IF NEQ DATAOPR

%2363%			! If input is being performed, we must  assume
%2363%			! the variable is  clobbered.  Note that  this
%2363%			! includes a COMMON/EQUIVALENCE check.
%2363%
%2363%			IF .INPFLAG
%2363%			THEN VARCLOBB(.IOLELEM[DCALLELEM]);

		END;

		%(***FOR AN SLISTCALL NODE***)%
		BEGIN
			TREEPTR_.IOLELEM[SCALLCT];
			IF .TREEPTR[OPRCLS] NEQ DATAOPR
			THEN
			%(***DONT BOTHER TO TRY TO LEAVE THIS IN A REG***)%
%1274%				! Get 1 or 2 word temp based on DBLFLG

%1274%				IF .TREEPTR[DBLFLG]
%1274%				THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274%				ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);

%2363%			! If input is being performed, we must  assume
%2363%			! the array  is  clobbered.   Note  that  this
%2363%			! includes a COMMON/EQUIVALENCE check.
%2363%
%2363%			IF .INPFLAG
%2363%			THEN VARCLOBB(.IOLELEM[SCALLELEM]);

		END;

		%(***AN IOLSTCALL WITHIN AN IOLSTCALL IS ILLEGAL***)%
		BEGIN
		END;

		%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%
		ALCE1LIST(.IOLELEM,.BSYREGS,.FREGCT);

		%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%
		ALCE2LIST(.IOLELEM,.BSYREGS,.FREGCT)

		TES;

		%(***GO ON TO NEXT ELEMENT***)%
		IOLELEM_.IOLELEM[CLINK];
	END;

	%(***RETSORE CSTMNT***)%
	CSTMNT_.SAVSTMNT;

END;	! of ALCIOCALL
GLOBAL ROUTINE ALCE1LIST(IOLELEM,BSYREGS,FREGCT)=
%(**********************************************************************
	PERFORM REGISTER ALLOCATION FOR AN E1LISTCALL NODE
	STORE THE RESULTS OF ALL CALCULATIONS REQUIRED BY
	ELEMENTS IN THE E1LISTCALL NODE IN TEMPORARIES
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	MAP PEXPRNODE TREEPTR;
	LOCAL BASE IOARRAY;
%2363%	LOCAL BSYRG1;			! Adjusted set of free regs
%2363%	LOCAL FRGCT1;			! Adjusted count of free regs

	%(***ALLOCATE THE COUNT EXPRESSION***)%

	TREEPTR_.IOLELEM[ECNTPTR];
	IF .TREEPTR[OPRCLS] EQL ARRAYREF	!REF TO AN ARRAY ELEM
	THEN	IOLELEM[ECNTPTR]_ALCTVARR(.BSYREGS,.FREGCT)	!LINK A STORECLS NODE INTO THE TREE
	ELSE
	IF .TREEPTR[OPRCLS] NEQ DATAOPR 
%1274%	THEN	! Get 1 or 2 word temp based on DBLFLG

%1274%		IF .TREEPTR[DBLFLG]
%1274%		THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274%		ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);

	%(***ALLOCATE THE INCREMENT EXPRESSION***)%

	TREEPTR_.IOLELEM[E1INCR];
	IF .TREEPTR[OPRCLS] EQL ARRAYREF
	THEN IOLELEM[E1INCR]_ALCTVARR(.BSYREGS,.FREGCT)
	ELSE
	IF .TREEPTR[OPRCLS] NEQ DATAOPR 
%1274%	THEN	! Get 1 or 2 word temp based on DBLFLG

%1274%		IF .TREEPTR[DBLFLG]
%1274%		THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274%		ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);

	%(***ALLOCATE THE ARRAY REFERENCES***)%

	IOARRAY_.IOLELEM[ELSTPTR];
	WHILE .IOARRAY NEQ 0
%2363%	DO
%2363%	BEGIN	! For each element
%2363%
%2363%		TREEPTR = .IOARRAY[E2ARREFPTR];
%2363%
%2363%		! We don't  need to  do  register allocation  if  this
%2363%		! element is  a DATAOPR,  a  REGCONTENTS node,  or  an
%2363%		! ARRAYREF with no subscript expression.
%2363%
%2363%		IF .TREEPTR[OPRCLS] NEQ DATAOPR
%2363%		THEN IF .TREEPTR[OPRCLS] NEQ REGCONTENTS
%2363%		THEN IF NOT (.TREEPTR[OPRCLS] EQL ARRAYREF AND
%2363%			     .TREEPTR[ARG2PTR] EQL 0)
%2363%		THEN
%2363%		BEGIN	! Do register allocation
%2363%
%2363%			! Determine the set of free registers
%2363%
%2363%			IF .TREEPTR[DBLFLG]
%2363%			THEN
%2363%			BEGIN	! Double
%2363%
%2363%				BSYRG1 = DPBSYREGS(.BSYREGS);
%2363%				FRGCT1 = ONESCOUNT(.BSYRG1);
%2363%
%2363%			END	! Double
%2363%			ELSE
%2363%			BEGIN	! Non-double
%2363%
%2363%				BSYRG1 = .BSYREGS;
%2363%				FRGCT1 = .FREGCT;
%2363%
%2363%			END;	! Non-double
%2363%
%2363% 			! For an  ARRAYREF,  we must  materialize  the
%2363% 			! address referenced.  For a non-ARRAYREF, use
%2363% 			! a 1 or 2 word temp based on DBLFLG.
%2363%
%2363%			IF .TREEPTR[OPRCLS] EQL ARRAYREF
%2363%			THEN IOARRAY[E2ARREFPTR] = ALCTARY(.BSYRG1,.FRGCT1)
%2363%			ELSE IF .TREEPTR[DBLFLG]
%2363%			THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%2363%			ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
%2363%
%2363%		END;	! Do register allocation
%2363%
%2363%		! If input  is being  performed,  we must  assume  the
%2363%		! variable is clobbered.   Note that  this includes  a
%2363%		! COMMON/EQUIVALENCE check.
%2363%
%2363%		IF .INPFLAG
%2363%		THEN VARCLOBB(.IOARRAY[E2ARREFPTR]);
%2363%
%2363%		IOARRAY = .IOARRAY[CLINK];	! Move to next element
%2363%
%2363%	END;	! For each element

	%(***ALLOCATE THE ASSIGNMENT STATEMENT(S) TO LOOP VARIABLE***)%
%1663%	ALCASCHAIN( .IOLELEM[ELPFVLCHAIN], .BSYREGS, .FREGCT );

END;	! of ALCE1LIST
GLOBAL ROUTINE ALCE2LIST(IOLELEM,BSYREGS,FREGCT)=
%(**********************************************************************
	PERFORM REGISTER ALLOCATION FOR AN E2LISTCALL NODE
	STORE THE RESULTS OF ALL CALCULATIONS REQUIRED BY
	ELEMENTS IN THE E2LISTCALL NODE IN TEMPORARIES
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	MAP PEXPRNODE TREEPTR;
	LOCAL BASE IOARRAY;
%2363%	LOCAL BSYRG1;			! Adjusted set of free regs
%2363%	LOCAL FRGCT1;			! Adjusted count of free regs

	%(***ALLOCATE THE COUNT EXPRESSION***)%

	TREEPTR_.IOLELEM[ECNTPTR];		!ALLOCATE EXPRESSION
	IF .TREEPTR[OPRCLS] EQL ARRAYREF	!REF TO AN ARRAY ELEM
	THEN	IOLELEM[ECNTPTR]_ALCTVARR(.BSYREGS,.FREGCT)	!LINK A STORECLS NODE INTO THE TREE
	ELSE
	IF .TREEPTR[OPRCLS] NEQ DATAOPR
%1274%	THEN	! Get 1 or 2 word temp based on DBLFLG

%1274%		IF .TREEPTR[DBLFLG]
%1274%		THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274%		ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);

	%(***ALLOCATE THE INCREMENT EXPRESSIONS***)%

	IOARRAY_.IOLELEM[ELSTPTR];		!LOCATE LIST
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
		TREEPTR_.IOARRAY[E2INCR];		!ALLOCATE EXPRESSION
		IF .TREEPTR[OPRCLS] EQL ARRAYREF
		THEN IOARRAY[E2INCR]_ALCTVARR(.BSYREGS,.FREGCT)
		ELSE
		IF .TREEPTR[OPRCLS] NEQ DATAOPR 
%1274%		THEN	! Get 1 or 2 word temp based on DBLFLG

%1274%			IF .TREEPTR[DBLFLG]
%1274%			THEN ALCINTMP(NXTTMP(2),.BSYREGS,.FREGCT)
%1274%			ELSE ALCINTMP(NXTTMP(1),.BSYREGS,.FREGCT);

		IOARRAY_.IOARRAY[CLINK]
	END;

	%(***ALLOCATE THE ARRAYREF COMPUTATIONS***)%

	IOARRAY_.IOLELEM[ELSTPTR];		!LOCATE LIST
	WHILE .IOARRAY NEQ 0
%2363%	DO
%2363%	BEGIN	! For each element
%2363%
%2363%		TREEPTR = .IOARRAY[E2ARREFPTR];
%2363%
%2363%		! We don't  need to  do  register allocation  if  this
%2363%		! element is  a DATAOPR,  a  REGCONTENTS node,  or  an
%2363%		! ARRAYREF with no subscript expression.
%2363%
%2363%		IF .TREEPTR[OPRCLS] NEQ DATAOPR
%2363%		THEN IF .TREEPTR[OPRCLS] NEQ REGCONTENTS
%2363%		THEN IF NOT (.TREEPTR[OPRCLS] EQL ARRAYREF AND
%2363%			     .TREEPTR[ARG2PTR] EQL 0)
%2363%		THEN
%2363%		BEGIN	! Do register allocation
%2363%
%2363%			! Determine the set of free registers
%2363%
%2363%			IF .TREEPTR[DBLFLG]
%2363%			THEN
%2363%			BEGIN	! Double
%2363%
%2363%				BSYRG1 = DPBSYREGS(.BSYREGS);
%2363%				FRGCT1 = ONESCOUNT(.BSYRG1);
%2363%
%2363%			END	! Double
%2363%			ELSE
%2363%			BEGIN	! Non-double
%2363%
%2363%				BSYRG1 = .BSYREGS;
%2363%				FRGCT1 = .FREGCT;
%2363%
%2363%			END;	! Non-double
%2363%
%2363% 			! For an  ARRAYREF,  we must  materialize  the
%2363% 			! address referenced.  For a non-ARRAYREF, use
%2363% 			! a 1 or 2 word temp based on DBLFLG.
%2363%
%2363%			IF .TREEPTR[OPRCLS] EQL ARRAYREF
%2363%			THEN IOARRAY[E2ARREFPTR] = ALCTARY(.BSYRG1,.FRGCT1)
%2363%			ELSE IF .TREEPTR[DBLFLG]
%2363%			THEN ALCINTMP(NXTTMP(2),.BSYRG1,.FRGCT1)
%2363%			ELSE ALCINTMP(NXTTMP(1),.BSYRG1,.FRGCT1);
%2363%
%2363%		END;	! Do register allocation
%2363%
%2363%		! If input  is being  performed,  we must  assume  the
%2363%		! variable is clobbered.   Note that  this includes  a
%2363%		! COMMON/EQUIVALENCE check.
%2363%
%2363%		IF .INPFLAG
%2363%		THEN VARCLOBB(.IOARRAY[E2ARREFPTR]);
%2363%
%2363%		IOARRAY = .IOARRAY[CLINK];	! Move to next element
%2363%
%2363%	END;	! For each element

	%(***ALLOCATE THE ASSIGNMENT STATEMENT(S) TO LOOP VARIABLE***)%

%1663%	ALCASCHAIN( .IOLELEM[ELPFVLCHAIN], .BSYREGS, .FREGCT );

END;	! of ALCE2LIST
GLOBAL ROUTINE ALCASCHAIN( FIRSTMN, BSYREGS, FREGCT ) =
%(*****
	Routine to perform register allocation for a chain of
	assignment statements embedded within another statement.
	Called for the assignment statements that set the final value
	of an implied DO loop index when that DO has been folded into
	an E1LIST or an E2LIST by the optimizer. Called by
	ALCE1LIST and ALCE2LIST.

	FIRSTMN points to the first assignment statement in the chain
	to be allocated. BSYREGS and FREGCT indicate the AC's that
	can be used.

[1663]	New routine.
******)%
BEGIN	! ALCASCHAIN

	LOCAL SAVSTBSYR;
	LOCAL SAVSTRGCT;

	SAVSTBSYR = .STBSYR;	! Save "statement busy regs"
	SAVSTRGCT = .STRGCT;

	CSTMNT = .FIRSTMN;	! Set up CSTMNT to point to the first
				!  assignment statement in the chain

%[1220]% WHILE .CSTMNT NEQ 0 DO
%[1220]% BEGIN
		! Set up globals that indicate AC's that can
		!  be used to evaluate the assignment stmt
		STBSYR = .BSYREGS;
		STRGCT = .FREGCT;
%[1220]% 	ALCASMNT();
%[1220]% 	CSTMNT_.CSTMNT[CLINK]
%[1220]% END;

	STBSYR = .SAVSTBSYR;	! Restore STBSYR, STRGCT
	STRGCT = .SAVSTRGCT;

END;	!ALCASCHAIN
GLOBAL ROUTINE LHINREGALC=
%(*****
	ROUTINE TO PERFORM REGISTER ALLOCATION FOR AN ASSIGNMENT STATEMENT
	WHEN THE LEFT-HAND-SIDE IS ALLOCATED TO A REGISTER.
	THIS ROUTINE ATTEMPTS TO COMPUTE THE VALUE OF THE RIGHT-HAND-SIDE
	INTO THAT REGISTER.  IT IS ABLE TO DO SO IF EITHER:
		1.  THERE IS NO REFERENCE TO THE LHS VARIABLE IN THE
	    RHS EXPRESSION
		2.  THERE IS A REFERENCE TO THE LHS VARIABLE AT A DEPTH OF
		    1 OR 2 WITHIN THE RHS EXPRESSION.
	RETURNS TRUE IF SUCCEEDED, FALSE IF FAILED (IN WHICH CASE REGISTER
	ALLOCATION FOR THIS EXPRESSION MUST STILL BE PERFORMED)
*****)%
BEGIN
	REGISTER PEXPRNODE RHNODE;
	OWN PEXPRNODE LHNODE;
	OWN RA;
	OWN PEXPRNODE ARG1NODE;
	REGISTER PEXPRNODE ARG2NODE;

	%(***LOCAL ROUTINE TO SET REG FOR COMPUTATION OF RIGHT HAND EXPR EQUAL TO
	     REG TO WHICH LHS VARIABLE WAS ALLOCATED*****)%
	ROUTINE SETRHRGTOLH=
	BEGIN
		RHNODE[TARGTAC]_.LHNODE[TARGTAC];
%[625]%		RHNODE[INREGFLG]_1;
		CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
![721] SINCE WE ARE USING THE REGISTER, INVALIDATE ANY PREVIOUS USE
%[721]%		REGCLOBB(.CSTMNT[ASMNTREG]);
		CSTMNT[A1SAMEFLG]_1;
		CSTMNT[A2SAMEFLG]_1;

	END;	! of SETRHRGTOLH

	%(***LOCAL ROUTINE TO SPECIFY THAT THE COMPUTATION OF THE VALUE OF THE NODE
	     "PNODE" BE PERFORMED IN THE REGISTER USED FOR LHS WHEN ARG1
	     UNDER "PNODE" IS EQUAL TO LHS
		CAN BE CALLED FOR PNODE OF OPRCLS:
			ARITHMETIC,BOOLEAN,SPECOP
	****)%
	ROUTINE CMPNODINLH(PNODE)=
	BEGIN
		MAP PEXPRNODE PNODE;
		PNODE[A1SAMEFLG]_1;
		PNODE[TARGTAC]_.LHNODE[TARGTAC];
%[625]%		PNODE[INREGFLG]_1;
		%(****PERFORM REG ALLOC FOR ARG2 UNDER PNODE***)%
		IF NOT .PNODE[A2VALFLG] AND .PNODE[OPRCLS] NEQ SPECOP
		THEN
		BEGIN
			TREEPTR_.PNODE[ARG2PTR];
			ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);
		END;

	END;	! of CMPNODINLH


	ROUTINE CMPRHINLH=
	%(***LOCAL ROUTINE TO ALLOCATE THE COMPUTATION OF RHNODE TO BE
	     PERFORMED IN THE REGISTER ALLOCATED TO LHS, WHEN THE FIRST
	     ARG UNDER THE FIRST ARG OF RHNODE IS KNOWN TO BE EQUAL TO
	     THE VARIABLE ON THE LHS
	****)%
	BEGIN
		%(***IF THE COMPUTATION OF ARG2 UNDER RHS INCLUDES A REFERENCE
			TO THE VARIABLE FROM THE LHS, MUST COMPUTE ARG2 BEFORE
			COMPUTE ARG1 (SINCE THE COMPUTATION OF ARG1 WILL
			CLOBBER THE REG THAT HOLDS THAT VAR)
		***)%
		IF .ARG2NODE[RESRFFLG] AND NOT .RHNODE[RVRSFLG]
		THEN
		BEGIN
			RHNODE[RVRSFLG]_1;

			%(**IF ON COMPLEXITY PASS WE ALLOCATED ARG2 TO BE COMPUTED
				INTO FN-RETURN REG, AND THE COMPUTATION OF ARG1 WILL
				CLOBBER FN-RETURN REG, THEN WE MUST UNDO THAT ALLOCATION***)%
			IF .ARG2NODE[ALCRETREGFLG] AND .ARG1NODE[FNCALLSFLG]
			THEN
			BEGIN
				ARG2NODE[ALCRETREGFLG]_0;
				ARG2NODE[INREGFLG]_0;
				ARG2NODE[A1SAMEFLG]_0;
				ARG2NODE[A2SAMEFLG]_0;
			END
		END;


		%(***PERFORM REGISTER ALLOCATION FOR THE COMPUTATION OF ARG2 UNDER RHNODE
			(WE KNOW THAT THE VAL OF ARG1 WILL BE LEFT IN THE REG IN WHICH LHS
			IS ALLOCATED)
		****)%
		IF NOT .RHNODE[A2VALFLG] AND .RHNODE[OPRCLS] NEQ SPECOP
		THEN
		BEGIN
			TREEPTR_.ARG2NODE;
			ALCINREG(AFREEREG(.STBSYR,FALSE,.TREEPTR[DBLFLG]),.STBSYR,.STRGCT);

			%(***IF ARG2 IS COMPUTED BEFORE ARG1, THEN MUST NOT USE
				THE REG IN WHICH VAL OF ARG2 WAS LEFT IN COMPUTING ARG1**)%
			IF .RHNODE[RVRSFLG]
			THEN
			BEGIN
				OWN RB;
				IF (RB_RGTOSAVE(.ARG2NODE)) NEQ -1	!IF SOME REG MUST BE PRESERVED
									! TO PRESERVE VAL OF ARG2
				THEN
				BEGIN
					STBSYR_CLRBIT(.STBSYR,.RB);	!TAKE THAT REG OUT OF SET AVAILABL
					%(***IF THAT REG IS THE REG TO WHICH LHS WAS
						ALLOCATED, ARE IN AN IMPOSSIBLE SITUATION.
						THIS SHOULD NEVER OCCUR***)%
					IF .RB EQL .LHNODE[TARGTAC] THEN CGERR();
				END;
			END;
		END;

		%(***PERFORM ALLOCATION OF ARG1 UNDER RHNODE, COMPUTING ITS VAL INTO
			THE REG USED FOR LHS***)%
		CMPNODINLH(.ARG1NODE);

		RHNODE[TARGTAC]_.ARG1NODE[TARGTAC];
		RHNODE[A1SAMEFLG]_1;

		SETRHRGTOLH();		!SET FIELDS OF CSTMNT TO INDICATE THAT RHNODE WAS
					! COMPUTED INTO THE REG FOR LHNODE

	END;	! of CMPRHINLH






	ROUTINE ALCTORETREG=
	%(*********************
		ROUTINE TO ALLOCATE THE RIGHT HAND SIDE WHEN IT HAS BEEN DETERMINED
		THAT IT CAN BE COMPUTED INTO THE FN RETURN REG, AND THE LHS
		IS ALSO A REGCONTENTS FOR THE FN RETURN REG
	***********************)%
	BEGIN
		TREEPTR_.RHNODE;
		ALCINREG(AFREEREG(.STBSYR,FALSE,.RHNODE[DBLFLG]),.STBSYR,.STRGCT);
		CSTMNT[ASMNTREG]_RETREG;	!USE RETREG FOR THE ASSIGNMNET
		CSTMNT[A1SAMEFLG]_1;
		CSTMNT[A2SAMEFLG]_1;
		RETURN TRUE

	END;	! of ALCTORETREG

	ROUTINE MUSTSAVLHREG(ANODE)=
	%(***************
		TESTS WHETHER THE VALUE OF ANODE WILL BE INACCESSIBLE IF THE
		REGISTER THAT HOLDS THE VARIABLE ON THE LHS HAS BEEN CLOBBERED.
		THIS IS TRUE ONLY IF ANODE IS AN ARRAYREF THAT WILL HAVE THE
		LHS VAR AS ITS SUBSCRIPT OR FOR DUMMY TYPE CONVERSION NODES
		THAT HAVE THE LHS VAR UNDER THEM
	******************)%
	BEGIN
		MAP PEXPRNODE ANODE;
		IF .ANODE EQL .LHNODE THEN RETURN TRUE	!TO REF THE LHS VAR ITSELF,
								! THE VAL MUST BE PRESERVED
		ELSE
		IF .ANODE[OPRCLS] EQL ARRAYREF	!FOR AN ARRAYREF, IF THE INDEX
		THEN RETURN MUSTSAVLHREG(.ANODE[ARG2PTR])	! IS A NODE THAT REQUIRES THE LHS TO
								! BE PRESERVED

		ELSE
		IF .ANODE[OPRCLS] EQL TYPECNV
		THEN
		BEGIN
			%(***IF THE ARG UNDER A DUMMY TYPE-CNV NODE REQUIRES THE REG TO
				BE PRESERVED, THEN THE TYPE-CNVNODE DOES ALSO***)%
			IF NOCNV(ANODE) THEN RETURN MUSTSAVLHREG(.ANODE[ARG2PTR])
			ELSE RETURN FALSE
		END
		ELSE RETURN FALSE

	END;	! of MUSTSAVLHREG

%[1067]%	ROUTINE NOCMSBINR1=
![1067]	%(***********************
![1067]		ROUTINE TO TEST IF A COMMON SUBEXPRESSION HAS BEEN ALLOCATED
![1067]		IN REGISTER 1.  RETURN TRUE IF NONE IN REG 1
![1067]	************************)%
%[1067]%	BEGIN
%[1067]%		REGISTER T1;
%[1067]%		MAP PEXPRNODE T1;
%[1067]%		T1_.CSTMNT[SRCCOMNSUB];
%[1067]%		IF .T1 NEQ 0 THEN
%[1067]%			DO IF .T1[TARGADDR] EQL RETREG+1 THEN RETURN FALSE
%[1067]%				ELSE T1_.T1[CLINK]
%[1067]%			WHILE .T1 NEQ 0;
%[1067]%		RETURN TRUE

%[1067]%	END;	! of NOCMSBINR1





	LHNODE_.CSTMNT[LHEXP];

	%(***IF RHS IS A SCALAR, SIMPLY SET TARGET TO REG ALLOCATED FOR LHS***)%
	IF .CSTMNT[A2VALFLG]
	THEN
	BEGIN
		CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
		CSTMNT[A1SAMEFLG]_1;
		IF .CSTMNT[RHEXP] EQL .LHNODE
			OR REGCONTAINING(.CSTMNT[RHEXP]) EQL .LHNODE[TARGTAC]	!IF THE VAR ON RHS WAS ALREADY IN THE DESIRED REG
		THEN
		CSTMNT[A2SAMEFLG]_1
		ELSE REGCLOBB(.CSTMNT[ASMNTREG]);	!IF LEFT SOME VAR IN LHS REG WHILE
							! COMPUTING RHS, THAT VAR IS NOW NO LONGER THERE

		RETURN TRUE;
	END;


	RA_.LHNODE[TARGTAC];
	RHNODE_.CSTMNT[RHEXP];


	%(***IF THE LHS IS THE FN-RETURN REG AND THE RHS HAS ALREADY BEEN DETERMINED
		TO BE EVALUATED TO IT, THEN JUST DO
		REST OF ALLOCATION FOR RHS EXPRESSION***)%
	IF .RA EQL RETREG AND .RHNODE[ALCRETREGFLG] AND .RHNODE[TARGTAC] EQL RETREG AND .RHNODE[INREGFLG]
	THEN RETURN ALCTORETREG();


	%(***IF RHS IS AN ARRAY-REF - LOAD THE VAL INTO THE DESIRED REG***)%
	IF .RHNODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		TREEPTR_.RHNODE;
		ALCARRAY(.STBSYR,.STRGCT);
		CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
		CSTMNT[A1SAMEFLG]_1;
		REGCLOBB(.CSTMNT[ASMNTREG]);
		RETURN TRUE;
	END;

	%(***IF THERE IS NO REFERENCE TO THE VARIABLE ON THE LHS IN THE
	     EXPRESSION ON THE RHS, SIMPLY ALLOCATE THE EXPRESSION TO BE
	     COMPUTED INTO THE REG USED FOR THE VARIABLE IF POSSIBLE
	****)%
	IF NOT .RHNODE[RESRFFLG]
		AND NOT (.RA EQL RETREG AND .RHNODE[FNCALLSFLG])	!IF LHS IS FN RETURN REG
								! AND HAVE FNCALLS ON RHS
	THEN
	BEGIN
		OWN STBSYR1;		!SET OF REGS AVAILABLE FOR USE IN COMPUTING THE
					! THE VAL OF THE RHS

		%(***FOR COMPUTING THE RHS OF THIS STMNT, CAN USE THE REG TO WHICH
			THE LHS WAS ALLOCATED (SINCE THE LHS VARIABLE DOES NOT OCCUR
			IN THE RHS EXPRESSION)***)%
		STBSYR1_SETBIT(.STBSYR,.RA);

![1067]		%(**WHEN TARGETTING TO REG 0 (FN RET REG) ALLOW REG 1 TO BE
![1067]		    USED IF THERE ARE NO COMMON SUBEXPRS ON STMNT WHICH USE IT
![1723]			AND ARE NOT ALREADY IN DOUBLE WORD MODE**)%
%[1067]%	IF .RA EQL RETREG AND NOCMSBINR1()
%[1723]%		AND NOT .DBLMODE
		THEN STBSYR1_SETBIT(.STBSYR1,RETREG+1);
		TREEPTR_.RHNODE;
		ALCINREG(.RA,.STBSYR1,ONESCOUNT(.STBSYR1));
		CSTMNT[ASMNTREG]_.LHNODE[TARGTAC];
		CSTMNT[A1SAMEFLG]_1;
		IF .RHNODE[TARGTAC] EQL .CSTMNT[ASMNTREG] AND .RHNODE [INREGFLG]
		THEN
		CSTMNT[A2SAMEFLG]_1
		ELSE REGCLOBB(.CSTMNT[ASMNTREG]);	!IF LEFT SOME VAR IN LHS REG WHILE
							! COMPUTING RHS, THAT VAR IS NOW NO LONGER THERE
		RETURN TRUE;
	END;




	%(***IF RHS CONTAINS A REFERENCE TO LHS VAR AND IS A SPECIAL OPERATOR
	     (P2MUL OR P2DIV), CHECK FOR ARG1 OF THAT OPERATOR EQUAL
	     TO THE LHS - IF IT IS, PERFORM THE OPERATION IN THE REG
	     ALLOCATED TO LHS - OTHERWISE GIVE UP
	****)%
	IF .RHNODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
	! MUST NOT CLOBBER LHS REG IF P2PL1OP OR EXPCIOP NOT A POWER OF 2
		IF .RHNODE [OPERSP] EQL P2PL1OP OR
		   (.RHNODE [OPERSP] EQL EXPCIOP AND
		    NOT POWOF2 (.RHNODE [ARG2PTR]))
			THEN RETURN FALSE;
		IF .RHNODE[ARG1PTR] EQL .LHNODE
		THEN
		BEGIN
			SETRHRGTOLH();
			RHNODE[A1SAMEFLG]_1;
			RETURN TRUE;
		END
		ELSE
		RETURN FALSE;
	END;


	%(***IF RHS CONTAINS A REFERENCE TO LHS VAR AND IS A RELATIONAL,
	     FUNCTION CALL, TYPE-CONVERSION, OR NEG/NOT - DON'T BOTHER
	****)%
	IF .RHNODE[OPRCLS] NEQ ARITHMETIC AND .RHNODE[OPRCLS] NEQ BOOLEAN
	THEN
	RETURN FALSE;


	%(********WHEN THE LHS IS THE FN RETURN REG AND THE RHS IS AN ARITH OR BOOLEAN
		EXPRESSION THAT CONTAINS FUNCTION CALLS BUT WAS NOT ALLOCATED TO THE FN RETURN
		REG ALREADY, CHECK FOR RHS OF THE FORM:
			<EXPR> OP <FN-CALL>
		  OR	<EXPR> OP <EXPR ALLOCATED TO FN RETURN REG>
		AND REVERSE THE 2 OPERATORS IF CAN DO SO
	*********)%
	IF .RA EQL RETREG
	THEN
	BEGIN
		ARG1NODE_.RHNODE[ARG1PTR];
		ARG2NODE_.RHNODE[ARG2PTR];
		IF .ARG2NODE[ALCRETREGFLG]	!IF ARG2 WAS ALLOCATED TO FN RETURN REG
			AND .ARG2NODE[INREGFLG] AND .ARG2NODE[TARGTAC] EQL RETREG
			AND COMMUTATIVE(RHNODE)	!AND THE RHS EXPRESSION IS COMMUTATIVE
			AND NOT .ARG1NODE[FNCALLSFLG]	!AND ARG1 DOES NOT INCLUDE FN CALLS
		THEN
		BEGIN
			EXCHARGS(.RHNODE);	!LET ARG1 BE THE ARG COMPUTED INTO FN RETURN REG
			RHNODE[RVRSFLG]_0;	!ALWAYS COMPUTE THAT ARG FIRST
			RHNODE[ALCRETREGFLG]_1;	!COMPUTE THE RHS IN THE FN RET REG
			RHNODE[TARGTAC]_RETREG;
			RHNODE[INREGFLG]_1;
			RHNODE[A1SAMEFLG]_1;	!ARG1 OF RHS WONT HAVE TO BE LOADED INTO THE REG
			RETURN ALCTORETREG()
		END
		ELSE RETURN FALSE;	!IF LHS IS FN RETURN REG, RHS CONTAINS FN CALLS
				! AND NEITHER RHS, NOR ARG2 UNDER RHS WAS ALLOCATED TO FN
				! RET REG, GIVE UP ON OPTIMALITY
	END;


	%(*******WHEN RHS EXPRESSION IS ARITHMETIC OR BOOLEAN AND CONTAINS
	     A REFERENCE TO LHS VAR***)%
	! CONSIDER CASES LIKE:
	!	I=I/J
	!	I=(I+K)/J
	!	I=J+(I/K)
	! AND OTHER ASSOCIATED PROBLEMS!
	! THESE ALL DEPEND UPON THE REG AFTER THE ONE
	! IN WHICH THE LHS IS LIVING GETTING OVERWRITTEN BY
	! SOME OPERATION PERFORMED DIRECTLY IN THE REG FOR LHS.
		IF CLOBBNX(.RHNODE) THEN RETURN FALSE;


	%(***IF ARG1 IS EQUAL TO LHS VAR, SIMPLY PERFORM OP IN LHS REG***)%
	IF .RHNODE[ARG1PTR] EQL .LHNODE
	THEN
	BEGIN
		SETRHRGTOLH();
		CMPNODINLH(.RHNODE);
		RETURN TRUE;
	END;


	%(***IF ARG2 IS EQUAL TO LHS VAR. ATTEMPT TO SWAP THE ARGS.
	     IF CAN DO SO, THE PERFORM OP IN LHS REG***)%
	IF .RHNODE[ARG2PTR] EQL .LHNODE
	THEN
	BEGIN
		IF COMMUTATIVE(RHNODE)
		THEN
		BEGIN
			SWAPARGS(RHNODE);
			SETRHRGTOLH();
			CMPNODINLH(.RHNODE);
			RETURN TRUE;
		END
		ELSE
		RETURN FALSE
	END;


	%(***SEARCH DOWN ONE LEVEL ONLY FOR REFERENCES TO LHS.
		THUS CAN HANDLE:
		A=A+C
		A=A+B+C
		A=A*B+C*D
		BUT NOT:
		A=A*B+C*D+E*F
		A=A+B+C+D
	****)%
	ARG1NODE_.RHNODE[ARG1PTR];
	ARG2NODE_.RHNODE[ARG2PTR];
	%(***IF EITHER OF THE ARGS WILL BE IMPOSSIBLE TO REFERENCE IF THE
		OTHER ARG IS COMPUTED INTO THE REG HOLDING THE LHS VAR,
		THEN GIVE UP. (EG I=I*J+K(I) CANNOT BE COMPUTED BY COMPUTING
		I*J IN THE REG FOR I)
	*****)%
	IF .ARG1NODE[RESRFFLG] AND .ARG2NODE[RESRFFLG] AND .RHNODE[OPRCLS] NEQ SPECOP
	THEN
	BEGIN
		IF MUSTSAVLHREG(.ARG1NODE) OR MUSTSAVLHREG(.ARG2NODE)
		THEN RETURN FALSE
	END;
	IF .ARG1NODE[OPRCLS] EQL ARITHMETIC OR .ARG1NODE[OPRCLS] EQL BOOLEAN OR .ARG1NODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
		IF .ARG1NODE[ARG1PTR] EQL .LHNODE
		THEN
		BEGIN
%1757%			! The SPECOP's  P2PL1 (power  of 2  plus 1)  and
%1757%			! EXPCIOP (raise to an integer power), must  not
%1757%			! use the  same  register  as the  LHS  for  the
%1757%			! computation.

%1757%			IF .ARG1NODE[OPRCLS] EQL SPECOP
%1757%			THEN IF .ARG1NODE[OPERSP] EQL P2PL1OP OR
%1757%				.ARG1NODE[OPERSP] EQL EXPCIOP
%1757%			THEN RETURN FALSE;

			IF CLOBBNX(.ARG1NODE) THEN RETURN FALSE;
			CMPRHINLH();
			RETURN TRUE;
		END
		ELSE
		IF .ARG1NODE[ARG2PTR] EQL .LHNODE
		THEN
		BEGIN
			IF COMMUTATIVE(ARG1NODE)
			THEN
			BEGIN
				SWAPARGS(ARG1NODE);
				CMPRHINLH();
				RETURN TRUE;
			END;
		END;
	END;
%2041%	IF COMMUTATIVE(RHNODE)
%2041%	THEN IF .ARG2NODE[OPRCLS] EQL ARITHMETIC
%2041%		OR .ARG2NODE[OPRCLS] EQL BOOLEAN
%2041%		OR .ARG2NODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
		IF .ARG2NODE[ARG1PTR] EQL .LHNODE
		THEN
		BEGIN
			IF CLOBBNX(.ARG2NODE) THEN RETURN FALSE;
			SWAPARGS(RHNODE);
			RHNODE[RVRSFLG]_NOT .RHNODE[RVRSFLG];	!WHEN EXCHANGE ARG1 AND ARG2
								! COMPUTE THEM IN THE ORDER
								! ORIGINALLY DETERMINED
			ARG1NODE_.RHNODE[ARG1PTR];
			ARG2NODE_.RHNODE[ARG2PTR];
			CMPRHINLH();
			RETURN TRUE;
		END
		ELSE
		IF .ARG2NODE[ARG2PTR] EQL .LHNODE
		THEN
		BEGIN
			IF COMMUTATIVE(ARG2NODE)
			THEN
			BEGIN
				SWAPARGS(ARG2NODE);
				SWAPARGS(RHNODE);
				RHNODE[RVRSFLG]_NOT .RHNODE[RVRSFLG];	!WHEN EXCHANGE ARG1 AND ARG2
								! COMPUTE THEM IN THE ORDER
								! ORIGINALLY DETERMINED
				ARG1NODE_.RHNODE[ARG1PTR];
				ARG2NODE_.RHNODE[ARG2PTR];
				CMPRHINLH();
				RETURN TRUE;
			END
		END
	END;


	RETURN FALSE;

END;	! of LHINREGALC


END
ELUDOM