Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/HPW/MD/DCE/JNG
MODULE	P2S2(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES) =
BEGIN

GLOBAL BIND P2S2V = 5^24 + 1^18 + 56;	!VERSION DATE: 18-AUG-77

%(
REVISION HISTORY

47	-----	-----	FOLD EXPONENTIATIONS WHICH
			REQUIRE FEWER THAN 8 MULTIPLIES INTO THE SPECIAL
			OPERATOR EXPCIOP
			ELIMINATE SQROP, CUBOP, P4OP
48	-----	-----	FIX INTEGC AND CREATION OF SPECIAL OP EXPCIOP

49	-----	-----	DO DP EXPONENS TO INTEGER POWERS IN LINE ON KI10
50	-----	-----	MAKE "CNTMPY" A GLOBAL ROUTINE
51	331	17091	FIX TAKNEGARG FOR OPERATOR EXPCIOP
			RAISE TO AN ODD POWER CANNOT ABSORB NEG
52	345	17554	ABSORB NEG CORRECTLY FOR EVEN EXPONENTIATION
53	430	18876	ABSORB NEG IN ARITHMETIC IF CORRECTLY

	BEGIN VERSION 5A, 7-NOV-76

54	530	21606	DO NOT ALLOW FSC ON DOUBLE PRECISION NUMBERS
55	553	21826	BE CAREFUL COLLAPSING AN AND NODE WITH TRUE AS ARG
56	610	23333	FIX EDIT 52 (MUST TEST OPERCLAS TOO)
)%

	EXTERNAL
		CANONICALIZE,CGERR,MAKEPR,C1H,C1L,C2H,C2L,COPRIX,CNSTCM,
		KBOOLBASE,KTYPCB,SPKABA,CNSTCMB,TBLSEARCH,
		SKERR;
	FORWARD
		TAKNEGARG(1),SETNEG(2),DNEGCNST(1),NEGOFNOT(1),NOTOFNEG(1), BLCMB(3), 
		ARCMB(4),CMBEQLARGS(1),FOLDLIF(0),FOLDAIF(0);


	EXTERNAL
		P2SKBL,P2SKREL,P2SKFN,P2SKARITH,P2SKLTP,P2SKLARR,
		P2SKNEGNOT;


EXTERNAL NEGFLG,NOTFLG;

EXTERNAL P2SKL1DISP;

EXTERNAL SETPVAL;
EXTERNAL KDNEGB;

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



%(***************************************************************************
	THIS MODULE CONTAINS ROUTINES USED BY PHASE 2 SKELETON.
***************************************************************************)%



