! 08.07.85 - line 646 of LOOPBUILD, map on to current CL block
!          - line 810 of LOOPBUILD, map on to next AR block
! 11/10/84 - clear relevant bit in CLOOPDEF if ASMT/ASGN triad backward moved
!          - line 1342 corrected to VAL1: line 1316 moved back 7 lines
! 21/06/84 - change OPSTAB(CMPLX) ENTRY TO X'06'
{04/01/84 suspend backmove of character comparisons}
{21/11/83 correct tracing in BREAKOUT}
{04/10/83  insert backward movement tracing; call TREVERSE in SWAP to clear bug D15}
{24/05/83  suppress backmove of TOCHAR}
{28/04/83  correct cycle limit (BSWORDS-1) in OP2A}{09/02/83  suppress BACKMOVE of ASGN, DEFARR if LOOPCON1 = 0}
{24/01/83  ensure no code after column 80}
{19/01/83  mask top bit in _FCON}
{13/01/83  test for IFUN in OP2A}
{06/01/83  correct ATABS mappings in BMOVCHECK}
{30/12/82  update triads for intrinsics}
{20/12/82  FUN triad param chaining corrected}
{13/12/82  include BACKMOVE }
{29/11/82  perform optimisations unless inhibited by bit settings in INHIBMASK}
!*
!%INCLUDE "ERCS06.OPT_SPECS"
!*
!***********************************************************************
!* 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)
!*
!***********************************************************************
!* Formats for accessing dictionary records                            *
!***********************************************************************
!*
%RECORDFORMAT PRECF(%BYTEINTEGER CLASS,TYPE,X0,X1,
                    %INTEGER LINK1, LINK2,
                   (%HALFINTEGER COORD,CMNBLK %OR %INTEGER LAST   %C
                        %OR %INTEGER CONSTRES %OR %INTEGER INF3),
                    %INTEGER ADDR4,
                    %HALFINTEGER DISP,LEN,IDEN,IIN,
                    %INTEGER LINE,XREF,CMNLENGTH,CMNREFAD)
!*
%RECORDFORMAT TMPF((%BYTEINTEGER CLASS,TYPE,X0,X1 %OR %INTEGER W0),
                    %INTEGER LINK1,
                    %BYTEINTEGER REG,MODE,%HALFINTEGER INDEX,
                    %HALFINTEGER COORD,USECNT,
                    %INTEGER ADDR)
!*
%RECORDFORMAT SRECF(%INTEGER INF0, LINK1, INF2, INF3, INF4)
!*
%RECORDFORMAT RESF((%INTEGER W %OR %HALFINTEGER H0,
                      (%HALFINTEGER H1 %OR %BYTEINTEGER FORM,MODE)))
!*
%RECORDFORMAT LABRECF(%HALFINTEGER BLKIND,%BYTEINTEGER X0,X1,  %C
            %INTEGER LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE,  %C
            %HALFINTEGER DOSTART,DOEND,IFSTART,IFEND)
!*
%RECORDFORMAT PLABF(%HALFINTEGER BLKIND,%BYTEINTEGER X0,X1,
                    %INTEGER INDEX,CODEAD,REF,REFCHAIN)
!*
%RECORDFORMAT CONSTRECF(%INTEGER MODE,LINK1,DADDR,CADDR)
!*
%RECORDFORMAT TERECF(%HALFINTEGER MODE,LOOP,
                      %INTEGER CHAIN,DISP1,INDEX,
                      %HALFINTEGER COORD,FLAGS)
!*
%RECORDFORMAT DTRECF(%HALFINTEGER MODE,IDENT,
                      %INTEGER CHAIN,DISP2,
                      %HALFINTEGER FLAGS,INDEX,
                     (%INTEGER LOOP %OR %RECORD(RESF) CONST))
!*
!*
!***********************************************************************
!* 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)
!*
!***********************************************************************
!* TRIAD record format                                                 *
!***********************************************************************
!*
%RECORDFORMAT TRIADF(  %C
               %BYTEINTEGER OP,
               (%BYTEINTEGER USE %OR %BYTEINTEGER VAL2),
               %HALFINTEGER CHAIN,
               (%RECORD(RESF) RES1      %OR     %C
               (%HALFINTEGER OPD1,%BYTEINTEGER QOPD1,MODE  %OR  %C
               (%INTEGER SLN %OR %INTEGER VAL1))),
               (%RECORD(RESF) RES2      %OR   %C
                %HALFINTEGER OPD2,%BYTEINTEGER QOPD2,MODE2))
!*
!********************* 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 TRIAD   =32
%CONSTINTEGER ARREL   =33
%CONSTINTEGER CHAREL  =34
%CONSTINTEGER CHVAL   =35
%CONSTINTEGER LIT     =64
%CONSTINTEGER NEGLIT  =65
%CONSTINTEGER CNSTID  =66
!*
%CONSTINTEGER CONSTMASK=X'40'
%CONSTINTEGER IDMASK   =X'10'
%CONSTINTEGER TEXTMASK =X'20'
!*
!********************* MODES ****************************************
!*
%CONSTINTEGER INT2    = 0, INT4    = 1, INT8    = 2
%CONSTINTEGER REAL4   = 3, REAL8   = 4, REAL16  = 5
%CONSTINTEGER CMPLX8  = 6, CMPLX16 = 7, CMPLX32 = 8
%CONSTINTEGER LOG1    =13, LOG4    = 9, LOG8    =14
%CONSTINTEGER CHARMODE=10, HOLMODE =11
!*
!********************* TYPES **************************************
!*
%CONSTINTEGER INTTYPE   = 1
%CONSTINTEGER REALTYPE  = 2
%CONSTINTEGER CMPLXTYPE = 3
%CONSTINTEGER LOGTYPE   = 4
%CONSTINTEGER CHARTYPE  = 5
!*
%CONSTINTEGER ARRAYBIT  = X'04'
%CONSTINTEGER CMNBIT    = X'02'
%CONSTINTEGER EQUIVBIT  = X'80'
!*
!*
!***********************************************************************
!* Optimiser record formats                                            *
!***********************************************************************
!*
%RECORDFORMAT BLRECF(%BYTEINTEGER FLAGS,DEPTH,%HALFINTEGER 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(%HALFINTEGER DEFCT,TEXT,DEFN,
                       %BYTEINTEGER FLAGS,COORD2,
                       %RECORD(RESF) REPL)
!*
%RECORDFORMAT SREDF(%HALFINTEGER MODE,IDENT,LOOP,DUMP,INIT,
                    %BYTEINTEGER FLAGS,USECT,
                    %INTEGER WEIGHT,
                    %INTEGER CHAIN,
                   (%HALFINTEGERARRAY INCR(1:3),TEST(1:3),USE(1:1000) %C
                           %OR %HALFINTEGERARRAY ALLREFS(1:1006)))
!*
!***********************************************************************
!* Constant definitions                                                *
!***********************************************************************
!*
%CONSTINTEGER DSCALE         =  2 ;! scaling factor for dict entries in triads 2 2900  0 PERQ
%CONSTINTEGER BSCALE         =  2 ;! scaling factor for words to 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 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 SRSCALE        = 2;! SR==RECORD(ABLOCKS + SRPTR<<SRSCALE)
%CONSTINTEGER SRUSESZ        = 2
%CONSTINTEGER SRFIXED        = 32
%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:114)=   %C
   0(7),1,0(4),1,0(38),5,0,1,0(11),3,4,0(3),6,0,2,0(42);! ASMT,ASGN,FUN,CALL,DARG
!*
!%INCLUDE "ERCS06.PERQ_TRIADOPS"
!***********************************************************************
!*
!*
!*********************** 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 STODA  = X'22'
%CONSTINTEGER EOD1   = X'24'
%CONSTINTEGER EOD2   = X'25'
%CONSTINTEGER EODA   = X'26'
%CONSTINTEGER EODB   = X'27'
%CONSTINTEGER BRK    = X'28'
%CONSTINTEGER DARR   = X'29'
%CONSTINTEGER DEFARR = X'29'
%CONSTINTEGER RSUB   = X'2A'
%CONSTINTEGER RDIV   = 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 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'
!*
!
%EXTERNALROUTINESPEC PRINTTR(%INTEGER INDEX,ADICT,ANAMES,LEVEL,
      %RECORD(TRIADF)%NAME TRIAD)

