Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/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, 1985
!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 = #10^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