Trailing-Edge
-
PDP-10 Archives
-
AP-D480B-SB_1978
-
p2s1.bli
There are 26 other files named p2s1.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!COPYRIGHT (C) 1972,1977 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR: S. MURPHY/JNG/DCE
MODULE P2S1(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3),GLOROUTINES) =
BEGIN
! CREATE A POINTER TO A STACK REFERENCE -
! HENCE DEFINE 'FREG1' EQUAL TO FREG
EXTERNAL
CANONICALIZE,CGERR,MAKEPR,C1H,C1L,C2H,C2L,COPRIX,
KBOOLBASE,KTYPCB,KARIIB,KARIAB,CNSTCM,DNEGCNST,TBLSEARCH,
SKERR;
FORWARD
P2SKBL(1),BLSKOPT(1), P2SKIGNORE(1),P2SKREL(1),RELSKOPT(1), P2SKFN(1), P2SKARITH(1),ARSKOPT(1),
P2SKLTP(1), P2SKLARR(1),P2SKNEGNOT(1);
EXTERNAL
NEGOFNOT,NOTOFNEG, BLCMB,
ARCMB,CMBEQLARGS;
EXTERNAL NEGFLG,NOTFLG;
EXTERNAL SETPVAL;
EXTERNAL KDNEGB;
EXTERNAL TAKNEGARG,TAKNOTARG;
EXTERNAL SAVSPACE;
EXTERNAL KSPECB;
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
SWITCHES LIST;
GLOBAL BIND P5S1V = 2^18+61; !VERSION DATE: 14-SEP-76
%( 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.
61 445 19632 REDUCE CHANCE OF STACK OVERFLOW BY CUTTING
DOWN NUMBER OF LOCALS FOR P2SKARITH
)%
%(************************************************************************
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/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 (2 OR 3) 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
HAVE A ROUTINE CORRESPONDING TO EACH OPERATOR CLASS. TO PROCESS
A GIVEN NODE, DISPATCH 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).
************************************************************************)%
%(******DEFINE THE DISPATCH TABLE FOR PHASE 2 SKELETON - HAVE A ROUTINE FOR EACH OPERATOR CLASS***)%
BIND DMYXXX = PLIT (
P2SKL1DISP GLOBALLY NAMES
P2SKBL,
P2SKIGNORE, !SHOULD GET HERE VERY RARELY (VALFLG IS
! USUALLY SET AND CHECKED)
P2SKREL,
P2SKFN,
P2SKARITH,
P2SKLTP,
P2SKLARR,
P2SKIGNORE, !COMMON SUBEXPR
P2SKNEGNOT, !NEG/NOT
P2SKIGNORE, !SPECIAL OPS (P2MUL ETC)
P2SKIGNORE, !FIELDREF (NOT IN RELEASE 1)
P2SKIGNORE, !STORECLS
P2SKIGNORE, !REGCONTENTS
P2SKIGNORE, !LABEL
P2SKIGNORE, !STATEMENT
P2SKIGNORE, !IOLSCLS
P2SKIGNORE); !IN-LINE-FN (SINCE THESE ARE INSERTED IN P2S
! SHOULD NOT ENCOUNTER THEM
GLOBAL ROUTINE P2SKBL(CNODE)=
%(*** INITIAL PASS OF PHASE 2 SKELETON FOR A BOOLEAN
***)%
BEGIN
MAP PEXPRNODE CNODE;
LOCAL PEXPRNODE ARG1NODE;
LOCAL PEXPRNODE ARG2NODE;
LOCAL 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
%(***FOR ARG2 NOT A LEAF (OR COMMON SUBEXPR)***)%
BEGIN
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;
GLOBAL ROUTINE BLSKOPT(CNODE)=
%(***************************************************************************
ROUTINE TO CHECK WHETHER A BOOLEAN OPERATION HAS ARGUMENTS WHICH
ARE EITHER CONSTANT OR IDENTICAL TO EACHOTHER AND HENCE CAN BE FOLDED.
THE ARG "CNODE" IS A PTR TO THE BOOLEAN NODE TO BE EXAMINED.
IF CNODE CAN BE FOLDED, THIS ROUTINE RETURNS A PTR TO THE
NODE WHICH WILL REPLACE CNODE IN THE EXPRESSION TREE.
OTHERWISE IT RETURNS A PTR TO CNODE
***************************************************************************)%
BEGIN
OWN PEXPRNODE ARG1NODE:ARG2NODE;
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-WDS TO BE
OPERATED ON***)%
C1L_IF .ARG1NODE[VALTP1] EQL INTEG1
THEN .ARG1NODE[CONST2]
ELSE .ARG1NODE[CONST1];
C2L_IF .ARG2NODE[VALTP1] EQL INTEG1
THEN .ARG2NODE[CONST2]
ELSE .ARG2NODE[CONST1];
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
%(*****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
***************)%
ELSE
%(***IF ARG1 IS TRUE OR FALSE, REPLACE CNODE BY ARG2,
TRUE OR FALSE***)%
CNODE_BLCMB(.CNODE,.ARG1NODE,.ARG2NODE);
END
ELSE
IF .ARG2NODE[OPR1] EQL CONSTFL
THEN
%(***IF ARG2 IS TRUE OR FALSE, REPLACE CNODE BY ARG1,
TRUE, OR FALSE***)%
CNODE_BLCMB(.CNODE,.ARG2NODE,.ARG1NODE)
%(******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
****************)%
ELSE
IF .CNODE[ARG1PTR] EQL .CNODE[ARG2PTR]
THEN
%(***IF ARG1 IS EQUAL TO ARG2, THEN TRY TO COLLAPSE CNODE***)%
CNODE_CMBEQLARGS(.CNODE,FALSE);
RETURN CANONICALIZE( .CNODE);
END;
GLOBAL ROUTINE P2SKIGNORE(CNODE)=
%(***************************************************************************
PHASE 2 SKEL 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)
.
***************************************************************************)%
BEGIN
RETURN .CNODE
END;
GLOBAL ROUTINE P2SKREL(CNODE)=
%(***
INITIAL PASS OF PHASE 2 SKELETON FOR A RELATIONAL
***)%
BEGIN
MAP PEXPRNODE CNODE;
LOCAL PEXPRNODE ARG1NODE;
LOCAL PEXPRNODE ARG2NODE;
LOCAL 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 ARG***)%
%(****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 ARG***)%
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 VALS TO BE PASSED BACK UP TO PARENT***)%
NOTFLG_FALSE;
NEGFLG_.PRVNEGFLG;
%(***CHECK FOR OPS ON CONSTANTS AND OPS ON IDENTICAL ARGS THAT CAN BE FOLDED***)%
RETURN RELSKOPT(.CNODE);
END;
GLOBAL ROUTINE RELSKOPT(CNODE)=
%(***************************************************************************
ROUTINE TO CHECK A RELATIONAL NODE FOR ARGS EQUAL TO CONSTANTS, OR TO EACHOTHER,
AND TO FOLD SUCH A NODE IF IT IS POSSIBLE TO DO SO.
THE ARG "CNODE" POINTS TO THE RELATIONAL NODE TO BE EXAMINED.
IF THE NODE CAN BE FOLDED THEN A PTR TO THE NEW NODE TO REPLACE IT IN
THE TREE IS RETURNED.
OTHERWISE A PTR TO CNODE IS RETURNED.
***************************************************************************)%
BEGIN
EXTERNAL KDPRL,C1H,C1L,C2H,C2L,COPRIX,CNSTCM, !EXTERNALS USED IN FOLDING
KADPRN; ! A KI10 FORMAT NUMB TO KA10 PREC OR
! A REAL TO 1 WD OF PREC
OWN PEXPRNODE ARG1NODE: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 ARGS IS A CONSTANT, LET THAT ARG BE THE 2ND ARG.
*************)%
IF .ARG1NODE[OPR1] EQL CONSTFL
AND .ARG1NODE[VALTYPE] NEQ DOUBLOCT !(DONT FOLD OPS ON DOUBLE OCTALS
! SINCE HAVE COMPLICATIONS DUE TO USING KI10
! FORMAT NUMBS AT COMPILE TIME)
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;
OWN K1H,K1L,K2H,K2L; !HI AND LO WDS OF EACH CONST (AFTER ROUND)
%(***FOR REAL VARS AND DP VARS ON KA10, MUST ROUND BEFORE COMPARE***)%
IF (.KA10FLG AND .ARG1NODE[VALTYPE] EQL DOUBLPREC) OR .ARG1NODE[VALTYPE] EQL REAL
THEN
BEGIN
C1H_.ARG1NODE[CONST1]; !SET UP GLOBALS FOR CONST
C1L_.ARG1NODE[CONST2]; ! FOLDING ROUTINE
COPRIX_(IF .ARG1NODE[DBLFLG]
THEN KADPRN !TO ROUND DP FROM KI TO KA PREC
ELSE KDPRL); !TO ROUND FROM DP TO REAL
CNSTCM(); !DO THE ROUNDING, LEAVE RESULT IN C2H,C2L
K1H_.C2H;
K1L_.C2L
END
ELSE (K1H_.ARG1NODE[CONST1]; K1L_.ARG1NODE[CONST2]); !IF NEEDNT ROUND
IF (.KA10FLG AND .ARG2NODE[VALTYPE] EQL DOUBLPREC) OR .ARG2NODE[VALTYPE] EQL REAL
THEN
BEGIN
C1H_.ARG2NODE[CONST1]; !SET UP GLOBALS FOR CONST
C1L_.ARG2NODE[CONST2]; ! FOLDING ROUTINE
COPRIX_(IF .ARG2NODE[DBLFLG]
THEN KADPRN !TO ROUND DP FROM KI TO KA PREC
ELSE KDPRL); !TO ROUND FROM DP TO REAL
CNSTCM(); !DO THE ROUNDING, LEAVE RESULT IN C2H,C2L
K2H_.C2H;
K2L_.C2L
END
ELSE (K2H_.ARG2NODE[CONST1]; K2L_.ARG2NODE[CONST2]); !IF NEEDNT ROUND
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***)%
IF .ARG1NODE[VALTP1] EQL INTEG1
THEN
%(***FOR INTEGERS- COMPARE THE LO WDS**)%
BEGIN
C1_.K1L;
C2_.K2L;
END
ELSE
%(**FOR REALS - COMPARE THE HI WDS***)%
BEGIN
C1_.K1H;
C2_.K2H;
END;
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);
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;
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
EXTERNAL DOWDP,CDONODE; !GLOBAL USED IN DETERMINING WHETHER A
! DO LOOP INDEX CAN LIVE IN A REGISTER
MAP OBJECTCODE DOWDP;
MAP PEXPRNODE CDONODE;
EXTERNAL USERFNFLG; !FLAG INDICATING THAT THIS STMNT HAD A
! CALL TO A USER FUNCTION
MAP OBJECTCODE USERFNFLG;
MAP PEXPRNODE CNODE;
LOCAL ARGUMENTLIST ARGLST;
LOCAL PEXPRNODE FNNAMENTRY;
LOCAL PRVNEGFLG, PRVNOTFLG;
LOCAL PEXPRNODE ARGNODE;
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);
!**;[434] Change @ line 3868 in P2SKFN JNG 31-Aug-76
%[434]% END;
%(***CHECK WHETHER THIS ARG IS THE INDEX OF A DO LOOP THAT
INCLUDES THIS STMNT. IF SO, WILL NOT BE ABLE TO
HAVE THAT LOOP INDEX LIVE IN A REGISTER***)%
IF .ARGLST[.CT,ARGNPTR] EQL .DOWDP[DOINDUC]
THEN DOWDP[DOMTRLZIX]_1;
END;
%(***RESTORE NEGFLG AND NOTFLG TO THE VALS THAT THEY HAD WHEN ENTERED***)%
NEGFLG_.PRVNEGFLG;
NOTFLG_.PRVNOTFLG;
END;
%(***CHECK FOR WHETHER THIS FN SHOULD BE EXPANDED IN LINE. IF SO,TRANSFORM
THIS FNCALL NODE INTO AN "IN-LINE-FN" NODE OR A TYPE-CONVERSION NODE***)%
IF .FNNAMENTRY[IDINLINFLG]
THEN
BEGIN
%(***IN RELEASE 1, WE DONT EXPAND ANYTHING WITH MORE THAN 2 ARGS INLINE***)%
IF .ARGLST[ARGCOUNT] LEQ 2
THEN
BEGIN
CNODE[OPERATOR]_.FNNAMENTRY[IDINLINOPR];
%(***FOR A TYPE-CONVERSION NODE, THE SINGLE ARG IS ARG2***)%
IF .CNODE[OPRCLS] EQL TYPECNV
THEN
BEGIN
CNODE[ARG2PTR]_.ARGLST[1,ARGNPTR];
IF .ARGLST[1,AVALFLG] THEN CNODE[A2VALFLG]_1;
END
ELSE
BEGIN
CNODE[ARG1PTR]_.ARGLST[1,ARGNPTR];
IF .ARGLST[1,AVALFLG]
THEN CNODE[A1VALFLG]_1;
IF .ARGLST[ARGCOUNT] EQL 2
THEN
BEGIN
CNODE[ARG2PTR]_.ARGLST[2,ARGNPTR];
IF .ARGLST[2,AVALFLG]
THEN CNODE[A2VALFLG]_1;
END
ELSE CNODE[ARG2PTR]_0;
END;
%(***RETURN THE CORE THAT WAS USED FOR THE ARGLST TO FREE STORAGE***)%
SAVSPACE(.ARGLST[ARGCOUNT],.ARGLST); !ARGCOUNT IS # OF WDS-1
%(***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(3,.ARGNODE);
END;
END;
END;
RETURN .CNODE;
END;
GLOBAL ROUTINE P2SKARITH(CNODE)=
%(***
INITIAL PASS OF PHASE 2 SKELETON FOR AN ARITHMETIC NODE
***)%
BEGIN
EXTERNAL DOWDP; !GLOBAL USED IN DETERMINING WHETHER A DO-LOOP
! INDEX SHOULD LIVE IN A REG
MAP OBJECTCODE DOWDP;
LOCAL PEXPRNODE ARG1NODE;
LOCAL PEXPRNODE ARG2NODE;
LOCAL V;
MAP PEXPRNODE CNODE;
!**;[445], P2SKARITH @3956, DCE, 14-SEP-76
!**;[445], MAKE 4 BOOLEAN LOCALS LIVE INSIDE V
!**;[445], SO THAT RECURSIVE CALLS ARE LESS LIKELY TO
!**;[445], OVERFLOW OUR STACK! THE BOOLEANS ARE DEFINED BELOW
MACRO PARNEG=35,1$, ![445]
PARNOT=34,1$, ![445]
ARG1NEG=33,1$, ![445]
ARG2NEG=32,1$; ![445]
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
!**;[445], P2SKARITH @3977, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_TRUE;
%[445]% V<ARG2NEG>_TRUE;
%[445]% V<PARNEG>_FALSE;
END;
%(*** FOR SUB ***)%
BEGIN
CNODE[OPERSP]_ADDOP;
!**;[445], P2SKARITH @3984, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_TRUE;
%[445]% V<ARG2NEG>_FALSE;
%[445]% V<PARNEG>_FALSE;
END;
%(*** FOR MUL ***)%
BEGIN
!**;[445], P2SKARITH @3990, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_TRUE;
%[445]% V<ARG2NEG>_FALSE;
%[445]% V<PARNEG>_FALSE;
END;
%(*** FOR DIV ***)%
BEGIN
!**;[445], P2SKARITH @3996, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_TRUE;
%[445]% V<ARG2NEG>_FALSE;
%[445]% V<PARNEG>_FALSE;
END;
%(*** FOR EXPONENTIATION ***)%
%(*** CANNOT FORCE NEG DOWN ***)%
BEGIN
!**;[445], P2SKARITH @4003, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_FALSE;
%[445]% V<ARG2NEG>_FALSE;
%[445]% V<PARNEG>_TRUE;
END
TES
END
ELSE
BEGIN
!**;[445], P2SKARITH @4011, DCE, 14-SEP-76
%[445]% V<ARG1NEG>_FALSE;
%[445]% V<PARNEG>_FALSE;
IF .CNODE[OPERSP] EQL SUBOP
THEN
BEGIN
CNODE[OPERSP]_ADDOP;
!**;[445], P2SKARITH @4017, DCE, 14-SEP-76
%[445]% V<ARG2NEG>_TRUE;
END
ELSE
!**;[445], P2SKARITH @4020, DCE, 14-SEP-76
%[445]% V<ARG2NEG>_FALSE;
END;
%(*** CANNOT FORCE DOWN A NOT ***)%
!**;[445], P2SKARITH @4024, DCE, 14-SEP-76
%[445]% 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
!**;[445], P2SKARITH @4033, DCE, 14-SEP-76
%[445]% IF .V<ARG1NEG>
THEN CNODE[A1NEGFLG]_1;
END
ELSE
%(***IF ARG IS NOT A LEAF OR COMMON SUBEXPR***)%
BEGIN
NOTFLG_FALSE;
!**;[445], P2SKARITH @4040, DCE, 14-SEP-76
%[445]% 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
!**;[445], P2SKARITH @4068, DCE, 14-SEP-76
%[445]% IF .V<ARG2NEG>
THEN
CNODE[A2NEGFLG]_1;
END
ELSE
BEGIN
!**;[445], P2SKARITH @4073, DCE, 14-SEP-76
%[445]% 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;
!**;[445], P2SKARITH @4116, DCE, 14-SEP-76
%[445]% NEGFLG_ IF .V<PARNEG> THEN TRUE ELSE FALSE;
%[445]% NOTFLG_ IF .V<PARNOT> THEN TRUE ELSE FALSE;
%(****CHECK FOR CONSTANT OPERATIONS AND OPERATIONS ON IDEXTICAL ARGS THAT CAN BE FOLDED***)%
V_ ARSKOPT(.CNODE);
%(***IF EITHER ARG OF AN EXPONENTIATION IS THE INDEX OF A DO LOOP THAT
INCLUDES THAT EXPONENTIATION, CANNOT HAVE THAT LOOP INDEX LIVE IN A REG***)%
IF .CNODE[OPR1] EQL EXPONOPF
THEN
BEGIN
IF .CNODE[ARG1PTR] EQL .DOWDP[DOINDUC] OR
(.CNODE[ARG2PTR] EQL .DOWDP[DOINDUC])
THEN
DOWDP[DOISUBS]_0
END;
RETURN .V;
END;
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
EXTERNAL CNTMPY;
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;
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
COPRIX_KDNEGB+.CKA10FLG;
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;
GLOBAL ROUTINE P2SKLARR(CNODE)=
%(********
INITIAL PASS OF PHASE 2 SKELETON FOR AN ARRAY REFERENCE.
THE EXPRESSION NODE FOR THE ARRAYREF IS ASSUMED TO HAVE THE
FOLLOWING 2 ARGS:
ARG1PTR - PTR TO THE SYMBOL TABLE ENTRY FOR THE ARRAY NAME
ARG2PTR - PTR TO AN EXPRESSION NODE FOR THE ADDRESS CALCULATION
********)%
BEGIN
MAP PEXPRNODE CNODE;
LOCAL PEXPRNODE SSNODE;
LOCAL PRVNEGFLG,PRVNOTFLG;
DEBGNODETST(CNODE); !FOR DEBUGGING ONLY
%(*****UNLESS THE ADDRESS-CALCULATION IS A LEAF, PERFORM THE
PHASE 2 SKEL OPTIMIZATIONS ON IT****)%
IF NOT .CNODE[A2VALFLG]
THEN
BEGIN
SSNODE_.CNODE[ARG2PTR];
PRVNEGFLG_.NEGFLG;
PRVNOTFLG_.NOTFLG;
NEGFLG_FALSE;
NOTFLG_FALSE;
CNODE[ARG2PTR]_(.P2SKL1DISP[.SSNODE[OPRCLS]])(.SSNODE);
CNODE[A2NEGFLG]_.NEGFLG<0,1>;
CNODE[A2NOTFLG]_.NOTFLG<0,1>;
NEGFLG_.PRVNEGFLG; !CANNOT PASS NEG/NOT DOWN OVER AN
! ARRAYREF NODE; HENCE IF WERE TRYING TO DO SO,
! PASS THEM BACK UP TO PARENT
NOTFLG_.PRVNOTFLG;
END;
RETURN .CNODE;
END;
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
EXTERNAL SETPIMMED;
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;
END
ELUDOM