%ROUTINESPEC BACKMOVE
!
!
%EXTERNALROUTINE OP2
!
!
%EXTERNALROUTINESPEC GLOBSUBS
%EXTERNALROUTINESPEC SUBSUM
%EXTERNALROUTINESPEC SUBSEOB
%EXTERNALROUTINESPEC EXPELIM
%EXTERNALROUTINESPEC CONELIM
%EXTERNALROUTINESPEC OPTDIV
%EXTERNALROUTINESPEC OPTNEG
%EXTERNALROUTINESPEC OPTCVT
%EXTERNALROUTINESPEC OPTFUN
%EXTERNALROUTINESPEC OPTEXP
%EXTERNALROUTINESPEC FACTORISE
%EXTERNALROUTINESPEC LINEARISE
%EXTERNALROUTINESPEC EXPELBTARG
%EXTERNALROUTINESPEC FLOWOFCONT
%EXTERNALROUTINESPEC STRENGTHRED
!
%ROUTINESPEC OP2A
%ROUTINESPEC LOOPSEL (%INTEGER L)
%ROUTINESPEC LOOPBUILD
!
%RECORDFORMAT ARTICF (%INTEGER BLOCK)
%CONSTINTEGER ARTICSZ = 4
%INTEGERARRAYFORMAT TABF (0:1000)
%INTEGERARRAYFORMAT BF (0:15)
%INTEGERARRAYFORMAT BS (0:1000)
%INTEGERARRAYNAME B1,B2,BLKBS,ENTBTAB
%RECORD (BLRECF) %NAME BB
%RECORD (LOOPRECF) %NAME LL
%RECORD (CLOOPRECF) %NAME CL
%RECORD (TRIADF) %NAME TT
%RECORD (ARTICF) %NAME AR
%RECORD (CONRECF) %NAME CN
!
%INTEGER PLOOPCH,DLOOPCH
%INTEGER I,J,NEWENT,BLOCK
%INTEGER BLKBSLENGTH,SAVEPTR,BLKBITS,BIT
!
!
!********************************************************************
!* FOR EACH PROGRAM LOOP IN TURN, BUILD UP ALL NECESSARY DATA &     *
!*   TABLES, AND THEN CALL ALL THE VARIOUS OPTIMISATION PROCESSES.  *
!********************************************************************
!
!
      BLKBSLENGTH = (NEXTBLOCK + 31) >> 5
      FREEBLOCKS = (NEXTBLOCK + 1) * BLSIZE
      SRHEAD = 0
      SRCH = ADDR (SRHEAD)
      FREETABS = (FREETABS + 3) & X'FFFFFFFC'
      BLKBITS = CREATETAB (BLKBSLENGTH << 2) + ATABS
      BLKBS == ARRAY (BLKBITS,BS)
      %IF INHIBMASK & INHIBSUBSUM = 0 %THEN GLOBSUBS
!
      LOOPSEL (0) %UNLESS FREELOOPS = 0
!
      LOOP = X'FFFF' 
      LOOPDEPTH = 0
      BACKTARG = 0
      BTARGTRIAD = 0
      OLDBTARGTRIAD = 0
      %FOR I = 0,1,BSWORDS-1 %CYCLE
         DLOOPUSE(I) = 0
         DLOOPDEF(I) = 0
      %REPEAT
      SAVEPTR = FREETABS
      PLOOPCH = ADDR (PLOOPHEAD)
      DLOOPCH = ADDR (DLOOPHEAD)
      PLOOPHEAD = 0
      DLOOPHEAD = 0
      PLOOPTAIL = 0
      DLOOPTAIL = 0
      BLKBS(I) = 0 %FOR I = 0,1,BLKBSLENGTH-1
      ENTBTAB == ARRAY (ATABS + ENTBPTR,TABF)
      %FOR J = 1,1,ENTBTAB(0) %CYCLE
         NEWENT = CREATETAB (CLOOPSZ)
         BLOCK = ENTBTAB(J)
         CL == RECORD (ATABS + NEWENT)
         CL_BLOCK = BLOCK
         BB == RECORD (ABLOCKS+ BLOCK*BLSIZE)
         B1 == ARRAY (BB_USE,BF)
         B2 == ARRAY (BB_DEF,BF)
         %FOR I = 0,1,BSWORDS-1 %CYCLE
            DLOOPUSE(I) = DLOOPUSE(I) ! B1(I)
            DLOOPDEF(I) = DLOOPDEF(I) ! B2(I)
         %REPEAT
         SETBIT (BLKBITS,BLOCK)
         INTEGER (DLOOPCH) = NEWENT
         DLOOPCH = ADDR (CL_PDCHAIN)
         CL_PDCHAIN = 0
         CL_PDBACKCHAIN = DLOOPTAIL
         DLOOPTAIL = NEWENT
      %REPEAT 
      CLOOPHEAD = DLOOPHEAD
!
      %IF CLOOPHEAD#0 %THEN LOOPBUILD
!
!     CODE NEEDED HERE TO OPTIMISE COPYING OF ARGUMENTS IN PROLOGUES
!                     & EPILOGUES
!
!
!
!
%ROUTINE LOOPSEL (%INTEGER L)
!
!***********************************************************************
!* OBTAIN NEXT LOOP TO BE OPTIMISED FROM LOOPTAB                       *
!* AND CALL LOOPBUILD TO BUILD THE NECESSARY TABLES.                   *
!* RECURSIVE ROUTINE, SO AS TO PRESENT DEEPEST LOOPS FIRST.            *
!***********************************************************************
!
%INTEGER DOWN,LOOPPTR
!
      LOOPPTR = L
      %CYCLE
         LL == RECORD (ALOOPS + LOOPPTR)
         DOWN = LL_DOWN
         %UNLESS DOWN = 0 %THENSTART
            LOOPSEL (DOWN)
            LL == RECORD (ALOOPS + LOOPPTR)
         %FINISH
         SAVEPTR = FREETABS
         LOOP = LOOPPTR
         NEWENT = CREATETAB (CLOOPSZ)
         CL == RECORD (ATABS + NEWENT)
         LOOPENT = LL_BLOCK
         CL_BLOCK = LOOPENT
         CL_PDCHAIN = 0
         CL_PDBACKCHAIN = 0
         CLOOPHEAD = NEWENT
         DLOOPHEAD = NEWENT
         PLOOPHEAD = 0
         DLOOPTAIL = NEWENT
         PLOOPTAIL = 0
         DLOOPCH = ADDR (CL_PDCHAIN)
         PLOOPCH = ADDR (PLOOPHEAD)
         BLKBS(I) = 0 %FOR I = 0,1,BLKBSLENGTH-1
         SETBIT (BLKBITS,LOOPENT)
         BB == RECORD (ABLOCKS + LOOPENT*BLSIZE)
         LOOPDEPTH = BB_DEPTH
         BACKTARG = BB_BTARG
         B1 == ARRAY (BB_USE,BF)
         B2 == ARRAY (BB_DEF,BF)
         %FOR I = 0,1,BSWORDS-1 %CYCLE
            DLOOPUSE(I) = B1(I)
            DLOOPDEF(I) = B2(I)
         %REPEAT
         BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
         OLDBTARGTRIAD = BB_TEXT
!
         LOOPBUILD
!
         LOOPPTR = LL_ACROSS
      %REPEAT %UNTIL LOOPPTR = 0
%END;! LOOPSEL
!
!
!
!
%ROUTINE LOOPBUILD
!
!*******************************************************************
!* BUILD CLOOPTAB & ASSOCIATED BIT STRIPS.                         *
!* IDENTIFY ARTICULATION BLOCKS.                                   *
!* CALL OP2A & OP2B.                                               *
!*******************************************************************
!
%INTEGER EXITCT,EXITBLK,I,J
%INTEGER FCON,CLOOPPTR,LEB
%INTEGER STACKPTR,TABSTART,TABLEEND,TAB2PTR,TABLE2
%INTEGER ARTI,ARTJ,ARTK
!
      %FOR I = 0,1,BSWORDS-1 %CYCLE
         PLOOPUSE(I) = 0
         PLOOPDEF(I) = 0
      %REPEAT
      EXITCT = 0
      EXITBLK = 0
      CLOOPPTR = CLOOPHEAD
!* ADD INTO CLOOP ALL FCONS OF ALL CLOOP ENTRIES, PROVIDED INSIDE THE LOOP,
!*   AND NOT ALREADY IN CLOOP.
      %WHILE CLOOPPTR < FREETABS %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         BB == RECORD (ABLOCKS + CL_BLOCK*BLSIZE)
         FCON = BB_FCON&X'7FFFFFFF'
         %UNLESS FCON = 0 %THENSTART
            CN == RECORD (ATABS + FCON)
            %FOR J = 1,1,CN_COUNT %CYCLE
               CL==RECORD(ATABS+CLOOPPTR)
               BLOCK = CN_BLOCK(J)
               %UNLESS BLOCK = 0 %THENSTART
                  BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
                  %IF BB_DEPTH < LOOPDEPTH %THENSTART
                     EXITCT = EXITCT + 1
                     EXITBLK = CL_BLOCK
                  %FINISHELSESTART
