! 24/09/84 - check for PROCID line 780 of OPTNEG
! 09/08/84 - correction to OPTDIV, line 672 moved to line 681
! copied from pnxrel01_conelimp41
! 13/06/84 - delete use of RSUB as op to CONOP
! 12/03/84 only generate MOO triad if target is 2900
! 22/11/83 set up TRACE flag and CDUMPTRACE routine
! 27/10/83 copied from ERCS06.REL90_CONELIMB12
!*
%INCLUDE "host_host"
!*
%INCLUDE "targ_target"
!*
%INCLUDE "pf_version"
!*
%INCLUDE "bits_fmts"
!*
%INCLUDE "bits_optspecs"
!*
%INCLUDE "bits_optfmts"
!
%INCLUDE "bits_consts"
!*
%INCLUDE "bits_triadops"
!*

%OWNINTEGER TRACE=0
!
%EXTERNALROUTINESPEC PRINT TR(%INTEGER INDEX,ADICT,ANAMES,
          LEVEL,%RECORD(TRIADF)%NAME TRIAD)
%EXTERNALINTEGERFNSPEC CONRES(%INTEGER CONST,MODE)
%EXTERNALINTEGERFNSPEC CONCHECK(%RECORD(RESF) RES)
%EXTERNALINTEGERFNSPEC CONVERTMODE(%RECORD(RESF)%NAME RES,%INTEGER MODE)
%EXTERNALINTEGERFNSPEC CONINVERT(%RECORD(RESF) RES1,
                                 %RECORD(RESF)%NAME RES)

%OWNRECORD(RESF) RNULL
%CONSTBYTEINTEGERARRAY MODETYPE(0:15)=
                                1,1,1,2,2,2,3,3,
                                3,4,5,5,0,4,4,0

%EXTERNALROUTINE CDUMPTRACE
 TRACE=OPTFLAGS&CDUMP
%END
!
%EXTERNALROUTINE OPTDIV
! OPTIMISE THE DIV TRIAD
%RECORD(TRIADF)%NAME CTR,OPD1TR,TMPTR,NEWTR
%RECORD(RESF) RES
%INTEGER NEWIND,OK,DELIND
%INTEGER CMODE,CVAL

CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("OPTIMISING DIV TRIAD, INDEX")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_QOPD2&CONSTMASK#0 %START
  %IF CTR_QOPD1&CONSTMASK#0 %START
    ! BOTH OPERANDS ARE CONSTANT
    OK=CONOP(CTR_RES1,DIV,CTR_RES2,RES)
    %IF OK#0 %THEN %RETURN
    CTR_RES1=RES
    CTR_OP=(CTR_OP&BMBIT)!REPL
    %IF TRACE#0 %START
      PRINTSTRING("BOTH OPERANDS ARE CONSTANT - TRIAD OPTIMISED TO:")
      NEWLINE
      ->PROUT
    %FINISH
    %RETURN
  %FINISH
  ! OPD2 IS A CONSTANT, OPD1 IS NOT
  CVAL=CONCHECK(CTR_RES2)
  %IF CVAL=1 %START
    ! DIVISION BY 1
    CTR_RES2=0
    CTR_OP=(CTR_OP&BMBIT)!REPL
    %IF TRACE#0 %START
      PRINTSTRING("OPD2 IS A CONSTANT, OPD1 IS NOT");NEWLINE
      PRINTSTRING("DIVISION BY 1 - TRIAD OPTIMISED TO:");NEWLINE
      ->PROUT
    %FINISH
    %RETURN
  %FINISH
  %IF CTR_QOPD1&TEXTMASK#0 %START
    ! OPD1 IS A TRIAD, OPD2 IS NOT
    ! (-A)/2 BECOMES A/-2
    OPD1TR==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
    %IF OPD1TR_OP&BMBITOFF=NEG %START
      %IF OPD1TR_QOPD1&TEXTMASK#0 %START
        TMPTR==RECORD(ATRIADS+OPD1TR_OPD1*TRIADLENGTH)
        TMPTR_USE=TMPTR_USE+1
      %FINISH
      OK=CONOP(RNULL,NEG,CTR_RES2,RES)
      %IF OK#0 %THEN %RETURN
      %IF TRACE#0 %START
        PRINTSTRING("OPD1 IS A TRIAD WITH NEG OP");NEWLINE
        PRINTSTRING("DELETEING TRIAD WITH INDEX")
        WRITE(CTR_OPD1,1);NEWLINE
      %FINISH
      DELUSE(CTR_OPD1)
      CTR_RES1_W=OPD1TR_RES1_W
      CTR_RES2=RES
      %IF TRACE#0 %START
        PRINTSTRING("TRIAD OPTIMISED TO:");NEWLINE
        ->PROUT
      %FINISH
    %FINISH
  %FINISH
  %IF MODETYPE(CTR_MODE2)=REALTYPE %START
    ! DIVISION BY REAL CONSTANT BECOMES MULTIPLICATION BY
    ! RECIPROCAL CONSTANT
    OK=CONINVERT(CTR_RES2,RES)
    %IF OK#0 %THEN %RETURN
    CTR_RES2=RES
    CTR_OP=(CTR_OP&BMBIT)!MULT
    %IF TRACE#0 %START
      PRINTSTRING("DIVISION BY REAL CONST.")
      PRINTSTRING(" BECOMES MULTIPLICATION BY RECIPROCAL CONST")
      NEWLINE
      PRINTSTRING("TRIAD OPTIMISED TO:");NEWLINE
      ->PROUT
    %FINISH
  %FINISH
  OUT1:
  %IF TRACE#0 %START
    PRINTSTRING("END OF DEALING WITH CONSTANTS - EXIT FROM OPTDIV")
    NEWLINE
  %FINISH
  %RETURN
PROUT:
%IF TRACE#0 %START
  PRINT TR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  ->OUT1
%FINISH
%FINISH; ! END OF DEALING WITH CONSTANTS

! HERE IF CTR_QOPD2 IS NOT A CONSTANT
! A/B/C BECOMES A/(B*C) IN REAL MODE ONLY
%IF MODETYPE(CTR_MODE)# REALTYPE %OR MODETYPE(CTR_MODE2)#REALTYPE %C
    %THEN %RETURN
%IF CTR_QOPD1&TEXTMASK=0 %THEN %RETURN
! OPD1 IS A TRIAD
%IF TRACE#0 %START
  PRINTSTRING("OPD2 IS NOT A CONSTANT, OPD1 IS ATRIAD & MODE IS REAL")
  NEWLINE
%FINISH
OPD1TR==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
%IF OPD1TR_OP&BMBIT#0 %THEN %RETURN; ! A LOOP CONSTANT
%IF OPD1TR_OP#DIV %THEN %RETURN
%IF OPD1TR_USE#1 %THEN %RETURN

%IF TRACE#0 %START
  PRINTSTRING("GET A NEW TRIAD");NEWLINE
%FINISH
NEWIND=GETTRIAD; ! GET A NEW TRIAD
NEWTR==RECORD(ATRIADS+NEWIND*TRIADLENGTH)
NEWTR_OP=MULT
NEWTR_USE=1
NEWTR_CHAIN=CURRTRIAD
NEWTR_MODE=CTR_MODE
NEWTR_RES2_W=CTR_RES2_W
CTR_QOPD2=TRIAD
CTR_OPD2=NEWIND
NEWTR_RES1_W=OPD1TR_RES2_W
DELIND=CTR_OPD1
CTR_RES1_W=OPD1TR_RES1_W
TREVERSE(NEWIND); ! ENSURE CORRECT ORDER OF B*C OPERANDS
CURRTRIAD=NEWIND; ! RESET CURRTRIAD SO THAT NEWTRIAD CAN BE FURTHER OPTIMISED
%IF TRACE#0 %START
  PRINTSTRING("DELETEING TRIAD WITH INDEX")
  WRITE(DELIND,1);NEWLINE
%FINISH
DELUSEX(DELIND); ! DELETE A/B
TMPTR==RECORD(ATRIADS+PREVTRIAD*TRIADLENGTH)
TMPTR_CHAIN=NEWIND
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD NOW HAS INDEX")
  WRITE(NEWIND,1); NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,NEWTR)
  PRINTSTRING("CURRTRIAD CHAINED TO TRIAD WITH INDEX")
  WRITE(NEWTR_CHAIN,1);NEWLINE
  PRINTTR(NEWTR_CHAIN,ADICT,ANAMES,0,CTR)
  PRINTSTRING("EXIT FROM OPTDIV")
%FINISH
%END; ! OPTDIV


