Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/memcmp.bli
There are 12 other files named memcmp.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/HPW/EDS

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

GLOBAL BIND MEMCMV = #11^24 + 0^18+ 32;	! Version Date: 30-Nov-81

%(

***** Begin Revision History *****

27	-----	-----	SCAN I/O LISTS FOR I/O OPTIMIZATIONS
28	-----	-----	FIX BUG IN ARRMEMCHK - WERE TREATING A(I)
			AS IDENTICAL TO A(-I)

29	-----	-----	REMOVE ALL REFERENCES TO SQUARE,CUBE,P4
30	-----	-----	DO NOT SET MEMCMPFLG ON OPS INVOLVING
			CONTROL TYPE BOOLEANS
***** Begin Version 6 *****

31	1062	EDS	15-Apr-81	10-30950
	Fix special case of I=-1*I**2 being computed to memory.
	This case should be computed to AC then MOVNM.

***** Begin Version 7 *****

32	1426	SRM	30-Nov-81	--------
	Do not do operations to memory if there is a NEGFLG or
	  NOTFLG  in the statement node. This fixes the following
	  cases:
	 I=.NOT. (I + ...)
	 I= - (I.AND. ...)

	Note that in most cases, the NEGFLG or NOTFLG will be down in the
	 expression node rather than in the statement node. It is only in
	 the statement node when .NOT. is applied to an arithmentic operator
	 or minus is applied to a logical operator.

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

)%

	FORWARD MEMCMCHK(0),VMEMCMCHK(0),ARRMEMCMCHK(0),SPECTOMEM(1);
	EXTERNAL CSTMNT;

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





GLOBAL ROUTINE MEMCMCHK=
%(***************************************************************************
	ROUTINE TO DETECT ASSIGNMENT STATEMENTS THAT CAN BE PERFORMED TO MEMORY.
	IF THERE IS AN N-ARY EXPRESSION ON THE RIGHT HAND SIDE, SEARCHES THAT
	EXPRESSION FOR THE VAR OR ARRAYREF THAT IS ON THE LEFT HAND SIDE AND
	IF IT IS FOUND, BRINGS IT UP TO THE TOP RIGHT HAND NODE UNDER THE N-ARY
	EXPRESSION.
	IF THE STMNT CAN BE PERFORMED TO MEMORY, MEMCMPFLG IS SET IN THE
	STATEMENT NODE, AND IN THE EXPRESSION ON THE RIGHT HAND SIDE
***************************************************************************)%
BEGIN
	EXTERNAL CSTMNT;
	MAP PEXPRNODE CSTMNT;
	LOCAL SAVCSTMNT;
	LOCAL PEXPRNODE LHNODE:RHNODE;


	%(***IF THIS STMNT IS A LOGICAL IF, WANT TO LOOK AT THE SUBSTATEMENT UNDER IT***)%
	IF .CSTMNT[SRCID] EQL IFLID
	THEN
	BEGIN
		SAVCSTMNT_.CSTMNT;	!SAVE PTR TO CURRENT STMNT
		CSTMNT_.CSTMNT[LIFSTATE];
		MEMCMCHK();

		CSTMNT_.SAVCSTMNT;	!RESTORE PTR TO CURRENT STMNT
		RETURN
	END;

	%(***LOOK FOR ASSIGNMENT STATEMENTS ON I/O LISTS***)%

	IF .CSTMNT[SRCID] EQL READID OR .CSTMNT[SRCID] EQL WRITID THEN
	BEGIN
		SAVCSTMNT_.CSTMNT;
		CSTMNT_.CSTMNT[IOLIST];
		UNTIL .CSTMNT EQL 0 DO
		BEGIN
			IF .CSTMNT[OPRCLS] EQL STATEMENT THEN
			 IF .CSTMNT[SRCID] EQL ASGNID THEN MEMCMCHK();
			CSTMNT_.CSTMNT[SRCLINK]
		END;
		CSTMNT_.SAVCSTMNT;
		RETURN
	END;

	%(***ONLY WANT TO DO THIS FOR ASSIGNMENT STATEMENTS***)%

	IF .CSTMNT[SRCID] NEQ ASGNID THEN RETURN;

	%(***CHECK ASSIGNMENT STATEMENTS***)%