!* USE BITSTRIP TO TEST WHETHER THIS BLOCK ALREADY IN CLOOP.
                     GETBIT (BLKBITS,BLOCK,BIT)
                     %IF BIT = 0 %THENSTART
                        SETBIT (BLKBITS,BLOCK)
                        NEWENT = CREATETAB (CLOOPSZ)
                        CL == RECORD (ATABS + NEWENT)
                        CL_BLOCK = BLOCK
                        CL_PDCHAIN = 0
                        B1 == ARRAY (BB_USE,BF)
                        B2 == ARRAY (BB_DEF,BF)
                        %IF BB_DEPTH = LOOPDEPTH %THENSTART
                           INTEGER (DLOOPCH) = NEWENT
                           DLOOPCH = ADDR (CL_PDCHAIN)
                           CL_PDBACKCHAIN = DLOOPTAIL
                           DLOOPTAIL = NEWENT
                           %FOR I = 0,1,BSWORDS-1 %CYCLE
                              DLOOPUSE(I) = DLOOPUSE(I) ! B1(I)
                              DLOOPDEF(I) = DLOOPDEF(I) ! B2(I)
                           %REPEAT
                        %FINISHELSESTART
                           INTEGER (PLOOPCH) = NEWENT
                           PLOOPCH = ADDR (CL_PDCHAIN)
                           CL_PDBACKCHAIN = PLOOPTAIL
                           PLOOPTAIL = NEWENT
                           %FOR I = 0,1,BSWORDS-1 %CYCLE
                              PLOOPUSE(I) = PLOOPUSE(I) ! B1(I)
                              PLOOPDEF(I) = PLOOPDEF(I) ! B2(I)
                           %REPEAT
                        %FINISH
                     %FINISH
                  %FINISH
               %FINISH
            %REPEAT
         %FINISH
         CLOOPPTR = CLOOPPTR + CLOOPSZ
      %REPEAT
      CLOOPTAIL = FREETABS - CLOOPSZ
      %FOR I = 0,1,BSWORDS-1 %CYCLE
         CLOOPUSE(I) = DLOOPUSE(I) ! PLOOPUSE(I)
         CLOOPDEF(I) = DLOOPDEF(I) ! PLOOPDEF(I)
      %REPEAT
!*************************************************************
!* IDENTIFY & FLAG ARTICULATION BLOCKS.                      *
!*************************************************************
!* STACK ALL BACK CONNECTIONS (INSIDE LOOP) OF LOOP ENTRY BLOCK.
      %UNLESS BACKTARG = 0 %THENSTART
         TABSTART = FREETABS
         LL == RECORD (ALOOPS + LOOP)
         LEB = LL_BLOCK
         BB == RECORD (ABLOCKS + LEB*BLSIZE)
         CN == RECORD (ATABS + BB_BCON)
         NEWENT = CREATETAB (ARTICSZ)
         AR == RECORD (ATABS + NEWENT)
         AR_BLOCK = 0
         %FOR I = 1,1,CN_COUNT %CYCLE
            BLOCK = CN_BLOCK(I)
            BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
            %UNLESS BB_DEPTH < LOOPDEPTH %THENSTART
               NEWENT = CREATETAB (ARTICSZ)
               AR == RECORD (ATABS + NEWENT)
               AR_BLOCK = BLOCK
            %FINISH
         %REPEAT
         STACKPTR = NEWENT - ARTICSZ
         BLOCK = AR_BLOCK
         TABLE2 = FREETABS
         %IF STACKPTR = TABSTART %THEN ARTI = BLOCK %ELSESTART
!* IF MORE THAN ONE BACK CONNECTION, FIND THE COMMON NODE.
!* BUILD BACK DOMINATOR CHAIN OF ONE OF BACK CONNECTIONS.
            NEWENT = CREATETAB (ARTICSZ)
            AR == RECORD (ATABS + NEWENT)
            AR_BLOCK = BLOCK
            %WHILE BLOCK # LEB %CYCLE
               BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
               BLOCK = BB_BDOM
               NEWENT = CREATETAB (ARTICSZ)
               AR_BLOCK = BLOCK
            %REPEAT
            TABLEEND = FREETABS
            ARTK = TABLE2
            %WHILE STACKPTR # TABSTART %CYCLE
               AR == RECORD (ATABS + STACKPTR)
               STACKPTR = STACKPTR - ARTICSZ
               ARTI = AR_BLOCK
               %CYCLE
                  TAB2PTR = ARTK
                  %WHILE TAB2PTR # TABLEEND %CYCLE
                     AR == RECORD (ATABS + TAB2PTR)
                     -> L1 %IF AR_BLOCK = ARTI                                  
                     TAB2PTR = TAB2PTR + ARTICSZ
                  %REPEAT
                  BB == RECORD (ABLOCKS + ARTI*BLSIZE)
                  ARTI = BB_BDOM
               %REPEAT
         L1:   ARTK = TAB2PTR
            %REPEAT
         %FINISH
!* ARTI IS NOW COMMON DOMINATOR.
!* NOW BUILD STACK OF DOMINATOR BLOCKS WHICH ARE ARTICULATION CANDIDATES.
         FREETABS = TABSTART + ARTICSZ
         %WHILE ARTI # LEB %CYCLE
            BB == RECORD (ABLOCKS + ARTI*BLSIZE)
            %UNLESS BB_DEPTH > LOOPDEPTH %THENSTART
               NEWENT = CREATETAB (ARTICSZ)
               AR == RECORD (ATABS +NEWENT)
               AR_BLOCK = ARTI
               ARTI = BB_BDOM
            %FINISHELSE ARTI = BB_BTARG
         %REPEAT
         STACKPTR = FREETABS - ARTICSZ
         TABLE2 = FREETABS
         AR == RECORD (ATABS + TABSTART + ARTICSZ)
!* TEST FOR NORMAL LOOP, I.E. ONLY ONE EXIT.
         %IF EXITCT = 1 %AND EXITBLK = AR_BLOCK %THENSTART                          
            BB == RECORD (ABLOCKS + LEB*BLSIZE)
            BB_FLAGS = BB_FLAGS ! ARTICBIT
            STACKPTR = TABSTART + ARTICSZ
            %WHILE STACKPTR # FREETABS %CYCLE
               AR == RECORD (ATABS + STACKPTR)
               BB == RECORD (ABLOCKS + AR_BLOCK*BLSIZE)
               BB_FLAGS = BB_FLAGS ! ARTICBIT
               STACKPTR = STACKPTR + ARTICSZ
            %REPEAT 
         %FINISHELSESTART
            %CYCLE
               BB == RECORD (ABLOCKS + ARTI*BLSIZE)
               BB_FLAGS = BB_FLAGS ! ARTICBIT
               FREETABS = TABLE2
               %EXIT %IF STACKPTR = TABSTART
               AR == RECORD (ATABS + STACKPTR)
               STACKPTR = STACKPTR - ARTICSZ
               ARTJ = AR_BLOCK
               NEWENT = CREATETAB (ARTICSZ*2)
               AR == RECORD (ATABS + NEWENT)
               AR_BLOCK = ARTJ
               ARTK = NEWENT + ARTICSZ
               AR == RECORD (ATABS + ARTK)
               AR_BLOCK = ARTI
               %CYCLE
                  BLOCK = AR_BLOCK
                  BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
                  -> L4 %IF BB_DEPTH < LOOPDEPTH
                  CN == RECORD (ATABS + BB_FCON)
!* ADD ALL FCONS TO TABLE, UNLESS ALREADY THERE.
                  %FOR I = 1,1,CN_COUNT %CYCLE
                     FCON = CN_BLOCK(I)
                     TAB2PTR = TABLE2
                     %CYCLE
                        AR == RECORD (ATABS + TAB2PTR)
                        -> L3 %IF AR_BLOCK = FCON
                        TAB2PTR = TAB2PTR + ARTICSZ
                     %REPEAT %UNTIL TAB2PTR = FREETABS
                     NEWENT = CREATETAB (ARTICSZ)
                     AR == RECORD (ATABS + NEWENT)
                     AR_BLOCK = FCON
            L3:   %REPEAT
                  ARTK = ARTK + ARTICSZ
                  AR == RECORD(ATABS+ARTK)
               %REPEAT %UNTIL ARTK = FREETABS
               ARTI = ARTJ
            %REPEAT
         %FINISH
   L4:   FREETABS = TABSTART
      %FINISH
!
!* DIAGNOSTICS FOR EACH LOOP IDENTIFIED.
      %IF OPTFLAGS & LDUMP # 0 %THENSTART
         NEWLINE
         PRINTSTRING ("LOOPDATA BEFORE OP2A")
         NEWLINE
         NEWLINE
         PRINTSTRING ("CLOOP (* = ARTIC): ")
         %FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            BLOCK = CL_BLOCK
            WRITE (BLOCK,4)
            BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
            PRINTSTRING ("*") %IF BB_FLAGS & ARTICBIT # 0
         %REPEAT
         NEWLINE
         PRINTSTRING ("DLOOP: ")
         CLOOPPTR = DLOOPHEAD
         %WHILE CLOOPPTR # 0 %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            WRITE (CL_BLOCK,4)
            CLOOPPTR = CL_PDCHAIN
         %REPEAT
         NEWLINE
         PRINTSTRING ("PLOOP: ")
         CLOOPPTR = PLOOPHEAD
         %WHILE CLOOPPTR # 0 %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            WRITE (CL_BLOCK,4)
            CLOOPPTR = CL_PDCHAIN
         %REPEAT
         NEWLINE
         PRINTSTRING ("LOOP= ")
         WRITE (LOOP,3)
         PRINTSTRING (" BACKTARG= ")
         WRITE (BACKTARG,3)
         PRINTSTRING (" LOOPDEPTH= ")
         WRITE (LOOPDEPTH,2)
         PRINTSTRING (" LOOPENT= ")
         WRITE (LOOPENT,3)
         NEWLINE
         PRINTSTRING ("CLOOPUSE: ")
         PRINTBS (CLOOPUSE)
         PRINTSTRING ("CLOOPDEF: ")
         PRINTBS (CLOOPDEF)
      %FINISH
