!                                                                    fcelim1
! 07/12/86 - copy of ftncelim3
!          - insert include files
! 12/06/86 - correction to error path on NEG
! 20/02/86 - comment out code after temp. return in OPTCVT
! 02/12/85 - taken from conelim43, new include files incorporated
! 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 "ftn_ht"
!*
{%INCLUDE "ftn_fmts2"}
!* 09/12/85 - add recordformat SUBFMT
!* modified 14/03/85
!*
!***********************************************************************
!* Formats for accessing dictionary records                            *
!***********************************************************************
!*
%recordformat PRECF(%byteinteger CLASS,TYPE,X0,X1,
                    %integer LINK1, LINK2,
                   (%shortinteger COORD,LINK3  %OR %integer LAST   %C
                        %OR %integer CONSTRES %OR %integer INF3),
                    %integer ADDR4,
                    %shortinteger DISP,LEN,IDEN,IIN,
                    %integer LINE,XREF,CMNLENGTH,CMNREFAD)
!*
%recordformat SRECF(%integer INF0, LINK1, INF2, INF3, INF4)
!*
%recordformat RESF((%integer W %OR %shortinteger H0,
                      (%shortinteger H1 %OR %byteinteger FORM,MODE)))
!*
%recordformat DORECF( %C
    %integer LABEL, LINK1,
    %record(RESF) LOOPAD, ENDREF, INDEXRD, INCRD, FINALRD, ICRD,
    %integer LABLIST,LINE)
!*
%recordformat BFMT(%integer L,U,M)
!*
%recordformat ARRAYDVF(%integer DIMS, ADDRDV,ADDRZERO,  %C
            %integer ZEROTOFIRST, ADFIRST, NUMELS, ELLENGTH,  %C
            %record(BFMT) %ARRAY B(1 : 7))
!*
!*
%recordformat LRECF(%integer NOTFLAG,LINK1,
                    %record(RESF) ORLAB,ANDLAB,
                    %integer RELOP)
!*
%recordformat IFRECF(%integer TYPE,LINK1,
                     %record(RESF) ENDIFLAB,FALSELAB,
                     %integer LABLIST,LINE)
!*
%recordformat LABRECF(%shortinteger BLKIND,%byteinteger X0,X1,  %C
            %integer LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE,  %C
            %shortinteger DOSTART,DOEND,IFSTART,IFEND)
!*
%recordformat PLABF(%shortinteger BLKIND,%byteinteger USE,X1,
                    %integer INDEX,CODEAD,REF,REFCHAIN)
!*
%recordformat IMPDORECF(%integer VAL,LINK,IDEN)
!*
%recordformat CONSTRECF(%shortinteger MODE,LENGTH,
                      (%integer VALUE %OR %integer LINK1),
                      %integer DADDR,CADDR)
!*
%recordformat TMPF((%byteinteger CLASS,TYPE,
                        %shortinteger LEN %OR %integer W0),
                    %integer LINK1,
                    %byteinteger REG,MODE,%shortinteger INDEX,
                    %shortinteger COORD,USECNT,
                    %integer ADDR)
!*
%recordformat CHARF(%integer ADESC,LINK,LEN)
!*
%recordformat FNRECF(%integer FPTR,LINK1,HEAD,PCT)
!*
%recordformat TERECF(%shortinteger MODE,LOOP,
                      %integer CHAIN,DISP1,INDEX,
                      %shortinteger COORD,FLAGS)
!*
%recordformat DTRECF(%shortinteger MODE,IDENT,
                      %integer CHAIN,DISP2,
                      %shortinteger FLAGS,INDEX,
                     (%integer LOOP %OR %record(RESF) CONST))
!*
!*
!***********************************************************************
!* TRIAD record format                                                 *
!***********************************************************************
!*
%recordformat TRIADF(  %C
               %byteinteger OP,
               (%byteinteger USE %OR %byteinteger VAL2),
               %shortinteger CHAIN,
               (%record(RESF) RES1      %OR     %C
               (%shortinteger OPD1,%byteinteger QOPD1,MODE  %OR  %C
               (%integer SLN %OR %integer VAL1))),
               (%record(RESF) RES2      %OR   %C
                %shortinteger OPD2,%byteinteger QOPD2,MODE2))
