!                                                               f2opt1
! 07/12/86 - copy of ftn2opt5
!          - insert include files
! 13/06/86 - avoid back move of char array els
! 11/06/86 - BREAKCHECK to always return 0
! 10/06/86 - suppress backward movement of simple common var
! 02/12/85 - taken from op2p47, new include files incorporated
! 07/08/85 - include test for CHARMODE in ARR/DEFARR triad in BMOVECHECK
! 26/06/85 - line 976 0f LOOPBUILD, map on to next AR block
!          - line 812 of LOOPBUILD, map on to current CL block
! 19/09/84 - clear relevant bit in CLOOPDEF if ASMT/ASGN triad backward moved
!          - line 1510 corrected to VAL1=1, line 1515 moved back 7 lines
! 28/08/84 - correction to BTBITS for CMNCOORDS(1)
! 02/07/84 - change OPTSAB(CMPLX) entry to X'06'
! 11/04/84 - don't word align FREETABS in BMOVHECK
! 10/04/84 - scaling correction in bmovecheck
! 31/01/84 - UPDATE OPSTAB FOR DCMPLX & INTRIN
! 18/01/84 - ADJUST BIT STRIP ADDRESSES
! 17/01/84 - MAKE CALLS OF CREATETAB CONSISTTENT
! 23/11/83 call EDUMPTRACE in OP2A; set up LDUMPTRACE & BMTRACE
! 22/11/82 call CDUMPTRACE in OP2A
! 27/10/83 COPIED FROM ERCS06.REL90_OP2B13
!*
%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
!*
%routine Copy(%integer Length,Fbase,Fdisp,Tbase,Tdisp)
!***********************************************************************
!* copy Length bytes from fbase(fdisp) to tbase(tdisp)                 *
!***********************************************************************
%integer I,From,To
      %if Length<=0 %then %return
      From=Fbase+Fdisp
      To=Tbase+Tdisp
      %cycle I=0,1,Length-1
         byteinteger(To+I)=byteinteger(From+I)
      %repeat
%end;! Copy
!*
!*
!*
%OWNINTEGER TRACE=0,BMTRACE=0
!
%EXTERNALROUTINESPEC PRINTTR(%INTEGER INDEX,ADICT,ANAMES,LEVEL,
      %RECORD(TRIADF)%NAME TRIAD)

%ROUTINESPEC BACKMOVE
!
!
%ROUTINE LDUMPTRACE
TRACE=LDUMP&OPTFLAGS
%END
!
%ROUTINE SETBMTRACE
BMTRACE=CDUMP&OPTFLAGS
%END
!
%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)
%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; ! LENGTH IN 32BIT WORDS
      FREEBLOCKS = (NEXTBLOCK + 1) * BLSIZE
      SRHEAD = 0
      SRCH = ADDR (SRHEAD)
      FREETABS = (FREETABS + 3) & X'FFFFFFFC'
      BLKBITS = CREATETAB (BLKBSLENGTH << WSCALE) + ATABS
      BLKBS == ARRAY (BLKBITS,BS)
      LDUMPTRACE
      %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 (ABLOCKS+BB_USE,BF)
         B2 == ARRAY (ABLOCKS+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 (ABLOCKS+BB_USE,BF)
         B2 == ARRAY (ABLOCKS+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 (ABLOCKS+BB_USE,BF)
                        B2 == ARRAY (ABLOCKS+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 TRACE # 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 TRACE # 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.                            *
!****************************************************************
!
%EXTERNALROUTINESPEC EDUMPTRACE
%EXTERNALROUTINESPEC CDUMPTRACE
!
%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.
        SETBMTRACE
        CDUMPTRACE
         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).
         EDUMPTRACE
         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:116) = %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',    X'07',
   {  LEN       ICHAR     CHIND     DCMPLX
      X'21'
   { INTRIN
!
!
%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
I=btargtriad
         BTARGTRIAD = CURRTRIAD
        %IF BMTRACE#0 %START
          PRINTSTRING("TRIAD HAS BEEN BACKWARD MOVED - ")
          NEWLINE
printtr(i,adict,anames,0,tt2)
          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 BMTRACE#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 %THENSTART
           %IF TT_MODE=CHARMODE {%AND NEQ<=TT_OP<=LE} %THEN %RESULT = 1  %ELSE %RESULT = 2
         %FINISH %ELSE %RESULT=1
      %FINISH
      %IF CLASS = 1 %THENSTART
!
!* ARR OR DEFARR TRIAD
!  -------------------
         %if TT_Mode=Charmode %then %result=0
         %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 %OR %C
               TT_MODE=CHARMODE %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 BMTRACE#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 BMTRACE#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 (ABLOCKS+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 (ABLOCKS+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,W1,FREETABS-W1 %CYCLE
                           %IF INTEGER (TABPTR2+ATABS) = CNBLOCK %THEN -> L2
                        %REPEAT
                        TABPTR2 = CREATETAB (W1)
                        INTEGER (TABPTR2+ATABS) = CNBLOCK
                     %FINISH
            L2:   %FINISH
               %REPEAT
            %FINISH
            %IF TABPTR = FREETABS %THENSTART
               FREETABS = SAVEPTR
               BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
               SETBIT (ABLOCKS+BB_DEF,COORD)
               BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
               CLEARBIT (ABLOCKS+BB_DEF,COORD)
               CLEARBIT(ADDR(CLOOPDEF(0)),COORD)
               GETBIT (ABLOCKS+BB_USE,COORD,VAL1)
               %IF VAL1 = 1 %THEN SETBIT (ABLOCKS+BB_BOE,COORD)
               %RESULT = 3
            %FINISH
            BLOCK = INTEGER(TABPTR+ATABS)
            BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
            GETBIT (ABLOCKS+BB_USE,COORD,VAL1)
            %IF VAL1 = 1 %THENSTART
               FREETABS = SAVEPTR
               %RESULT = 1
            %FINISH
            TABPTR = TABPTR + W1
         %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 BMTRACE#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 BMTRACE#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 (ABLOCKS+BB_USE,COORD)
      SETBIT(ABLOCKS+BB_USE,1) %IF (DD_CLASS&CMNBIT)\=0 %AND %C
        CMNCOORDS(1)=1
      GETBIT (ABLOCKS+BB_DEF,COORD,VAL1)
      %IF VAL1 = 0 %THEN %START
        SETBIT(ABLOCKS+BB_BOE,1) %IF (DD_CLASS&CMNBIT)\=0 %AND CMNCOORDS(1)=1
        SETBIT (ABLOCKS+BB_BOE,COORD)
      %FINISH
!
%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 +, -, *.                *
!***************************************************************************
!
%result=0
      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 BMTRACE#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 BMTRACE#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 BMTRACE#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 BMTRACE#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