Google
 

Trailing-Edge - PDP-10 Archives - fortv11 - p2s1.bli
There are 26 other files named p2s1.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!AUTHOR: S. MURPHY/JNG/DCE/TFV/CDM/RVM/AHM/TJK/MEM

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

GLOBAL BIND P2S1V = #11^24 + 0^18 + #4560;	! Version Date:	22-Dec-86

%(

***** 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 V7 Development *****

2007	CDM	6-Oct-83
	Do not make LEN or ICHAR inline functions when the argument is a
	dynamic concatenation.  Dynamic  concatenation requires  "marks"
	and "unwinds".   The  existing  code  to  do  this  requires  an
	argument list  structure,  but  this is  thrown  away  when  the
	functions are made inline.

2025	TJK	21-Dec-83
	P2SKCONCAT  doesn't   handle   inline   functions   correctly.
	Specifically, it makes  a redundant call  to P2SILF, and  more
	importantly it doesn't  correctly update  the argument  count,
	which can result in incorrect code.  This corrects edit  1655.

2030	TJK	4-Jan-84	20-19858
	P2SKARITH doesn't check to see  if ARSKOPT returns a  constant
	with NEGFLG set.  This case should be reduced to a new negated
	constant with NEGFLG cleared,  since some routines which  call
	P2SKARITH ignore  NEGFLG when  the  returned expression  is  a
	constant.


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

2243	CDM	13-Dec-83
	Detect AOBJN DO loop register indexes into large arrays  (arrays
	in .LARG.).  This is  done in the  skeleton optimizer, and  will
	disable the  DO loop  from using  an AOBJN  instruction for  the
	cases that can be caught  this early in compilation.  This  will
	prevent the negative left half  of the AOBJN register  appearing
	to be an  invalid section  number when indexing  into the  array
	when running in a non-zero section.

2251	CDM	22-Dec-83
	Add new global  variable BIGCONCAT to  declare the size  (50,000
	for now) of the largest concatenation allowed as fixed  (CONCTF)
	or known maximum  (CONCTM) in length.   If the concatenation  is
	larger  than  this,  then  the  concatenation  will  be  dynamic
	(CONCTV) so that it will use the character stack.

2272	TJK	20-Jan-84
	Remove   code   from   P2SKCONCAT   which   folds    top-level
	subconcatenation  nodes  in  a  concatenation  argument  list,
	modify it  and make  it into  a new  routine called  P2SKFOLD.
	Have  P2SKCONCAT  call   this  new   routine  (P2SKCONCAT   is
	functionally unchanged).  This is so SKCALL can call  P2SKFOLD
	if the  CALL statement  is really  a character  assignment  or
	character statement function so that subconcatenations can  be
	folded in these cases.

2304	TJK	8-Feb-84
	Add  P2SKOVRLP  to  do   compile-time  overlap  checking   for
	character assignments.  Have SKCALL  call this routine if  the
	CALL statement is really a character assignment.

2307	TJK	13-Feb-84
	Have P2SKOVRLP  manually  set  NOALLOC for  new  symbol  table
	entries CASNN. and CNCAN., since this isn't automatically done
	after phase 1.

2352	CDM	1-May-84
	Make intrinsic functions  IAND, IOR, and  IEOR inline functions.   They
	are converted to  Fortran .AND.,  .OR., AND .XOR.  within the  skeleton
	optimizer.
	Generalize P2SILF a little more for inline folding.

2401	TJK	19-Jun-84
	Prevent P2SKSUBSTR  from  creating .Dnnnn  constant  substring
	descriptors.  This  causes problems  elsewhere, and  would  be
	even worse with the optimizer turned on.  They are now created
	during the complexity walk.  Also, remove a .Dnnnn check  from
	P2SKOVRLP.

2404	TJK	21-Jun-84
	Add call  to UNSAFE  from P2SKOVRLP,  replacing an  equivalent
	in-line test.

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

2544	MEM	13-Aug-85
	When converting subtract node into add node, don't just set it to one,
	because it might already be set and need to be cleared.

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

***** Begin Version 11 *****

4507	MEM	25-Jul-85
	Modified P2SKSUBSTR to change some lower/upper substring nodes to
	lower/length substring nodes. If it creates a new lower/length
	substring node and it is a substring of an array element (instead of a
	substring of a variable) then the array offset will be folded into
	the lower bound.

4510	MEM	14-Aug-85
	Move code for substring bounds checking from DOTDCHECK back to 
	P2SKSUBSTR.

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

4517	MEM	17-Sep-85
	Add routine SINGLECHARCHK to check if it was passed a 1-char variable
	(non-dummy), 1-char substring or 1-char arrayref. If it was then 
	return true else return false.

	Routine P2SKFN now checks to see if we have a character
	relational with single character args (by calling SINGLECHARCHK) -
	if so then convert this into a control relational with ICHAR nodes 
	above each of the operands. Set the INCRFLG in the ICHAR nodes
	indicating that we will have an incremented bytepointer under it.
	If an arrayref or substring is under one of the ICHAR nodes,
	increment its offset by one.

	Two changes are made to P2SILF. If some silly programmer has a
	concatenation under an ICHAR, remove the concatenation and replace it
	with the first arg of the concatenation - i.e. (ichar(c1//c2//...//cn)
	=> ichar(c1) .  If we have an ICHAR over a variable(non-dummy), 
	arrayref or substring then set the INCRFLG in the ICHAR node and if we 
	have an	arrayref or substring node under it then increment its offset.

4522	MEM	5-Nov-85
	Modify SINGLECHARCHK to allow dummys and function calls.
	Modify P2SKFN to allow incremented and/or unincremented bytepointers
	in inline 1-char relationals.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].  The lengths will be one
	(word) until a later edit, which will store and use long symbols.

4555	MEM	4-Dec-86
	Move bounds checking code back from P2SKSUBSTR to DOTDCHECK.

4557	MEM	9-Dec-86
	Modified P2SKSUBSTR to handle ICHAR over function call.

4560	MEM	22-Dec-85
	Remove edit 4555 until its bugs are fixed.

ENDV11
)%


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

! Below is for use in making PLM's with RUNOFF
!++
!.LITERAL
!--

!++
	!***************************************************************
	! 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),
%2272%	P2SKFOLD(2),
%1431%	P2SKCONCAT(1),
%2304%	P2SKOVRLP(0),
%4517%	SINGLECHARCHK(1),	!Check if we have a single char variable/substring/arrayref/function call
%1431%	P2SKSUBSTR(1),
%1567%	P2SILF(1);

EXTERNAL
	ARCMB,
%2243%	ARNOAOBJN,	! Routine to decide if array reference's address
%2243%			! calc should make a innermost DO loop not AOBJN.
%2251%	BIGCONCAT,	! Size of the biggest concatenation to allow  as
%2251%			! as a "fixed length" or "known maximum  length"
%2251%			! concatenation.
	BLCMB,
	C1H,
	C1L,
	C2H,
	C2L,
	CANONICALIZE,
	CDONODE,
	CGERR,		! Error routine for Internal Compiler Errors
%1567%	CHEXLEN,	! Returns length of character expression or LENSTAR
	CMBEQLARGS,
