! 02/12/85 - taken from eelimp45, new include files incorporated
! 21/08/95 - alter TRELIM to inhibit expression elimination of ARR triads
! 29/11/84 - correct TRELIM for TOCHAR and CONJG
! 31/01/84 - UPDATE TRELIM FOR DCMPLX & INTRIN
! 18/01/84 - BIT STRIP ADDRESSES ARE NOW RELATIVE TO ABLOCKS
! 23/11/83 set up TRACE flag and EDUMPTRACE routine
! 27/10/83 - copied from ERCS06.REL8002_eelimb7
%INCLUDE "ftn_ht"
!*
%INCLUDE "ftn_fmts2"
%INCLUDE "ftn_optspecs1"
%INCLUDE "ftn_consts1"
%INCLUDE "ftn_optfmts1"
!
%INCLUDE "ftn_triadops1"
!*
%OWNINTEGER TRACE=0
!
%OWNINTEGER ELFLAG,ELIMEND,RWFLAG,HVAL
%OWNINTEGER COORD1,COORD2,MODE,MATCH
!*
! ARRAY FOR TRIADS WHICH MAY BE ELIMINATION CANDIDATES
%CONSTBYTEINTEGERARRAY TRELIM(0:116) = 0,0,1,1,1,1,1,0,1,0,
0,0,0,0,1,1,1,1,1,1,
1,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,1,1,0,1,0,0,0,0,
0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,0,0,1,0,0,
0,1,0,0,0,0,0,0,0,1, { SET BIT FOR IARG ???
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,1,0,0,0,0,0, { SET BIT FOR ANINT ???
1,1,1,1,1,1,1,1,1,1,
0,0,0,0,0,0,1
%EXTERNALROUTINE EDUMPTRACE
TRACE=OPTFLAGS&EDUMP
%END
!
%ROUTINE CREATETABLE(%INTEGER LEN,%INTEGERNAME TADDR)
! CREATE A TABLE ENTRY OF LEN ARCHITECTURAL UNITS AND RETURN ADDRESS IN TADDR
TABSFULL %IF FREETABS+LEN>MAXTABS
TADDR=FREETABS
FREETABS=FREETABS+LEN
%END; ! CREATETABLE
%INTEGERFUNCTION HASH
! CALCULATE HASH VALUE OF CURRENT TRIAD(TR)
%RECORD(TRIADF)%NAME TR
%INTEGER RES
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
RES=(TR_OPD1!!TR_OPD2!!TR_OP)&X'1F'
%IF TRACE#0 %START
PRINTSTRING("HASH VALUE FOR CURRENT TRIAD IS")
WRITE(RES,4)
NEWLINE
%FINISH
%RESULT=RES
%END; ! HASH
%ROUTINE SETCOORDS
! SETUP COORD1,COORD2 & MODE
%RECORD(TRIADF)%NAME TR,MTR
%RECORD(PRECF)%NAME DENT
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TR_OP&BMBITOFF=CVT %THEN MODE=TR_MODE %ELSE MODE=-1
COORD2=-1
%IF TR_QOPD1&IDMASK=IDMASK %START
! CHECK FOR ARR & DEFARR TRIADS & GET COORD FOR THEIR BASE ARRAY
%IF (TR_OP&BMBITOFF=ARR %OR TR_OP&BMBITOFF=DEFARR) %AND %C
TR_QOPD1&TEXTMASK=TEXTMASK %START
MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
DENT==RECORD(MTR_OPD1<<DSCALE+ADICT)
%FINISHELSE DENT==RECORD(TR_OPD1<<DSCALE+ADICT)
COORD1=DENT_COORD
%FINISH %ELSE COORD1=-1
%IF TR_QOPD2&IDMASK=IDMASK %START
DENT==RECORD(TR_OPD2<<DSCALE+ADICT)
%IF COORD1=-1 %THEN COORD1=DENT_COORD %ELSE COORD2=DENT_COORD
%FINISH
%IF TRACE#0 %START
PRINTSTRING("COORD1="); WRITE(COORD1,1)
PRINTSTRING(" COORD2="); WRITE(COORD2,1)
PRINTSTRING(" MODE="); WRITE(MODE,1);NEWLINE
%FINISH
%END; ! SETCOORDS
%INTEGERFUNCTION TRDEF(%INTEGER TRIND)
! CHECK TRIAD WITH INDEX TRIND FOR DEFS. OF OPERANDS WITH COORDINATES
! COORD1 & COORD2
! RETURNS 1 IF DEFS. ELSE 0
%INTEGER RES
RES=ALLDEF(TRIND); ! IDENTIFIY THE DEFINING CONTEXT OF THE TRIAD
%IF RES=0 %THEN %RESULT=0; ! TRIAD HAS NO DEFINING CONTEXT
%IF RES=-1 %START; ! COMMON ITEM MAY BE DEFINED
! ASSUME CMNCOORDS HAS COORD(1) SET IF ANY CHAR OR ARRAY PARAMS IN PROG.
GETBIT(ACMNCOORDS,COORD1,RES)
%IF RES=1 %THEN %RESULT=1; ! VAR. WITH COORD1 IS DEFINED
%IF COORD2#-1 %START
GETBIT(ACMNCOORDS,COORD2,RES)
%IF RES=1 %THEN %RESULT=1; ! VAR. WITH COORD2 IS DEFINED
%FINISH
%RESULT=0; ! NEITHER VAR. IS DEFINED
%FINISH
%IF RES<0 %START; ! COMMON ITEM DEFINED & VARS. WITH COORD(1) EXIST
!RESULT FROM ALLDEF IS THE -VE COORD VALUE OF THE DEFINED COMMON
%IF COORD1=1 %OR COORD2=1 %THEN %RESULT=1
RES=-RES; ! CONTINUE AS FOR +VE RES
%FINISH
! HERE IF COMMON/LOCAL VARIABLE DEFINED BY THE TRIAD
! RESULT FROM ALLDEF IS THE COORD OF THE DEFINED VAR.
%IF RES=COORD1 %OR RES=COORD2 %THEN %RESULT=1
%RESULT=0
%END; ! TRDEF
%INTEGERFUNCTION MATCHTR(%INTEGER IND)
! CHECKS IF TRIAD IN IND MATCHES CURRTRIAD
! RESULT =1 IF MATCH ELSE 0
%RECORD(TRIADF)%NAME TR,MTR
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF TR_OP&BMBITOFF#MTR_OP&BMBITOFF %THEN %RESULT=0
%IF TR_RES1_W#MTR_RES1_W %THEN %RESULT=0
%IF TR_OPD2#MTR_OPD2 %THEN %RESULT=0
%IF TR_QOPD2#MTR_QOPD2 %THEN %RESULT=0
%RESULT=1
%END; ! MATCHTR
%INTEGERFUNCTION CURBLDEF
! CHECK IF VARIABLE WITH COORD1 OR COORD2 DEFINED SO FAR IN CURBLK
! RESULT=1 IF DEFS. ELSE 0
%INTEGER RES
GETBIT(ACURRDEF,COORD1,RES)
%IF RES=1 %THEN %RESULT=1
%IF COORD2#-1 %START
GETBIT(ACURRDEF,COORD2,RES)
%IF RES=1 %THEN %RESULT=1
%FINISH
%RESULT=0
%END; ! CURBLDEF
%INTEGERFUNCTION BLDEF(%INTEGER IND)
! CHECK BLOCK WITH INDEX IND FOR DEFS. OF VARIABLES WITH
! COORD1 OR COORD2
! RESULT=1 IF DEFS. ELSE 0
%RECORD(BLRECF)%NAME BL
%INTEGER RES
BL==RECORD(ABLOCKS+IND*BLSIZE)
GETBIT(ABLOCKS+BL_DEF,COORD1,RES)
%IF RES=1 %THEN %RESULT=1
%IF COORD2#-1 %START
GETBIT(ABLOCKS+BL_DEF,COORD2,RES)
%IF RES=1 %THEN %RESULT=1
%FINISH
%RESULT=0
%END; ! BLDEF
%ROUTINE ELIMINATE
! PERFORM TRIAD ELIMINATION OF CURRTRIAD & SET ELFLAG
%INTEGER OP,NEWOP
%RECORD(TRIADF)%NAME TR,MTR
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
MTR==RECORD(ATRIADS+MATCH*TRIADLENGTH)
%IF TRACE#0 %START
PRINTSTRING("ELIMINATE CURRTRIAD, INDEX"); WRITE(CURRTRIAD,4);NEWLINE
PRINTSTRING("MATCHING TRIAD IS");WRITE(MATCH,1);NEWLINE
%FINISH
%IF TR_QOPD1&TEXTMASK=TEXTMASK %THEN DELUSE(TR_OPD1)
%IF TR_QOPD2&TEXTMASK=TEXTMASK %THEN DELUSE(TR_OPD2)
! CHANGE CURRTRIAD(TR) TO REPL TRIAD
TR_OP=(TR_OP&BMBIT)!REPL
TR_OPD1=MATCH
OP=MTR_OP
%IF OP=ARR %OR OP=DEFARR %OR OP=ARGARR %THEN NEWOP=ARREL %ELSE NEWOP=TRIAD
TR_QOPD1=NEWOP
TR_RES2_W=0
MTR_USE=MTR_USE+1
ELFLAG=1
%END; !ELIMINATE
%ROUTINE CHECKOUT
! CHECK IF ELIM. POSS OUTSIDE CURBLK
! SETS ELFLAG TO 1 IF ELIMINATION HAS OCCURRED ELSE 0
%RECORD(TRIADF)%NAME TR,MTR
%RECORDFORMAT RWF(%INTEGER BL,EL)
%RECORD(BLRECF)%NAME CBL
%RECORD(RWF)%NAME RW
%RECORD(CLOOPRECF)%NAME DL
%RECORD(BLRECF)%NAME BDBL,RXBL
%RECORD(CONRECF)%NAME BCON
%INTEGERARRAYFORMAT ELIMF(0:31)
%INTEGERARRAYNAME RWELIM
%INTEGERARRAYFORMAT TABF(0:1000)
%INTEGERARRAYNAME RX
%INTEGER BD,RWPTR,RXPTR,RXEND,MBLK,RES
%INTEGER CNT,I,J
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
CBL==RECORD(ABLOCKS+CURRBLK*BLSIZE)
%IF TRACE#0 %START
PRINTSTRING("CHECK FOR POSSIBLE ELIMINATION OUTSIDE CURRBLK"); NEWLINE
%FINISH
ELFLAG=0
%IF COORD1>0 %START ; ! DEFS ARE POSSIBLE
! CHECK IF EITHER COORD DEFINED IN CURBL
%IF CURBLDEF=1 %THEN %RETURN; ! DEF. OCCURS - ELIMINATION NOT POSSIBLE
%FINISH
%IF RWFLAG=0 %START; ! SET UP RW TO CONTAIN BDC OF CURBLK
%IF TRACE#0 %START
PRINTSTRING("SET UP RW TO CONTAIN BDC OF CURRBLK");NEWLINE
%FINISH
RWFLAG=1
DL==RECORD(ATABS+DLOOPPTR)
CNT=1; ! INITIALISE COUNT FOR ELIMTAB INDEX
BD=CBL_BDOM; ! GET BDOM OF CURBLK
%IF TRACE#0 %START
PRINTSTRING("BDOM IS");WRITE(BD,1);NEWLINE
PRINTSTRING("BACKTARG IS"); WRITE(BACKTARG,1);NEWLINE
%FINISH
%WHILE BD#BACKTARG %CYCLE; ! CYCLE UNTIL BDOM IS OUTSIDE THE LOOP
BDBL==RECORD(ABLOCKS+BD*BLSIZE); ! GET BDOM BLOCK
%IF BDBL_DEPTH=LOOPDEPTH %START; ! BDOM IS A MEMBER OF THIS LOOP
CREATETABLE(2<<BSCALE,RWPTR); ! CREATE RW ENTRY
RW==RECORD(RWPTR+ATABS)
RW_BL=BD
%IF TRACE#0 %START
PRINTSTRING("SEARCH DLOOPTAB FOR BDOM ENTRY");NEWLINE
%FINISH
%CYCLE; ! SEARCH DLOOPTAB FOR BD ENTRY TO DETERMINE ITS ELIMTAB INDEX
CNT=CNT+1
DL==RECORD(ATABS+DL_PDBACKCHAIN)
%IF DL_BLOCK=BD %THEN %EXIT
%REPEAT
RW_EL=ELIMEND-CNT*(32<<BSCALE)
%IF TRACE#0 %START
PRINTSTRING("NEW RW ENTRY AT LOCATION"); WRITE(RWPTR,7); NEWLINE
PRINTSTRING("RW_BL=");WRITE(RW_BL,4)
PRINTSTRING(" RW_EL=");WRITE(RW_EL,7);NEWLINE
%FINISH
BD=BDBL_BDOM
%FINISHELSE BD=BDBL_BTARG
%REPEAT
%FINISH; ! SETTING UP RW
! SCAN RW TO CHECK ALL BDOMS OF CURBLK FOR ANY POSS. ELIMS.
RWPTR=ELIMEND
%IF TRACE#0 %START
PRINTSTRING("SCAN RW TO CHECK FOR ANY POSSIBLE ELIMINATIONS");NEWLINE
%FINISH
%WHILE RWPTR#FREETABS %CYCLE
RW==RECORD(ATABS+RWPTR)
RWELIM==ARRAY(RW_EL+ATABS,ELIMF)
%IF RWELIM(HVAL)#0 %START; ! POSSIBLE TRIAD MATCH
%IF TRACE#0 %START
PRINTSTRING("ELIMTAB ENTRY AT"); WRITE(RW_EL,7)
PRINTSTRING(" FOR HVAL");WRITE(HVAL,4)
PRINTSTRING(" ALREADY SET - POSSIBLE TRIAD MATCH")
NEWLINE
%FINISH
! SEARCH FOR MATCH TILL EOB
I=RWELIM(HVAL)
MTR==RECORD(I*TRIADLENGTH+ATRIADS)
MATCH1:
%WHILE MTR_USE&SOB#SOB %CYCLE
%IF MATCHTR(I)=1 %THEN ->NEXT1; ! MATCH FOUND
I=MTR_CHAIN
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%REPEAT
%IF TRACE#0 %START
PRINTSTRING("NO MATCH - CONTINUE SCAN");NEWLINE
%FINISH
->NOMATCH; ! NO MATCH - SCAN NEXT RW ENTRY
NEXT1: ! HERE IF TRIAD MATCH FOUND - CHECK FOR CVT TRIAD
%IF MODE#-1 %START
%IF TR_MODE2#MTR_MODE2 %START; ! NOT A MATCH
I=MTR_CHAIN
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
->MATCH1; ! CONTINUE CYCLE TO LOOK FOR MATCH
%FINISH
%FINISH
MATCH=I
MBLK=RW_BL
%IF TRACE#0 %START
PRINTSTRING("MATCH FOUND WITH TRIAD"); WRITE(MATCH,4)
PRINTSTRING(" IN BLOCK"); WRITE(MBLK,4);NEWLINE
%FINISH
! MATCH FOUND - NOW CHECK IF DEFS. POSSIBLE
%IF COORD1#-1 %START; ! DEFS. POSSIBLE
%IF BLDEF(MBLK)=1 %START; ! DEF. OCCURS IN MATCHED BLOCK(MBLK)
%IF TRACE#0 %START
PRINTSTRING("DEFS. OCCUR IN MATCHED BLOCK"); NEWLINE
%FINISH
! CHECK FOR DEFS. BETWEEN MATCH & EOB
%CYCLE
I=MTR_CHAIN
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%IF MTR_USE&SOB=SOB %THEN %EXIT; ! NO DEFS. FOUND IN MATCHED BLOCK
%IF TRDEF(I)=0 %THEN %CONTINUE; ! NO DEFS - CHECK NEXT TRIAD
LOOP1:
%CYCLE; ! DEF. FOUND - LOOK FOR ANOTHER MATCH
%IF TRACE#0 %START
PRINTSTRING("DEF. FOUND - LOOF FOR ANOTHER MATCH");NEWLINE
%FINISH
I=MTR_CHAIN
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%IF MTR_USE&SOB=SOB %THEN ->NOMATCH; ! NO MATCH - SCAN NEXT RW ENTRY
%IF MATCHTR(I)=1 %THEN %EXIT; ! MATCH FOUND - EXIT CYCLE
%REPEAT
%IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
%IF MTR_MODE2#TR_MODE %THEN ->LOOP1; ! NOT A MATCH - CYCLE
%FINISH
MATCH=I; ! SET NEW MATCH
%IF TRACE#0 %START
PRINTSTRING("NEW MATCH WITH TRIAD");WRITE(MATCH,4);NEWLINE
%FINISH
%REPEAT; ! END OF CYCLE TO LOOK FOR DEFS. IN MATCHED BLOCK
%FINISH
! HERE IF NO RELEVANT DEFS. FOUND IN MATCHED BLOCK
! CHECK FOR DEFS. BETWEEN MATCHED BLOCK& CURBLK(CBL)
%IF TRACE#0 %START
PRINTSTRING("CHECK FOR DEFS. BETWEEN MATCHED BLOCK & CURRBLK")
NEWLINE
PRINTSTRING("PUT BCS OF CURBLK ON RX")
NEWLINE
%FINISH
BCON==RECORD(ATABS+CBL_BCON)
RX==ARRAY(ATABS+FREETABS,TABF)
RXEND=0
! PUT BCS OF CURBLK ON RX
%FOR I=1,1,BCON_COUNT %CYCLE
%IF BCON_BLOCK(I)#MBLK %THEN RXEND=RXEND+1 %AND %C
RX(RXEND)=BCON_BLOCK(I)
%REPEAT
RXPTR=1
%IF TRACE#0 %START
PRINTSTRING("RX CONTAINS ")
%FOR I=1,1,RXEND %CYCLE; WRITE(RX(I),1); %REPEAT
NEWLINE
%FINISH
! SCAN RX
%WHILE RXPTR<=RXEND %CYCLE
%IF BLDEF(RX(RXPTR))=1 %THEN ->NOELIM; ! DEF. FOUND - ELIM. NOT POSS.
! ADD BCS OF RX(RXPTR) TO RX UNLESS ALREADY PRESENT
RXBL==RECORD(ABLOCKS+RX(RXPTR)*BLSIZE)
BCON==RECORD(ATABS+RXBL_BCON)
%FOR I=1,1,BCON_COUNT %CYCLE
%IF BCON_BLOCK(I)=MBLK %THEN %CONTINUE
%FOR J=1,1,RXEND %CYCLE
%IF RX(J)=BCON_BLOCK(I) %THEN ->NEXT2
%REPEAT
RXEND=RXEND+1
RX(RXEND)=BCON_BLOCK(I)
NEXT2:
%REPEAT
RXPTR=RXPTR+1
%REPEAT
%FINISH; ! END OF CHECKING FOR POSS. DEFS.
!HERE IF NO DEFS. BETWEEN TRIADS
ELIMINATE
%RETURN; ! TERMINATE CHECKOUT
NOELIM:
! HERE IF DEF. FOUND
%IF TRACE#0 %START
PRINTSTRING("DEF. FOUND - ELIMINATION NOT POSSIBLE");NEWLINE
%FINISH
%RETURN; ! TERMINATE CHECKOUT
%FINISH; ! END OF LOOKING FOR POSS. MATCH
NOMATCH:
! HERE IF NO MATCH FOUND - CONTINUE SCAN
%IF TRACE#0 %START
PRINTSTRING("NO MATCH - CONTINUE SCAN");NEWLINE
%FINISH
RWPTR=RWPTR+2<<BSCALE
%REPEAT; ! END OF CYCLE TO SCAN RW
%END; ! CHECKOUT
%EXTERNALROUTINE EXPELBTARG
%RECORD(TRIADF)%NAME TR,MTR
%RECORD(BLRECF)%NAME BTBL
%INTEGER SOB
%INTEGER IND
BTBL==RECORD(ABLOCKS+BACKTARG*BLSIZE)
SOB=BTBL_TEXT
CURRTRIAD=OLDBTARGTRIAD
%IF TRACE#0 %START
NEWLINES(2)
PRINTSTRING("EXPRESSION ELIMINATION FOR BACK TARGET BLOCK")
WRITE(BACKTARG,1);NEWLINES(2)
PRINTSTRING("SCAN TRIADS IN BACKTARG");NEWLINE
%FINISH
%CYCLE
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TRACE#0 %START
PRINTSTRING("CURRTRIAD IS");WRITE(CURRTRIAD,1);NEWLINE
%FINISH
! CHECK IF CURRTRIAD IS AN ELIM. CANDIDATE
%IF TRELIM(TR_OP&BMBITOFF)=1 %START
%IF TRACE#0 %START
PRINTSTRING("CURRTRIAD IS AN ELIMINATION CANDIDATE");NEWLINE
%FINISH
HVAL=HASH; ! GET HASH VAULE OF CURRTRIAD
! CHECK IF EITHER OPERAND IS A TEXT REF. WITH USE=1
%IF TR_QOPD1&TEXTMASK=TEXTMASK %START
MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
%IF MTR_USE=1 %THEN %CONTINUE; ! SCAN NEXT TRIAD
%FINISH
%IF TR_QOPD2&TEXTMASK=TEXTMASK %START
MTR==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
%IF MTR_USE=1 %THEN %CONTINUE; ! SCAN NEXT TRIAD
%FINISH
! SETUP COORD1,COORD2 &MODE
SETCOORDS
!SEARCH FOR MATCH FROM SOB
IND=SOB
MATCH1:
%WHILE IND#CURRTRIAD %CYCLE
MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF MATCHTR(IND)=1 %THEN ->MATCH2; ! MATCH FOUND
IND=MTR_CHAIN
%REPEAT
%IF TRACE#0 %START
PRINTSTRING("NO MATCH - SCAN NEXT TRIAD"); NEWLINE
%FINISH
%CONTINUE; ! NO MATCH - SCAN NEXT TRIAD
MATCH2:
%IF MODE#-1 %START
%IF TR_MODE2#MTR_MODE2 %THEN IND=MTR_CHAIN %AND ->MATCH1; ! NO MATCH
%FINISH
MATCH=IND
%IF TRACE#0 %START
PRINTSTRING("MATCH FOUND WITH TRIAD");WRITE(MATCH,1);NEWLINE
%FINISH
! MATCH FOUND - CHECK IF DEFS. POSSIBLE FOR THIS TRIAD
%IF COORD1=-1 %THEN ->ELIM; ! DEFS. NOT POSSIBLE - ELIMINATE
%IF BLDEF(BACKTARG)=1 %START; ! DEF. OCCURS IN BACKTARG
! CHECK FOR DEFS. BETWEEN MATCH & CURRTRIAD
%CYCLE
IND=MTR_CHAIN
%IF IND=CURRTRIAD %THEN ->ELIM; ! NO DEFS. FOUND
MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF TRDEF(IND)=0 %THEN %CONTINUE; ! NO DEF. - CHECK NEXT TRIAD
MATCH3:
%CYCLE
%IF TRACE#0 %START
PRINTSTRING("DEF. FOUND - LOOK FOR ANOTHER MATCH");NEWLINE
%FINISH
IND=MTR_CHAIN
MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF MATCHTR(IND)=1 %THEN %EXIT; ! MATCH FOUND
%REPEAT
%IF IND=CURRTRIAD %THEN %EXIT; ! MATCH WITH ITSELF
%IF MODE#-1 %START; ! CVT TRIAD
%IF MTR_MODE2#TR_MODE2 %THEN ->MATCH3; ! NOT A MATCH
%FINISH
! HERE IF NEW MATCH
MATCH=IND
%IF TRACE#0 %START
PRINTSTRING("NEW MATCH FOUND WITH TRIAD")
WRITE(MATCH,1);NEWLINE
PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
%FINISH
%REPEAT; ! END OF CYCLE TO LOOK FOR MATCH WITH NO DEFS.
%CONTINUE; ! SCAN NEXT TRIAD
%FINISH; ! END OF CHECK FOR DEFS.
ELIM:; ! HERE IF NO DEFS.FOUND
ELIMINATE
%IF TRACE#0 %START
PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
%FINISH
%CONTINUE; ! SCAN NEXT TRIAD
%FINISH; ! END OF CURRTRIAD AS AN ELIMINATION CANDIDATE
%REPEAT %UNTIL NEXTTRIAD=0
%IF TRACE#0 %START
PRINTSTRING("END OF EXPRESSION ELIMINATION FOR BACKTARG");NEWLINE
%FINISH
%END; ! EXPELBTARG
%EXTERNALROUTINE EXPELIM
%INTEGERARRAYFORMAT ELIMF(0:31)
%INTEGERARRAYNAME ELIMENT
%RECORD(BLRECF)%NAME CBL
%RECORD(TRIADF)%NAME TR,MTR
%INTEGER ELIMPTR
%INTEGER I
! CREATE ELIMTAB ENTRY FOR CURRENT BLOCK(CUBLK)
CREATETABLE(32<<BSCALE,ELIMPTR)
ELIMENT==ARRAY(ATABS+ELIMPTR,ELIMF)
ELIMENT(I)=0 %FOR I=0,1,31
!SAVE POINTER TO END OF ELIMTAB ENTRIES
ELIMEND=FREETABS
! INTIIALISE FLAGS
RWFLAG=0
! GET CURRENT BLOCK
CBL==RECORD(ABLOCKS+CURRBLK*BLSIZE)
%IF TRACE#0 %START
NEWLINES(2)
PRINTSTRING("EXPRESSION ELIMINATION FOR BLOCK")
WRITE(CURRBLK,4);NEWLINE
PRINTSTRING("ELIMTAB ENTRY CREATED AT LOCATION");
WRITE(ELIMPTR,7);NEWLINES(2)
PRINTSTRING("SCAN TRIADS IN CURRBLK");NEWLINE
%FINISH
%CYCLE; ! SCAN TRIADS IN CURRBLK
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH); ! GET CURRENT TRIAD
%IF TRACE#0 %START
PRINTSTRING("CURRTRIAD IS");WRITE(CURRTRIAD,4);NEWLINE
%FINISH
! CHECK IF CURRTRIAD MAY CAUSE DEFS. & CALL UPDATECURRDEF
%IF DEFTEST(TR_OP&BMBITOFF)>0 %THEN UPDATE CURRDEF
%IF TRELIM(TR_OP&BMBITOFF)=1 %START
! CURRTRIAD IS AN ELIM. CANDIDIATE
%IF TRACE#0 %START
PRINTSTRING("CURRTRIAD IS AN ELIMINATION CANDIDATE");NEWLINE
%FINISH
HVAL=HASH; ! GET HASH VALUE OF CURRTRIAD(TR)
%IF TR_QOPD1&TEXTMASK=TEXTMASK %START
MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
%IF MTR_USE=1 %THEN ->SETELIM1; ! OPERAND IS A TEXT REF. WITH USE=1
%FINISH
%IF TR_QOPD2&TEXTMASK=TEXTMASK %START
MTR==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
%IF MTR_USE=1 %THEN ->SETELIM1
%FINISH
! SETUP COORD1,COORD2 & MODE
SETCOORDS
! PERFORM ANY POSSIBLE ELIMINATIONS
%IF ELIMENT(HVAL)#0 %START
! ELIMTAB ENTRY FOR THIS HASH VALUE IS SET
%IF TRACE#0 %START
PRINTSTRING("ELIMTAB ENTRY ALREADY SET FOR HASH VALUE")
WRITE(HVAL,4);NEWLINE
%FINISH
I=ELIMENT(HVAL)
MATCH1:
! SEARCH FOR TRIAD MATCH
%WHILE I#CURRTRIAD %CYCLE
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%IF MATCHTR(I)=1 %THEN -> NEXT2; ! MATCH FOUND
I=MTR_CHAIN
%REPEAT
%IF TRACE#0 %START
PRINTSTRING("NO MATCH");NEWLINE
%FINISH
->ELIM2; ! NO MATCH OCCURRED - ELIMINATE OUTSIDE BLOCK
NEXT2:
%IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
%IF TR_MODE2#MTR_MODE2 %THEN I=MTR_CHAIN %AND ->MATCH1; ! NO MATCH
%FINISH
MATCH=I
!MATCH FOUND, CHECK IF DEFS. POSS. FOR THIS TRIAD
%IF TRACE#0 %START
PRINTSTRING("MATCH FOUND WITH TRIAD"); WRITE(MATCH,1);NEWLINE
%FINISH
%IF COORD1=-1 %THEN ->ELIM1; ! DEFS. NOT POSS. - ELIMINATE
%IF CURBLDEF=1 %START; ! DEF. OCCURS IN THIS BLOCK
%CYCLE; ! ELIMINATE IF MATCHING TRIAD WITH NO DEFS. BEFORE CURRTRIAD
I=MTR_CHAIN
%IF I=CURRTRIAD %THEN ELIMINATE %AND %EXIT
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%IF TRDEF(I)=0 %THEN %CONTINUE; ! NO DEFS. - CHECK NEXT TRIAD
LOOP1:
%CYCLE; ! DEF. FOUND - LOOK FOR ANOTHER MATCH
%IF TRACE#0 %START
PRINTSTRING("DEF. FOUND - LOOK FOR ANOTHER MATCH");NEWLINE
%FINISH
I=MTR_CHAIN
MTR==RECORD(ATRIADS+I*TRIADLENGTH)
%IF MATCHTR(I)=1 %THEN %EXIT; ! MATCH FOUND - EXIT CYCLE
%REPEAT
%IF I=CURRTRIAD %THEN %EXIT; ! MATCH WITH ITSELF - EXIT
%IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
%IF MTR_MODE2#TR_MODE2 %THEN ->LOOP1; ! NOT A MATCH
%FINISH
! HERE IF NEW MATCH FOUND
MATCH=I
%IF TRACE#0 %START
PRINTSTRING("NEW MATCH FOUND WITH TRIAD"); WRITE(MATCH,1)
NEWLINE
%FINISH
%REPEAT; ! END OF CYCLE TO LOOK FOR MATCHING TRIAD WITH NO DEFS.
%IF TRACE#0 %START
PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
%FINISH
%CONTINUE; ! SCAN NEXT TRIAD
%FINISH; ! END OF DEFS. OCCURING IN CURRENT BLOCK
ELIM1:
! HERE IF NO DEFS. IN CURRBLK
ELIMINATE
%IF TRACE#0 %START
PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
%FINISH
%CONTINUE; ! SCAN NEXT TRIAD
ELIM2:
! HERE FOR POSSIBLE ELIMS. OUTSIDE CURRBLK
CHECKOUT
%FINISH {ELIMTAB ENTRY SET} %ELSESTART
%IF TRACE#0 %START
PRINTSTRING("ELIMTAB ENTRY NOT SET FOR HVAL");NEWLINE
%FINISH
CHECKOUT
%IF ELFLAG=0 %THEN ELIMENT(HVAL)=CURRTRIAD
%FINISH
%IF TRACE#0 %START
PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
%FINISH
%CONTINUE; ! SCAN NEXT TRIAD
SETELIM1:
! HERE IF OPERANDS ARE TRIADS WITH USE=1
%IF TRACE#0 %START
PRINTSTRING("CURRTRIAD'S OPERANDS ARE TRIADS WITH USE=1");NEWLINE
%FINISH
%IF ELIMENT(HVAL)=0 %THEN ELIMENT(HVAL)=CURRTRIAD
%FINISH; ! END OF CURRTRIAD AS AN ELIM. CNADIDATE
%REPEAT %UNTIL NEXTTRIAD=0
! CLEAR RW
FREETABS=ELIMEND
%IF TRACE#0 %START
PRINTSTRING("END OF EXPRESSION ELIMINATION FOR CURRBLK");NEWLINE
%FINISH
%END; ! EXPELIM
%ENDOFFILE