! 01/02/83 - EELIMV4 -LINE 960, DO DEFTEST CHECK BEFORE CALLING UPDATECURRDEF
! 31/07/83 - EELIMV3 -  DELETE LINES 960-966 AND CALL UPDATE CURRDEF
 !         - INSERT AT LINE 610, REPL TRIAD POINTS TO ARREL WHERE NECESSARY
{30/12/82 - allow for intrinsic triads}
%INCLUDE "ERCS06.OPT_SPECS"

%INCLUDE "ERCS06.PERQ_TRIADOPS"

%OWNINTEGER ELFLAG,ELIMEND,RWFLAG,HVAL
%OWNINTEGER COORD1,COORD2,MODE,MATCH

! ARRAY FOR TRIADS WHICH MAY BE ELIMINATION CANDIDATES
%CONSTBYTEINTEGERARRAY TRELIM(0:114) = 0,0,1,1,1,1,1,0,1,1,
                                      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,
                                      0,0,0,0,0,0,0,0,0,0,
                                      0,0,0,0,1,0,0,0,0,1,
                                      1,1,1,1,1,1,1,1,1,1,
                                      1,1,0,0,0

%ROUTINE CREATETABLE(%INTEGER LEN,%INTEGERNAME TADDR)
! CREATE A TABLE ENTRY OF LEN BYTES AND RETURN ADDRESS IN TADDR

TABSFULL %IF FREETABS+LEN>MAXTABS
TADDR=FREETABS
FREETABS=FREETABS+LEN
%END; ! CREATETABLE

! %EXTERNALROUTINE SETBIT(%INTEGER BSADDR,COORD)
! SET BIT DETERMINED BY COORD IN ARRAY WITH ADDRESS BSADDR

!%INTEGER WORD,BIT
!%INTEGERARRAYNAME BS
!WORD=(COORD*X'FFF0')>>4
!BIT=X'80000000'>>(COORD&X'F')
!BS==ARRAY(BSADDR,TABF)
!BS(WORD)=BS(WORD)!BIT
!%END; ! SETBIT

!%EXTERNALROUTINE GETBIT(%INTEGER BSADDR,COORD, %INTEGERNAME RES)
! IF BIT(DETERMINED BY COORD) SET IN ARRAY WITH ADDRESS BSADDR,
! SET RES TO 1 ELSE 0
!%INTEGER WORD,BIT
!%INTEGERARRAYNAME BS
!WORD=(COORD&X'FFF0')>>4
!BIT=X'80000000'>>(COORD&X'F')
!BS==ARRAY(BSADDR,TABF)
!%IF BS(WORD)&BIT=BIT %THEN RES=1 %ELSE RES=0
!%END; ! GETBIT

%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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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(BL_DEF,COORD1,RES)
%IF RES=1 %THEN %RESULT=1
%IF COORD2#-1 %START
  GETBIT(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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#0 %START
        PRINTSTRING("ELIMTAB ENTRY NOT SET FOR HVAL");NEWLINE
      %FINISH
      CHECKOUT
      %IF ELFLAG=0 %THEN ELIMENT(HVAL)=CURRTRIAD
    %FINISH
    %IF OPTFLAGS&EDUMP#0 %START
      PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
    %FINISH
    %CONTINUE; ! SCAN NEXT TRIAD
  
    SETELIM1:
    ! HERE IF OPERANDS ARE TRIADS WITH USE=1
    %IF OPTFLAGS&EDUMP#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 OPTFLAGS&EDUMP#0 %START
  PRINTSTRING("END OF EXPRESSION ELIMINATION FOR CURRBLK");NEWLINE
%FINISH
%END; ! EXPELIM
%ENDOFFILE