%INCLUDE "ERCC07.PERQ_FORMAT3S"
%EXTRINSICRECORD(WORKAF) WORKA
%EXTRINSICRECORD(PARMF) PARM
%CONSTINTEGER YES=1
%CONSTINTEGER NO=0
%EXTERNALROUTINESPEC ABORT
%EXTERNALROUTINESPEC FAULT(%INTEGER N,DATA,IDENT)
%EXTERNALROUTINESPEC PRINT TRIPS(%RECORD(TRIPF)%ARRAYNAME TRIPLES)
%CONSTBYTEINTEGERARRAY WORDS(0:7)=0(3),1,1,2,4,8;
%ROUTINE EXTRACT(%RECORD(RD)%NAME OPND,%INTEGERNAME VAL, %C
         %LONGREALNAME RVAL,%STRINGNAME STRVAL)
!***********************************************************************
!*    EXTRACTS A CONTANT OPERAND RETURNING REAL &INT VALUES           *
!***********************************************************************
%INTEGER TYPE,PREC,I,AD
      TYPE=OPND_PTYPE; PREC=TYPE>>4
      TYPE=TYPE&15
      %IF TYPE=5 %START
         %FOR I=0,1,OPND_XTRA %CYCLE
            BYTEINTEGER(ADDR(STRVAL)+I)=WORKA_A(OPND_D+I)
         %REPEAT
      %FINISH %ELSE %IF TYPE=1 %THEN %START
         VAL=OPND_D
         RVAL=VAL
      %FINISH %ELSE %START
         VAL=0
         AD=ADDR(OPND_D)
         %CYCLE I=0,1,7
            BYTEINTEGER(ADDR(RVAL)+I)=BYTEINTEGER(AD+I)
         %REPEAT
      %FINISH
%END
%EXTERNALROUTINE CTOP(%INTEGERNAME FLAG,MASK,%INTEGER XTRA,
         %RECORD(RD)%NAME OPND1,OPND2)
!***********************************************************************
!*    AN OPERATION HAS BEEN FOUND WHERE BOTH OPERANDS ARE              *
!*    CONSTANTS OR KNOWN AT COMPILE TIME. THIS ROUTINE INTERPRETS      *
!*    THE OPERATION                                                    *
!*    ON EXIT FLAG=0 IF INTERPRETED. REFRAINS FROM INTERPRETING        *
!*    X=1/0 FOR EXAMPLE. CODE IS PLANTED FOR THESE FUNNIES             *
!***********************************************************************
%CONSTINTEGER UTRUNCMASK=X'00000800',BTRUNCMASK=X'00000013'
%CONSTBYTEINTEGERARRAY FCOMP(1:14)= %C
                                        8,10,2,7,12,4,7,
                                        8,12,4,7,10,2,7;
%INTEGER K,TYPEP,PRECP,OP,VAL,SVAL1,SVAL2,C,D,JJ,KK,TRUNCMASK
%STRING(255) STRVAL1,STRVAL2
!%LONGINTEGER VAL1,VAL2
%INTEGER VAL1,VAL2
!%LONGLONGREAL RVAL1,RVAL2
%LONGREAL RVAL1,RVAL2
%SWITCH UISW,URSW(10:20),BISW,BRSW(0:24)
      %ON %EVENT 1,2 %START
         %RETURN
      %FINISH
      TYPEP=OPND1_PTYPE&7; PRECP=OPND1_PTYPE>>4&15; OP=FLAG
      EXTRACT(OPND1,VAL1,RVAL1,STRVAL1)
      SVAL1<-VAL1
      %IF OP<128 %START;                ! UNARY
         %RETURN %IF OP>20
         TRUNCMASK=UTRUNCMASK
         %IF TYPEP=2 %THEN ->URSW(OP) %ELSE  ->UISW(OP)
      %FINISH
      OP=OP-128
      EXTRACT(OPND2,VAL2,RVAL2,STRVAL2)
      SVAL2<-VAL2
      %IF TYPEP=2 %THEN ->BRSW(OP) %ELSE ->BISW(OP)
UISW(10):                                ! \
      VAL1=\VAL1
INTEND:
!      %IF PRECP=6 %THEN %START
!         OPND1_D<-VAL1>>32
!         OPND1_XTRA<-VAL1
!         FLAG=0
!      %FINISH %ELSE %START
         VAL<-VAL1
         %IF VAL=VAL1 %OR 1<<OP&TRUNCMASK=0 %THEN %C
            FLAG=0 %AND OPND1_D=VAL;! NO ARITH OFLOW CONDITION