!
      %IF INHIBMASK & INHIBOP2A = 0 %THEN OP2A
!
!* MORE LOOP-LEVEL DIAGNOSTICS.
      %IF OPTFLAGS & LDUMP # 0 %THENSTART
         NEWLINE
         NEWLINE
         PRINTSTRING ("BACK TARGET & CLOOP BLOCKS AFTER OP2A")
         NEWLINE
         NEWLINE
         %UNLESS BACKTARG = 0 %THENSTART
            PRBLOCK (BACKTARG)
            PRBLTRIADS (BACKTARG)
         %FINISH
         %FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            PRBLOCK (CL_BLOCK)
            PRBLTRIADS (CL_BLOCK)
         %REPEAT
      %FINISH
!
      %UNLESS BACKTARG = 0 %THENSTART
!
         STRENGTHRED
!
!* AND YET MORE LOOP-LEVEL DIAGNOSTICS.
         %IF SRFLAGS & 4 # 0 %THENSTART
            NEWLINE
            NEWLINE
            PRINTSTRING (" BACK TARGET & CLOOP BLOCKS AFTER OP2B")
            NEWLINE
            NEWLINE
            PRBLOCK (BACKTARG)
            PRBLTRIADS (BACKTARG)
            %FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
               CL == RECORD (ATABS + CLOOPPTR)
               PRBLOCK (CL_BLOCK)
               PRBLTRIADS (CL_BLOCK)
            %REPEAT
         %FINISH
      %FINISH
!
      FREETABS = SAVEPTR;!   DELETE ALL OP2 TABLES.