%761%	CNSTCM,
	CNTMPY,
	COPRIX,
%4507%	COPYEXPR,
%1474%	CORMAN,		! Routine to get some space from free memory
%2304%	BASE CSTMNT,	! Pointer to current statement
	DOWDP,
%761%	DNEGCNST,
%4510%	E165,		! Substring bound out of range error
%1567%	E202,		! CHAR library function error
%1522%	FATLERR,	! Error routine
%2243%	INNERLOOP,	! Flag indicating that we are within an innermost DO loop.
%761%	KARIGB,
%761%	KARIIB,
%761%	KBOOLBASE,
	KDNEGB,
	KDPRL,
%1542%	KGFOCT,
	KGFRL,
	KSPECB,
	KSPECG,
%761%	KTYPCB,
%761%	KTYPCG,
%2352%	MAKPR1,		! Make an expression node
%1535%	MAKLIT,		! Makes literal constant entry
	NEGFLG,
	NEGOFNOT,
%4517%	NEWENTRY,	! Make a new table entry
	NOTFLG,
	NOTOFNEG,
%4517%	ONEPLIT,	! Returns pointer to constant table entry for 1
%4515%	ONEWPTR,	! Returns [1,,pointer] to Sixbit argument
	SAVSPACE,	! Return free space
	SETPIMMED,
	SETPVAL,	
	SKERR,
	TAKNEGARG,
	TAKNOTARG,
%761%	TBLSEARCH,
%2404%	UNSAFE,		! Checks if two variables can overlap
	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
%4517%		ARGUMENTLIST ALST,	! Argument list to an ICHAR function
%4527%		BASE FNNAMENTRY;	! Function symble table node

	LOCAL
%4527%		BASE ARGNODE,		!Argument node for spec arg
%4517%		BASE NODE:TMP,		!Temp
		PRVNEGFLG,
		PRVNOTFLG,
%4517%		CH1FLAG;	! true if all args are 1 char

%4517%	CH1FLAG = TRUE;	! Assume all arguments are 1 character

	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;
%4517%			IF NOT SINGLECHARCHK(.ARGLST[.CT,ARGNPTR]) THEN CH1FLAG = FALSE;

			%(***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;

%4517%	! If we have a relational with single character args try to make the
%4517%	! following transformation
%4517%
%4517%	!	      fncall		=>       control relational
%4517%	!	      /    \			      /        \
%4517%	!	   fnname   arglist		 inlinfn     inlinfn
%4517%	!	   Lxx.     /  \		  ICHAR       ICHAR
%4517%	!		 arg1 arg2	           /          /
%4517%	!				         arg1       arg2
%4517%	!
%4517%	! where if arg1 [or arg2] is a char constant then
%4517%	! 
%4517%	! 	inlinfn
%4517%	! 	ICHAR                 
%4517%	! 	 /             =>      integer const
%4517%	!     char const
%4517%
%4517%	IF .CH1FLAG EQL TRUE	! All args are a single character
%4527%	THEN IF (SELECT .FNNAMENTRY[ID1ST6CHAR] OF
%4517%		NSET
%4517%			SIXBIT 'LLT.':(TMP = L;  EXITSELECT 1);
%4517%			SIXBIT 'LEQ.':(TMP = E;  EXITSELECT 1);
%4517%			SIXBIT 'LLE.':(TMP = LE; EXITSELECT 1);
%4517%			SIXBIT 'LNE.':(TMP = N;	 EXITSELECT 1);
%4517%			SIXBIT 'LGT.':(TMP = G;  EXITSELECT 1);
%4517%			SIXBIT 'LGE.':(TMP = GE; EXITSELECT 1);
%4517%		OTHERWISE: 0;
%4517%		TESN)
%4517%	THEN
%4517%	BEGIN
%4517%		INCR CT FROM 1 TO .ARGLST[ARGCOUNT]
%4517%		DO
%4517%		BEGIN
%4517%			ARGNODE = .ARGLST[.CT,ARGNPTR];
%4517%
%4517%			! convert char const to integer constant
%4517%			IF .ARGNODE[OPR1] EQL CONSTFL
%4517%			THEN ARGLST[.CT,ARGNPTR] = MAKECNST(INTEGER,0,.ARGNODE[LITC2])
%4517%			
%4522%			! If we have a non-dummy substring/arrayref then
%4517%			! Change arg2ptr to lower bound instead of lower bound-1 in substrings
%4517%			! Change arg2ptr to array offset instead of array offset-1
%4517%			ELSE IF .ARGNODE[OPRCLS] EQL SUBSTRING
%4517%			     OR .ARGNODE[OPRCLS] EQL ARRAYREF
%4517%			THEN
%4517%			BEGIN
%4522%				IF NOT ISDUMMY(ARGNODE)
%4522%				THEN
%4522%				BEGIN
%4517%					ARGNODE[A2VALFLG] = 0;
%4517%					NODE = MAKPR1(.ARGNODE,ARITHMETIC,ADDOP,INTEGER,.ARGNODE[ARG2PTR],.ONEPLIT);
%4517%					ARGNODE[ARG2PTR] = NODE = (.P2SKL1DISP[.NODE[OPRCLS]])(.NODE);
%4517%					IF .NODE[OPRCLS] EQL DATAOPR
%4517%					THEN ARGNODE[A2VALFLG] = 1
%4517%					ELSE NODE[PARENT] = .ARGNODE;
%4517%				END
%4517%			END
%4517%		END;
%4517%
%4517%
%4517%		!Make an expression node for CONTROL RELATIONAL
%4517%
%4517%		ARGNODE = MAKPR1(.CNODE[PARENT],RELATIONAL,.TMP,CONTROL,0,0);
%4517%		TMP = .CNODE[PARENT];
%4517%		IF .TMP[OPRCLS] EQL FNCALL
%4517%		THEN
%4517%		BEGIN
%4517%			REGISTER I;
%4517%			ALST = .TMP[ARG2PTR];
%4517%			I=0;
%4517%			WHILE .ALST[I=.I+1,ARGNPTR] NEQ .CNODE DO;
%4517%			ALST[.I,ARGNPTR] = CNODE = .ARGNODE;
%4517%		END
%4517%		ELSE
%4517%		BEGIN	! TMP is not a fncall
%4517%			IF .TMP[ARG1PTR] EQL .CNODE
%4517%			THEN TMP[ARG1PTR] = CNODE = .ARGNODE
%4517%			ELSE TMP[ARG2PTR] = CNODE = .ARGNODE;
%4517%		END;
%4517%
%4517%		TMP = .ARGLST[1,ARGNPTR];
%4517%		IF .TMP[OPR1] EQL CONSTFL
%4517%		THEN 	! First arg is a constant
%4517%		BEGIN
%4517%			CNODE[ARG1PTR] = .TMP;
%4517%			CNODE[A1VALFLG] = 1;	
%4517%			CNODE[A1IMMEDFLG] = 1;
%4517%		END
%4517%
%4517%		!Make an inlinfn expression node for first arg 
%4517%
%4517%		ELSE
%4517%		BEGIN
%4557%			ARGNODE = .TMP[ARG1PTR];

%4557%			IF .TMP[OPR1] EQL CHARFNFL	!Remove CHAR over FNCALL
%4557%			THEN IF .ARGNODE[OPRCLS] EQL FNCALL
%4557%			THEN
%4557%			BEGIN
%4557%				CNODE[ARG1PTR] = .TMP[ARG2PTR]; !ARG TO CHAR FN
%4557%				SAVSPACE(EXSIZ-1,.TMP);		!Savspace CHAR node
%4557%				TMP = .CNODE[ARG1PTR];		
%4557%			END;
%4557%
%4517%			ARGNODE = CNODE[ARG1PTR] = MAKPR1(.CNODE,INLINFN,ICHARFN,INTEGER,.TMP,0);
%4517%
%4522%			IF .TMP[OPRCLS] EQL SUBSTRING
%4522%			OR .TMP[OPRCLS] EQL ARRAYREF
%4522%			OR .TMP[OPR1] EQL VARFL
%4522%			THEN IF NOT ISDUMMY(TMP) 
%4522%			THEN ARGNODE[INCRFLG] = 1;	! INCREMENTED BP	
%4517%		END;
%4517%
%4517%		TMP = .ARGLST[2,ARGNPTR];
%4517%		IF .TMP[OPR1] EQL CONSTFL
%4517%		THEN 
%4517%		BEGIN
%4517%			CNODE[ARG2PTR] = .TMP;
%4517%			CNODE[A2VALFLG] = 1;
%4517%			CNODE[A2IMMEDFLG] = 1;
%4517%		END
%4517%
%4517%		!Make an inlinfn expression node for second arg 
%4517%
%4517%		ELSE
%4517%		BEGIN
%4557%			ARGNODE = .TMP[ARG1PTR];

%4557%			IF .TMP[OPR1] EQL CHARFNFL	!Remove CHAR over FNCALL
%4557%			THEN IF .ARGNODE[OPRCLS] EQL FNCALL
%4557%			THEN
%4557%			BEGIN
%4557%				CNODE[ARG2PTR] = .TMP[ARG2PTR]; !ARG TO CHAR FN
%4557%				SAVSPACE(EXSIZ-1,.TMP);		!Savspace CHAR node
%4557%				TMP = .CNODE[ARG2PTR];		
%4557%			END;
%4557%
%4517%			NAME = EXPTAB;
%4517%			ARGNODE = CNODE[ARG2PTR] = NEWENTRY();	!Make an expression node 
%4517%			ARGNODE[PARENT] = .CNODE;
%4517%			ARGNODE[VALTYPE] = INTEGER;
%4517%			ARGNODE[OPRCLS] = INLINFN;
%4517%			ARGNODE[OPERSP] = ICHARFN;
%4517%			ARGNODE[ARG1PTR] = .TMP;	! = .ARGLST[2,ARGNPTR];
%4517%			ARGNODE[ARG2PTR] = 0;

%4517%			IF .TMP[OPRCLS] EQL DATAOPR
%4517%			THEN ARGNODE[A1VALFLG] = 1
%4517%			ELSE TMP[PARENT] = .ARGNODE;

%4522%			IF .TMP[OPRCLS] EQL SUBSTRING
%4522%			OR .TMP[OPRCLS] EQL ARRAYREF
%4522%			OR .TMP[OPR1] EQL VARFL
%4522%			THEN IF NOT ISDUMMY(TMP) 
%4522%			THEN ARGNODE[INCRFLG] = 1;	! INCREMENTED BP	
%4517%		END;
%4517%
%4517%
%4517%		RETURN P2SKREL(.CNODE);
%4517%	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
%2544%		CNODE[A2NEGFLG] = IF .CNODE[A2NEGFLG] THEN 0 ELSE 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***)%

