Google
 

Trailing-Edge - PDP-10 Archives - BB-D480F-BB_1985_short - cmplex.bli
There are 26 other files named cmplex.bli in the archive. Click here to see a list.
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1985
!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/MD/JNG/SJW/DCE/TFV/AHM/CDM/TJK

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

GLOBAL BIND CMPLEV = #10^24 + 0^18 + #2466;	! Version Date:	12-Oct-84

%(

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

115	-----	-----	ADD ROUTINES CMPE1LIST AND CMPE2LIST TO
			COMPUTE COMPLEXITY FOR E1LISTCALL AND
			E2LISTCALL NODES
116	-----	-----	ALLOCATE CONSTANT ZERO IN E1INCR OR E2INCR
			FIELD OF E1LISTCALL OR E2LISTCALL NODES
117	-----	-----	KEEP VALUE OF "PAIRMODE" CORRECTLY INSIDE OF
			IOLISTS ("CMPLIOLST" NEEDED MODIFYING)
			KEEP VALUE OF "FNREF" INSIDE OF IOLISTS
			SET "FNREF" WHEN A FNCALL IS ENCOUNTERED
118	-----	-----	IN A SYMMETRIC BINARY OPERATION WITH TWO
			REGISTER ARGUMENTS ONE OF WHICH IS THE
			FUNCTION RETURN REGISTER, PERFORM CALCULATIONS
			IN THE OTHER REGISTER
119	-----	-----	IMPROVE COMPLEXITY CALCULATION FOR DATACALL, 
			E1LISTCALL, AND E2LISTCALL NODES
120	-----	-----	SAME FOR FUNCTION AND SUBROUTINE CALLS
121	-----	-----	ADD CMPLEXITY FOR CMPLX IN LINE

122	-----	-----	ALLOW "EXCHARGS" TO BE CALLED FOR IN LINE FNS
123	-----	-----	REMOVE ALL REFERENCES TO SQROP,CUBOP,P4OP
			(THEY ARE ALL NOW UNDER EXPCIOP)
124	-----	-----	CHANGE REFS TO THE MACRO "POWEROF2" TO "POWOF2"
125	-----	-----	FIX BUG IN CMPILF; DIM CANNOT HAVE AN IMMED MODE 2ND ARG
126	-----	-----	?
127	301	16154	SET FNCALLSFLG IN CSTMNT WHEN CHANGING ** TO FUNCTION
			CALL, (JNT)
128	344	17768	PROPAGATE FNCALLSFLG TO NEG/NOT NODE EVEN
			IF COMPLEXITY OF ARGUMENT IS ZERO., (MD)
129	411	19537	DON'T EXCHANGE ARGS TO MAX OR MIN FUNCTION IF
			FIRST ARG IS NEGATIVE., (JNG)

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

130	412	-----	IN CMPLA FOR DOUBLE ARRAYREF FOR KA10, PARENT
			  COMPLEXITY MUST BE AT LEAST 3, (SJW)
131	426	18816	SET FNCALLSFLG FOR STATEMENTS CONTAINING
			IMPLICIT FN CALLS SO 0,1, 16 WILL BE SAVED., (JNG)
132	510	-----	DON'T LOOK FOR ALCRETREGFLG IN DATAOPR NODES., (JNG)

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

133	622	11020	COMPLEXITY OF COMPLEX ARRAY REF SHOULD BE GTR 2, (DCE)

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

134	730	28275	IN LINE FUNCTIONS OF FORM A=MIN(A,EXPR) MAY
			DOUBLY ASSIGN A REGISTER., (DCE)

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

135	761	TFV	1-Mar-80	-----
	Remove KA10FLG and add new /GFLOATING exponential routine
	names (GEXP vs DEXP etc.)

139	1127	AHM	22-Sep-81	------
	Change erroneous (and potentially  dangerous) use of  IDTARGET
	to TARGADDR in ARRNARGBLK.

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

136	1202	DCE	1-Jul-80	-----
	For expressions on output lists, we need to allocate potential
	constants in the lists.

137	1211	DCE	29-Apr-81	-----
	Do complexity analysis for final loop value assignments (ELISTs).

138	1253	CKS	11-Aug-81
	Do complexity for character arrayref nodes.  Same as numeric arrayrefs
	but don't remove constant term from subscript expression.  Also don't
	ADDREGCANDIDATE the subscript since it will be destroyed by the ADJBP.

140	1422	TFV	12-Nov-81	------
	Modify CMPLFNCALL for character functions. The first argument on the
	argument list is the descriptor for the result.  The value is not
	returned in AC0, AC1, but they maybe clobbered.

141	1431	CKS	15-Dec-81
	Add CMPLXSUBSTR to compute complexity for substring nodes

1474	TFV	15-Mar-82
	Add CMPLCONCAT to compute the complexity of concatenation nodes.
	Concatenations are function  calls.  The first  argument is  the
	descriptor for the result.   Since it has not  yet been set  up,
	CMPLFNARGS has to be changed to ignore the first argument.  This
	is done by adding another argument to the call.

1505	AHM	12-Mar-82
	Have EXPTOFNCALL set the psect  index of symbol table  entries
	for exponentiation functions  to PSCODE in  order to  relocate
	those references by .CODE.

1507	AHM	14-Mar-82
	Make  CMPLIOLST,  CMPIOCALL,  CMPE1LIST  and  CMPE2LIST   call
	ALOCONST for SLIST/ELIST increments and  counts so we can  get
	rid of immediate I/O list args.

1520	DCE	25-Mar-82
	Fix up ELISTS so that constants in I/O lists get allocated,
	e. g., (A(I),1234,I=1,10).

1551	AHM	3-Jun-82
	Remove edit 1505 from this module because external  references
	will not have a psect index set in the STE.

1567	CDM	24-JUN-82
	Set complexities for inline functions

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

1762	TFV	13-Jun-83	10-33767
	Fix CMPLXARRAY to handle the case where the subscript expression
	for a complicated  arrayref propagates and  folds to constant  +
	constant.  Add  in  both constants  to  the ADDR  field  of  the
	arrayref and zero ARG2PTR.  ((THIS IS A DAY 1 BUG.))

1766	CDM	15-Jul-83
	Compiler puts constant array ref offset calculations in TARGADDR
	whenever possible.  TARGADDR  is a  half word  quantity (17  bit
	plus 1 bit for  sign) which can not  store large numbers.   Some
	large positive  numbers  may  be  truncated  and  appear  to  be
	negative when  retrieved, since  the  retrieved offset  is  sign
	extended.  (Also negative numbers can appear to be positive  the
	same way.)  Before  storing into TARGADDR,  check if the  offset
	will fit.

2012	CDM	11-Oct-83
	Correct edit 1766.  Incorrect arguments were passed to AROFCONST.

2052	TJK	16-May-84
	CMPLXSUBSTR was incorrectly clearing some flags (specifically,
	INREGFLG) when the  lower bound  (minus 1)  was a  REGCONTENTS
	node.  This edit  adds a  test so  that these  flags are  only
	cleared when they really should be.


2244	CDM	13-Dec-83
	Eliminate AOBJN  DO  loop  register indexes  into  large  arrays
	(arrays in  .LARG.)   during  code  generation.   Create  a  new
	STORECLS node,  STRHAOBJN to  copy the  right hand  half of  the
	AOBJN register into another  register.  Otherwise, the  negative
	left half of  the AOBJN register  will appear to  be an  invalid
	section number.  This is  to catch the  cases that the  skeleton
	optimizer (edit 2243) can not.

2336	CDM	6-Apr-84
	Fix case  not caught  for  edit 1766  for  putting too  large  a
	constant into an ARRAYREF's TARGADDR.

2360	CDM	17-May-84
	Fix for edit 2336.  CMPLXA  was making an add  node to add the  array's
	IDADDR field and the array's  address calculation together even if  the
	pointer to  the address  calculation is  0 (meaning  there isn't  any).
	This edit  simply  substitutes the  constant  IADDR if  no  calculation
	previously exists.

2361	AHM	17-May-84
	Fix for edit 2360.  Prevents generation of immediate mode
	instructions for large constants.  A local alias for the
	ARRAYREF's ARG2PTR field (ADDRNODE) was not kept up to date
	even though later code uses it.  Update ADDRNODE with
	ARG2PTR's new value.

2362	CDM	23-May-84
	Hopefully the  final  fix  for  edits  1766/2012/2336/2360/2361.
	Flags from deleted  nodes (expressions and  constants) were  not
	being propagated properly.  These include A*VALFLG,  A*IMMEDFLG,
	A*NEGFLG, A*NOTFLG.

2401	TJK	19-Jun-84
	Add DOTDCHECK,  which  checks  for  substrings  which  can  be
	converted into .Dnnnn compile  time constant descriptors.   It
	also performs the bounds checking  which was formerly done  in
	P2SKSUBSTR.  Make several improvements to the bounds checking.
	Add  calls  to  DOTDCHECK  in  CMPFNARGS,  CMPILF,  CMPLIOLST,
	CMPIOCALL, CMPE1LIST, and CMPE2LIST.

2402	TJK	19-Jun-84
	Add FIXAOBJN, a routine which prevents values from being taken
	directly  from  AOBJN  registers.   Call  this  routine   from
	CMPE1LIST and CMPE2LIST.  Note that this only catches a few of
	the many known cases.  Furthermore, it would really be  better
	if we could  eliminate the  AOBJN control  word completely  in
	these cases, instead of inserting STRHAOBJN nodes.

2411	CDM	30-Jun-84
	Fix CMPLXA so that array address calculations with neg/not flags
	involved won't take out  constants below the  flags to add  into
	the array's TARGADDR.  Also rename local symbol NAME to  ARRNAME
	to avoid any confusion with global NAME.

2463	AHM	8-Oct-84
	When trying to add all sorts of constant offsets into a
	numeric ARRAYREF's TARGADDR in AROFCONST, use a constant table
	entry for the ones that are too big to fit when the array is
	in PSLARGE.  Set the OPERSP to ARREFBIG for such ARRAYREFs.
	Also, take account of such mutated ARRAYREFs when accessing
	TARGADDR in CMPLXARRAY.

2464	AHM	9-Oct-84
	Change of heart for edit 2463.  Try to create ARREFBIG nodes
	for all numeric ARRAYREFs in AROFCONST, not just for large
	arrays.  Also, be wary of ARREFBIG nodes as well as ARRAYREFs
	for arrays in PSLARGE when creating STRHAOBJN nodes.

2466	AHM	12-Oct-84
	Yet another patch to subscript optimization in CMPLXARRAY.  If
	both operands of a topmost plus node are optimized into
	TARGADDR, return after SAVSPACEing the plus node.  Also,
	explicitly set A2VALFLG for the ARRAYREF in CMPLXARRAY in this
	situation.  These keep SETCOMPLEXITY and CGETVAL
	(respectively) from infinitely recursing on a NIL ARG2PTR.

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

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

)%


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

! The below is for putting through RUNOFF to get a PLM file.
!++
!.LITERAL
!--

FORWARD
	SETCOMPLEXITY, 
	ARRNARGBLK(2),
	CMPLA,
	CMARGS,
	EXPTOFNCALL,
	PRCNSTARG(3),	! Process constants
	CMPVBOOL,
	CMPLBL, 
	CMPLREL,
%1474%	CMPLCONCAT,	! Compute the complexity of a CONCATENATION node
	CMPLFNCALL,
	CMPFNARGS(3),
	CMPTPCNV,
	CMPLXARRAY,
%1766%	AROFCONST(4),	! Optimize array offset expression if constant
	CMPILF,
	CMPLXSUBSTR,
	CMPLIOLST,
	CMPIOCALL(1),
	CMPE1LIST(1),
	CMPE2LIST(1),
	SNGARGPROP(2),
	EXCHARGS(1),
%2401%	DOTDCHECK(1),	! Tries to create compile time constant .Dnnnn
%2401%			! substring descriptors
%2402%	FIXAOBJN(2);	! Eliminates AOBJN fetches


EXTERNAL
	ADDREGCANDATE,	! Routine in basic-block  register allocator  to
			! add a variable to  the set of variables  whose
			! values  are   left   in   registers   by   the
			! computation of statements in the block
	ALOCONST,
	C1H,
	C1L,
%2244%	BASE CDONODE,	! Current DO statement
	CGERR,
	CLOBBREGS,
	CORMAN,		! Routine to get dynamic core
%1211%	CMSTMN,
%2401%	BASE CSTMNT,		! Pointer to source statement node
	DNEGCNST,
%2244%	OBJECTCODE DOWDP,	! DO loop status word
%2401%	E165,		! Substring bound out of range error
	ENTRY,		! Holds name that TBLSEARCH looks for
%2401%	FATLERR,	! Error routine
	FNREF,		! Global flag  for  this  statement  includes  a
			! function call
	GBSYREGS,
	MAKEPR,
	MAKPR1,
	NAME,		! Holds name of which hash table to search
%2401%	NEWDVAR,	! Creates .Dnnnn variables
	ONEPLIT,	! Points to a constant table entry for the number 1
	PAIRMODE,	! Global flag that  will be set  to true if  any
			! operations  are   encountered   that   require
			! register pairs
	PROPNEG,	! Routine to propagate a negate (UTIL)
	RESNAME,
	SAVREGCONTAINING,	! Routine  to set  flag in the  previous
			! reference to a variable  so that the  register
			! containing it will be saved (CMPBLO)
	SAVSPACE,
	SRCHREGCANDATE,	! Routine in basic-block  allocator that  checks
			! whether or a given variable  is in the set  of
			! variables whose values were left in  registers
			! by the computation of preceeding statements
	STBSYR,
	STCMCSB,
	STRGCT,
	TBLSEARCH,	! Searches hash tables
%2401%	BASE TREEPTR;

!++
!***************************************************************************
!
!	Local register allocation module.
!
!	Does two passes  over an expression  tree;
!		1. Complexity
!		2. Allocation.
!	
!	The global "TREEPTR" is used in both these walks to point to the
!	node of the expression tree being processed.
!
!***************************************************************************
!
! Complexity:
!
!	On the "complexity walk", the  nodes are rearranged to  reduce
!	the number of  registers necessary  to compute  them, and  the
!	minimum number of regs necessary  to compute is saved in  each
!	node.
!
!	CMPBLOCK performs complexity on a basic block.
!	SETCOMPLEXTIY Compute the complexity of expression nodes.
!
!	At this time:
!
!	  o	Constants that can be used "immed mode" (able to fit  in
!		a half word for use  with an immediate instruction)  are
!		recognized, and space is allocated for all others.
!
!	  o	The constant part of  an array address calculation  is
!		also added in to the instruction address at this time.
!
!	  o	For statements within an inner DO loop whose index will
!		live in a register, a REGCONTENTS node is substituted
!		for each reference to the loop index.  See LPSIXSUB.
!
!	Complexity of common subexpressions  for statements (in  routine
!	STCMCSB)  must  be  done  after  the  complexity  walk  for  the
!	statement.  This is because of the possibitlity of changing  the
!	common subexpression in the complexity walk for the statement.
!
!***************************************************************************
!
! Allocation:
!
!	ALCBLOCK performs register allocation for basic blocks.
!	ALCSTMN performs register allocation for statements.
!
!	ALCINREG does reg  allocation for an  expression to leave  the
!		result in an accumilator.
!	ALCINTMP does reg  allocation for an  expression to leave  the
!		result in a memory location.
!
!	Parameter BSYREGS indicates which  register are available  for
!	use.  Each bit represents a register.   If bit zero is a  one,
!	then register zero is free for use.
!
!	Registers 0  and  1 are  always  used for  returning  function
!	values  and  are  never   preserved  across  function   calls.
!	Register 16 is used to point to argument lists.  Rgister 17 is
!	the stack pointer.
!
!	For  double  precision  and  complex  expressions,  only  even
!	registers are  allcoated.  BYREGS  is  modified so  that  only
!	alternate bits are set.
!
!	The  flag  PAIRMODEFLG  on  a  statement  is  set  during  the
!	complexity pass if operations that require a register pair  is
!	required.  Global PAIRMODE is set to TRUE to keep at least one
!	pair of adjacent accumilators.
!
!	For each  statement,  the allocator  first  performs  register
!	allocation for  all  local common  subexpressions,  using  the
!	routine ALCCMNSB.  Common subexpessions are left in  registers
!	whenever possible (this will be done for most statements).
!***************************************************************************
!--

GLOBAL ROUTINE SETCOMPLEXITY= 
BEGIN
!++
!***************************************************************************
!	Routine to compute the complexity (ie # of regs necessary  for
!	computation) of expression nodes and store that value into the
!	node itself.
!
!	 o	Tries to make arg1 be  the argument most likely to  be
!		computed into a register.
!
!	 o	Sets the flag  FNCALLSFLG which indicates  that reg  0
!		gets clobbered under this node.
!
!	 o	When arg1  of  a  given node  will  be  computed  into
!		"RETREG" (ie fn return  reg) then if possible  assigns
!		the parent to be computed into "RETREG"
!
!	Called with the global  "TREEPTR" pointing to  the node to  be
!	processed returns the value of the complexity of this node.
!
!***************************************************************************
!--
	REGISTER PEXPRNODE CNODE:ARGNODE;				!PTR TO THE NODE BEING PROCESSED
	OWN CMPLX1;


	CNODE_.TREEPTR;

	IF .CNODE[DBLFLG]	!IF THIS NODE IS DP OR COMPLEX
	THEN PAIRMODE_TRUE;	! THEN REG PAIRS WILL BE NEEDED

	RETURN 
	BEGIN
		CASE .CNODE[OPRCLS] OF SET

		%(*******FOR BOOLEAN OPERATIONS*******)%
		CNODE[COMPLEXITY]_CMPVBOOL();

		%(******FOR DATA ITEMS******************)%
		%(*******RETURN 0, BUT DO NOT SET ANYTHING IN THE ENTRY***)%
		0;

		%(******FOR RELATIONALS*********************)%
		%(********NEED 1 MORE REG THAN DO FOR CONTROL-TYPE RELATIONALS****)%
		%(*******MUST CHECK FOR DOUBLE-PREC ARGS UNDER THIS SINGLE-WD NODE*****)%
		CNODE[COMPLEXITY]_CMPLREL()+1;


		%(*******FOR FUNCTION CALLS*****************)%
		CNODE[COMPLEXITY]_CMPLFNCALL();


		%(*******FOR ARITHMETIC EXPRESSIONS**********)%
		BEGIN
			CMPLX1_CMPLA();
			CNODE[COMPLEXITY]_(IF .CNODE[OPERATOR] EQL INTDIVIDE
					THEN (
						PAIRMODE_TRUE;	!A REG PAIR WILL BE NEEDED
						IF .CMPLX1 GTR 2	!AT LEAST 2 REGS

						THEN .CMPLX1	!WILL BE NEEDED
						ELSE 2)
					ELSE .CMPLX1)
		END;

		%(*******FOR TYPE CONVERSION****************)%
		CNODE[COMPLEXITY]_CMPTPCNV();


		%(******FOR ARRAY REFERENCE***************)%
		%(*******MUST GET THE VALUE OF  THE OFFSET INTO A REGISTER - THUS
			NEED AS MANY REGS  AS NEED TO COMPUTE THAT VAL, OR 1 REG
			IF NO COMPUTATION IS NECESSARY*******)%
		CNODE[COMPLEXITY]_CMPLXARRAY();


		%(*******FOR COMMON SUBEXPRESSION NODE*******)%
		%(*********RETURN 0 - DO NOT SET FIELD IN NODE*****)%
		0;

		%(*******FOR NEG/NOT NODES (THERE SHOULD BE VERY FEW OF THESE THAT COULDNT BE
			PROPAGATED OUT*******)%
		CNODE[COMPLEXITY]_BEGIN
					ARGNODE_.CNODE[ARG2PTR];
					IF .ARGNODE[OPR1] EQL CONSTFL	!IF ARG IS A CONST
					THEN ALOCONST(.ARGNODE);	!THIS NODE WILL USUALLY HAVE BEEN
							! FOLDED INTO THE CONSTANT, IF NOT
							! ALLOCATE CORE FOR THE CONST
					TREEPTR_.CNODE[ARG2PTR];
					CMPLX1_SETCOMPLEXITY();
					IF .CMPLX1 EQL 0
					THEN
					BEGIN
						%(***IF ARG IS EQL TO VAR ON LHS OF ASMNT***)%
						IF .ARGNODE EQL .RESNAME
						THEN CNODE[RESRFFLG]_1;

						%(***IF ARG IS A FUNCTION CALL ***)%
						IF .ARGNODE[OPRCLS] NEQ DATAOPR
						AND .ARGNODE[OPRCLS] NEQ CMNSUB
						THEN SNGARGPROP(.CNODE,.ARGNODE);

						%(***IF ARG COULD HAVE BEEN LEFT IN A
							REG BY A EARLIER STMNT, DO SO***)%
						SAVREGCONTAINING(.ARGNODE);

						%(***VAL OF CMPLX IS 1***)%
						1
					END
					ELSE
					BEGIN
						%(***IF ARG IS COMPUTED INTO FN-RET REG
							COMPUTE VAL OF THIS NODE THERE ALSO***)%
						SNGARGPROP(.CNODE,.ARGNODE);
						.CMPLX1
					END
				END;


		%(*****FOR SPECIAL OPS INTRODUCED BY PHASE 2 SKELETON****)%
		%(*******P2MUL,P2DIV, AND EXPCIOP TO A POWER THAT IS A POWER OF TWO   TAKE NO EXTRA REGISTERS OVER
			THOSE NECESSARY TO GET THE ARG  INTO A REG.
			P2PL1MUL NEEDS 1 REG IF ARG IS A PROGRAM VARIABLE
			OTHERWISE, EITHER 2 REGS OR AS MANY AS ARE
			NEEDED TO COMPUTE THE ARG (WHICHEVER IS GREATER)
		********)%
		CNODE[COMPLEXITY]_
		BEGIN
			ARGNODE_.CNODE[ARG1PTR];

			IF .CNODE[A1VALFLG]
			THEN
			BEGIN
				%(**IF ARG COULD HAVE BEEN LEFT IN A REG BY AN EARLIER STMNT, DO SO**)%
				SAVREGCONTAINING(.ARGNODE);

				%(***IF ARG IS A CONSTANT, DECIDE WHETHER TO ALLOCATE CORE FOR IT**)%
				IF .ARGNODE[OPR1] EQL CONSTFL
				THEN PRCNSTARG(.CNODE,.ARGNODE,TRUE)

				ELSE
				%(***IF ARG IS THE VARIABLE ON THE LHS OF THE ASSIGNMENT
					STMNT, SET "RESRFFLG" IN CNODE***)%

				IF .ARGNODE EQL .RESNAME THEN CNODE[RESRFFLG]_1;

				1
			END
			ELSE
			BEGIN
				TREEPTR_.ARGNODE;
				CMPLX1_SETCOMPLEXITY();

				%(***IF ARG CONTAINED ANY FNCALLS OR ANY REFERENCES TO THE
					LHS OF ASMNT, SET FLAGS IN CNODE***)%
				IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
				IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;

				%(***IF ARG WAS COMPUTED INTO FN-RETURN REG, THEN FOR
					P2MUL,P2DIV, AND EXPCIOP TO A POWER OF 2  WANT TO
					COMPUTE THE PARENT IN FN-RETURN REG***)%
				IF .ARGNODE[ALCRETREGFLG]
				THEN
				BEGIN
					MACRO CMPINRETREG=
					BEGIN
						CNODE[TARGTAC]_RETREG;
						CNODE[INREGFLG]_1;
						CNODE[A1SAMEFLG]_1;
						CNODE[ALCRETREGFLG]_1;
					END$;

					CASE .CNODE[OPERSP] OF SET
					CMPINRETREG;	!P2MUL
					CMPINRETREG;	!P2DIV
					BEGIN END;	!P2PL1MUL
					CGERR();	!(SQROP HAS BEEN REMOVED)
					CGERR();	!CUBOP HAS BEEN REMOVED
					CGERR();	!P4OP HAS BEEN REMOVED
					BEGIN		!EXPCIOP
						IF POWOF2(.CNODE[ARG2PTR]) THEN CMPINRETREG;
					END;
					TES;
				END;


				%(***IF ARG HAS COMPLEXITY 0, STILL NEED 1 REG***)%
				IF .CMPLX1 EQL 0
				THEN 1

				ELSE
				%(***IF ARG HAS COMPLEXITY GEQ 2, THEN NEED SAME NUMBER
					OF REGS FOR PARENT AS DO FOR ARG***)%
				IF .CMPLX1 GEQ 2
				THEN .CMPLX1

				ELSE
				%(***IF ARG HAS COMPLEXITY 1, THEN FOR P2MUL,P2DIV,
					AND EXPCIOP TO A POWER OF 2, NEED ONLY 1 REG.
					FOR P2PL1MUL AND EXPCIOP TO A NUMBER OTHER THAN A POWER OF 2
					 NEED 2 REGS******)%
				(  CASE .CNODE[OPERSP] OF SET
				1;		!FOR P2MUL
				1;		!FOR P2DIV
				2;		!FOR P2PL1MUL
				CGERR();		!FOR SQROP(NO LONGER USED)
				CGERR();		!FOR CUBOP(NO LONGER USED)
				CGERR();		!FOR P4OP (POWER OF 4)
				2;		!FOR EXPCIOP 
				TES  )
			END
		END;


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

%2244%		BEGIN	! STORECLS
%2244%
%2244%			! The  only   STORECLS  node   allowed  in   the
%2244%			! complexity walk is STRHAOBJN.  All others  are
%2244%			! created in  the register  allocation walk  and
%2244%			! SHOULD NEVER COME HERE!!
%2244%
%2244%			IF .TREEPTR[OPERSP] EQL STRHAOBJN
%2244%			THEN 1
%2244%			ELSE CGERR();	! Internal Compiler Error
%2244%
%2244%		END;	! STORECLS

		%(***FOR REGCONTENTS: COMPLEXITY IS 0*****)%
		0;

		%(***FOR LABOP:  SHOULD NEVER GET HERE*************)%
		CGERR();

		%(***FOR STATEMENT:  SHOULD NEVER GET HERE*****)%
		CGERR();

		%(***FOR IOLIST ELEMENT: SHOULD NEVER GET HERE*******)%
		CGERR();

		%(***FOR IN-LINE FUNCTIONS*************************)%
		CNODE[COMPLEXITY]_CMPILF();

%1431%		%(***FOR SUBSTRING***)%
%1431%		CNODE[COMPLEXITY] _ CMPLXSUBSTR();

%1474%		! CONCATENATION

%1474%		CNODE[COMPLEXITY] = CMPLCONCAT();

		TES
	END;

END;	! of SETCOMPLEXITY


GLOBAL ROUTINE ARRNARGBLK(REFPNTR,VLUPNTR)=
%(**********************************************************************

	ROUTINE TO DETERMINE IF AN ARRAY REFENCE APPEARING IN
	AN ARGBLK IS OF THE FORM A(1) WHERE A IS A FORMAL ARRAY
	IF SO, WE WANT TO SUBSTITUTE THE NAME OF THE FORMAL
	ARRAY FOR THE ARRAYREFERENCE

	CALLED WITH REFPNTR POINTING TO THE REFERENCE
	TO THE ARRAY AND VLUPNTR POINTING TO
	THE APPRPARIATE VALFLG (REFPNTR AND
	VLUPNTR ARE BYTE POINTERS)

**********************************************************************)%
BEGIN
TREEPTR_..REFPNTR;		!RESET TREEPTR
IF .TREEPTR[OPRCLS] EQL ARRAYREF THEN
IF .TREEPTR[ARG2PTR] NEQ 0 THEN
IF .TREEPTR[TARGADDR] EQL 0 THEN	!1127
BEGIN
	LOCAL PEXPRNODE ARROFFSET;
	ARROFFSET_.TREEPTR[ARG2PTR];
	IF .ARROFFSET[OPR1] EQL FMLVARFL THEN
	BEGIN
		LOCAL PEXPRNODE ARRNAME;
		ARRNAME_.TREEPTR[ARG1PTR];
		IF .ARRNAME[OPR1] EQL FMLARRFL THEN
		IF .ARRNAME[IDSYMBOL] EQL .ARROFFSET[IDSYMBOL] THEN
		BEGIN
			SAVSPACE(EXSIZ-1,.TREEPTR);
			.REFPNTR_TREEPTR_.ARRNAME;	!SUBSTITUE ARRAY NAME
			IF .VLUPNTR NEQ 0 THEN .VLUPNTR_1;
			RETURN TRUE
		END
	END
END;
RETURN FALSE

END;	! of ARRNARGBLK


GLOBAL ROUTINE CMPLA=
%(***************************************************************************
	ROUTINE TO COMPUTE THE COMPLEXITY OF AN ARITH OR NON-CONTROL
	TYPE BOOLEAN
	RETURNS THE VAL OF THE COMPLEXITY
	ALSO TRIES TO  MAKE ARG1 BE THE ARGUMENT MOST LIKELY TO BE COMPUTED INTO
	A REGISTER.
	ALSO SETS THE FLAGS   "FNCALLSFLG", "A1IMMEDFLG", "A2IMMEDFLG".
	ALLOCATES CORE FOR CONSTANTS WHICH ARE NOT IMMED-SIZE AND HENCE MUST BE STORED
	ALSO, WHEN ARG1 OF A GIVEN NODE WILL BE COMPUTED INTO "RETREG" (IE FN RETURN REG)
	 THEN IF POSSIBLE ASSIGNS THE PARENT TO BE COMPUTED INTO "RETREG"
	CALLED WITH THE GLOBAL "TREEPTR" POINTING TO THE NODE TO BE
	PROCESSED
***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE CNODE;				!PTR TO THE NODE BEING PROCESSED
	REGISTER PEXPRNODE ARG1NODE;
	REGISTER PEXPRNODE ARG2NODE;
	LOCAL CMPLX1,CMPLX2;				!COMPLEXITY OF THE ARGS UNDER CNODE

	LOCAL  RETVAL;		! RETURN VALUE

	OWN T1;
	OWN AADDR;			!BASE ADDRESS FOR THE ARRAY

	%(****TO SWAP THE INFO ABOUT THE 2 ARGS WHEN SWAP THE 2 ARGS***)%
	MACRO SWPARGDATA =
	BEGIN
		T1_.CMPLX1;
		CMPLX1_.CMPLX2;
		CMPLX2_.T1;
		ARG1NODE_.CNODE[ARG1PTR];
		ARG2NODE_.CNODE[ARG2PTR];
	END$;




	%(**CHECK WHETHER THIS EXPR WILL BE EVALUATED BY
		CALLING A LIBRARY FN(EG IF IT IS COMPLEX MUL,DIV OR A DP OP ON THE KA10)
		SET A GLOBAL FLAG INDICATING WHETHER THIS PROGRAM INCLUDES ANY CALLS TO SUCH FNS**)%
	IF USEFNCALL(TREEPTR) THEN TREEPTR[FNCALLSFLG]_LIBARITHFLG_TRUE;



	%(****WILL TREAT EXPONENTIATION AS A FUNCTION CALL. THEREFORE TRANSFORM
		ANY EXPONENTIATION NODES TO FUNCTION-CALL NODES AND CALL THE ROUTIEN TO PERFORM
		COMPLEXITY OF A FN-CALL
	********)%
	IF .TREEPTR[OPR1] EQL EXPONOPF
	THEN
	BEGIN
		EXPTOFNCALL();
		RETURN CMPLFNCALL();
	END;



	CNODE_.TREEPTR;
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];


	%(****FIND COMPLEXITIES OF THE 2 ARGS,  IF EITHER ARG IS A CONSTANT PROCESS IT
		ALSO PROPAGATE THE FLAGS FNCALLSFLG, AND RESRFFLG UP FROM THE ARGS***)%
	CMARGS();


	%(***GET COMPLEXITY OF 1ST ARG****)%
	CMPLX1_(IF .CNODE[A1VALFLG] THEN 0 ELSE .ARG1NODE[COMPLEXITY]);

	%(**GET COMPLEXITY OF 2ND ARG*******)%
	CMPLX2_(IF .CNODE[A2VALFLG] THEN 0 ELSE .ARG2NODE[COMPLEXITY]);


	%(****WILL ALWAYS WANT ARG1 TO BE COMPUTED INTO A REGISTER, THEREFORE IF EITHER ARG
		1. MUST BE IN A TEMPORARY
		2. IS A SIMPLE DATA ITEM WHICH REQUIRES NO COMPUTATION
		3. IS AN ARRAY REFERENCE WHICH MAY BE PICKED UP WITHOUT COMPUTING
		   IT INTO A REG
		4.  IS A COMMON SUBEXPRESSION

		LET THAT ARG BE ARG2 IF POSSIBLE
	********)%
	IF NOT .CNODE[A2VALFLG]
		AND NOT .CNODE[MEMCMPFLG]	!DO NOT REORDER THE ARGS OF AN OPERATION
						! THAT WILL BE PERFORMED TO MEMORY
	THEN
	BEGIN
		IF .CNODE[A1VALFLG]
		THEN
		%(***IF EITHER ARG IS A DATA ITEM OR COMMON SUBEXPR, THAT ARG SHOULD
			ALWAYS BE ARG2 IF POSSIBLE**********)%
		BEGIN
			IF EXCHARGS(.CNODE)
			THEN
			%(***IF WERE ABLE TO EXCHANGE ARG1 AND ARG2, THEN EXCHANGE
				THE DATA ABOUT THEM AS WELL***)%
			SWPARGDATA;
		END
		ELSE
		IF .ARG2NODE[OPRCLS] NEQ ARRAYREF
		THEN
		%(****WHEN NEITHER ARG IS A SIMPLE DATA ITEM, THEN IF EITHER ARG IS AN
			ARRAY REFERENCE, THAT ARG SHOULD BE ARG2 IF POSSIBLE*****)%
		BEGIN
			IF .ARG1NODE[OPRCLS] EQL ARRAYREF
			   OR
				.CMPLX1 GTR .CMPLX2
			THEN
			%(***IF NEITHER ARG IS AN ARRAYREF NOR A DATA ITEM,
				LET ARG2 BE THE ARG OF GREATER COMPLEXITY***)%
			BEGIN
				IF EXCHARGS(.CNODE)
				THEN SWPARGDATA;
			END;
		END;
	END;



	%(***IF 1ST ARG IS NOT A SUBEXPRESSION WHOSE EVALUATION WILL LEAVE A RESULT
		IN A REGISTER, THEN TRY TO MAKE 1ST ARG BE A VARIABLE WHOSE VALUE MIGHT
		BE LEFT IN A REG FROM EXECUTION OF A PRECEEDING STMNT***)%
	IF .ARG1NODE[OPRCLS] EQL DATAOPR	!IF ARG1 IS A VAR OR CONST
	THEN
	BEGIN
		IF SAVREGCONTAINING(.ARG1NODE)	!IF CAN LEAVE ARG1 IN A REG FROM A 
		THEN BEGIN END			! PRECEEDING STMNT, DO SO

		ELSE				!OTHERWISE, 
		IF .ARG2NODE[RGCANDFLG]		!IF ARG2 CAN BE LEFT IN A REG BY 
			AND NOT .CNODE[MEMCMPFLG]
		THEN				! A PRECEEDING STMNT,
		BEGIN
			IF EXCHARGS(.CNODE)	!IF CAN SWAP THE ARGS, DO SO
			THEN
			BEGIN
				SWPARGDATA;
				SAVREGCONTAINING(.ARG1NODE);	!SAVE THE REG CONTAINING
								! THE NEW ARG1
			END;
		END
	END
	ELSE

	%(***
	IF ARG1 IS AN ARRAYREF OR COMMON SUB OR ARG1 RETURNS ITS
	VALUE IN THE FUNCTION RETURN REGISTER, CHECK IF ARG2 IS
	ALSO A REGISTER AND, IF SO, PERFORM THE
	CALCULATION IN THE REGISTER FOR ARG2
	***)%

	IF .ARG1NODE[OPRCLS] EQL ARRAYREF
	OR .ARG1NODE[OPRCLS] EQL CMNSUB
	OR
	BEGIN	!ARG1 RETURNING VALUE IN REGISTER 0?
		.ARG1NODE[ALCRETREGFLG] AND
		.ARG1NODE[INREGFLG] AND
		.ARG1NODE[TARGTAC] EQL RETREG
	END
	THEN
	BEGIN
		IF .ARG2NODE[RGCANDFLG]		!HENCE IF ARG2 WAS LEFT IN  A REG
			AND NOT .CNODE[MEMCMPFLG]
		THEN					! BY A PRECEEDING STMNT
		BEGIN
			IF EXCHARGS(.CNODE)	!IF CAN SWAP THE ARGS, DO SO
			THEN
			BEGIN
				SWPARGDATA;
				SAVREGCONTAINING(.ARG1NODE);	!SAVE THE REG CONTAINING
								! THE NEW ARG1
			END
		END
	END;


	%(***IF ARE COMPUTING TO MEMORY AND THE 1ST ARG IS A SIMPLE VAR OR CONST, THEN THAT
		VAR OR CONST CAN BE LEFT IN A REG AFTER THIS STMNT IS EVALUATED**)%
	IF .CNODE[MEMCMPFLG] AND .CNODE[A1VALFLG]
	THEN ADDREGCANDATE(.ARG1NODE,.CNODE);



	IF .CMPLX1 LEQ .CMPLX2
	THEN
	CNODE[RVRSFLG]_1;

	%(***CHECK WHETHER THE VAL OF THE ARG COMPUTED FIRST WILL
		BE LEFT IN "RETREG" AND THEN CLOBBERRED BY COMPUTATION
		OF THE ARG THAT IS COMPUTED SECOND.
		IF SO, UNDO THE ASSIGNMENT OF THAT VAL TO "RETREG"
	********)%
	IF NOT .CNODE[A1VALFLG] AND NOT .CNODE[A2VALFLG]
	THEN
	BEGIN
		IF .CNODE[RVRSFLG]
		THEN
		%(***IF ARG2 IS EVALUATED FIRST***)%
		BEGIN
			IF .ARG2NODE[ALCRETREGFLG] AND .ARG1NODE[FNCALLSFLG]
			THEN
			BEGIN
				ARG2NODE[ALCRETREGFLG]_0;
				ARG2NODE[A1SAMEFLG]_0;
				ARG2NODE[A2SAMEFLG]_0;	!(NOTE THAT ARG-SAME-FLGS
							! COULD ONLY BE SET AT THIS
							! POINT DUE TO ALCRETREG
				ARG2NODE[INREGFLG]_0;
			END;
		END

		ELSE
		%(***IF ARG1 IS EVALUATED FIRST***)%
		BEGIN
			IF .ARG1NODE[ALCRETREGFLG] AND .ARG2NODE[FNCALLSFLG]
			THEN
			BEGIN
				ARG1NODE[ALCRETREGFLG]_0;
				ARG1NODE[A1SAMEFLG]_0;
				ARG1NODE[A2SAMEFLG]_0;
				ARG1NODE[INREGFLG]_0;
			END;
		END;
	END;


	%(****IF ARG1 WILL BE COMPUTED INTO "RETREG" (FN RETURN REGISTER) THEN
		WOULD LIKE TO COMPUTE PARENT IN RETREG ALSO.*******)%
	IF NOT .CNODE[A1VALFLG] AND .ARG1NODE[ALCRETREGFLG]
		AND .ARG1NODE[INREGFLG] AND .ARG1NODE[TARGTAC] EQL RETREG !(FOR RELATIONALS, "ALCRETREGFLG"

							! INDICATES THAT THE COMPAR IS DONE
							! IN RETREG, NOT THAT THE VAL IS LEFT THERE

	THEN
	%(***IF VAL OF ARG1 WILL BE LEFT IN "RETREG"***)%
	BEGIN
		IF .CNODE[OPRCLS] EQL RELATIONAL
		THEN
		CNODE[TARGAUX]_RETREG
		ELSE
		BEGIN
			CNODE[TARGTAC]_RETREG;
			CNODE[INREGFLG]_1;
		END;
		CNODE[ALCRETREGFLG]_1;
		CNODE[A1SAMEFLG]_1;
	END;

	%(***IF CMPLX1 IS STILL 0 (AFTER HAVE ATTEMPTED TO SWAP ARGS), TREAT IT AS
		IF IT WERE 1 (SINCE IT MUST BE LOADED INTO A REG TO PERFORM THE OPERATION***)%
	IF .CMPLX1 EQL 0 THEN CMPLX1_1;

	%(***RETURN THE  COMPLEXITY OF CNODE - THIS VALUE IS EQUAL
		TO THE MAXIMUM OF THE COMPLEXITY OF ARG1(CMPLX1) AND THE
		COMPLEXITY OF ARG2 (CMPLX2), UNLESS THE TWO ARE EQUAL, IN
		WHICH CASE IT IS ONE GREATER THAN THE VAL OF THE COMPLEXITY
		OF THE 2 ARGS
	*********)%

	RETVAL _
		BEGIN
			IF .CMPLX1 EQL .CMPLX2
			THEN
			.CMPLX1+1
			ELSE
			BEGIN
				IF .CMPLX2 GTR .CMPLX1
				THEN
				.CMPLX2
				ELSE
				.CMPLX1
			END
		END;

	%(*** IF ARG1 IS DOUBLE PREC ARRAYREF FOR KA10 AND
		ARG2 HAS NON-ZERO COMPLEXITY, THEN PARENT MUST
		HAVE AT LEAST COMPLEXITY 3 ***)%

%622%	! COMPLEX ARRAY REF NEEDS 3 REGS ALSO!

%622%	IF .ARG1NODE[OPRCLS] EQL ARRAYREF
%622%	THEN IF .ARG1NODE[VALTYPE] EQL COMPLEX
%622%	THEN IF .CMPLX2 NEQ 0
%622%	THEN IF .RETVAL LSS 3
%622%	THEN RETVAL _ 3;

	RETURN .RETVAL;

END;	! of CMPLA



GLOBAL ROUTINE CMARGS=
%(***************************************************************************
	ROUTINE TP PERFORM COMPLEXITY-WALK PROCESSING FOR THE 2 ARGS
	UNDER THE NODE POINTED TO BY THE GLOBAL "TREEPTR".
	IF EITHER OF THE ARGS HAS "FNCALLSFLG" SET, SETS IT IN THE PARENT.
	IF EITHER OF THE ARGS HAS "RESRFFLG" SET, SETS IT IN THE PARENT.
	IF EITHER ARG IS A CONSTANT, DECIDES WHETHER TO USE IT IMMEDIATE MODE,
	 OR ALLOCATE CORE FOR IT
***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE ARG1NODE:ARG2NODE:CNODE;
	CNODE_.TREEPTR;
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];


	%(*****COMPUTE COMPLEXITY OF 1ST ARG******)%
	IF NOT .CNODE[A1VALFLG] 
	THEN
	BEGIN
		TREEPTR_.CNODE[ARG1PTR];
		SETCOMPLEXITY();
	END;

	%(*****COMPUTE COMPLEXITY OF 2ND ARG*****)%
	IF NOT .CNODE[A2VALFLG]
	THEN
	BEGIN
		TREEPTR_.CNODE[ARG2PTR];
		SETCOMPLEXITY();
	END;




	%(***IF  EITHER ARG IS  THE VAR INTO WHICH THE RESULT OF THIS ASSIGNMENT IS
		TO BE STORED, SET A FLAG IN THE PARENT***)%
	IF .ARG1NODE EQL .RESNAME OR .ARG2NODE EQL .RESNAME  THEN CNODE[RESRFFLG]_1;


	%(***IF EITHER ARG IS A CONSTANT- THEN IF IT IS IMMED SIZE, SET IMMEDFLG,
		IF NOT, ALLOCATE CORE FOR IT*****)%
	IF .ARG1NODE[OPR1] EQL CONSTFL
	THEN
	PRCNSTARG(.CNODE,.ARG1NODE,TRUE);

	IF .ARG2NODE[OPR1] EQL CONSTFL
	THEN
	PRCNSTARG(.CNODE,.ARG2NODE,FALSE);

	%(***KEEP FLAGS FOR "FNCALL PRESENT SOMEWHERE UNDER THIS NODE"
		AND "REF TO RESULT VARIABLE PRESENT SOMEWHER UNDER THIS NODE"*****)%
	IF .ARG1NODE[OPRCLS] NEQ DATAOPR
	THEN
	BEGIN
		IF .ARG1NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
		IF .ARG1NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
	END;

	IF .ARG2NODE[OPRCLS] NEQ DATAOPR
	THEN
	BEGIN
		IF .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
		IF .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
	END;

END;	! of CMARGS


GLOBAL ROUTINE EXPTOFNCALL=		![1505] Reformatted by AHM
BEGIN

! Transforms an exponentiation node into a function call node.  Called
! with the global TREEPTR pointing to the node to be transformed.

REGISTER
	PEXPRNODE FNNMENTRY,	! Points to the function name STE
	PEXPRNODE ARG2NODE,	! Points to the RH exponentiation operand
	ARGUMENTLIST LST;	! Points to the arg list being created

! Tables of routine names to be called for exponentiation

BIND
	IEXPFNTBL= PLIT (	! INTEGER exponent, non G-floating
		SIXBIT 'EXP1.',		!INTEGER**INTEGER
		SIXBIT 'EXP2.',		!REAL**INTEGER
		SIXBIT 'DEXP2.',	!DOUBLE-PREC**INTEGER
		SIXBIT 'CEXP2.' ),	!COMPLEX**INTEGER

%761%	GIEXPFNTBL= PLIT (	! INTEGER exponent, G-floating
%761%		SIXBIT 'EXP1.',		!INTEGER**INTEGER
%761%		SIXBIT 'EXP2.',		!REAL**INTEGER
%761%		SIXBIT 'GEXP2.',	!DOUBLE-PREC**INTEGER
%761%		SIXBIT 'CEXP2.' ),	!COMPLEX**INTEGER

	EXPFNTBL=PLIT (		! Exponent of same type as base, non G-floating
		SIXBIT 'EXP1.',		!INTEGER**INTEGER
		SIXBIT 'EXP3.',		!REAL**REAL
		SIXBIT 'DEXP3.',	!DOUBLE-PREC**DOUBLE-PREC
		SIXBIT 'CEXP3.' ),	!COMPLEX**COMPLEX

%761%	GEXPFNTBL=PLIT (	! Exponent of same type as base, G-floating
%761%		SIXBIT 'EXP1.',		!INTEGER**INTEGER
%761%		SIXBIT 'EXP3.',		!REAL**REAL
%761%		SIXBIT 'GEXP3.',	!DOUBLE-PREC**DOUBLE-PREC
%761%		SIXBIT 'CEXP3.' );	!COMPLEX**COMPLEX


! Get core to hold the arg list

	NAME<LEFT> = ARGLSTSIZE(2);
	LST = CORMAN();

	LST[ARGCOUNT] = 2;		! Say there are 2 arguments
	LST[1,ARGNPTR] = .TREEPTR[ARG1PTR];	! First one was ARG1PTR
	LST[2,ARGNPTR] = ARG2NODE = .TREEPTR[ARG2PTR];	! Second was ARG2PTR

	LST[1,AVALFLG] = .TREEPTR[A1VALFLG];	! Set the valflgs for
	LST[2,AVALFLG] = .TREEPTR[A2VALFLG];	!  the 2 args

	TREEPTR[OPRCLS] = FNCALL;	! Make the node a FNCALL node
	TREEPTR[OPERSP] = LIBARY;	! (A library function)
	TREEPTR[ARG2PTR] = .LST;	! Point to the argument list
	TREEPTR[EXPFLAGS] = 0;		! Clear lots of flags

! Set ARG1 of the FNCALL  to point to the  symbol table entry for  the
! function name for the function  to be used.  There  are 2 sets of  2
! functions for each of the 4 main value types.  One set is for normal
! double precision and the other  is for G-floating DP.  One  function
! in each set is for that valtype  raised to an integer power and  the
! other is for that valtype raised to a power of the same valtype.

%761%	IF .GFLOAT	! G-floating uses GEXP, not DEXP
%761%	THEN IF .ARG2NODE[VALTP1] EQL INTEG1
%761%		THEN ENTRY[0] = .GIEXPFNTBL[.TREEPTR[VALTP1]]
%761%		ELSE ENTRY[0] = .GEXPFNTBL[.TREEPTR[VALTP1]]
%761%	ELSE IF .ARG2NODE[VALTP1] EQL INTEG1
%761%		THEN ENTRY[0] = .IEXPFNTBL[.TREEPTR[VALTP1]]
%761%		ELSE ENTRY[0] = .EXPFNTBL[.TREEPTR[VALTP1]];

	NAME = IDTAB;			! Search the symbol table
	TREEPTR[ARG1PTR] = FNNMENTRY = TBLSEARCH();

	FNNMENTRY[OPERSP] = FNNAME

END;	! of EXPTOFNCALL


GLOBAL ROUTINE PRCNSTARG(PARNODE, CONSTNODE,A1CNSTFLG)=
%(***************************************************************************
	TO PROCESS A CONSTANT ARG.
	IF IT IS OF IMMED SIZE, SET IMMEDFLG IN THE PARENT.
	IF NOT, ALLOCATE CORE FOR IT.
	CALLED WITH THE ARGS
		PARNODE - PTR TO THE PARENT NODE
		CONSTNODE - PTR TO THE CONSTANT TABLE ENTRY FOR THE CONSTANT
		A1CNSTFLG - FLAG FOR "THE CONSTANT NODE IS THE 1ST ARG UNDER PARENT"
***************************************************************************)%
BEGIN
	MAP PEXPRNODE PARNODE:CONSTNODE;

	%(***IF THE CONSTANT IS USED AS THE 2ND ARG OF AN OPERATION WHICH IS PERFORMED
		BY MEANS OF A FN-CALL (IE EXPONENTIATION OR DOUBLE-PREC OPS ON KA10), THEN
		MUST ALLOCATE CORE FOR THE CONSTANT***)%
	IF USEFNCALL(PARNODE) AND NOT .A1CNSTFLG
	THEN
	ALOCONST(.CONSTNODE)


	%(***IF THE CONSTANT IS NOT OF TYPE INTEGER OR TYPE LOGICAL, AND A BOOLEAN
		OPERATOR IS BEING APPLIED TO IT, THEN MUST ALLOCATE CORE FOR IT*****)%
	ELSE
	IF .PARNODE[OPRCLS] EQL BOOLEAN AND .CONSTNODE[VALTP1] NEQ INTEG1
	THEN ALOCONST(.CONSTNODE)



	%(***IF CONSTANT IS IMMEDIATE SIZE, DO NOT ALLOCATE CORE FOR IT. INSTEAD, SET
		IMMEDFLG IN THE PARENT
	*****)%
	ELSE
	IF IMMEDCNST(CONSTNODE)
	THEN
	BEGIN
		(IF .A1CNSTFLG THEN PARNODE[A1IMMEDFLG] ELSE PARNODE[A2IMMEDFLG])_1;
		IF .CONSTNODE[CONST2] LSS 0 AND .CONSTNODE[VALTP1] EQL INTEG1
		THEN
		%(***IF THE CONSTANT IS A NEG INTEGER, USE  A POSITIVE NUMBER NEGATED.***)%
		BEGIN
			IF .PARNODE[OPRCLS] EQL BOOLEAN	THEN
			%(***FOR BOOLEANS, USE  THE 1S COMPLEMENT AND THE 'NOT'
				VERSION OF THE INSTRUCTION.*******)%
			BEGIN
				IF .A1CNSTFLG	!TO PICK UP ARG1 WITH"NOT"
				THEN
				BEGIN
					PARNODE[A1NOTFLG]_NOT .PARNODE[A1NOTFLG];
					PARNODE[ARG1PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,NOT .CONSTNODE[CONST2]);
				END
				ELSE		!TO OPERATE ON ARG2 WITH "NOT"
				BEGIN
					PARNODE[A2NOTFLG]_NOT .PARNODE[A2NOTFLG];
					PARNODE[ARG2PTR]_
						MAKECNST(.CONSTNODE[VALTYPE],0,NOT .CONSTNODE[CONST2]);
				END;
			END

			ELSE
			IF .PARNODE[OPRCLS] EQL STATEMENT
			THEN
			BEGIN
				%(***FOR ASSIGNMENT STMNTS, IF RHS IS AN IMMED CONSTANT
					WHEN NEGATED, THEN SET A2NEGFLG AND USE THE NEG***)%
				IF .PARNODE[SRCID] EQL ASGNID
				THEN
				BEGIN
					PARNODE[A2NEGFLG]_NOT .PARNODE[A2NEGFLG];
					PARNODE[RHEXP]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
				END
				ELSE CGERR();	!SHOULD NEVER CALL PRCNSTARG WITH
						! ANY STMNT OTHER THAN ASSIGNMENT
			END

			ELSE
			IF .A1CNSTFLG
			THEN
			BEGIN
				PARNODE[A1NEGFLG]_NOT .PARNODE[A1NEGFLG];
				PARNODE[ARG1PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
			END
			ELSE
			BEGIN
				PARNODE[A2NEGFLG]_NOT .PARNODE[A2NEGFLG];
				PARNODE[ARG2PTR]_MAKECNST(.CONSTNODE[VALTYPE],0,-.CONSTNODE[CONST2]);
			END;
		END
	END
	ELSE
	ALOCONST(.CONSTNODE);

END;	! of PRCNSTARG


GLOBAL ROUTINE CMPVBOOL=
%(***************************************************************************
	ROUTINE PERFORMS COMPLEXITY WALK FOR A BOOLEAN WHOSE VALUE IS
	TO BE COMPUTED.
***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;

	%(***FOR EQV AND XOR - TREAT SAME AS ARITH****)%
	IF .TREEPTR[BOOLCLS] NEQ ANDORCLS THEN CMPLA()

	ELSE
	%(***IF VALTYPE OF THIS NODE IS "CONTROL" WILL NEED 1 REG TO HOLD THE VAL
		IN ADDITION TO THE NUMBER OF REGS NEEDED FOR THE CONTROL BOOLEAN IF
		IT WERE USED STRICTLY FOR CONTROL PURPOSES****)%
	IF .TREEPTR[VALTYPE] EQL CONTROL
	THEN CMPLBL() + 1

	ELSE
	BEGIN
		CNODE_.TREEPTR;
		ARG1NODE_.CNODE[ARG1PTR];
		ARG2NODE_.CNODE[ARG2PTR];

		%(***IF ONE OF THE 2 ARGS HAS VALTYPE CONTROL (AND THE OTHER IS A MASK)
			ALWAYS MAKE ARG1 BE THE MASK.
		********)%
		IF .ARG1NODE[VALTYPE] EQL CONTROL
		THEN
		BEGIN
			EXCHARGS(.CNODE);
			ARG1NODE_.CNODE[ARG1PTR];
			ARG2NODE_.CNODE[ARG2PTR];
		END;

		%(***IF ONE ARG IS OF TYPE CONTROL, WILL INIT VAL OF BOOLEAN TO THE
			OTHER ARG, THEN EVALUATE THE CONTROL ARG***)%
		IF .ARG2NODE[VALTYPE] EQL CONTROL
		THEN
		BEGIN
			%(***PERFORM COMPLEXITY WALK FOR THE 2 ARGS. PROPAGATE
				FNCALLSFLG AND RESRFFLG UP FROM THE ARGS TO THE PARENT***)%
			CMARGS();

			%(***IF ARG1 IS COMPUTED INTO FN-RETURN-REG***)%
			IF .ARG1NODE[OPRCLS] NEQ DATAOPR
				AND .ARG1NODE[ALCRETREGFLG]
			THEN
			BEGIN
				%(**IF COMP OF ARG2 WILL CLOBBER FN-RET-REG, THEN
					MUST STORE ARG1 ELSEWHERE***)%
				IF .ARG2NODE[FNCALLSFLG] 
				THEN
				BEGIN
					ARG1NODE[ALCRETREGFLG]_0;
					ARG1NODE[A1SAMEFLG]_0;
					ARG1NODE[INREGFLG]_0;
				END
				%(***OTHERWISE COMPUTE PARENT IN FN-RET REG***)%
				ELSE
				BEGIN
					CNODE[ALCRETREGFLG]_1;
					CNODE[A1SAMEFLG]_1;
					CNODE[INREGFLG]_1;
					CNODE[TARGTAC]_RETREG;
				END;
			END;

			SAVREGCONTAINING(.ARG1NODE);	!IF BB ALLOCATOR CAN LEAVE VAL OF ARG1 IN A REG
							! IN SOME PREV STMNT, IT SHOULD DO SO

			%(***COMPLEXITY OF CNODE IS MAX OF (1+CMPLX OF ARG2) AND
				CMPLX OF ARG1 ***)%
			IF .ARG1NODE[COMPLEXITY] GTR .ARG2NODE[COMPLEXITY]
			THEN .ARG1NODE[COMPLEXITY]
			ELSE .ARG2NODE[COMPLEXITY] + 1
		END

		ELSE
		%(***FOR AND OR OR WHEN NEITHER ARG HAS TYPE CONTROL, TREAT LIKE ARITH***)%
		CMPLA()
	END

END;	! of CMPVBOOL


GLOBAL ROUTINE CMPLBL=
%(***************************************************************************
	ROUTINE TO COMPUTE THE COMPLEXITY OF A CONTROL-TYPE BOOLEAN
	CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE
	WHOSE COMPLEXITY IS TO BE RETURNED
***************************************************************************)%

BEGIN
	LOCAL PEXPRNODE CNODE:ARG1NODE:ARG2NODE;
	LOCAL CMPLX1,CMPLX2;				!COMPLEXITY OF ARG1 AND ARG2
	CNODE_.TREEPTR;					!PTR TO THE NODE BEING PROCESSED
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];

	%(****FOR 1ST ARG**************************************)%
	TREEPTR_.ARG1NODE;

	%(****ARGS OF A CONTROL-TYPE BOOLEAN CAN BE EITHER CONTROL-TYPE
		BOOLEANS, OR RELATIONALS************************)%
	IF .ARG1NODE[OPRCLS] EQL RELATIONAL
	THEN
	%(****FOR A RELATIONAL USED FOR CONTROL PURPOSES ONLY***)%
	ARG1NODE[COMPLEXITY]_(CMPLX1_CMPLREL())

	ELSE
	BEGIN
		IF .ARG1NODE[OPRCLS] EQL BOOLEAN
		THEN
		%(****IF A SUBNODE IS A BOOLEAN, IT MUST BE A CONTROL-TYPE BOOLEAN****)%
		ARG1NODE[COMPLEXITY]_(CMPLX1_CMPLBL())

		ELSE
		CGERR(5)

	END;


	%(****FOR 2ND ARG**************************************)%
	TREEPTR_.ARG2NODE;

	%(****ARGS OF A CONTROL-TYPE BOOLEAN CAN BE EITHER CONTROL-TYPE
		BOOLEANS, OR RELATIONALS************************)%
	IF .ARG2NODE[OPRCLS] EQL RELATIONAL
	THEN
	%(****FOR A RELATIONAL USED FOR CONTROL PURPOSES ONLY***)%
	ARG2NODE[COMPLEXITY]_(CMPLX2_CMPLREL())

	ELSE
	BEGIN
		IF .ARG2NODE[OPRCLS] EQL BOOLEAN
		THEN
		%(****IF A SUBNODE IS A BOOLEAN, IT MUST BE A CONTROL-TYPE BOOLEAN****)%
		ARG2NODE[COMPLEXITY]_(CMPLX2_CMPLBL())

		ELSE
		CGERR(5)

	END;


	%(****SET THE FLAG "FNCALLSFLG" IN THE PARENT, IF ANY FNCALLS ARE UNDER
		ANY OF THE ARGS****)%
	%(****SET THE FLAG "RESRFFLG" IN THE PARENT IF REF TO LOC OF FINAL RESULT
		OCCURS UNDER EITHER ARG*****)%
	IF .ARG1NODE[FNCALLSFLG] OR .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
	IF .ARG1NODE[RESRFFLG] OR .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;


	%(****FOR A CONTROL-TYPE BOOLEAN, COMPLEXITY IS EQUAL TO MAX
		OF COMPLEXITY OF THE 2 ARGS**********************)%
	IF .CMPLX2 GTR .CMPLX1
	THEN
	CMPLX1_.CMPLX2;

	CNODE[COMPLEXITY] _.CMPLX1;

	RETURN .CMPLX1

END;	! of CMPLBL


GLOBAL ROUTINE CMPLREL=
%(****************************************************************************
	ROUTINE TO COMPUTE THE COMPLEXITY OF A RELATIONAL.
	COMPUTES THE NUMBER OF REGISTERS NEEDED IF THE REL IS USED
	FOR CONTROL PURPOSES ONLY.
	CALLED WITH THE GLOBAL TREEPTR POINTING TO THE NODE FOR
	THE RELATIONAL.
****************************************************************************)%
BEGIN
	OWN CMPLX1;
	LOCAL PEXPRNODE CNODE:ARG1NODE: ARG2NODE;
	CNODE_.TREEPTR;

	%(***USE SAME BASIC ALGORITHM FOR COMPLEXITY AS IS USED FOR ARITH NODES***)%
	CMPLX1_CMPLA();

	ARG1NODE_.CNODE[ARG1PTR];	!AFTER CMPLA, GET VALS OF ARG1PTR AND ARG2PTR

	ARG2NODE_.CNODE[ARG2PTR];
	CNODE[INREGFLG]_0;	!CMPLA WOULD HAVE SET "INREGFLG" IF IT ALLOCATED
				! THIS NODE TO BE COMPUTED IN FN-RET REG -
				! BUT FOR A RELATIONAL, THE COMPAR
				! IS PERF IN A REG, BUT THE VAL MIGHT BE LEFT
				! IN A TEMP


	%(***IF ARGS ARE DOUBLE-WORD, THEN NEED TWICE AS MANY REGS AS CMPLX1 INDICATES ***)%
	IF .ARG1NODE[DBLFLG] THEN
	BEGIN
		 CMPLX1_.CMPLX1^1;
		PAIRMODE_TRUE	!IF THE OPERANDS OF THE RELATIONAL ARE DP OR COMPLEX VARS
				! WILL NEED A REG PAIR TO DO THE COMPARISON
	END;



	%(***IF ARG2 IS A REAL OR COMPLEX  IMMED CONSTANT,
		 WILL HAVE TO ALLOCATE CORE FOR IT (SINCE
		HAVE NO COMPARE IMMED INSTRUCTION FOR REALS) HANCE IF ONE ARG IS
		REAL IMMED AND THE OTHER IS  A VAR , LET ARG1 BE THE CONST ARG.
		IF BOTH ARGS ARE REAL IMMED(POSSIBLE ONLY IF P2SKEL NOT USED),
		ALLOCATE CORE FOR ARG2****)%
	IF .CNODE[A2IMMEDFLG]
	THEN
	BEGIN
		IF (.ARG2NODE[OPERATOR] EQL REALCONST OR .ARG2NODE[OPERATOR] EQL CPLXCONST)
			AND (.ARG2NODE[CONST1] NEQ 0)	!CAN USE CAI FOR ZERO
		THEN
		BEGIN
			%(***IF ARG1 IS AN EXPRESSION (WHOSE VAL WILL PROBABLY BE LEFT IN A REG)
				OR IS A VARIABLE WHOSE VAL CAN BE LEFT IN A REG BY A PREV STMNT
				OR IF ARG1 IS ALSO AN IMMED CONSTANT,
				ALLOCATE CORE FOR ARG2
			********)%
			IF .CNODE[A1IMMEDFLG]	!IF ARG1 IS AN IMMED CONST
			   OR
				(.ARG1NODE[OPRCLS] NEQ ARRAYREF	!ARG1 NOT AN ARRAY REF
				AND
				NOT (.ARG1NODE[OPRCLS] EQL DATAOPR	!ARG1 NOT A VAR THAT
				    AND NOT .ARG1NODE[RGCANDFLG])	! COULD NOT HAVE BEEN LEFT IN A REG
				)
			THEN
			BEGIN
				%(***MUST ALLOCATE CORE FOR ARG2***)%
				ALOCONST(.ARG2NODE);
				CNODE[A2IMMEDFLG]_0;
			END

			%(***IF ARG1 IS A VAR THAT COULD NOT HAVE BEEN LEFT IN A REG BY A PREV STMNT
				OR IF ARG1 IS AN ARRAYREF (IE IF ARG1 HAS TO BE LOADED INTO
				A REG) AND IF ARG1 IS NOT ALSO AN IMMED REAL CONST,
				EXCHANGE THE 2 ARGS***)%
			ELSE
			EXCHARGS(.CNODE)
		END;
	END;

	%(***CANNOT GENERATE CODE FOR A RELATIONAL WHICH HAS A NEGFLG OVER
		ARG2. GET RID OF ANY A2NEGFLG BY:
		A LT -B = -A GT B
		A LEQ -B = -A GEQ B
		A EQ -B = -A EQ B
		ETC
	*****)%
	IF .CNODE[A2NEGFLG]
	THEN
	BEGIN
		CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
		CNODE[A2NEGFLG]_0;
		IF NOT EQREL(.CNODE[OPERSP])
		THEN CNODE[OPERSP]_REVREL(.CNODE[OPERSP])
	END;

	%(***IF A1NEGFLG IS NOW SET AND ARG1 IS AN EXPRESSION, TRY TO PROPAGATE
		THE NEGATIVE OVER ARG1
	*******)%
	IF .CNODE[A1NEGFLG] AND NOT .CNODE[A1VALFLG]
	THEN
	BEGIN
		IF PROPNEG(.CNODE[ARG1PTR]) THEN CNODE[A1NEGFLG]_0;
	END;

	%(***IF  ARG1  IS A VAR OR CONST, ADD IT TO THE SET 
		OF VARS WHOSE VALS ARE LEFT IN REGS BY THE EVAL OF STMNTS***)%
	IF .CNODE[A1VALFLG] 
	THEN
	BEGIN
		%(**IF BOTH ARGS ARE VARS/CONSTS THEN PUT ARG2 IN THE SET OF VARS
			WHOSE VALS CAN BE LEFT IN REGS**)%
		IF .CNODE[A2VALFLG]
		THEN
		BEGIN
			%(**ONLY PUT ARG2 INTO THE SET OF POTENTIAL REG VARS IF
				1. ARG1 IS A CONST OR VAR (NOT A CSB)
				2. ARG1 WILL NOT BE AVAILABLE IN A REG FROM SOME
				   EARLIER STMNT
			*****)%
			ARG1NODE_.CNODE[ARG1PTR];
			IF .ARG1NODE[OPRCLS] EQL DATAOPR
				AND NOT .ARG1NODE[RGCANDFLG]
			 THEN ADDREGCANDATE(.CNODE[ARG2PTR],.CNODE);
		END;


		%(***ADD ARG1 TO SET OF POTENTIAL REG-VARS***)%
		 ADDREGCANDATE(.CNODE[ARG1PTR],.CNODE);

	END;

	RETURN .CMPLX1;

END;	! of CMPLREL


ROUTINE CMPLCONCAT=
BEGIN
	!***************************************************************
	! Compute the complexity  of a concatenation  node by  examining
	! its  list  of  arguments.   Called  with  the  global  treeptr
	! pointing to the concatenation node.
	!***************************************************************

%1474%	! Written by TFV on 12-Feb-82

	BIND INCONCAT = TRUE;	! Flag for CMPFNARGS.  It indicates that
				! the first argument should be ignored

	LOCAL ARGUMENTLIST ARGLST;

	LOCAL PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARGNODE;


	FNREF = TRUE;	! Set global flag indicating that this statement
			! includes a function call

	TREEPTR[FNCALLSFLG] = 1;	! Set flag in statement node for
					! function   calls  occur  under
				  	! this node

	CNODE = .TREEPTR;		! Save pointer to current node

	! Complexity  will  be  the  maximum  of  complexities  of   the
	! arguments in the argument list.  For concatenations, the first
	! argument is not set up until allocation.

%2401%	! Removed some useless, dangerously incorrect code.
%2401%
%2401%	RETURN CMPFNARGS(.TREEPTR[ARG2PTR],.TREEPTR[DBLFLG],INCONCAT);

END;	! of CMPLCONC


GLOBAL ROUTINE CMPLFNCALL=
BEGIN
	!***************************************************************
	! Compute the complexity  of a  function call  by examining  its
	! list of arguments.  Called with the global TREEPTR pointing to
	! the function call node.
	!***************************************************************

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

	LOCAL ARGUMENTLIST ARGLST;
	LOCAL CMPLX1;

	LOCAL PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARGNODE;

	! Set global  flag  indicating  that this  statment  includes  a
	! function call.  Set the flag in the node also.

	FNREF = TRUE;
	TREEPTR[FNCALLSFLG] = 1;

%1422%	IF .TREEPTR[VALTYPE] NEQ CHARACTER
%1422%	THEN
%1422%	BEGIN	! Non-character functions return the result in AC0, AC1

		TREEPTR[ALCRETREGFLG] = 1;
		TREEPTR[TARGTAC] = RETREG;
		TREEPTR[INREGFLG] = 1;
		TREEPTR[TARGADDR] = RETREG;

%1422%	END;	! Non-character functions return the result in AC0, AC1

	! If no arguments then complexity is 0

	IF .TREEPTR[ARG2PTR] EQL 0 THEN RETURN 0;

	CNODE = .TREEPTR;	! Setup pointer to the node

	! Complexity will  be the  maximum of  the complexities  of  the
	! elements of the argument list

%1474%	CMPLX1 = CMPFNARGS(.TREEPTR[ARG2PTR],.TREEPTR[DBLFLG],NOTINCONCAT);

	! Determine whether any argument under this call is equal to the
	! left hand side of this  assignment or contains a reference  to
	! it.

	ARGLST = .CNODE[ARG2PTR];

	INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
	DO
	BEGIN	! Walk down the argument list

		ARGNODE = .ARGLST[.CT,ARGNPTR];

		IF .ARGNODE[OPRCLS] EQL DATAOPR
		THEN
		BEGIN
			IF .ARGNODE EQL .RESNAME THEN CNODE[RESRFFLG] = 1;
		END
		ELSE
		IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1;

	END;	! Walk down the argument list

	RETURN .CMPLX1;

END;	! of CMPLFNCALL


GLOBAL ROUTINE CMPFNARGS(ARLISTT,PARDBLFLG,INCONCAT)=
BEGIN
	!***************************************************************
	! Compute  the  complexity  of  an  argument  list.   Used   for
	! functions, subroutine calls, and concatenations.  PARDBLFLG is
	! true iff  the  function had  a  double word  value  and  hence
	! allocation at the parent level  was done in double word  mode.
	! The flag INCONCAT is true  if this is called from  CMPLCONCAT.
	! In that case the first argument is ignored since it is not set
	! up until allocation.
	!***************************************************************

%1474%	REGISTER FIRSTARG;		! The first argument to examine
	MAP ARGUMENTLIST ARLISTT;
	LOCAL CMPLMAX, CMPL1;
	LOCAL PEXPRNODE ARGNODE;

	CMPLMAX = 0;

%1474%	! Decide which argument is the first to examine

%1474%	IF .INCONCAT THEN FIRSTARG = 2 ELSE FIRSTARG = 1;

%1474%	INCR CT FROM .FIRSTARG TO .ARLISTT[ARGCOUNT]
	DO
	BEGIN	! Walk down the argument list

%2401%		! See if we  have a  substring which  can be  replaced
%2401%		! with a .Dnnnn compile time constant descriptor.
%2401%
%2401%		ARLISTT[.CT,ARGNPTR] = TREEPTR = ARGNODE =
%2401%			DOTDCHECK(.ARLISTT[.CT,ARGNPTR]);
%2401%
%2401%		IF .ARGNODE[OPRCLS] EQL DATAOPR		! In case it changed,
%2401%		THEN ARLISTT[.CT,AVALFLG] = 1;		! get val flag right

		! If this argument is a constant, set the flag to allocate
		! memory for that constant 

		IF .ARGNODE[OPR1] EQL CONSTFL
		THEN
		BEGIN
			ALOCONST(.TREEPTR);
			CMPL1 = 0
		END
		ELSE
		IF NOT .ARLISTT[.CT,AVALFLG]
		THEN
		BEGIN

			! Compute the complexity of the argument

			CMPL1 =  SETCOMPLEXITY();

			! Check for an argument  that requires a  double
			! word computation. If  parent was  not also  in
			! double word mode, must double the size of  the
			! number of registers indicated

			IF .ARGNODE[DBLFLG] AND NOT .PARDBLFLG
			THEN CMPL1 = .CMPL1^1
			ELSE

			! If parent  is  in  double word  mode  and  the
			! argument is in  single word  mode, divide  the
			! complexity in half

			IF .PARDBLFLG AND NOT .ARGNODE[DBLFLG]
			THEN CMPL1 = (.CMPL1+1)^(-1);

			! Check if the argument is a formal array

			IF ARRNARGBLK(ARLISTT[.CT,ARGNPTR],ARLISTT[.CT,AVALFLG])
			THEN CMPL1 = 0;

		END
		ELSE CMPL1 = 0;

		IF .CMPL1 GTR .CMPLMAX THEN CMPLMAX = .CMPL1;

	END;	! Walk down the argument list

	RETURN .CMPLMAX

END;	! of CMPFNARGS


GLOBAL ROUTINE CMPTPCNV=
%(***************************************************************************
	TO COMPUTE THE COMPLEXITY OF A TYPE CONVERSION NODE.
	IF THE CONVERSION IS BETWEEN SINGLE-WORD AND DOUBLE-WORD VALUES,
	MUST ADJUST THE COMPLEXITY USED FOR NODES BELOW THIS ONE.
	IF THE CONVERSION IS BETWEEN FIXED AND FLOAT ON THE KA10, WILL NEED AN
	EXTRA REG.

***************************************************************************)%
BEGIN
	LOCAL PEXPRNODE CNODE:ARGNODE;
	OWN CMPLX1;

	CNODE_.TREEPTR;
	ARGNODE_.CNODE[ARG2PTR];

	%(***GET COMPLEXITY OF THE ARG***)%
	IF .CNODE[A2VALFLG]
	THEN
	BEGIN
		CMPLX1_0;
		%(***IF ARG IS EQUAL TO THE VARIABLE ON THE LHS OF THIS ASSIGNMENT
			SET A FLG*****)%
		IF .CNODE[ARG2PTR] EQL .RESNAME
		THEN
		CNODE[RESRFFLG]_1;

		%(***IF THE ARG UNDER THIS NODE COULD HAVE BEEN LEFT IN A REG
			BY THE EVAL OF A PRECEEDING STMNT, DO SO***)%
		SAVREGCONTAINING(.ARGNODE);
	END
	ELSE
	BEGIN
		ARGNODE_.CNODE[ARG2PTR];
		TREEPTR_.CNODE[ARG2PTR];
		CMPLX1_SETCOMPLEXITY();
		%(***IF VAL OF ARG IS COMPUTED INTO RETREG,
			COMPUTE VAL OF PARENT INTO RETREG**)%
		SNGARGPROP(.CNODE,.ARGNODE);

	END;


	%(***IF ARG IS A CONSTANT, MUST ALLOCATE CORE FOR IT (THIS WILL ONLY
		OCCUR IF CALLED THE TYPE CONV ROUTINE EXPLICITLY)***)%
	IF .ARGNODE[OPR1] EQL CONSTFL
	THEN
	ALOCONST(.ARGNODE);


	%(***UNLESS NO CONVERSION CODE HAS TO BE GENERATED,
		AT LEAST 1 REGISTER WILL BE NEEDED TO PERFORM
		THE CONVERSION IN
	*******)%
	IF NOT NOCNV(CNODE)
	THEN
	BEGIN
		IF .CMPLX1 EQL 0
		THEN CMPLX1_1;

	END;

	%(***CHECK FOR CHANGE IN PRECISION ACROSS THIS NODE***)%
	IF .CNODE[DBLFLG] AND NOT .CNODE[SDBLFLG]
	THEN
	%(***IF NODE BELOW IS SINGLE-WD AND THIS NODE
		IS DOUBLE-WD***)%
	CMPLX1_(.CMPLX1+1)^(-1)

	ELSE
	IF NOT .CNODE[DBLFLG] AND .CNODE[SDBLFLG]
	THEN
	%(***IF NODE BELOW IS DOUBLE-WD AND THIS NODE
		IS SINGLE-WD***)%
	CMPLX1_.CMPLX1^1;

	RETURN .CMPLX1;

END;	! of CMPTPCNV


GLOBAL ROUTINE CMPLXARRAY=
BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	Returns the complexity  of an array  reference.  Must get  the
!	value of the offset into  a register (unless it is  constant).
!	Need as many regs as are needed to compute that val, or 1  reg
!	if that val requires no computation but is not constant (ie is
!	a variable).
!
!	Set up TARGADDR of this ARRAYREF node to represent the
!	constant part of the reference to this element (i.e. the sum
!	of the address of the array base with any constants involved
!	in the offset calculation).  Do this by walking down the n-ary
!	sum that is the address calculation, to get any constant term
!	(which the canonicalizer will have left at bottom left).
!	TARGADDR may already contain constant terms that were detected
!	at the time that the address calculation was expanded.
!
!	Note that if the array is numeric and the constant part of the
!	ARRAYREF does not directly fit into TARGADDR, a CTE will be
!	created for the constant, and the CTE's address will be placed
!	in TARGADDR.  The ARRAYREF's OPERSP will be changed to
!	ARREFBIG to signify the offset's change in representation.
!
!	Called with the global TREEPTR pointing to the ARRAYREF node
!	to be processed.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	Complexity of the array reference passed.
!
! SIDE EFFECTS:
!
!	Unknown
!
!--


%2463%	OWN BASE AADDR;			! Array address
	OWN CMPLX1;			! Calculated complexity
	OWN PEXPRNODE CONSTTERM;	!EVENTUALLY WILL BE SET TO PT TO THE
					! CONSTANT TERM IN THE ADDRESS CALC
	OWN PEXPRNODE PAROFCONST;	!PTR TO PARENT OF CONSTTERM
	OWN PEXPRNODE GPOFCONST;	!PTR TO PARENT OF "PAROFCONST"

	REGISTER
		PEXPRNODE ADDRNODE,	! Array address calculation
		PEXPRNODE CNODE,
%2411%		PEXPRNODE ARRNAME;	! Array symbol table entry

%2244%	LOCAL	BASE AOBJNPTR,		! Expression node pointing to
%2244%					! AOBJN REGCONTENTS node.
%2244%		BASE AOBJNSTORNODE,	! STRHAOBJN node created.
%2244%		CMPAOBJN;		! Added complexity if addr calc
%2244%					! is AOJBN and array is in .LARG.


%2411%	ARRNAME _ .TREEPTR[ARG1PTR];	! Symbol table name entry
	ADDRNODE _ .TREEPTR[ARG2PTR];	! Address node
	CNODE _ .TREEPTR;		! Array ref node

	%(***IF THE ARRAY NAME IS IDENTICAL TO THE ARRAY NAME ON LEFT HAND
		SIDE OF ASSIGNMENT OR THE ADDRNODE IS IDENTICAL TO A SIMPLE VAR
		ON THE LEFT HAND SIDE OF THE ASSIGNMENT, SET FLAGS
		INDICATING THAT THERE IS A REFERENCE TO LHS UNDER THIS NODE***)%

%2411%	IF (.ARRNAME EQL .RESNAME) OR (.ADDRNODE EQL .RESNAME) THEN CNODE[RESRFFLG]_1;


%2411%	IF .ARRNAME[VALTYPE] NEQ CHARACTER
%1253%	THEN
	BEGIN	! NON-CHARACTER

	! We want to try to add the base address of the array into the constant
	! part of the address calculation if the array is not a formal.

%2411%	IF .ARRNAME[FORMLFLG]
%2362%	THEN	AADDR = EXTSIGN(.CNODE[TARGADDR])	! Formal array
%1766%	ELSE
%2336%	BEGIN	! Not formal array
%2336%
%2411%		AADDR = EXTSIGN(.CNODE[TARGADDR]) + .ARRNAME[IDADDR];
%2336%
%2362%		! Check the size of the address so far.  If the address is  too
%2362%		! big to store into TARGADDR already, then we should keep these
%2362%		! constants separate.   What  is in  TARGADDR  obviously  fits.
%2362%		! Make a  new constant,  ARRNAME[IDADDR], and  insert an  ADDOP
%2362%		! node directly below the  array node to  add the constant  and
%2362%		! the existing address calculation.
%2336%
%2336%		IF NOT STORETARGADDR(.AADDR)
%2336%		THEN
%2336%		BEGIN	! Too big for TARGADDR
%2336%
%2336%			! Reset AADDR
%2336%			AADDR = EXTSIGN(.TREEPTR[TARGADDR]);
%2336%
%2360%			! Make a constant with the large IDADDR.
%2411%			CONSTTERM =  MAKECNST(INTEGER,0,.ARRNAME[IDADDR]);
%2336%
%2360%			! If there  is no  address  expression, then  make  the
%2360%			! IDADDR the address  calculation.  Otherwise, make  an
%2360%			! add node with  the current address  calc and the  new
%2360%			! constant.
%2360%
%2361%			IF .ADDRNODE EQL 0
%2361%			THEN
%2362%			BEGIN	! No address node
%2361%				TREEPTR[ARG2PTR] = ADDRNODE = .CONSTTERM;
%2362%				TREEPTR[A2VALFLG] = 1;
%2362%			END	! No address node
%2360%			ELSE
%2362%			BEGIN	! Address node exists
%2362%
%2362%				! Create add node with constant
%2362%
%2336%				TREEPTR[ARG2PTR] = ADDRNODE = MAKPR1( .TREEPTR,
%2336%					ARITHMETIC, ADDOP, INDEX,
%2360%					.CONSTTERM,
%2336%					.ADDRNODE );
%2362%
%2362%				! Raise flags from  ARRAYREF to  add node  that
%2362%				! was created.  Then clear ARRAYREF's A2 flags.
%2362%
%2362%				ADDRNODE[A2FLGS] = RAISEFLGS(.ADDRNODE[A2FLGS],
%2362%					.TREEPTR[A2FLGS]);
%2362%				TREEPTR[A2FLGS] = 0;
%2362%
%2362%			END;	! Address node exists
%2336%
%2336%		END;	! Too big for TARGADDR
%2336%
%2336%	END;	! Not formal array

	%(***IF THERE IS NO ADDRESS CALCULATION TO BE DONE (ADDR IS A CONSTANT WHICH
		WAS DETECTED AT TIME OF EXPANSION OF THE ARRAY).
		FILL IN CORRECT VAL FOR TARGET FIELD AND RETURN.
	*******)%
	IF .ADDRNODE EQL 0
	THEN
	BEGIN
		TREEPTR[A2IMMEDFLG] = 1;
%1766%		TREEPTR[TARGADDR] = .AADDR;
		RETURN 0
	END;


	! If the array offset address calculation is a constant,  then
	! we may not need runtime address calculation.  May be able to
	! add the constant into the array ref's TARGADDR.

%1766%	IF AROFCONST(.TREEPTR, .TREEPTR, .ADDRNODE, .AADDR)
%1766%	THEN
%1766%	BEGIN	! Constant optimized into TARGADDR

		TREEPTR[ARG2PTR] = 0;	! Zero subscript list

		RETURN 0		! No registers needed
%1766%	END;

	! If the variable part of the  address is a common sub set  flag
	! indicating "this cs used as  a subscript" (this will cause  it
	! to get priority for a register)

	IF .ADDRNODE[OPRCLS] EQL CMNSUB
	THEN ADDRNODE[CSSSFLG]_1;


	! If offset  address  computation is  a  sum, try  to  take  any
	! constant pieces  out  of  the expression  and  add  them  into
	! TARGADDR in the array ref node.

	CONSTTERM = .ADDRNODE[ARG1PTR];

	IF .ADDRNODE[OPR1] EQL ADDOPF
	THEN
	BEGIN	! Offset address computation is a sum

		! +-------------+
		! | ARRAYREF	|
		! +-------------+
		!		\
		!		 V
		!		+-------+
		!		| +	|
		!		+-------+

%1766%		IF .CONSTTERM[OPR1] EQL CONSTFL
%1766%		THEN
%1766%		BEGIN	! Arg1 is constant

			!	+-------+
			!	| +	|
			!	+-------+
			!	 /
			!	V
			! +-------------+
			! | constant	|
			! +-------------+

%1766%			IF AROFCONST(.TREEPTR,.ADDRNODE,.CONSTTERM,.AADDR)
%1766%			THEN
%1766%			BEGIN	! Try to optimize arg1

%1766%				! If 2nd argument to  the plus node  can
%1766%				! be optimized in, then there isn't  any
%1766%				! expression  to  calculate.   Otherwise
%1766%				! substitute  arg2   for   the   address
%1766%				! calculation.

%2463%				IF .TREEPTR[OPERSP] EQL ARREFSMALL
%2362%				THEN AADDR = EXTSIGN(.TREEPTR[TARGADDR])
%2463%				ELSE			! Large, offset in CTE
%2463%				BEGIN	! ARREFBIG
%2463%					AADDR = .TREEPTR[TARGADDR];	! CTE
%2463%					AADDR = .AADDR[CONST2];	! Actual offset
%2463%				END;	! ARREFBIG

%1766%				IF AROFCONST(.TREEPTR, .ADDRNODE,
%1766%					.ADDRNODE[ARG2PTR], .AADDR)
%1766%				THEN
%2362%				BEGIN	! Constant was opt into ARRAYREF
%2362%
%1766%					TREEPTR[ARG2PTR] = 0;	! No subscripts

					! A2VALFLG - true (Don't let CGETVAL
					!	recurse on NIL pointer)
					! A2NOTFLG - false (It *is* false)
					! A2NEGFLG - false (It *is* false)
					! A2SAMEFLG - false (I hope)
					! A2IMMEDFLG - true (Tradition)

%2362%					TREEPTR[A2FLGS] = 0;	! Clear all
%2466%					TREEPTR[A2VALFLG]	! Set some
%2466%						= TREEPTR[A2IMMEDFLG] = 1;

%2466%					SAVSPACE(EXSIZ-1,.ADDRNODE);	! Del +
%2466%					RETURN 0;	! Complexity of 0
%2362%				END	! Constant was opt into ARRAYREF
%1766%				ELSE
%1766%				BEGIN	! NOT OPT
%1766%					TREEPTR[ARG2PTR] = .ADDRNODE[ARG2PTR];
%1766%					TREEPTR[A2FLGS] = RAISEFLGS(
%1766%						.TREEPTR[A2FLGS],
%1766%						.ADDRNODE[A2FLGS]);
%1766%					! Delete plus node
%1766%					SAVSPACE(EXSIZ-1,.ADDRNODE);
%1766%				END;	! NOT OPT
%1766%			END	! Try to optimize arg1
%1766%			ELSE		! Can't optimize arg1
%1766%			BEGIN	! Try to optimize arg2.
%1766%
%2012%				IF AROFCONST(.TREEPTR, .ADDRNODE,
%2012%					.ADDRNODE[ARG2PTR], .AADDR)
%1766%				THEN
%1766%				BEGIN	! Optimization succeeds.  Delete
%1766%					! plus node and  have the  array
%1766%					! ref point to arg1 instead.
%1766%
%1766%					TREEPTR[ARG2PTR] = .ADDRNODE[ARG1PTR];
%2362%					TREEPTR[A2FLGS] = RAISEFLGS(
%2362%						.TREEPTR[A2FLGS],	! Copy
%2362%						.ADDRNODE[A1FLGS]);	! flags
%2362%
%1766%					SAVSPACE(EXSIZ-1,.ADDRNODE);	! Del +
%1766%				END
%1766%				ELSE	! Neither arg1 nor arg2 stored
%1766%					TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766%			END;	! Try to optimize arg2.
%1766%
%1766%		END	! Arg1 is constant
%1766%		ELSE
%1766%		BEGIN	! Plus node's arg1 is not a constant

			! If address computation is  a sum, search  down
			! the N-ary sum for the constant term (which the
			! canonicalizer will have left at bottom  left).
			! Try to extract this term from the tree and put
			! it in the target field.

			IF .CONSTTERM[OPR1] EQL ADDOPF
			THEN
			BEGIN	! ARG1 is add node


%2411%				! Set to top ADD node to search down...
%2411%				CONSTTERM = .ADDRNODE;

 				! If there is  a constant-term, it  will
 				! be the first non-plus node reached.
%2411%				! If a neg or not flag exists, then we
%2411%				! can't do this optimization, since the
%2411%				! constant must be negated or notted.

				DO
				BEGIN	! Set parent and possible constant

					PAROFCONST_.CONSTTERM;
					CONSTTERM_.CONSTTERM[ARG1PTR];

				END	! Set parent and possible constant
				WHILE
%2411%				BEGIN	! Condition to loop

					.CONSTTERM[OPR1] EQL ADDOPF
%2411%					AND NOT (.PAROFCONST[A1NOTFLG] OR
%2411%						.PAROFCONST[A1NEGFLG])
%2411%
%2411%				END;	! Condition to loop

				! Check if we can store in TARGADDR.  CONSTTERM
				! is now the first non-plus node seen.

%1766%				IF AROFCONST(.TREEPTR, .PAROFCONST,
%1766%					.CONSTTERM, .AADDR)
%1766%				THEN
%1766%				BEGIN	! The offset stored in TARGADDR

					! Remove the constant node  from
					! the tree, linking its  brother
					! under  its  parent   plus-node
					! directly to  its  grand-parent
					! plus-node

					GPOFCONST _ .PAROFCONST[PARENT];
					GPOFCONST[A1FLGS] _
						RAISEFLGS(.GPOFCONST[A1FLGS],
						.PAROFCONST[A2FLGS]);
					GPOFCONST[ARG1PTR] _ .PAROFCONST[ARG2PTR];

%1766%					! Delete the plus node containing
%1766%					! the constant we're not using.
%1766%					SAVSPACE(EXSIZ-1,.PAROFCONST);
%1766%
%1766%				END	! The offset stored in TARGADDR
%1766%				ELSE	! Not stored
%1766%					TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766%			END	! ARG1 is add node
%1766%			ELSE	! Not add node
%1766%				TREEPTR[TARGADDR] = .AADDR;
%1766%
%1766%		END;	! Plus node's arg1 is not a constant
%1766%
%1766%	END	! Address computation is a sum
%1766%	ELSE	! Not sum
%1766%		TREEPTR[TARGADDR] = .AADDR;

%1766%	ADDRNODE = .TREEPTR[ARG2PTR];	! Reset address calculation node

	END	! NON-CHARACTER
%1253%	ELSE
%1253%	BEGIN	! [1253] CHARACTER

		IF .ADDRNODE EQL 0 	! IF SUBSCRIPT IS CONSTANT AND HAS
		THEN			! BEEN FOLDED INTO BASE (NYI),
		RETURN 1;		! IT REQUIRES 1 REGISTER

		IF .ADDRNODE[OPR1] EQL CONSTFL
		THEN
		PRCNSTARG(.TREEPTR,.ADDRNODE,FALSE);

	END;	! [1253] CHARACTER


	%(***IF THE VARIABLE PART OF THE ADDR IS A SINGLE VAR, THEN IF IT
		COULD BE LEFT IN A REG EARLIER DO SO AND IF ITS NEEDED LATER THEN
		LEAVE ITS REG  ALONE AFTER EXECUTION OF THIS STMNT***)%
	IF .TREEPTR[A2VALFLG]
	THEN
	BEGIN
		SAVREGCONTAINING(.ADDRNODE);    !SAVE THE REG FROM PREV REF
%2411%		IF .ARRNAME[VALTYPE] NEQ CHARACTER	!IF NON-CHARACTER
		THEN ADDREGCANDATE(.ADDRNODE,.TREEPTR); !IF NEED THE REG LATER, CAN USE IT
						! FROM THIS REF
	END;


	%(***FIND THE NUMBER OF REGISTERS NECESSARY TO COMPUTE THE ADDRESS,
		THE COMPLEXITY OF THE ARRAYREF NODE IS 1 IF 0 REGS ARE NEEDED, OTHERWISE
		IT IS EQUAL TO THE NUMBER OF REGS NEEDED*****)%
	IF .TREEPTR[A2VALFLG]
	THEN CMPLX1_1
	ELSE
	BEGIN
		TREEPTR_.ADDRNODE;
		CMPLX1_SETCOMPLEXITY();
		%(**IF THERE IS A REFERENCE TO LHS OF ASSIGNMENT STMNT SOMEWHERE IN THE
			ADDRESS CALCULATION, SET FLAG IN THE ARRAYREF NODE***)%
		IF .ADDRNODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
		IF .ADDRNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
	END;


%1253%	IF .CNODE[DBLFLG]
	THEN
	BEGIN
		%(***CONVERT CMPLX1 FROM NUMBER OF REGS TO NUMBER OF PAIRS***)%
		CMPLX1_(.CMPLX1+1)/2;

		%(***FOR A DOUBLE-WD ARRAY-REF - ALWAYS NEED AT LEAST 3 REGS TO
			GET THE VALUE LOADED (SINCE CANT LOAD IT INTO THE
			REG USED FOR THE INDEX). HENCE NEED AT LEAST 2 PAIRS***)%
		IF .CMPLX1 LSS 2 THEN CMPLX1_2;
	END
	%(***FOR A SINGLE-WD ARRAYREF - ALWAYS NEED AT LEAST 1 REG***)%
	ELSE	IF .CMPLX1 EQL 0 THEN CMPLX1_1;


%2244%	! If array is in .LARG.  and the address calculation  expression
%2244%	! is a register containing an AOBJN count, then must must add  a
%2244%	! STORECLS node between the  arrayref and the regcontents  nodes
%2244%	! to copy the right half of the AOBJN count to another register.
%2244%
%2244%	CMPAOBJN = 0;	! No added complexity yet.
%2244%
%2244%	IF .DOWDP NEQ 0				! Within inner DO loop
%2411%	THEN IF .ARRNAME[VALTYPE] NEQ CHARACTER	! and not character array
%2244%	THEN IF .CDONODE[FLCWD]			! and DO is AOBJN
%2411%	THEN IF (.ARRNAME[IDPSECT] EQL PSLARGE	! and .LARG. PSECT
%2464%		OR .TREEPTR[OPERSP] EQL ARREFBIG)	! or large ARRAYREF
%2244%	THEN					! Yep, don't AOBJN index EFIW
%2244%	BEGIN	! MOBY
%2244%
%2244%		! Decide who might point to  the AOBJN.  If the  address
%2244%		! calc is a common  sub, then the  AOBJN would be  under
%2244%		! it.
%2244%
%2244%		IF .ADDRNODE[OPRCLS] EQL CMNSUB
%2244%		THEN	AOBJNPTR = .ADDRNODE	! Common subexpresion node
%2244%		ELSE	AOBJNPTR = .CNODE;	! Array node
%2244%
%2244%		! Check if the array's  address calculation is the  same
%2244%		! as the REGCONTENTS node used for the AOBJN instruction
%2244%		! in the  DO  statement.   If so,  then  we  insert  our
%2244%		! STORECLS node.
%2244%
%2244%		IF .AOBJNPTR[ARG2PTR] EQL .DOWDP[DOREGPTR]
%2244%		THEN
%2244%		BEGIN	! Address calc is DO AOBJN register
%2244%
%2244%			! Make a STRHAOBJN node to copy the right half ac
%2244%			! into another register.
%2244%
%2244%			AOBJNPTR[ARG2PTR] = AOBJNSTORNODE =
%2244%				MAKPR1(.AOBJNPTR, STORECLS, STRHAOBJN, INDEX,
%2244%					0, .AOBJNPTR[ARG2PTR]);
%2244%
%2244%			AOBJNSTORNODE[COMPLEXITY] = 1;
%2244%
%2244%			! Copy flags from pointer to new node.  Clear the
%2244%			! pointer's A2VALFLG and A2IMMEDFLG.
%2244%
%2244%			AOBJNSTORNODE[A2FLGS] = .AOBJNPTR[A2FLGS];	! Copy
%2244%
%2244%			AOBJNPTR[A2VALFLG] = 0;		! No longer is DATAOPR
%2244%			AOBJNPTR[A2IMMEDFLG] = 0;	! No longer is immed
%2244%			AOBJNPTR[A2SAMEFLG] = 1;	! Target (reg) same
%2244%
%2244%			IF .AOBJNPTR[OPRCLS] NEQ CMNSUB
%2244%			THEN CMPAOBJN = 1;	! Extra register needed.
%2244%
%2244%		END;	! Address calc is DO AOBJN register
%2244%
%2244%	END;	! MOBY

%2244%	RETURN (.CMPLX1 + .CMPAOBJN)	! Return complexity calculated

END;	! of CMPLXARRAY
ROUTINE AROFCONST(ARREF,CPARENT,CONST,AADDR)=	![1766] New
BEGIN
!++
! FUNCTIONAL DESCRIPTION:
!
!	Attempts to optimize  a given constant  from an array  reference
!	offset calculation into TARGADDR in the array reference node. If
!	the constant  will  not  fit  into TARGADDR  or  if  the  passed
!	expression is not a constant, then the array's TARGADDR field is
!	unchanged.
!
! FORMAL PARAMETERS:
!
!	ARREF		The array reference node.
!
!	CPARENT		CONST's parent.  Flags and TARGADDR in this node
!			may be changed.
!
!	CONST		Offset to try to store.  This must be a constant,
!			else nothing to do.
!
!	AADDR		Address so far calculated.
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	Returns	True	if offset is stored in TARGADDR
!		False	if not.
!
! Side Effects:
!
!	None
!
!--

	MAP	BASE AADDR,
		BASE ARREF,
		BASE CONST,
		BASE CPARENT;

	REGISTER
		BASE	ARROFFSET;	! Calculated array offset


	! Check if the offset expression is a constant

	IF .CONST[OPR1] EQL CONSTFL
	THEN
	BEGIN	! Have a constant

		! Set parent's flags indicating  a leaf below  depending
		! on  whether  it's   arg1  or  arg2   for  the   parent
		! expression.

		IF .CONST EQL .CPARENT[ARG1PTR]
		THEN CPARENT[A1VALFLG] = 1
		ELSE CPARENT[A2VALFLG] = 1;

		! Calculate the offset for this constant

		ARROFFSET = .AADDR + .CONST[CONST2];

		! Try to optimize if the offset will fit in TARGADDR
		! correctly (what we put in will come out).

		IF STORETARGADDR(.ARROFFSET)
		THEN
		BEGIN	! Put offset in

			ARREF[TARGADDR] = .ARROFFSET;	! Put in offset

			! Set parent's flags indicating a constant
			! usable with an immediate instruction
			! (depending on whether it's arg1 or arg2 for
			! the parent expression).

			IF .CONST EQL .CPARENT[ARG1PTR]
			THEN CPARENT[A1IMMEDFLG] = 1
			ELSE CPARENT[A2IMMEDFLG] = 1;

			RETURN TRUE;	! Optimized into TARGADDR

		END	! Put offset in
%2463%		ELSE IF EXTENDED	! No room, EFIWs available?
%2463%		THEN			! Yes, make ARREFBIG
%2464%		BEGIN	! EXTENDED

			! Flag TARGADDR change and store offset constant

%2463%			ARREF[OPERSP] = ARREFBIG;
%2463%			ARREF[TARGADDR] = MAKECNST(INTEGER,0,.ARROFFSET);

			! Set parent's flags indicating a constant
			! useable with an immediate instruction
			! (depending on whether it's arg1 or arg2 for
			! the parent expression).

%2463%			IF .CONST EQL .CPARENT[ARG1PTR]
%2463%			THEN CPARENT[A1IMMEDFLG] = 1
%2463%			ELSE CPARENT[A2IMMEDFLG] = 1;

%2463%			RETURN TRUE;	! Stored in TARGADDR (sort of)
%2464%		END	! EXTENDED
%2463%		ELSE PRCNSTARG(.CPARENT, .CONST,	! No EFIWs, allocate
			(.CPARENT[ARG1PTR] EQL .CONST) );	! constant
	END;	! Have a constant

	! If we get here, we're not optimizing the offset

	RETURN FALSE;

END;	! of AROFCONST
GLOBAL ROUTINE CMPILF=
%(***************************************************************************
	The complexity pass for an in-line-function node.

	Number of regs needed  is max of the following:
		1. Number of regs needed to compute ARG1
		2. 1+number of regs needed for computing ARG2

	For MOD and CHAR, we need 1 more reg for calculating the result.
***************************************************************************)%
BEGIN
	LOCAL
		PEXPRNODE ARG1NODE,	! ARG1PTR from CNODE
		PEXPRNODE ARG2NODE,	! ARG2PTR from CNODE
	 	CMPLX1,			! Complexity of arg 1
		CMPLX2;			! Complexity of arg 2
	REGISTER
		PEXPRNODE CNODE;	! Inline function node


	CNODE_.TREEPTR;
	ARG1NODE_.CNODE[ARG1PTR];
	ARG2NODE_.CNODE[ARG2PTR];

	%(***FOR CMPLX - USE CMPLA***)%

	IF .CNODE[OPERSP] EQL CMPLXFN THEN
	RETURN
	BEGIN
		IF (CMPLX1_CMPLA()) GTR 2 THEN .CMPLX1 ELSE 2
	END;


	%(***FOR MAX AND MIN - IF ONE OF THE ARGS IS A REAL OR  NEGATIVE
		CONSTANT, LET ARG1  BE THAT ARG  (SINCE HAVE PROBS  WITH
		COMPARE-IMMED FOR REAL AN NEG CNSTS)***)%

	IF .CNODE[OPERSP] EQL MAXFN  OR .CNODE[OPERSP] EQL MINFN
	THEN
	BEGIN
		IF .ARG2NODE[OPR1] EQL CONSTFL
			AND .ARG1NODE[OPR1] NEQ CONSTFL
			AND NOT .CNODE[A1NEGFLG]
		THEN
		BEGIN
			IF .ARG2NODE[VALTP1] NEQ INTEG1 OR .ARG2NODE[CONST2] LSS 0
			THEN
			BEGIN
				SWAPARGS(CNODE);	!EXCHANGE THE 2 PTRS AND ALSO THE FLAGS THAT GO WITH
							! THE 2 ARGS
				ARG1NODE_.CNODE[ARG1PTR];
				ARG2NODE_.CNODE[ARG2PTR];
			END
		END
	END;


	%(***PERFORM COMPLEXITY ANALYSIS FOR ARG1***)%

	%(******************************)%
	%(***PROCESS 1st ARG************)%
	%(******************************)%

%2401%	! See if we  have a  substring which  can be  replaced with  a
%2401%	! .Dnnnn compile time constant descriptor.
%2401%
%2401%	CNODE[ARG1PTR] = TREEPTR = ARG1NODE = DOTDCHECK(.ARG1NODE);
%2401%
%2401%	IF .ARG1NODE[OPRCLS] EQL DATAOPR	! In case it changed,
%2401%	THEN CNODE[A1VALFLG] = 1;		! get val flag right

	%(***IF ARG1 IS AN IMMED CNST SET A1IMMEDFLG, IF IT IS
		A NON-IMMED CNST, ALLOCATE CORE FOR IT***)%
	IF .ARG1NODE[OPR1] EQL CONSTFL
	THEN (PRCNSTARG(.CNODE,.CNODE[ARG1PTR],TRUE); 
		CMPLX1_0)
	ELSE
	IF .CNODE[A1VALFLG]
	THEN
	BEGIN
		%(***IF ARG IS RESULT NAME, SET RESRFFLG***)%
		IF .ARG1NODE EQL .RESNAME THEN CNODE[RESRFFLG]_1;

		CMPLX1_0
	END
	ELSE
	BEGIN	! Non-zero complexity

		CMPLX1_SETCOMPLEXITY();

		! Set flags for  "FNCALLS present under  this node"  and
		! for ref to result under this node
		IF .ARG1NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
		IF .ARG1NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;


%1567%		! If the node and arg  differ in being either single  or
%1567%		! double, then convert that  complexity figured for  the
%1567%		! argument to the mode of the parent.
%1567%
%1567%		IF .CNODE[DBLFLG] AND NOT .ARG1NODE[DBLFLG]
%1567%		THEN	CMPLX1 = (.CMPLX1+1) ^ (-1)	! divide by 2
%1567%		ELSE	IF NOT .CNODE[DBLFLG] AND .ARG1NODE[DBLFLG]
%1567%			THEN CMPLX1 = .CMPLX1 ^ 1;	! Mult by 2

	END;	! Non-zero complexity


	! For fns other than ABS if val of ARG1 can be left in a reg  in
	! a previous  statment, bb  allocator should  do so.  (Character
	! args can't)

	IF .CNODE[OPERSP] NEQ ABSFN THEN
%1567%	IF  .ARG1NODE[VALTYPE] NEQ CHARACTER
	THEN SAVREGCONTAINING(.ARG1NODE);


%1567%	! Now that we know whether  the first argument has any  function
%1567%	! calls beneath it, if LEN has an  array ref for an arg, we  can
%1567%	! simplify the argument to be the array name and not go  through
%1567%	! any calculation for the array element.

%1567%	IF .CNODE[OPERSP] EQL LENFN THEN
%1567%	IF .ARG1NODE[OPRCLS] EQL ARRAYREF THEN
%1567%	IF NOT .ARG1NODE[FNCALLSFLG]
%1567%	THEN
%1567%	BEGIN
%1567%		CNODE[ARG1PTR] = .ARG1NODE[ARG1PTR];	! Array name
%1567%		RETURN	CMPLX1 = 1;	! Array names aren't complex
%1567%	END;


	%(******************************)%
	%(***PROCESS 2ND ARG************)%
	%(******************************)%

	IF .ARG2NODE NEQ 0
	THEN
	BEGIN
%2401%		! See if we  have a  substring which  can be  replaced
%2401%		! with a .Dnnnn compile time constant descriptor.
%2401%
%2401%		CNODE[ARG2PTR] = TREEPTR = ARG2NODE = DOTDCHECK(.ARG2NODE);
%2401%
%2401%		IF .ARG2NODE[OPRCLS] EQL DATAOPR	! In case it changed,
%2401%		THEN CNODE[A2VALFLG] = 1;		! get val flag right

		%(***FOR ARG2 AN IMMED CNST, SET A2IMMEDFLG EXCEPT
			IN THE CASES OF AMAX AND AMIN (SINCE CANT DO COMPARE IMMED
			FOR A REAL) AND IN THE (UNLIKELY!) CASE OF SIGN***)%
		IF .ARG2NODE[OPR1] EQL CONSTFL
		THEN
		BEGIN
			IF .CNODE[OPERATOR] EQL AMAXFNOP OR .CNODE[OPERATOR] EQL AMINFNOP
				OR .CNODE[OPERATOR] EQL DIMFNOP
				OR .CNODE[OPERSP] EQL SIGNFN
			THEN
			ALOCONST(.ARG2NODE)
			ELSE
			IF IMMEDCNST(ARG2NODE)
			THEN
			BEGIN
				IF .ARG2NODE[VALTP1] EQL INTEG1 AND .ARG2NODE[CONST2] LSS 0
				THEN ALOCONST(.ARG2NODE)
				ELSE
				CNODE[A2IMMEDFLG]_1;
			END
			ELSE ALOCONST(.ARG2NODE);

			CMPLX2_1;
		END

		ELSE
		IF .CNODE[A2VALFLG]
		THEN
		BEGIN
			IF .ARG2NODE EQL .RESNAME 
%730%			THEN CNODE[RESRFFLG]_1;

			CMPLX2_1;
		END

		ELSE
		BEGIN
			CMPLX2_SETCOMPLEXITY()+1;

			IF .ARG2NODE[RESRFFLG] THEN CNODE[RESRFFLG]_1;
			IF .ARG2NODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG]_1;
		END;
	END
	ELSE CMPLX2_1;

%1567%	! If the node and arg differ  in being either single or  double,
%1567%	! then convert that complexity figured  for the argument to  the
%1567%	! mode of the parent.
%1567%
%1567%	IF .ARG2NODE NEQ 0 THEN
%1567%	IF .CNODE[DBLFLG] AND NOT .ARG2NODE[DBLFLG]
%1567%	THEN	CMPLX2 = (.CMPLX2+1) ^ (-1)	! divide by 2
%1567%	ELSE	IF NOT .CNODE[DBLFLG] AND .ARG2NODE[DBLFLG]
%1567%		THEN CMPLX2 = .CMPLX2 ^ 1;	! Mult by 2

	%(***IF ARG1 WILL BE COMPUTED INTO RETREG (FN RETURN REGISTER), THEN
		1. IF ARG2 INCLUDES FN CALLS, THEN CANNOT COMPUTE ARG1 INTO
		  RETREG. UNDO THE ALLOCATION.
		2. OTHERWISE, COMPUTE THE PARENT INTO RETREG ALSO
	**********)%
	IF NOT .CNODE[A1VALFLG] AND .ARG1NODE[ALCRETREGFLG]
	THEN
	BEGIN
		IF NOT .CNODE[A2VALFLG] AND .ARG2NODE[FNCALLSFLG]
		THEN
		BEGIN
			%(***UNDO THE ALLOCATION OF ARG1 TO RETREG (SINCE RETREG
				WILL BE CLOBBERED WHILE COMPUTING ARG2)***)%
			ARG1NODE[ALCRETREGFLG]_0;
			ARG1NODE[A1SAMEFLG]_0;
			ARG1NODE[A2SAMEFLG]_0;
			ARG1NODE[INREGFLG]_0;
		END
		ELSE
		BEGIN
			%(***ALLOCATE CNODE TO BE COMPUTED IN RETREG***)%
			CNODE[TARGTAC]_RETREG;
			CNODE[INREGFLG]_1;
			CNODE[A1SAMEFLG]_1;
			CNODE[ALCRETREGFLG]_1;
		END;
	END;


	IF .CMPLX2 GTR .CMPLX1	! Return whichever complexity is greater.
	THEN	CMPLX1_.CMPLX2;

	! Return the complexity  computed.  MOD  and CHAR  each need  an
	! extra register for computation.

	IF .CNODE[OPERSP] EQL MODFN
	THEN RETURN .CMPLX1+1
	ELSE RETURN .CMPLX1;

END;	! of CMPILF


ROUTINE CMPLXSUBSTR=			![1431] New

%(**********************************************************************

**********************************************************************)%

BEGIN
	REGISTER PEXPRNODE CNODE:ARGNODE;
	LOCAL CMPLX1:CMPLX2:CMPLX4;

	! Save pointer to substring node in CNODE
	CNODE = .TREEPTR;

	! Do arg 2, lower bound - 1 expression
	ARGNODE = .CNODE[ARG2PTR];		! Point to expression node
	IF .CNODE[A2VALFLG]
	THEN
	BEGIN	! simple variable
		CMPLX2 = 0;			! Complexity of a scalar is 0
		IF .ARGNODE EQL .RESNAME	! Set RESRFFLG if this arg
		THEN CNODE[RESRFFLG] = 1;	!   matches global RESNAME

		IF .ARGNODE[OPR1] EQL CONSTFL	! If it's constant, either set
		THEN PRCNSTARG(.CNODE,.ARGNODE,FALSE); ! IMMEDFLG or allocate
						! the constant

		SAVREGCONTAINING(.ARGNODE);	! Request that it be saved if
						! it's available in an AC.
	END	! simple variable
	ELSE
	BEGIN	! expression
		TREEPTR = .ARGNODE;		! Set TREEPTR to the expression
		CMPLX2 = SETCOMPLEXITY();	! Compute its complexity

		IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1;    ! Propagate
		IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags

%2052%		! Never allocate the lower bound node to RETREG (AC 0)
%2052%		! even if it's  a function  call node  since we  would
%2052%		! have to move it out of  AC 0 before doing the  ADJBP
%2052%		! anyway.  If anything is to land  in AC 0, let it  be
%2052%		! the upper bound expression.
%2052%
%2052%		IF .ARGNODE[ALCRETREGFLG]
%2052%		THEN
%2052%		BEGIN	! ALCRETREGFLG
%2052%
%2052%			ARGNODE[ALCRETREGFLG] = 0;
%2052%			ARGNODE[A1SAMEFLG] = 0;
%2052%			ARGNODE[A2SAMEFLG] = 0;
%2052%			ARGNODE[INREGFLG] = 0;
%2052%
%2052%		END;	! ALCRETREGFLG

	END;

	! Do arg 1, upper bound expression
	ARGNODE = .CNODE[ARG1PTR]; 		! Point to expression node
	IF .CNODE[A1VALFLG]
	THEN
	BEGIN	! simple variable
		CMPLX1 = 0;			! Complexity of a scalar is 0
		IF .ARGNODE EQL .RESNAME	! Set RESRFFLG if this arg
		THEN CNODE[RESRFFLG] = 1;	!   matches global RESNAME

		IF .ARGNODE[OPR1] EQL CONSTFL	! If it's constant, either set
		THEN PRCNSTARG(.CNODE,.ARGNODE,TRUE); ! IMMEDFLG or allocate
						! the constant

		SAVREGCONTAINING(.ARGNODE);	! Request that it be saved if
						! it's available in an AC.
	END	! simple variable
	ELSE
	BEGIN	! expression					
		TREEPTR = .ARGNODE;		! Set TREEPTR to the expression
		CMPLX1 = SETCOMPLEXITY();	! Compute its complexity

		IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1;    ! Propagate
		IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags
	END;	! expression

	! If we have substring of an arrayref, do subscript expression
	ARGNODE = .CNODE[ARG4PTR];		! Point to base variable of
						! substring, must be DATAOPR or
						! ARRAYREF
	IF .ARGNODE[OPRCLS] EQL DATAOPR
	THEN
	BEGIN	! simple variable
		CMPLX4 = 0;			! Complexity of subscript is 0
		IF .ARGNODE EQL .RESNAME	! Set RESRFFLG if variable
		THEN CNODE[RESRFFLG] = 1;	!   matches global RESNAME

		IF .ARGNODE[OPR1] EQL CONSTFL	! If subscript is a constant
		THEN ALOCONST(.ARGNODE);	!   allocate the constant
	END	! simple variable
	ELSE
	BEGIN	! array reference
		TREEPTR = .ARGNODE;		! Point to the ARRAYREF node
		SETCOMPLEXITY();		! Compute its complexity

		TREEPTR = .ARGNODE[ARG1PTR];	! Point to base variable
		IF .ARGNODE EQL .RESNAME	! Check against RESNAME
		THEN CNODE[RESRFFLG] = 1;

		TREEPTR = .ARGNODE[ARG2PTR];	! Point to subscript expression
		CMPLX4 = .TREEPTR[COMPLEXITY];	! Get its complexity

		IF .ARGNODE[RESRFFLG] THEN CNODE[RESRFFLG] = 1;    ! Propagate
		IF .ARGNODE[FNCALLSFLG] THEN CNODE[FNCALLSFLG] = 1; ! flags
	END;

	! Set RVRSFLG in the substring node since code generation will evaluate
	! args in the order ARG2 then ARG1.
	CNODE[RVRSFLG] = 1;

	! The complexity of the substring node is
	!    max (upper, 1+lower, 1+subscript, 2)
	! The various subnodes are all known to be of type integer, so their
	! complexities are in registers (as opposed to register pairs).
	! The complexity of the substring node is in pairs, since character
	! variables have DBLFLG set.  Therefore this expression must be
	! rounded up and divided by 2 to convert it to pairs.  Also, the
	! max-of-2 term can be dropped since the rounding up takes care of it.

	IF .CMPLX2 GEQ .CMPLX1 THEN CMPLX1 = .CMPLX2 + 1;
	IF .CMPLX4 GEQ .CMPLX1 THEN CMPLX1 = .CMPLX4 + 1;
	CMPLX1 _ (.CMPLX1+1)^(-1);

	RETURN .CMPLX1;

END;	! of CMPLXSUBSTR



GLOBAL ROUTINE CMPLIOLST=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY WALK FOR AN IOLIST
	CALLED WITH THE GLOBAL CSTMNT POINTING TO A STATEMENT THAT HAS
	AN IOLIST ASSOCIATED WITH IT.
	CALLED WITH THE GLOBALS STBSYR AND STRGCT
	INDICATING WHICH REGS ARE AVAILABLE FOR USE
	THE COMPLEXITY OF AN IOLIST IS EQUAL TO THE COMPLEXITY OF ITS MOST COMPLEX
	ELEMENT.
***************************************************************************)%
BEGIN
	MAP BASE CSTMNT;
	LOCAL CMPLXMAX,CMPLX1;
	LOCAL BASE IOLELEM;
	LOCAL SAVSTMNT;
	LOCAL SAVPAIRMODE,SAVFNREF;

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

	%(***SAVE PTR TO CURRENT STATEMENT (IF THERE ARE DO-STMNTS IN THE IOLIST
		WILL CLOBBER CSTMNT) ***)%
	SAVSTMNT_.CSTMNT;

	%(***INIT THE COMPLEXITY OF THE IOLOIST TO 0****)%
	CMPLXMAX_0;

	%(****WALK THRU THE  ELEMENTS ON THE IOLOIST*****)%
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN

		IF .IOLELEM[OPRCLS] EQL STATEMENT
		THEN
		BEGIN
			CSTMNT_.IOLELEM;
			SAVPAIRMODE_.PAIRMODE; SAVFNREF_.FNREF;	!(THE GLOBALS "PAIRMODE" AND "FNREF" WILL
					! DESCRIBE THIS SUBSTMNT WHEN WE RETURN FROM CMSTMN - SAVE THEIR
					! OLD VALUES
			CMSTMN();
			PAIRMODE_.SAVPAIRMODE OR .PAIRMODE;	!RESTORE "PAIRMODE" - IT SHOULD
					! GET SET TO "TRUE" IF THIS SUBSTMNT USED ANY PAIRS
			FNREF_.SAVFNREF OR .FNREF;	!RESTORE "FNREF" - IT SHOULD
					! GET SET TO "TRUE" IF THIS SUBSTMNT INCLUDED ANY FN CALLS

			CMPLX1_.CSTMNT[SRCCMPLX];
		END

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

			%(***FOR A DATACALL NODE*******)%
			BEGIN
%2401%				! See if we have a substring which can
%2401%				! be replaced  with a  .Dnnnn  compile
%2401%				! time constant descriptor.
%2401%
%2401%				IOLELEM[DCALLELEM] = TREEPTR =
%2401%					DOTDCHECK(.IOLELEM[DCALLELEM]);

%1202%				IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
				CMPLX1_SETCOMPLEXITY();
				IF ARRNARGBLK(IOLELEM[DCALLELEM],0) THEN
				CMPLX1_0;

			END;

			%(***FOR AN SLISTCALL NODE***)%
			BEGIN
				%(***PERFORM COMPLEXITY PASS FOR THE EXPRESSION TO
					COMPUTE THE NUMBER OF ELEMENTS***)%
				TREEPTR_.IOLELEM[SCALLCT];
%1507%				IF .TREEPTR[OPR1] EQL CONSTFL
%1507%				THEN ALOCONST(.TREEPTR);
%1507%				ALOCONST(.ONEPLIT);
				CMPLX1_SETCOMPLEXITY();
				IF ARRNARGBLK(IOLELEM[SCALLCT],0) THEN
				CMPLX1_0;
			END;

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

			%(***FOR AN E1LISTCALL - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				CMPE1LIST(.IOLELEM);	!SET COMPLEXITY
				SAVCSTMNT_.CSTMNT;	!INCLUDE COMMON SUBS
				CSTMNT_.IOLELEM;	!SET STATEMENT
				STCMCSB();		!INCLUDE COMMON SUBS
				CMPLX1_.IOLELEM[SRCCMPLX];	!SET COMPLEXITY
				CSTMNT_.SAVCSTMNT
			END;

			%(***FOR AN E2LISTCALL - OPTIMIZED CODE ONLY***)%
			BEGIN
				LOCAL BASE SAVCSTMNT;
				CMPE2LIST(.IOLELEM);	!SET COMPLEXITY
				SAVCSTMNT_.CSTMNT;	!INCLUDE COMMON SUBS
				CSTMNT_.IOLELEM;	!SET STATEMENT
				STCMCSB();		!INCLUDE COMMON SUBS
				CMPLX1_.IOLELEM[SRCCMPLX];	!SET COMPLEXITY
				CSTMNT_.SAVCSTMNT
			END

			TES;


			%(***IF THIS ELEMENT OF THE LIST REQUIRES MORE REGS TO
				COMPUTE THAN ANY EARLIER ELEMENTS, SET CMPLXMAX
				TO INDICATE THE NUMBER OF REGS THAT THIS ELEM NEEDS***)%
			IF .CMPLXMAX LSS .CMPLX1 THEN CMPLXMAX_.CMPLX1;
		END;

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

	CSTMNT_.SAVSTMNT;

	CSTMNT[SRCCMPLX]_.CMPLXMAX;

END;	! of CMPLIOLST


GLOBAL ROUTINE CMPIOCALL(IOLSNODE)=
%(***************************************************************************
	ROUTINE TO PERFORM THE COMPLEXITY WALK FOR AN IOLSTCALL NODE.
	THE ARG IOLSNODE POINTS TO THE IOLSTCALL NODE.
	THE NUMBER OF REGS THAT CAN BE USED FOR AN IOLSTCALL NODE
	IS DETERMINED BY:
		1. THE NUMBER OF ITEMS LEFT IN REGS ACROSS THE CALL
		  TO THE OPERATING SYSTEM
		2. THE NUMBER OF REGS NEEDED TO COMPUTE THE EXPRESSIONS
		   WHICH MUST BE COMPUTED PRIOR TO CALLING THE OPERATING SYSTEM
	THE COMPLEXITY OF THIS NODE IS THE MAXIMUM VALUE OF THE SUM OF:
		1. THE NUMBER OF REGS NECESSARY TO COMPUTE A GIVEN EXPRESSION
		2. THE NUMBER OF ITEMS PRECEEDING THIS EXPRESSION THAT WERE
		  LEFT IN REGS
***************************************************************************)%
BEGIN
	MAP BASE IOLSNODE;
	OWN SAVSTMNT;
	OWN CMPLX,REGSINUSE;
	OWN CMPLX1,REG1;
	OWN BASE IOLELEM;

	%(***SAVE PTR TO CSTMNT***)%
	SAVSTMNT_.CSTMNT;

	CMPLX_0;
	REGSINUSE_0;

	IOLELEM_.IOLSNODE[IOLSTPTR];

	%(***WALK THRU THE ELEMENTS OF THE IOLST, KEEPING TRACK OF THE MAX VALUE OF
		THE SUM OF THE COMPLEXITY OF A GIVEN ELEMENT WITH THE NUMBER OF REGS
		BEING USED TO HOLD ELEMS BEFORE IT***)%
	UNTIL .IOLELEM EQL 0
	DO
	BEGIN
		CASE .IOLELEM[OPERSP] OF SET

		%(***FOR A DATACALL NODE***)%
		BEGIN
			OWN PEXPRNODE DELEM;	!EXPRESSION FOR DATA ELEMENT

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

%1202%			IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
			CMPLX1_SETCOMPLEXITY();
			IF ARRNARGBLK(IOLELEM[DCALLELEM],0) THEN CMPLX1_0;
			REG1_(IF .CMPLX1 EQL 0
				THEN 0
				ELSE IF .DELEM[DBLFLG]	!IF THE VAL MUST BE LEFT
							! IN AN EVEN-ODD PAIR
				THEN 2		! TAKE 2 REGS OUT OF SET
				ELSE 1);
		END;

		%(***FOR A SLISTCALL NODE***)%
		BEGIN
			TREEPTR_.IOLELEM[SCALLCT];
%1507%			IF .TREEPTR[OPR1] EQL CONSTFL
%1507%			THEN ALOCONST(.TREEPTR);
%1507%			ALOCONST(.ONEPLIT);
			CMPLX1_SETCOMPLEXITY();
			IF ARRNARGBLK(IOLELEM[SCALLCT],0) EQL 0
			THEN CMPLX1_0;
			REG1_0;		! Never bother to try to leave this
					!  count in a reg (store it in a temp
					!  before calling FOROTS)
		END;

		%(***IOLSTCALL NODE WITHIN AN IOLSTCALL NODE IS ILLEGAL***)%
		CGERR();

		%(***FOR AN E1LISTCALL NODE - OPTIMIZED CODE ONLY***)%

		BEGIN
			CMPLX1_CMPE1LIST(.IOLELEM);
			REG1_0			!NO REGISTERS
		END;

		%(***FOR AN E2LISTCALL NODE - OPTIMIZED CODE ONLY***)%

		BEGIN
			CMPLX1_CMPE2LIST(.IOLELEM);
			REG1_0
		END

		TES;

		IF .REGSINUSE+.CMPLX1 GTR .CMPLX
		THEN CMPLX_.REGSINUSE+.CMPLX1;

		REGSINUSE_.REGSINUSE+.REG1;

		IOLELEM_.IOLELEM[CLINK];
	END;

	IOLSNODE[SRCCMPLX]_.CMPLX;

	%(***PERFORM COMPLEXITY ANALYSIS FOR COMMON SUBEXPRS UNDER THIS IOLSTCALL***)%
	CSTMNT_.IOLSNODE;
	STCMCSB();

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

	RETURN .IOLSNODE[SRCCMPLX];

END;	! of CMPIOCALL



GLOBAL ROUTINE CMPE1LIST(IOLELEM)=
%(**********************************************************************
	COMPUTE THE COMPLEXITY OF AN E1LISTCALL NODE
	(EXCEPT FOR COMMON SUBEXPRESSIONS)
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	LOCAL BASE IOARRAY;
	OWN CMPLX,REGSINUSE,CMPLX1,REG1;

	%(***COMPUTE COMPLEXITY OF COUNT EXPRESSION***)%

%2402%	! Correct AOBJN problems
%2402%
%2402%	IOLELEM[ECNTPTR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[ECNTPTR]);

%1507%	IF .TREEPTR[OPR1] EQL CONSTFL
%1507%	THEN ALOCONST(.TREEPTR);
	CMPLX_SETCOMPLEXITY();		!INITIALIZE COMPLEXITY
	IF ARRNARGBLK(IOLELEM[ECNTPTR],0)
	THEN CMPLX_0;	!RESET IF ARRAYREF IS REPLACED
	REGSINUSE_0;			!INITIALIZE REGISTER COUNT

	%(***ADD IN COMPLEXITY OF INCREMENT EXPRESSION***)%

%2402%	! Correct AOBJN problems
%2402%
%2402%	IOLELEM[E1INCR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[E1INCR]);

%1507%	IF .TREEPTR[OPR1] EQL CONSTFL
%1507%	THEN ALOCONST(.TREEPTR);
	CMPLX1_SETCOMPLEXITY();		!COMPUTE COMPLEXITY
	IF ARRNARGBLK(IOLELEM[E1INCR],0)
	THEN CMPLX1_0;	!RESET OF ARRAYREG IS REPLACED
	REG1_0;				!NEVER SAVE IN A REG
	IF .REGSINUSE +.CMPLX1 GTR .CMPLX
	THEN CMPLX_.REGSINUSE+.CMPLX1;	!UPDATE COMPLEXITY
	REGSINUSE_.REGSINUSE+.REG1;	!UPDATE REGISTER COUNT
	%(***ADD IN COMPLEXITY OF EACH ARRAYREF ON THE LIST***)%

	IOARRAY_.IOLELEM[ELSTPTR];	!LOCATE LIST
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
%2401%		! See if we  have a  substring which  can be  replaced
%2401%		! with a .Dnnnn compile time constant descriptor.
%2401%
%2401%		IOARRAY[E2ARREFPTR] = TREEPTR =
%2401%			DOTDCHECK(.IOARRAY[E2ARREFPTR]);

%1520%		IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
		CMPLX1_SETCOMPLEXITY();	!COMPUTE COMPLEXITY
		IF ARRNARGBLK(IOARRAY[E2ARREFPTR],0) THEN CMPLX1_0;
		REG1_0;				!NEVER IN A REG

		IF .REGSINUSE+.CMPLX1 GTR .CMPLX THEN
		 CMPLX_.REGSINUSE+.CMPLX1;	!UPDATE COMPLEXITY
		REGSINUSE_.REGSINUSE+.REG1;	!UPDATE REGISTER COUNT
		IOARRAY_.IOARRAY[CLINK]	!NEXT ARRAYREF
	END;

	%(***WORK ON THE FINAL VALUE CHAIN (IF ANY)***)%

%1211%	CSTMNT_.IOLELEM[ELPFVLCHAIN];

%1211%	WHILE .CSTMNT NEQ 0 DO
%1211%	BEGIN
%1211%		CMSTMN();	! Complexity of assignment statement
%1211%		IF .CSTMNT[SRCCMPLX] GTR .CMPLX
%1211%			THEN CMPLX_.CSTMNT[SRCCMPLX];
%1211%		CSTMNT_.CSTMNT[CLINK]	! On to the next...
%1211%	END;


	%(***RETURN COMPLEXITY OF E1LISTCALL NODE***)%

	RETURN (IOLELEM[SRCCMPLX]_.CMPLX)

END;	! of CMPE1LIST


GLOBAL ROUTINE CMPE2LIST(IOLELEM)=
%(**********************************************************************
	COMPUTE THE COMPEXITY OF AN E2LISTCALL NODE
	(EXCEPT FOR COMMON SUBEXPRESSIONS)
**********************************************************************)%
BEGIN
	MAP BASE IOLELEM;
	LOCAL BASE IOARRAY;
	OWN CMPLX,REGSINUSE,CMPLX1,REG1;

	%(***COMPUTE COMPLEXITY OF COUNT EXPRESSION***)%

%2402%	! Correct AOBJN problems
%2402%
%2402%	IOLELEM[ECNTPTR] = TREEPTR = FIXAOBJN(.IOLELEM,.IOLELEM[ECNTPTR]);

%1507%	IF .TREEPTR[OPR1] EQL CONSTFL
%1507%	THEN ALOCONST(.TREEPTR);
	CMPLX_SETCOMPLEXITY();		!INITIALIZE COMPLEXITY COUNTER
	IF ARRNARGBLK(IOLELEM[ECNTPTR],0)
	THEN CMPLX_0;
	REGSINUSE_0;			!INITIALIZE REGSISTER COUNTER

	%(***COMPUTE COMPLEXITY OF EACH INCREMENT EXPRESSION***)%

	IOARRAY_.IOLELEM[ELSTPTR];	!INITIALIZE POINTER
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
%2402%		! Correct AOBJN problems
%2402%
%2402%		IOARRAY[E2INCR] = TREEPTR =
%2402%			FIXAOBJN(.IOARRAY,.IOARRAY[E2INCR]);

%1507%		IF .TREEPTR[OPR1] EQL CONSTFL
%1507%		THEN ALOCONST(.TREEPTR);
		CMPLX1_SETCOMPLEXITY();		!COMPUTE COMPLEXITY
		IF ARRNARGBLK(IOARRAY[E2INCR],0) THEN CMPLX1_0;
		REG1_0;				!NEVER SAVE IN A REG
		IF .REGSINUSE+.CMPLX1 GTR .CMPLX
		 THEN .CMPLX_.REGSINUSE+.CMPLX1;	!UPDATE CMPLEXITY
		REGSINUSE_.REGSINUSE+.REG1;		!UPDATE REGISTER COUNT
		IOARRAY_.IOARRAY[CLINK]			!ADVANCE TO NEXT ARRAYREF
	END;

	%(***COMPUTE COMPLEXITY FOR ARRAYREFS***)%

	IOARRAY_.IOLELEM[ELSTPTR];	!INITIALIZE POINTER
	WHILE .IOARRAY NEQ 0 DO
	BEGIN
%2401%		! See if we  have a  substring which  can be  replaced
%2401%		! with a .Dnnnn compile time constant descriptor.
%2401%
%2401%		IOARRAY[E2ARREFPTR] = TREEPTR =
%2401%			DOTDCHECK(.IOARRAY[E2ARREFPTR]);

%1520%		IF .TREEPTR[OPR1] EQL CONSTFL THEN ALOCONST(.TREEPTR);
		CMPLX1_SETCOMPLEXITY();		!COMPUTE COMPLEXITY
		IF ARRNARGBLK(IOARRAY[E2ARREFPTR],0)
		THEN CMPLX1_0;
		REG1_0;				!NEVER SAVE IN A REG
		IF .REGSINUSE+.CMPLX1 GTR .CMPLX
		THEN .CMPLX_.REGSINUSE+.CMPLX1;	!UPDATE CMPLEXITY
		REGSINUSE_.REGSINUSE+.REG1;		!UPDATE REGISTER COUNT
		IOARRAY_.IOARRAY[CLINK]			!ADVANCE TO NEXT ARRAYREF
	END;


	%(***WORK ON THE FINAL VALUE CHAIN (IF ANY)***)%

%1211%	CSTMNT_.IOLELEM[ELPFVLCHAIN];

%1211%	WHILE .CSTMNT NEQ 0 DO
%1211%	BEGIN
%1211%		CMSTMN();	! Complexity of assignment statement
%1211%		IF .CSTMNT[SRCCMPLX] GTR .CMPLX
%1211%			THEN CMPLX_.CSTMNT[SRCCMPLX];
%1211%		CSTMNT_.CSTMNT[CLINK]	! On to the next...
%1211%	END;


	%(***RETURN COMPLEXITY***)%

	RETURN (IOLELEM[SRCCMPLX]_.CMPLX)

END;	! of CMPE2LIST


GLOBAL ROUTINE SNGARGPROP(PARENTNODE,SON)=
%(***************************************************************************
	FOR NODES THAT HAVE ONLY ONE ARGUMENT (TYPE-CONVERSION,NEGNOT,
	SPECIAL OPERATORS), SET RESRFFLG,FNCALLSFLG IN THE PARENT IF
	THEY ARE SET IN THE SON. 
	ALSO, IF THE ARG IS COMPUTED INTO
	THE FN-RESULT REGISTER ("RETREG"), THEN WILL WANT TO COMPUTE
	THE PARENT INTO THE SAME REGISTER (IN MOST CASES).
***************************************************************************)%
BEGIN
	MAP PEXPRNODE PARENTNODE:SON;
	IF .SON[ALCRETREGFLG] AND .SON[INREGFLG] AND .SON[TARGTAC] EQL RETREG
	THEN
	BEGIN
		PARENTNODE[TARGTAC]_RETREG;
		PARENTNODE[INREGFLG]_1;
		PARENTNODE[ALCRETREGFLG]_1;

		%(***SET FLAG IN PARENT INDICATING WHICH ARG IS IN THE SAME REG***)%
		IF .PARENTNODE[ARG1PTR] EQL .SON
		THEN PARENTNODE[A1SAMEFLG]_1
		ELSE PARENTNODE[A2SAMEFLG]_1;
	END;

	IF .SON[RESRFFLG] THEN PARENTNODE[RESRFFLG]_1;
	IF .SON[FNCALLSFLG] THEN PARENTNODE[FNCALLSFLG]_1;

END ;	! of SNGARGPROP


GLOBAL ROUTINE EXCHARGS(CNODE) =
%(***************************************************************************
	ROUTINE TO SWAP THE 1ST AND 2ND ARGS UNDER AN EXPRESSION NODE
	IF POSSIBLE
	CALLED WITH THE ARG "CNODE" POINTING TO THE NODE IN QUESTION
	RETURNS "TRUE" IF A SWAP WAS POSSIBLE, "FALSE" IF NOT
***************************************************************************)%

BEGIN
	MAP PEXPRNODE CNODE;

	%(***SHOULD ONLY CALL THIS ROUTINE FOR NODES OF OPRCLS
		RELATIONAL, BOOLEAN,  ARITHMETIC, OR IN LINE FN*****)%
	IF .CNODE[OPRCLS] GTR ARITHMETIC THEN
	BEGIN
		IF .CNODE[OPRCLS] EQL INLINFN	!FOR IN LINE FNS
		THEN
		BEGIN
			IF .CNODE[OPERSP] EQL MAXFN OR .CNODE[OPERSP] EQL MINFN	!FOR MAX/MIN
										! CAN SWAP ARGS
			THEN (SWAPARGS(CNODE); RETURN TRUE)	!EXCHANGE THE PTRS AND THE FLAGS
			ELSE RETURN FALSE	!FOR OTHER IN LINE FNS CANNOT
		END
		ELSE CGERR()	!IF OPERATOR IS NOT BOOLEAN,REL,ARITH OR IN LINE FN HAVE AN ERROR
	END;


	IF .CNODE[OPR1] EQL DIVOPF OR .CNODE[OPR1] EQL EXPONOPF
	THEN
	RETURN FALSE;

	%(***CANNOT SWAP THE ARGS IF HAVE SUB AND THE NOT FLAG IS ON FOR
		ARG2 (WHICH WOULD NOW NEED TO BE NEGATED) ***)%
	IF .CNODE[OPR1] EQL MULOPF AND .CNODE[A2NOTFLG] 
	THEN RETURN FALSE;


	%(***SWAP THE 2 POINTERS*****)%
	%(****ALSO THE FLAGS CORRESPONDING TO THE 2 ARGS (IE A1NEGFLG WITH A2NEGFLG ETC) ****)%
	SWAPARGS(CNODE);



	%(****FOR SUBTRACTION,COMPLEMENT NEGFLG
		FOR THE ARG THAT WAS MOVED FROM 2ND TO 1ST AND
		CHANGE OPERSP FROM "SUB2 TO "ADD"*******)%
	IF .CNODE[OPR1] EQL SUBOPF
	THEN
	BEGIN
		CNODE[OPR1]_ADDOPF;
		CNODE[A1NEGFLG]_NOT .CNODE[A1NEGFLG];
	END;

	%(****FOR RELATIONALS(EXCEPT EQ AND NE)  REVERSE THE MODE
		OF THE RELATIONAL (EG SET LT TO GT, LE TO GE, ETC)*****)%
	IF .CNODE[OPRCLS] EQL RELATIONAL 
	THEN
	BEGIN
		IF NOT EQREL(.CNODE[OPERSP])
		THEN
		CNODE[OPERSP]_REVREL(.CNODE[OPERSP]);
	END;

	RETURN TRUE;

END;	! of EXCHARGS

GLOBAL ROUTINE DOTDCHECK(EXPR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is passed a pointer to any expression node, EXPR.
!	It then checks to see if EXPR points to a SUBSTRING node  with
!	constant bounds which can be  converted into a .Dnnnn  compile
!	time constant  descriptor.   If  so,  it  creates  the  .Dnnnn
!	descriptor and returns a  pointer to it.   If not, it  returns
!	EXPR.
!
!	In addition,  this routine  also performs  bounds checking  on
!	EXPR (if EXPR points to a SUBSTRING node with a constant upper
!	or lower bound).
!
! FORMAL PARAMETERS:
!
!	EXPR		Pointer to any expression node which may be a
!			SUBSTRING node.
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	If no .Dnnnn is possible, EXPR is returned.
!
!	If EXPR can be converted into a .Dnnnn, a pointer to the .Dnnnn
!	is returned.
!
! SIDE EFFECTS:
!
!	None
!
!--


![2401] New
BEGIN
	MAP BASE EXPR;		! Potentially points to a SUBSTRING node
	REGISTER BASE UNODE;	! Upper bound
	REGISTER BASE LNODE;	! Lower bound minus one
	REGISTER BASE ANODE;	! ARRAYREF or DATAOPR
	REGISTER BASE CHLEN;	! Length of character variable or array element
	LOCAL BASE DVAR;	! Points to the new .Dnnnn variable

	IF .EXPR[OPRCLS] NEQ SUBSTRING THEN RETURN .EXPR;	! Forget it

	UNODE = .EXPR[ARG1PTR];		! Upper bound
	LNODE = .EXPR[ARG2PTR];		! Lower bound minus one
	ANODE = .EXPR[ARG4PTR];		! ARRAYREF or DATAOPR

	! Get the length  of the character  variable or array  element
	! we're taking the substring from.

	IF .ANODE[OPRCLS] NEQ ARRAYREF
	THEN CHLEN = .ANODE[IDCHLEN]	! ANODE is scalar, get its length
	ELSE 
	BEGIN	! ARRAYREF

		CHLEN = .ANODE[ARG1PTR];	! Array name
		CHLEN = .CHLEN[IDCHLEN];	! Length of array element

	END;	! ARRAYREF

	IF .LNODE[OPR1] EQL CONSTFL
	THEN IF .LNODE[CONST2] LSS 0	! Lower bound - 1 must be >= 0
		OR			! and < CHLEN
		(.CHLEN NEQ LENSTAR AND .LNODE[CONST2] GEQ .CHLEN)
	THEN FATLERR(.ISN,E165<0,0>);	! Give bounds error

	IF .UNODE[OPR1] EQL CONSTFL
	THEN
	BEGIN	! Upper bound is constant

		IF .UNODE[CONST2] LSS 1		! Upper bound must be >= 1
			OR			! and <= CHLEN
			(.CHLEN NEQ LENSTAR AND .UNODE[CONST2] GTR .CHLEN)
		THEN FATLERR(.ISN,E165<0,0>);	! Give bounds error

		IF .LNODE[OPR1] EQL CONSTFL
		THEN
		BEGIN	! Upper and lower bounds are both constant

			! Give a bounds error if the lower bound minus
			! one  is  >=  the  upper  bound  (i.e.,   the
			! user-specified lower  bound is  > the  upper
			! bound).  Also avoid creating a .Dnnnn, since
			! a  length  which  is  <=  0  will  cause  an
			! internal compiler error in HSDDESC.

			IF .LNODE[CONST2] GEQ .UNODE[CONST2]
			THEN FATLERR(.ISN,E165<0,0>)	! Give bounds error

			! Both bounds are constant, and the  substring
			! length  is  >  0.   We  can  now  turn   the
			! reference  into   a  .Dnnnn   compile   time
			! constant descriptor if the base variable  is
			! a simple (non-formal) scalar.

			ELSE IF .ANODE[OPR1] EQL VARFL	
			THEN IF NOT .ANODE[IDATTRIBUT(DUMMY)]
			THEN
			BEGIN	! .Dnnnn material

				! We can  create and  return a  .Dnnnn
				! variable.  First create it.

				DVAR = NEWDVAR(1);

				! Now set the base address (IDADDR) to
				! point back to the original variable.
				! Also fill in the length and  offset.

				DVAR[IDADDR] = .ANODE;
				DVAR[IDCHLEN] = .UNODE[CONST2]-.LNODE[CONST2];
				DVAR[IDBPOFFSET] = .LNODE[CONST2];

				RETURN .DVAR;	! Success, return the .Dnnnn

			END;	! .Dnnnn material

		END;	! Upper and lower bounds are both constant

	END;	! Upper bound is constant

	RETURN .EXPR;	! We couldn't create a .Dnnnn

END;	! of DOTDCHECK

ROUTINE FIXAOBJN(PARNT,EXPR) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called  to see if EXPR  will be taken from  an
!	AOBJN register.  This can happen if EXPR is a REGCONTENTS node
!	or a  CMNSUB node  in a  chain  of CMNSUB  nodes ending  in  a
!	REGCONTENTS node,  where the  REGCONTENTS  node is  the  AOBJN
!	register for the current, innermost DO-loop.
!
!	If this is  the case,  a STRHAOBJN node  is inserted  directly
!	above the REGCONTENTS node.  In  any case, pointer to the  new
!	top-level expression  is returned.   It  is assumed  that  the
!	caller will  link  in  the returned  expression  and  set  any
!	necessary flags in the parent.
!
!	Note that  EXPR  must  not appear  in  a  higher-level  common
!	subexpression node, since  it is assumed  that the  complexity
!	walk hasn't reached the common subexpressions for the  current
!	statement yet.  Otherwise, the  complexity for the  additional
!	STRHAOBJN node might not be set.
!
! FORMAL PARAMETERS:
!
!	PARNT		The parent of EXPR.  This  is used to set  the
!			parent field  of  the SRHAOBJN  node  if  EXPR
!			itself is an AOBJN REGCONTENTS node.
!
!	EXPR		The pointer to the expression which mustn't be
!			taken from an AOBJN register.
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	A pointer to an expression equivalent to EXPR but which  won't
!	be taken directly  from an  AOBJN register.   There are  three
!	cases:
!
!	    1.	EXPR was already  safe and nothing  changed.  In  this
!		case EXPR is returned.
!
!	    2.	EXPR was a common subexpression node in a chain ending
!		in  an  AOBJN  REGCONTENTS  node.   In  this  case,  a
!		STRHAOBJN node is linked in and EXPR is returned.
!
!	    3.	EXPR itself was  an AOBJN REGCONTENTS  node.  In  this
!		case, a STRHAOBJN node is created and returned.
!
! SIDE EFFECTS:
!
!	None
!
!--


![2402] New
BEGIN
	MAP BASE PARNT;		! Parent of top-level expression
	MAP BASE EXPR;		! Top-level expression

	REGISTER BASE AOBJNPAR;	! Parent of AOBJN REGCONTENTS node
	REGISTER BASE AOBJNREG;	! AOBJN REGCONTENTS node
	REGISTER BASE STRNODE;	! STRHAOBJN node

	IF .DOWDP NEQ 0
	THEN IF .CDONODE[FLCWD]
	THEN
	BEGIN	! In an AOBJN loop

		AOBJNPAR = .PARNT;
		AOBJNREG = .EXPR;

		WHILE .AOBJNREG[OPRCLS] EQL CMNSUB
		DO
		BEGIN	! Keep looking

			AOBJNPAR = .AOBJNREG;
			AOBJNREG = .AOBJNREG[ARG2PTR];

		END;	! Keep looking

		IF .AOBJNREG EQL .DOWDP[DOREGPTR]
		THEN
		BEGIN	! Found AOBJN

			! Create a STRHAOBJN node whose parent is AOBJNPAR.

			STRNODE = MAKPR1(.AOBJNPAR,STORECLS,STRHAOBJN,
				INTEGER,0,.AOBJNREG);

			IF .AOBJNPAR NEQ .PARNT
			THEN
			BEGIN	! We walked down a CMNSUB

				! We  aren't  changing  the  top-level
				! expression.  Link the STRHAOBJN node
				! into its  parent CMNSUB  node,  copy
				! flags from the parent, and reset the
				! parents flags.

				AOBJNPAR[ARG2PTR] = .STRNODE;
				STRNODE[A2FLGS] = .AOBJNPAR[A2FLGS];
				AOBJNPAR[A2VALFLG] = 0;
				AOBJNPAR[A2IMMEDFLG] = 0;
				AOBJNPAR[A2SAMEFLG] = 1;

			END	! We walked down a CMNSUB
			ELSE
			BEGIN	! Changing top-level expr

				! EXPR   pointed    to    the    AOBJN
				! REGCONTENTS node.  Set flags in  the
				! STRHAOBJN node  and return  it  (let
				! the caller  worry about  linking  it
				! in).

				STRNODE[A2VALFLG] = 1;
				STRNODE[A2IMMEDFLG] = 1;
				RETURN .STRNODE;	! New top-level expr

			END;	! Changing top-level expr

		END;	! Found AOBJN

	END;	! In an AOBJN loop

	RETURN .EXPR;	! The top-level expression hasn't changed

END;	! of FIXAOBJN


! The below is for putting through RUNOFF to get a PLM file.
!++
!.END LITERAL
!--
END
ELUDOM