Google
 

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

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1972, 1983
!AUTHOR: S. MURPHY/JNG/DCE/TFV/CDM/RVM/AHM

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



GLOBAL BIND P2S1V = 7^24 + 0^18 + #1706;	! Version Date:	22-Dec-82

%(

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

57	-----	-----	DO NOT CHECK FOR EXPONEN INVOLVING A LOOP 
			INDEX UNTIL AFTER IN LINE EXPONENS HAVE BEEN
			DETECTED (SO THAT I**2 DOESNT CAUSE THE LP INDEX
			TO BE MATERIALIZED)
58	-----	-----	FIX TYPO IN "P2SKFN". WHEN REMOVE A NEG FROM
			UNDER AN IN-LINE FN, WHEN
			GETTING PTR TO NODE TO SET PARENT PTR, SHOULD
			LOOK AT "CNODE[ARG1PTR]", (NOT ARGNODE[ARG1PTR])
59	-----	-----	IN "ARSKOPT", USE "KEXPIX" TO FOLD EXPONEN OF CONSTS
			(RATHER THAN SQROP,CUBOP,P4OP)
60	434	19211	CHECK IF FN PARAM IS DO LOOP INDEX AFTER CONST
			FOLDING IN CASE I+0 TYPE CONSTRUCTION., (JNG)
61	445	19632	REDUCE CHANCE OF STACK OVERFLOW BY CUTTING
			DOWN NUMBER OF LOCALS FOR P2SKARITH, (DCE)
62	671	NVT	WHEN SWAPPING ARGS, SWAP DEF PTS TOO, (DCE)

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

63	761	TFV	1-Mar-80	-----
	Remove KA10FLG and use /GFLOATING when rounding DP to SP

64	1031	TFV	25-Nov-80	------
	When folding relationals, chose low or high word of each constant
	based on VALTP1 since octals are not converted to real under GFLOATING

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

65	1264	CDM	25-Sept-81
	Add code to P2SKFN to check if function is a type conversion NOP
	and if so to remove the node.

66	1273	CDM	15-Oct-81
	Change P2SKFN to not change functions into inline for octal 
	arguments (problem with /OPT otherwise).

67	1431	CKS	4-Dec-81
	Add P2SKSUBSTR to do skeleton optimizations for substring nodes.  Also
	add a temporary null routine to optimize concatenation.

68	1452	CKS	4-Jan-82
	Do not optimize A(1:2) to a .D variable if A is a formal variable.

1474	TFV	15-Mar-82
	Write  P2SKCONC  to  perform   the  skeleton  optimization   for
	concatenation.   It  walks  down   the  argument  list  of   the
	concatenation   performing   skeleton   optimizations   on   the
	sub-expressions.   If   all   the   lengths   are   fixed,   the
	concatenation node  is  changed  to an  OPERSP  of  CONCTF,  the
	ARG1PTR field is also filled in with a constant table entry  for
	the  length  of  the   concatenation  in  characters.   If   the
	concatenation has a  known maximum length,  the OPERSP field  is
	changed to CONCTM.   It also folds  all the concatenations  into
	one concatenation node.

1522	TFV	29-Mar-82
	Change P2SKSUBSTRING to  give the substring  bound out of  range
	error for upper bound less than lower bound, and for lower bound
	less than 1.

1535	CDM	17-May-82
	Optimize CHAR(constant) and ICHAR(constant) to be constants.

1542	RVM	25-May-82
	Convert REAL constants (stored in double precision) back to 
	single precision before folding LOGICAL expressions.  Under
	/GFLOATING, REAL numbers do not have the same bit pattern
	at compile-time that they have at execution time, so the
	conversion must be done for the results gotten at compile-
	time to agree with those gotten at run-time.

1557	CKS	14-Jun-82
	Detect substrings with constant bounds which have upper bound
	greater than string length.

1567	CDM	24-Jun-82
	Massive restructuring for inline  functions and creation of  new
	routine P2SILF.  Addition of code  to fold CHAR, ICHAR, and  LEN
	to constants.

1641	AHM	10-Oct-82
	When P2SKCONCAT  sees  the expression  A//(B//C)//D,  it  will
	change it into  A//B//C//D.  Make  it also  change the  parent
	pointers for B and C to point  to the new concat node if  they
	have parent pointers.

1655	CDM	25-Oct-82
	Allow character inline functions for arguments to concatenation.

1706	TFV	22-Dec-82
	Fix  P2SKSUBSTRING  for   substring  assignments  to   character
	function values.

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

)%


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

	!***************************************************************
	! Initial  pass  of  phase  2  skeleton.   This  pass  over   an
	! expression tree performs the following:
	!
	! 	1.  Eliminates neg and not  nodes, forcing them down  to
	! 	    the bottom if possible.  In doing this the following
	! 	    globals are used:
	!
	! 		NEGFLG - If this flag is  true when the  routine
	!			 is called for a given node, a neg is to
	!			 be forced down  from above.  This  flag
	!			 is returned  true if  the parent  above
	!			 this node must handle negation for this
	!			 node.
	!
	!		NOTFLG - Like  negflg except  indicating that  a
	!			 not is to be forced down (or back up).
	!
	!	2. Eliminates the subtract operator,  changing it to add
	!	   and propagating the neg down over the 2nd arg
	!
	!	3. Checks  for  any  operations which are  performed  on
	!	   constants and  may  be  performed  at  compile  time.
	!	   Performs such operations  and replaces their  entries
	!	   in the  expression tree  by the  resultant  constant.
	!	   Creates  constant   table  entries   for  these   new
	!	   constants.
	!
	!	4. Detects multiplication  or  division  by  a  constant
	!	   power of 2  and changes the  node to p2mul.   Detects
	!	   multiplication by a power of 2 plus 1.
	!
	!	5. Detects  exponentiation to a small  constant  integer
	!	   power.
	!
	!	6. N-ary nodes are put into canonical order.
	!
	! This   pass   is   performed   before   common   subexpression
	! elimination.  It is performed before  phase 2 when phase 2  is
	! present.  It  has a  routine  corresponding to  each  operator
	! class.  To process a given node, it dispatches to the  routine
	! corresponding to its  operator class, via  the dispatch  table
	! "P2SKL1DISP".
	!
	! These routines are called with the argument CNODE - a  pointer
	! to the node in the tree  to be processed.  They each return  a
	! pointer to  the node  to  replace CNODE  (this will  be  CNODE
	! itself unless constant elimination or neg/not propogation  has
	! been performed).
	!***************************************************************

FORWARD
	P2SKBL(1),
	BLSKOPT(1),
	P2SKIGNORE(1),
	P2SKREL(1),
	RELSKOPT(1),
	P2SKFN(1),
	P2SKARITH(1),
	ARSKOPT(1),
	P2SKLTP(1),
	P2SKLARR(1),
	P2SKNEGNOT(1),
%1431%	P2SKCONCAT(1),
%1431%	P2SKSUBSTR(1),
%1567%	P2SILF(1);

EXTERNAL
	ARCMB,
	BLCMB,
	C1H,
	C1L,
	C2H,
	C2L,
	CANONICALIZE,
	CDONODE,
	COPRIX,
%1474%	CORMAN,		! Routine to get some space from free memory
	CGERR,		! Error routine for Internal Compiler Errors
	CMBEQLARGS,
%761%	CNSTCM,
	CNTMPY,
	DOWDP,		! Global used in  determining whether a  do-loop
			! index should live in a reg
%761%	DNEGCNST,
%1522%	E165,		! Substring bound out of range error
%1567%	E202,		! CHAR library function error
%1522%	FATLERR,	! Error routine
%761%	KARIGB,
%761%	KARIIB,
%761%	KBOOLBASE,
	KDNEGB,
	KDPRL,
%1542%	KGFOCT,
	KGFRL,
	KSPECB,
	KSPECG,
%761%	KTYPCB,
%761%	KTYPCG,
	MAKEPR,
%1535%	MAKLIT,		! Makes literal constant entry
	NEGFLG,
	NEGOFNOT,
	NEWDVAR,	! Makes new .Dnnn variable
	NOTFLG,
	NOTOFNEG,
	SAVSPACE,	! Return free space
%1567%	CHEXLEN,	! Returns length of character expression or LENSTAR
	SETPIMMED,
	SETPVAL,	
	SKERR,
	TAKNEGARG,
	TAKNOTARG,
%761%	TBLSEARCH,
	USERFNFLG;	! Flag indicating that this statement had a call
			! to a user function.

	!***************************************************************
	! Define the  dispatch  table for  phase  2 skeleton  -  have  a
	! routine for each operator class
	!***************************************************************

