Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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, 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: S MURPHY/HPW/EDS
MODULE MEMCMP(SREG=#17,VREG=#15,FREG=#16,DREGS=4,RESERVE(0,1,2,3)) =
BEGIN
GLOBAL BIND MEMCMV = #10^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