%2030%	CNODE = ARSKOPT(.CNODE);
%2030%
%2030%	IF .NEGFLG AND .CNODE[OPR1] EQL CONSTFL
%2030%	THEN
%2030%	BEGIN
%2030%		NEGFLG = FALSE;
%2030%		CNODE = NEGCNST(CNODE);
%2030%	END;

	%(***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;

%2030%	RETURN .CNODE;

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 has 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
!
!	CNODE is the ARRAYREF expression node.
!***********************************************************************
!--
BEGIN
	MAP PEXPRNODE CNODE;
	LOCAL	PEXPRNODE SSNODE,
		PRVNEGFLG,
		PRVNOTFLG;

	DEBGNODETST(CNODE);		!FOR DEBUGGING ONLY


	SSNODE = .CNODE[ARG2PTR];


	%(*****UNLESS THE ADDRESS-CALCULATION IS A LEAF, PERFORM THE
		PHASE 2 SKEL OPTIMIZATIONS ON IT****)%
	IF NOT .CNODE[A2VALFLG]
	THEN
	BEGIN

		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;

%2243%	! If a numeric array reference is:
%2243%	!
%2243%	! 	o in an innermost DO loop,
%2243%	! 	o and the array is in PSLARGE,
%2243%	! 	o and the index  variable for the DO  is in the  address
%2243%	! 	  calculation for the array,
%2243%	!
%2243%	! then mark that this  should not be an AOBJN loop.
%2243%
%2243%	IF .INNERLOOP
%2243%	THEN ARNOAOBJN(.CNODE);

	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

GLOBAL ROUTINE P2SKFOLD(ARGLIST,PARNODE) =	![2272] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine  is  called to  fold  top-level  subconcatenation
!	nodes in a concatenation argument list, i.e., it will  replace
!	any top-level subconcatenation nodes with their  corresponding
!	operands.
!
!	If there are no  top-level subconcatenation nodes, it  returns
!	ARGLIST (unchanged).
!
!	If there are  top-level subconcatenation  nodes, it  allocates
!	space for a new  argument list, fills it  in, and returns  it.
!	In this case, the parent pointers of all operands of top-level
!	subconcatenation nodes  are replaced  with PARNODE  (but  only
!	when appropriate, i.e., not for symbol table entries).   Also,
!	the original argument list, and all top-level subconcatenation
!	nodes and their argument lists, are deallocated.
!
!	Note that this routine only looks down one level, since it  is
!	assumed  that   skeleton  optimizations   have  already   been
!	performed on every  operand in the  argument list.  Also  note
!	that the first operand  in the argument is  assumed to be  the
!	destination for the concatenation, and is left unchanged.
!
! FORMAL PARAMETERS:
!
!	ARGLIST		points to a concatenation argument list
!	PARNODE		value to be used as a parent pointer
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NAME		set up for call to CORMAN
!
! ROUTINE VALUE:
!
!	Pointer to an equivalent concatenation argument list with  any
!	original top-level concatenation operands folded in at the top
!	level.
!
! SIDE EFFECTS:
!
!	NONE
!
!--


BEGIN
	MAP	ARGUMENTLIST ARGLIST;	! Pointer to the argument list

	REGISTER
		PEXPRNODE ARGNODE,	! Pointer to an argument
		ARGUMENTLIST NEWARGL;	! Pointer to  the  new  argument
					! list    used    when    moving
					! concatenation   subexpressions
					! to top level

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

	INCR I FROM 2 TO .ARGLIST[ARGCOUNT]
	DO
	BEGIN	! For each concat operand

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

		! We've already performed  skeleton optimizations  for
		! each   argument.    Just   count   the   number   of
		! concatenation operands.

		IF .ARGNODE[OPRCLS] EQL CONCATENATION
		THEN
		BEGIN
			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
		ELSE NUMARGS = .NUMARGS + 1;	! Single operand

	END;	! For each concat operand

	! NUMARGS is now the number  of arguments we really want.   If
	! it's equal to  the current  argument count,  then we  didn't
	! find any subconcatenation  nodes that  we want  to fold,  so
	! simply return the original argument list.

	IF .NUMARGS EQL .ARGLIST[ARGCOUNT]
	THEN RETURN .ARGLIST;

	! There are subconcatenations in this argument list.  Build  a
	! new argument list with all concatenation operands at the top
	! level.

	NAME<LEFT> = ARGLSTSIZE(.NUMARGS);	! Size of new arg list

	NEWARGL = CORMAN();			! Get space for new arg list

	! Copy the header words to the new argument list

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

	! Also copy the first argument, which is the destination

	NEWARGL[1,ARGFULL] = .ARGLIST[1,ARGFULL];

	NEWARGL[ARGCOUNT] = .NUMARGS;		! Fill in the arg count

	! Walk down the old argument  list copying the arguments  into
	! the new argument list.  Move the arguments of  concatenation
	! subnodes to the top level.   Don't 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			

		ARGNODE = .ARGLIST[.I,ARGNPTR];		! Get ptr to this arg

		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,
%1641%				! (is not an STE),  then change it  to
%1641%				! point to the parent  of the old  arg
%1641%				! list.
%1641%
%1641%				IF NOT .NEWARGL[.NEWARGPOS,AVALFLG]
%1641%				THEN
%1641%				BEGIN
%1641%					SUBARG = .NEWARGL[.NEWARGPOS,ARGNPTR];
%1641%					SUBARG[PARENT] = .PARNODE;
%1641%				END;

				! Update position in new arg 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);

	RETURN .NEWARGL;