%EXTERNALROUTINE OPTNEG
!OPTIMISE THE NEG TRIAD
%RECORD(TRIADF)%NAME CTR,OPD1TR
%RECORD(RESF) RES
%INTEGER OK
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("OPTIMISING NEG TRIAD, INDEX")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_QOPD1&IDMASK#0 %OR CTR_QOPD1=PROCID %THEN %RETURN
%IF MODETYPE(CTR_MODE)=CMPLXTYPE %THEN %RETURN
%IF CTR_QOPD1&CONSTMASK#0 %START
  ! OPD1 IS ACONSTANT - NEGATE IT
  OK=CONOP(RNULL,NEG,CTR_RES1,RES)
  %IF OK#0 %THEN %RETURN
  CTR_RES1=RES
  %IF TRACE#0 %START
    PRINTSTRING("OPD1 IS A CONSTANT - NEGATE IT")
    NEWLINE
  %FINISH
  ->SETREPL
%FINISH
! QOPD1 IS A TRIAD
%IF TRACE#0 %START
  PRINTSTRING("OPD1 IS A TRIAD, INDEX")
  WRITE(CTR_OPD1,1);NEWLINE
%FINISH
OPD1TR==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
%IF OPD1TR_USE#1 %THEN %RETURN
%IF OPD1TR_OP&BMBITOFF=SUB %START
  !NEG(A SUB B) BECOMES B SUB A
  RES=OPD1TR_RES1
  OPD1TR_RES1=OPD1TR_RES2
  OPD1TR_RES2=RES
  %IF TRACE#0 %START
    PRINTSTRING("NEG(A SUB B) BECOMES B SUB A")
    NEWLINE
    PRINTSTRING("OPD1 TRIAD BECOMES");NEWLINE
    PRINTTR(CTR_OPD1,ADICT,ANAMES,0,OPD1TR)
  %FINISH
  ->SETREPL
%FINISH
%IF OPD1TR_OP&BMBITOFF=ADD %START
  %IF OPD1TR_QOPD2&CONSTMASK=0 %THEN %RETURN
  ! NEG(ANY+CT) BECOMES -CT-ANY
  OK=CONOP(RNULL,NEG,OPD1TR_RES2,RES)
  %IF OK#0 %THEN %RETURN
  OPD1TR_RES2=OPD1TR_RES1
  OPD1TR_RES1=RES
  OPD1TR_OP=(OPD1TR_OP&BMBIT)!SUB
  %IF TRACE#0 %START
    PRINTSTRING("NEG(ANY+CONST) BECOMES (-CONST)-ANY")
    NEWLINE
    PRINTSTRING("OPD1 TRIAD BECOMES");NEWLINE
    PRINTTR(CTR_OPD1,ADICT,ANAMES,0,OPD1TR)
  %FINISH
  ->SETREPL