!
%END;! LOOPBUILD
!
!
!
!
%ROUTINE OP2A
!
!****************************************************************
!* HAVING BUILT UP ALL THE DATA FOR A LOOP, INVOKE THE VARIOUS  *
!*   OPTIMISATION PROCESSES IN OP2A.                            *
!****************************************************************
!
%INTEGER OP,I,NEXT,STOB
!
%RECORD (PRECF) %NAME DD
!
      DLOOPPTR = DLOOPHEAD
      %CYCLE
         CL == RECORD (ATABS + DLOOPPTR)
         CURRBLK = CL_BLOCK
         %UNLESS OLDBTARGTRIAD = 0 %THENSTART
            NEXT = OLDBTARGTRIAD
            TT == RECORD (ATRIADS + NEXT*TRIADLENGTH)
            %CYCLE
               BTARGTRIAD = NEXT
               NEXT = TT_CHAIN
               TT == RECORD (ATRIADS + NEXT*TRIADLENGTH)
            %REPEAT %UNTIL TT_OP = GOTO %OR %C
                          (TT_OP = STMT %AND TT_USE & SOB # 0)
            OLDBTARGTRIAD = BTARGTRIAD
         %FINISH
         BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
         STOB = BB_TEXT
!
!* FIRST DO SUBSUMPTION FOR WHOLE BLOCK.
         CURRTRIAD = STOB
         %WHILE NEXTTRIAD = 1 %CYCLE
            TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
            TT_OP = TT_OP & BMBITOFF     ;!  CLEAR BACKMOVED FLAG
            %IF INHIBMASK & INHIBSUBSUM = 0 %THEN SUBSUM
         %REPEAT
         %IF INHIBMASK & INHIBSUBSUM = 0 %THEN SUBSEOB
         CURRDEF(I) = 0 %FOR I = 0,1,BSWORDS-1
!
!* NOW ALL THE EXPRESSION OPTIMISATIONS FOR WHOLE BLOCK.
         CURRTRIAD = STOB
         %WHILE NEXTTRIAD = 1 %CYCLE
            %IF INHIBMASK & INHIBEXPOPTS = 0 %THENSTART
               TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
               OP = TT_OP
               %IF OP = DIV %THENSTART
                  OPTDIV
                  TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
                  OP = TT_OP
               %FINISH
               %IF OP = ADD %OR OP = SUB %OR OP = MULT %THENSTART
                  CONELIM
                  FACTORISE
                  LINEARISE
                  TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
                  OP = TT_OP
               %FINISH
               %IF OP = NEG %THENSTART
                  OPTNEG
               %FINISHELSEIF OP = CVT %THENSTART
                  OPTCVT
               %FINISHELSEIF JIT <= OP <= JIZ %THENSTART
                  FLOWOFCONT
               %FINISHELSEIF OP = EXP %THENSTART
                  OPTEXP
               %FINISHELSEIF OP = IFUN %THENSTART
                  OPTFUN ;!  LIBRARY FUNCTIONS ONLY.
               %FINISH
            %FINISH
            %IF INHIBMASK & INHIBBMOVE = 0 %THENSTART
               BACKMOVE %UNLESS BACKTARG = 0
            %FINISH
            UPDATECURRDEF
         %REPEAT
!
!* FINALLY DO EXPRESSION ELIMINATION FOR THE WHOLE BLOCK (BUT FIRST
!*   FOR THE BACK TARG BLOCK IF THIS EXISTS & HAS BEEN ADDED TO).
         EXPELBTARG %UNLESS OLDBTARGTRIAD = 0 %OR %C
                           OLDBTARGTRIAD = BTARGTRIAD
         CURRTRIAD = STOB
         CURRDEF(I) = 0 %FOR I = 0,1,BSWORDS-1
         EXPELIM
         DLOOPPTR = CL_PDCHAIN
      %REPEAT %UNTIL DLOOPPTR = 0
!
%END;! OP2A
!
%END;! OP2
!
!
!
!
!*
!***********************************************************************
!*                                                                     *
!***********************************************************************
!*                                                                     *
!*                     B A C K M O V E                                 *
!*                                                                     *
!***********************************************************************
!*                                                                     *
!***********************************************************************
!
!
%EXTERNALROUTINE BACKMOVE
!
%ROUTINESPEC MOVEOP (%RECORD (RESF) %NAME OPD)
%ROUTINESPEC BTBITS (%INTEGER ID)
%INTEGERFUNCTIONSPEC BMOVCHECK
%INTEGERFUNCTIONSPEC BREAKOUT (%INTEGER TR)
%INTEGERFUNCTIONSPEC BREAKIN (%INTEGER TR)
%INTEGERFUNCTIONSPEC LCON (%RECORD (RESF) OPD)
%INTEGERFUNCTIONSPEC BREAKCHECK (%INTEGER TR)
%INTEGERFUNCTIONSPEC BRNEW
%INTEGERFUNCTIONSPEC OPSCOM
%ROUTINESPEC SWAP
!
!
!
%CONSTBYTEINTEGERARRAY OPSTAB (0:114) = %C
      X'00',    X'00',    X'47',    X'47',
   {  NULL      (01)      ADD       SUB
      X'47',    X'07',    X'05',    X'33',
   {  MULT      DIV       NEG       ASMT
      X'03',    X'13',    X'00',    X'00',
   {  CVT       ARR       ARR1      BOP
      X'00',    X'00',    X'07',    X'07',
   {  ASGN      (0D)      EXP       EXP3
      X'07',    X'07',    X'05',    X'07',
   {  AND       OR        NOT       EQUIV
      X'07',    X'07',    X'07',    X'07',
   {  NEQ       GT        LT        NE
      X'07',    X'07',    X'07',    X'00',
   {  EQ        GE        LE        SUBSTR
      X'00',    X'00',    X'00',    X'00',
   {  CHAR      CONCAT    CHHEAD    (1F)
      X'00',    X'00',    X'00',    X'00',
   {  STOD1     STOD2     STODA     (23)
      X'00',    X'00',    X'00',    X'00',
   {  EOD1      EOD2      EODA      EODB
      X'07',    X'11',    X'07',    X'07',
   {  BRK       DEFARR    RSUB      RDIV
      X'00',    X'07',    X'00',    X'00',
   {  DCHAR     ASH       (2E)
      X'00',    X'00',    X'00',    X'00',
   {  STRTIO    IOITEM    IODO      IOSPEC
      X'00',    X'00',    X'00',    X'00',
   {  IO        DIOITEM   (36)
      X'00',    X'03',    X'02',    X'00',
   {  (38)      ARGARR    INIT      INCR
      X'00',    X'00',    X'00',    X'00',
   {  DECR      DINIT     PINCR     (3F)
      X'00',    X'21',    X'00',    X'01',
   {  NOOP      FUN       SUBR      ARG
      X'00',    X'00',    X'00',    X'21',
   {  STRTSF    ENDSF     CALLSF    IFUN
      X'00',    X'01',    X'00',    X'01',
   {  DARG      IARG      REPL      REF
      X'00',    X'00',    X'01',    X'00',
   {  LOADB     STOREB    MOO       (4F)
      X'04',    X'04',    X'04',    X'04',
   {  JIT       JIF       JINN      JINP
      X'04',    X'04',    X'04',    X'04',
   {  JINZ      JIN       JIP       JIZ
      X'04',    X'04',    X'00',    X'00',
   {  CGT       GOTO      RET       STOP
      X'00',    X'00',    X'07',    X'07',
   {  PAUSE     EOT       NINT      ANINT
      X'00',    X'00',    X'00',    X'00',
   {  STMT      ITS       PA        TOCHAR
      X'07',    X'07',    X'07',    X'07',
   {  DIM       DMULT     AINT      ABS
      X'07',    X'07',    X'07',    X'07',
   {  MOD       SIGN      MIN       MAX
      X'07',    X'07',    X'06',    X'07',
   {  REALL     IMAG      CMPLX     CONJG
      X'07',    X'07',    X'07'
   {  LEN       ICHAR     CHIND
!
!
%RECORD (BLRECF) %NAME BB
%RECORD (TRIADF) %NAME TT,TT1,TT2
%RECORD (PRECF) %NAME DD
%RECORD (CLOOPRECF) %NAME CL
%RECORD (CONRECF) %NAME CN
%RECORD (RESF) OPD
!
!
%INTEGER LINK,ACTNO,LINKPREV,LINKCHAIN,CONSTRIDS
%INTEGER NEWENT,CONFLAG,OP,ACTION
%INTEGER OPS,CLASS,COORD,TEXT,ID,WOPD,OLDOP2,LCON1,LCON2
%INTEGER DEF,BLOCK,BITS1,BITS2,VAL1,VAL2,CNBLOCK
%INTEGER DLOOPPTR,I,SAVEPTR,TABPTR,TABPTR2,TRID
%CONSTINTEGER IDBIT = 16
!
!
!******************************************************************
!* MOVE LOOP-CONSTANT TRIADS INTO BACK TARGET BLOCK.              *
!******************************************************************
!
      ACTION = BMOVCHECK
      TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
      %IF ACTION = 1 %THENSTART
!
!* TRIAD CANNOT BE BACKWARD MOVED. TRY TO MOVE A SINGLE OPERAND
!*    WHICH IS A LOOP CONSTANT COMMON VARIABLE.
!
         %IF OPS & 4 # 0 %AND TT_QOPD1 = CSCALID %AND %C
                      TT_MODE # CHARMODE %THENSTART
            %IF LOOPCON1 (CURRTRIAD) = 1 %THEN MOVEOP (TT_RES1)
         %FINISH
         %IF OPS & 2 # 0 %AND TT_QOPD2 = CSCALID %AND %C
                      TT_MODE # CHARMODE %THENSTART
            %IF LOOPCON2 (CURRTRIAD) = 1 %THEN MOVEOP (TT_RES2)
         %FINISH
      %FINISHELSEUNLESS ACTION = 0 %THENSTART
!
!* PERFORM BACKWARD MOVEMENT. UPDATE BITSTRIPS & RECHAIN TRIAD.
!
         %IF ACTION = 2 %AND TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
         %IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
         TT_OP = TT_OP ! BMBIT
         TT2 == RECORD (ATRIADS + PREVTRIAD*TRIADLENGTH)
         TT2_CHAIN =TT_CHAIN
         TT2 == RECORD (ATRIADS + BTARGTRIAD*TRIADLENGTH)
         TT_CHAIN = TT2_CHAIN
         TT2_CHAIN = CURRTRIAD
         BTARGTRIAD = CURRTRIAD
        %IF OPTFLAGS&CDUMP#0 %START
          PRINTSTRING("TRIAD HAS BEEN BACKWARD MOVED - ")
          NEWLINE
          PRINTTR(BTARGTRIAD,ADICT,ANAMES,0,TT)
        %FINISH
         CURRTRIAD = PREVTRIAD
      %FINISH
!
!
!
!
%INTEGERFUNCTION BMOVCHECK
!
!***********************************************************************
!* CHECK WHETHER BACKWARD MOVEMENT IS POSSIBLE, AND RETURN ONE         *
!*     OF FOUR VALUES:                                                 *
!*                  0.  NO BACKWARD MOVEMENT POSSIBLE.                 *
!*                  1.  TRIAD CANNOT BE MOVED. TRY ONE OF OPERANDS.    *
!*                  2.  MOVE THE TRIAD.                                *
!*                  3.  MOVE TRIAD (ASGN OR ASMT)                      *
!***********************************************************************
!
      BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
      %IF OPT = 1 %AND BB_FLAGS & ARTICBIT = 0 %THEN %RESULT = 0
      TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
!*************************************************************************
!* PICK UP CLASS OF TRIAD FROM TABLE:                                    *
!*        B5 = OPD 1 CANDIDATE FOR COMMON VARIABLE REMOVAL               *
!*        B6 = OPD 2 CANDIDATE FOR COMMON VARIABLE REMOVAL               *
!*        B7 = CANDIDATE FOR BACKWARD MOVEMENT, WITH B0-3 CONTAINING     *
!*                                   SUBCLASSIFICATION                   *
!*************************************************************************
      OPS = OPSTAB(TT_OP)
      %UNLESS OPS & X'F1' # 0 %THEN %RESULT = 1
!*
!* TRIAD IS A CANDIDATE FOR BACKWARD MOVEMENT. DO FURTHER CHECKS ACCORDING
!*    TO SUBCLASS.
!
      CLASS = OPS >> 4
    %IF OPTFLAGS&CDUMP#0 %THENSTART
        PRINTSTRING("CURRTRIAD IS A CANDIDATE FOR BACKWARD MOVEMENT - ")
        NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
      %FINISH
      %IF CLASS = 0 %THENSTART
!
!* UNCLASSIFIED TRIAD
!  ------------------
         %IF LOOPCON1 (CURRTRIAD) = 1 %AND LOOPCON2 (CURRTRIAD) = 1      %C
                                    %THENSTART
            %IF TT_MODE=CHARMODE %AND NEQ<=TT_OP<=LE %THEN %RESULT=1
             %RESULT = 2
         %FINISHELSE %RESULT = 1
      %FINISH
      %IF CLASS = 1 %THENSTART
!
!* ARR OR DEFARR TRIAD
!  -------------------
         %IF LOOPCON2 (CURRTRIAD) = 1 %THENSTART
            %IF LOOPCON1 (CURRTRIAD) = 1 {%OR TT_OP = DEFARR}    %C
                                    %THEN %RESULT = 2 %ELSE %RESULT = 0
         %FINISH
!* OPD 2 IS VARIABLE, & SO A CANDIDATE FOR BREAK UP
!*           (IF A TEXT POINTER, AND NOT COMPLEX).
         %IF TT_QOPD2 & TEXTMASK = 0 %OR %C
               CMPLX8 <= TT_MODE <= CMPLX32 %THEN %RESULT = 0
         CONFLAG = 0
         %UNLESS BREAKCHECK (TT_OPD2) = 1 %AND CONFLAG = 1 %THEN %RESULT  = 0
         TT2 == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
         WOPD = BREAKOUT (TT2_OPD2)
         NEWENT = BRNEW
         TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
         TT_RES2_W = WOPD
         TT_OP = DEFARR ! BMBIT
         TT_RES1 = TT2_RES1
         %IF TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
         %IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
         TT2_QOPD1 = TRIAD
         TT2_OPD1 = NEWENT
         OLDOP2 = TT2_OPD2
        %IF OPTFLAGS&CDUMP#0 %THENSTART
          PRINTSTRING("BMOVCHECK:PLANT TRIAD IN BACK TARGET - ")
          NEWLINE
          PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
        %FINISH
         TT2_RES2_W = BREAKIN (OLDOP2)
         %IF TT2_QOPD2 & TEXTMASK # 0 %THENSTART
            TT == RECORD (ATRIADS + TT2_OPD2*TRIADLENGTH)
            TT_USE = TT_USE + 1
         %FINISH
         DELUSE (OLDOP2)
        %IF OPTFLAGS&CDUMP#0 %THENSTART
          PRINTSTRING("CURRTRIAD BECOMES - ")
          NEWLINE
          PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT2)
        %FINISH
         %RESULT = 0
      %FINISH
      %IF CLASS = 2 %THENSTART
!
!* FUN OR IFUN TRIAD
!  -----------------
         DD == RECORD (ADICT + TT_OPD1 << DSCALE)
         %IF DD_X0 & 3 = 0 %THEN %RESULT = 0 ;!     USER FUN.
         %IF LOOPCON2 (CURRTRIAD) = 1 %THEN %RESULT = 2 ;!    LIB FUN, CONST ARG
         %RESULT = 1
      %FINISH
      %IF CLASS = 3 %THENSTART
!
!* ASGN OR ASMT TRIAD
!  ------------------
         %UNLESS LOOPCON2 (CURRTRIAD) = 1 %THEN %RESULT = 0
         %IF BB_FLAGS & ARTICBIT = 0 %THEN %RESULT = 1
         %IF TT_QOPD1 & TEXTMASK # 0 %THENSTART ;! MUST BE DEFARR.
            %UNLESS LOOPCON1 (CURRTRIAD) = 1 %THEN %RESULT = 1
            TEXT = TT_OPD1
            TT == RECORD (ATRIADS + TEXT*TRIADLENGTH)
         %FINISH
         ID = TT_OPD1
         DD == RECORD (ADICT + ID<<DSCALE)
         COORD = DD_COORD ;! COORD OF ASSIGNMENT TARGET.
!* NO GOOD IF DEFINED/USED IN INNER LOOP.
         BITS1 = ADDR (PLOOPUSE(0))
         BITS2 = ADDR (PLOOPDEF(0))
         GETBIT (BITS1,COORD,VAL1)
         GETBIT (BITS2,COORD,VAL2)
         %IF VAL1 = 1 %OR VAL2 = 1 %THEN %RESULT = 1
!* NO GOOD IF B-O-E TO CURRENT BLOCK, OR IF DEFINED EARLIER IN THIS BLOCK.
         BITS1 = ADDR (CURRDEF(0))
         GETBIT (BB_BOE,COORD,VAL1)
         GETBIT (BITS1,COORD,VAL2)
         %IF VAL1 = 1 %OR VAL2 = 1 %THEN %RESULT = 1
!* NO GOOD IF DEFINED LATER IN THIS BLOCK.
         TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
         TRID = TT_CHAIN
         TT == RECORD (ATRIADS + TRID*TRIADLENGTH)
         %WHILE TT_USE & SOB = 0 %CYCLE
            DEF = ALLDEF (TRID)
            %UNLESS DEF = 0 %THENSTART
               %IF DEF < 0 %THENSTART
                  %IF COORD = 1 %THEN %RESULT = 1  %C
                                %ELSE DEF = - DEF
               %FINISH
               %IF DEF = COORD %THEN %RESULT = 1
               %IF DEF = 1 %AND DD_CLASS & CMNBIT # 0 %THEN %RESULT = 1
            %FINISH
            TRID = TT_CHAIN
            TT == RECORD (ATRIADS + TRID*TRIADLENGTH)
         %REPEAT
!* NO GOOD IF DEFINED IN ANOTHER BLOCK IN THIS LOOP.
         DLOOPPTR = DLOOPHEAD
         %WHILE DLOOPPTR # 0 %CYCLE
            CL == RECORD (ATABS + DLOOPPTR)
            BLOCK = CL_BLOCK
            %UNLESS BLOCK = CURRBLK %THENSTART
               BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
               GETBIT (BB_DEF,COORD,VAL1)
               %IF VAL1 = 1 %THEN %RESULT = 1
            %FINISH
            DLOOPPTR = CL_PDCHAIN
         %REPEAT
!* NO GOOD IF USED EARLIER IN THE LOOP.
!*  BUILD TABLE OF ALL BACK CONNECTIONS BACK TO L.E.B.
         FREETABS = (FREETABS + 3) & X'FFFFFFFC'
         SAVEPTR = FREETABS
         TABPTR = FREETABS
         BLOCK = CURRBLK
         %CYCLE
            BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
            %UNLESS BLOCK = LOOPENT %THENSTART
               CN == RECORD (ATABS + BB_BCON)
               %FOR I = 1,1,CN_COUNT %CYCLE
                  CNBLOCK = CN_BLOCK(I)
                  %UNLESS CNBLOCK = 0 %THENSTART
               L1:   BB == RECORD (ABLOCKS + CNBLOCK*BLSIZE)
                     %IF BB_DEPTH > LOOPDEPTH %THENSTART
                        CNBLOCK = BB_BTARG
                        -> L1
                     %FINISH
                     %IF BB_DEPTH = LOOPDEPTH %THENSTART
                        %FOR TABPTR2 = SAVEPTR,4,FREETABS-4 %CYCLE
                           %IF INTEGER (TABPTR2+ATABS) = CNBLOCK %THEN -> L2
                        %REPEAT
                        TABPTR2 = CREATETAB (4)
                        INTEGER (TABPTR2+ATABS) = CNBLOCK
                     %FINISH
            L2:   %FINISH
               %REPEAT
            %FINISH
            %IF TABPTR = FREETABS %THENSTART
               FREETABS = SAVEPTR
               BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
               SETBIT (BB_DEF,COORD)
               BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
               CLEARBIT (BB_DEF,COORD)
              CLEARBIT(ADDR(CLOOPDEF(0)),COORD)
               GETBIT (BB_USE,COORD,VAL1)
               %IF VAL1 = 1 %THEN SETBIT (BB_BOE,COORD)
               %RESULT = 3
            %FINISH
            BLOCK = INTEGER(TABPTR+ATABS)
            BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
            GETBIT (BB_USE,COORD,VAL1)
            %IF VAL1 = 1 %THENSTART
               FREETABS = SAVEPTR
               %RESULT = 1
            %FINISH
            TABPTR = TABPTR + 4
         %REPEAT
      %FINISH
      %IF CLASS = 4 %THENSTART
!
!* ADD, SUB, MULT, MAX, MIN TRIADS
!  -------------------------------
         CONSTRIDS = (LOOPCON1 (CURRTRIAD) << 1) + LOOPCON2 (CURRTRIAD)
         %UNLESS CONSTRIDS = 0 %THENSTART
            %IF CONSTRIDS = 3 %THEN %RESULT = 2;!  BOTH CONST. DO BACK MOVE.
            %IF CONSTRIDS = 2 %THENSTART
               %IF TT_QOPD2 & TEXTMASK = 0 %THEN %RESULT = 1;!  NO LINK TRIAD. TRY TO MOVE OPD.
               LINK = TT_OPD2
               ACTNO = 2
            %FINISHELSESTART
               %IF TT_QOPD1 & TEXTMASK = 0 %THEN %RESULT = 1
               LINK = TT_OPD1
               ACTNO = 0
            %FINISH
!
!* ONE CONST OPD & ONE TRIAD PTR. TRY FOR BACKWARD MOVEMENT BY ASSOCIATION.
!*      (VAR + CONST1) + CONST2:  TRY TO SWAP VAR & CONST2.
            TT1 == RECORD (ATRIADS + LINK*TRIADLENGTH)
            %IF TT1_USE # 1 %THEN %RESULT = 1
            %IF OPSCOM = 0 %THEN %RESULT = 1;!   INVALID COMBINATION OF OPERATORS.
            %IF LOOPCON2 (LINK) = 0 %THENSTART
               %IF LOOPCON1 (LINK) = 0 %THEN %RESULT = 1
               ACTNO = ACTNO ! 1
            %FINISH
            SWAP ;!   SWAPS OPERANDS ACCORDING TO VALUE OF ACTNO.
!* LINK NOW CONTAINS TWO CONSTANTS.  CHAIN INTO BACK TARGET.
            LINKPREV = BB_TEXT
            %CYCLE
               TT == RECORD (ATRIADS + LINKPREV*TRIADLENGTH)
               %IF TT_CHAIN = LINK %THEN %EXIT
               LINKPREV = TT_CHAIN
            %REPEAT
            TT1_OP = TT1_OP ! BMBIT
            TT_CHAIN =TT1_CHAIN
            TT == RECORD (ATRIADS +BTARGTRIAD*TRIADLENGTH)
            TT1_CHAIN = TT_CHAIN
            TT_CHAIN = LINK
            BTARGTRIAD = LINK
            %IF TT1_QOPD1 & IDBIT # 0 %THEN BTBITS (TT1_OPD1)
            %IF TT1_QOPD2 & IDBIT # 0 %THEN BTBITS (TT1_OPD2)
            %IF OPTFLAGS&CDUMP#0 %THENSTART
              PRINTSTRING("BMOVCHECK:MOVE TRIAD TO BACK TARGET - ")
              NEWLINE
              PRINTTR(LINK,ADICT,ANAMES,0,TT1)
            %FINISH
            %RESULT = 0
         %FINISH
!
!* BOTH OPERANDS VARIABLE. TRY FOR CONSTANT DESCENT.
!*    (CONST + VAR1) + VAR2:  TRY TO SWAP CONST & VAR2.
         %IF TT_QOPD1 & TEXTMASK # 0 %THENSTART
            %IF TT_QOPD2 & TEXTMASK # 0 %THEN %RESULT = 0
            LINK = TT_OPD1
            ACTNO = 0
            OPD = TT_RES2
         %FINISHELSESTART
            %IF TT_QOPD2 & TEXTMASK = 0 %THEN %RESULT = 0
            LINK = TT_OPD2
            ACTNO = 2
            OPD = TT_RES1
         %FINISH
         TT1 == RECORD (ATRIADS + LINK*TRIADLENGTH)
         %IF TT1_USE # 1 %THEN %RESULT = 0
         %IF OPSCOM = 0 %THEN %RESULT = 0
         %IF LOOPCON1 (LINK) = 0 %THENSTART
            %IF LOOPCON2 (LINK) = 0 %THEN %RESULT = 0
            ACTNO = ACTNO + 1
         %FINISH
         %IF OPD_FORM & IDBIT # 0 %THENSTART
            DD == RECORD (ADICT + OPD_H0 << DSCALE)
            COORD = DD_COORD
!* CHECK THAT WE ARE NOT TRYING TO MOVE A USE OF A LOOP VARIABLE
!*    BACKWARDS OVER ITS DEFINITION.
            LINKCHAIN = TT1_CHAIN
            %WHILE LINKCHAIN # CURRTRIAD %CYCLE
               DEF = ALLDEF (LINKCHAIN)
               %UNLESS DEF = 0 %THENSTART
                  %IF DEF < 0 %THENSTART
                     %IF COORD = 1 %THEN %RESULT = 0  %C
                                   %ELSE DEF = - DEF
                  %FINISH
                  %IF DEF = COORD %THEN %RESULT = 0
                  %IF DEF = 1 %AND DD_CLASS & CMNBIT # 0 %THEN %RESULT = 0
               %FINISH
               TT2 == RECORD (ATRIADS + LINKCHAIN*TRIADLENGTH)
               LINKCHAIN = TT2_CHAIN
            %REPEAT
         %FINISH
         SWAP ;!   SWAPS OPERANDS ACCORDING TO SETTING OF ACTNO.
         %RESULT = 0
      %FINISH
!
%END ;!   BMOVCHECK
!
!
!
!
%ROUTINE MOVEOP (%RECORD (RESF) %NAME OPD)
!
!*******************************************************************
!* MOVE A LOOP CONSTANT COMMON OPERAND TO THE BACK TARGET.         *
!*******************************************************************
      NEWENT = BRNEW
      TT1 == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
      TT1_OP = REF ! BMBIT
      TT1_RES1_W = OPD_W
      TT1_RES2_W = 0
      BTBITS (OPD_H0)
      OPD_H0 = BTARGTRIAD
      OPD_FORM = TRIAD
    TREVERSE(CURRTRIAD)
    %IF OPTFLAGS&CDUMP#0 %THENSTART
      PRINTSTRING("MOVEOP:PLANT TRIAD IN BACK TARGET - ")
      NEWLINE
      PRINTTR(NEWENT,ADICT,ANAMES,0,TT1)
      PRINTSTRING("CURRTRIAD BECOMES - ")
      NEWLINE
      PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
    %FINISH
!
%END;!  MOVEOP
!
!
!
!
%ROUTINE BTBITS (%INTEGER ID)
!
!*********************************************************************
!* SET RELEVANT BITS IN THE BACK TARGET BIT STRIPS.                  *
!*********************************************************************
!
      DD == RECORD (ADICT + ID<<DSCALE)
      BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
      COORD = DD_COORD
      SETBIT (BB_USE,COORD)
      GETBIT (BB_DEF,COORD,VAL1)
      %IF VAL1 = 0 %THEN SETBIT (BB_BOE,COORD)
!
%END;!   BTBITS
!
!
!
!
%INTEGERFUNCTION BREAKCHECK (%INTEGER TR)
!
!***************************************************************************
!* PERFORM TREE-WALK OF THE SUBSCRIPT EXPRESSION TO IDENTIFY A             *
!*            BREAK-UP CANDIDATE. (RECURSIVE FUNCTION)                     *
!*         RETURN CONFLAG = 1 IF A LOOP CONSTANT OPERAND HAS BEEN FOUND    *
!*                RESULT = 1 IF ONLY OPERATORS ARE +, -, *.                *
!***************************************************************************
!
      TT == RECORD (ATRIADS + TR*TRIADLENGTH)
      %IF TT_OP & BMBIT = 0 %THENSTART
         OP = TT_OP
         %IF OP = ADD %OR OP = SUB %THENSTART
            %IF LOOPCON1 (TR) = 1 %OR LOOPCON2 (TR) = 1 %THEN CONFLAG = 1
         %FINISHELSEIF OP = MULT %THENSTART
            %UNLESS (TT_QOPD1 & TEXTMASK = 0 %AND LOOPCON1 (TR) = 1) %OR %C
                   (TT_QOPD2 & TEXTMASK = 0 %AND LOOPCON2 (TR) = 1) %C
                                        %THEN %RESULT = 0
         %FINISHELSE %RESULT = 0
         %IF TT_QOPD1 & TEXTMASK # 0 %THENSTART
            %IF BREAKCHECK (TT_OPD1) = 0 %THEN %RESULT = 0
            TT == RECORD (ATRIADS + TR*TRIADLENGTH)
         %FINISH
         %IF TT_QOPD2 & TEXTMASK # 0 %THENSTART
            %IF BREAKCHECK (TT_OPD2) = 0 %THEN %RESULT = 0
         %FINISH
      %FINISH
      %RESULT = 1
!
%END ;!    BREAKCHECK
!
!
!
!
%INTEGERFUNCTION BREAKOUT (%INTEGER TR)
!
!************************************************************************
!* RECURSIVE ROUTINE WHICH PLANTS THE LOOP CONSTANT COMPONENTS OF THE   *
!*       SUBSCRIPT EXPRESSION IN THE BACK TARGET.                       *
!************************************************************************
!
%INTEGER OP
%RECORD (RESF) OPD,WOP1,WOP2
!
      TT == RECORD (ATRIADS + TR*TRIADLENGTH)
      OPD_MODE = TT_MODE
      OPD_FORM = TRIAD
      %IF TT_OP & BMBIT # 0 %THENSTART
!* ALREADY BACKWARD MOVED. UPDATE USE CT & RETURN IT.
         TT_USE = TT_USE + 1
         OPD_H0 = TR
         %RESULT = OPD_W
      %FINISH
      WOP1 = TT_RES1
      WOP2 = TT_RES2
      OP = TT_OP
!* MAKE RECURSIVE CALLS FOR TEXT OPERANDS.
      %IF WOP1_FORM & TEXTMASK # 0 %THEN WOP1_W = BREAKOUT (WOP1_H0)
      %IF WOP2_FORM & TEXTMASK # 0 %THEN WOP2_W = BREAKOUT (WOP2_H0)
      LCON1 = LCON (WOP1)
      LCON2 = LCON (WOP2)
      %IF LCON1 = 1 %AND LCON2 = 1 %THENSTART
!* BOTH OPDS CONSTANT. PLANT TRIAD IN BACK TARGET & UPDATE BIT STRIPS.
         NEWENT = BRNEW
         TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
         TT_RES1 = WOP1
         TT_RES2_W = WOP2_W
         TT_OP = OP ! BMBIT
         TREVERSE (NEWENT)
         %IF TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
         %IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
         OPD_H0 = NEWENT
        %IF OPTFLAGS&CDUMP#0 %THENSTART
          PRINTSTRING("BREAKOUT:PLANT TRIAD IN BACK TARGET - ")
          NEWLINE
          PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
        %FINISH
         %RESULT = OPD_W
      %FINISH
      %IF OP = MULT %THEN %RESULT = 0
!* TRIAD IS ADD OR SUB. OPDS 1 & 2 NOT BOTH CONSTANT.
      %IF LCON1 = 1 %THEN %RESULT = WOP1_W
      %IF LCON2 = 0 %THEN %RESULT = 0
!* OPD 2 CONSTANT. IF SUB TRIAD, NEED TO PLANT A NEG TRIAD.
      %IF OP = ADD %THEN %RESULT = WOP2_W
      NEWENT = BRNEW
      TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
      TT_RES1 = WOP2
      TT_OP = NEG ! BMBIT
      TT_RES2_W = 0
      %IF WOP2_FORM & IDBIT # 0 %THEN BTBITS (WOP2_H0)
      OPD_H0 = NEWENT
      %IF OPTFLAGS&CDUMP#0 %THENSTART
        PRINTSTRING("BREAKOUT:PLANT TRIAD IN BACK TARGET - ")
        NEWLINE
        PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
      %FINISH
      %RESULT = OPD_W
!
%END;!   BREAKOUT
!
!
!
!
%INTEGERFUNCTION BREAKIN (%INTEGER TR)
!
!*************************************************************************
!* RECURSIVE ROUTINE WHICH LEAVES ONLY THE LOOP VARIABLE COMPONENTS      *
!*     OF THE SUBSCRIPT EXPRESSION INSIDE THE LOOP.                      *
!*************************************************************************
!
%INTEGER OP
%RECORD (RESF) OPD,WOP1,WOP2
!
      TT == RECORD (ATRIADS + TR*TRIADLENGTH)
      OPD_H0 = TR
      OPD_FORM = TRIAD
      OPD_MODE = TT_MODE
      WOP1 = TT_RES1
      WOP2 = TT_RES2
      OP = TT_OP
      %IF WOP1_FORM & TEXTMASK # 0 %AND LCON (WOP1) = 0 %C
                                        %THEN WOP1_W = BREAKIN (WOP1_H0)
      %IF WOP2_FORM & TEXTMASK # 0 %AND LCON (WOP2) = 0 %C
                                        %THEN WOP2_W = BREAKIN (WOP2_H0)
      LCON1 = LCON (WOP1)
      LCON2 = LCON (WOP2)
      %IF LCON1 = 1 %AND LCON2 = 1 %THEN %RESULT = X'10000'
      %IF OP # MULT %THENSTART
         %IF LCON2 = 1 %THEN %RESULT = WOP1_W
         %IF LCON1 = 1 %THENSTART
            %IF OP = ADD %THEN %RESULT = WOP2_W   %C
                         %ELSESTART
               WOP1 = WOP2
               OP = NEG
               WOP2_W = X'10000'
            %FINISH
         %FINISH
      %FINISH
!* TRIAD REQUIRED TO PERFORM CURRENT OPERATION IN LOOP. NEW TRIAD
!*        ALWAYS GENERATED.
      NEWENT = GETTRIAD
      TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
      TT_USE=0
      TT1 == RECORD (ATRIADS + OPD_H0*TRIADLENGTH)
      TT_CHAIN = TT1_CHAIN
      TT1_CHAIN = NEWENT
      %IF WOP1_FORM & TEXTMASK # 0 %THENSTART
         TT1 == RECORD (ATRIADS + WOP1_H0*TRIADLENGTH)
         TT1_USE =TT1_USE + 1
      %FINISH
      %IF WOP2_FORM & TEXTMASK # 0 %THENSTART
         TT1 == RECORD (ATRIADS + WOP2_H0*TRIADLENGTH)
         TT1_USE = TT1_USE + 1
      %FINISH
      TT_RES1 = WOP1
      TT_RES2 = WOP2
      TT_OP = OP
      TREVERSE (NEWENT)
      OPD_H0 = NEWENT
      %IF OPTFLAGS&CDUMP#0 %THENSTART
        PRINTSTRING("BREAKIN:PLANT TRIAD IN BACK TARGET - ")
        NEWLINE
        PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
      %FINISH
      %RESULT = OPD_W
!
%END;!   BREAKIN
! 
!
!
!
%INTEGERFUNCTION BRNEW
!
!**************************************************************************
!* CLAIM A NEW TRIAD IN THE BACK TARGET, CHAINED AFTER BTARGTRIAD.        *
!**************************************************************************
!
%INTEGER TR,PTR
!
      TR = GETTRIAD
      TT == RECORD (ATRIADS + BTARGTRIAD*TRIADLENGTH)
      PTR = TT_CHAIN
      TT_CHAIN = TR
      TT == RECORD (ATRIADS + TR*TRIADLENGTH)
      TT_CHAIN = PTR
      TT_USE = 1
      BTARGTRIAD = TR
      %RESULT = TR
!
%END;!   BRNEW
!
!
!
!
%INTEGERFUNCTION LCON (%RECORD (RESF) OPD)
!
!*********************************************************************
!* CHECKS WHETHER OPERAND IS LOOP CONSTANT.  YES = 1, NO = 0.        *
!*********************************************************************
!
%INTEGER QUAL
!
      QUAL = OPD_FORM
      %IF QUAL = 0 %THEN %RESULT = OPD_H0;!    1 IF BREAKIN, 0 IF BREAKOUT.
      %IF QUAL & IDBIT # 0 %THENSTART
         DD == RECORD (ADICT + OPD_H0 << DSCALE)
         BITS1 = ADDR (CLOOPDEF(0))
         GETBIT (BITS1,DD_COORD,VAL1)
         %IF VAL1 = 1 %THEN %RESULT = 0 %ELSE %RESULT = 1
      %FINISH
      %IF QUAL & TEXTMASK = 0 %THEN %RESULT = 1
      TT == RECORD (ATRIADS + OPD_H0*TRIADLENGTH)
      %IF TT_OP & BMBIT = 0 %THEN %RESULT = 0   %C
                               %ELSE %RESULT = 1 ;!     CONSTANT IFF BACKWARD MOVED.
!
%END;!    LCON
!
!
!
!
%INTEGERFUNCTION OPSCOM
!
!***********************************************************************
!* CHECKS FOR VALID OPERATOR PAIRS IN DESCENT, NAMELY ADD, SUB, MULT,  *
!*      MAX, OR MIN TWICE, OR COMBINATIONS OF ADD & SUB.               *
!*         TRIAD POINTERS ON ENTRY ARE                                 *
!*                 TT -> CURRTRIAD                                     *
!*                 TT1 -> LINK.                                        *
!*         RETURNS 1 IF OPERATORS ARE A VALID COMBINATION, ELSE 0      *
!***********************************************************************
!
%INTEGER OP
!
      OP = TT_OP
      %IF OP = TT1_OP %THENSTART
         %IF OP = SUB %THEN ACTNO = ACTNO ! 12
         %RESULT = 1
      %FINISH
      %IF OP = ADD %AND TT1_OP = SUB %THENSTART
         ACTNO = ACTNO ! 4
         %RESULT = 1
      %FINISH
      %IF OP # SUB %OR TT1_OP # ADD %THEN %RESULT = 0
      ACTNO =ACTNO ! 8
      %RESULT = 1
!
%END  ;!    OPSCOM
!
!
!
!
%ROUTINE SWAP
!
!********************************************************************************
!* INTERCHANGE OPERANDS FOR CONSTANT DESCENT, ADJUSTING OPERATORS AS NECESSARY. *
!*   ON ENTRY  TT -> CURRTRIAD                                                  *
!*             TT1 -> LINK                                                      *
!*             ACTNO:  1-BIT SET TO SWAP OPD2 OF LINK (ELSE OPD1)               *
!*                     2-BIT SET TO SWAP OPD1 OF CURRTRIAD (ELSE OPD2)          *
!*                     4-BIT SET FOR A + (B - C)                                *
!*                     8-BIT SET FOR A - (B + C)                                *
!*                     4 & 8 BITS SET FOR A - (B - C).                          *
!********************************************************************************
!
%INTEGER OP
%INTEGERNAME AD
%RECORD (RESF) OPD
%CONSTBYTEINTEGERARRAY ACTS (5:15) = 1,0,9,17,1,10,26,12,0,12,0
!
      %IF ACTNO & 1 = 0 %THENSTART
         OPD = TT1_RES1
         AD == TT1_RES1_W
      %FINISHELSESTART
         OPD = TT1_RES2
         AD == TT1_RES2_W
      %FINISH
      %IF ACTNO & 2 = 0 %THENSTART
         AD = TT_RES2_W
         TT_RES2 = OPD
      %FINISHELSESTART
         AD = TT_RES1_W
         TT_RES1 = OPD
      %FINISH
!
!* SOME COMBINATIONS OF OPERATORS REQUIRE SWAPPING OF EITHER OPERATORS
!*   OR OPERANDS, AS DEFINED IN A SECOND SET OF ACTIONS.
      %UNLESS ACTNO < 5 %THENSTART
         ACTNO = ACTS (ACTNO)
         %IF ACTNO & 1 # 0 %THENSTART ;!  SWAP OPERATORS BETWEEN CURR & LINK
            OP = TT_OP
            TT_OP = TT1_OP
            TT1_OP = OP
         %FINISHELSEIF ACTNO & 2 # 0 %THEN TT1_OP = SUB    %C
               %ELSEIF ACTNO & 4 # 0 %THEN TT1_OP = ADD
         %IF ACTNO & 8 # 0 %THENSTART ;!  SWAP OPERANDS OF CURR.
            OPD = TT_RES1
            TT_RES1 = TT_RES2
            TT_RES2 = OPD
         %FINISH
         %IF ACTNO & 16 # 0 %THENSTART ;!  SWAP OPERANDS OF LINK.
            OPD = TT1_RES1
            TT1_RES1 = TT1_RES2
            TT1_RES2 = OPD
         %FINISH
      %FINISH
!* ENSURE NEW OPERANDS ARE IN CORRECT ORDER OF PRECEDENCE
      TREVERSE(CURRTRIAD)
      TREVERSE(LINK)
      %IF OPTFLAGS&CDUMP#0 %THENSTART
        PRINTSTRING("SWAP:LINK TRIAD BECOMES - ")
        NEWLINE
        PRINTTR(LINK,ADICT,ANAMES,0,TT1)
        PRINTSTRING("CURRTRIAD BECOMES - ")
        NEWLINE
        PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
      %FINISH
!
%END ;!   SWAP
!
!
%END;!   BACKMOVE
!
%ENDOFFILE