BIND DUMDUM = UPLIT(
	P2SKL1DISP GLOBALLY NAMES
		P2SKBL,
		P2SKIGNORE,	! Should get here very rarely (valflg is
				! usually set and checked)
		P2SKREL,
		P2SKFN,
		P2SKARITH,
		P2SKLTP,
		P2SKLARR,
		P2SKIGNORE,	! Common sub expression
		P2SKNEGNOT,	! Neg/not
		P2SKIGNORE,	! Special ops (p2mul, etc.)
		P2SKIGNORE,	! Fieldref
		P2SKIGNORE,	! Storecls
		P2SKIGNORE,	! Regcontents
		P2SKIGNORE,	! Label
		P2SKIGNORE,	! Statement
		P2SKIGNORE,	! Iolscls
		P2SKIGNORE,	! In-line-fn (since  these are  inserted
				! in p2s, should not encounter them)
%1431%		P2SKSUBSTR,	! Substring
%1431%		P2SKCONCAT);	! Concatenation
GLOBAL ROUTINE P2SKBL(CNODE)=
BEGIN
	!***************************************************************
	! Initial pass of phase 2 skeleton for a boolean
	!***************************************************************

	MAP    PEXPRNODE CNODE;

	LOCAL
		PEXPRNODE ARG1NODE,
		PEXPRNODE ARG2NODE,
		PRVNEGFLG,
		ARGNOTFLG;

	DEBGNODETST(CNODE);		! For debugging only
	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];

	!***************************************************************
	! For neg/not elimination. Cannot force  a neg down across  this
	! node.  Force down a not by:
	!	not(a and b)=(not a) or (not b)
	!	not(a or b)=(not a) and (not b)
	!	not(a xor b)=a eqv b
	!	not(a eqv b)=a xor b
	!***************************************************************

	PRVNEGFLG = .NEGFLG;
	ARGNOTFLG = .NOTFLG;

	IF.NOTFLG
	THEN
	BEGIN
		! Set opersp to OR from AND, AND from OR, EQV from  XOR,
		! XOR from eqv

		CNODE[BOPRFLG] = NOT.CNODE[BOPRFLG];

		IF .CNODE[BOOLCLS] NEQ ANDORCLS
		THEN ARGNOTFLG = FALSE;
	END;


	! Process 1st arg

	! If arg is a leaf, do not walk down there

	IF .CNODE[A1VALFLG]
	THEN
	BEGIN
		IF .ARGNOTFLG THEN CNODE[A1NOTFLG] = 1;
	END
	ELSE
	BEGIN
		NEGFLG = FALSE;
		NOTFLG = .ARGNOTFLG;
		ARG1NODE = (.P2SKL1DISP[.ARG1NODE[OPRCLS]])(.ARG1NODE);

		! If neg or  not was  propagated up from  arg1, set  the
		! flags in CNODE

		CNODE[A1NEGFLG] = .NEGFLG<0,1>;
		CNODE[A1NOTFLG] = .NOTFLG<0,1>;
	END;

	! If arg1 is a constant (or  was collapsed into into a  constant
	! by the walk over  it) and a1notflg is  set, perform the  'not'
	! operation

	IF .ARG1NODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		IF .CNODE[A1NOTFLG]
		THEN
		BEGIN
			ARG1NODE = NOTCNST(ARG1NODE);
			CNODE[A1NOTFLG] = 0;
		END
	END;

	CNODE[ARG1PTR]_.ARG1NODE;

	! Process 2nd arg

	! If arg is a leaf, do not walk down there

	IF .CNODE[A2VALFLG]
	THEN
	BEGIN
		IF .ARGNOTFLG THEN CNODE[A2NOTFLG] = 1;
	END
	ELSE
	BEGIN	! For arg2 not a leaf (or common subexpr)

		NEGFLG = FALSE;
		NOTFLG = .ARGNOTFLG;
		ARG2NODE = (.P2SKL1DISP[.ARG2NODE[OPRCLS]])(.ARG2NODE);
		CNODE[A2NEGFLG] = .NEGFLG<0,1>;
		CNODE[A2NOTFLG] = .NOTFLG<0,1>;
	END;

	! If arg2 is a constant (or was collapsed into one), perform the
	! 'not' operation on it if necessary

	IF .ARG2NODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		IF .CNODE[A2NOTFLG]
		THEN
		BEGIN
			ARG2NODE = NOTCNST(ARG2NODE);
			CNODE[A2NOTFLG] = 0;
		END;
	END;

	CNODE[ARG2PTR] = .ARG2NODE;
	NEGFLG = .PRVNEGFLG;
	NOTFLG = FALSE;

	! Check  for  operations  on  constants  and  operations  on   2
	! identical args, fold if can

	RETURN BLSKOPT(.CNODE);

END;	! of P2SKBL
GLOBAL ROUTINE BLSKOPT(CNODE)=
BEGIN
	!***************************************************************
	! Routine to  check whether  a boolean  operation has  arguments
	! which are either constant or identical to each other and hence
	! can be folded.  CNODE is a  pointer to the boolean node to  be
	! examined.  If  CNODE can  be folded,  this routine  returns  a
	! pointer to the node which will replace CNODE in the expression
	! tree.  Otherwise it returns a pointer to cnode.
	!***************************************************************

	REGISTER
		PEXPRNODE ARG1NODE,
		PEXPRNODE ARG2NODE,
%1542%		C1,
%1542%		C2;

	MAP PEXPRNODE CNODE;

	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];

	! Check for arg1 and arg2 both  constants and if so compute  the
	! value corresponding to CNODE and  replace CNODE by a  constant
	! table entry for that value.

	IF .ARG1NODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		IF.ARG2NODE[OPR1] EQL CONSTFL
		THEN
		BEGIN
			! Globals used by the assembly language  routine
			! that performs the operations are COPRIX,  C1L,
			! C2L.  Set C1L and C2L  to the single words  to
			! be operated on

%1542%			C1 = IF .ARG1NODE[VALTYPE] EQL REAL AND .GFLOAT
%1542%			     THEN
%1542%			     BEGIN
%1542%					C1H = .ARG1NODE[CONST1];
%1542%					C1L = .ARG1NODE[CONST2];
%1542%					COPRIX = KGFOCT;
%1542%					CNSTCM();
%1542%					.C2L
%1542%			      END
			      ELSE IF .ARG1NODE[VALTP1] EQL INTEG1
				   THEN .ARG1NODE[CONST2]
				   ELSE .ARG1NODE[CONST1];

%1542%			C2 = IF .ARG2NODE[VALTYPE] EQL REAL AND .GFLOAT
%1542%			     THEN
%1542%			     BEGIN
%1542%					C1H = .ARG2NODE[CONST1];
%1542%					C1L = .ARG2NODE[CONST2];
%1542%					COPRIX = KGFOCT;
%1542%					CNSTCM();
%1542%					.C2L
%1542%			      END
			      ELSE IF .ARG2NODE[VALTP1] EQL INTEG1
				   THEN .ARG2NODE[CONST2]
				   ELSE .ARG2NODE[CONST1];

%1542%			C1L = .C1;
%1542%			C2L = .C2;

			COPRIX = .CNODE[OPERSP] + KBOOLBASE;

			! Find the result of  this operation on these  2
			! constants

			CNSTCM();

			! Set valflg in parent of CNODE

			SETPVAL(.CNODE);

			! Replace CNODE by a new constant node

			CNODE = MAKECNST(LOGICAL,0,.C2L);
		END
		ELSE
			!**************************************
			! Check for:
			! 	A AND TRUE = A
			! 	A AND FALSE = FALSE
			! 	A OR  TRUE = TRUE
			! 	A OR  FALSE = A
			! 	A EQV TRUE = A
			! 	A XOR TRUE = NOT A
			! 	A EQV FALSE = NOT A
			! 	A XOR FALSE = A
			! and do the replacement
			!**************************************

			CNODE = BLCMB(.CNODE,.ARG1NODE,.ARG2NODE);
	END
	ELSE		! Do the same replacement for arg2

	IF .ARG2NODE[OPR1] EQL CONSTFL
	THEN CNODE = BLCMB(.CNODE,.ARG2NODE,.ARG1NODE)
	ELSE
		!**************************************
		! Check for:
		! 	A AND A =A
		! 	A AND (NOT A) = FALSE
		! 	A OR A = A
		! 	A OR (NOT A) = TRUE
		! 	A EQV A = TRUE
		! 	A EQV (NOT A) = FALSE
		! 	A XOR A = FALSE
		! 	A XOR (NOT A) = TRUE
		! and do the replacement
		!**************************************

	IF .CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]
	THEN CNODE = CMBEQLARGS(.CNODE,FALSE);

	RETURN CANONICALIZE(.CNODE);

END;	! of BLSKOPT
GLOBAL ROUTINE P2SKIGNORE(CNODE)=
BEGIN
	!***************************************************************
	! Phase  2  skeleton  routine  for  a  data  item  (constant  or
	! variable).  This routine is  also used for regcontents  nodes,
	! labels, etc.  In  general, do  not walk  down to  a data  node
	! because the valflg in the parent is set, and always check  the
	! flag before walking down to a  son.  This is here to keep  the
	! compiler from dying in those  rare cases where the valflg  was
	! left unset (it is used for elements on iolists where there  is
	! no valflg).
	!***************************************************************

	RETURN .CNODE

END;	! of P2SKIGNORE
GLOBAL ROUTINE P2SKREL(CNODE)=
BEGIN
	!***************************************************************
	! Initial pass of phase 2 skeleton for a relational
	!***************************************************************

	MAP PEXPRNODE CNODE;

	LOCAL
		PEXPRNODE ARG1NODE,
		PEXPRNODE ARG2NODE,
		PRVNEGFLG;

	DEBGNODETST(CNODE);		! For debugging only

	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];

	! For neg/not elimination - can force down a not by changing the
	! sense of the relational.  Cannot force down a neg.

	IF .NOTFLG THEN CNODE[OPERSP] = CMREL(.CNODE[OPERSP]);

	PRVNEGFLG = .NEGFLG;

	! Process first argument.  Do  not walk down to  arg if it is  a
	! leaf or common subexpr.

	IF NOT .CNODE[A1VALFLG]
	THEN
	BEGIN
		NEGFLG = FALSE;
		NOTFLG = FALSE;
		CNODE[ARG1PTR] = (.P2SKL1DISP[.ARG1NODE[OPRCLS]])(.ARG1NODE);
		CNODE[A1NEGFLG] = .NEGFLG<0,1>;
		CNODE[A1NOTFLG] = .NOTFLG<0,1>;
	END;

	! Process second argument.  Do not walk  down to arg if it is  a
	! leaf or common subexpr.

	IF NOT .CNODE[A2VALFLG]
	THEN
	BEGIN
		NEGFLG = FALSE;
		NOTFLG = FALSE;
		CNODE[ARG2PTR] = (.P2SKL1DISP[.ARG2NODE[OPRCLS]])(.ARG2NODE);
		CNODE[A2NEGFLG] = .NEGFLG<0,1>;
		CNODE[A2NOTFLG] = .NOTFLG<0,1>;
	END;

	! Set negflg and notflg  to the values to  be passed back up  to
	! parent

	NOTFLG = FALSE;
	NEGFLG = .PRVNEGFLG;

	! Check for operations on constants and operations on  identical
	! args that can be folded

	RETURN RELSKOPT(.CNODE);

END;	! of P2SKREL
GLOBAL ROUTINE RELSKOPT(CNODE)=
BEGIN
	!***************************************************************
	! Routine to  check a  relational node  for arguments  equal  to
	! constants, or to eachother, and to  fold such a node if it  is
	! possible  to  do  so.   The  argument  CNODE  points  to   the
	! relational node to  be examined.   If the node  can be  folded
	! then a pointer to the  new node to replace  it in the tree  is
	! returned.  Otherwise a pointer to CNODE is returned.
	!***************************************************************

	OWN
		PEXPRNODE ARG1NODE,
		PEXPRNODE ARG2NODE;

	MAP PEXPRNODE CNODE;

	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];

	!***************************************************************
	! If arg1 is equal to arg2 -
	!	substitute TRUE for a eq a, a le a, a ge a
	!	substitute FALSE for a lt a, a gt a, a ne a
	!***************************************************************

	IF .CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]
	THEN RETURN CMBEQLARGS(.CNODE,FALSE);


	!***************************************************************
	! Check for both args negated.
	! Transform:
	!	-a lt  -b = a gt b
	!	-a leq -b = a geq b
	!	-a eq  -b = a eq b
	!	-a gt  -b = a lt b
	!	-a geq -b = a leq b
	!	-a neq -b = a neq b
	!***************************************************************

	IF .CNODE[A1NEGFLG] AND .CNODE[A2NEGFLG]
	THEN
	BEGIN
		CNODE[A1NEGFLG] = 0;
		CNODE[A2NEGFLG] = 0;

		IF NOT EQREL(.CNODE[OPERSP])
		THEN CNODE[OPERSP] = REVREL(.CNODE[OPERSP]);
	END;

	! If the operands  are both constants,  evaluate the  relational
	! and replace it in the tree by either TRUE or FALSE.  If one of
	! the arguments  is a  constant, let  that argument  be the  2nd
	! argument.

	IF .ARG1NODE[OPR1] EQL CONSTFL
		AND .ARG1NODE[VALTYPE] NEQ DOUBLOCT
	THEN
	BEGIN
		!!!!!!?????????!!!!!!!!
		%(****FEB 23,1972 - THE FOLLOWING BLOCK WAS INSERTED TO
			PREVENT A BLISS BUG THAT DELETED CODE . THIS BLOCK FORCES
			BLISS TO USE 2 TEMP REGS***)%
		BEGIN
			OWN T,T1,T2,T3;
			T = 1; T1 = 2; T2 = 3; T3 = 4;
		END;

		IF .ARG2NODE[OPR1] EQL CONSTFL
			AND .ARG2NODE[VALTYPE] NEQ DOUBLOCT
		THEN
		BEGIN
			OWN
				KN,
				K1H,	! Hi word of const1 after the round
				K1L,	! Low word of const1 after the round
				K2H,	! Hi word of const2 after the round
				K2L;	! Low word of const2 after the round

			! For  real  variables   and  double   precision
			! variables, must round before compare