GLOBAL ROUTINE TAKNOTARG(PNODE)=
%(***************************************************************************
	THIS ROUTINE RETURNS "TRUE" IFF THE NODE POINTED TO BY PNODE CAN
	ABSORB A "NOT" ON ITS ARGS AS "A1NOTFLG" OR "A2NOTFLG"
***************************************************************************)%
BEGIN
	MAP PEXPRNODE PNODE;

	%(***WHETHER OR NOT A NODE CAN ABSORB A NOT FROM BELOW DEPENDS ON ITS OPRCLS**)%
	RETURN
	(
		CASE .PNODE[OPRCLS] OF SET
		TRUE;			!BOOLEAN NODES ABSORB NOT ON SONS
		FALSE;		!SHOULD NEVER SEE A DATA NODE AS A "PARENT"
		FALSE;		!RELATIONALS CANNOT ABSORB 'NOT' FROM SONS
					! (NOTE HOWEVER THAT THEY DO ABSORB 'NOT' PROPAGATED
					! DOWN FROM ABOVE THEM
		FALSE;		!NOT ON AN ARG TO A FN CALL CANNOT BE ABSORBED
		FALSE;		!ARITHMETIC NODES DO NOT ABSORB NOT
		BEGIN			!TYPE-CONV NODES ABSORB NOT EXCEPT
			IF NOCNV(PNODE)	! FOR THOSE THAT DONT ACTUALLY
			THEN TAKNOTARG(.PNODE[PARENT])
			ELSE TRUE		! GENERATE ANY CODE
		END;
		TRUE;			!ARRAY-REF NODES ABSORB NOT ON THE ADDR CALC
		TRUE;			!COMMON SUBEXPR NODES ABSORB NOT
		TRUE;			!NEG/NOT NODES ABSORN NOT
		TRUE;			!THE SPECIAL-CASE OPERATORS ABSORB NOT
		FALSE;		!FIELD-REF - NOT IN RELEASE 1
		FALSE;		!STORECLS - SHOULD NOT OCCUR IN P2S
		FALSE;		!REGCONTENTS - NOT ABOVE NEG/NOT
		FALSE;		!LABOP
		BEGIN			!STATEMENT - FOR ASSIGNMENT AND LOGICAL IF,
					! PARENT CAN ABSORN NOT, OTHERWISE IT CANT
			IF .PNODE[SRCID] EQL ASGNID OR .PNODE[SRCID] EQL IFLID
			THEN TRUE
			ELSE FALSE
		END;
		FALSE;		!IOLSCLS - CANNOT PROPAGATE
		FALSE;		!INLINFN - CANNOT PROPAGATE FOR ALL OF
					! THEM, SO DONT BOTHER
		TES
	)
END;


GLOBAL ROUTINE TAKNEGARG(PNODE)=
%(***************************************************************************
	THIS ROUTINE RETURNS "TRUE" IFF THE NODE PNODE  CAN ABSORB A
	NEG ON ITS ARG(S) AS "A1NEGFLG" OR "A2NEGFLG".
***************************************************************************)%
BEGIN
	MAP PEXPRNODE PNODE;

	%(***WHETHER OR NOT A NODE CAN ABSORB A NEG FROM BELOW DEPENDS ON ITS OPRCLS***)%
	RETURN
	(
		CASE .PNODE[OPRCLS] OF SET
		FALSE;			!BOOLEANS DO NOT ABSORB NEG
		FALSE;			!DATA ITEM (SHOULD NEVER OCCUR)
		TRUE;			!RELATIONALS DO ABSORB NEG
		FALSE;			!NEG ON ARG TO A FN CALL CANNOT BE ABSORBED
		BEGIN			!ARITH NODES EXCEPT FOR EXPONEN ABSRB NEG
			IF .PNODE[OPERSP] EQL EXPONOP
			THEN FALSE
			ELSE TRUE
		END;
		BEGIN
			IF NOCNV(PNODE)	!FOR TYPE-CNV NODES THAT GENERATE NO CODE
			THEN TAKNEGARG(.PNODE[PARENT])	!WILL HAVE TO PASS THE NEG UP AN
							! ADDITIONAL LEVEL
			ELSE TRUE	!OTHER TYPE-CNV NODES DO ABSORB NEG FROM BELOW
		END;
		TRUE;			!ARRAYREF NODES ABSORB NEG FROM ADDR CALC
		TRUE;			!COMMON SUBEXPR NODES ABSORB NEG
		TRUE;			!NEG/NOT NODES ABSORB NEG
%**;[331],TAKNEGARG,MD,14-NOV-75%
%**;[331],CHANGE @ LINE 3267  CASE P2MUL...%
		BEGIN			![331] SPECOP ABSORB NEG EXCEPT
			IF .PNODE[OPERSP] EQL EXPCIOP	![331] FOR RAISE
			AND .PNODE[ARG2PTR]	![331] TO AN ODD POWER
			THEN FALSE		![331]
			ELSE TRUE		![331]
		END;				![331]
		FALSE;			!FIELD-REF - NOT IN RELEASE 1
		FALSE;			!STORECLS NODES DO NOT ABSORB NEG (SHOULD NOT OCCUR IN P2S)
		FALSE;			!REGCONTENTS - NEVER OCCURS ABOVE NEG
		FALSE;			!LABOP - NEVER OCCURS
		BEGIN			!STATEMENT - ASSIGNMENT AND ARITH-IF ABSORB NEG
			IF .PNODE[SRCID] EQL ASGNID
				OR .PNODE[SRCID] EQL IFAID
			THEN TRUE
			ELSE FALSE
		END;
		FALSE;			!IOLSCLS - CANNOT PROPAGATE NEG UP
		FALSE;			!INLINFN - CANNOT ALWAYS PROPAGATE NEG UP- SO
					! DONT BOTHER
		TES      
	)
END;


GLOBAL ROUTINE SETNEG(PNODE,ARG1FLG)=
%(***************************************************************************
	IF THE NODE "PNODE" CANNOT ABSORB A NEGATE FROM ITS ARGS AS A1NEGFLG/A2NEGFLG
	THEN THIS ROUTINE RETURNS FALSE.
	IF "PNODE" CAN ABSORB A NEGATE FROM ITS ARGS, THEN THIS ROUTINE
	COMPLEMENTS EITHER A1NEGFLG (IF "ARG1FLG" IS TRUE) OR A2NEGFLG (IF
	"ARG1FLG" IS FALSE) IN PNODE AND RETURNS TRUE
***************************************************************************)%
BEGIN
	MAP PEXPRNODE PNODE;

	IF TAKNEGARG(.PNODE)
	THEN
	BEGIN
		%(***IF PNODE CAN ABSORB NEG FROM ITS ARGS***)%
!**;[430] Change @ 3301 in SETNEG	JNG	20-Aug-76
%[430]%		IF .ARG1FLG OR (.PNODE[OPRCLS] EQL STATEMENT AND .PNODE[SRCID] EQL IFAID)
%[430]%			! ARITHMETIC IF STATEMENT NODES ALWAYS USE THE A1????? FLAGS
		THEN
		BEGIN
			IF .PNODE[A1NOTFLG] THEN RETURN FALSE;
	!**;[610], SETNEG @3325, DCE, 18-AUG-77
	!**;[610], SIMPLY ABSORB THE NEG FOR EVEN EXPONENTIATION
	%[610]%		IF .PNODE[OPR1] NEQ EXPCIF THEN
			 PNODE[A1NEGFLG]_NOT .PNODE[A1NEGFLG]
		END
		ELSE
		BEGIN
			IF .PNODE[A2NOTFLG] THEN RETURN FALSE;
			 PNODE[A2NEGFLG]_NOT .PNODE[A2NEGFLG];
		END;

		RETURN TRUE
	END
	ELSE
	RETURN FALSE
END;



GLOBAL ROUTINE DNEGCNST(CNNODE)=
%(***************************************************************************
	ROUTINE TO TAKE THE NEGATIVE OF A DOUBLE-PREC CONSTANT.
	RETURNS  A PTR TO THE CONSTANT TABLE ENTRY FOR THE NEW CONSTANT.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNNODE;

	%(***SET UP GLOBALS USED BY THE ASSEMBLY LANG CONSTANT FOLDING
		ROUTINE*****)%
	C1H_.CNNODE[CONST1];
	C1L_.CNNODE[CONST2];
	COPRIX_KDNEGB+.CKA10FLG;

	CNSTCM();

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


GLOBAL ROUTINE NOTOFNEG(CNODE)=
%(***************************************************************************
	IN PHASE 2 SKELETON WHEN WERE TRYING TO PROPAGATE A NOT DOWN OVER A NEG
	AS IN NOT(-X), CALL THIS ROUTINE
	CALLED WITH THE ARG CNODE A PTR TO THE 'NEG' NODE;
		WITH NOTFLG KNOWN TO BE SET
	IF X IS A CONSTANT, CREATE A NEW CONSTANT FOR NOT(-X)
	OTHERWISE, SINCE CANNOT PROPAGATE NOT ACROSS NEGATE, PROPAGATE
	THE NOT BACK UP AND ATTEMPT TO PROPAGATE THE NEG DOWN.
	IF THE NEG CANNOT BE PROPAGATED DOWN, MUST LEAVE THE NEG NODE IN THE
	TREE (IN ALL OTHER CASES, NEG NODES ARE ELIMINATED
	FROM THE TREE)
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARGNODE;

	ARGNODE_.CNODE[ARG2PTR];

	IF .CNODE[A2VALFLG]
	THEN

	%(****IF THE ARG UNDER CNODE IS A LEAF****)%
	BEGIN

		IF .ARGNODE[OPR1] EQL CONSTFL
		THEN
		%(***IF THE ARG IS A CONSTANT, CAN ELIMINATE BOTH THE NEG AND
			THE NOT - BY CREATING A NEW CONSTANT***)%
		BEGIN
			NOTFLG_FALSE;
			%(***SET THE VAL-FLAG IN THE PARENT OF THE NEG NODE***)%
			SETPVAL(.CNODE);
			RETURN NTNGCNST(ARGNODE);
		END

		ELSE
		%(***IF THE ARG IS A LEAF, BUT NOT A CONSTANT, CANNOT
			PROPAGATE THE NEG DOWN AND HENCE MUST LEAVE THE NEG
			NODE IN THE TREE******)%
		RETURN .CNODE;

	END

	ELSE
	%(***IF THE ARG UNDER THE NEGATE NODE IS NOT A LEAF, ATTEMPT TO PROPAGATE
		THE NEG DOWN OVER IT (BUT DO NOT PROPAGATE THE NOT)***)%
	BEGIN
		NOTFLG_FALSE;
		NEGFLG_NOT .NEGFLG;
		ARGNODE_(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
		IF .NEGFLG
		THEN
		%(***IF COULD NOT PROPAGATE THE NEGATE, MUST LEAVE THE NEGATE NODE
			IN THE TREE***)%
		BEGIN
			NEGFLG_FALSE;
			CNODE[ARG2PTR]_.ARGNODE;
			NOTFLG_TRUE;			!PROPAGATE THE NOT BACK UP
			RETURN .CNODE;
		END

		ELSE
		BEGIN
			NOTFLG_TRUE;
			%(***IF ARE REPLACING THE 'NEG' NODE BY A LEAF, SET THE VALFLG
				IN THE PARENT OF THE NEG NODE***)%
			IF .ARGNODE[OPRCLS] EQL DATAOPR OR .ARGNODE[OPRCLS] EQL REGCONTENTS 
			THEN SETPVAL(.CNODE)
			ELSE
			ARGNODE[PARENT]_.CNODE[PARENT];
			RETURN .ARGNODE;
		END;
	END;
END;


GLOBAL ROUTINE NEGOFNOT(CNODE)=
%(***************************************************************************
	IN PHASE 2 SKELETON WHEN WERE TRYING TO PROPAGATE A NEG DOWN OVER A NOT
	AS IN -(NOT X), CALL THIS ROUTINE 
	CALLED WITH THE ARG CNODE A PTR TO THE 'NOT' NODE;
		WITH NEGFLG KNOWN TO BE SET
	IF X IS A CONSTANT, CREATE A NEW CONSTANT FOR-(NOT X)
	OTHERWISE, SINCE CANNOT PROPAGATE NEGATE ACROSS NOT, PROPAGATE
	THE NEG BACK UP AND ATTEMPT TO PROPAGATE THE NOT DOWN.
	IF THE NOT CANNOT BE PROPAGATED DOWN, MUST LEAVE THE NOT NODE IN THE
	TREE (IN ALL OTHER CASES, NOT NODES ARE ELIMINATED
	FROM THE TREE)
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE;
	LOCAL PEXPRNODE ARGNODE;

	ARGNODE_.CNODE[ARG2PTR];

	IF .CNODE[A2VALFLG]
	THEN

	%(****IF THE ARG UNDER CNODE IS A LEAF****)%
	BEGIN

		IF .ARGNODE[OPR1] EQL CONSTFL
		THEN
		%(***IF THE ARG IS A CONSTANT, CAN ELIMINATE BOTH THE NEG AND
			THE NOT - BY CREATING A NEW CONSTANT***)%
		BEGIN
			NEGFLG_FALSE;
			%(***SET THE VAL FLAG IN THE PARENT OF THE "NOT"***)%
			SETPVAL(.CNODE);
			RETURN NGNTCNST(ARGNODE);
		END

		ELSE
		%(***IF THE ARG IS A LEAF, BUT NOT A CONSTANT, CANNOT
			PROPAGATE THE NOT DOWN AND HENCE MUST LEAVE THE NOT
			NODE IN THE TREE******)%
		RETURN .CNODE;

	END

	ELSE
	%(***IF THE ARG UNDER THE NOT IS NOT A LEAF, ATTEMPT TO PROPAGATE
		THE NOT DOWN OVER IT (BUT DO NOT PROPAGATE THE NEGATE)***)%
	BEGIN
		NEGFLG_FALSE;
		NOTFLG_NOT .NOTFLG;
		ARGNODE_(.P2SKL1DISP[.ARGNODE[OPRCLS]])(.ARGNODE);
		IF .NOTFLG
		THEN
		%(***IF COULD NOT PROPAGATE THE NOT, MUST LEAVE THE NOT NODE
			IN THE TREE***)%
		BEGIN
			NOTFLG_FALSE;
			CNODE[ARG2PTR]_.ARGNODE;
			NEGFLG_TRUE;			!PROPAGATE THE NEG BACK UP
			RETURN .CNODE;
		END

		ELSE
		BEGIN
			NEGFLG_TRUE;
			%(***IF THE NOT NODE IS BEING REPLACED BY A LEAF, SET THE VAL-FLAG
				IN THE PARENT****)%
			IF .ARGNODE[OPRCLS] EQL DATAOPR OR .ARGNODE[OPRCLS] EQL REGCONTENTS
			THEN SETPVAL(.CNODE)
			ELSE
			ARGNODE[PARENT]_.CNODE[PARENT];
			RETURN .ARGNODE;
		END;
	END;
END;

GLOBAL ROUTINE BLCMB(CNODE,CNARGNODE,VARGNODE)=
%(***************************************************************************
	ROUTINE TO CHECK FOR
		TRUE AND A = A
		FALSE AND A = FALSE
		TRUE OR A = TRUE
		FALSE OR A = A
		TRUE EQV A = A
		FALSE EQV A = NOT A
		TRUE XOR A = NOT A
		FALSE XOR A = A
	CALLED WITH THE ARGS
		CNODE - THE PARENT NODE TO BE CHECKED
		CNARGNODE - ARG KNOWN TO BE A CONSTANT
		VARGNODE - ARG KNOWN TO BE A VARIABLE
	IF THE VALUE OF CNARGNODE IS TRUE OR FALSE, REPLACES CNODE BY
	THE VALUE INDICATED ABOVE.
***************************************************************************)%
BEGIN
	MAP PEXPRNODE CNODE:CNARGNODE:VARGNODE;
	OWN PEXPRNODE OLDCNODE;

	%(***A CONSTANT MUST HAVE VALTYPE CONTROL,LOGICAL, OR INTEGER TO BE 'TRUE' OR 'FALSE'****)%
	IF .CNARGNODE[VALTP1] NEQ INTEG1
	THEN RETURN .CNODE;

	OLDCNODE_.CNODE;

	IF .CNARGNODE[CONST2] EQL TRUE
	THEN
	%(***IF CONSTANT ARG IS "TRUE"*******)%
	BEGIN

		CASE .CNODE[OPERSP] OF SET

		%(***FOR AND***)%
		CNODE_.VARGNODE;

		%(***FOR OR***)%
		CNODE_.CNARGNODE;

		%(***FOR EQV***)%
		CNODE_.VARGNODE;

		%(***FOR XOR***)%
		%(****TRUE XOR A=NOT A****)%
		%(******(IN ORDER TO PASS A "NOT" BACK UP IN THE TREE WOULD HAVE TO
			FIRST EXAMINE THE OPRCLS OF THE PARENT. SINCE THIS IS A RARE CASE,
			DONT BOTHER)****)%
		BEGIN
		END

		TES;
	END

	ELSE
	IF .CNARGNODE[CONST2] EQL FALSE
	THEN
	%(***IF CONSTANT ARG IS FALSE***)%
	BEGIN
		CASE .CNODE[OPERSP] OF SET

		%(***FOR AND***)%
		CNODE_.CNARGNODE;

		%(***FOR OR*****)%
		CNODE_.VARGNODE;

		%(***FOR EQV****)%
		%(****FALSE EQV A = NOT A****)%
		%(******(IN ORDER TO PASS A "NOT" BACK UP IN THE TREE WOULD HAVE TO
			FIRST EXAMINE THE OPRCLS OF THE PARENT. SINCE THIS IS A RARE CASE,
			DONT BOTHER)****)%
		BEGIN
		END;

		%(***FOR XOR*****)%
		CNODE_.VARGNODE

		TES;

	END;


	%(***IF HAVE REPLACED THE OLD CNODE BY "VARGNODE" AND THERE WAS A "NOTFLG"
		SET IN THE OLD CNODE OVER "VARGNODE", MUST SET THAT FLAG IN THE
		NEW PARENT OF VARGNODE****)%
	IF .CNODE EQL .VARGNODE
	THEN 
	BEGIN		OWN VNOTFLG;

	!**;[553], BLCMB @3607, DCE, 22-MAR-77
	!**;[553], IF TYPE CONVERSION NODE IS BEING PROMOTED, WE MUST
	!**;[553], TAKE INTO CONSIDERATION THE FACT THAT IT MAY HAVE TO
	!**;[553], GENERATE CODE NOW WHERE IT DIDN'T USED TO...
	%[553]%	IF .CNODE[OPRCLS] EQL TYPECNV THEN CNODE[NOCNVFLG]_0;
		VNOTFLG_(IF .VARGNODE EQL .OLDCNODE[ARG1PTR]
			THEN .OLDCNODE[A1NOTFLG]
			ELSE .OLDCNODE[A2NOTFLG]);
		IF .VNOTFLG
		THEN
		BEGIN
			IF TAKNOTARG(.OLDCNODE[PARENT])	!IF THE NOT CAN BE PROPAGATED
			THEN				! BACK UP TO THE NEW PARENT OF VARGNODE
			NOTFLG_NOT .NOTFLG		! THEN WILL DO SO
			ELSE				!IF CANNOT
			RETURN .OLDCNODE		! THEN GIVE UP ON THIS OPTIM
		END
	END;


	%(***IF HAVE THE OLD CNODE BY A VARIABLE OR CONSTANT, SET THE VALFLG IN ITS
		PARENT.
		IF HAVE REPLACED IT BY AN EXPRESSION, SET THE PARENT PTR OF THE
		EXPRESSION.
	*********)%
	IF .CNODE[OPRCLS] EQL DATAOPR OR .CNODE[OPRCLS] EQL REGCONTENTS
	THEN
	SETPVAL(.OLDCNODE)
	ELSE
	CNODE[PARENT]_.OLDCNODE[PARENT];

	RETURN .CNODE;

END;



GLOBAL ROUTINE ARCMB(CNODE,CNARGNODE,VARGNODE,ARG1CFLG)=
%(****************************************************************************
	THIS ROUTINE IS CALLED DURING PHASE 2 SKEL WHEN ONE OF THE
	ARGS OF AN ARITHMETIC OPERATOR IS A CONSTANT
	IT COLLAPSES
		0 + A = A
		0 - A = -A
		0 * A = 0
		0/A = 0
		A ** 0 = 1 (CANNOT OPTIMIZE 0**A BECAUSE A MIGHT BE 0 AT RUN TIME)
		1 * A = A
		A / 1 = A
		1 ** A  = 1
		A ** 1 = A
	IT ALSO TRANSFORMS MULTIPLICATION AND DIVISION BY A POWER
	OF 2 INTO THE OPERATION "P2MUL" (IE THE MULT/DIV NODE IN
	THE TREE IS CHANGED TO A "P2MUL" NODE); AND MULT BY
	A POWER OF 2 PLUS ONE TO A "P2PL1MUL"

	CALLED WITH THE ARGS
		CNODE - PTR TO THE NODE FOR THE ARITH OPERATION
		CNARGNODE - PTR TO THE CONSTANT ARG
		VARGNODE - PTR TO THE VARIABLE ARG
		ARG1CFLG - FLAG FOR "CONSTANT ARG IS THE 1ST ONE"
***************************************************************************)%
BEGIN
	EXTERNAL KDPINT;		!TO PERFORM IDINT FUNCTION
	EXTERNAL KADPRN;	!TO ROUND NUMBERS TO KA10 PRECISION
	LABEL P2OPTIM;
	EXTERNAL PROPNEG;
	OWN PEXPRNODE OLDCNODE;		!KEEP PTR TO THE ORIGINAL NODE WERE CALLED WITH


	MAP PEXPRNODE CNODE:CNARGNODE:VARGNODE;
	OWN NEGVARFLG;				!THIS FLAG IS SET IFF THE NEGFLG
						! FOR THE VARIABLE ARG IS SET IN CNODE
	OWN INTEGFLG;				!THIS FLAG IS SET IF THE VALTP1
						! FIELD OF THE CONSTANT IS "INTEG1"
	OWN KH,KL;				!THE CONSTANT STORED IN "CNARGNODE"
						! FOR KA10 DP AND REAL (WHICH ARE
						! UNROUNDED UNTIL FINAL OUTPUT
						! THESE 2 WDS CONTAIN THE ROUNDED FORM
	OWN ONEFLG:MONEFLG;			!THESE FLAGS ARE SET IFF THE CONSTANT ARG IS 1
						! OR -1 RESPECTIVELY

	BIND F1 =#201400000000;		!FLOATING POINT 1
	BIND F2=#202400000000;		!FLOATING POINT 2
	BIND F3=#202600000000;		!FLOATING POINT 3
	BIND F4=#203400000000;		!FLOATING POINT 4
	BIND FM1 =#576400000000;		!FLOATING POINT -1
	BIND F5 =#203500000000;			!FLOATING PT 5
	MACRO RLP2M =#400000000$;		!MASK FOR A (JUSTIFIED) REAL POWER OF 2
	MACRO MANTMSK=#000777777777$;		!MASK TO GET THE MANTISSA OF A FLOATING PT NUMBER




	%(***DEFINE MACROS AND ROUTINES TO TEST PROPERTIES OF CONSTANTS ***)%

	%(****TO TEST FOR A CONSTANT EQUAL TO 0***)%
	MACRO ZERCNST=
		.KH EQL 0 AND .KL EQL 0$;

	%(***TO COUNT THE # OF MULTIPLIES REQUIRED TO REACH
	    A SPECIFIED POWER***)%

	GLOBAL ROUTINE CNTMPY(POWER)=
	BEGIN
	LOCAL BASE NUMOP;
	NUMOP_0;
	IF .POWER NEQ 0 THEN
	WHILE .POWER NEQ 1 DO
	BEGIN
		NUMOP_.NUMOP+1+.POWER<0,1>;	!COUNT # OF MULTIPLIES
		POWER_.POWER^(-1)		!SHIFT OUT A POWER
	END;
	RETURN .NUMOP
	END;

	%(****TO TEST FOR A CONSTANT EQUAL TO 1***)%

	ROUTINE ONECNST = 
	BEGIN
		IF .INTEGFLG
		THEN 
		.KL EQL 1
		ELSE
		.KH EQL F1 AND .KL EQL 0
	END;
	
	%(***TO TEST FOR A CONSTANT EQUAL TO -1*****)%
	ROUTINE MONECNST=
	BEGIN
		IF .INTEGFLG
		THEN 
		.KL EQL -1
		ELSE
		.KH EQL FM1 AND .KL EQL 0
	END;



	%(****TO TEST FOR A CONSTANT WHICH IS EQUAL TO AN INTEGER (IE EITHER AN INTEGER OR
		A REAL WHICH IS EQUAL TO AN INTEGER*****)%
	ROUTINE INTEGC=
	BEGIN
		IF .INTEGFLG THEN 1 ELSE
		BEGIN
			LOCAL EXP;
			EXP_.KH<27,8>;		!LOAD EXPONENT
			IF .KH LSS 0 THEN EXP_.EXP XOR #377;	!MAKE POSITIVE
			EXP_.EXP - #200;	!CONVERT TO REAL EXPONENT
			IF .EXP LEQ 0 OR .EXP GTR 35 THEN 0 ELSE
			BEGIN
				MACHOP LSHC=#246;
				REGISTER CN[2];
				CN[0]_.KH;
				CN[1]_.KL^1;
				LSHC(CN,.EXP+9);
				.CN[0] EQL 0 AND .CN[1] EQL 0
			END
		END
	END;


	%(***TO TEST FOR A CONSTANT EQUAL TO A POWER OF 2 (OR MINUS A POWER OF 2)*********)%
	ROUTINE POWEROF2 =
	BEGIN
		IF .INTEGFLG
		THEN
		%(***FOR A POSITIVE INTEGER I - I IS A POWER OF 2 IFF IT HAS NO BITS IN
			COMMON WITH (I-1)****)%
		BEGIN
			REGISTER RT;
			RT_.KL;
			IF .RT LSS 0 THEN RT_-.RT;
			(.RT AND (.RT-1)) EQL 0
		END

		ELSE
		%(***FOR REAL, DOUBLE-PREC, AND COMPLEX - 1ST WD SHOULD
			HAVE MANTISSA=400000000  2ND WD SHOULD BE 0*******)%
		(.KH AND MANTMSK) EQL RLP2M AND .KL EQL 0
	END;

	%(****TO DETERMINE THE VALUE OF N FOR A CONSTANT KNOWN TO BE EQUAL TO 2**N *****)%
	ROUTINE P2VAL =
	BEGIN
		IF .INTEGFLG
		THEN
		35-FIRSTONE( ABS(.KL))
		ELSE
		ABS(.KH)^(-27) -128 - 1		!EXPONENT OF THE REAL NUMBER
								! MINUS 1
	END;


	%(*****TO TEST FOR A CONSTANT EQUAL TO A POWER OF 2 PLUS 1 (OR MINUS (A POWER OF 2 PLUS 1))***)%
	ROUTINE P2PLUS1=
	BEGIN
		IF .INTEGFLG
		THEN
		%(****FOR A POSITIVE INTEGER I - I-1 IS A POWER OF 2
			IFF I-1 HAS NO BITS IN COMMON WITH I-2****)%
		BEGIN
			REGISTER RT;
			RT_.KL;
			IF .RT LSS 0 THEN RT_-.RT;
			((.RT-1) AND (.RT-2)) EQL 0
		END

		ELSE
		%(****FOR A REAL,DOUBLE-PREC,OR COMPLEX********)%
		BEGIN
			REGISTER RT;
			IF .KL NEQ 0 
			THEN FALSE			!(IGNORE DOUBLE-PREC CASES
							! GREATER THAN 2**27)

			ELSE
			BEGIN
				RT_ABS(.KH) FSBR F1;		!FLOATING PT VAL FOR THIS
									! NUMBER MINUS 1
				 (.RT AND MANTMSK) EQL RLP2M
					AND (.RT GTR 0)
			END
		END
	END;

	%(***TO DETERMINE THE VALUE OF N FOR A CONSTANT KNOWN TO BE 2**N + 1 ******)%
	ROUTINE P2VL1 =
	BEGIN
		REGISTER RT;
		IF .INTEGFLG
		THEN
		35-FIRSTONE( ABS(.KL)- 1)
		ELSE
		BEGIN
			RT_ABS(.KH) FSBR F1;		!MUST SUBTRACT 1 BEFORE LOOK AT EXPONENT
						! IN ORDER TO CORRECTLY HANDLE 1.5,1.25,...
			(.RT)^(-27) - 128 - 1 	!EXPONENT MINUS 1
		END
	END;


	ROUTINE RETURNNEGV(CNODE,VARGNODE)=
	%(**************************************
		ROUTINE TO CAUSE CNODE TO BE REPLACED BY THE NEGATIVE OF
		VARGNODE (WHICH ONE WANTS TO DO FOR:
			(-1)*V
			(-V)**1
			V/(-1)
		FIRST TRIES TO PROPAGATE THE NEG DOWN OVER V. IF IT FAILS
		AT THAT, THEN IF A NEG CAN BE PROPAGATED BACK UP THE TREE
		DOES THAT.
	***************************************)%
	BEGIN
		MAP PEXPRNODE CNODE:VARGNODE;
		EXTERNAL PROPNEG,TAKNEGARG,MAKPR1;

		IF .VARGNODE[OPR1] EQL CONSTFL	!IF THE ARG IS A CONSTANT,
		THEN RETURN NEGCNST(VARGNODE)	! THEN CAN SIMPLY NEGATE IT

		ELSE
		IF PROPNEG(.VARGNODE)	!IF ARE SUCCESSFUL IN PROPAGATING THE NEG
		THEN RETURN .VARGNODE	! OVER THE VARIABLE ARG, CAN JUST RETURN
					! THE VARIABLE ARG
		ELSE
		IF .NOTFLG		!IF THERE IS A NOTFLG BEING PROPAGATED
		THEN RETURN .CNODE	!CANT PROPAGATE ANEG BACK UP

		ELSE
		IF TAKNEGARG(.CNODE[PARENT])	!IF PARENT OF CNODE CAN HAVE A
		THEN				! NEG PROPAGATED INTO IT
		BEGIN
			NEGFLG_NOT .NEGFLG;
			RETURN .VARGNODE
		END
		ELSE
		%(***OTHERWISE, INSERT A NEGATE NODE INTO THE TREE ABOVE VARGNODE***)%
		RETURN MAKPR1(.CNODE[PARENT],NEGNOT,NEGOP,.CNODE[VALTYPE],0,.VARGNODE)
	END;



	%(*********START OF ROUTINE********************************************)%


	OLDCNODE_.CNODE;


	%(***SET A FLAG INDICATING WHETHER THE CONSTANT IS INTEGER OR OCTAL/LOGICAL***)%
	INTEGFLG_(.CNARGNODE[VALTP1] EQL INTEG1);

	%(***SET THE VARIABLES KH AND KL TO THE 2 WDS OF THE CONSTANT WHOSE
		PROPERTIES ARE TO BE EXAMINED. IF ARE COMPILING  ON THE
		KA10, THEN DOUBLE-PREC AND REAL CONSTANTS ARE NOT ROUNDED
		UNTIL THE END OF COMPILATION. HENCE MUST ROUND THEM IN ORDER
		TO TEST THEIR PROPERTIES***)%
	IF .KA10FLG AND (.CNARGNODE[VALTYPE] EQL REAL OR .CNARGNODE[VALTYPE] EQL DOUBLPREC)
	THEN
	BEGIN
		C1H_.CNARGNODE[CONST1];
		C1L_.CNARGNODE[CONST2];
		COPRIX_KADPRN;
		CNSTCM();
		KH_.C2H;
		KL_.C2L;
	END
	ELSE
	BEGIN
		KH_.CNARGNODE[CONST1];
		KL_.CNARGNODE[CONST2];
	END;


	%(***SET THE FLAG NEGVARFLG IFF THE NEG FLAG IS SET FOR THE VARIABLE ARG***)%
	NEGVARFLG_ (IF .ARG1CFLG
			THEN .CNODE[A2NEGFLG]
			ELSE .CNODE[A1NEGFLG]);


	
	%(***IF CONSTANT ARG IS 0, COLLAPS