END;	! of P2SKFOLD

ROUTINE P2SKCONCAT(CNODE) =
BEGIN

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

![2272]	Removed code to  fold subconcatenation nodes  and put it  into
![2272]	P2SKFOLD so it can be used elsewhere.

!++
! 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.  Otherwise keep it unchanged at CONCTV.
!--

	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
		LEN,			! Size of the fixed length result
		PEXPRNODE SUBARG;	! Pointer to the argument in  the
					! argument list of a subnode

	LEN = 0;			! Initialize length
	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];

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

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

		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%			SUBARG = .ARGNODE[ARG2PTR];	! .Dnnn return value
%1655%			LEN = .LEN + .SUBARG[IDCHLEN];	! Add in length
%1655%
%1655%		END;		! INLINFN

		BEGIN		! SUBSTRING

%4517%			! Get pointer to upper bound / length 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
%4517%				IF .ARGNODE[OPERSP] EQL SUBSTRUP ! upper/lower substring
%4507%				THEN LEN = .LEN + .UNODE[CONST2] - .LNODE[CONST2]
%4507%				ELSE LEN = .LEN + .UNODE[CONST2];! lower/length substring
			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

		END;		! SUBSTRING

		BEGIN		! CONCATENATION

			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

		END;		! CONCATENATION

		TES;

	END;	! Walk down the argument list


	! Now try  to make  this a  "fixed length"  or "known  maximum
	! length" concatenation.  Leave it "variable length" if it  is
	! too large, since we'd rather do this on the character  stack
	! than allocating  large  amounts  of static  storage  in  the
	! user's program.  Note that LEN will be ill-defined if  there
	! are any variable-length operands.  In this case,  ISFIXEDLEN
	! and ISMAXLEN  will both  be false  (i.e., the  concatenation
	! will remain variable-length), so the following test is still
	! safe.

%2251%	IF .LEN LEQ .BIGCONCAT
%2251%	THEN
%2251%	BEGIN	! Length small enough to make non-dynamic

		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

%2251%	END;	! Length small enough to make non-dynamic

%2272%	! Fold top-level concats
%2272%
%2272%	CNODE[ARG2PTR] = P2SKFOLD(.ARGLIST,.CNODE);

	RETURN .CNODE		! Return the new node

END;	! of P2SKCONCAT