%761%			IF .ARG1NODE[VALTYPE] EQL REAL
			THEN
			BEGIN
				! Set up the globals for constant folding

				C1H = .ARG1NODE[CONST1];
				C1L = .ARG1NODE[CONST2];

				! To round double precision to real

%761%				IF .GFLOAT
%761%					THEN COPRIX = KGFRL
%761%					ELSE COPRIX = KDPRL;

				! Do the rounding, leave result in  C2H,
				! C2L

				CNSTCM();
				K1H = .C2H;
				K1L = .C2L
			END
			ELSE
			BEGIN
				! If rounding is not needed

				K1H = .ARG1NODE[CONST1];
				K1L = .ARG1NODE[CONST2];
			END;

%761%			IF .ARG2NODE[VALTYPE] EQL REAL
			THEN
			BEGIN
				! Set up the globals for constant folding

				C1H = .ARG2NODE[CONST1];
				C1L = .ARG2NODE[CONST2];

				! To round double precision to real

%761%				IF .GFLOAT
%761%					THEN COPRIX = KGFRL
%761%					ELSE COPRIX = KDPRL;

				! Do the rounding, leave result in  C2H,
				! C2L

				CNSTCM();
				K2H = .C2H;
				K2L = .C2L
			END
			ELSE
			BEGIN
				! If rounding is not needed

				K2H = .ARG2NODE[CONST1];
				K2L = .ARG2NODE[CONST2];
			END;

			KN = 
			BEGIN
				IF .ARG1NODE[DBLFLG]
				THEN
				%(***IF MUST COMPARE 2-WD VAL****)%
				BEGIN
					CASE .CNODE[OPERSP] OF SET
					%(***UNUSED OPERSP CODE - SHOULD NEVER GET HERE***)%
					BEGIN
						SKERR();
						FALSE
					END;
					%(** LT **)%
					(.K1H LSS .K2H)
						OR (.K1H EQL .K2H AND .K1L LSS .K2L);
					%(** EQ **)%
					(.K1H EQL .K2H) AND (.K1L EQL .K2L);
					%(** LE **)%
					(.K1H LSS .K2H)
						OR (.K1H EQL .K2H AND .K1L LEQ .K2L);
					%(**UNUSED CODE SHOULD NEVER GET HERE**)%
					BEGIN
						SKERR();
						FALSE
					END;
					%(** GE **)%
					(.K1H GTR .K2H)
						OR (.K1H EQL .K2H AND .K1L GEQ .K2L);
					%(** NE**)%
					(.K1H NEQ .K2H) OR (.K1L NEQ .K2L);
					%(** GT **)%
					(.K1H GTR .K2H)
						OR (.K1H EQL .K2H AND .K1L GTR .K2L);
					TES
				END

				ELSE
				%(***IF MUST COMPARE SINGLE-WD VALS***)%
				BEGIN
					OWN C1,C2;
					%(***SET C1 AND C2 TO THE VALS TO BE COMPARED***)%
![1031] Use low or high word of each constant based on VALTP1
![1031] since octals are not converted to reals under GFLOATING
%[1031]%       				IF .ARG1NODE[VALTP1] EQL INTEG1
%[1031]%	       			THEN	C1 = .K1L
%[1031]%				ELSE	C1 = .K1H;

%[1031]%       				IF .ARG2NODE[VALTP1] EQL INTEG1
%[1031]%	       			THEN	C2 = .K2L
%[1031]%				ELSE	C2 = .K2H;

					CASE .CNODE[OPERSP] OF SET
					%(***UNUSED OPERSP CODE - SHOULD BEVER GET HERE***)%
					BEGIN
						SKERR();
						FALSE
					END;
					%(***LT****)%
					.C1 LSS .C2;
					%(***EQ****)%
					.C1 EQL .C2;
					%(***LE****)%
					.C1 LEQ .C2;
					%(***UNUSED OPERSP CODE - SHOULD NEVER GET HERE***)%
					BEGIN
						SKERR();
						FALSE
					END;
					%(***GE***)%
					.C1 GEQ .C2;
					%(***NE***)%
					.C1 NEQ .C2;
					%(***GT***)%
					.C1 GTR .C2
					TES
				END
			END;
			%(***SET THE VALFLG IN THE PARENT OF CNODE***)%
			SETPVAL(.CNODE);


			%(***RETURN THE CONSTANT TABLE ENTRY FOR THE VAL OF THIS RELATIONAL***)%
			RETURN MAKECNST(LOGICAL,0,
				BEGIN
					IF .KN THEN TRUE ELSE FALSE
				END);
		END


		%(***IF ARG1 IS A CONSTANT AND ARG2 IS NOT; SWAP THE 2
			ARGS ***)%
		ELSE
		BEGIN
			IF NOT EQREL(.CNODE[OPERSP])
			THEN
			CNODE[OPERSP] = REVREL(.CNODE[OPERSP]);
			SWAPARGS(CNODE);
![671] WHEN WE SWAP THE ARGUMENTS, BE SURE TO SWAP THE DEF PTS TOO
%[671]%			IF .FLGREG<OPTIMIZE> THEN
%[671]%			BEGIN
%[671]%				ARG1NODE = .CNODE[DEFPT2];
%[671]%				CNODE[DEFPT2] = .CNODE[DEFPT1];
%[671]%				CNODE[DEFPT1] = .ARG1NODE
%[671]%			END;
			ARG1NODE = .CNODE[ARG1PTR];
			ARG2NODE = .CNODE[ARG2PTR];
		END;
	END;





	%(*****IF ONE OF THE ARGS IS ZERO AND THE OTHER IS A SUM, TRANSFORM:
		(A+B).REL.0=A.REL.-B
	*********)%

	IF ( NOT .CNODE[A1VALFLG]) AND (.ARG2NODE[OPR1] EQL CONSTFL)
	THEN
	BEGIN
		IF (.ARG2NODE[CONST1] EQL 0) AND (.ARG2NODE[CONST2] EQL 0) AND (.ARG1NODE[OPR1] EQL ADDOPF)

			AND NOT .CNODE[A1NOTFLG]
		THEN
		BEGIN

			%(****MAKE ARG1 UNDER CNODE BE ARG1 UNDER THE SUM, MAKE ARG2 BE
				ARG2 UNDER THE SUM WITH THE SIGN REVERSED****)%
			CNODE[ARG1PTR] = .ARG1NODE[ARG1PTR];
			CNODE[A1FLGS] = .ARG1NODE[A1FLGS];
			CNODE[ARG2PTR] = .ARG1NODE[ARG2PTR];
			CNODE[A2FLGS] = .ARG1NODE[A2FLGS];
			CNODE[A2NEGFLG] = NOT .CNODE[A2NEGFLG];
			%(***CORRECT PARENT PTRS IN THE 2 SUBNODES WHICH WERE MOVED***)%
			ARG1NODE = .CNODE[ARG1PTR];
			ARG2NODE = .CNODE[ARG2PTR];
			IF .ARG1NODE[OPRCLS] EQL DATAOPR
			THEN
			CNODE[A1VALFLG] = 1
			ELSE
			ARG1NODE[PARENT] = .CNODE;

			IF .ARG2NODE[OPRCLS] EQL DATAOPR
			THEN
			CNODE[A2VALFLG] = 1
			ELSE
			ARG2NODE[PARENT] = .CNODE;
		END;
	END;

	RETURN .CNODE;

END;	! of RELSKOPT
GLOBAL ROUTINE P2SKFN(CNODE)=
%(*************************************************************************
	Initial pass of phase 2 skeleton for a function call.  Cannot force
	neg or not down across a fn call.
*************************************************************************)%
BEGIN

	MAP OBJECTCODE DOWDP;
	MAP PEXPRNODE CDONODE;

	MAP OBJECTCODE USERFNFLG;
	MAP PEXPRNODE CNODE;