%1426%	%(***CANNOT DO TO MEMORY IF "NEG" or "NOT" FLAGS ARE SET***)%
%1426%	IF .CSTMNT[A1NEGFLG] OR .CSTMNT[A2NEGFLG]
%1426%		OR .CSTMNT[A1NOTFLG] OR .CSTMNT[A2NOTFLG]
%1426%	THEN RETURN;

	LHNODE_.CSTMNT[LHEXP];
	RHNODE_.CSTMNT[RHEXP];

	IF .CSTMNT[A1VALFLG]
	THEN
	BEGIN
		IF VMEMCMCHK() THEN (CSTMNT[MEMCMPFLG]_1;RHNODE[MEMCMPFLG]_1);
	END
	ELSE
	IF .LHNODE[OPRCLS] EQL ARRAYREF
	THEN
	BEGIN
		IF ARRMEMCMCHK() THEN (CSTMNT[MEMCMPFLG]_1;RHNODE[MEMCMPFLG]_1);
	END
END;


GLOBAL ROUTINE VMEMCMCHK=
%(***************************************************************************
	ROUTINE TO DETECT EXPRESSIONS OF THE FORM:
		A=A+B+C+...
		A=A*B*C*...
		A=B/A
		A=A AND B AND C AND...
		A=A OR B OR C OR...
		A=A XOR B XOR C...
		A=A EQV B EQV C ...
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE TO
	BE ANALYZED.
	IF AN OPERATION THAT CAN BE PERFORMED TO MEMORY IS DETECTED, THE
	ARG THAT MATCHES THE LHS OF THE ASSIGNMENT IS MOVED INTO THE TOP RIGHT
	NODE OF THE N-ARY TREE, AND THIS FUNCTION RETURNS TRUE
***************************************************************************)%
BEGIN
	EXTERNAL CSTMNT;
	MAP PEXPRNODE CSTMNT;
	OWN PEXPRNODE ARGNODE;
	OWN PEXPRNODE SUBNODE;
	OWN T1;
	OWN NARYOPR;



	ARGNODE_.CSTMNT[RHEXP];

	%(**DO NOT SET MEMCMPFLG ON OPS INVOLVING CONTROL
		TYPE BOOLEANS**)%
	IF .ARGNODE[OPRCLS] EQL BOOLEAN
	THEN
	BEGIN
		SUBNODE_.ARGNODE[ARG1PTR];
		IF .SUBNODE[VALTYPE] EQL CONTROL THEN RETURN FALSE;
		SUBNODE_.ARGNODE[ARG2PTR];
		IF .SUBNODE[VALTYPE] EQL CONTROL THEN RETURN FALSE;
	END;


	%(***CHECK FOR A=A**2, A=A**3, A=A*(POWER OF 2 PLUS 1) ***)%
	IF .ARGNODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
		IF .ARGNODE[ARG1PTR] EQL .CSTMNT[LHEXP]
		THEN
		BEGIN
			IF SPECTOMEM(.ARGNODE)		!IF THIS OPERATOR IS ONE OF
							! THE ONES IN THIS OPRCLS THAT
							! CAN BE PERFORMED TO MEMORY
			THEN RETURN TRUE
		END;
		RETURN FALSE
	END

	ELSE
	%(***CHECK FOR A=B/A***)%
	IF .ARGNODE[OPR1] EQL DIVOPF
	THEN
	BEGIN
		IF .ARGNODE[ARG2PTR] EQL .CSTMNT[LHEXP]
		THEN RETURN TRUE
	END

	ELSE
	%(****FOR BOOLEANS, ADD AND MUL - MUST SEARCH N-ARY TREE FOR MATCH TO LHEXP**)%
	IF .ARGNODE[OPRCLS] EQL BOOLEAN OR ADDORMUL(ARGNODE)
	THEN
	BEGIN
		IF .ARGNODE[ARG1PTR] EQL .CSTMNT[LHEXP]
		THEN
		BEGIN
			%(***ARG WHICH IS EQUAL TO LHS SHOULD ALWAYS BE THE 2ND***)%
			SWAPARGS(ARGNODE);
			RETURN TRUE
		END
		ELSE
		IF .ARGNODE[ARG2PTR] EQL .CSTMNT[LHEXP]
		THEN RETURN TRUE
		ELSE
		%(***SEARCH THE TOP LEVEL N-ARY NODE***)%
		BEGIN
			NARYOPR_.ARGNODE[OPERATOR];
			SUBNODE_.ARGNODE[ARG1PTR];	!(EXPR'S ARE LEFT-BALANCED)

			%(***LOOP TO SEARCH FOR THE LHS WITHIN THE TOP-LEVEL NARY
				EXPRESSION*****)%
			WHILE (.SUBNODE[OPERATOR] EQL .NARYOPR) AND
				NOT (.SUBNODE[PARENFLG])
			DO
			BEGIN
				IF .SUBNODE[ARG2PTR] EQL .CSTMNT[LHEXP]
				THEN
				BEGIN
					%(***EXCHANGE THE NODE THAT MATCHES WITH
						THE TOP-LEVEL RIGHT NODE***)%
					SUBNODE[ARG2PTR]_.ARGNODE[ARG2PTR];
					T1_.SUBNODE[A2FLGS];
					SUBNODE[A2FLGS]_.ARGNODE[A2FLGS];
					ARGNODE[A2FLGS]_.T1;
					ARGNODE[ARG2PTR]_.CSTMNT[LHEXP];
					RETURN TRUE;
				END;

				%(***TREES ARE LEFT-BALANCED - THEREFORE EITHER
					EXAMINE THE LEFT-SON OR WALK DOWN TO IT***)%
				IF .SUBNODE[A1VALFLG]
				THEN
				BEGIN
					IF .SUBNODE[ARG1PTR] EQL .CSTMNT[LHEXP]
					THEN
					BEGIN
						%(***EXCHANGE THE NODE THAT MATCHES WITH
							THE NODE AT THE TOP-LEVEL
							RIGHT*****)%
						SUBNODE[ARG1PTR]_.ARGNODE[ARG2PTR];
						T1_.SUBNODE[A1FLGS];
						SUBNODE[A1FLGS]_.ARGNODE[A2FLGS];
						ARGNODE[A2FLGS]_.T1;
						ARGNODE[ARG2PTR]_.CSTMNT[LHEXP];
						RETURN TRUE;
					END;

					RETURN;
				END
				ELSE
				SUBNODE_.SUBNODE[ARG1PTR];
			END;

		END
	END;
	RETURN FALSE;
END;





GLOBAL ROUTINE ARRMEMCMCHK=
%(***************************************************************************
	ROUTINE TO DETECT EXPRESSIONS OF THE FORM:
		A(I,J,...)=A(I,J,...)+B+C+...
		A(I,J,...)=A(I,J,...)*B*C*...
		A(I,J,...)=B/A(I,J,...)
		A(I,J,...)=A(I,J,...) AND B AND C AND...
		A(I,J,...)=A(I,J,...) OR B OR C OR...
		A(I,J,...)=A(I,J,...) XOR B XOR C...
		A(I,J,...)=A(I,J,...) EQV B EQV C ...
	CALLED WITH THE GLOBAL CSTMNT POINTING TO THE STATEMENT NODE TO
	BE ANALYZED.
	IF AN OPERATION THAT CAN BE PERFORMED TO MEMORY IS DETECTED, THE
	ARG THAT MATCHES THE LHS OF THE ASSIGNMENT IS MOVED INTO THE TOP RIGHT
	NODE OF THE N-ARY TREE, AND THE FUNCTION RETURNS TRUE
***************************************************************************)%
BEGIN
	EXTERNAL CSTMNT;
	MAP PEXPRNODE CSTMNT;
	OWN PEXPRNODE LHNODE:TSTNODE;
	OWN PEXPRNODE ARGNODE;
	OWN PEXPRNODE SUBNODE;
	OWN T1;
	OWN NARYOPR;



	%(****ROUTINE TO TEST WHETHER 'NODE' IS AN ARRAYREF WITH IDENTICAL ARGS TO THE
		ARRAYREF ON THE LEFT HAND SIDE OF THE CURRENT ASSIGNMENT STATEMENT.
		(THIS IS NECESSARY BECAUSE ARRAYREF NODES ARE NEVER COMMON SUBEXPRS)****)%
	ROUTINE ARREQLLH(NODE)=
	BEGIN
		MAP PEXPRNODE NODE;
		IF .NODE[ARGWD] EQL .LHNODE[ARGWD]	!IF NAME OF ARRAY IS SAME AND
							! SS LIST IS THE SAME COMMON SUBEXPR
		THEN
		BEGIN
			RETURN (.NODE[TARGET] EQL .LHNODE[TARGET]
				AND .NODE[OPRCLS] EQL ARRAYREF
				AND .NODE[A2NGNTFLGS] EQL .LHNODE[A2NGNTFLGS])

		END
		ELSE RETURN FALSE
	END;



	ARGNODE_.CSTMNT[RHEXP];
	LHNODE_.CSTMNT[LHEXP];


	%(**DO NOT SET MEMCMPFLG ON OPS INVOLVING CONTROL
		TYPE BOOLEANS**)%
	IF .ARGNODE[OPRCLS] EQL BOOLEAN
	THEN
	BEGIN
		SUBNODE_.ARGNODE[ARG1PTR];
		IF .SUBNODE[VALTYPE] EQL CONTROL THEN RETURN FALSE;
		SUBNODE_.ARGNODE[ARG2PTR];
		IF .SUBNODE[VALTYPE] EQL CONTROL THEN RETURN FALSE;
	END;


	%(***CHECK FOR A=A**2, A=A**3, A=A*(POWER OF 2 PLUS 1) ***)%
	IF .ARGNODE[OPRCLS] EQL SPECOP
	THEN
	BEGIN
		IF ARREQLLH(.ARGNODE[ARG1PTR])
		THEN
		BEGIN
			IF SPECTOMEM(.ARGNODE)		!IF THIS OPERATOR IS ONE OF
							! THE ONES IN THIS OPRCLS THAT
							! CAN BE PERFORMED TO MEMORY
			THEN RETURN TRUE
		END;
		RETURN FALSE
	END

	ELSE
	%(***CHECK FOR A=B/A***)%
	IF .ARGNODE[OPR1] EQL DIVOPF
	THEN
	BEGIN
		TSTNODE_.ARGNODE[ARG2PTR];
		IF ARREQLLH(.TSTNODE)
		THEN
		RETURN TRUE
	END

	ELSE
	%(****FOR BOOLEANS, ADD AND MUL - MUST SEARCH N-ARY TREE FOR MATCH TO LHEXP**)%
	IF .ARGNODE[OPRCLS] EQL BOOLEAN OR ADDORMUL(ARGNODE)
	THEN
	BEGIN
		TSTNODE_.ARGNODE[ARG1PTR];
		IF ARREQLLH(.TSTNODE)
		THEN
		BEGIN
			%(***ARG WHICH IS EQUAL TO LHS SHOULD ALWAYS BE THE 2ND***)%
			SWAPARGS(ARGNODE);
			RETURN TRUE
		END
		ELSE
		IF ARREQLLH(.ARGNODE[ARG2PTR])
		THEN RETURN TRUE
		ELSE
		%(***SEARCH THE TOP LEVEL N-ARY NODE***)%
		BEGIN
			NARYOPR_.ARGNODE[OPERATOR];
			SUBNODE_.ARGNODE[ARG1PTR];	!(EXPR'S ARE LEFT-BALANCED)

			%(***LOOP TO SEARCH FOR THE LHS WITHIN THE TOP-LEVEL NARY
				EXPRESSION*****)%
			WHILE (.SUBNODE[OPERATOR] EQL .NARYOPR) AND
				NOT (.SUBNODE[PARENFLG])
			DO
			BEGIN
				IF ARREQLLH(.SUBNODE[ARG2PTR])
				THEN
				BEGIN
					%(***EXCHANGE THE NODE THAT MATCHES WITH
						THE TOP-LEVEL RIGHT NODE***)%
					T1_.SUBNODE[ARG2PTR];
					SUBNODE[ARG2PTR]_.ARGNODE[ARG2PTR];
					ARGNODE[ARG2PTR]_.T1;
					T1_.SUBNODE[A2FLGS];
					SUBNODE[A2FLGS]_.ARGNODE[A2FLGS];
					ARGNODE[A2FLGS]_.T1;
					RETURN TRUE;
				END;

				%(***TREES ARE LEFT-BALANCED - THEREFORE EITHER
					EXAMINE THE LEFT-SON OR WALK DOWN TO IT***)%
				IF ARREQLLH(.SUBNODE[ARG1PTR])
				THEN
				BEGIN
					%(***EXCHANGE THE NODE THAT MATCHES WITH
						THE NODE AT THE TOP-LEVEL
						RIGHT*****)%
					T1_.SUBNODE[ARG1PTR];
					SUBNODE[ARG1PTR]_.ARGNODE[ARG2PTR];
					ARGNODE[ARG2PTR]_.T1;
					T1_.SUBNODE[A1FLGS];
					SUBNODE[A1FLGS]_.ARGNODE[A2FLGS];
					ARGNODE[A2FLGS]_.T1;
					RETURN TRUE;

				END
				ELSE
				SUBNODE_.SUBNODE[ARG1PTR];
			END;

		END
	END;

	%(***IF FALL THRU TO HERE, WERE UNSUCCESSFUL*******)%
	RETURN FALSE;
END;



GLOBAL ROUTINE SPECTOMEM(RHNODE)=
%(***************************************************************************
	TESTS WHETHER THE NODE "RHNODE" HAS AN OPERATOR IN THE "SPECOP" CLASS
	(IE THE CLASS INCLUDING P2MUL,SQR,ETC) THAT CAN BE PERFORMED TO MEMORY.
	THIS ROUTINE IS ONLY CALLED IF THE OPERATOR IS KNOWN TO BE IN OPRCLS
	"SPECOP"
***************************************************************************)%
BEGIN
%[1062]% EXTERNAL CSTMNT;
%[1062]% MAP PEXPRNODE CSTMNT;
	MAP PEXPRNODE RHNODE;

	%(***P2MUL,P2DIV, CANNOT BE PERFORMED TO MEMORY***)%
	IF .RHNODE[OPERSP] EQL P2MULOP OR .RHNODE[OPERSP] EQL P2DIVOP
	THEN RETURN FALSE;

	%(***DOUBLE PREC OPS CANNOT BE PERFORMED TO MEMORY***)%
	IF .RHNODE[VALTYPE] EQL DOUBLPREC THEN RETURN FALSE;


	%(***IN LINE EXPONENTIATIONS TO EVEN POWERS OTHER THAN 2 CANNOT
		BE DONE TO MEMORY***)%
	IF .RHNODE[OPERSP] EQL EXPCIOP
	THEN
	BEGIN
		IF .RHNODE[ARG2PTR]	!IF HAVE AN ODD POWER
%[1062]%		OR ( .RHNODE[ARG2PTR] EQL 2	! OR THE POWER 2
%[1062]%		AND NOT .CSTMNT[A2NEGFLG] )	! BUT NO NEGFLG
		THEN RETURN TRUE
		ELSE RETURN FALSE;
	END;


	%(***P2-PLUS-1 MULTIPLY CAN BE PERFORMED TO MEMORY***)%
	RETURN TRUE;
END;
END
ELUDOM