!      %FINISH
      %IF FLAG=0 %START
         OPND1_PTYPE=PRECP<<4!1
         %IF X'FFFF8000'<=VAL1<=X'FFFF' %THEN OPND1_FLAG=0 %C
            %ELSE OPND1_FLAG=1
      %FINISH
      %RETURN
UISW(11):                                ! INTEGER NEGATE
      VAL1=-VAL1; -> INT END
UISW(13):                                ! INTEGER ABS
      VAL1=IMOD(VAL1); -> INT END
UISW(12):                                ! INTEGER FLOAT
      RVAL1=VAL1; PRECP=PRECP+1
      ->REAL END
URSW(15):                                ! STRETCH REAL
      PRECP=PRECP+1
REAL END:OPND1_FLAG=1
      OPND1_D=INTEGER(ADDR(RVAL1))
      OPND1_XTRA=INTEGER(ADDR(RVAL1)+4)
!      %IF PRECP=7 %THEN %START
!         OPND1_FLAG=3
!         OPND1_XTRA=ADDR(A(R))
!         %CYCLE K=0,1,15
!            A(R)=BYTEINTEGER(ADDR(RVAL1)+K)
!            R=R+1
!         %REPEAT
!      %FINISH
      FLAG=0; OPND1_PTYPE=16*PRECP+2
      %RETURN
UISW(15):                                ! STRETCH INTEGER
      %IF PRECP=4 %THEN PRECP=5 %AND ->INT END
      %RETURN
UISW(14):                                ! SHORTEN INTEGER
      %IF IMOD(VAL1)<=X'7FFF' %THEN PRECP=4 %AND ->INT END
      %RETURN
URSW(14):                                ! SHORTEN REAL
      PRECP=PRECP-1
      ->REAL END
URSW(12):                                ! FLOAT REAL
      ABORT
UISW(16):                                ! SHORTEN FOR <-
      %IF PRECP=5 %THEN VAL1=VAL1&X'FFFF' %AND PRECP=4 %AND %C
         ->INTEND
      %RETURN
BISW(0):                                ! ADD
BISW(14):                                ! COMBINE VMY RESULTS
      VAL1=VAL1+VAL2; -> INT END
BISW(1):                                ! MINUS
      VAL1=VAL1-VAL2; -> INT END
BISW(2):                                ! EXCLUSIVE OR
      VAL1=VAL1!!VAL2; -> INT END
BISW(3):                                ! OR
      VAL1=VAL1!VAL2; -> INT END
BISW(4):                                ! MULT
      VAL1=VAL1*VAL2; -> INT END
BISW(6): %RETURN;                       ! / DIVISION
BISW(5): %RETURN %IF VAL2=0;            ! // DIVISION
      VAL1=VAL1//VAL2; -> INT END
BISW(7):                                ! AND
      VAL1=VAL1&VAL2; -> INT END
BISW(9):                                ! SLL
      %IF PRECP=6 %THEN VAL1=VAL1<<SVAL2 %ELSE VAL1=SVAL1<<SVAL2
      ->INT END
BISW(8):                                ! SRL
      %IF PRECP=6 %THEN VAL1=VAL1>>SVAL2 %ELSE VAL1=SVAL1>>SVAL2
      ->INT END
BISW(13):                                ! VMY & CHK BOUNDS
      C=VAL2>>24;                       ! DIMENSION
      D=VAL2&X'FFFF';                   ! DV POINTER
      %RETURN %UNLESS D>0;              ! UNLESS DV AVAILABLE
      %IF VAL1<WORKA_CTABLE(D+3*C+1) %OR VAL1>WORKA_CTABLE(D+3*C) %C
         %THEN FAULT(50,VAL1,XTRA&X'FFFF')
      VAL1=VAL1*WORKA_CTABLE(D+3*C-1) %UNLESS C=1
      ->INT END
BISW(18):                                ! ARRAY SCALE
      D=VAL2>>16&31;                    ! TOTAL NO OF DIMENSIONS
      KK=VAL2&X'FFFF';                  ! DV DISP
      %RETURN %UNLESS KK>0
      JJ=WORKA_CTABLE(KK+4);            ! LB(1)
      C=6
      %WHILE C<=3*D %CYCLE
         JJ=JJ+WORKA_CTABLE(KK+C-1)*WORKA_CTABLE(KK+C+1)
         C=C+3
      %REPEAT
      VAL1=VAL1-JJ
      ->INT END