!*
!***********************************************************************
!* COM record format                                                   *
!***********************************************************************
!*
%recordformat COMFMT(%integer CONTROL,OPT,OPTIONS1,OPTIONS2,PTRACE,
      ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR,
      MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD,
      SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST,
      RESCOM1,RESCOM2,F77PARM,FNO,FAULTY,LINEST,CMNIIN,SFMK,
      LISTL,LISTSTREAM,DIAGSTREAM,LISTMODE,XREF,
      PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR,
      HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN,
      NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT,
      UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR,
      FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT,
      COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR,
      CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN,
      ADEXT,MAXDICT,MAXNAMES,MAXOUTPUT,MAXEXT,
      ACOMP,ASUBNAMES,MAXPSTACK,
      ATRIADS,TRFILEID,TRBLOCK,CMNCNT,SCANONLY,NOISY,
      MAXANAL,MAXGEN,SAVEANAL,SAVEGEN,OPTFLAGS,NEXTBIT,
      ACMNBITS,NEXTTEMP,ASSGOTOS,TMPPTR,DESTEMPS,OBJADDR,
      AREAADDR,PASTART,ADOPTDATA,TMINDEX,VRETURN,ENTRIES,
      EQUCHK,LABWARN,LINENO,MAXIBUFF,
      COMMENTS,DIAGLEVEL,WARNNOT77,WARNLENGTH,ALLOWUNIX,ALLOWVAX,
      ONETRIP,HOST,TARGET,MONERRS,CODECA,
      GLACA,DIAGCA,SSTCA,GSTCA,CONSTCA,SCALARCA,IOAREACA,ZGSTCA,STACKCA,
      W1,W2,W4,STATORDERMODE,CURSTATCLASS,LISTPOINT,STACKBASE,
      NEXTTRIAD,ASAVE,MAXSAVE,SUBTAB,LASTSUBTAB,
      INHIBOP4,ARGCNT,IDCNT,LABCNT,TMLIST,MAINPROG,PROCINDEX,CONSOLE)
!*
!***********************************************************************
!* record format for communicating with optimiser                      *
!***********************************************************************
!*
%recordformat OBJFMT(%string(35) MODULE,%integer MAINEP,I,J,K,
                     ADATE,ATIME,OPTIONS2,EXTPROCS,ATRIADS,MAXTRIADS,
                     ABLOCKS,MAXBLOCKS,ALOOP,MAXLOOP,ATABS,MAXTABS,
                     SRFLAGS,INHIBMASK,OPT,OPTFLAGS,OPTDESC0,OPTDESC1,
                     D1,D2,D3,D4)
!*
!***********************************************************************
!*
!*
%RECORDFORMAT SUBRECF(%INTEGER LINK,FLAGS,TRIADS,DICT,NAMES,PTRS,PROG,
      LABCNT,ARGCNT,IDCNT,TRCNT,REFSCNT,SUBSCNT,
      DPTR,NEXTTRIAD,NAMESFREE,NEXTBIT,SUBPROGTYPE,SUBPROGPTR,
      CBNPTR,SCPTR,CMNIIN,FUNRESDISP,CMNCNT,ASSGOTOS,VRETURN,ENTRIES,
      TMLIST,ALABS,ALHEADS,NEXTPLAB,
      %STRING(32) NAME,%INTEGERARRAY COORDS(0:15))