%1567%	REGISTER
		ARGUMENTLIST ARGLST,	! Argument list to function
		PEXPRNODE FNNAMENTRY;	! Function symble table node

	LOCAL
		PEXPRNODE ARGNODE,	!Argument node for spec arg
		PRVNEGFLG,
		PRVNOTFLG;


	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY


	FNNAMENTRY = .CNODE[ARG1PTR];
	ARGLST = .CNODE[ARG2PTR];

	! If this fn is not a  library fn, set a global indicating  that
	! this stmnt includes a call to a user fn

	IF .CNODE[OPERSP] NEQ LIBARY  THEN  USERFNFLG = TRUE;


	%(***IF THIS FN IS A STMNT FN AND THIS REFERENCE IS INSIDE A DO LOOP
		THEN THE INDEX OF THAT LOOP MUST BE MATERIALIZED (SINCE THE
		STMNT FN CAN REFERENCE THE VAR)***)%
	IF .FNNAMENTRY[IDATTRIBUT(SFN)] THEN DOWDP[DOMTRLZIX] = 1;

	%(***PERFORM PHASE 2 SKEL OPTIMS ON ALL ARGS***)%
	IF .CNODE[ARG2PTR] NEQ 0
	THEN
	BEGIN
		PRVNEGFLG = .NEGFLG;
		PRVNOTFLG = .NOTFLG;

		%(*** PROCESS ALL ARGUMENTS ***)%
		INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
		DO
		BEGIN
			ARGNODE = .ARGLST[.CT,ARGNPTR];
			IF NOT .ARGLST[.CT,AVALFLG]
			THEN
			%(***UNLESS THIS ARG IS A LEAF OR A COMMON SUBEXPR, PROCESS IT***)%
			BEGIN
				NEGFLG = FALSE;
				NOTFLG = FALSE;
				ARGLST[.CT,ARGNPTR] = (.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
			END;
			%(***CHECK WHETHER THIS ARG IS THE INDEX OF A DO LOOP THAT
				INCLUDES THIS STMNT. IF SO, WILL NOT BE ABLE TO
				HAVE THAT LOOP INDEX LIVE IN A REGISTER***)%
			IF .ARGLST[.CT,ARGNPTR] EQL .DOWDP[DOINDUC]
			THEN  DOWDP[DOMTRLZIX] = 1;

		END;

		%(***RESTORE NEGFLG AND NOTFLG TO THE VALS THAT THEY  HAD WHEN ENTERED***)%
		NEGFLG = .PRVNEGFLG;
		NOTFLG = .PRVNOTFLG;
	END;


	! Check for whether this fn should  be expanded in line. If  so,
	! transform this  FNCALL node  into an  "in-line-fn" node  or  a
	! type-conversion node. Function won't be made inline if it  has
	! octal arguments.

	IF .FNNAMENTRY[IDINLINFLG]
%1567%	THEN	RETURN P2SILF(.CNODE);


	RETURN .CNODE;

END;	! of P2SKFN
GLOBAL ROUTINE P2SKARITH(CNODE)=
%(***
	INITIAL PASS OF PHASE 2 SKELETON FOR AN ARITHMETIC NODE
***)%
BEGIN

	MAP OBJECTCODE DOWDP;
	LOCAL PEXPRNODE ARG1NODE;
	LOCAL PEXPRNODE ARG2NODE;
	LOCAL V;
	MAP PEXPRNODE CNODE;
	! MAKE 4 BOOLEAN LOCALS LIVE INSIDE V
	!SO THAT RECURSIVE CALLS ARE LESS LIKELY TO
	!OVERFLOW OUR STACK!  THE BOOLEANS ARE DEFINED BELOW
	MACRO	PARNEG=35,1$,
		PARNOT=34,1$,
		ARG1NEG=33,1$,
		ARG2NEG=32,1$;

	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY


	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];

	%(***FORCE DOWN A NEGATIVE BY:
		-(A+B)=-A-B
		-(A-B)=-A+B
		-(A*B)=(-A)*B
		-(A/B)=(-A)/B
	***)%
	IF .NEGFLG
	THEN
	BEGIN
		CASE .CNODE[OPERSP] OF SET
		%(*** FOR ADD ***)%
		BEGIN
			V<ARG1NEG> = TRUE;
			V<ARG2NEG> = TRUE;
			V<PARNEG> = FALSE;
		END;
		%(*** FOR SUB ***)%
		BEGIN
			CNODE[OPERSP] = ADDOP;
			V<ARG1NEG> = TRUE;
			V<ARG2NEG> = FALSE;
			V<PARNEG> = FALSE;
		END;
		%(*** FOR MUL ***)%
		BEGIN
			V<ARG1NEG> = TRUE;
			V<ARG2NEG> = FALSE;
			V<PARNEG> = FALSE;
		END;
		%(*** FOR DIV ***)%
		BEGIN
			V<ARG1NEG> = TRUE;
			V<ARG2NEG> = FALSE;
			V<PARNEG> = FALSE;
		END;
		%(*** FOR EXPONENTIATION ***)%
		%(*** CANNOT FORCE NEG DOWN ***)%
		BEGIN
			V<ARG1NEG> = FALSE;
			V<ARG2NEG> = FALSE;
			V<PARNEG> = TRUE;
		END
		TES
	END
	ELSE
	BEGIN
		V<ARG1NEG> = FALSE;
		V<PARNEG> = FALSE;
		IF .CNODE[OPERSP] EQL SUBOP
		THEN
		BEGIN
			CNODE[OPERSP] = ADDOP;
			V<ARG2NEG> = TRUE;
		END
		ELSE
		V<ARG2NEG> = FALSE;
	END;

	%(*** CANNOT FORCE DOWN A NOT ***)%
	V<PARNOT> = .NOTFLG;


	%(********* PROCESS FIRST ARG **********)%

	%(****DO NOT WALK DOWN TO A NODE WHICH IS A LEAF OR COMMON SUBEXPR***)%
	IF .CNODE[A1VALFLG]
	THEN
	BEGIN
		IF .V<ARG1NEG>
		THEN CNODE[A1NEGFLG] = 1;
	END
	ELSE
	%(***IF ARG IS NOT A LEAF OR COMMON SUBEXPR***)%
	BEGIN
		NOTFLG = FALSE;
		NEGFLG =  IF .V<ARG1NEG> THEN TRUE ELSE FALSE;
		ARG1NODE = (.P2SKL1DISP[.ARG1NODE[OPRCLS]])(.ARG1NODE);
		CNODE[A1NEGFLG] = .NEGFLG<0,1>;
		CNODE[A1NOTFLG] = .NOTFLG<0,1>;
	END;

	%(***IF ARG IS A CONSTANT (OR WAS COLLAPSED INTO ONE), PERFORM NEG
		ON IT AT COMPILE TIME*****)%
	IF .ARG1NODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		IF .CNODE[A1NEGFLG]
		THEN
		BEGIN
			ARG1NODE = NEGCNST(ARG1NODE);
			CNODE[A1NEGFLG] = 0;
		END;
	END;

	CNODE[ARG1PTR] = .ARG1NODE;



	%(********* PROCESS SECOND ARG ********)%

	IF .CNODE[A2VALFLG]
	THEN
	BEGIN
		IF .V<ARG2NEG>
		THEN
		CNODE[A2NEGFLG] = 1;
	END
	ELSE
	BEGIN
		NEGFLG =  IF .V<ARG2NEG> THEN TRUE ELSE FALSE;
		NOTFLG = FALSE;
		ARG2NODE = (.P2SKL1DISP[.ARG2NODE[OPRCLS]])(.ARG2NODE);
		CNODE[A2NEGFLG] = .NEGFLG<0,1>;
		CNODE[A2NOTFLG] = .NOTFLG<0,1>;
	END;

	%(***IF ARG IS A CONSTANT (OR WAS COLLAPSED INTO ONE), PERFORM NEG
		ON IT AT COMPILE TIME*****)%
	IF .ARG2NODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		IF .CNODE[A2NEGFLG]
		THEN
		BEGIN
			ARG2NODE = NEGCNST(ARG2NODE);
			CNODE[A2NEGFLG] = 0;
		END;
	END;

	CNODE[ARG2PTR] = .ARG2NODE;


	%(*** CHECK FOR
		(-A)*(-B)=A*B
		(-A)/(-B)=A/B
	***)%
	IF .CNODE[A1NEGFLG] AND .CNODE[A2NEGFLG]
	THEN
	BEGIN
		IF .CNODE[OPERSP] EQL MULOP
		OR .CNODE[OPERSP] EQL DIVOP
		THEN
		BEGIN
			CNODE[A1NEGFLG] = 0;
			CNODE[A2NEGFLG] = 0;
		END;
	END;




	NEGFLG =  IF .V<PARNEG> THEN TRUE ELSE FALSE;
	NOTFLG =  IF .V<PARNOT> THEN TRUE ELSE FALSE;

	%(****CHECK FOR CONSTANT OPERATIONS AND OPERATIONS ON IDEXTICAL ARGS THAT CAN BE FOLDED***)%
	V =  ARSKOPT(.CNODE);

	%(***IF EITHER ARG OF AN EXPONENTIATION IS THE INDEX OF A DO LOOP THAT
		INCLUDES THAT EXPONENTIATION, CANNOT HAVE THAT LOOP INDEX LIVE IN A REG***)%
	IF .CNODE[OPR1] EQL EXPONOPF
	THEN
	BEGIN
		IF .CNODE[ARG1PTR] EQL .DOWDP[DOINDUC] OR
			(.CNODE[ARG2PTR] EQL .DOWDP[DOINDUC])
		THEN
		DOWDP[DOISUBS] = 0
	END;

	RETURN .V;