BISW(11):BISW(12):                        ! COMPARISONS
BRSW(11):BRSW(12):                        ! REAL COMPARISONS
      MASK=FCOMP(XTRA)
      FLAG=0
      %IF TYPEP=2 %THEN ->RCOMP
      %IF (MASK&8#0 %AND VAL1=VAL2) %OR (MASK&4#0 %AND VAL1<VAL2)%C
         %OR (MASK&2#0 %AND VAL1>VAL2) %THEN MASK=15 %ELSE MASK=0
      %RETURN
RCOMP:
      %IF (MASK&8#0 %AND RVAL1=RVAL2) %OR (MASK&4#0 %AND RVAL1<RVAL2)%C
         %OR (MASK&2#0 %AND RVAL1>RVAL2) %THEN MASK=15 %ELSE MASK=0
      %RETURN
URSW(11):                                ! NEGATE
      RVAL1=-RVAL1; -> REAL END
BRSW(13):                                ! ABS
      RVAL1=MOD(RVAL1); -> REAL END
BRSW(0):                                ! ADD
      RVAL1=RVAL1+RVAL2; -> REAL END
BRSW(1):                                ! SUBTRACT
      RVAL1=RVAL1-RVAL2; -> REAL END
BRSW(4):                                ! MULT
      RVAL1=RVAL1*RVAL2; -> REAL END
BRSW(6):                                ! DIVISION
      %RETURN %IF RVAL2=0;              ! AVOID DIV BY ZERO
      RVAL1=RVAL1/RVAL2; -> REAL END
BISW(10):                                ! '**' WITH 2 INTEGER OPERANDS
BRSW(10):                                 ! '**' WITH AT LEAST 1 REAL
      %RETURN %UNLESS OPND2_PTYPE&7=1 %AND -63<=VAL2<=63
      RVAL1=RVAL1**VAL2
      ->REALEND
BISW(17):                                ! '****' WITH 2 INTEGER OPERAND
      %RETURN %UNLESS 0<=VAL2<=63
      VAL2=1
      %WHILE SVAL2>0 %CYCLE
         VAL2=VAL2*VAL1
         SVAL2=SVAL2-1
!         %RETURN %IF VAL2#INTEGER(ADDR(VAL2)+4)
      %REPEAT
      VAL1=VAL2; ->INT END
BISW(24):                               ! CONCAT
      %RETURN %IF LENGTH(STRVAL1)+LENGTH(STRVAL2)>255
      STRVAL1=STRVAL1.STRVAL2
STREND:                                 ! RETURN VALUE 
      OPND1_XTRA=LENGTH(STRVAL1)
      JJ=WORKA_ARTOP
      %FOR K=0,1,OPND1_XTRA %CYCLE
         WORKA_A(JJ+K)=BYTEINTEGER(ADDR(STRVAL1)+K)
      %REPEAT
      OPND1_D=JJ
      WORKA_ARTOP=JJ+OPND1_XTRA+1
      FLAG=0
      %RETURN
URSW(*):UISW(*):
BRSW(*):BISW(*):
%END
%EXTERNALROUTINE TRIP OPT(%RECORD(TRIPF)%ARRAYNAME TRIPLES,
      %INTEGERNAME NEXT TRIP)
!***********************************************************************
!*    SCANS A TRIPLES LIST FOR POSSIBLE OPTIMISATIONS
!***********************************************************************
%INTEGER CHANGES,DUPS,DUPTNO,PTR,I,J,K,VAL,CURR,NEXT,OP1,OP2,CTOPOP
%BYTEINTEGERARRAYNAME A
%RECORD(TRIPF)%NAME CURRT,NEWT,NEXTT
%RECORD(RD)%NAME OPND1,OPND2
%RECORD(LISTF)%NAME LCELL
%INTEGERFNSPEC PRELOAD PLACE(%INTEGER TRIP)
%ROUTINESPEC NOOP(%INTEGER TRIPLE,%RECORD(RD)%NAME ROPND)

%INTEGERFNSPEC SAME OPND(%RECORD(RD)%NAME OPND1,OPND2)
%ROUTINESPEC CHECK DUPS(%INTEGER STRIPNO,STRIPNO)
%ROUTINESPEC DUPLICATE TRIP(%INTEGER TRIPNO,DTRIPNO)
%ROUTINESPEC DEC USE(%INTEGER TRIPLE NO)
%ROUTINESPEC DELETE TRIPLE(%INTEGER TRIPLE NO)
%CONSTBYTEINTEGERARRAY FOLD NOOP INFO(20:40)= %C
                    X'81',X'41',X'81',X'81',X'86',{+,-,!!,!,*}
                    2,0,X'84',1,1,{//,/,&,>>,<<}
                    2,0,0,3,X'81',{**,COMP,DCOMP,VMY,COMB}
                    0,0,2,0,1,{=,<-,****,SCALE,INDEX}
                    0{IFETCH};
! 2**0 SET IF SECOND OPERANR ZERO IS NOOP
! 2**1 SET IF SECOND OPERAND 1 IS A NOOP
! 2**2 SET IF SECOND OPERAND 0 MEANS RESULT=0
! 2**5 SET IF SOME FOLDING POSSIBLE
! 2**6 SET IF FOLDING WITH ITSELF POSSIBLE BUT NOT SIMPE
! 2**7 SET FOR NORMAL FOLDING
!
      CHANGES=0;                        ! NO CHANGES AS YET
      DUPS=0;                           ! NO DUPLICATES YET
      A==WORKA_A
!
! FIRST OPTIMISATIO IS TO SEARCH FOR AND REMOVE NOPS
! LIKE *1 OR <<0 OR +0 ETC. THESE ARE SURPRISINGLY COMMON
! IN PROGRAMS MADE MACHINE INDEPENDENT BY LIBERAL USE
! OF CONSTANT VARIABLES
!
      PTR=TRIPLES(0)_FLINK
      %WHILE PTR>0 %CYCLE
         CURRT==TRIPLES(PTR);           ! EXAMINE EACH TRIPLE
         CURR=PTR
         PTR=CURRT_FLINK
         %CONTINUE %IF CURRT_FLAGS&DONT OPT#0
         I=CURRT_OPERN
         OPND1==CURRT_OPND1
         OPND2==CURRT_OPND2
         %IF I>=20 %THEN %START;        ! BINARY OPERATIONS
            J=FOLD NOOP INFO(I)&15
            %CONTINUE %UNLESS OPND2_FLAG<=1 %AND J#0 %AND OPND2_PTYPE&7=1
            VAL=OPND2_D;                ! VALUE OF CONSTANT
            %IF (J&1#0 %AND VAL=0) %OR (J&2#0 %AND VAL=1) %START
               NOOP(CURR,OPND1);        ! THIS IS NOOP
               %CONTINUE
            %FINISH
            %IF J&4#0 %AND VAL=0 %THEN %START
               %IF OPND1_FLAG=8 %THEN DEC USE(OPND1_D)
               CURRT_OPND1=OPND2;       ! RESULT IS ZERO
               NOOP(CURR,OPND2)
                                        ! MAY CAUSE OTHER NOOPS
                                        ! GE I=(A+B)*0
            %FINISH
         %FINISH %ELSE %START;          ! UNARY
                                        ! OPTIMISE LOAD DOUBLE & SHRINK
                                        ! IN CASE WHERE CHECKING IS OFF
            %CONTINUE %UNLESS OPND1_S1>>16=X'51' %C
               %AND(I=16 %OR(I=14 %AND PARM_OPT=0))
            %IF OPND1_FLAG=2 %AND A(OPND1_D+2)=2=A(OPND2_D+3) %THEN %START
               J=WORKA_TAGS(OPND1_XTRA)
               LCELL==RECORD(WORKA_AASL0+16*J);! ON TO NAME RECORD
               OPND1_FLAG=7;            ! LOCAL
               OPND1_PTYPE=X'41';       ! PRESHORTENED
               CURRT_OPTYPE=X'41';      ! REVISE TRIPLE PTYPE
               OPND1_D=(LCELL_S1&X'F0')<<12! LCELL_S3>>16
               NOOP(CURR,OPND1)
            %FINISH
            %IF OPND1_FLAG=8 %THEN %START
               NEXTT==TRIPLES(OPND1_D)
               %IF NEXTT_CNT=1 %AND NEXTT_OPERN=40 %START
                  NEXTT_OPND1_PTYPE=X'41'
                  NEXTT_OPTYPE=X'41'
                  OPND1_PTYPE=X'41'
                  NOOP(CURR,OPND1)
               %FINISH
            %FINISH
         %FINISH
      %REPEAT
!
! ADVANCED FOLDING FACTOR CONSTANTS OUT OF 2 OR MORE TRIPLES
! TO SAVE AN OPERATION. ONLY MORE USUSAL CASE CATERED FOR AS IN
! VAR+CONST+CONST.
!
      PTR=TRIPLES(0)_FLINK
      %WHILE PTR>0 %CYCLE
         CURRT==TRIPLES(PTR)
         NEXT=CURRT_FLINK
         %EXIT %IF NEXT<=0
         NEXTT==TRIPLES(NEXT)
         %UNLESS CURRT_CNT=1 %AND NEXTT_CNT=1 %AND CURRT_FLAGS& %C
            NEXTT_FLAGS&CONSTANTOP#0 %AND CURRT_PUSE=NEXT %C
            %THEN PTR=NEXT %AND %CONTINUE
         PTR=NEXT %AND %CONTINUE %UNLESS (CURRT_FLAGS!NEXTT_FLAGS)&DONT OPT=0
         J=CURRT_OPERN
         K=NEXTT_OPERN
         %UNLESS FOLD NOOP INFO(J)>>4#0 %AND FOLD NOOP INFO(K)>>4 #0 %C
            %THEN PTR=NEXT %AND %CONTINUE
         %IF CURRT_OPND1_FLAG<=1 %THEN OP1=1 %AND OPND1==CURRT_OPND1 %C
                 %ELSE OP1=2 %AND OPND1==CURRT_OPND2
         %IF NEXTT_OPND1_FLAG<=1 %THEN OP2=1 %AND OPND2==NEXTT_OPND1 %C
            %ELSE OP2=2 %AND OPND2==NEXTT_OPND2
         CTOPOP=0
         %IF J=K %AND FOLD NOOP INFO(J)&X'80'#0 %THEN CTOPOP=J
         %IF J=K=21 %AND OP2=2 %START
            %IF OP1=2 %THEN CTOPOP=20 %ELSE CTOPOP=21
         %FINISH
         %IF J=20 %AND K=21 %AND OP2=2 %THEN CTOPOP=21
         %IF J=21 %AND K=20 %THEN %START
            %IF OP1=1 %THEN CTOPOP=20 %ELSE CTOPOP=21
         %FINISH
         %IF CTOPOP#0 %START
            CTOP(CTOPOP,K,0,OPND1,OPND2)
            %IF CTOPOP=0 %THEN %START
               %IF OP2=2 %THEN OPND2==NEXTT_OPND1 %ELSE OPND2==NEXTT_OPND2
               NOOP(NEXT,OPND2)
               %CONTINUE
            %FINISH
         %FINISH
         PTR=NEXT
      %REPEAT
!
! PASS TOCHECK FOR COMMON SUBEXPRESSIONS. DONE IN SUCH A WAY THAT
! SEQUENCES ARE DETECTED AND COMBINED
!
      PTR=TRIPLES(0)_FLINK
      %WHILE PTR>0 %CYCLE
         CURRT==TRIPLES(PTR)
         %IF CURRT_FLAGS&DONT OPT=0 %THEN CHECK DUPS(PTR,CURRT_FLINK)
         PTR=CURRT_FLINK
      %REPEAT
!
! NESTED ACCUMULATOR PASS. AVOID EXCHANGES BY ARRANGING EARLY LOADS
! OF OPERANDS FOR NON COMMUTABLE OPERATIONS
!
      PTR=TRIPLES(0)_FLINK
      %WHILE PTR>0 %CYCLE
         CURRT==TRIPLES(PTR)
         %IF CURRT_OPERN>=20 %AND %C
            CURRT_FLAGS&(LOADOP1!LOADOP2!COMMUTABLE)=LOADOP1 %START
            J=PRELOAD PLACE(CURRT_OPND2_D)
            %IF J>=0 %START;            ! PALCE ACCESSIBLE
               I=J; K=0
               %WHILE I#PTR %CYCLE;     ! CHECK FOR DEPTH OF NESTING
                  NEXTT==TRIPLES(I)
                  %IF K<NEXTT_DPTH %THEN K=NEXTT_DPTH
                  I=NEXTT_FLINK                                                 
               %REPEAT
               %IF K+WORDS(CURRT_OPTYPE>>4)>=12 %THEN %C
                  PTR=CURRT_FLINK %AND %CONTINUE
               NEXTT==TRIPLES(J)
               NEWT==TRIPLES(NEXT TRIP)
               NEWT=0
               NEWT_OPERN=19;           ! PRELOAD
               NEWT_CNT=1
               NEWT_OPTYPE=CURRT_OPTYPE
               NEWT_FLAGS=LOADOP1!LEAVE STACKED
               NEWT_PUSE=PTR
               NEWT_OPND1=CURRT_OPND1
               CURRT_FLAGS=CURRT_FLAGS&(\LOAD OP1);! OP1 DOES NOT NEED LOAD
               CURRT_OPND1_FLAG=8
               CURRT_OPND1_D=NEXT TRIP
               CURRT_OPND1_XTRA=0
                                        ! LINK IN NEW TRIPLE
               NEWT_FLINK=J
               NEWT_BLINK=NEXTT_BLINK
               NEXTT_BLINK=NEXT TRIP
               TRIPLES(NEWT_BLINK)_FLINK=NEXT TRIP
               NEXT TRIP=NEXT TRIP+1
!
! CORRECT DEPTH OF NESTING FIELD
!
               NEWT_DPTH=NEXTT_DPTH
               %WHILE J#PTR %CYCLE
                  NEXTT_DPTH=NEXTT_DPTH+WORDS(NEWT_OPTYPE>>4)
                  J=NEXTT_FLINK
                  NEXTT==TRIPLES(J)
               %REPEAT
!               CHANGES=CHANGES+1
            %FINISH
         %FINISH
         PTR=CURRT_FLINK
      %REPEAT
!
! PASS TO TRY TO KEEP DUPLICTE TRIPLES IN ESTACK. THE SAVING
! HERE IS SO LARGE THAT IT IS WORTH THE EFFORT TO FIND THESE
! RATHER RARE CASES. OFTEN THE FORM IS A(I)=A(I)+B.
!
      %IF DUPS>0 %START;                ! THERE IS AT LEST ONE
         PTR=TRIPLES(0)_FLINK
         %WHILE PTR>0 %CYCLE
            CURRT==TRIPLES(PTR)
            NEXT=CURRT_FLINK
            %IF CURRT_CNT=2 %START;     ! ONLY DUPILCATES POSSIBLE
               NEXTT==TRIPLES(NEXT)
               %IF CURRT_PUSE#NEXT %AND ((NEXTT_OPND1_FLAG=8 %AND %C
                  NEXTT_OPND1_D=PTR) %OR (NEXTT_OPND2_FLAG=8 %AND %C
                  NEXTT_FLAGS&(COMMUTABLE!LOADOP1)=COMMUTABLE!LOADOP1 %C
                  %AND NEXTT_OPND2_D=PTR)) %START
                  CURRT_FLAGS=CURRT_FLAGS! USE ESTACK
                  CHANGES=CHANGES+1
                  PTR=NEXT
                  %CONTINUE
               %FINISH
               %IF CURRT_PUSE=NEXT %AND %C
                  NEXTT_OPND1_FLAG=8=NEXTT_OPND2_FLAG %AND %C
                  NEXTT_OPND1_D=PTR=NEXTT_OPND2_D %THEN %START
                  CURRT_FLAGS=CURRT_FLAGS!USE ESTACK
                  CHANGES=CHANGES+1
                  PTR=NEXT; %CONTINUE
               %FINISH
               %IF CURRT_PUSE=NEXT %AND NEXTT_FLINK=NEXTT_PUSE#0 %C
                  %AND(NEXTT_FLAGS&COMMUTABLE#0 %OR (NEXTT_OPND1_FLAG=8 %C
                  %AND NEXTT_OPND1_D=PTR)) %START
                  NEWT==TRIPLES(NEXTT_FLINK)
                  %IF (NEWT_OPND2_FLAG=8 %AND NEWT_OPND2_D=PTR) %OR %C
                     (NEWT_FLAGS&COMMUTABLE#0 %AND NEWT_OPND1_FLAG=8 %C
                     %AND NEWT_OPND1_D=PTR) %START
                     CURRT_FLAGS=CURRT_FLAGS! USE ESTACK
                     CHANGES=CHANGES+1
                     PTR=NEXT
                     %CONTINUE
                  %FINISH
               %FINISH
               I=2; J=NEXT;             ! TRY TO USE MSTACK
               %CYCLE
                  NEWT==TRIPLES(J)
                  %EXIT %IF NEWT_CNT#1 %OR NEWT_FLAGS&USE MSTACK#0
                  %IF (NEWT_OPND1_FLAG=8 %AND NEWT_OPND1_D=PTR) %OR %C
                     (NEWT_OPND2_FLAG=8 %AND NEWT_OPND2_D=PTR %AND %C
                     NEWT_OPERN>=20) %START
                     I=I-1
                     %IF I=0 %THEN CURRT_FLAGS=CURRT_FLAGS!USE MSTACK %C
                        %AND %EXIT
                  %FINISH
                  J=NEWT_FLINK
                  %EXIT %IF J=0
               %REPEAT
            %FINISH
         PTR=NEXT
         %REPEAT
      %FINISH
      %IF CHANGES>0 %AND PARM_DCOMP#0 %THEN PRINT TRIPS(TRIPLES)
      %RETURN
%INTEGERFN PRELOAD PLACE(%INTEGER TRIP)
!***********************************************************************
!*    LOOK FOR FIRST TRIPLE IN THE CHAIN THAT LEADS TO TRIP            *
!*    CAN BE VERY COMPILCATED. RETURN -1 IF NOT SIMPLE                 *
!***********************************************************************
%RECORD(RD)%NAME OPND1,OPND2
%RECORD(TRIPF)%NAME CURRT
      CURRT==TRIPLES(TRIP)
      OPND1==CURRT_OPND1
      OPND2==CURRT_OPND2
      %IF CURRT_OPERN<20 %OR CURRT_FLAGS&LOAD OP2#0 %START;! BACK VIA OPND1
         %IF CURRT_FLAGS&LOAD OP1#0 %THEN %RESULT=TRIP
         %RESULT=PRELOAD PLACE(OPND1_D)
      %FINISH
      %IF CURRT_FLAGS&LOAD OP1#0 %OR OPND1_D=CURRT_BLINK %THEN %C
         %RESULT=PRELOAD PLACE(OPND2_D)
!
! BOTH OPERANDS ARE LOADED TRIPLES
!
      %IF CURRT_BLINK=OPND2_D %THEN %RESULT=PRELOADPLACE(OPND1_D)
      %RESULT=-1;                       ! TOO COMPLICATED
%END
%ROUTINE NOOP(%INTEGER TRIPLE NO,%RECORD(RD)%NAME ROPND)
!***********************************************************************
!*    THIS TRIPLE HAS BECOME A NOOP.DELETE IT AND PASS ITS ENTRY TRIPLE*
!*    FORWARD TO ANT WHO USE IT                                        *
!***********************************************************************
%RECORD(TRIPF)%NAME CURRT,NOOPT
%RECORD(RD)%NAME OPND1,OPND2
%INTEGER PTR,CNT
      NOOPT==TRIPLES(TRIPLE NO);         ! THIS ONE TO BECOME NOOP
      CNT=NOOPT_CNT;                    ! HOW MANY TIMES USED
      ABORT %UNLESS CNT=1;              ! NO OPS ELIMINATED BEFORE DUPS
      NOOPT_OPERN=18;                   ! SET AS NOOP
      PTR=NOOPT_BLINK
      %WHILE PTR>0 %CYCLE
         CURRT==TRIPLES(PTR)
         %IF CURRT_PUSE=TRIPLE NO %THEN CURRT_PUSE=NOOPT_PUSE
         PTR=CURRT_BLINK
      %REPEAT
      PTR=NOOPT_FLINK
      %CYCLE
         CURRT==TRIPLES(PTR)
         OPND1==CURRT_OPND1
         OPND2==CURRT_OPND2
         %IF OPND1_FLAG=8 %AND OPND1_D=TRIPLE NO %THEN %START
            OPND1=ROPND
            CNT=CNT-1
            %IF OPND1_FLAG#8 %THEN CURRT_FLAGS=CURRT_FLAGS!LOAD OP1
         %FINISH
         %IF CURRT_OPERN>=20 %AND OPND2_FLAG=8 %AND OPND2_D=TRIPLE NO %START
            OPND2=ROPND
            CNT=CNT-1
            %IF OPND2_FLAG#8 %THEN CURRT_FLAGS=CURRT_FLAGS!LOAD OP2
         %FINISH
         PTR=CURRT_FLINK
         %IF CNT=0 %OR PTR=0 %THEN %EXIT
         %IF NOOPT_OPND1_FLAG#8 %THEN %C
            CURRT_DPTH<-CURRT_DPTH-WORDS(NOOPT_OPTYPE>>4)
      %REPEAT
      CHANGES=CHANGES+1
      %UNLESS NOOPT_FLINK=0=NOOPT_BLINK %START
         TRIPLES(NOOPT_BLINK)_FLINK=NOOPT_FLINK
         TRIPLES(NOOPT_FLINK)_BLINK=NOOPT_BLINK
      %FINISH
%END
%ROUTINE DEC USE(%INTEGER TRIPLE NO)
!***********************************************************************
!*    A TRIPLE HAS BEEN PASSED INTO 'DEAD' CODE. DECREMENT ITS USE     *
!*    AND IF RELEVANT DELETE OPERATIONS LEADING TO IT                  *
!***********************************************************************
%RECORD(TRIPF)%NAME CURRT
      CURRT==TRIPLES(TRIPLE NO)
      CURRT_CNT=CURRT_CNT-1
      %IF CURRT_CNT=1 %THEN DUPS=DUPS-1
      %IF CURRT_CNT=0 %THEN DELETE TRIPLE(TRIPLE NO)
%END
%ROUTINE DELETE TRIPLE(%INTEGER TRIPLE NO)
%RECORD(TRIPF)%NAME DELT
      DELT==TRIPLES(TRIPLE NO)
      %IF DELT_OPND1_FLAG=8 %THEN DEC USE(DELT_OPND1_D)
      %IF DELT_OPERN>=20 %AND DELT_OPND2_FLAG=8 %THEN %C
         DEC USE(DELT_OPND2_D)
      DELT_OPERN=18;                    ! NO OP
      %UNLESS DELT_FLINK=0=DELT_BLINK %START;! UNLESS ONLY TRIPLE
         TRIPLES(DELT_BLINK)_FLINK=DELT_FLINK
         TRIPLES(DELT_FLINK)_BLINK=DELT_BLINK
         DELT_BLINK=0
         DELT_FLINK=0
      %FINISH
%END
%ROUTINE DUPLICATE TRIP(%INTEGER TRIPNO,DTRIPNO)
!***********************************************************************
!*    DTRIPNO IS A DUPLICATE OF TRIPNO. CHANGE ALL REFERENCES          *
!*    AND DELETE IT                                                    *
!***********************************************************************
%RECORD(RD)%NAME OPND1,OPND2
%RECORD(TRIPF)%NAME MASTER,CURRT,DUPT
%INTEGER CNT,PTR
      DUPS=DUPS+1
      DUPTNO=TRIPNO
      MASTER==TRIPLES(TRIPNO)
      DUPT==TRIPLES(DTRIPNO)
      CNT=DUPT_CNT
      PTR=DUPT_FLINK
!
      %WHILE CNT>0 %AND PTR>0 %CYCLE
         CURRT==TRIPLES(PTR)
         OPND1==CURRT_OPND1
         OPND2==CURRT_OPND2
         %IF OPND1_FLAG=8 %AND OPND1_D=DTRIPNO %START
            MASTER_CNT=MASTER_CNT+1
            OPND1_D=TRIPNO
            CURRT_FLAGS=CURRT_FLAGS!LOAD OP1
            CNT=CNT-1
         %FINISH
         %IF CURRT_OPERN>=20 %AND %C
            OPND2_FLAG=8 %AND OPND2_D=DTRIPNO %START
            MASTER_CNT=MASTER_CNT+1
            OPND2_D=TRIPNO
            CURRT_FLAGS=CURRT_FLAGS!LOAD OP2
            CNT=CNT-1
         %FINISH
         PTR=CURRT_FLINK
      %REPEAT
      DELETE TRIPLE(DTRIPNO)
%END
%ROUTINE CHECK DUPS(%INTEGER TRIPNO,STRIPNO)
!***********************************************************************
!*    CHECK STARTING FROM STRIPNO FOR DUPLICATES OF TRIPNO             *
!*    MAY BE MORE THAN ONE                                             *
!***********************************************************************
%RECORD(TRIPF)%NAME CURRT,DUPT
%INTEGER OPERN,F,NEXT
      DUPT==TRIPLES(TRIPNO)
      OPERN=DUPT_OPERN
      F=DUPT_FLAGS
      %WHILE STRIPNO>0 %CYCLE
         CURRT==TRIPLES(STRIPNO)
         NEXT=CURRT_FLINK
         %IF CURRT_OPERN=OPERN %AND ((%C
            OPERN<20 %AND SAME OPND(DUPT_OPND1,CURRT_OPND1)=YES ) %C
            %OR(OPERN>=20 %AND SAME OPND(DUPT_OPND1,CURRT_OPND1)=YES %C
            %AND SAME OPND(DUPT_OPND2,CURRT_OPND2)=YES ) %OR %C
            (F&COMMUTABLE#0 %AND SAME OPND(DUPT_OPND1,CURRT_OPND2)=YES %AND %C
            SAME OPND(DUPT_OPND2,CURRT_OPND1)=YES)) %START
            DUPLICATE TRIP(TRIPNO,STRIPNO)
            CHANGES=CHANGES+1
         %FINISH
         STRIPNO=NEXT
      %REPEAT
%END
%INTEGERFN SAME OPND(%RECORD(RD)%NAME OPND1,OPND2)
!***********************************************************************
!*    ARE THESE OPERANDS THE SAME ?                                    *
!***********************************************************************
%INTEGER F
      %RESULT=NO %UNLESS OPND1_S1=OPND2_S1
      F=OPND1_FLAG
      %IF F=2 %OR F=5 %START
         %RESULT=NO %UNLESS OPND1_XTRA=OPND2_XTRA %AND OPND1_UPTYPE&X'30'=0
         %RESULT=YES
      %FINISH
      %IF F<=1 %START;                  ! CONSTANTS
         %RESULT=YES %IF OPND1_D=OPND2_D %AND %C
            (OPND1_XTRA=OPND2_XTRA %OR OPND1_PTYPE&X'F0'<=X'50')
         %RESULT=NO
      %FINISH
      %RESULT=YES %IF OPND1_D=OPND2_D %AND F#9
      %RESULT=NO
%END
%END
%ENDOFFILE