GLOBAL ROUTINE P2SKOVRLP = 		![2304] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	This  routine  performs  compile-time  overlap  detection  for
!	character assignments.   The assignment  statement is  a  CALL
!	statement pointed to by CSTMNT, and should call either  CASNM.
!	or CNCAM.,  which  are  the routines  that  perform  character
!	assignment in its most general case.
!
!	This routine  tries to  determine whether  or not  overlap  is
!	possible in the character  assignment.  If it determines  that
!	overlap cannot occur, it replaces the call to CASNM. or CNCAM.
!	with a call to CASNN. or CNCAN. (these routines assume there's
!	no overlap).
!
!	As a future development  edit, the following optimization  may
!	be added:  If it  determines that  overlap always  occurs,  it
!	replaces the call to CASNM. or  CNCAM.  with a call to  CASNO.
!	or CNCAO. (these routines assume there's overlap).
!
!	If  it  can't  make  any  determination  at  compile-time,  it
!	preserves the call to the original routine (CASNM. or CNCAM.).
!	These routines make no  assumptions about overlap and  perform
!	run-time tests to determine whether or not overlap occurs.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	CSTMNT		This  points   to   a   character   assignment
!			statement (i.e., a CALL statement to CASNM. or
!			CNCAM.)
!
!	FLAG		Set by TBLSEARCH.   True if  the symbol  table
!			entry already existed.
!
! IMPLICIT OUTPUTS:
!
!	CSTMNT[CALSYM]	This is the name of  the routine to be  called
!			by the CALL statement pointed to by CSTMNT.
!
!	ENTRY		Set  for  call  to  TBLSEARCH.   Contains  the
!			[length,,pointer] to name of the symbol table entry.
!
!	NAME		Set for  call to  TBLSEARCH.  Indicates  which
!			table to use.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	None
!
!--


BEGIN

	REGISTER
		ARGUMENTLIST ARGLIST,	! Pointer to the argument list
		BASE SRCNAME,		! Pointer to symbol table entry
					! for a source variable
		BASE DESTNAME;		! Pointer to symbol table entry
					! for destination variable

	LOCAL	NOOVRLP,		! Flag indicating no overlap
		BASE CALLNAME;		! Pointer to symbol table entry
					! for name of routine being called

	LABEL	SRCWALK,		! Labels loop to walk source strings
		THISSRC;		! Labels body of loop to walk source
					! strings

	ARGLIST = .CSTMNT[CALLIST];		! Get pointer to argument list
	DESTNAME = .ARGLIST[1,ARGNPTR];		! Get pointer to destination

	! DESTNAME is either a SUBSTRING, an ARRAYREF, or a variable

	IF .DESTNAME[OPRCLS] EQL SUBSTRING	! If DESTNAME is a substring
	THEN DESTNAME = .DESTNAME[ARG4PTR];	! Get full string

	! DESTNAME is now either an ARRAYREF or a variable

	IF .DESTNAME[OPRCLS] EQL ARRAYREF	! If DESTNAME is an array ref
	THEN DESTNAME = .DESTNAME[ARG1PTR];	! Get ptr to array name

	! DESTNAME is now a variable or array name

	NOOVRLP = TRUE;				! Initially assume no overlap

SRCWALK:
	INCR I FROM 2 TO .ARGLIST[ARGCOUNT]
	DO
THISSRC:
	BEGIN	! For each source string

		SRCNAME = .ARGLIST[.I,ARGNPTR];		! Get ptr to next src
	
		IF .SRCNAME[OPERATOR] EQL CHARCONST	! If SRCNAME is const
		THEN LEAVE THISSRC;			! No overlap

		IF .SRCNAME[OPRCLS] NEQ SUBSTRING
		THEN IF .SRCNAME[OPRCLS] NEQ ARRAYREF
		THEN IF .SRCNAME[OPRCLS] NEQ DATAOPR
		THEN LEAVE THISSRC;			! No overlap

		! SRCNAME is now either a SUBSTRING, an ARRAYREF, or a variable

		IF .SRCNAME[OPRCLS] EQL SUBSTRING	! If substring
		THEN SRCNAME = .SRCNAME[ARG4PTR];	! Get full string

		! SRCNAME is now either an ARRAYREF or a variable

		IF .SRCNAME[OPRCLS] EQL ARRAYREF	! If an array ref
		THEN SRCNAME = .SRCNAME[ARG1PTR];	! Get ptr to array name

		! SRCNAME is now a variable or array name

		IF .SRCNAME EQL .DESTNAME		! Check for match
		THEN
		BEGIN	! Matching source and destination names

			!!! This should become more sophisticated someday

			!!! Could also check to see if array indices are
			!!! different constants

			NOOVRLP = FALSE;		! Assume overlap
			LEAVE SRCWALK;			! Punt

		END	! Matching source and destination names

		! Now check for common/equivalence potential  overlap.

%2404%		ELSE IF UNSAFE(.SRCNAME,.DESTNAME)
		THEN
		BEGIN	! Potential common/equiv problems

			NOOVRLP = FALSE;		! Assume overlap
			LEAVE SRCWALK;			! Punt

		END;	! Potential common/equiv problems

	END;	! For each source string

	IF .NOOVRLP
	THEN
	BEGIN	! No overlap

		NAME = IDTAB;			! Look in symbol table

		CALLNAME = .CSTMNT[CALSYM];	! Get routine name

		! See if we're calling CASNM. or CNCAM., and set ENTRY
		! accordingly.

%4527%		IF .CALLNAME[ID1ST6CHAR] EQL SIXBIT 'CASNM.'
		THEN ENTRY = SIXBIT 'CASNN.'	! It's CASNM., make it CASNN.
		ELSE ENTRY = SIXBIT 'CNCAN.';	! It's CNCAM., make it CNCAN.

%4515%		ENTRY = ONEWPTR(.ENTRY);	! [1,,pointer]

		! Get the symbol table entry for the new routine.  If
		! it's not already there, create it.

		CSTMNT[CALSYM] = CALLNAME = TBLSEARCH();

		IF NOT .FLAG			! New symbol table entry?
		THEN
		BEGIN	! New symbol table entry

			CALLNAME[OPERSP] = FNNAME;	! Func/subr name
			CALLNAME[IDLIBFNFLG] = 1;	! Library func/subr
			CALLNAME[IDCLOBB] = 1;		! ACs are clobbered

%2307%			! Have to manually set NOALLOC after phase 1
%2307%
%2307%			CALLNAME[IDATTRIBUT(NOALLOC)] = 1;

		END;	! New symbol table entry

	END;	! No overlap

END;	! of P2SKOVRLP

GLOBAL ROUTINE SINGLECHARCHK(EXP) =	

!++
! FUNCTIONAL DESCRIPTION:
!
!	Checks if EXP is a one character const, variable, array element,
!	substring or function call
!
! FORMAL PARAMETERS:
!
!	EXP	Expression node
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	Return 1 if EXP is a single character substring, array ref, 
!	variable, const or function call. Otherwise, return 0 
!
! SIDE EFFECTS:
!
!	None
!
!--



BEGIN	! New [4517]

	MAP BASE EXP;
	REGISTER BASE EXP2;
	IF .EXP[VALTYPE] NEQ CHARACTER THEN RETURN FALSE;

	IF .EXP[OPR1] EQL SUBSLFL AND .EXP[A1VALFLG]
	THEN	! lower/length substring
	BEGIN
		RETURN .EXP[ARG1PTR] EQL .ONEPLIT ! true if constant 1
	END
	ELSE IF .EXP[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		EXP2 = .EXP[ARG1PTR];	! EXP2 = variable
		RETURN .EXP2[IDCHLEN] EQL 1 ! true if 1 char array element
	END
	ELSE IF .EXP[OPRCLS] EQL DATAOPR
	THEN
	BEGIN
		IF .EXP[OPERSP] EQL VARIABLE THEN
      		BEGIN
			RETURN .EXP[IDCHLEN] EQL 1 ! true if 1 char
		END
		ELSE IF .EXP[OPERSP] EQL CONSTANT
		THEN
		BEGIN
			RETURN .EXP[LITLEN] EQL 1 ! true if const 1
		END
	END
%4522%	ELSE IF .EXP[OPRCLS] EQL FNCALL
%4522%	THEN
%4522%	BEGIN
%4522%		EXP2 = .EXP[ARG1PTR];	!Routine name
%4522%		
%4522%		RETURN .EXP2[IDCHLEN] EQL 1	! true if 1 char
%4522%	END;

	RETURN 0
END;

ROUTINE P2SKSUBSTR(CNODE)=		![1431] New

%(**********************************************************************
	PHASE 2 SKELETON FOR A SUBSTRING NODE
[4507]	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.

[2401]	Note that this latter  NYI optimization will probably  involve
[2401]	the creation of a compile-time constant (.Dnnnn), or partially
[2401]	initialized  (.Qnnnn)  descriptor.   If  so,  or  if  any  new
[2401]	aliasing of this type is  implemented, it must be done  during
[2401]	the complexity walk (in DOTDCHECK) to avoid creating bugs.
**********************************************************************)%

BEGIN
MACRO STRIPCONST(BOUND,CONSTSUM,NEGFLG,LOWLEN) = 	! [4507] New
!
! FORMAL PARAMETERS:
!
!	BOUND		lower or upper bound of a substring index
!
!	CONSTSUM	sum of constants in length of substring
!
!	NEGFLG		negflg for BOUND ( set if BOUND = k - D)
!
!	LOWLEN		false if BOUND is not one of the following
!			     	D + k		D - k	  D
!			     	k + D		k - D     k
!			where D is a dataopr and k is a constant
!

BEGIN
	MAP	BASE	BOUND;
	LOCAL 	BASE ARG1:ARG2;

	IF .BOUND[OPR1] EQL ADDOPF	! D + k   or    k + D  or  D + D2
	THEN
	BEGIN
		ARG1 = .BOUND[ARG1PTR];
		ARG2 = .BOUND[ARG2PTR];
		IF .ARG1[OPERSP] EQL CONSTANT	! k + D
		THEN
		BEGIN
			IF .BOUND[A1NEGFLG]
			THEN CONSTSUM = .CONSTSUM - .ARG1[CONST2]
			ELSE CONSTSUM = .CONSTSUM + .ARG1[CONST2];

			BOUND = .BOUND[ARG2PTR];
		END
		ELSE IF .ARG2[OPERSP] EQL CONSTANT! D + k
		THEN
		BEGIN
			IF .BOUND[A2NEGFLG]
			THEN CONSTSUM = .CONSTSUM - .ARG2[CONST2]
			ELSE CONSTSUM = .CONSTSUM + .ARG2[CONST2];

			BOUND = .BOUND[ARG1PTR];
		END
		ELSE LOWLEN = FALSE;	! D + D2
	END
	ELSE IF .BOUND[OPERSP] EQL SUBOPF	! D - k  or  k - D  or  D - D2
	THEN
	BEGIN
		ARG1 = .BOUND[ARG1PTR];
		ARG2 = .BOUND[ARG2PTR];

		IF .ARG2[OPERSP] EQL CONSTANT	! D - k
		THEN
		BEGIN
			IF .BOUND[A2NEGFLG]
			THEN CONSTSUM = .CONSTSUM + .ARG1[CONST2]
			ELSE CONSTSUM = .CONSTSUM - .ARG1[CONST2];

			BOUND = .ARG1;
		END
		ELSE IF .ARG1[OPERSP] EQL CONSTANT! k - D
		THEN
		BEGIN
			IF .BOUND[A1NEGFLG]
			THEN CONSTSUM = .CONSTSUM - .ARG1[CONST2]
			ELSE CONSTSUM = .CONSTSUM + .ARG1[CONST2];
			
			NEGFLG = 1;
			
			BOUND = .ARG2;
		END
		ELSE LOWLEN = FALSE;		! D - D2
	END
	ELSE LOWLEN = FALSE;	! not an addop or subop
END$;

	MAP PEXPRNODE CNODE;
	REGISTER PEXPRNODE LNODE:UNODE:ANODE;
	LOCAL PEXPRNODE DVAR;
	LOCAL PRVNEGFLG,PRVNOTFLG;
%1557%	LOCAL PEXPRNODE CHLEN;
%4507%	LOCAL BASE SUBNODE:LENNODE;	! USED FOR BUILDING SUBSTRING NODE
%4507%	LOCAL CONSTSUM,LNEGFLG,UNEGFLG;	! USED FOR BUILDING SUBSTRING NODE
%4507%	LOCAL LOWLEN;			! FLAG INDICATING IF THE NEW LENGTH/LOW
					! NODE CAN BE BUILT

	DEBGNODETST(CNODE);		! For debugging only

%4517%	! If we already have a lower/length form then return
%4517%	IF .CNODE[OPERSP] EQL SUBSTRLEN THEN RETURN .CNODE;

	! Perform skel optimizations on offspring nodes

%4507%	UNODE = .CNODE[ARG1PTR];	! UNODE points to upper bound or length expr
%4507%	LNODE = SUBNODE = .CNODE[ARG2PTR];! LNODE points to lower bound-1 expr

%4507%	IF .LNODE[OPR1] NEQ SUBOPF THEN SKERR();
%4507%	LNODE = .LNODE[ARG1PTR];	! LNODE points to lower bound 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

%4507%	IF NOT .SUBNODE[A1VALFLG]
%4507%	THEN
%4507%	BEGIN	! do L node
%4507%		PRVNEGFLG = .NEGFLG;
%4507%		PRVNOTFLG = .NOTFLG;
%4507%		NEGFLG = NOTFLG = FALSE;
%4507%		SUBNODE[ARG1PTR] = LNODE = (.P2SKL1DISP[.LNODE[OPRCLS]])(.LNODE);
%4507%		SUBNODE[A1NEGFLG] = .NEGFLG;
%4507%		SUBNODE[A1NOTFLG] = .NOTFLG;
%4507%		NEGFLG = .PRVNEGFLG;
%4507%		NOTFLG = .PRVNOTFLG;
%4507%	END;	! do L node
%4510%
%4510%	! Get the length  of the character  variable or array  element
%4510%	! we're taking the substring from.
%4510%
%4510%	IF .ANODE[OPRCLS] NEQ ARRAYREF
%4510%	THEN CHLEN = .ANODE[IDCHLEN]	! ANODE is scalar, get its length
%4510%	ELSE 
%4510%	BEGIN	! ARRAYREF
%4510%
%4510%		CHLEN = .ANODE[ARG1PTR];	! Array name
%4510%		CHLEN = .CHLEN[IDCHLEN];	! Length of array element
%4510%
%4510%	END;	! ARRAYREF
%4510%
%4510%	IF .LNODE[OPR1] EQL CONSTFL
%4510%	THEN IF .LNODE[CONST2] LSS 1	! Lower bound must be >= 1
%4510%		OR			! and < CHLEN
%4510%		(.CHLEN NEQ LENSTAR AND .LNODE[CONST2] GTR .CHLEN)
%4510%	THEN FATLERR(.ISN,E165<0,0>);	! Give bounds error
%4510%
%4510%	IF .UNODE[OPR1] EQL CONSTFL
%4510%	THEN
%4510%	BEGIN	! Upper bound is constant
%4510%
%4510%		IF .UNODE[CONST2] LSS 1		! Upper bound must be >= 1
%4510%			OR			! and <= CHLEN
%4510%			(.CHLEN NEQ LENSTAR AND .UNODE[CONST2] GTR .CHLEN)
%4510%		THEN FATLERR(.ISN,E165<0,0>);	! Give bounds error
%4510%
%4510%
%4510%		IF .LNODE[OPR1] EQL CONSTFL
%4510%		THEN
%4510%		BEGIN	! Upper and lower bounds are both constant
%4510%
%4510%			! Give a bounds error if the lower bound minus
%4510%			! one  is  >=  the  upper  bound  (i.e.,   the
%4510%			! user-specified lower  bound is  > the  upper
%4510%			! bound).
%4510%
%4510%			IF .LNODE[CONST2] GTR .UNODE[CONST2]
%4510%			THEN FATLERR(.ISN,E165<0,0>)	! Give bounds error
%4510%		END;
%4510%	END;
%4510%
%4507%	! If both the upper and lower bounds are of one of the following forms
%4507%	! then we should make a lower/length substring node
%4507%
%4507%	!	D		D + k		D - k
%4507%	!	k		k + D		k - D
%4507%	 
%4507%	! where D = a dataopr and k = a constant
%4507%
%4507%	LOWLEN = TRUE;	! Assume both indexes are of the appropriate form until
%4507%			! we find otherwise
%4507%	LNEGFLG = .SUBNODE[A1NEGFLG];
%4507%	UNEGFLG = .CNODE[A1NEGFLG];
%4507%
%4507%
%4507%	! Check if lower bound is of one of the 6 cases and set LOWLEN accordingly
%4507%	CONSTSUM = 0;
%4507%	IF (.LNODE[OPRCLS] NEQ DATAOPR)
%4507%	THEN
%4507%	BEGIN
%4507%		IF (.LNODE[A1VALFLG]) AND (.LNODE[A2VALFLG])
%4507%		THEN    STRIPCONST(LNODE,CONSTSUM,LNEGFLG,LOWLEN)
%4507%		
%4507%		ELSE LOWLEN = FALSE;
%4507%	END;
%4507%
%4507%	CONSTSUM = 1 - .CONSTSUM;		! length = U - (L-1) = 1-L+U
%4507%
%4507%	! Check if upper bound is of one of the 6 cases and set LOWLEN accordingly
%4507%	IF (.UNODE[OPRCLS] NEQ DATAOPR) AND (.LOWLEN EQL TRUE)
%4507%	THEN
%4507%	BEGIN
%4507%		IF (.UNODE[A1VALFLG]) AND (.UNODE[A2VALFLG])
%4507%		THEN STRIPCONST(UNODE,CONSTSUM,UNEGFLG,LOWLEN)
%4507%		ELSE LOWLEN = FALSE;
%4507%	END;
%4507%
%4507%	IF .LOWLEN EQL TRUE
%4507%	THEN	! Make lower/length substring node
%4507%	BEGIN
%4507%		CNODE[OPERSP] = SUBSTRLEN;
%4507%
%4507%		! Length node will look like	+
%4507%		!			      /   \
%4507%		!			     -	   C
%4507%		!			   /   \
%4507%		!			  U     L
%4507%		!
%4507%		! where upper bound = U + k
%4507%		!       lower bound = L + k2
%4507%		!       C = k + k2 + 1
%4507%		
%4507%		
%4507%		
%4507%		! Make UBOUND into length node 
%4507%
%4507%		LENNODE = MAKPR1(.CNODE,ARITHMETIC,ADDOP,INTEGER,0,MAKECNST(INTEGER,0,.CONSTSUM));
%4507%		SUBNODE = MAKPR1(.LENNODE,ARITHMETIC,SUBOP,INTEGER,.UNODE,.LNODE);
%4507%		
%4507%		SUBNODE[A1NEGFLG] = .UNEGFLG;
%4507%		SUBNODE[A2NEGFLG] = .LNEGFLG;
%4507%		
%4507%		LENNODE[ARG1PTR] = .SUBNODE;
%4507%		UNODE = CNODE[ARG1PTR] = .LENNODE;
%4507%		CNODE[A1VALFLG] = 0;	
%4507%
%4507%		IF NOT .CNODE[A1VALFLG]
%4507%		THEN
%4507%		BEGIN	! do U node
%4507%			PRVNEGFLG = .NEGFLG;	! Cannot pass neg/not down over
%4507%			PRVNOTFLG = .NOTFLG;	!   substring, so stop them here
%4507%			NEGFLG = NOTFLG = FALSE; !  and pass them back up to parent.
%4507%			CNODE[ARG1PTR] = UNODE = (.P2SKL1DISP[.UNODE[OPRCLS]])(.UNODE);
%4507%			CNODE[A1NEGFLG] = .NEGFLG;
%4507%			CNODE[A1NOTFLG] = .NOTFLG;
%4507%			NEGFLG = .PRVNEGFLG;
%4507%			NOTFLG = .PRVNOTFLG;
%4507%		END;	! do U node
%4507%	END;
%4507%
%4507%	LNODE = .CNODE[ARG2PTR];
%4507%	IF .LNODE[OPRCLS] EQL DATAOPR 
%4507%	THEN .CNODE[A2VALFLG] = 1
%4507%	ELSE LNODE[PARENT] = .CNODE;
%4507%
%4507%	! If we have a lower/length substring node and ANODE is an arrayref
%4507%	! then add the array offset to the lower bound and set anode to
%4507%	! anode[arg1ptr]
%4507%
%4517%	IF .CNODE[OPERSP] EQL SUBSTRLEN AND .ANODE[OPRCLS] EQL ARRAYREF
%4507%	THEN	
%4507%	BEGIN
%4507%		CNODE[ARG2PTR] = LNODE = MAKPR1(.CNODE,ARITHMETIC,ADDOP,INTEGER,.LNODE,.ANODE[ARG2PTR]);
%4507%		SUBNODE = .ANODE;	
%4507%		CNODE[ARG4PTR] = ANODE = .ANODE[ARG1PTR];
%4507%		SAVSPACE(EXSIZ-1,.SUBNODE)	! savspace arrayref node
%4507%	END;

	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
%2401%	THEN CNODE[ARG4PTR] = (.P2SKL1DISP[.ANODE[OPRCLS]])(.ANODE);

%2401%	! Remove code  which creates  .Dnnnn variables.   This is  now
%2401%	! done during the complexity walk, along with bounds checking,
%2401%	! by DOTDCHECK.

	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
%4517%		BASE NODE:ARG1;

	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 this function call into something else now.  We may
	! be able to  fold this into  a constant  or a node  that the  compiler
	! already recognizes.

	IF .FNNAMENTRY[IDFNFOLD]
	THEN
	BEGIN	! Try to fold into a constant

		! Try to optimize library functions based on the function type.
		! If we can fold into  something better, then return to  caller
		! and stop processing for an inline function.

%2352%		CASE .FNNAMENTRY[IDILFOPERSP] OF SET
%2352%
%2352%		BEGIN END;	! ABSFN - Can't fold
%2352%		BEGIN END;	! CMPLXFN - Can't fold
%2352%		BEGIN END;	! SIGNFN - Can't fold
%2352%		BEGIN END;	! DIMFN - Can't fold
%2352%		BEGIN END;	! MODFN - Can't fold
%2352%		BEGIN END;	! MAXFN - Can't fold
%2352%		BEGIN END;	! MINFN - Can't fold
%1535%		BEGIN	! CHARFN
%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;	! CHARFN
		BEGIN	! LENFN
		
			! 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.

%2007%			! If the  argument is  a dynamic  concatenation,
%2007%			! then don't make this into an inline fn.
%2007%			IF .ARGNODE[OPR1] EQL DYNCONCAT THEN RETURN .CNODE;

			! 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;	! LENFN
%1535%		BEGIN	! ICHARFN
%4517%
%4517%			! ichar(c1) <= ichar(c1//c2//...cn)
%4517%
%4517%			IF .ARGNODE[OPRCLS] EQL CONCATENATION
%4517%			THEN
%4517%			BEGIN
%4517%				LOCAL ARGUMENTLIST ALST;
%4517%
%4517%				ALST = .ARGNODE[ARG2PTR];
%4517%				! SAVSPACE
%4517%				ARGNODE = .ALST[2,ARGNPTR];
%4517%				ARGNODE[PARENT] = .CNODE;
%4517%				ARGLST[1,ARGNPTR] = .ARGNODE;
%4517%			END;
%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

%4517%			ELSE IF .ARGNODE[OPR1] EQL VARFL
%4517%			THEN
%4517%			BEGIN
%4517%				IF NOT .ARGNODE[IDATTRIBUT(DUMMY)] 
%4517%				THEN CNODE[INCRFLG] = 1; !INCREMENTED BP
%4517%			END
%4517%			ELSE IF .ARGNODE[OPRCLS] EQL SUBSTRING
%4517%			THEN
%4517%			BEGIN
%4517%				LOCAL BASE LEN;
%4517%				LEN = .ARGNODE[ARG1PTR];
%4517%
%4517%				NODE = .CNODE[ARG4PTR];     !ARRAYREF/VARIABLE
%4517%				IF .NODE[OPRCLS] EQL ARRAYREF
%4517%				THEN NODE = .NODE[ARG1PTR]; !VARIABLE

%4517%				IF NOT .NODE[IDATTRIBUT(DUMMY)]
%4517%				THEN	! non-dummy substring
%4517%				BEGIN	
%4517%					CNODE[INCRFLG] = 1; !ALREADY INCREMENTED BP
%4517%
%4517%					! Make all substrings of length 1
%4517%					IF .ARGNODE[OPERSP] NEQ SUBSTRLEN 
%4517%					OR .LEN[OPR1] NEQ CONSTFL OR .LEN[CONST2] NEQ 1
%4517%					THEN 
%4517%					BEGIN
%4517%						IF .LEN[OPR1] NEQ CONSTFL AND .LEN[OPR1] NEQ VARFL
%4517%						THEN SAVSPACE(EXSIZ-1,.ARGNODE[ARG1PTR]);
%4517%
%4517%						IF .LEN NEQ .ONEPLIT
%4517%						THEN
%4517%						BEGIN
%4517%							ARGNODE[ARG1PTR] = .ONEPLIT;
%4517%							ARGNODE[A1VALFLG] = 1;
%4517%							ARGNODE[A1IMMEDFLG] = 1;
%4517%						END;
%4517%					END;
%4517%
%4517%					! Change arg2ptr to lower bound instead of 
%4517%					! lower bound-1	in all non-dummy substrings 
%4517%					ARG1 = .ARGNODE[ARG1PTR];
%4517%					NODE = .ARGNODE[ARG2PTR];
%4517%					ARGNODE[A2VALFLG] = 0;
%4517%					ARGNODE[ARG2PTR] = NODE = MAKPR1(.ARGNODE,ARITHMETIC,ADDOP,INTEGER,.NODE,.ONEPLIT);
%4517%					ARGNODE[ARG2PTR] = (.P2SKL1DISP[.NODE[OPRCLS]])(.NODE);
%4517%				END	! non-dummy substring
%4517%			END
%4517%
%4517%			ELSE IF .ARGNODE[OPRCLS] EQL ARRAYREF
%4517%			THEN
%4517%			BEGIN
%4517%				NODE = .ARGNODE[ARG1PTR]; !VARIABLE
%4517%				IF NOT .NODE[IDATTRIBUT(DUMMY)]
%4517%				THEN	! non-dummy arrayref
%4517%				BEGIN
%4517%					CNODE[INCRFLG] = 1; !ALREADY INCREMENTED BP
%4517%
%4517%					! Change arg2ptr to array offset instead of array 
%4517%					! offset-1 in all non-dummy arrayrefs
%4517%					NODE = .ARGNODE[ARG2PTR];
%4517%					ARGNODE[A2VALFLG] = 0;
%4517%					ARGNODE[ARG2PTR] = NODE = MAKPR1(.ARGNODE,ARITHMETIC,ADDOP,INTEGER,.NODE,.ONEPLIT);
%4517%					ARGNODE[ARG2PTR] = (.P2SKL1DISP[.NODE[OPRCLS]])(.NODE);
%4517%				END	! non-dummy arrayref
%4517%			END
%1535%
%1535%		END;	! ICHARFN
%2352%		BEGIN	! IORFN
%2352%
%2352%			! Convert this to be a simple Fortran OR.  Setup  arg1,
%2352%			! arg2, then skeleton optimize this new node.
%2352%
%2352%			CNODE[OPR1] = OROPFL;
%2352%
%2352%			CNODE[ARG1PTR] = .ARGLST[1,ARGNPTR];
%2352%			CNODE[A1VALFLG] = .ARGLST[1,AVALFLG];
%2352%
%2352%			CNODE[ARG2PTR] = .ARGLST[2,ARGNPTR];
%2352%			CNODE[A2VALFLG] = .ARGLST[2,AVALFLG];
%2352%
%2352%			RETURN (.P2SKL1DISP[.CNODE[OPRCLS]])(.CNODE);
%2352%
%2352%		END;	! IORFN
%2352%		BEGIN	! IAND
%2352%
%2352%			! Convert this to be a simple Fortran AND.  Setup arg1,
%2352%			! arg2, then skeleton optimize this new node.
%2352%
%2352%			CNODE[OPR1] = ANDOPFL;
%2352%
%2352%			CNODE[ARG1PTR] = .ARGLST[1,ARGNPTR];
%2352%			CNODE[A1VALFLG] = .ARGLST[1,AVALFLG];
%2352%
%2352%			CNODE[ARG2PTR] = .ARGLST[2,ARGNPTR];
%2352%			CNODE[A2VALFLG] = .ARGLST[2,AVALFLG];
%2352%
%2352%			RETURN (.P2SKL1DISP[.CNODE[OPRCLS]])(.CNODE);
%2352%
%2352%		END;	! IANDFN
%2352%		BEGIN CGERR() END;	! ISHFTFN - ** not yet implimented
%2352%		BEGIN CGERR() END;	! ISHFTCFN - ** not yet implimented
%2352%		BEGIN CGERR() END;	! IBITSFN - ** not yet implimented
%2352%		BEGIN CGERR() END;	! NOTFN - ** not yet implimented
%2352%		BEGIN	! IEORFN
%2352%
%2352%			! Convert this to be a simple Fortran XOR.  Setup arg1,
%2352%			! arg2, then skeleton optimize this new node.
%2352%
%2352%			CNODE[OPR1] = XOROPFL;
%2352%
%2352%			CNODE[ARG1PTR] = .ARGLST[1,ARGNPTR];
%2352%			CNODE[A1VALFLG] = .ARGLST[1,AVALFLG];
%2352%
%2352%			CNODE[ARG2PTR] = .ARGLST[2,ARGNPTR];
%2352%			CNODE[A2VALFLG] = .ARGLST[2,AVALFLG];
%2352%
%2352%			RETURN (.P2SKL1DISP[.CNODE[OPRCLS]])(.CNODE);
%2352%
%2352%		END;	! IEORFN
%2352%		BEGIN CGERR() END;	! BTESTFN - ** not yet implimented
%2352%		BEGIN CGERR() END;	! IBSETFN - ** not yet implimented
%2352%		BEGIN CGERR() END;	! IBCLRFN - ** not yet implimented
%2352%
%2352%		TES;	! End of CASE

	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

! Below is for use in making PLM's with RUNOFF
!++
!.END LITERAL
!--

END
ELUDOM