!*
%CONSTINTEGER SUBSIZE=232
%CONSTINTEGER LABSIZE=128
%CONSTINTEGER LHEADSIZE=620
!*
!*
{%INCLUDE "ftn_optspecs1"}
!*
!***********************************************************************
!* External data items                                                 *
!***********************************************************************
!*
%EXTRINSICINTEGER ADICT     ;! @ of dictionary area
%EXTRINSICINTEGER MAXDICT   ;! currect available length of dictionary
%EXTRINSICINTEGER ANAMES    ;! @ of name table
%EXTRINSICINTEGER ABLOCKS   ;! @ of block table
%EXTRINSICINTEGER MAXBLOCKS ;! current available length of block table area
%EXTRINSICINTEGER NEXTBLOCK ;! next available block index
%EXTRINSICINTEGER FREEBLOCKS
%EXTRINSICINTEGER CBNPTR    ;! listhead of common block records
%EXTRINSICINTEGER SCPTR     ;! listhead of local identifiers
%EXTRINSICINTEGER ATABS     ;! @ of area for assorted optimiser tables
%EXTRINSICINTEGER MAXTABS   ;! curent available length of opt table area
%EXTRINSICINTEGER FREETABS  ;! next free location in opt table area
%EXTRINSICINTEGER EXBPTR    ;! exit block table
%EXTRINSICINTEGER ENTBPTR   ;! entry block table
%EXTRINSICINTEGER ALOOPS    ;! @ loop table area
%EXTRINSICINTEGER MAXLOOPS  ;! current available length of loop table area
%EXTRINSICINTEGER FREELOOPS ;! next free location in loop table area
%EXTRINSICINTEGER ATRIADS   ;! @ of triad area
%EXTRINSICINTEGER LASTTRIAD ;! last allocated triad index
%EXTRINSICINTEGER MAXTRIADS ;! current available number of triads
%EXTRINSICINTEGER FREETRIADS;! listhead of released triads
%EXTRINSICINTEGER BLSIZE    ;! length (in architecture units) of a block entry
%EXTRINSICINTEGER BSBITS    ;! length (in bits) of bit string
%EXTRINSICINTEGER BSSIZE    ;! length (in architecture units) of a bit strip
%EXTRINSICINTEGER BSWORDS   ;! length in 2900 words of a bit strip
%EXTRINSICINTEGER OPT       ;! optimisation level 0, 1 or 2
%EXTRINSICINTEGER OPTFLAGS  ;! tracing level   1 Triads  2 Blocks  4 Loops 
%EXTRINSICINTEGER INHIBMASK ;! inhibits specific optimisations
%EXTRINSICINTEGER SRFLAGS   ;! strength reduction diagnostic flags
%EXTRINSICINTEGER SRHEAD
%EXTRINSICINTEGER SRCH
%EXTRINSICINTEGER APROPTABS ;! @ bsbits * prop table entries
%EXTRINSICINTEGER CLOOPHEAD ;! head of list of all blocks in current loop 
%EXTRINSICINTEGER PLOOPHEAD ;! subset of CLOOPHEAD list already processed
%EXTRINSICINTEGER DLOOPHEAD ;! CLOOPHEAD list - PLOOPHEAD list
%EXTRINSICINTEGER CLOOPTAIL
%EXTRINSICINTEGER PLOOPTAIL
%EXTRINSICINTEGER DLOOPTAIL
%EXTRINSICINTEGER DLOOPPTR  ;! current DLOOP record
%EXTRINSICINTEGER LOOP      ;! current pointer to looptab
%EXTRINSICINTEGER BACKTARG  ;! blocktab index of back target block
%EXTRINSICINTEGER BTARGTRIAD;! index of triad within back target block to which new triads chained
%EXTRINSICINTEGER OLDBTARGTRIAD
%EXTRINSICINTEGER LOOPDEPTH ;! depth of current loop
%EXTRINSICINTEGER LOOPENT   ;! blocktab index of loop entry block
%EXTRINSICINTEGER CURRBLK   ;! blocktab index of current block
%EXTRINSICINTEGER CURRTRIAD ;! triad index of triad currently being processed
%EXTRINSICINTEGER PREVTRIAD ;! previous triad (for rechaining)
%EXTRINSICINTEGER ACMNCOORDS;! @ CMNCOORDS
%EXTRINSICINTEGER ACURRDEF  ;! @ CURRDEF
%EXTRINSICINTEGER ASTFNDEF
%EXTRINSICINTEGER ARGRISK
%EXTRINSICINTEGER VALTEMPHEAD
%EXTRINSICINTEGER DESTEMPHEAD
%EXTRINSICINTEGER DTINDEX
%EXTRINSICINTEGER TEINDEX
%EXTRINSICINTEGER TECH
%EXTRINSICINTEGER DTCH
!*
%EXTRINSICINTEGERARRAY CMNCOORDS(0:15)   ;!
%EXTRINSICINTEGERARRAY CLOOPUSE(0:15)    ;!
%EXTRINSICINTEGERARRAY PLOOPUSE(0:15)    ;!
%EXTRINSICINTEGERARRAY DLOOPUSE(0:15)    ;!
%EXTRINSICINTEGERARRAY CLOOPDEF(0:15)    ;!
%EXTRINSICINTEGERARRAY PLOOPDEF(0:15)    ;!
%EXTRINSICINTEGERARRAY DLOOPDEF(0:15)    ;!
%EXTRINSICINTEGERARRAY CURRDEF(0:15)     ;!
%EXTRINSICINTEGERARRAY STFNDEF(0:15)
!*
!***********************************************************************
!* Service procedures                                                  *
!***********************************************************************
!*
%EXTERNALROUTINESPEC BLOCKSFULL  ;! to be called when block table exhausted
%EXTERNALROUTINESPEC TABSFULL    ;! to be called when opt table exhausted
%EXTERNALROUTINESPEC DICTFULL    ;! to be called when dictionary is full
%EXTERNALROUTINESPEC LOOPSFULL   ;! to be called when loop table is full
!*
%EXTERNALINTEGERFNSPEC GETTRIAD
%EXTERNALINTEGERFNSPEC ALLDEF(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC NEXTTRIAD
%EXTERNALINTEGERFNSPEC NEXTTR
%EXTERNALROUTINESPEC UPDATE CURRDEF
%EXTERNALROUTINESPEC DELUSE(%INTEGER INDEX)
%EXTERNALROUTINESPEC DELUSEX(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC LOOPCON1(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC LOOPCON2(%INTEGER INDEX)
%EXTERNALROUTINESPEC TREVERSE(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC BUSYONX(%INTEGER FROMORTO,BLOCK,IDPTR)
%EXTERNALROUTINESPEC SETCMNBITS(%INTEGER STRIPADDR)
%EXTERNALROUTINESPEC SETARGBITS(%INTEGER BLIND)
%EXTERNALROUTINESPEC SETBIT(%INTEGER STRIPADDR,INDEX)
%EXTERNALROUTINESPEC PUTBIT(%INTEGER STRIPADDR,INDEX,VAL)
%EXTERNALROUTINESPEC CLEARBIT(%INTEGER STRIPADDR,INDEX)
%EXTERNALROUTINESPEC GETBIT(%INTEGER STRIPADDR,INDEX,%INTEGERNAME VAL)
%EXTERNALINTEGERFNSPEC CONOUT(%RECORD(RESF) R)
%EXTERNALINTEGERFNSPEC CONIN(%INTEGER VAL)
%EXTERNALINTEGERFNSPEC CONOP(%RECORD(RESF) RL,%INTEGER OP,
                             %RECORD(RESF) RR,%RECORD(RESF)%NAME R)
%EXTERNALINTEGERFNSPEC CONVAL(%INTEGER CONST1,CONST2,OP,MODE)
%EXTERNALINTEGERFNSPEC CREATETAB(%INTEGER A)
%EXTERNALINTEGERFNSPEC CREATEDTAB(%INTEGER A)
%EXTERNALROUTINESPEC PRBLOCK(%INTEGER BL)
%EXTERNALROUTINESPEC PRBLTRIADS(%INTEGER BL)
%EXTERNALROUTINESPEC PRINTBS(%INTEGERARRAYNAME B)
%EXTERNALROUTINESPEC PUSHFREE(%INTEGER VAL,%INTEGERNAME LINK)
!*
!*
{%INCLUDE "ftn_optfmts1"}
!*
!***********************************************************************
!* Optimiser record formats                                            *
!***********************************************************************
!*
%RECORDFORMAT BLRECF(%BYTEINTEGER FLAGS,DEPTH,%SHORTINTEGER CHAIN,
                     %INTEGER FCON,
                     %INTEGER BCON,BDOM,BTARG,TEXT,
                     %INTEGER CORRUPT,BUB1,
                     %INTEGER USE,DEF,BOE)
!*
%RECORDFORMAT CONRECF((%INTEGER COUNT %OR %INTEGERARRAY BLOCK(0:1000)))
!*
%RECORDFORMAT LOOPRECF(%INTEGER BLOCK,DOWN,ACROSS,ST)
!*
%RECORDFORMAT CLOOPRECF(%INTEGER BLOCK,PDCHAIN,PDBACKCHAIN)
!*
%RECORDFORMAT PROPRECF(%SHORTINTEGER DEFCT,TEXT,DEFN,
                       %BYTEINTEGER FLAGS,COORD2,
                       %RECORD(RESF) REPL)
!*
%RECORDFORMAT SREDF(%SHORTINTEGER MODE,IDENT,LOOP,DUMP,INIT,
                    %BYTEINTEGER FLAGS,SPARE1,
                    %SHORTINTEGER USECT,SPARE2,
                    %INTEGER WEIGHT,
                    %INTEGER CHAIN,
                   (%SHORTINTEGERARRAY INCR(1:3),TEST(1:3),USE(1:1000) %C
                           %OR %SHORTINTEGERARRAY ALLREFS(1:1006)))
!*
!***********************************************************************
!* Constant definitions                                                *
!***********************************************************************
!*
%CONSTINTEGER USE            =  0 ;! variable usage
%CONSTINTEGER DEF            =  1 ;!
!*
%CONSTINTEGER TDUMP          =  1 ;! dump triads before optimiastion
%CONSTINTEGER BDUMP          =  2 ;! dump block tables
%CONSTINTEGER LDUMP          =  4 ;! dump loop tables
%CONSTINTEGER T1DUMP         =  8 ;! dump triads after OP1
%CONSTINTEGER T2DUMP         = 16 ;! dump triads after OP2
%CONSTINTEGER T3DUMP         = X'200' ;! dump triads after OP3
%CONSTINTEGER SDUMP          = 32 ;! give reconstructed source
%CONSTINTEGER S1DUMP         = X'800' ;! reconstructed source after OP1
%CONSTINTEGER S2DUMP         = X'1000' ;! reconstructed source after OP2
%CONSTINTEGER EDUMP          = 64 ;! dump elimination info
%CONSTINTEGER CDUMP          = X'80' ;! constant elimination
%CONSTINTEGER PDUMP          = X'100';! proptabs
%CONSTINTEGER SEOBDUMP       = X'400' ;! dump triads for block after SUBSEOB
%CONSTINTEGER SSDUMP         = X'2000' ;! trace path through SUBSUM
!*
%CONSTINTEGER INHIBSUBSUM  =  1
%CONSTINTEGER INHIBOP2A    =  2
%CONSTINTEGER INHIBEXPOPTS =  4
%CONSTINTEGER INHIBBMOVE   =  8
%CONSTINTEGER INHIBEXPELIM = 16
%CONSTINTEGER INHIBSTR = 32
!*
%CONSTINTEGER FUNCBIT        = X'80' ;! block contains a function call
%CONSTINTEGER RETBIT         = X'20' ;! block is a procedure return block
%CONSTINTEGER LEBIT          = X'10' ;! block is a loop entry block
%CONSTINTEGER ARTICBIT       = X'08' ;! block is an articulation block
!*
%CONSTINTEGER EBBIT          = X'08' ;! entry block marker in label table
!*
%CONSTINTEGER SOB            = X'80' ;! start of block marker in STMT triad
%CONSTINTEGER BMBIT          = x'80' ;! in TR_OP indicates it has been backward moved
%CONSTINTEGER BMBIT OFF      = x'7F' ;! mask for deleting BMBIT
%CONSTINTEGER BMBIT SHIFT    = 7
!*
%CONSTINTEGER TESTREPBIT     = 2
%CONSTINTEGER REVTESTBIT     = 1
%CONSTINTEGER BREGBIT        = 4
%CONSTINTEGER SCANDBIT       = 8
!*
%CONSTINTEGER SRTEMPBIT      = 1
%CONSTINTEGER ACTARGBIT      = 2
%CONSTINTEGER INITLOADBIT    = 4
!*
%CONSTINTEGER FROM           = 0 ;! param to BUSYONX
%CONSTINTEGER TO             = 1 ;! ditto
%CONSTINTEGER BUSY           = 1
%CONSTINTEGER NOT BUSY       = 0
!*
%CONSTBYTEINTEGERARRAY DEFTEST(0:116)=   %C
   0(7),1,0(4),1,0(38),5,0,1,0(11),3,4,0(3),6,0,2,0(44);! ASMT,ASGN,FUN,CALL,DARG
!*
!*
%RECORDFORMAT OPTDFMT(     %C
%INTEGER ADICT     ,{ @ of dictionary area}
%INTEGER MAXDICT   ,{ currect available length of dictionary}
%INTEGER ANAMES    ,{ @ of name table}
%INTEGER ABLOCKS   ,{ @ of block table}
%INTEGER MAXBLOCKS ,{ current available length of block table area}
%INTEGER NEXTBLOCK ,{ next available block index}
%INTEGER FREEBLOCKS,
%INTEGER CBNPTR    ,{ listhead of common block records}
%INTEGER SCPTR     ,{ listhead of local identifiers}
%INTEGER ATABS     ,{ @ of area for assorted optimiser tables}
%INTEGER MAXTABS   ,{ curent available length of opt table area}
%INTEGER FREETABS  ,{ next free location in opt table area}
%INTEGER EXBPTR    ,{ exit block table}
%INTEGER ENTBPTR   ,{ entry block table}
%INTEGER ALOOPS    ,{ @ loop table area}
%INTEGER MAXLOOPS  ,{ current available length of loop table area}
%INTEGER FREELOOPS ,{ next free location in loop table area}
%INTEGER ATRIADS   ,{ @ of triad area}
%INTEGER LASTTRIAD ,{ last allocated triad index}
%INTEGER MAXTRIADS ,{ current available number of triads}
%INTEGER FREETRIADS,{ listhead of released triads}
%INTEGER BLSIZE    ,{ length (in architecture units) of a block entry}
%INTEGER BSBITS    ,{ length (in bits) of bit string}
%INTEGER BSSIZE    ,{ length (in architecture units) of a bit strip}
%INTEGER BSWORDS   ,{ length in 2900 words of a bit strip}
%INTEGER OPT       ,{ optimisation level 0, 1 or 2}
%INTEGER OPTFLAGS  ,{ tracing level   1 Triads  2 Blocks  4 Loops }
%INTEGER INHIBMASK ,{ inhibits specific optimisations}
%INTEGER SRFLAGS   ,{ strength reduction diagnostic flags}
%INTEGER SRHEAD,
%INTEGER SRCH,
%INTEGER APROPTABS ,{ @ bsbits * prop table entries}
%INTEGER CLOOPHEAD ,{ head of list of all blocks in current loop }
%INTEGER PLOOPHEAD ,{ subset of CLOOPHEAD list already processed}
%INTEGER DLOOPHEAD ,{ CLOOPHEAD list - PLOOPHEAD list}
%INTEGER CLOOPTAIL,
%INTEGER PLOOPTAIL,
%INTEGER DLOOPTAIL,
%INTEGER DLOOPPTR  ,{ current DLOOP record}
%INTEGER LOOP      ,{ current pointer to looptab}
%INTEGER BACKTARG  ,{ blocktab index of back target block}
%INTEGER BTARGTRIAD,{ index of triad within back target block to which new triads chained}
%INTEGER OLDBTARGTRIAD,
%INTEGER LOOPDEPTH ,{ depth of current loop}
%INTEGER LOOPENT   ,{ blocktab index of loop entry block}
%INTEGER CURRBLK   ,{ blocktab index of current block}
%INTEGER CURRTRIAD ,{ triad index of triad currently being processed}
%INTEGER PREVTRIAD ,{ previous triad (for rechaining)}
%INTEGER ACMNCOORDS,{ @ CMNCOORDS}
%INTEGER ACURRDEF  ,{ @ CURRDEF}
%INTEGER ASTFNDEF,
%INTEGER ARGRISK,
%INTEGER VALTEMPHEAD,
%INTEGER DESTEMPHEAD,
%INTEGER DTINDEX,
%INTEGER TEINDEX,
%INTEGER TECH,
%INTEGER DTCH)
!*
!
{%INCLUDE "ftn_consts1"}
!* modified 23/09/86
!*
!*
%constinteger WSCALE = 2;! scale word address to byte address
%constinteger BSCALE = 0;! scaling factor for words to architectural units
%constinteger CSCALE = 0;! byte offset to architectural unit offset
%constinteger DSCALE = 2;! dict pointer scaling in RES records
!*
%constinteger W1 =  4 ;!  1 word  in architectural units
%constinteger W2 =  8 ;!  2 words in architectural units
%constinteger W3 = 12 ;!  3 words in architectural units
%constinteger W4 = 16 ;!  4 words in architectural units
!*
%constinteger TRIADLENGTH    = 12 ;! size of an individual triad
%constinteger BLRECSIZE      = 44 ;! size of a block table entry in architectural units
%constinteger LOOPRECSIZE    = 16 ;! size of a loop table entry
%constinteger PROPRECSIZE    = 12 ;! size of a propagation table entry
%constinteger CLOOPSZ        = 12 ;! size of cloop table entry
%constinteger FRSIZE         =  8 ;! size of freelist created by PUSHFREE
%constinteger TESZ           = 20
%constinteger DTSZ           = 20
%constinteger ARTICSZ        =  4
%constinteger CTSIZE         =  2 ;! used in OP3
%constinteger EXTNSIZE       =  4 ;! used in OP3
!*
!* following used in strength reduction
!*
%constinteger RDSZ           =  8
%constinteger RUSESZ         = 12
%constinteger RTESTSZ        =  4
%constinteger RDEFSZ         = 16
%constinteger USESZ          = 32
%constinteger SRUSESZ        =  2
%constinteger SRSCALE        =  4;! SR==RECORD(ABLOCKS + SRPTR<<SRSCALE)
%constinteger SRFIXED        = 36
!*
!*
%conststring(5) REG1="reg7"
%constinteger GLAOFFSET=32
%if target=ibm %thenstart
   %constinteger dvarea=7
%finishelsestart
   %constinteger DVAREA=2
%finish
!*
!***********************************************************************
!* Constants defining the size of DICT records                         *
!***********************************************************************
!*
   %constinteger IDRECSIZE    = 28;! size of dict entry reserved for a new identifier
   %constinteger CONRECSIZE   = 16
   %constinteger CNSTRECMIN   =  4
   %constinteger IMPDORECSIZE = 12;! size of DATA-implied-DO list item
   %constinteger LABRECSIZE   = 40
   %constinteger PLABRECSIZE  =  8;! N.B. this is a reduced size for compiler using Put interfaces
   %constinteger XREFSIZE     =  8
   %constinteger CMNRECEXT    = 16;! extra space on iden record for common block name
   %constinteger TMPRECSIZE   = 20
   %constinteger DVRECSIZE    = 28
   %constinteger TRIADSIZE    = 12
   %constinteger LBLKSIZE     = 520
!*
!*
!********************* TRIAD qualifiers ********************************
!*
%CONSTINTEGER NULL    = 0
%CONSTINTEGER LABID   = 1
%CONSTINTEGER PLABID  = 2
%CONSTINTEGER PROCID  = 3
%CONSTINTEGER STKLIT  = 4
%CONSTINTEGER GLALIT  = 5
%CONSTINTEGER SRTEMP  = 6
%CONSTINTEGER BREG    = 7
%CONSTINTEGER VALTEMP = 8
%CONSTINTEGER DESTEMP = 9
%CONSTINTEGER LSCALID =16
%CONSTINTEGER OSCALID =17
%CONSTINTEGER CSCALID =18
%CONSTINTEGER ASCALID =19
%CONSTINTEGER PSCALID =20
%CONSTINTEGER ARRID   =21
%CONSTINTEGER TMPID   =22
%CONSTINTEGER PERMID  =23
%CONSTINTEGER STFNID  =24
%CONSTINTEGER ITMPID  =22
%CONSTINTEGER RTMPID  =22
%CONSTINTEGER ETMPID  =22
%CONSTINTEGER TRIAD   =32
%CONSTINTEGER ARREL   =33
%CONSTINTEGER CHAREL  =34
%CONSTINTEGER CHVAL   =35
%CONSTINTEGER LIT     =64
%CONSTINTEGER NEGLIT  =65
%CONSTINTEGER CNSTID  =66
!*
!********************* TRIAD masks *************************************
!*
%CONSTINTEGER CONSTMASK=X'40'
%CONSTINTEGER IDMASK   =X'10'
%CONSTINTEGER TEXTMASK =X'20'
!*
!********************* other useful masks ******************************
!*
%CONSTINTEGER ARRAYBIT  = X'04'
%CONSTINTEGER CMNBIT    = X'02'
%CONSTINTEGER EQUIVBIT  = X'80'
!*
!********************* modes *******************************************
!*
%CONSTINTEGER INT2    = 0, INT4    = 1, INT8    = 2
%CONSTINTEGER REAL4   = 3, REAL8   = 4, REAL16  = 5
%CONSTINTEGER CMPLX8  = 6, CMPLX16 = 7, CMPLX32 = 8
%CONSTINTEGER LOG1    = 9, LOG2    =10, LOG4    =11
%CONSTINTEGER LOG8    =12, CHARMODE=13, HOLMODE =14
%CONSTINTEGER BYTE    =15, HEXCONST=16
!*
!********************* types *******************************************
!*
%CONSTINTEGER INTTYPE   = 1
%CONSTINTEGER REALTYPE  = 2
%CONSTINTEGER CMPLXTYPE = 3
%CONSTINTEGER LOGTYPE   = 4
%CONSTINTEGER CHARTYPE  = 5
!*
!********************* scaling factors *********************************
!*
!*
!********************* length of maximum source statement **************
!*
%CONSTINTEGER INPUT LIMIT = 1328
!*
!********************* mode to size/type *******************************
!*
%CONSTBYTEINTEGERARRAY MODETOST(0:15)=  %C
   X'41',X'51',X'61',X'52',X'62',X'72',
   X'53',X'63',X'73',X'34',X'44',X'54',X'64',5,0,X'31'
!*
!********************* mode to bytes etc. ******************************
!*
%CONSTBYTEINTEGERARRAY CSIZE(0:15)=  %c
   2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoBytes(0:15)=  %c
   2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoTempBytes(0:15)=  %c
   4,4,8,4,8,16,8,16,32,4,4,4,8,4,4,4
%CONSTBYTEINTEGERARRAY SETMODE(0:63)= %C
0(4),10,13,0(11),1,3,6,11,0(12),2,4,7,8,0(12),15,5,8,9,0(11)
!*
!********************** location of pseudo common record in dict *******
!*
%CONSTINTEGER PSEUDOCMN=20
!*
!********************** location of blank common record in dict ********
!*
%CONSTINTEGER BLCMPTR=96
!*
!********************** other useful consts ****************************
!*
%CONSTINTEGER NO  = 0
%CONSTINTEGER YES = 1
%CONSTINTEGER FULL= 2
!*
!********************** area identifiers *******************************
!*
%constinteger STACK   = 0
%CONSTINTEGER GLA     = 2
%CONSTINTEGER SST     = 4
%CONSTINTEGER GST     = 5
%CONSTINTEGER DIAGS   = 6
%if target=ibm %thenstart
   %constinteger scalars=7
%finishelsestart
   %CONSTINTEGER SCALARS = 2
%finish
%CONSTINTEGER IOAREA  = 8
%CONSTINTEGER ZEROGST = 9
%CONSTINTEGER CONSTS  =10
!*
!********************** system procedures ******************************
!*
%constinteger F77AUX   = 0
%constinteger F77STOP  = 1
%constinteger F77PAUSE = 2
%constinteger F77IOA   = 3
%constinteger F77IOB   = 4
%constinteger F77IOC   = 5
%constinteger F77IOD   = 6
%constinteger F77IOE   = 7
%constinteger F77IOF   = 8
%constinteger F77FILE  = 9
%constinteger IMPSTOP  =10
%constinteger F77RTERR =11
%constinteger F77IOAR  =12
%constinteger F77IOBR  =13
%constinteger F77IOG   =14
%constinteger F77CPSTR =15
%constinteger F77CONCAT=16
%constinteger F77INDEX =17
%constinteger FIBITS   =18
%constinteger FISHFTC  =19
%constinteger F77PCHECK=20
%constinteger F77IOH   =21
%constinteger F77IOI   =22
!***********************************************************************
!*
!*
{%INCLUDE "ftn_triadops1"}
!*
!*********************** TRIAD operator values *************************
!*
%constinteger ADD    = X'02'
%constinteger SUB    = X'03'
%constinteger MULT   = X'04'
%constinteger DIV    = X'05'
%constinteger NEG    = X'06'
%constinteger ASMT   = X'07'
%constinteger CVT    = X'08'
%constinteger ARR    = X'09'
%constinteger ARR1   = X'0A'
%constinteger BOP    = X'0B'
%constinteger ASGN   = X'0C'
%constinteger EXP    = X'0E'
%constinteger EXP3   = X'0F'
%constinteger AND    = X'10'
%constinteger OR     = X'11'
%constinteger NOT    = X'12'
%constinteger EQUIV  = X'13'
%constinteger NEQ    = X'14'
%constinteger GT     = X'15'
%constinteger LT     = X'16'
%constinteger NE     = X'17'
%constinteger EQ     = X'18'
%constinteger GE     = X'19'
%constinteger LE     = X'1A'
%constinteger SUBSTR = X'1B'
%constinteger CHAR   = X'1C'
%constinteger CONCAT = X'1D'
%constinteger CHHEAD = X'1E'
%constinteger STOD1  = X'20'
%constinteger STOD2  = X'21'
%constinteger EOD1   = X'24'
%constinteger EOD2   = X'25'
%constinteger BRK    = X'28'
%constinteger DARR   = X'29'
%constinteger DEFARR = X'29'
%constinteger RRSUB  = X'2A'
%constinteger RRDIV  = X'2B'
%constinteger DCHAR  = X'2C'
%constinteger ASH    = X'2D'
%constinteger STRTIO = X'30'
%constinteger IOITEM = X'31'
%constinteger IODO   = X'32'
%constinteger IOSPEC = X'33'
%constinteger IO     = X'34'
%constinteger ENDIO  = X'34'
%constinteger DIOITEM= X'35'
%constinteger SUBS   = X'38'
%constinteger ARGARR = X'39'
%constinteger INIT   = X'3A'
%constinteger INCR   = X'3B'
%constinteger DECR   = X'3C'
%constinteger DINIT  = X'3D'
%constinteger PINCR  = X'3E'
%constinteger NOOP   = X'40'
%constinteger FUN    = X'41'
%constinteger SUBR   = X'42'
%constinteger ARG    = X'43'
%constinteger STRTSF = X'44'
%constinteger ENDSF  = X'45'
%constinteger CALLSF = X'46'
%constinteger IFUN   = X'47'
%constinteger DARG   = X'48'
%constinteger IARG   = X'49'
%constinteger REPL   = X'4A'
%constinteger REF    = X'4B'
%constinteger LOADB  = X'4C'
%constinteger STOREB = X'4D'
%constinteger MOO    = X'4E'
%constinteger JIT    = X'50'
%constinteger JIF    = X'51'
%constinteger JINN   = X'52'
%constinteger JINP   = X'53'
%constinteger JINZ   = X'54'
%constinteger JIN    = X'55'
%constinteger JIP    = X'56'
%constinteger JIZ    = X'57'
%constinteger CGT    = X'58'
%constinteger GOTO   = X'59'
%constinteger RET    = X'5A'
%constinteger STOP   = X'5B'
%constinteger PAUSE  = X'5C'
%constinteger EOT    = X'5D'
%constinteger NINT   = X'5E'
%constinteger ANINT  = X'5F'
%constinteger STMT   = X'60'
%constinteger ITS    = X'61'
%constinteger PA     = X'62'
%constinteger TOCHAR = X'63'
%constinteger DIM    = X'64'
%constinteger DMULT  = X'65'
%constinteger AINT   = X'66'
%constinteger ABS    = X'67'
%constinteger MOD    = X'68'
%constinteger SIGN   = X'69'
%constinteger MIN    = X'6A'
%constinteger MAX    = X'6B'
%constinteger REALL  = X'6C'
%constinteger IMAG   = X'6D'
%constinteger CMPLX  = X'6E'
%constinteger CONJG  = X'6F'
%constinteger LEN    = X'70'
%constinteger ICHAR  = X'71'
%constinteger CHIND  = X'72'
%constinteger DCMPLX = X'73'
%constinteger INTRIN = X'74'
!*
!*
{%INCLUDE "ftn_copy1"}
!* modified 23/09/86
!*
%constINTEGER 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
      OK=CONOP(RNULL,NEG,CTR_RES2,RES); ! NEGATE THE CONST.
      %IF OK#0 %THEN %RETURN
      DELUSEX(CTR_OPD1); ! DECREMENT USE OF NEG TRIAD
      CTR_RES1=TROPD1_RES1
      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