END;	! of P2SKARITH
GLOBAL ROUTINE ARSKOPT(CNODE)=
%(***************************************************************************
	FOR AN ARITHMETIC NODE, CHECK FOR OPERATIONS ON CONSTANTS AND ON IDENTICAL ARGS THAT CAN BE FOLDED.
	CALLED WITH THE ARG CNODE POINTING TO AN ARITHMETIC EXPRESSION NODE.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;
	OWN PEXPRNODE ARG1NODE:ARG2NODE;
	LABEL FOLDCNST;

	ARG1NODE = .CNODE[ARG1PTR];
	ARG2NODE = .CNODE[ARG2PTR];



	%(***
	CHECK FOR BOTH OPERANDS CONSTANTS.  IF SO, PERFORM THE
	OPERATION AT COMPILE TIME - CREATE A CONSTANT TABLE ENTRY
	FOR THE NEW CONSTANT WHICH IS THE RESULTS
	***)%
	IF .ARG1NODE[OPR1] EQL CONSTFL AND .ARG2NODE[OPR1] EQL CONSTFL
		%(***DO NOT FOLD OPERATIONS INVOLVING DOUBLE OCTALS SINCE HAVE COMPLICATIONS
			DUE TO KEEPING ALL DOUBLE-PRECISION IN KI10 FORMAT UNTIL THE END***)%
		AND .ARG1NODE[VALTYPE] NEQ DOUBLOCT AND .ARG2NODE[VALTYPE] NEQ DOUBLOCT
	THEN
FOLDCNST:	BEGIN
		%(***DO NOT FOLD COMPLEX MULTIPLY AND DIVIDE,*****)%
		IF .CNODE[VALTYPE] EQL COMPLEX AND MULORDIV(CNODE)
		THEN
		LEAVE FOLDCNST;


		%(***GLOBALS USED BY THE ASSEMBLY LANGUAGE ROUTINE THAT
			PERFORMS THE OPERATIONS ARE
			 COPRIX, C1H, C1L, C2H, C2L***)%

		%(***FOLD CONSTANTS RAISED TO INTEGER POWERS ONLY IF THEY USE 8 OR LESS MULTIPLIES***)%
		IF .CNODE[OPERSP] EQL EXPONOP
		THEN
		BEGIN
			%(***DO NOT FOLD DOUBLE-PREC EXPONENTIATION AT COMPILE TIME***)%
			IF .CNODE[DBLFLG]
			THEN LEAVE FOLDCNST
			ELSE
			BEGIN
				IF .ARG2NODE[VALTP1] EQL INTEG1
					AND CNTMPY(.ARG2NODE[CONST2]) LEQ 8	!LESS THAN 8 MULTIPLIES
				THEN
				COPRIX = KEXPIX(.CNODE[VALTP1])
				ELSE LEAVE FOLDCNST
			END
		END
		ELSE
		COPRIX = KARITHOPIX(CNODE);

		%(***PICK UP ARG1 AND ARG2. WHEN HAVE PROPAGATED CONSTANTS, WILL HAVE TO
			WORRY ABOUT NEGFLGS***)%
		C1H = .ARG1NODE[CONST1];
		C1L = .ARG1NODE[CONST2];
		C2H = .ARG2NODE[CONST1];
		C2L = .ARG2NODE[CONST2];

		%(***COMBINE THE CONSTANTS LEAVING THE RESULTS IN C2H AND C2L***)%
		CNSTCM();

		%(***SET THE VALFLG IN THE PARENT OF CNODE****)%
		SETPVAL(.CNODE);


		CNODE = MAKECNST(.CNODE[VALTYPE], .C2H, .C2L);
	END;


	IF .CNODE[OPRCLS] NEQ DATAOPR	!IF DID NOT SUCCEED IN FOLDING THIS NODE ALREADY
	THEN
	BEGIN

		%(****
			CHECK FOR ONE OF THE ARGUMENTS A CONSTANT
			IF SO, GO ATTEMPT TO MAKE THE
			VARIOUS OPTOMIZATIONS THAT CAN BE MADE ON OPS BETWEEN
			A VARIABLE(OR EXPRESSION) AND A CONSTANT.
			THESE INCLUDE RECOGNIZING CONSTANTS  AS BEING
				1. ZERO
				2. ONE
				3. MINUS ONE
				4. POWERS OF 2
				5. POWER OF 2 PLUS ONE
		*******)%

		IF .ARG1NODE[OPR1] EQL CONSTFL
		THEN
		CNODE = ARCMB(.CNODE,.ARG1NODE,.ARG2NODE,TRUE)
		ELSE
		IF .ARG2NODE[OPR1] EQL CONSTFL
		THEN
		CNODE = ARCMB(.CNODE,.ARG2NODE,.ARG1NODE,FALSE)



		%(********
			CHECK FOR:
				A+A=2*A
				A-A=0
				A/A=1
				A/-A=-1
		***********)%

		ELSE
		IF (.CNODE[ARG1PTR] EQL .CNODE[ARG2PTR])
		THEN
		CNODE = CMBEQLARGS(.CNODE,FALSE);
	END;

	%(****CANONICALIZE CNODE AND RETURN THE RESULT*****)%
	RETURN CANONICALIZE(.CNODE);

END;	! of ARSKOPT
GLOBAL ROUTINE P2SKLTP(CNODE)=
%(********
	INITIAL PASS OF PHASE 2 SKELETON FOR A TYPE-CONVERSION
	NODE.
********)%
BEGIN
	LOCAL PEXPRNODE ARGNODE;
	LOCAL SAVENOTFLG;


	MAP PEXPRNODE CNODE;

	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY


	ARGNODE = .CNODE[ARG2PTR];

	IF NOT .CNODE[A2VALFLG]
	THEN
	%(**PROCESS THE ARGUMENT UNDER THIS NODE.
		SIMPLY PASS NEG ON DOWN.
	**)%
	BEGIN
		IF NOT NOCNV(CNODE)	!IF THIS IS A TYPE-CNV THAT DOES GENERATE CODE
		THEN
		BEGIN
			SAVENOTFLG = .NOTFLG;	!CANNOT PASS A "NOT" DOWN OVER A TYPE CNV
			NOTFLG = FALSE;
		END;

		ARGNODE = (.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);	!PROCESS ARG UNDER TPCNV



		%(***EXCEPT FOR DUMMY TYPE CONVERSION NODES, CANNOT PASS "NOT"
			UP THROUGH THE TYPE CONVERSION***)%
		IF NOT NOCNV(CNODE)
		THEN
		BEGIN
			CNODE[A2NOTFLG] = .NOTFLG<0,1>;
			NOTFLG = .SAVENOTFLG;
		END;

		%(***IF HAVE A NEG PASSED UP TO THIS NODE, MUST CHECK WHETHER IT CAN
			BE PASSED UP TO THE PARENT OF THIS NODE***)%
		IF .NEGFLG AND NOT TAKNEGARG(.CNODE[PARENT])
		THEN
		%(***IF CANNOT PASS THE NEG BACK UP, PUT IT INTO THE TPCNV NODE***)%
		BEGIN
			CNODE[A2NEGFLG] = 1;
			NEGFLG = FALSE;
		END;
	END;


	%(***PERFORM TYPE-CONVERSION ON A CONSTANT****)%
	IF .ARGNODE[OPR1] EQL CONSTFL
	THEN
	BEGIN
		C1H = .ARGNODE[CONST1];
		C1L = .ARGNODE[CONST2];
		IF .CNODE[A2NOTFLG]	!IF MUST TAKE THE "NOT" OF THE ARG
		THEN
		BEGIN
			C1H = NOT .C1H;
			C1L = NOT .C1L;
		END;
		IF .CNODE[A2NEGFLG]	!IF MUST TAKE THE NEG OF THE ARG
		THEN
		BEGIN
			IF .ARGNODE[VALTYPE] EQL DOUBLPREC OR .ARGNODE[VALTYPE] EQL REAL
			THEN
			%(***FOR DOUBLE PREC (AND REAL) MUST USE ASSEMBLY LANG ROUTINE
				TO TAKE NEG***)%
			BEGIN
%761%				COPRIX = KDNEGB;
				CNSTCM();
				C1H = .C2H;
				C1L = .C2L;
			END
			ELSE
			BEGIN
				C1H = -.C1H;
				C1L = -.C1L;
			END
		END;
		COPRIX = KTPCNVIX(CNODE);
		CNSTCM();

		%(***SET THE VALFLG IN THE PARENT OF CNODE***)%
		SETPVAL(.CNODE);

		RETURN MAKECNST(.CNODE[VALTYPE],.C2H,.C2L);

	END;

	CNODE[ARG2PTR] = .ARGNODE;

	RETURN .CNODE;

END;	! of P2SKLTP
GLOBAL ROUTINE P2SKLARR(CNODE)=
%(********
	INITIAL PASS OF PHASE 2 SKELETON FOR AN ARRAY REFERENCE.
	THE EXPRESSION NODE FOR THE ARRAYREF IS ASSUMED TO HAVE THE
	FOLLOWING 2 ARGS:
		ARG1PTR - PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY NAME
		ARG2PTR - PTR TO AN EXPRESSION NODE FOR THE ADDRESS CALCULATION
********)%
BEGIN
	MAP PEXPRNODE CNODE;
	LOCAL PEXPRNODE SSNODE;
	LOCAL PRVNEGFLG,PRVNOTFLG;

	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY


	%(*****UNLESS THE ADDRESS-CALCULATION IS A LEAF, PERFORM THE
		PHASE 2 SKEL OPTIMIZATIONS ON IT****)%
	IF NOT .CNODE[A2VALFLG]
	THEN
	BEGIN
		SSNODE = .CNODE[ARG2PTR];
		PRVNEGFLG = .NEGFLG;
		PRVNOTFLG = .NOTFLG;
		NEGFLG = FALSE;
		NOTFLG = FALSE;
		CNODE[ARG2PTR] = (.P2SKL1DISP[.SSNODE[OPRCLS]])(.SSNODE);
		CNODE[A2NEGFLG] = .NEGFLG<0,1>;
		CNODE[A2NOTFLG] = .NOTFLG<0,1>;
		NEGFLG = .PRVNEGFLG;		!CANNOT PASS NEG/NOT DOWN OVER AN
						! ARRAYREF NODE; HENCE IF WERE TRYING TO DO SO,
						! PASS THEM BACK UP TO PARENT
		NOTFLG = .PRVNOTFLG;
	END;

	RETURN	.CNODE;

END;	! of P2SKLARR
GLOBAL ROUTINE P2SKNEGNOT(CNODE)=
%(***************************************************************************
	INITIAL PASS OF PHASE 2 SKEL FOR A NEG OR NOT NODE
	TRANSFORMS:
		-(-X)=X
		NOT(NOT X)=X
	PERFORMS NEG/NOT ON A CONSTANT
	PASSES NEG AND NOT ON DOWN TO BOTTOMMOST NODES
	IN MANY CASES
	WHEN A NEG/NOT CANNOT BE PASSED DOWN ANY FURTHER, THE PARENT
	NODE HAS A FLAG SET INDICATING "NEGATE(OR COMPLEMENT) THE
	FIRST (OR 2ND) ARG"; 
	THE NEGATE/NOT NODE IS REMOVED FROM THE TREE.
	A NEGATE CANNOT BE PASSED DOWN FROM ABOVE OVER A NOT. IF THIS
	SITUATION ARISES (EG -(NOT X)), THE NEG WILL BE PASSED BACK UP
	WHEN THE NOT IS ENCOUNTERED AND IF THE NOT CANNOT BE PROPAGATED DOWN
	THE NOT NODE MUST BE LEFT IN THE TREE.
	SIMILARLY, A  NOT CANNOT BE PROPAGATED OVER A NEGATE.

	WHEN A NEGATE OR NOT CANNOT BE PROPAGATED DOWNWARD, THEN
	DEPENDING ON WHAT THE PARENT NODE OVER THE NEG/NOT NODE IS, THE NEG OR
	NOT MAY IN SOME CASES BE PROPAGATED BACK UPWARD.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARGNODE;
	OWN PEXPRNODE PARNODE;			!PTR TO PARENT NODE

	%(***DEFINE MACRO TO REMOVE THE NEG/NOT NODE FROM THE TREE***)%
	MACRO REMOVE=
	BEGIN
		%(***IF ARG IS A LEAF, SET VALFLG IN PARENT OF CNODE***)%
		IF .ARGNODE[OPRCLS] EQL DATAOPR
			OR .ARGNODE[OPRCLS] EQL REGCONTENTS
		THEN
		BEGIN
			 SETPVAL(.CNODE);

			%(***IF THE IMMEDIATE-FLAG WAS SET IN THE NEG/NOT NODE, SET IT
				IN THE PARENT OF THE NEG/NOT NODE***)%
			IF .CNODE[A2IMMEDFLG]
			THEN SETPIMMED(.CNODE);

		END

		%(***OTHERWISE SET PARENT PTR OF THE ELEMENT BELOW CNODE
			AND IF HAVE A PARENFLG ON CNODE, PUT IT ON THE ELEMENT BELOW**)%
		ELSE
		BEGIN
			 ARGNODE[PARENT] = .CNODE[PARENT];
			IF .CNODE[PARENFLG] THEN ARGNODE[PARENFLG] = 1;
		END;
		RETURN .ARGNODE;
	END$;

	%(***DEFINE A MACRO TO LEAVE A NEG NODE IN THE TREE, AND RETURN WITH NEGFLG=FALSE***)%
	MACRO LEAVENEG=
	BEGIN
		NEGFLG = FALSE;
		CNODE[OPERSP] = NEGOP;	!THIS NODE MAY HAVE ORIGINALLY BEEN A NOT.
					! EG .NOT.(.NOT.(-X))
		RETURN .CNODE;
	END$;

	%(***DEFINE A MACRO TO LEAVE A NOT NODE IN THE TREE, AND RETURN WITH NOTFLG=FALSE***)%
	MACRO LEAVENOT=
	BEGIN
		NOTFLG = FALSE;
		CNODE[OPERSP] = NOTOP;	!THIS NODE MAY HAVE ORIGINALLY BEE A NEG.
					! EG -(-(.NOT.X))
		RETURN .CNODE;
	END$;



	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY

	ARGNODE = .CNODE[ARG2PTR];

	IF .CNODE[OPERSP] EQL NEGOP
	THEN
	%(***IF CNODE IS A 'NEG' NODE (UNARY MINUS)***)%
	BEGIN
		%(***IF WERE TRYING TO PROPAGATE A 'NOT' FROM ABOVE
			CANNOT PROPAGATE IT ACROSS A NEG NODE***)%
		IF .NOTFLG
		THEN
		RETURN NOTOFNEG(.CNODE);

		NEGFLG = NOT .NEGFLG;
	END

	ELSE
	IF .CNODE[OPERSP] EQL NOTOP
	THEN
	%(***IF CNODE IS A 'NOT' NODE***)%
	BEGIN
		IF  .NEGFLG
		THEN
		%(***IF WERE TRYING TO PROPAGATE A 'NEG' FROM ABOVE,
			CANNOT PROPAGATE IT ACROSS A 'NOT' NODE***)%
		RETURN NEGOFNOT(.CNODE);
		NOTFLG = NOT .NOTFLG;
	END;


	IF .CNODE[A2VALFLG]
	THEN

	%(***IF THE ARGUMENT UNDER CNODE IS A LEAF***)%

	BEGIN

		%(****IF THE ARG IS A CONSTANT, CREATE A NEW CONSTANT TABLE ENTRY***)%
		IF .ARGNODE[OPR1] EQL CONSTFL
		THEN
		BEGIN
			IF .NEGFLG
			THEN
			%(****FOR NEG***)%
			BEGIN
				NEGFLG = FALSE;
				%(***SET THE VALFLG IN THE PARENT OF THE NEG***)%
				SETPVAL(.CNODE);
				RETURN NEGCNST(ARGNODE);
			END;

			IF .NOTFLG
			THEN
			%(****FOR NOT***)%
			BEGIN
				NOTFLG = FALSE;
				%(***SET THE VALFLG IN THE PARENT OF THE NOT***)%
				SETPVAL(.CNODE);
				RETURN NOTCNST(ARGNODE);
			END;
		END;
	END


	ELSE
	%(***IF ARG IS NOT A LEAF, TRY TO PROPAGATE NEG AND NOT OVER IT***********)%
	BEGIN
		ARGNODE =   (.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
		CNODE[ARG2PTR] = .ARGNODE;
	END;


	%(****IF ARE LEFT WITH A NEG OR NOT THAT COULD NOT BE PROPAGATED DOWN, DECIDE
		WHETHER OR NOT TO COLLAPSE IT UP INTO THE PARENT ON THE BASIS
		OF THE OPERATOR CLASS OF THE PARENT
	*******)%

	IF .NEGFLG
	THEN
	BEGIN
		IF TAKNEGARG(.CNODE[PARENT])
		THEN
		REMOVE
		ELSE
		LEAVENEG;

	END

	ELSE

	%(***IF HAVE A NOT THAT WERE UNABLE TO PROPAGATE DOWN***)%
	IF .NOTFLG
	THEN
	BEGIN
		IF TAKNOTARG(.CNODE[PARENT])	!IF THE NOT CAN BE ABSORBED BY THE PARENT
		THEN REMOVE			! REMOVE THE NOT NODE AND PROPAGATE
						! THE NOT UP TO THE PARENT
		ELSE LEAVENOT;			!OTHERWISE LEAVE THE NOT NODE
	END


	%(***IF THE NEG OR NOT WAS ABSORBED BELOW THIS NODE, CAN REMOVE THE NEG/NOT NODE
		FROM THE TREE****)%
	ELSE
	REMOVE;

END;	! of P2SKNEGNOT
ROUTINE P2SKCONCAT(CNODE) =
BEGIN

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

	! Perform skeleton optimizations  on CONCATENATION nodes.   Walk
	! down  the  argument  list  performing  optimizations  on   the
	! arguments (except for  the first which  is the descriptor  for
	! the result).  If the lengths  are fixed, change the OPERSP  to
	! CONCTF.  If the maximum length of the result is known,  change
	! the OPERSP to CONCTM.


	MAP BASE CNODE;

	REGISTER
		ARGUMENTLIST ARGLIST,	! Pointer to the argument list
		PEXPRNODE ARGNODE;	! Pointer to an argument

	LOCAL
		PEXPRNODE ANODE,	! Pointer to  an  arrayref  node
					! under a substring node
		PEXPRNODE LNODE,	! Lower bound of a substring node
		PEXPRNODE UNODE,	! Upper bound of a substring node
		ISFIXEDLEN,		! Flag  for  this  concatenation
					! has a fixed length
		ISMAXLEN,		! Flag  for  this  concatenation
					! has a known maximum length
		HASSUBCONC,		! Flag   for   this   node   has
					! concatenations as subnodes
		LEN,			! Size of the fixed length result
		NUMARGS,		! Number  of  arguments  for  the
					! folded concatenation.
		ARGUMENTLIST DOWNARGL,	! Pointer to the argument list of
					! a subnode
		PEXPRNODE SUBARG,	! Pointer to the argument in  the
					! argument list of a subnode
		ARGUMENTLIST NEWARGL,	! Pointer to  the  new  argument
					! list    used    when    moving
					! concatenation   subexpressions
					! to top level
		NEWARGPOS;		! Pointer to  the next  position
					! to fill  in the  new  argument
					! list

	NUMARGS = 1;			! One argument is  needed for the
					! result of the concatenation
	LEN = 0;			! Initialize length
	HASSUBCONC = FALSE;		! Assume no  concatenations below
					! this node
	ISFIXEDLEN = TRUE;		! Assume this  is a fixed  length
					! concatenation
	ISMAXLEN = TRUE;		! Assume this  is a concatenation
					! with a known maximum length

	ARGLIST = .CNODE[ARG2PTR];	! Get a pointer to the argument list

	INCR I FROM 2 TO .ARGLIST[ARGCOUNT]
	DO
	BEGIN	! Walk down the argument list

		! Walk down the  arguments from the  second onward.   Do
		! the skeleton optimization for each sub-expression.

		! The length of each legal  argument MUST be added  into
		! LEN so that  we can  assign the length  of the  concat
		! needed.

		ARGNODE = .ARGLIST[.I, ARGNPTR];	! Pointer to the
							! argument

		! If this  argument  is  not a  DATAOPR,  walk  down  it
		! performing further skeleton optimizations.

		IF NOT .ARGLIST[.I, AVALFLG]
		THEN ARGLIST[.I, ARGNPTR] = ARGNODE =
			 (.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);

		! Now process this argument based on OPRCLS.

		CASE .ARGNODE[OPRCLS] OF SET

		CGERR();	! BOOLEAN - error

		BEGIN		! DATAOPR

			! The argument either was a DATAOPR or it became
			! one through folding.

			ARGLIST[.I, AVALFLG] = 1;	! Set flag bit

			! If this is a  fixed length result, update  the
			! length.  Otherwise reset the fixed length  and
			! maximum length flags.

			IF .ARGNODE[OPERATOR] NEQ CHARCONST
			THEN
			BEGIN	! Variable

				IF .ARGNODE[IDCHLEN] EQL LENSTAR
				THEN
				BEGIN
					ISFIXEDLEN = FALSE;
					ISMAXLEN = FALSE;
				END
				ELSE	LEN = .LEN + .ARGNODE[IDCHLEN];

			END	! Variable
			ELSE	! Constant
				LEN = .LEN + .ARGNODE[LITLEN];

			! Update the argument count

			NUMARGS = .NUMARGS + 1;

		END;		! DATOPR 

		CGERR();	! RELATIONAL - error

		BEGIN		! FNCALL

			! Look  at  the  symbol  table  entry  for   the
			! function name to get the length of the result.
			! It can not have length *.

			SUBARG = .ARGNODE[ARG1PTR];
			LEN = .LEN + .SUBARG[IDCHLEN];

			! Update the argument count

			NUMARGS = .NUMARGS + 1;

		END;		! FNCALL

		CGERR();	! ARITHMETIC - error
		CGERR();	! TYPCNV - error

		BEGIN		! ARRAYREF

			! Get the pointer to the array name

			SUBARG = .ARGNODE[ARG1PTR];

			! If this  is  a  fixed length  array,  get  the
			! length of  an  element  from  the  array  name
			! symbol table entry.  Otherwise reset the fixed
			! length and maximum length flags.

			IF .SUBARG[IDCHLEN] EQL LENSTAR
			THEN
			BEGIN
				ISFIXEDLEN = FALSE;
				ISMAXLEN = FALSE;
			END
			ELSE	LEN = .LEN + .SUBARG[IDCHLEN];

			! Update the argument count

			NUMARGS = .NUMARGS + 1;

		END;		! ARRAYREF

		CGERR();	! CMNSUB - character common subs are not
				! supported in this release.

		CGERR();	! NEGNOT - error
		CGERR();	! SPECOP - error
		CGERR();	! FIELDREF - error
		CGERR();	! STORECLS - error
		CGERR();	! REGCONTENTS - error
		CGERR();	! LABOP - error
		CGERR();	! STATEMENT - error
		CGERR();	! IOLSCLS - error

%1655%		BEGIN		! INLINFN
%1655%
%1655%			! Add in the  length of the  inline function  to
%1655%			! the  concat  node.   Do  this  before  calling
%1655%			! P2SILF,  since  it  could   come  back  as   a
%1655%			! constant, and we don't want to bother what  it
%1655%			! gets optimized into to get the length.
%1655%
%1655%			SUBARG = .ARGNODE[ARG2PTR];	! .Dnnn return value
%1655%			LEN = .LEN + .SUBARG[IDCHLEN];	! Add in length
%1655%
%1655%			ARGLIST[.I,ARGNPTR] = P2SILF(.ARGNODE);	! Optimize
%1655%
%1655%		END;		! INLINFN

		BEGIN		! SUBSTRING

			!!! Will need more code to support the  A(I:I+3)
			!!! case.   This   is   also  a   fixed   length
			!!! concatenation.

			! Get pointer to upper bound expression

			UNODE = .ARGNODE[ARG1PTR];

			! Get pointer to lower bound expression

			LNODE = .ARGNODE[ARG2PTR];

			! Get pointer to ARRAYREF or DATAOPR node

			ANODE = .ARGNODE[ARG4PTR];

			! If both substring  bounds are constants,  this
			! is a fixed length concatenation.  Otherwise if
			! the DATAOPR or ARRAYREF subnode is not  length
			! * it is a known maximum length.

			IF .LNODE[OPR1] EQL CONSTFL AND
				.UNODE[OPR1] EQL CONSTFL
			THEN
			BEGIN	! Fixed length result

				LEN = .LEN + .UNODE[CONST2] - .LNODE[CONST2];

			END	! Fixed length result
			ELSE
			BEGIN	! Maximum or dynamic length result

				! Reset the fixed length flag

				ISFIXEDLEN = FALSE;

				! If this is an ARRAYREF, get the symbol
				! table entry for  the identifier  under
				! it.

				IF .ANODE[OPRCLS] EQL ARRAYREF
				THEN ANODE = .ANODE[ARG1PTR];

				IF .ANODE[IDCHLEN] EQL LENSTAR
				THEN
				BEGIN	! Dynamic length

					ISMAXLEN = FALSE;

				END	! Dynamic length
				ELSE	LEN = .LEN + .ANODE[IDCHLEN];

			END;	! Maximum or dynamic length result

			! Update the argument count

			NUMARGS = .NUMARGS + 1;

		END;		! SUBSTRING

		BEGIN		! CONCATENATION

			! Set the  flag  for  there  are  concatenations
			! under this node.

			HASSUBCONC = TRUE;

			IF .ARGNODE[OPERSP] EQL CONCTF
			THEN
			BEGIN	! Fixed length concatenation

				! This is a  fixed length  concatenation
				! as a sub-expression.   Get the  length
				! of   the   result   of   the   subnode
				! concatenation.  It is a constant table
				! entry pointed to by ARG1PTR.

				SUBARG = .ARGNODE[ARG1PTR];
				LEN = .LEN + .SUBARG[CONST2];

			END	! Fixed length concatenation
			ELSE	IF .ARGNODE[OPERSP] EQL CONCTM
			THEN
			BEGIN	! Known maximum length

				! Reset the fixed length flag

				ISFIXEDLEN = FALSE;

				! This is a maximum length concatenation
				! as a sub-expression.   Get the  length
				! of   the   result   of   the   subnode
				! concatenation.  It is a constant table
				! entry pointed to by ARG1PTR.

				SUBARG = .ARGNODE[ARG1PTR];
				LEN = .LEN + .SUBARG[CONST2];

			END	! Known maximum length
			ELSE
			BEGIN	! Dynamic length

				! Reset the  fixed  length  and  maximum
				! length flags

				ISFIXEDLEN = FALSE;
				ISMAXLEN = FALSE;

			END;	! Dynamic length

			! Get a  pointer to  the  argument list  of  the
			! subnode.

			DOWNARGL = .ARGNODE[ARG2PTR];

			! Update the  count  of  the  actual  number  of
			! concatenation arguments.   The first  argument
			! is ignored  since it  is  the result  for  the
			! concatenation subnode.

			NUMARGS = .NUMARGS + .DOWNARGL[ARGCOUNT] - 1;

		END;		! CONCATENATION

		TES;

	END;	! Walk down the argument list

	IF .ISFIXEDLEN
	THEN
	BEGIN	! Fixed length result

		CNODE[OPERSP] = CONCTF;

		! Fill in ARG1PTR with a  pointer to the constant  table
		! entry for the length.

		CNODE[ARG1PTR] = MAKECNST(INTEGER, 0, .LEN);

	END	! Fixed length result
	ELSE	IF .ISMAXLEN
	THEN
	BEGIN	! Known maximum length

		CNODE[OPERSP] = CONCTM;

		! Fill in ARG1PTR with a  pointer to the constant  table
		! entry for the maximum length of the result.

		CNODE[ARG1PTR] = MAKECNST(INTEGER, 0, .LEN);

	END;	! Known maximum length

	IF .HASSUBCONC
	THEN
	BEGIN	! Concatenations under this node

		! There are concatenations under this node, build a  new
		! node  with  all  the  concatenations  at  top   level.
		! Compute the size needed for the new argument block

		NAME<LEFT> = ARGLSTSIZE(.NUMARGS);

		NEWARGL = CORMAN();	! Get space for the new argument
					! block.

		! Copy the header words to the new argument list

		DECR I FROM ARGHDRSIZ - 1 TO 0
		DO (.NEWARGL)[.I] = .(.ARGLIST)[.I];

		! Fill in the argument count

		NEWARGL[ARGCOUNT] = .NUMARGS;

		! Walk down the old argument list copying the  arguments
		! into the  new argument  list.  Move  the arguments  of
		! concatenation subnodes to the top level.  Do not  copy
		! the first arguments of concatenations since these  are
		! the decriptors for the result.

		NEWARGPOS = 2;		! Start filling the new argument
					! block at  the second  argument
					! position

		INCR I FROM 2 TO .ARGLIST[ARGCOUNT]
		DO
		BEGIN	! Walk the old argument list			

			! Get the pointer to the next argument

			ARGNODE = .ARGLIST[.I, ARGNPTR];

			IF .ARGNODE[OPRCLS] EQL CONCATENATION
			THEN
			BEGIN	! Concatenation subexpression

				! Get the pointer  to the argument  list
				! of the concatenation subnode

				DOWNARGL = .ARGNODE[ARG2PTR];

				INCR J FROM 2 TO .DOWNARGL[ARGCOUNT]
				DO
				BEGIN	! Copy arguments to top level

					NEWARGL[.NEWARGPOS, ARGFULL] = .DOWNARGL[.J, ARGFULL];

%1641%					! If this arg has a parent pointer, (is
%1641%					! not an STE), then change it to  point
%1641%					! to the upper concatenation node.

%1641%					IF NOT .NEWARGL[.NEWARGPOS,AVALFLG]
%1641%					THEN
%1641%					BEGIN
%1641%						SUBARG = .NEWARGL[.NEWARGPOS,ARGNPTR];
%1641%						SUBARG[PARENT] = .CNODE
%1641%					END;

					! Update   position    in    new
					! argument list

					NEWARGPOS = .NEWARGPOS + 1;

				END;	! Copy arguments to top level

				! Free the space  for the argument  list
				! of the concatenation subnode

				SAVSPACE(ARGLSTSIZE(.DOWNARGL[ARGCOUNT]) - 1, .DOWNARGL);

				! Free the space  for the  concatenation
				! subnode

				SAVSPACE(EXSIZ - 1, .ARGNODE)

			END	! Concatenation subexpression
			ELSE
			BEGIN	! Not Concatenation

				! Just copy  this  argument to  the  new
				! argument list

				NEWARGL[.NEWARGPOS, ARGFULL] = .ARGLIST[.I, ARGFULL];

				! Update position in new argument list

				NEWARGPOS = .NEWARGPOS + 1;

			END;	! Not Concatenation

		END;	! Walk the old argument list			

		! Free the space for the old argument list

		SAVSPACE(ARGLSTSIZE(.ARGLIST[ARGCOUNT]) - 1, .ARGLIST);

		! Link in the new argument list

		CNODE[ARG2PTR] = .NEWARGL;

	END;	! Concatenations under this node

	RETURN .CNODE		! Return the new node

END;	! of P2SKCONCAT
ROUTINE P2SKSUBSTR(CNODE)=		![1431] New

%(**********************************************************************
	PHASE 2 SKELETON FOR A SUBSTRING NODE
	TRANSFORMS SUBSTRINGS WITH CONSTANT BOUNDS INTO .D VARIABLES
NYI	TRANSFORMS NODES TO LOWER/LENGTH FORM INSTEAD OF LOWER/UPPER FORM
NYI	IMPROVES NODES WITH CONSTANT LOWER BOUNDS THAT .NE. 1 TO ONES
		(LENGTH FORM?) WITH LOWER BOUND .EQ. 1.
**********************************************************************)%

BEGIN
	MAP PEXPRNODE CNODE;
	REGISTER PEXPRNODE LNODE:UNODE:ANODE;
	LOCAL PEXPRNODE DVAR;
	LOCAL PRVNEGFLG,PRVNOTFLG;
%1557%	LOCAL PEXPRNODE CHLEN;

	DEBGNODETST(CNODE);		! For debugging only
	
	! Perform skel optimizations on offspring nodes

	UNODE = .CNODE[ARG1PTR];	! UNODE points to upper bound expr
	LNODE = .CNODE[ARG2PTR];	! LNODE points to lower bound-1 expr
	ANODE = .CNODE[ARG4PTR];	! ANODE points to ARRAYREF or DATAOPR

	IF NOT .CNODE[A1VALFLG]
	THEN
	BEGIN	! do U node
		PRVNEGFLG = .NEGFLG;	! Cannot pass neg/not down over
		PRVNOTFLG = .NOTFLG;	!   substring, so stop them here
		NEGFLG = NOTFLG = FALSE; !  and pass them back up to parent.
		CNODE[ARG1PTR] = UNODE = (.P2SKL1DISP[.UNODE[OPRCLS]])(.UNODE);
		CNODE[A1NEGFLG] = .NEGFLG;
		CNODE[A1NOTFLG] = .NOTFLG;
		NEGFLG = .PRVNEGFLG;
		NOTFLG = .PRVNOTFLG;
	END;	! do U node

	IF NOT .CNODE[A2VALFLG]
	THEN
	BEGIN	! do L node
		PRVNEGFLG = .NEGFLG;
		PRVNOTFLG = .NOTFLG;
		NEGFLG = NOTFLG = FALSE;
		CNODE[ARG2PTR] = LNODE = (.P2SKL1DISP[.LNODE[OPRCLS]])(.LNODE);
		CNODE[A2NEGFLG] = .NEGFLG;
		CNODE[A2NOTFLG] = .NOTFLG;
		NEGFLG = .PRVNEGFLG;
		NOTFLG = .PRVNOTFLG;
	END;	! do L node

	IF .ANODE[OPRCLS] EQL ARRAYREF
	THEN
	CNODE[ARG4PTR] = ANODE = (.P2SKL1DISP[.ANODE[OPRCLS]])(.ANODE);

%1557%	! Get length of variable we're taking substring of

%1557%	IF .ANODE[OPRCLS] NEQ ARRAYREF
%1557%	THEN CHLEN = .ANODE[IDCHLEN]
%1557%	ELSE (CHLEN = .ANODE[ARG1PTR]; CHLEN = .CHLEN[IDCHLEN]);

%1557%	! If bounds are constant, check that they're in range

%1522%	IF .LNODE[OPR1] EQL CONSTFL	! If lower bound is constant
%1522%	THEN IF .LNODE[CONST2] LSS 0	! it must be at least 1
%1522%	THEN FATLERR(.ISN,E165<0,0>);	! "Substring bound out of range"

%1557%	IF .UNODE[OPR1] EQL CONSTFL	! If upper bound is constant
%1557%	THEN IF .UNODE[CONST2] GTR .CHLEN ! it must be less than string length
%1557%	THEN IF .CHLEN NEQ LENSTAR	! (if length is known)
%1557%	THEN FATLERR(.ISN,E165<0,0>);	! "Substring bound out of range"

	! Turn reference into a .D variable if both bounds are constant and
	! if the base variable is a simple (non-formal) scalar.

%1452%	IF .ANODE[OPR1] EQL VARFL	
%1706%	THEN 	IF NOT .ANODE[IDATTRIBUT(DUMMY)]
%1706%	THEN
	BEGIN	! Scalar

		! If the substring has constants for both bounds, we can
		! replace the substring with a .D variable (whose descriptor
		! is calculated at compile time).

		IF .LNODE[OPR1] EQL CONSTFL
		THEN
		BEGIN	! Lower bound constant
			IF .UNODE[OPR1] EQL CONSTFL
			THEN
			BEGIN	! Lower and upper bound both constant

				! Substitute a 2-word .D variable for the
				! substring reference.  Get the .D variable's
				! address from the base variable's address;
				! calculate its length and byte offset now.

				DVAR = NEWDVAR(1); 
				DVAR[IDADDR] = .CNODE[ARG4PTR];
				DVAR[IDCHLEN] = .UNODE[CONST2] - .LNODE[CONST2];

%1522%				! Give  substring  bound  out  of  range
%1522%				! error if  upper  bound  is  less  than
%1522%				! lower bound.

%1522%				IF .DVAR[IDCHLEN] LEQ 0
%1522%				THEN FATLERR(.ISN,E165<0,0>);

				DVAR[IDBPOFFSET] = .LNODE[CONST2];
				RETURN .DVAR;
			END;	! Lower and upper bound both constant
		END;	! Lower bound constant

	END;	! Scalar

	RETURN .CNODE;

END;	! of P2SKSUBSTR
GLOBAL ROUTINE P2SILF(CNODE)=
BEGIN

! Try to  change  a  function  call into  an  inline  function  or  type
! conversion node.  It may be instead  optimized into a constant, or  it
! may be decided to keep the original function call.

! Returns:	CNODE

! [1567] New with code moved from P2SKFN


	MAP	BASE CNODE;		! Function call node to look at

	REGISTER
		ARGUMENTLIST ARGLST,	! Argument list
		BASE ARGNODE;		! Argument node

	LOCAL	BASE FNNAMENTRY,	! Function symbol table entry
		ARGLEN,			! Length of a char arg
		ARGPOS,			! Position of arg in arg list
		BASE OLDCNODE;		! Node to be removed


	ARGLST = .CNODE[ARG2PTR];
	FNNAMENTRY = .CNODE[ARG1PTR];


	! "In release 1, we don't expand anything with more than 2  args
	! inline"  Don't make this inline.
	IF .ARGLST[ARGCOUNT] GTR 2 THEN RETURN .CNODE;


	! Character fn's arg is the 2nd in the arg list.
	IF .CNODE[VALTYPE] EQL CHARACTER
	THEN	ARGNODE = .ARGLST[2,ARGNPTR]
	ELSE	ARGNODE = .ARGLST[1,ARGNPTR];


	! If possible, fold these calls into constants now.

	IF .FNNAMENTRY[IDFNFOLD]
	THEN
	BEGIN
%1535%		! Try to optimize library functions
%1535%
%1535%		! If CHAR or ICHAR with a constant argument, we want  to
%1535%		! optimize this, returning the  value we would have  had
%1535%		! to calculate at run-time.
%1535%
%1535%		IF .FNNAMENTRY[IDINLINOPR] EQL ICHARFNOP
%1535%		THEN
%1535%		BEGIN	! ICHAR
%1535%
%1535%			IF .ARGNODE[OPR1] EQL CONSTFL
%1535%			THEN
			BEGIN
				SETPVAL(.CNODE);	! Set parent
				SAVSPACE(EXSIZ-1,.CNODE);
%1535%				RETURN MAKECNST(INTEGER, 0, .ARGNODE[LITC2]);
%1535%			END;
%1535%
%1535%		END	! ICHAR
%1535%
%1535%		ELSE
%1535%		IF .FNNAMENTRY[IDINLINOPR] EQL CHARFNOP
%1535%		THEN
%1535%		BEGIN	! CHAR
%1535%
%1535%			IF .ARGNODE[OPR1] EQL CONSTFL
%1535%			THEN
%1535%			BEGIN	! Make a character constant
%1535%
				SAVSPACE(EXSIZ-1,.CNODE);	! Freespace

				! Make a literal constant
%1535%				CNODE = MAKLIT(1);
%1535%				CNODE[LIT1] = ASCII'     ';
%1535%				CNODE[LITC2] = .ARGNODE[CONST2]; ! Const value
%1535%
%1535%				! If out of bounds, give a warning.
%1535%				IF .ARGNODE[CONST2] LSS 0 OR
%1535%					.ARGNODE[CONST2] GTR #177
%1535%				THEN 	FATLERR(.ISN,E202<0,0>);
%1535%
				! .Dnnn is not used, don't allocate it.
				ARGNODE = .ARGLST[1,ARGNPTR];
				ARGNODE[IDATTRIBUT(NOALLOC)] = 1;

				SETPVAL(.CNODE);		! Set parent
%1535%				RETURN .CNODE;
%1535%
%1535%			END;	! Make a character constant

%1535%		END	! CHAR

		ELSE
		IF .FNNAMENTRY[IDINLINOPR] EQL LENFNOP
		THEN
		BEGIN	! LEN
		
			! If we can find out the length of the character
			! argument  at  compile-time,  then  remove  the
			! function call and make this a constant node.

			! Make sure we don't have an array ref since  we
			! could have a function call under this node and
			! not know it yet.  (If  there is a fn call,  it
			! must be done)

			IF .ARGNODE[OPRCLS] NEQ ARRAYREF
			THEN
			BEGIN
				ARGLEN = CHEXLEN(.ARGNODE);	! Len of arg
				IF .ARGLEN NEQ LENSTAR		! Len known?
				THEN
				BEGIN
					SETPVAL(.CNODE);	! Set parent
					SAVSPACE(EXSIZ-1,.CNODE); ! Freespace
					RETURN MAKECNST(INTEGER, 0, .ARGLEN);
				END;
			END;

		END;	! LEN

	END;	! Try to fold into a constant


	! Make into either a Type convert or an In line function node

	IF .FNNAMENTRY[IDILFOPRCLS] EQL TYPECNV
	THEN
	BEGIN	! Type conversion

		CNODE[OPERATOR] = .FNNAMENTRY[IDINLINOPR];

		%(***For a type-conversion node, the single arg is arg2***)%
		CNODE[ARG2PTR] = .ARGNODE;
		IF .ARGLST[1,AVALFLG] THEN CNODE[A2VALFLG] = 1;

%1264%		! If a type conversion NOP  (the from and to values  are
%1264%		! the same), then remove the node, and replace the  type
%1264%		! conversion node with the argument.
%1264%
%1264%		IF .CNODE[VALTP2] EQL .CNODE[OPERSP]
%1264%		THEN
%1264%		BEGIN	! Remove type-convert
%1264%
%1264%			OLDCNODE  =  .CNODE;	! Node to remove
%1264%
%1264%			! Make new node from argument for function
%1264%			CNODE  =  .CNODE[ARG2PTR];
%1264%
%1264%			! Set up parent depending on whether new node is
%1264%			! leaf
%1264%
%1264%			IF .CNODE[OPRCLS] EQL DATAOPR
%1264%				OR .CNODE[OPRCLS] EQL REGCONTENTS
%1264%				OR .CNODE[OPRCLS] EQL CMNSUB
%1264%			THEN	SETPVAL(.OLDCNODE)	% Leaf %
%1264%			ELSE	CNODE[PARENT]  =  .OLDCNODE[PARENT];
%1264%
			! Free up the space
			SAVSPACE(EXSIZ-1,.OLDCNODE);

			RETURN .CNODE;

%1264%		END;	! Remove type-convert

	END	! Type convert
	ELSE
	BEGIN	! In-line

		! If either argument  is octal, then  we shouldn't  make
		! this into an inline function.  Return the node passed.

		INCR CNT FROM 1 TO .ARGLST[ARGCOUNT]
		DO
		BEGIN
			ARGNODE = .ARGLST[.CNT,ARGNPTR];
%1273%			IF (.ARGNODE[VALTYPE] EQL OCTAL)
%1273%				OR (.ARGNODE[VALTYPE] EQL DOUBLOCT)
			THEN	RETURN .CNODE;	! Don't make inline
		END;

		! Change opr fields to be inline
		CNODE[OPERATOR] = .FNNAMENTRY[IDINLINOPR];

		! Inline's argument position  in the arglist depends  on
		! whether the function is character.
		IF .CNODE[VALTYPE] EQL CHARACTER
		THEN	ARGPOS = 2
		ELSE	ARGPOS = 1;

		! Set up arg1 and whether it is a leaf
		CNODE[ARG1PTR] = .ARGLST[.ARGPOS,ARGNPTR];
		CNODE[A1VALFLG] = .ARGLST[.ARGPOS,AVALFLG];

		IF .ARGLST[ARGCOUNT] EQL 2
		THEN
		BEGIN	! 2 arguments

			! If a character function,  a .Dnnn variable  is
			! needed for  the return  value.  Save  the  one
			! originally generated for the function's return
			! value, before the arglist is returned to  free
			! space.

			IF .CNODE[VALTYPE] EQL CHARACTER
			THEN	ARGPOS = 1
			ELSE	ARGPOS = 2;

			CNODE[ARG2PTR] = .ARGLST[.ARGPOS,ARGNPTR];
			CNODE[A2VALFLG] = .ARGLST[.ARGPOS,AVALFLG];
		END
		ELSE
		BEGIN	! One argument

			CNODE[ARG2PTR] = 0;
		END;

	END;	! In-line


	%(***If arg1 under this node has a neg node as its top node,
		fold it out***)%
	ARGNODE = .CNODE[ARG1PTR];
	IF .ARGNODE[OPR1] EQL NEGFL
	THEN
	BEGIN
		CNODE[A1NEGFLG] = 1;
		CNODE[ARG1PTR] = .ARGNODE[ARG2PTR];
		IF .ARGNODE[A2VALFLG]
		THEN CNODE[A1VALFLG] = 1
		ELSE
		BEGIN
			OWN PEXPRNODE ARG1NODE;
			ARG1NODE = .CNODE[ARG1PTR];
			ARG1NODE[PARENT] = .CNODE;
		END;
		%(***Return the space for the neg to free storage***)%
		SAVSPACE(EXSIZ-1,.ARGNODE);
	END;


	! Return the core that was used for the arg list to free
	! storage.  Return # of wds-1.
	SAVSPACE(.ARGLST[ARGCOUNT]+ARGHDRSIZ-1,.ARGLST);

	RETURN .CNODE;

END;	! of P2SILF

END
ELUDOM