Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
cannon.bli
There are 12 other files named cannon.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1972, 1986
!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: NORMA ABEL/HPW/SJW/TFV
MODULE CANNON(RESERVE(0,1,2,3),SREG=#17,VREG=#15,FREG=#16,DREGS=4,GLOROUTINES)=
BEGIN
! REQUIRES FIRST, TABLES, OPTMAC
SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE OPTMAC.BLI;
SWITCHES LIST;
SWITCHES NOSPEC;
GLOBAL BIND CANNOV = #11^24 + 0^18 + 26; ! Version Date: 23-Jul-81
%(
***** Begin Revision History *****
23 ----- ----- MOVE ARRAYREFS UP (OR CONSTANTS DOWN DPENDING
UPON YOUR POINT OF VIEW)
24 ----- ----- DO NOT SET PARENT OF CMNSUB NODES IN SWAP2DOWN.
THE POSSIBILITY COULD ARISE FROM THE I/O
OPTS.
25 VER5 ----- MYSWAPARGS MACRO IN MOVDOWN TO SWAP DEFPTS
SWAP DEFPTS IN SWAP2DOWN, (SJW)
***** Begin Version 6 *****
26 761 TFV 1-Mar-80 -----
Add KARIGB for constant folding under /GFLOATING.
Remove KARIAB which was for the KA.
***** End Revision History *****
)%
!THE MAIN ROUTINE IN THIS MODULE IS CANONICALIZE. IT APPEARS
!AT THE END OF THE LISTING. READING THE CODE MAKES MORE SENSE
!IF STARTED AT CANONICALIZE.
![761] KARIGB fold /GFLOATING constants
%[761]% EXTERNAL SETPVAL,KARIGB,KARIIB,KBOOLBASE;
EXTERNAL TBLSEARCH;
EXTERNAL ARCMB,CNSTCMB,CMBEQLARGS,NEGFLG,NOTFLG,BLCMB;
FORWARD SWAP2DOWN;
EXTERNAL QQ;
EXTERNAL COPRIX,C1H,C2H,C1L,C2L;
MAP PEXPRNODE QQ;
OWN SOMECHANGE; !FLAG TO STOP UNLIMITED RECURSION
OWN RECURSCNT; !COUNTER TO PREVENT TOO MUCH RECURSION
!
!***************************************************
!
ROUTINE MOVDOWN(P)=
BEGIN
BIND RECURSMAX=12;
MACRO MYSWAPARGS (NODE) =
BEGIN
REGISTER T1;
SWAPARGS (NODE);
IF .FLGREG<OPTIMIZE>
THEN BEGIN
T1 _ .NODE [DEFPT2];
NODE [DEFPT2] _ .NODE [DEFPT1];
NODE [DEFPT1] _ .T1;
END;
END$;
!**************************************************
!THIS ROUTINE DOES THE WORK OF EXPRESSION CANONICALIZATION.
!THE ORDERING PRODUCED IS EXPLAINED IN FRONT OF THE
!DRIVER ROUTINE CANONICALIZE. (NEXT IN LISTING).
!MOVDOW IS CALLED RECURSIVELY AND BY CANONICALIZE.
!THE SINGLE PARAMETER, P, IS A POINTER TO AN
!EXPRESSION TO BE CANONICALIZED.
!PHASE 2 SKELETON CALLS CANONICALIZE FOR
!AN EXPRESSION FROM THE BOTTOM OF THE TREE UPWARD. MOVDOW
!REWALKS ALL LOWER PARTS OF THE TREE INSURING THAT THINGS ARE
!IN THE CORRECT ORDER AND COLLAPSING AND FOLDING IF NECESSARY.
!SINCE CANONICALIZE ALSO FOLDS AND COLLAPSES, WHY IS THIS SEPARATE
!ROUTINE NECEAARY?. THE ANSWER IS THE SETING OF THE NEG AND
!NOT FLAGS WHICH ARE BEING PROPAGATED BY PHASE 2 SKELETON AT
!THE SAME TIME. THEY MIUST BE SET DIFFERENTLY AT THE TOP
!LEVEL THEN AT LOWER LEVELS.
LABEL SKTREE,CNST2;
LOCAL PRVNEGFLG,PRVNOTFLG;
MAP PEXPRNODE P;
LOCAL PEXPRNODE PA:PB;
!
!
!FIRST OF ALL QUIT IF THIS IS JUST TOO MUCH
IF .RECURSCNT GTR RECURSMAX THEN RETURN(.P);
RECURSCNT_.RECURSCNT+1;
RECURSCNT_.RECURSCNT+1;
!SET FLAG TO ZERO
SOMECHANGE_0;
!JUST IN CASE WE GET HERE ON A RECURSIVE CALL WITH AN IMPROPER
!NODE
IF .P[OPRCLS] NEQ ARITHMETIC THEN
IF .P[OPRCLS] NEQ BOOLEAN THEN RETURN(.P);
PB_.P[ARG2PTR]; !FOR TEST OF SPECOP
SKTREE:
!IF THE FIRST ARGUMENT IS NOT A DATA ITEM
!NOTE: WE ASSUME LEFT BALANCED NARY TREES.
IF NOT .P[A1VALFLG] THEN
BEGIN
!DATA IS ANY EXPRESSION AND NOT NECESSARILY
!AN ITEM OF OPRCLS DATAOPR.
!
! OP
! * *
! * *
! UNKNOWN DATA
!
!WE WILL NOW EXAMINE UNKNOWN
!
QQ_.P[ARG1PTR];
IF NARYNODE(P,QQ) AND .PB[OPRCLS] EQL DATAOPR THEN
! OP
! * *
! * *
! SAME DATA OR SPECOP
! OP
BEGIN !NARY SITUATION
!LOOK AT
!
! OP (P)
! * *
! * *
! OP(QQ) DATA (PB) OR SPECOP
! *
! *
! DATA (PA)
!
PA_.QQ[ARG2PTR];
!FIRST SEE IF EQUAL ARGS
!IF THE ARGUMENTS ARE EQUAL
IF .PB EQL .PA THEN
BEGIN
P_CMBEQLARGS(.P,TRUE);
!IF SOMETHING HAPPENED
!GET OUT FAST
IF .P[OPRCLS] EQL DATAOPR THEN
LEAVE SKTREE;
IF .P[OPRCLS] EQL SPECOP THEN
LEAVE SKTREE;
END;
!NOW CANONICALIZE IF POSSIBLE
IF (.PA[OPR1] EQL VARFL AND
.PB[OPR1] EQL VARFL) AND
.PB LSS .PA THEN
(SWAP2DOWN(.P,.QQ); SOMECHANGE_1;)
ELSE
IF .PA[OPR1] NEQ CONSTFL AND
( .PB[OPRCLS] EQL FNCALL
OR .PB[OPR1] EQL CONSTFL) THEN
(SWAP2DOWN(.P,.QQ); SOMECHANGE_1;)
ELSE
IF .PA[OPRCLS] EQL DATAOPR AND
.PB[OPRCLS] NEQ DATAOPR THEN
(SWAP2DOWN(.P,.QQ); SOMECHANGE_1;)
ELSE
IF .PA[OPRCLS] EQL ARRAYREF AND
.PB[OPRCLS] NEQ FNCALL THEN
(SWAP2DOWN(.P,.QQ); SOMECHANGE_1;);
IF NOT .P[A1VALFLG] AND .SOMECHANGE THEN
BEGIN
PRVNEGFLG_.NEGFLG;
PRVNOTFLG_.NOTFLG;
NOTFLG_NEGFLG_FALSE;
P[ARG1PTR]_MOVDOWN(.P[ARG1PTR]);
!NOW UPDATE NEGFLG,ETC
!IF RECURSIVE CALL HAS CHANGED
!THEM
IF .NEGFLG THEN
BEGIN
P[A1NEGFLG]_ NOT .P[A1NEGFLG];
NEGFLG_.PRVNEGFLG;
END;
IF .NOTFLG THEN
BEGIN
P[A1NOTFLG]_NOT .P[A1NOTFLG];
NOTFLG_.PRVNOTFLG;
END;
QQ_.P[ARG1PTR];
IF .QQ[OPRCLS] EQL DATAOPR THEN
P[A1VALFLG] _1;
END;
END ELSE !NOT NARY
BEGIN
%(
IF ARG1 IS A BOTTOM TREE AND THE
PARENT OF P WILL BE NARY WITH P
OR ARG1 IS AN ARRAYREF AND THE
PARENT OF P WILL BE NARY
WITH P AND ARG2 IS A CONSTANT
AND ARG2 OF THE PARENT OF P IS
A CONSTANT THEN
SWAP ARGS ON P
)%
IF NOT .P[A1VALFLG] AND
.P[A2VALFLG] THEN
BEGIN
QQ_.P[ARG1PTR];
IF .QQ[OPRCLS] EQL ARRAYREF THEN
BEGIN
IF .PB[OPR1] EQL CONSTFL THEN
BEGIN
QQ_.P[PARENT];
IF NARYNODE(QQ,P) THEN
BEGIN
QQ_.QQ[ARG2PTR];
IF .QQ[OPR1] EQL CONSTFL THEN
BEGIN
MYSWAPARGS(P);
SOMECHANGE_1
END
END
END
END
ELSE
!QQ MUST BE BOTTOM-MOST
IF .QQ[A1VALFLG] AND
.QQ[A2VALFLG] THEN
BEGIN
!PARENT MUST BE NARY WITH P
QQ_.P[PARENT];
IF NARYNODE(QQ,P) THEN
BEGIN
MYSWAPARGS(P);
SOMECHANGE_1
END
END;
END;
END; !NOT NARY DOWNWARD.
END; !
!PREVIOUS CODE TOOK CARE OF SKEWED TREE
!NOW DO THE SIMPLE STRAIGHT TREE (BINARY WITH LEAVES)
CNST2:
IF .P[A1VALFLG] AND .P[A2VALFLG] THEN
BEGIN
!FIRST LOOK FOR CONSTANTS TO COLLAPSE
QQ_.P[ARG1PTR]; PB_.P[ARG2PTR];
IF .QQ[OPR1] EQL CONSTFL THEN
IF .PB[OPR1] EQL CONSTFL THEN
BEGIN
!CHECK FOR COMPLEX MULTIPLE OR DIVIDE
!THEY CANNOT BE DONE AT COMPILE TIME
IF .P[VALTYPE] EQL COMPLEX AND
MULORDIV(P) THEN
LEAVE CNST2
ELSE
IF .P[OPR1] LSS DIVOPF THEN
!COLLAPSE CONSTANTS
BEGIN
!SET UP GLOBAL VARAIBLES FOR CONSTANT COLAPSE
COPRIX_
(IF .P[OPRCLS] EQL ARITHMETIC THEN
KARITHOPIX(P) ELSE
KBOOLOPIX(P));
C1H_.QQ[CONST1];
C1L_.QQ[CONST2];
C2H_.PB[CONST1];
C2L_.PB[CONST2];
CNSTCMB();
!RESET VAL FLAGS
SETPVAL(.P);
P_ MAKECNST(.P[VALTYPE],.C2H,.C2L);
RETURN .P
END;
END
ELSE
!CALL ROUTINES WHICH HANDLE A CONSTANT AND A VARIABLE
BEGIN
IF .QQ EQL .PB THEN P_CMBEQLARGS(.P,FALSE)
ELSE
BEGIN
IF .P[OPRCLS] EQL BOOLEAN THEN
P_BLCMB(.P,.QQ,.PB)
ELSE
IF .P[OPRCLS] EQL ARITHMETIC THEN
P_ARCMB(.P,.QQ,.PB,.QQ[OPR1] EQL CONSTFL);
END;
END;
!NOW CANONICALIZE
IF .P[OPRCLS] NEQ DATAOPR AND .P[OPRCLS] NEQ SPECOP THEN
BEGIN
IF .P[OPR1] EQL ADDOPF OR .P[OPR1] EQL MULOPF OR
.P[OPRCLS] EQL BOOLEAN
THEN !COMMUTATIVE OPERATOR
BEGIN
QQ_.P[ARG2PTR]; PB_.P[ARG1PTR];
IF (.QQ[OPR1] EQL VARFL AND .PB[OPR1] EQL VARFL AND
.PB GTR .QQ) OR .QQ[OPR1] EQL CONSTFL THEN
(MYSWAPARGS(P); SOMECHANGE_1);
END;
END;
END; !A1VALFLG AND A2VALFLG
!CAME BACK FROM LOOKING AT A SKEWED TREE
! OP
! * *
! * *
! UNKNOWN SPECOP
!VAL FLAG IS NOT SET ON SPECOP
!EITHER THAT OR WEVE COME BACK FROM A COMPLETE COLLAPSE
!IN WHICH CASE WE WISH TO EXIT SMARTLY
IF .P[OPRCLS] NEQ DATAOPR THEN
IF NOT .P[A1VALFLG] AND .SOMECHANGE THEN !UNKNOWN IS EXPRESSION
BEGIN
PRVNEGFLG_.NEGFLG;
PRVNOTFLG_.NOTFLG;
NOTFLG_NEGFLG_FALSE;
P[ARG1PTR]_MOVDOWN(.P[ARG1PTR]);
IF .NEGFLG THEN
BEGIN
P[A1NEGFLG]_NOT .P[A1NEGFLG];
NEGFLG_.PRVNEGFLG;
END;
IF .NOTFLG THEN
BEGIN
P[A1NOTFLG]_NOT .P[A1NOTFLG];
NOTFLG_.PRVNOTFLG;
END;
END;
.P
END;
GLOBAL ROUTINE CANONICALIZE(CNODE)= !CANNONIZE
BEGIN
LOCAL PEXPRNODE P:PB:PA;
LOCAL PRVNEGFLG,PRVNOTFLG;
MAP PEXPRNODE CNODE;
!PUT AN EXPRESSION IN CANNONICAL FORM
!THE ORDER OF CANONICALIZATION FROM THE BOTTOM OF A TREE UPWARD IS
! 1. ALL CONSTANTS
! 2. ALL FUNCTION CALL NODES
! 3. ALL OTHER EXPRESSIONS (EXCEPT ARRAYREFS)
! 4. ARRAY REFERENCES
! 5. ALL SCARLAR VARIABLES IN ORDER OF SYMBOL TABLE ADDRESS
!
!THIS ENABLES CONSTANTS TO BE FOLDED AND REGISTER ALLOCATION
!TO OCCUR IN A REASONABLE FASHION AS THE FUNCTION NODES
!WILL BE COMPUTED FIRST (AS THEY ARE BOTTOM-WARD), FOLLOWED
!BY OTHER THINGS OF SOME COMPLEXITY (EXPRESSIONS AND ARRAY
!REFERENCES) FOLLOWED BY THE EASY THINGS.
!
!CNODE POINTS TO AN EXPRESSION
LABEL CNST1;
RECURSCNT_0;
!CHECK FOR ARITHMETIC OR BOOLEAN AND GET OUT FAST IF NEITHER
IF .CNODE[OPRCLS] NEQ ARITHMETIC THEN
IF .CNODE[OPRCLS] NEQ BOOLEAN THEN
RETURN(.CNODE);
!SAVE NEG AND NOT FLAGS
PRVNEGFLG_.NEGFLG;
PRVNOTFLG_.NOTFLG;
NEGFLG_FALSE;
NOTFLG_FALSE;
!
P_MOVDOWN(.CNODE);
!IDEALLY WE WOULD LIKE TO QUIT IF NOTHING HAPPENED.
!UNFORTUNATELY WE CANNOT TELL. THIS RESULTS IN THE
!INEFFICIENCY THAT FOR VARIABLE OP CONSTANT ARCMB
!WILL BE CALLED MANY UNNECESSARY TIMES.
CNST1:
IF .P[OPRCLS] EQL ARITHMETIC OR
.P[OPRCLS] EQL BOOLEAN THEN
BEGIN
!LOOK FOR CONSTANTS TO COLLAPSE
QQ_.P[ARG1PTR]; PB_.P[ARG2PTR];
!ALSO CHECK FOR EQL ARGS
IF .QQ EQL .PB AND (.QQ[OPR1] NEQ CONSTFL) THEN
(P_CMBEQLARGS(.P,FALSE);
LEAVE CNST1;);
IF .QQ[OPR1] EQL CONSTFL THEN
IF .PB[OPR1] EQL CONSTFL THEN
BEGIN
!ONE LAST CHECK FOR A COMPLEX MULTIPLY OR DIVIDE.
!THEY CONNOT BE FOLDED AT COMPILE TIME
IF .P[VALTYPE] EQL COMPLEX AND MULORDIV(P) THEN
LEAVE CNST1
ELSE
IF .P[OPR1] LSS DIVOPF THEN
!COLLAPSE CONSTANTS
BEGIN
!SET UP GLOBAL VARAIBLES FOR CONSTANT COLAPSE
COPRIX_
(IF .P[OPRCLS] EQL ARITHMETIC THEN
KARITHOPIX(P) ELSE
KBOOLOPIX(P));
C1H_.QQ[CONST1];
C1L_.QQ[CONST2];
C2H_.PB[CONST1];
C2L_.PB[CONST2];
CNSTCMB();
!RESET VAL FLGS
SETPVAL(.P);
P_ MAKECNST(.P[VALTYPE],.C2H,.C2L);
END;
END
ELSE
!CALL ROUTINES WHICH HANDLE A CONSTANT AND A VARIABLE
BEGIN
NOTFLG_FALSE; NEGFLG_FALSE;
IF .P[OPRCLS] EQL BOOLEAN THEN
P_BLCMB(.P,.QQ,.PB)
ELSE
IF .P[OPRCLS] EQL ARITHMETIC THEN
P_ARCMB(.P,.QQ,.PB,TRUE);
END;
END;
!RESET THE GLOBALS NEGFLG AND NOTFLG PROPERLY.
!THE LOGIC BEHIND THE SETTING OF THESE FLAGS IS
!PRESUMED TO BE EXPLAINED IN THE PHASE 2 SKELETON
!DOCUMENTATION.
NEGFLG_(IF .NEGFLG THEN NOT.PRVNEGFLG
ELSE .PRVNEGFLG);
NOTFLG_(IF .NOTFLG THEN NOT .PRVNOTFLG
ELSE .PRVNOTFLG);
.P
END; !CANNONIZE
GLOBAL ROUTINE SWAP2DOWN(PNODE,AR1NODE)=
BEGIN
%(*****************************************************
SWAP ARG 2 OF AN N-ARY PARENT(PNODE) WITH THE
SECOND ARG OF THE LEFT SON (AR1NODE).
REMEMBER TO ADJUST THE VAL FLAGS AND THE PARENT.
*******************************************************)%
LOCAL T1;
MAP PEXPRNODE PNODE:AR1NODE:T1;
T1_.PNODE[ARG2PTR];
!SWAP ARGS
PNODE[ARG2PTR]_.AR1NODE[ARG2PTR];
AR1NODE[ARG2PTR]_.T1;
!FIX PARENTS
!NOTE THAT T1 (WHICH HAS BECOME AR1NODE) ARG2 SHOULD GET AR1NODE
!AS PARENT IF IT IS NOT AN ORPHAN
IF .T1[OPRCLS] NEQ DATAOPR THEN
IF .T1[OPRCLS] NEQ CMNSUB THEN
T1[PARENT]_.AR1NODE;
!NOW USE T1 AGAIN AS A DIFFERENT VALUE
T1_.PNODE[ARG2PTR];
IF .T1[OPRCLS] NEQ DATAOPR THEN
IF .T1[OPRCLS] NEQ CMNSUB THEN
T1[PARENT]_.PNODE;
!ADJUST FLAGS
T1_.PNODE[A2FLGS];
PNODE[A2FLGS]_.AR1NODE[A2FLGS];
AR1NODE[A2FLGS]_.T1;
IF .FLGREG<OPTIMIZE>
THEN BEGIN
T1 _ .PNODE [DEFPT2];
PNODE [DEFPT2] _ .AR1NODE [DEFPT2];
AR1NODE [DEFPT2] _ .T1;
END;
END;
END
ELUDOM