%FINISH
%IF OPD1TR_OP&BMBITOFF=MULT %OR OPD1TR_OP&BMBITOFF=DIV %START
  %IF OPD1TR_QOPD1&CONSTMASK#0 %START
    ! NEG(CT /* ANY) BECOMES -CT /* ANY
    OK=CONOP(RNULL,NEG,OPD1TR_RES1,RES)
    %IF OK#0 %THEN %RETURN
    OPD1TR_RES1=RES
    %IF TRACE#0 %START
      PRINTSTRING("NEG(CONST/*ANY) BECOMES (-CONST)/*ANY")
      NEWLINE
      PRINTSTRING("OPD1 TRIAD BECOMES");NEWLINE
      PRINTTR(CTR_OPD1,ADICT,ANAMES,0,OPD1TR)
    %FINISH
    ->SETREPL
  %FINISH
  %IF OPD1TR_QOPD2&CONSTMASK=0 %THEN %RETURN
  ! OPD2 IS A CONSTANT
  OK=CONOP(RNULL,NEG,OPD1TR_RES2,RES)
  %IF OK#0 %THEN %RETURN
  OPD1TR_RES2=RES
  %IF TRACE#0 %START
    PRINTSTRING("OPD2 IS ACONSTANT");NEWLINE
    PRINTSTRING("OPD1 TRIAD BECOMES");NEWLINE
    PRINTTR(CTR_OPD1,ADICT,ANAMES,0,OPD1TR)
  %FINISH
%FINISH %ELSE %RETURN
SETREPL:
CTR_OP=(CTR_OP&BMBIT)!REPL
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH

! ADD FURTHER CHECKS
! E.G. NEG(CVT(A*10)) BECOMES CVT(A * -10)

%END; ! OPTNEG
!
%EXTERNALROUTINE CONELIM
! CONSTANT EXPRESSION ELIMINATION
! ADD, SUB & MULT TRIADS

%CONSTINTEGER TABADD=0,TABSUB=1,TABMULT=2,TABCSUB=3
%RECORD(TRIADF)%NAME CTR,TROPD1,TROPD2,TRFST,TRSCND
%RECORD(RESF) RES1,RES2,RES
%INTEGER OK,CVAL,OP1,OP2,DELIND,TAB1IND,TAB2IND,TAB3IND
%INTEGER FSTIND,SCNDIND,CURROP
%SWITCH ACT(0:235)
!
%CONSTBYTEINTEGERARRAY CETAB1(0:95)=1,7,14,20,
                                    0,0,14,26,
                                    1,33,0,0,
                                    0(4),
                                    0,0,39,46,
                                    52,59,0(2),
                                    14,64,1,33,
                                    0,0,1,7,
                                    14,20,0,0,
                                    0(4),
                                    0,0,71,78,
                                    84,91,0,0,
                                    0(12),
                                    226,226,229,229,
                                    96,101,0,0,
                                    0(4),
                                    107,112,120,125,
                                    0,0,120,133,
                                    107,140,0,0,
                                    0(4),
                                    0,0,147,153,
                                    160,166,0,0
!
%CONSTBYTEINTEGERARRAY CETAB2(0:231)=0,1,2,3,4,5,6,
                                     1,2,3,4,7,5,6,
                                     8,2,3,4,5,6,
                                     9,2,3,4,10,6,
                                     9,2,3,4,7,5,6,
                                     1,2,3,4,10,6,
                                     1,2,3,4,11,12,6,
                                     1,3,13,7,5,6,
                                     8,2,3,4,11,14,6,
                                     9,3,13,10,6,
                                     9,2,3,4,7,5,6,
                                     8,2,3,4,11,12,6,
                                     9,3,13,7,5,6,
                                     1,2,3,4,11,14,6,
                                     1,3,13,10,6,
                                     15,3,4,5,6,
                                     15,3,4,7,5,6,
                                     1,3,13,5,6,
                                     1,2,3,4,12,7,11,6,
                                     8,3,13,5,6,
                                     8,3,16,13,17,7,11,6,
                                     9,3,4,12,7,11,6,
                                     1,3,16,13,7,11,6,
                                     1,3,13,12,11,6,
                                     1,3,13,12,7,11,6,
                                     8,3,13,14,11,6,
                                     9,3,22,4,7,11,6,
                                     1,2,3,4,18,
                                     8,2,3,4,18,
                                     15,2,3,19,20,
                                     9,3,16,13,17,7,18,
                                    1,3,16,13,7,18,
                                    15,3,4,18,
                                    1,3,13,18,
                                    8,3,13,18,
                                    15,3,22,19,21,
                                    9,22,23,2,3,4,7,18,
                                    1,3,24,
                                    8,3,24
!
%CONSTBYTEINTEGERARRAY CETAB3(0:15)=173,178,183,188,
                                     178,173,183,195,
                                    0,0,201,0,
                                    205,209,213,218
!
%INTEGERFUNCTION CCHECK(%INTEGER TRIND,%RECORD(RESF)%NAME RES)
! CHECKS THE SUITABILITY OF A TRIAD FOR CONST. ELIM.
! RESULT IS O,1,2 OR 3 IF OP IS +,-C,* OR C- RESPECTIVELY, ELSE -1
! RES WILL HOLD CONST. POINTER OR 0
!
%RECORD(TRIADF)%NAME TR
TR==RECORD(ATRIADS+TRIND*TRIADLENGTH)
RES=RNULL
%IF TR_USE# 1 %THEN %RESULT=-1
%IF TR_OP&BMBITOFF=SUB %START
  %IF TR_QOPD1&CONSTMASK#0 %THEN RES=TR_RES1 %AND %RESULT=TABCSUB
%FINISH
%IF TR_QOPD2&CONSTMASK#0 %THEN RES=TR_RES2
%IF TR_OP&BMBITOFF=ADD %THEN %RESULT=TABADD
%IF TR_OP&BMBITOFF=MULT %THEN %RESULT=TABMULT
%IF TR_OP&BMBIT=SUB %THEN %RESULT=TABSUB
RES=RNULL
%RESULT=-1
%END; ! CCHECK
!
CE0:
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("CONSTANT EXPRESSION ELIMINATION");NEWLINE
  PRINTSTRING("FOR ADD, SUB OR MULT TRIAD, INDEX")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_OP&BMBITOFF=ADD %START
  ! ELIMINATE OPERANDS WHICH ARE NEG TRIADS
  %IF TRACE#0 %START
    PRINTSTRING("ELIMINATE OPERANDS WHICH ARE NEG TRIADS")
    NEWLINE
  %FINISH
  %IF CTR_QOPD1&TEXTMASK#0 %START
    TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
    %IF TRACE#0 %START
      PRINTSTRING("OPD1 IS A TRIAD -")
      NEWLINE
      PRINTTR(CTR_OPD1,ADICT,ANAMES,0,TROPD1)
    %FINISH
    DELIND=CTR_OPD1
    %IF TROPD1_OP&BMBITOFF=NEG %START
      ! (-ANY1) + ANY2 BECOMES ANY2-ANY1
      CTR_RES1=CTR_RES2
      CEN10:
      ! ANY2 + (-ANY1) BECOMES ANY2-ANY1
      CTR_OP=(CTR_OP&BMBIT)!SUB
      CEN20:
      CTR_RES2=TROPD1_RES1
      ! IF NEG HAS TEXT OPD, UPDATE USE COUNT
      %IF TROPD1_QOPD1&TEXTMASK#0 %START 
        TRSCND==RECORD(ATRIADS+TROPD1_OPD1*TRIADLENGTH)
        TRSCND_USE=TRSCND_USE+1
      %FINISH
      %IF TRACE#0 %START
        PRINTSTRING("(-ANY1) + ANY2 BECOMES ANY2-ANY1")
        NEWLINE
        PRINTSTRING("ANY2 + (-ANY1) BECOMES ANY2-ANY1")
        NEWLINE
        PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
        PRINTSTRING("DELETE TRIAD")
        WRITE(DELIND,1);NEWLINE
        PRINTSTRING("AND THEN START AGAIN")
        NEWLINE
      %FINISH
      ! DELETE USE OF THE NEG TRIAD
      DELUSE(DELIND)
      TREVERSE(CURRTRIAD)
      ->CE0; ! START AGAIN
    %FINISH; ! TROPD1_OP=NEG
    ! CEN30:
    %IF CTR_QOPD2&TEXTMASK#0 %START
      TROPD1==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
      %IF TRACE#0 %START
        PRINTSTRING("OPD2 IS A TRIAD -")
        NEWLINE
        PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD1)
      %FINISH
      DELIND=CTR_OPD2
      %IF TROPD1_OP&BMBITOFF=NEG %THEN ->CEN10
    %FINISH
  %FINISH; ! CTR_QOPD1 IS A TRIAD
  ! CEN50:
  CURROP=TABADD
! CE12:
%FINISH %ELSEIF CTR_OP&BMBITOFF=SUB %START
  ! ELIMINATE OPD2 IF A NEG TRIAD
  %IF TRACE#0 %START
    PRINTSTRING("ELIMINATE OPD2 IF A NEG TRIAD")
    NEWLINE
  %FINISH
  %IF CTR_QOPD2&TEXTMASK#0 %START
    TROPD1==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
   %IF TRACE#0 %START
      PRINTSTRING("OPD2 IS A TRIAD -")
      NEWLINE
      PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD1)
    %FINISH
    DELIND=CTR_OPD2
    %IF TROPD1_OP&BMBITOFF=NEG %THEN CTR_OP=(CTR_OP&BMBIT)!ADD %C
       %AND ->CEN20
  %FINISH
  CURROP=TABSUB
! CE14:
%FINISH %ELSE CURROP=TABMULT
!
! REJECT COMPLEX
%IF MODETYPE(CTR_MODE)=CMPLXTYPE %OR MODETYPE(CTR_MODE2)=CMPLXTYPE %C
    %THEN %RETURN
! CE1:
%IF CTR_QOPD1&CONSTMASK#0 %AND CTR_QOPD2&CONSTMASK#0 %START
  ! BOTH OPERANDS ARE CONSTANTS
  OK=CONOP(CTR_RES1,CTR_OP&BMBITOFF,CTR_RES2,RES)
  %IF OK#0 %THEN %RETURN
  CTR_OP=(CTR_OP&BMBIT)!REPL
  CTR_RES1=RES
  %IF TRACE#0 %START
    PRINTSTRING("BOTH OPERANDS ARE CONSTANTS")
    NEWLINE
    PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
    PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
    PRINTSTRING("EXIT FROM CONELIM");NEWLINE
  %FINISH
  %RETURN
%FINISH
!
! CE20:
%IF CTR_QOPD1&CONSTMASK#0 %THEN %START
  ! ONLY OPD1 IS CONST. OP MUST BE SUB
  CE11F:
  %UNLESS CTR_OP&X'7F'=SUB %THEN %RETURN;! GEM 30/09/83 to clear bug D15
  %IF TRACE#0 %START
    PRINTSTRING("ONLY OPD1 IS A CONSTANT - CONST-ID OR CONST-TRIAD")
    NEWLINE
  %FINISH
  ! CONST-ID OR CONST-TRIAD
  CVAL=CONCHECK(CTR_RES1)
  %IF CVAL=0 %START
    CTR_OP=(CTR_OP&BMBIT)!NEG
    CTR_RES1=CTR_RES2
    CTR_RES2=RNULL
    %IF TRACE#0 %START
      PRINTSTRING("CONSTANT IS ZERO - CURRTRIAD BECOMES")
      NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      PRINTSTRING("EXIT FROM CONELIM");NEWLINE
    %FINISH
    %RETURN
  %FINISH
  ! CE80:
  %IF CTR_QOPD2&TEXTMASK=0 %THEN %RETURN; ! QOPD2 IS ID
  ! QOPD2 IS A TRIAD
  FSTIND=CTR_OPD2
  TRFST==RECORD(ATRIADS+FSTIND*TRIADLENGTH)
  %IF TRACE#0 %START
    PRINTSTRING("OPD2 IS A TRIAD -")
    NEWLINE
    PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TRFST)
  %FINISH
  RES2=CTR_RES1
  CURROP=TABCSUB
  ->CE85
%FINISH
!
! CE25:
%IF CTR_QOPD2&CONSTMASK#0 %START
  ! ONLY OPD2 IS CONSTANT
  %IF TRACE#0 %START
    PRINTSTRING("ONLY OPD2 IS CONSTANT - CHECK FOR VALUES -1,0,1,2")
    NEWLINE
  %FINISH
  ! CHECK FOR VALUE -1,0,1 OR 2
  CVAL=CONCHECK(CTR_RES2)
  %IF -2<CVAL<3 %START
    %IF CURROP#TABMULT %START
      ! ADD OR SUB TRIAD
      %IF CVAL=0 %THEN %START
        CTR_OP=(CTR_OP&BMBIT)!REPL
        %IF TRACE#0 %START
          PRINTSTRING("ADD OR SUB TRIAD - CONST IS 0")
          NEWLINE
          PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
          PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
          PRINTSTRING("EXIT FROM CONELIM");NEWLINE
        %FINISH
        %RETURN
      %FINISH
    %FINISH %ELSESTART
      ! MULT TRIAD
    %IF TRACE#0 %START
      PRINTSTRING("MULT TRIAD - ")
    %FINISH
      %IF CVAL=-1 %START
        CTR_OP=(CTR_OP&BMBIT)!NEG
        CTR_RES2=RNULL
        %IF TRACE#0 %START
          PRINTSTRING("CONST. -1");NEWLINE
          PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
          PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
          PRINTSTRING("EXIT FROM CONELIM");NEWLINE
        %FINISH
        %RETURN
      %FINISH
      %IF CVAL=2 %START
        ! MULTIPLY BY 2
        %IF MODETYPE(CTR_MODE)=INTTYPE %THEN ->CE37
        %IF CTR_QOPD1&TEXTMASK#0 %START
          TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
          TROPD1_USE=TROPD1_USE+1
        %FINISH
        CTR_RES2=CTR_RES1
        CTR_OP=(CTR_OP&BMBIT)!ADD
        %IF TRACE#0 %START
          PRINTSTRING("CONST. IS 2");NEWLINE
          PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
          PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
          PRINTSTRING("EXIT FROM CONELIM");NEWLINE
        %FINISH
        %RETURN
      %FINISH
      %IF CVAL=0 %START
        ! DECREMENT USE COUNT IF OPD1 IS A TRIAD
        %IF CTR_QOPD1&TEXTMASK#0 %THEN DELUSE(CTR_OPD1)
        CTR_RES1=CTR_RES2
      %FINISH
      ! CVAL=0 OR 1
      CTR_OP=(CTR_OP&BMBIT)!REPL
      %IF TRACE#0 %START
        PRINTSTRING("CONST. IS 0 OR 1");NEWLINE
        PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
        PRINTSTRING("EXIT FROM CONELIM");NEWLINE
      %FINISH
      %RETURN
    %FINISH; ! MULT TRIAD
  %FINISH; ! OPD2 IS A SPECIAL CONSTANT
  ! OPD2 IS A CONSTANT, BUT NOT A SPECIAL CASE
  ! CE35:
  %IF TRACE#0 %START
    PRINTSTRING("OPD2 IS A CONST., BUT NOT A SPECIAL CASE")
   NEWLINE
  %FINISH
  %IF CURROP=TABSUB %AND MODETYPE(CTR_MODE2)=REALTYPE %START
    ! SUB REAL CONST. BECOMES ADD REAL CONST.
    OK=CONOP(RNULL,NEG,CTR_RES2,RES)
    %IF OK#0 %THEN %RETURN
    CTR_RES2=RES
    CTR_OP=(CTR_OP&BMBIT)!ADD
    CURROP=TABADD
  %IF TRACE#0 %START
    PRINTSTRING("SUB REAL CONST. BECOMES ADD REAL CONST.")
    NEWLINE
    PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
    PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  %FINISH
  %FINISH
  CE37:
  %IF CTR_QOPD1&TEXTMASK=0 %THEN %RETURN
  CE3F:
  ! TRIAD OP CONST.
  %IF TRACE#0 %START
    PRINTSTRING("TRIAD OP CONST. - ")
    NEWLINE
  %FINISH
  ! FIRST ATTEMPT TO REMOVE NEG TRIAD IF OP=MULT
  ! (-A) * 10 BECOMES A * -10
  %IF CTR_OP&BMBITOFF=MULT %START
    TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
    %IF TROPD1_OP&BMBITOFF=NEG %AND TROPD1_USE=1 %START
      ! OPD1 IS A NEG TRIAD WITH USE=1
      %IF TRACE#0 %START
        PRINTSTRING("OPD1 IS A NEG TRIAD,USE=1")
        NEWLINE
        PRINTSTRING("(-A) * CONST. BECOMES A * -CONST.")
        NEWLINE
        PRINTSTRING("DECREMENT USE OF NEG TRIAD, INDEX")
        WRITE(CTR_OPD1,1);NEWLINE
      %FINISH
      DELUSEX(CTR_OPD1); ! DECREMENT USE OF NEG TRIAD
      CTR_RES1=TROPD1_RES1
      OK=CONOP(RNULL,NEG,CTR_RES2,RES); ! NEGATE THE CONST.
      %IF OK#0 %THEN %RETURN
      CTR_RES2=RES; ! PLANT THE NEW CONST.
      %IF TRACE#0 %START
        PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
        PRINTSTRING("START AGAIN");NEWLINE
      %FINISH
      ->CE0; ! START AGAIN
    %FINISH
  %FINISH; ! OP=MULT
  ! CE83:
  FSTIND=CTR_OPD1
  TRFST==RECORD(ATRIADS+FSTIND*TRIADLENGTH)
  RES2=CTR_RES2
!
  CE85:
  OP1=CCHECK(FSTIND,RES)
  %IF RES_W=RNULL_W %THEN %RETURN
  ! THERE IS A CONST. IN TRFST
  %IF TRACE#0 %START
    PRINTSTRING("THERE IS A CONSTANT IN TRIAD")
    WRITE(FSTIND,1);NEWLINE
    PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  %FINISH
  ! DERIVE CETAB3 INDEX
  TAB3IND=OP1*4+CURROP
  RES1=RES
  TAB2IND=CETAB3(TAB3IND)
  %IF TAB2IND=0 %THEN %RETURN
  %IF TRACE#0 %START
    PRINTSTRING("CETAB3 INDEX IS")
    WRITE(TAB3IND,1);NEWLINE
    PRINTSTRING("CETAB2 INDEX IS")
    WRITE(TAB2IND,1);NEWLINE
    PRINTSTRING("JUMP TO ACTION")
    WRITE(CETAB2(TAB2IND),1);NEWLINE
  %FINISH
  ->ACT(CETAB2(TAB2IND))
!
%FINISH; ! OPD2 IS A CONST.
!
! HERE, NEITHER OPERAND IS A CONST.
! TRY VARIOUS POSSIBILITIES OF ELIMINATION BY COMBINATION
! CE15F:
%IF TRACE#0 %START
  PRINTSTRING("NEITHER OPERAND IS CONST.");NEWLINE
%FINISH
%IF CTR_OP&BMBITOFF=SUB %START
  %IF CTR_QOPD1=CTR_QOPD2 %AND CTR_OPD1=CTR_OPD2 %START
    ! N-N BECOMES 0
    CTR_OP=(CTR_OP&BMBIT)!REPL
    %IF CTR_QOPD1&TEXTMASK#0 %START
      DELUSE(CTR_OPD1)
      DELUSE(CTR_OPD2)
    %FINISH
    CTR_RES1_W=CONRES(0,CTR_MODE)
    CTR_RES2=RNULL
    %IF TRACE#0 %START
      PRINTSTRING("N-N BECOMES 0");NEWLINE
      PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      PRINTSTRING("EXIT FROM CONELIM");NEWLINE
    %FINISH
    %RETURN
  %FINISH
%FINISH; ! CTR_OP=SUB & OPD1=OPD2
!
! CE45:
%IF CTR_QOPD1&TEXTMASK=0 %START
  %IF CTR_QOPD2&TEXTMASK=0 %THEN %RETURN; ! ID OP ID
  ! ID OP TRIAD - OP MUST BE SUB
  TROPD2==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
  %IF TRACE#0 %START
    PRINTSTRING("ID OP TRIAD - OP MUST BE SUB")
    NEWLINE
    PRINTSTRING("TRIAD IS")
    NEWLINE
    PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD2)
  %FINISH
  %IF TROPD2_RES1_W=CTR_RES1_W %START
    ! LOOK FOR A CONSTANT IN THE SAME TRIAD, AND USE=1
    OP2=CCHECK(CTR_OPD2,RES2)
    %IF RES2_W=RNULL_W %THEN %START
      %IF OP2=-1 %OR OP2=TABMULT %THEN %RETURN
    %FINISH
    %IF OP2#TABMULT %START
      ! CEI40:
      ! TROPD2_OP IS + OR -
      ! CASE A: ID - (ID+-ANY)
      %IF TRACE#0 %START
        PRINTSTRING("CASE A: ID - (ID+-ANY)")
        NEWLINE
      %FINISH
      %IF OP2=TABADD %THEN OP1=NEG %ELSE OP1=REPL
      RES=TROPD2_RES2
      DELIND=CTR_OPD2
      ->CEI90
    %FINISH
    ! OP2 IS MULT
    ! ID - (ID*CONST) WHERE (ID*CONST) IS USED ONLY ONCE
    ! GENERATE (ID*1-CONST)
    RES1_W=CONRES(1,CTR_MODE)
    OK=CONOP(RES1,SUB,RES2,RES)
    %IF OK#0 %THEN %RETURN
    DELIND=CTR_OPD2
    CTR_RES2=RES
    CTR_OP=(CTR_OP&BMBIT)!MULT
    DELUSE(DELIND)
    %IF TRACE#0 %START
      PRINTSTRING("ID - (ID*1-CONST) BECOMES ID * (1-CONST)")
      NEWLINE
      PRINTSTRING("DELETE TRIAD")
      WRITE(DELIND,1);NEWLINE
      PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      PRINTSTRING("START AGAIN");NEWLINE
    %FINISH
    ->CE0
  %FINISH %ELSESTART
    !CEI20:
    %IF TROPD2_RES2_W#CTR_RES1_W %THEN %RETURN
    %IF TROPD2_OP&BMBITOFF#ADD %THEN %RETURN
    ! CASE B:ID - (ANY+ID)
    %IF TRACE#0 %START
      PRINTSTRING("CASE B: ID - (ANY+ID)")
      NEWLINE
    %FINISH
    OP1=NEG
    RES=TROPD2_RES1
    DELIND=CTR_OPD2
    ->CEI90
  %FINISH
%FINISH; ! OPD1 = ID
!
%IF CTR_QOPD2&TEXTMASK=0 %START
  ! TRIAD OP ID
  ! CE53:
  %IF CTR_OP&BMBITOFF=MULT %THEN %RETURN
  TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
  %IF TROPD1_RES1_W=CTR_RES2_W %START
    %IF TRACE#0 %START
      PRINTSTRING("TRIAD OP ID");NEWLINE
      PRINTSTRING("TRIAD IS")
    NEWLINE
      PRINTTR(CTR_OPD1,ADICT,ANAMES,0,TROPD1)
    %FINISH
    ! LOOK FOR A CONST. IN SAME TRIAD WITH USE=1
    OP2=CCHECK(CTR_OPD1,RES1)
    %IF RES1_W=RNULL_W %THEN  %START
      %IF OP2=-1 %OR OP2=TABMULT %THEN %RETURN
    %FINISH
    %IF OP2#TABMULT %START
      ! CEI60:
      ! TROPD1_OP IS + OR -
      %IF CURROP#TABSUB %THEN %RETURN
      ! CASE C: (ID+-ANY) - ID
      %IF TRACE#0 %START
        PRINTSTRING("CASE C: (ID+-ANY) - ID")
        NEWLINE
      %FINISH
      %IF OP2=TABADD %THEN OP1=REPL %ELSE OP1=NEG
      RES=TROPD1_RES2
      DELIND=CTR_OPD1
      ->CEI90
    %FINISH
    ! (ID*CONST) +- ID
    ! (ID*CONST) IS USED ONLY ONCE
    ! GENERATE (ID*CONST+-1)
    RES2_W=CONRES(1,CTR_MODE)
    ! ADD 1 TO OR SUBTRACT 1 FROM THE CONST
    OK=CONOP(RES1,CTR_OP&BMBITOFF,RES2,RES)
    %IF OK#0 %THEN %RETURN
    DELIND=CTR_OPD1
    CTR_RES1=CTR_RES2
    CTR_RES2=RES
    CTR_OP=(CTR_OP&BMBIT)!MULT
    DELUSE(DELIND)
    %IF TRACE#0 %START
      PRINTSTRING("(ID*CONST) +- ID BECOMES ID * (CONST+-1)")
      NEWLINE
      PRINTSTRING("DELETE TRIAD ")
      WRITE(DELIND,1)
      PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      PRINTSTRING("START AGAIN");NEWLINE
    %FINISH
    ->CE0
  %FINISH %ELSESTART
    ! CEI80:
    %IF TROPD1_RES2_W#CTR_RES2_W %THEN %RETURN
    %IF TROPD1_OP&BMBITOFF=ADD %START
      %IF CTR_OP&BMBITOFF=ADD %THEN %RETURN
      ! CASE D: (ANY+ID) - ID
      %IF TRACE#0 %START
        PRINTSTRING("CASE D: (ANY+ID) - ID")
        NEWLINE
      %FINISH
    %FINISH %ELSEIF TROPD1_OP&BMBITOFF=SUB %START
      %IF CTR_OP&BMBITOFF#ADD %THEN %RETURN
      ! CASE E: (ANY-ID) + ID
      %IF TRACE#0 %START
        PRINTSTRING("CASE E: (ANY-ID) + ID")
        NEWLINE
      %FINISH
    %FINISH %ELSE %RETURN
    OP1=REPL
    RES=TROPD1_RES1
    DELIND=CTR_OPD1
    CEI90:
    ! REPL/NEG IS IN OP1
    ! ANY IS IN RES
    ! INDEX OF TRIAD OPERAND IN DELIND
    CTR_OP=(CTR_OP&BMBIT)!OP1
    CTR_RES1=RES
    CTR_RES2=RNULL
    %IF CTR_QOPD1&TEXTMASK#0 %START
      TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
        TROPD1_USE=TROPD1_USE+1
    %FINISH
    DELUSE(DELIND)
    %IF TRACE#0 %START
      PRINTSTRING("DELETE TRIAD ")
      WRITE(DELIND,1);NEWLINE
      PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      PRINTSTRING("EXIT FROM CONELIM");NEWLINE
    %FINISH
    %RETURN
  %FINISH
%FINISH; ! OPD2=ID
!
! CE60:
! BOTH OPERANDS ARE TRIADS
! OPTIMISATION IS POSSIBLE IF BOTH CONTAIN CONSTANTS
%IF TRACE#0 %START
  PRINTSTRING("BOTH OPERANDS ARE TRIADS")
  NEWLINE
%FINISH
OP1=CCHECK(CTR_OPD1,RES1)
%IF RES1_W=RNULL_W %THEN %RETURN
! CTR_OPD1 CONTAINS A CONSTANT
OP2=CCHECK(CTR_OPD2,RES2)
%IF RES2_W=RNULL_W %THEN %RETURN
! CTR_OPD2 CONTAINS A CONSTANT
TAB1IND=2*(CURROP+3*(OP2+4*OP1))
%IF TRACE#0 %START
  PRINTSTRING("BOTH OPERANDS CONTAIN CONSTANTS")
  NEWLINE
  PRINTSTRING("CETAB1 INDEX IS")
  WRITE(TAB1IND,1);NEWLINE
%FINISH
%IF CETAB1(TAB1IND)=0 %THEN %RETURN; ! NO ELIMINATION
TROPD1==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
TROPD2==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("TRIAD OPD1 -")
  NEWLINE
  PRINTTR(CTR_OPD1,ADICT,ANAMES,0,TROPD1)
  PRINTSTRING("TRIAD OPD2 -")
  NEWLINE
  PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD2)
%FINISH
!
! SAVE OPD1 &OPD2 IN FST &SCND RESPECTIVELY
TRFST==TROPD1
FSTIND=CTR_OPD1
TRSCND==TROPD2
SCNDIND=CTR_OPD2
!
%IF TROPD1_OP&BMBIT#0 %THEN %START
  %IF TROPD2_OP&BMBIT=0 %THEN ->CE70; ! OPD1 IS A LOOP CONST, OPD2 IS NOT
%FINISH %ELSESTART
  %IF TROPD2_OP&BMBIT#0 %THEN ->CE68; ! OPD2 IS A LOOP CONST,OPD1 IS NOT
%FINISH
!
! BOTH OPERANDS ARE LOOP CONSTS., OR BOTH ARE NOT
! SCAN THE CHAIN TO FIND EARLIER TRIAD
CE64:
%IF TROPD2_CHAIN=CURRTRIAD %OR TROPD1_CHAIN=SCNDIND %THEN ->CE70
%IF TROPD2_CHAIN=FSTIND %OR TROPD1_CHAIN=CURRTRIAD %THEN ->CE68
TROPD1==RECORD(ATRIADS+TROPD1_CHAIN*TRIADLENGTH)
TROPD2==RECORD(ATRIADS+TROPD2_CHAIN*TRIADLENGTH)
->CE64
!
CE68:
%IF TRACE#0 %START
  PRINTSTRING("EITHER OPD2 IS A LOOPCONST. AND OPD1 IS NOT, OR")
  NEWLINE
  PRINTSTRING("OPD2 IS THE EARLIER TRIAD")
  NEWLINE
  PRINTSTRING("CHANGE ORDER OF TWO TRIADS")
  NEWLINE
%FINISH
!
! CHANGE FST & SCND ROUND
TROPD1==TRFST
DELIND=FSTIND
TRFST==TRSCND
FSTIND=SCNDIND
TRSCND==TROPD1
SCNDIND=DELIND
TAB1IND=TAB1IND+1
!
CE70:
TAB2IND=CETAB1(TAB1IND)-1
!
CENEXT:
TAB2IND=TAB2IND+1
%IF TRACE#0 %START
  PRINTSTRING("CETAB2 INDEX IS")
  WRITE(TAB2IND,1);NEWLINE
  PRINTSTRING("GOT TO ACTION")
  WRITE(CETAB2(TAB2IND),1);NEWLINE
%FINISH
->ACT(CETAB2(TAB2IND))
!
ACT(0):%RETURN
!
ACT(1):
OK=CONOP(RES1,ADD,RES2,RES); ! CON1+CON2
%IF OK#0 %THEN %RETURN
->CENEXT
!
ACT(2):
%IF MODETYPE(CTR_MODE)#REALTYPE %THEN ->CENEXT
%IF TRFST_OP&BMBITOFF#SUB %THEN ->CENEXT
! MINUS REAL CONST. BECOMES PLUS REAL CONST.
OK=CONOP(RNULL,NEG,RES,RES); ! NEGATE RES
%IF OK#0 %THEN %RETURN
TRFST_OP=(TRFST_OP&BMBIT)!ADD; ! MINUS BECOMES PLUS
->CENEXT
!
ACT(3):
->CENEXT
!
ACT(4):
TRFST_RES2=RES
->CENEXT
!
ACT(5):
CTR_RES2=TRSCND_RES1
->CENEXT
!
ACT(6):
DELUSEX(SCNDIND)
%IF TRACE#0 %START
  PRINTSTRING("ACTION 6 - DELETE TRIAD")
  WRITE(SCNDIND,1);NEWLINE
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("TRFST BECOMES")
  NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("START AGAIN");NEWLINE
%FINISH
->CE0
!
ACT(7):
CTR_RES1=CTR_RES2
->CENEXT
!
ACT(8):
OK=CONOP(RES1,SUB,RES2,RES); ! CON1-CON2
%IF OK#0 %THEN %RETURN
->CENEXT
!
ACT(9):
OK=CONOP(RES2,SUB,RES1,RES); ! CON2-CON1
->CENEXT
!
ACT(10):
CTR_RES1=TRSCND_RES1
->CENEXT
!
ACT(11):
CTR_RES2=TRSCND_RES2
->CENEXT
!
ACT(12):
CTR_OP=(CTR_OP&BMBIT)!SUB
->CENEXT
!
ACT(13):
TRFST_RES1=RES
->CENEXT
!
ACT(14):
CTR_OP=(CTR_OP&BMBIT)!ADD
->CENEXT
!
ACT(15):
OK=CONOP(RES1,MULT,RES2,RES)
%IF OK#0 %THEN %RETURN
->CENEXT
!
ACT(16):
TRFST_RES2=TRFST_RES1
->CENEXT
!
ACT(17):
TRFST_OP=(TRFST_OP&BMBIT)!SUB
->CENEXT
!
ACT(18):
CTR_OP=(CTR_OP&BMBIT)!REPL
CTR_RES2=0
%IF TRACE#0 %START
  PRINTSTRING("ACTION 18 - CURRTRIAD BECOMES")
  NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("TRFST BECOMES")
  NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
%FINISH
%RETURN
!
ACT(19):
TRFST_RES2=CTR_RES2
OP1=TRFST_OP&BMBITOFF
TRFST_OP=CTR_OP&BMBITOFF
CTR_OP=OP1
->CENEXT
!
ACT(20):
CTR_RES2=RES
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("TRFST BECOMES")
  NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("START AGAIN");NEWLINE
%FINISH
->CE0
!
ACT(21):
CTR_RES2=CTR_RES1
CTR_RES1=RES
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("TRFST BECOMES")
  NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("START AGAIN");NEWLINE
%FINISH
->CE0
!
ACT(22):
TRFST_RES1=TRFST_RES2
->CENEXT
!
ACT(23):
TRFST_OP=(TRFST_OP&BMBIT)!ADD
->CENEXT
!
ACT(24):
%IF TRFST_RES1_W#TRSCND_RES1_W %THEN %RETURN
CTR_RES1=TRFST_RES1
CTR_RES2=RES
CTR_OP=(CTR_OP&BMBIT)!MULT
DELUSEX(FSTIND)
DELUSE(SCNDIND)
%IF TRACE#0 %START
  PRINTSTRING("DELETE TRIAD")
  WRITE(FSTIND,1);NEWLINE
  PRINTSTRING("DELETE TRIAD")
  WRITE(SCNDIND,1);NEWLINE
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("START AGAIN")
%FINISH
->CE0
!
%END; ! CONELIM
!
%EXTERNALROUTINE FACTORISE
! ATTEMPT FACTORIASTION OF EXPRESSIONS
%RECORD(TRIADF)%NAME CTR,TRFST,TRSCND,TRTMP
%RECORD(RESF) RES
%INTEGER COP,FSTIND,SCNDIND,IND
!
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
COP=CTR_OP&BMBITOFF
%IF COP#ADD %AND COP#SUB %THEN %RETURN
%IF CTR_QOPD1&TEXTMASK=0 %OR CTR_QOPD2&TEXTMASK=0 %THEN %RETURN
! OPERANDS ARE BOTH TRIADS
%IF TRACE#0 %START
  PRINTSTRING("ATTEMPT FACTORISATION OF EXPRESSION - CURRTRIAD IS")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_RES1_W=CTR_RES2_W %THEN %RETURN
TRSCND==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
SCNDIND=CTR_OPD1
%IF TRSCND_OP&BMBITOFF#MULT %OR TRSCND_USE#1 %THEN %RETURN
TRFST==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
FSTIND=CTR_OPD2
%IF TRFST_OP&BMBITOFF#MULT %OR TRFST_USE#1 %THEN %RETURN
! BOTH OPERANDS HAVE OP=* AND USE=1
%IF TRFST_OP&BMBIT#0 %START
  ! TRFST IS A LOOP CONSTANT
  %IF TRSCND_OP&BMBIT=0 %START
    ! TRSCND IS NOT A LOOP CONSTANT - SWAP FST & SCND
    %IF TRACE#0 %START
      PRINTSTRING("SWAP TRFST AND TRSCND");NEWLINE
    %FINISH
    IND=FSTIND
    TRTMP==TRFST
    FSTIND=SCNDIND
    TRFST==TRSCND
    SCNDIND=IND
    TRSCND==TRTMP
  %FINISH
%FINISH
!
! FSTIND POINTS TO THE TRIAD WHICH IS TO BE MANIPULATED
! SCNDIND POINTS TO THE TRIAD WHICH WILL DISAPPEAR IF A COMMON
! OPERAND IS FOUND, PERMITTING FACTORISATION
%IF TRACE#0 %START
  PRINTSTRING("TRFST HAS INDEX")
  WRITE(FSTIND,1);NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("TRSCND HAS INDEX")
  WRITE(SCNDIND,1);NEWLINE
  PRINTTR(SCNDIND,ADICT,ANAMES,0,TRSCND)
%FINISH
%IF TRSCND_RES2_W#TRFST_RES2_W %START
  %IF TRSCND_RES1_W#TRFST_RES1_W %START
    %IF TRFST_RES2_W#TRSCND_RES1_W %START
      %IF TRFST_RES1_W#TRSCND_RES2_W %THEN %RETURN
      RES=TRFST_RES1
      TRFST_RES1=TRFST_RES2
      TRFST_RES2=RES
      ->FAC50
    %FINISH
  %FINISH %ELSE %START
    ! FAC20
    RES=TRFST_RES1
    TRFST_RES1=TRFST_RES2
    TRFST_RES2=RES
  %FINISH
  ! FAC30
  RES=TRSCND_RES1
  TRSCND_RES1=TRSCND_RES2
  TRSCND_RES2=RES
%FINISH; ! TRSCND_RES2=TRFST_RES2
!
FAC50:
TRSCND_OP=NULL
CTR_RES2_W=TRSCND_RES2_W
TRFST_RES2_W=TRSCND_RES1_W
CTR_OP=(CTR_OP&BMBIT)!MULT; ! TRFST_OP IS *
TRFST_OP=(TRFST_OP&BMBIT)!COP
%IF FSTIND#CTR_OPD1 %START
  RES=TRFST_RES1
  TRFST_RES1=TRFST_RES2
  TRFST_RES2=RES
%FINISH
!
!FAC60:
TREVERSE(FSTIND)
%IF TRACE#0 %START
  PRINTSTRING("TRFST HAS INDEX")
  WRITE(FSTIND,1);NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("TRSCND HAS INDEX")
  WRITE(SCNDIND,1);NEWLINE
  PRINTTR(SCNDIND,ADICT,ANAMES,0,TRSCND)
%FINISH
CTR_OPD1=FSTIND
%IF CTR_QOPD2&TEXTMASK#0 %START
  ! THE COMMON FACTOR WAS A TRIAD, DELETE ITS USE COUNT
  %IF TRACE#0 %START
    PRINTSTRING("THE COMMON FACTOR WAS A TRIAD, INDEX")
    WRITE(CTR_OPD2,1)
    PRINTSTRING(" - DELETE ITS USE COUNT");NEWLINE
  %FINISH
  DELUSE(CTR_OPD2)
  TREVERSE(CURRTRIAD)
%FINISH
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("EXIT FROM FACTORISE");NEWLINE
%FINISH
!
%END; ! FACTORISE
!
%EXTERNALROUTINE LINEARISE
! ATTEMPT LINEARISATION OF EXPRESSIONS
! MULT,SUB & ADD TRIADS
%RECORD(TRIADF)%NAME CTR,TRFST,TRSCND,TRTMP
%RECORD(BLRECF)%NAME CBL
%INTEGER FSTIND,SCNDIND,IND,TLSIGN,OK
!
%INTEGERFUNCTION LINCHTRIADS(%INTEGER IND)
! CHECK FOR TRIAD OPERANDS IN  THE TRIAD WITH INDEX IND
! POINTERS TO ARR OR BACKWARD MOVED TRIADS ARE EXCEPTED
! RETURNS 1 IF TRIAD OPERANDS ELSE 0
%RECORD(TRIADF)%NAME TR,TROPD
!
TR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF TR_QOPD1&TEXTMASK#0 %START
  TROPD==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
  %IF TROPD_OP&BMBITOFF# ARR %AND TROPD_OP&BMBIT=0 %THEN %C
    %RESULT=1; ! OPD1 IS A TRIAD
%FINISH
%IF TR_QOPD2&TEXTMASK=0 %THEN %RESULT=0
TROPD==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
%IF TROPD_OP&BMBITOFF=ARR %%OR TROPD_OP&BMBIT#0 %THEN %RESULT=0
%RESULT=1
%END; ! LINCHTRIADS
!
%INTEGERFUNCTION LINEAROP(%INTEGER IND)
! RECOGNISE VALID COMBINATIONS OF OPERATORS FOR LINEARISATION
! RETURNS 1 IF VALID, ELSE 0
%RECORD(TRIADF)%NAME TR
%INTEGER OP,COP
!
TR==RECORD(ATRIADS+IND*TRIADLENGTH)
OP=TR_OP&BMBITOFF
COP=CTR_OP&BMBITOFF
%IF OP#ADD %AND OP#SUB %START
  %IF OP#MULT %OR OP#COP %THEN %RESULT=0
  TLSIGN=MULT
%FINISH %ELSE %START
  ! LRP20:
  %IF COP=OP %THEN TLSIGN=ADD %ELSE %START
    !LRP30:
    %IF COP=MULT %THEN %RESULT=0
    TLSIGN=SUB
  %FINISH
%FINISH
%RESULT=1
%END; ! LINEAROP
!
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF CTR_QOPD2&TEXTMASK=0 %OR CTR_QOPD1&TEXTMASK=0 %THEN %RETURN
%IF CTR_RES1_W=CTR_RES2_W %THEN %RETURN
TRSCND==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
%IF TRSCND_OP&BMBITOFF=ARR %OR TRSCND_OP&BMBIT#0 %THEN %RETURN
TRFST==RECORD(ATRIADS+CTR_OPD1*TRIADLENGTH)
%IF TRFST_OP&BMBITOFF=ARR %OR TRFST_OP&BMBIT#0 %THEN %RETURN
%IF TRACE#0 %START
  PRINTSTRING("LINEARISATION OF EXPRESSIONS - CURRTRIAD INDEX=")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("OPD1 POINT TO TRIAD WITH INDEX(FSTIND)")
  WRITE(CTR_OPD1,1);NEWLINE
  PRINTTR(CTR_OPD1,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("OPD2 POINTS TO TRIAD WITH INDEX(SCNDIND)")
  WRITE(CTR_OPD2,1);NEWLINE
  PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TRSCND)
  PRINTSTRING("NOW TEST IF ONE OF THE TRIADS CAN BE LINEARISED")
  NEWLINE
%FINISH
!
! NOW TEST IF ONE OF THE TRIADS CAN BE LINEARISED
FSTIND=CTR_OPD1
SCNDIND=CTR_OPD2
OK=LINCHTRIADS(FSTIND)
%IF OK=1 %START
  ! OPD1 CONTAINS A TRIAD
  OK=LINCHTRIADS(SCNDIND)
  %IF OK=1 %THEN %RETURN
%FINISH %ELSESTART
  !LIN10:
  OK=LINCHTRIADS(SCNDIND)
  %IF OK=0 %START
    !LIN20:
    OK=LINEAROP(FSTIND)
    %IF OK=1 %THEN SCNDIND=FSTIND %AND ->LIN40
  %FINISH %ELSE SCNDIND=FSTIND
%FINISH
!LIN30:
OK=LINEAROP(SCNDIND)
%IF OK=0 %THEN%RETURN
LIN40:
%IF SCNDIND#CTR_OPD2 %START
  ! SWAP FST AND SCND
  %IF TRACE#0 %START
    PRINTSTRING("SWAP FSTIND & SCNDIND");NEWLINE
  %FINISH
  FSTIND=CTR_OPD2
  TRTMP==TRFST
  TRFST==TRSCND
  TRSCND==TRTMP
%FINISH
%IF TRSCND_USE#1 %THEN %RETURN
!
! LIN50:
! CHECK THAT TRFST PRECEDES TRSCNDN SINCE TRSCND IS
! GOING TO POINT OT TRFST AFTER LINEARISATION
%IF TRACE#0 %START
  PRINTSTRING("CHECK THAT TRFST PRECEDES TRSCND");NEWLINE
%FINISH
CBL==RECORD(ABLOCKS+CURRBLK*BLSIZE)
IND=CBL_TEXT
!
LIN60:
TRTMP==RECORD(ATRIADS+IND*TRIADLENGTH)
IND=TRTMP_CHAIN
%IF IND#SCNDIND %START
  %IF IND#FSTIND %THEN ->LIN60
%FINISH %ELSESTART
  ! LIN70: TRTMP_CHAIN=SCNDIND
  ! NECESSARY TO RECHAIN TRFST & TRSCNDN
  ! WILL THIS HAVE ANY SIDE-EFFECTS?
  %IF TRACE#0 %START
    PRINTSTRING("RECHAIN TRFST & TRSCND");NEWLINE
  %FINISH
  TRTMP_CHAIN=TRSCND_CHAIN
  TRSCND_CHAIN=TRFST_CHAIN
  TRFST_CHAIN=SCNDIND
%FINISH
!
!LIN80:
%IF CTR_OPD1=SCNDIND %START
  CTR_RES2_W=CTR_RES1_W
  CTR_RES1_W=TRSCND_RES1_W
%FINISH %ELSESTART
  CTR_RES1_W=CTR_RES2_W
  CTR_RES2_W=TRSCND_RES1_W
%FINISH
!
!LIN87:
! OPERANDS HAVE NOW BEEN JUGGLED TO GET ALINEAR SEQUENCE
TREVERSE(CURRTRIAD)
TRSCND_OP=TLSIGN; ! SET NEW SIGN IN THE LINEARISED TRIAD
TRSCND_OPD1=FSTIND
TRSCND_QOPD1=TRIAD
TREVERSE(SCNDIND)
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
  PRINTSTRING("TRFST BECOMES");NEWLINE
  PRINTTR(FSTIND,ADICT,ANAMES,0,TRFST)
  PRINTSTRING("TRSCND BECOMES");NEWLINE
  PRINTTR(SCNDIND,ADICT,ANAMES,0,TRSCND)
  PRINTSTRING("EXIT FROM LINEARISE");NEWLINE
%FINISH
!
%END; ! LINEARISE
!
%EXTERNALROUTINE OPTCVT
! OPTIMISE THE CVT TRIAD
%RECORD(TRIADF)%NAME CTR,TROPD
%INTEGER OK
%RECORD(RESF) RES
!
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("OPTIMISE THE CVT TRIAD, INDEX")
  WRITE(CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_QOPD2&CONSTMASK#0 %START
  ! OPD2 IS CONSTANT, CONVERT IF COMPLEX NOT INVOLVED
  %IF MODETYPE(CTR_MODE)=CMPLXTYPE %OR MODETYPE(CTR_MODE2)=CMPLXTYPE %C
   %THEN %RETURN
  %IF CTR_MODE=INT2 %THEN %RETURN; ! REJECT TARGET INT*2
  RES=CTR_RES2
  OK=CONVERTMODE(RES,CTR_MODE)
  %IF OK#0 %THEN %RETURN; ! REJECT SOURCE INT*2
  CTR_RES1=RES
  ->SETREPL
%FINISH
!
%IF CTR_QOPD2&TEXTMASK=0 %THEN %RETURN
!OPD2 IS ATRIAD
TROPD==RECORD(ATRIADS+CTR_OPD2*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("OPD2 IS A TRIAD, INDEX")
  WRITE(CTR_OPD2,1);NEWLINE
  PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD)
%FINISH
%RETURN;! TEMPORARY !!!!!!!!
%IF MODETYPE(CTR_MODE)#INTTYPE %START
  ! LCCN86
  ! LOOK FOR (R4*R4)->R8 & GENERATE DMULT
  %IF CTR_MODE#REAL8 %THEN %RETURN
  %IF CTR_MODE2#REAL4 %THEN %RETURN
%FINISH %ELSESTART
  ! LCCN87
  ! LOOK FOR (I4*I4)->I8 &GENERATE DMULT
  %IF CTR_MODE#INT8 %THEN %RETURN
  %IF CTR_MODE2#INT4 %THEN %RETURN
%FINISH
!
! LCCN88
%IF TROPD_USE#1 %OR TROPD_OP&BMBITOFF#MULT %THEN %RETURN
TROPD_OP=(TROPD_OP&BMBIT)!DMULT
%IF TRACE#0 %START
  PRINTSTRING("OPD2 TRIAD BECOMES");NEWLINE
  PRINTTR(CTR_OPD2,ADICT,ANAMES,0,TROPD)
%FINISH
CTR_OPD1=CTR_OPD2
CTR_QOPD1=CTR_QOPD2
CTR_RES2=RNULL
SETREPL:
CTR_OP=(CTR_OP&BMBIT)!REPL
%IF TRACE#0 %START
  PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
!
%END; ! OPTCVT
!
%EXTERNALROUTINE OPTEXP
! EXPONENTIATE OPTIMISATION
%RECORD(TRIADF)%NAME CTR
%INTEGER CVAL,OK
%RECORD(RESF) RES,PWRRES,RES2
!
! GRECIP=0
!
CTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF MODETYPE(CTR_MODE)=CMPLXTYPE %OR MODETYPE(CTR_MODE2)=CMPLXTYPE %C
    %THEN %RETURN
%IF TRACE#0 %START
  PRINTSTRING("EXPONENTIATE OPTIMISATION - CURRTRIAD INDEX,")
  WRITE( CURRTRIAD,1);NEWLINE
  PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
%FINISH
%IF CTR_QOPD1&CONSTMASK#0 %START
  ! BASE IS CONSTANT
  ! CHECK FOR 0 OR 1
  %IF TRACE#0 %START
    PRINTSTRING("BASE IS CONSTANT");NEWLINE
  %FINISH
  CVAL=CONCHECK(CTR_RES1)
  %IF CVAL=0 %OR CVAL=1 %START
    ! 0**ANY BECOMES 0, 1**ANY BECOMES 1
    %IF TRACE#0 %START
      PRINTSTRING("BASE IS 0 OR 1");NEWLINE
    %FINISH
    %IF CTR_QOPD2&TEXTMASK#0 %THEN DELUSE(CTR_OPD2)
    ->SETREPL
  %FINISH; ! BASE IS 0 OR 1
  %IF CVAL=-1 %START
    ! LEXP20
    ! BASE IS -1
    %IF MODETYPE(CTR_MODE)=INTTYPE %START
      CTR_OP=(CTR_OP&BMBIT)!EXP3
      %RETURN
    %FINISH
  %FINISH; ! BASE IS -1
!
!
! IF INTEGER CONST.** ANY IN I4 MODE
! GET CONST. VALUE & CHECK FOR POWER OF 2
! SEE LISTING @ LEXP15-LEXP20, LEXP25-LEXP39
!
!
%FINISH; ! QOPD1 IS A CONTANT
!
! LEXP40:
%IF CTR_QOPD2&CONSTMASK#0 %START
  ! QOPD2 IS A CONSTANT
  %IF TRACE#0 %START
    PRINTSTRING("POWER IS CONSTANT");NEWLINE
  %FINISH
  CVAL=CONCHECK(CTR_RES2)
  %IF CVAL=0 %START
    ! ANY ** 0 BECOMES 1
    ! GENERATE 1 OF MODE CTR_MODE
    %IF TRACE#0 %START
      PRINTSTRING("POWER IS 0 - ANY**0 BECOMES 1");NEWLINE
    %FINISH
    %IF CTR_QOPD1&TEXTMASK#0 %THEN DELUSE(CTR_OPD1)
    CTR_RES1_W=CONRES(1,CTR_MODE)
    ->SETREPL
  %FINISH
  %IF CVAL=1 %START
    ! LEXP77
    %IF TRACE#0 %START
      PRINTSTRING("POWER IS 1");NEWLINE
    %FINISH
    ->SETREPL
  %FINISH
  %IF CVAL=-1 %START
    ! POWER IS -1, A**-1 BECOMES 1/A
    %IF TRACE#0 %START
      PRINTSTRING("POWER IS -1 - ANY**-1 BECOMES 1/ANY")
      NEWLINE
    %FINISH
    CTR_RES2=CTR_RES1
    CTR_RES1_W=CONRES(1,CTR_MODE)
    CTR_OP=(CTR_OP&BMBIT)!DIV
    ->OUT1
  %FINISH
  %IF CVAL=2 %AND MODETYPE(CTR_MODE2)=REALTYPE %THEN %C
    CTR_RES2_W=CONRES(2,INT4)
!
  ! LEXP50:
  ! IF POWER IS NEGATIVE CHANGE TO POSITIVE & SET
  ! GRECIP TO TRIGGER GENERATION OF 1/EXP AT END
!
!
  %IF MODETYPE(CTR_MODE2)=INTTYPE %START
    ! LEXP53:
    ! INTEGER CONST. POWER - BASE**INT.CONST.
    %IF CTR_QOPD1&CONSTMASK#0 %START
      ! BASE ALSO CONSTANT - EVALUATE
      %IF CVAL<0 %START
        ! POWER IS NEGATIVE, CHANGE TO POSITIVE
        %IF TRACE#0 %START
          PRINTSTRING("POWER IS NEGATIVE, CHANGE TO POSITIVE")
          NEWLINE
      %FINISH
        OK=CONOP(RNULL,NEG,CTR_RES2,PWRRES)
        %IF OK#0 %THEN %RETURN
      %FINISH %ELSE PWRRES=CTR_RES2
      OK=CONOP(CTR_RES1,CTR_OP&BMBITOFF,PWRRES,RES)
      %IF OK#0 %THEN %RETURN
      %IF CVAL<0 %START
        ! ORIGINAL POWER WAS NEGATIVE - GENERATE 1/CONST.
        %IF TRACE#0 %START
          PRINTSTRING("ORIGINAL POWER WAS NEGATIVE - GENERATE 1/CONST")
          NEWLINE
        %FINISH
        RES2_W=CONRES(1,RES_MODE)
        OK=CONOP(RES2,DIV,RES,RES)
        %IF OK#0 %THEN %RETURN
      %FINISH
      CTR_RES1=RES
      SETREPL:
      CTR_RES2=RNULL
      CTR_OP=(CTR_OP&BMBIT)!REPL
      OUT1:
      %IF TRACE#0 %START
        PRINTSTRING("CURRTRIAD BECOMES");NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,CTR)
      %FINISH
      ->EXIT1
    %FINISH; ! BOTH OPDS. ARE CONSTANT
!
!
! IF NUMBER OF MULTIPLICATIONS REQUIRED TO PERFORM EXPONENTIATION IS
! <=8, THEN GENERATE NECESSARY MULTS. - LISTING @ LEXP60-LEXP80
! & IF ORIGINAL PWER WAS NEGATIVE, GENERATE RECIPROCATION -
! LISTING @LEXPREP2
!
!
    ->EXIT1
  %FINISH
  ! LEXP80:
  ! BASE ** REAL CONST.
!
!
! IF REAL CONSTANT IS INTEGRAL, CONVERT TO INT4 MODE,
! TEST NUMBER OF MULTS. REQUIRED (LISTING @ LEXP80-LEXP88) & IF <= 8
! GENEARATE NECESSARY MULTS. & CONTINUE AS FOR INT. CONST. POWER(LEXP61)
!
!
  ! LEXP90:
  ! BASE**REAL CONST. NOT SUITABLE FOR IN-LINE EXPANSION
!
!
! GENERATE EXP1 OR EXP2 IN PLACE OF EXP & %RETURN
!
!
  ! LEXP100:
  ! REAL **REAL CONST.
!
!
! IF POWER=0.5 GENERATE SQRT(BASE)& %RETURN
! OTHERWISE ->LEXP150
!
!
%FINISH; ! QOPD2 IS CONST.
!
!LEXP110:
! NEITHER BASE NOR POWER IS CONSTANT
!
!
! IF MODE IS INTEGER %RETURN
! LOOK FOR REAL**CVT(INT) & CHANGE TO REAL**INT
!
!
!LEXP150:
!
!
! A**B BECOMES EXP(B*LOG(A)))
! GENEARATE RECIPROCATION IF ORIGINAL POWER NEGATIVE
!
!
EXIT1:
%IF TRACE#0 %START
  PRINTSTRING("EXIT FROM OPTEXP");NEWLINE
%FINISH
%RETURN
!
%END; ! OPTEXP
!
%EXTERNALROUTINE OPTFUN
! REPLACE SINGLE OR DOUBLE PRECISION CALLS OF BASIC FNS BY MOO
! 
%CONSTBYTEINTEGERARRAY MMLTYPE(0:11)=
                      0,1,   3,  2,  0,4,  5,  6,  0,0,0,7
!                      {SQRT EXP LOG   SIN COS TAN       ATAN}
%RECORD(TRIADF)%NAME TR
%RECORD(PRECF)%NAME FN
%INTEGER I,J
!
%UNLESS TARGET=ICL2900 %THEN %RETURN
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
FN==RECORD(ADICT+TR_OPD1<<DSCALE)
%UNLESS FN_X0&3=1 %THEN %RETURN; ! ONLY STANDARD FN. CALLS
I=FN_LINK2; ! FN DETAILS
%UNLESS REAL4<=(I>>20)&X'F'<=REAL8 %THEN %RETURN; ! ONLY REAL*4 & REAL*8
I=I>>24; ! FN INDEX
%UNLESS 1<=I<=11 %THEN %RETURN
J=MMLTYPE(I)
%IF J=0 %THEN %RETURN
%IF TR_MODE=REAL8 %THEN J=J+8
TR_QOPD1=LIT
TR_OPD1=J
TR_OP=MOO
%END; ! OPTFUN
!
%EXTERNALROUTINE FLOWOFCONT
%END
!
%ENDOFFILE