!                                                                   fsred1
! 07/12/86 - insert include files
!                                                                   ftnsred6
! 11/11/86 - correction to mode of srtemps
!                                                                   ftnsred5
! 11/11/86 - allow int2 vars to be srtemps
!          - scale QTOUS and RES in Subtemp and Scan to equiv I2 and I4
!          - also in Examine and Reduce
!                                                                   ftnsred4
! 06/11/86 - use ftn_consts4 to redefine size of usef
!                                                                   ftnsred2
! 10/07/86 - in EXAMINE leave TOUS + Lit undisturbed
! 13/12/85 - copied from sred42
!          - new include files incorporated
! 05/06/84 reject sr vars which have neglits floating around (EXAMINE)
! 04/06/84 change format of USEF & size of TINITSZ
!          local variables inserted in print routines
! 22/01/84 BIT STRIP ADDRESSES NOW RELATIVE TO ABLOCKS
! 30/10/83 COPIED FROM ERCS06.REL90_SREDB12
!*
%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
!*
%routine Fill(%integer Length,Fbase,Fdisp,Filler)
!***********************************************************************
!* fill Length bytes from fbase(fdisp) with Filler                     *
!***********************************************************************
%integer I,From
      %if Length<=0 %then %return
      From=Fbase+Fdisp
      %cycle I=0,1,Length-1
         byteinteger(From+I)=Filler
      %repeat
%end;! Fill
!*
%routine Zero(%integer Addr,Length)
!***********************************************************************
!* Set Length (a multiple of 4) bytes to zero                          *
!***********************************************************************
%integer I
      I=0
      %while I<Length %cycle
         integer(Addr+I)=0
         I=I+4 {bytes}
      %repeat
%end;! Zero
!*
!*
%EXTERNALROUTINE STRENGTHRED
!
!
%ROUTINESPEC IDENTIFY
%INTEGERFUNCTIONSPEC COLLECT
%INTEGERFUNCTIONSPEC RTENTRY
%ROUTINESPEC RUENTRY
%INTEGERFUNCTIONSPEC EXAMINE 
%ROUTINESPEC REDUCE 
%ROUTINESPEC TARGHK (%RECORD (RESF) OPD)
%ROUTINESPEC SUBTEMP
%INTEGERFUNCTIONSPEC SCAN
%ROUTINESPEC IREPL
%ROUTINESPEC SRENTRY (%INTEGER SFLAG)
%ROUTINESPEC REPLACE
%INTEGERFUNCTIONSPEC BOEX (%INTEGER IDPTR)
%INTEGERFUNCTIONSPEC CREATEBTAB (%INTEGER A)
%ROUTINESPEC PRINTRD
%ROUTINESPEC PRINTRUSE
%ROUTINESPEC PRINTRDEF
%ROUTINESPEC PRINTRTEST
%ROUTINESPEC PRINTUSESTACK
!
%EXTERNALINTEGERFUNCTIONSPEC CREATETAB (%INTEGER A)
!
!*************************************************************************
!* GIVEN A LOOP, PERFORMS THE STANDARD OPTIMATIONS                       *
!*                         STRENGTH REDUCTION                            *
!*                         TEST REPLACEMENT                              *
!*                         DEAD DEFINITION ELIMINATION                   *
!*************************************************************************
!
!
%RECORDFORMAT RDF (%RECORD (RESF) VAR,%shortINTEGER TRIAD,BLOCK)
%RECORDFORMAT RUSEF (%INTEGER TRIAD,CHAIN, %shortINTEGER PREV,BLOCK)
%RECORDFORMAT RTESTF (%shortINTEGER TRIAD,BLOCK)
%RECORDFORMAT RDEFF (%shortINTEGER ASSTRIAD,INCTRIAD,INCPREV,BLOCK,SIGN,FILL,
                       (%INTEGER LITINC %OR %RECORD (RESF) INC))
%RECORDFORMAT USEF (%shortINTEGER TRIAD,BLOCK,
                             %RECORD (RESF) RV,
                             %INTEGER USES, %BYTEINTEGERARRAY SIGN (0:3),
                             %shortINTEGER TEMP,FILL,
                             (%INTEGERARRAY LITINC (1:3)   %OR  %C
                              %RECORD (RESF) %ARRAY INC (1:3)))
%RECORDFORMAT TINRECF (%INTEGER TRIAD,OPD,REF)
!
!
%RECORD (CLOOPRECF) %NAME CL
%RECORD (BLRECF) %NAME BB
%RECORD (RDF) %NAME RR
%RECORD (RUSEF) %NAME RU
%RECORD (RTESTF) %NAME RT
%RECORD (RDEFF) %NAME RD
%RECORD (PRECF) %NAME DD
%RECORD (TRIADF) %NAME TT,TT1
%RECORD (USEF) %NAME US
%RECORD (SREDF) %NAME SR
%RECORD (LOOPRECF) %NAME LO
%RECORD (CONRECF) %NAME CN
%RECORD (TINRECF) %NAME TI
!
%CONSTINTEGER INFIN = X'80000001'
%CONSTINTEGER LITBIT = X'80'
%CONSTINTEGER NOTLITBIT = X'7F'
%CONSTINTEGER LITSHIFT = 7
!
%INTEGER CLOOPPTR,COORD,BOEXKEEP,BITS,EFLAG,NRFLAG,NRUSECT,MAXTEMP,MAXWEIGHT
%INTEGER RDSTART,RDPTR,RDEND,RUSESTART,RUSEPTR,RUSEHEAD,RUSECH,RUSEEND
%INTEGER SRTABS,RTESTSTART,RTESTPTR,RTESTEND,RTESTMAX,RTESTCT
%INTEGER RDEFSTART,RDEFPTR,RDEFEND,RDEFMAX,SRPTR
%INTEGER TOUS,USESTACKSTART,USESTACKPTR,I,BLOCK,PTR,CHAIN
%INTEGER SCOP1,SCOP2,BIT,OPN
!
%RECORD (RESF) CURRVAR,QTOUS
!
!
!**************************************************************************
!* STAGE 1.  OUTER LEVEL OF LOOP SCANNED FOR ACCEPTABLE RECURSIVE         *
!*                  DEFINITIONS OF INTEGER VARIABLES.                     *
!*           RD TABLE CONSTRUCTED CONTAINING AN ENTRY FOR EACH REC        *
!*                  DEFN, OF THE FORM                                     *
!*              VAR:    RESF RECORD FOR THE RECURSIVE VARIABLE            *
!*              TRIAD:  TEXT INDEX FOR THE RD ASSIGNMENT                  *
!*              BLOCK:  BLOCK INDEX FOR THE RD ASSIGNMENT                 *
!**************************************************************************
!
!
!* CREATE TABLE SPACE FOR FIXED LENGTH TABLES RTEST,RDEF, TO BE SET UP    
!*     BY COLLECT
      FREETABS = (FREETABS + 3) & X'FFFFFFFC'
      SRTABS = CREATETAB (3*RTESTSZ + 3*RDEFSZ)
      RTESTSTART = SRTABS
      RDEFSTART = SRTABS + 3*RTESTSZ
!
      IDENTIFY
!
!* SCAN THROUGH TEXT IN ALL ALREADY-PROCESSED INNER LOOPS, IN ORDER TO
!*   REMOVE REFS TO REPL'S IN THE OUTER LEVEL.
      CLOOPPTR = PLOOPHEAD
      %WHILE CLOOPPTR # 0 %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         BB == RECORD (ABLOCKS + CL_BLOCK * BLSIZE)
         CURRTRIAD = BB_TEXT
         %CYCLE
         %REPEAT %UNTIL NEXTTRIAD = 0
         CLOOPPTR = CL_PDCHAIN
      %REPEAT
!
      %FOR RDPTR = RDSTART,RDSZ,RDEND %CYCLE
         RR == RECORD (ATABS + RDPTR)
         CURRVAR = RR_VAR
         %UNLESS CURRVAR_FORM = NULL %OR CURRVAR_MODE = CHARMODE %THENSTART
!****************************************************************************
!* STAGE 2.  FOR THE RD IDENTIFIED BY RDPTR, COLLECT ALL INFO ABOUT USES,   *
!*               TESTS, & DEFNS INTO RUSE, RTEST, RDEF.                     *
!*             IF COLLECT DETECTS A CONDITION WHICH MAKES THE RV UNSUITABLE *
!*               FOR REDUCTION, IT RETURNS FALSE.                           *
!*             COLLECT ALSO LOOKS FOR OTHER ENTRIES IN RD TAB FOR THE SAME  *
!*               IDENT, SETTING THEIR RR_VAR_FORM FIELD TO NULL.            *
!****************************************************************************
            DD == RECORD (ADICT + CURRVAR_H0 << DSCALE)
            COORD = DD_COORD
            RUSESTART = FREETABS
            RUSEHEAD = 0
            RUSECH = ADDR (RUSEHEAD)
            BOEXKEEP = BOEX (CURRVAR_H0)
!
            %IF COLLECT # 0 %THENSTART
               %UNLESS SRFLAGS & 1 = 0 %THENSTART
                  PRINTRD
                  PRINTRUSE
                  PRINTRDEF
                  PRINTRTEST
               %FINISH
!***************************************************************************
!* STAGE 3. THE REDUCTION PROCESS.                                         *
!***************************************************************************
               BITS = 0;!   BACKTARG BITS FOR I NOT YET UPDATED.
               NRFLAG = 0;!   NO NON-REDUCIVE USES OF I IN THIS BLOCK.
               NRUSECT = 0;!   COUNT OF ALL NON-REDUCIVE USES.
               MAXTEMP = 0;!                 BEST-TEMP-SO-FAR
               MAXWEIGHT = INFIN - 1;!        INFORMATION.
               USESTACKSTART = FREETABS
               RUSEPTR = RUSEHEAD
               %WHILE RUSEPTR # 0 %CYCLE
                  RU == RECORD (ATABS + RUSEPTR)
                  CHAIN = RU_CHAIN
                  CURRTRIAD = RU_TRIAD
                  %UNLESS CURRTRIAD = 0 %THENSTART
                     PREVTRIAD = RU_PREV
                     TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
                     BB == RECORD (ABLOCKS + RU_BLOCK * BLSIZE)
                     %UNLESS TT_CHAIN = CURRTRIAD %THENSTART
                        PREVTRIAD = BB_TEXT
                        TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
                        %WHILE TT_CHAIN # CURRTRIAD %CYCLE
                           PREVTRIAD = TT_CHAIN
                           TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
                        %REPEAT
                     %FINISH
                     %IF OPT = 1 %AND BB_FLAGS & ARTICBIT = 0 %THENSTART
                        NRUSECT = NRUSECT + 1
                        NRFLAG = 1
                     %FINISHELSESTART
                        FREETABS = USESTACKSTART 
                        USESTACKPTR = CREATETAB (USESZ)
                        US == RECORD (ATABS + USESTACKPTR)
                        US_BLOCK = RU_BLOCK
                        US_TRIAD = CURRTRIAD
                        US_RV = CURRVAR
                        US_TEMP = 0
                        US_USES = 1
                        TOUS = CURRVAR_H0
                        QTOUS = CURRVAR
                        RDEFPTR = RDEFSTART
                        %FOR I = 1,1,3 %CYCLE
                           RD == RECORD (ATABS + RDEFPTR)
                           US_SIGN (I) = RD_SIGN
                           US_LITINC(I) = RD_LITINC
                           RDEFPTR = RDEFPTR + RDEFSZ
                          %IF RDEFPTR>RDEFEND %THEN %EXIT
                        %REPEAT
!* EXAMINE THE USE OF T-O-US IN CURRTRIAD TO SEE IF IT IS REDUCIVE.
{LSR_EXAM}              %CYCLE
                           %IF EXAMINE = 1 %THEN REDUCE %ELSESTART
{LSR_NONRED}                  %IF QTOUS_W = CURRVAR_W %THENSTART
                                 NRUSECT = NRUSECT + 1
                                 NRFLAG = 1
                                 %EXIT
                              %FINISH
                              EFLAG = 0
{LSR_SUBT}              L1:   SUBTEMP;!  GENERATE A TEMP & SUBSTITUTE FOR T-O-US.
                              %IF US_USES = 0 %THENSTART
                                 FREETABS = FREETABS - USESZ
                                 USESTACKPTR = USESTACKPTR - USESZ
                                 %IF USESTACKPTR < USESTACKSTART %THEN %EXIT
                                 US == RECORD (ATABS + USESTACKPTR)
                                 TOUS = US_RV_H0
                                 QTOUS = US_RV
                              %FINISH
                           %FINISH
{LSR_SCAN}                 %IF SCAN = 0 %THENSTART
                              EFLAG = 1;!  STILL LOOKING FOR FURTHER USES.
                              -> L1
                           %FINISH
                        %REPEAT
                     %FINISH
                  %FINISH
!*  REDUCTION (OR NOT) OF THIS RUSE ENTRY NOW COMPLETE, EXCEPT FOR BITSTRIPS.
!*    IF CURRENT ENTRY WAS LAST IN BLOCK & ALL ENTRIES HAVE BEEN REDUCED,
!*    WE UNSET ALL BITS FOR I.
{LSR_RP5}         BLOCK = RU_BLOCK
                  RU == RECORD (ATABS + CHAIN)
                  %IF CHAIN = 0 %OR RU_BLOCK # BLOCK %THENSTART
                     %IF NRFLAG = 0 %THENSTART
                        BB == RECORD (ABLOCKS + BLOCK * BLSIZE)
                        CLEARBIT (ABLOCKS+BB_USE,COORD)
                        CLEARBIT (ABLOCKS+BB_DEF,COORD)
                        CLEARBIT (ABLOCKS+BB_BOE,COORD)
                     %FINISHELSE NRFLAG = 0
                  %FINISH
                  RUSEPTR = CHAIN
               %REPEAT
!***************************************************************************
!* STAGE 4.  THE REPLACEMENT PROCESS.  IF BUSY-ON-EXIT WE CANNOT DO ANY    *
!*             REPLACEMENT OF USES, SO DON'T DO TEST REPLACEMENT EITHER.   *
!*           IF I NOT B-O-EX, WE KNOW IT WILL BE REMOVED COMPLETELY, & WE  *
!*             CLEAR BIT STRIPS FOR BLOCKS CONTAINING TESTS & DEFNS.       *
!***************************************************************************
{LSR_REP}      %FOR RDEFPTR = RDEFSTART,RDEFSZ,RDEFEND %CYCLE
                  RD == RECORD (ATABS + RDEFPTR)
                  BB == RECORD (ABLOCKS + RD_BLOCK * BLSIZE)
                  PUTBIT (ABLOCKS+BB_USE,COORD,BOEXKEEP)
                  PUTBIT (ABLOCKS+BB_DEF,COORD,BOEXKEEP)
                  PUTBIT (ABLOCKS+BB_BOE,COORD,BOEXKEEP)
               %REPEAT
               %FOR RTESTPTR = RTESTSTART,RTESTSZ,RTESTEND %CYCLE
                  RT == RECORD (ATABS + RTESTPTR)
                  BB == RECORD (ABLOCKS + RT_BLOCK * BLSIZE)
                  PUTBIT (ABLOCKS+BB_USE,COORD,BOEXKEEP)
                  PUTBIT (ABLOCKS+BB_BOE,COORD,BOEXKEEP)
               %REPEAT
               %IF BOEXKEEP = 0 %THENSTART
                  IREPL;!  REPLACE ALL NON-REDUCED USES OF I.
!*  REPLACE TESTS OF I BY TESTS OF TEMP.
                  %IF RTESTEND >= RTESTSTART %THEN REPLACE
!*  RD'S OF I CAN NOW BE REMOVED AS THEY ARE THE ONLY REMAINING REFERENCES.
                  %FOR RDEFPTR = RDEFSTART,RDEFSZ,RDEFEND %CYCLE
                     RD == RECORD (ATABS +RDEFPTR)
                     DELUSE (RD_ASSTRIAD)
                  %REPEAT
               %FINISH
{LSR_RP1}   %FINISH
            FREETABS = RUSESTART
         %FINISH
      %REPEAT
      FREETABS = SRTABS
!
!
!
!
!
%ROUTINE IDENTIFY
!
!***************************************************************************
!*  ALL ACCEPTABLE DEFINITIONS FOUND IN THE LOOP ARE RECORDED IN RD TABLE. *
!*    LOOKS FOR TRIADS AT TOP LEVEL OF LOOP, OF THE FORM:-                 *
!*                  @N:   I  <-  @M                                        *
!*          WHERE I IS   INT4 or INT2  &                                   *
!*                       NOT DEFINED IN ANY INNER LOOP  &                  *
!*                       NOT EQUIVALENCED.                                 *
!*            AND @M IS ONE OF   I + LOOP CONSTANT                         *
!*                               I - LOOP CONSTANT                         *
!*                               LOOP CONSTANT + I                         *
!***************************************************************************
!
%INTEGER OPN,OP2,BLOCK
%RECORD (RESF) OPD
!
      RDSTART = FREETABS
      RDPTR=FREETABS-RDSZ
      CLOOPPTR = DLOOPHEAD
      %WHILE CLOOPPTR#0 %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         BLOCK = CL_BLOCK
         BB == RECORD (ABLOCKS + BLOCK * BLSIZE)
         CURRTRIAD = BB_TEXT
         %WHILE NEXTTRIAD = 1 %CYCLE
            TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
            %UNLESS TT_OP = ASMT %THEN %CONTINUE
            %UNLESS TT_QOPD2 & TEXTMASK # 0 %THEN %CONTINUE
            OP2 = TT_OPD2
            %IF TT_QOPD1 & IDMASK = 0 %THEN %CONTINUE
            %UNLESS TT_MODE = INT4 %or TT_Mode = INT2 %THEN %CONTINUE
            CURRVAR = TT_RES1
            DD == RECORD (ADICT + TT_OPD1 << DSCALE)
            %IF DD_X1 & EQUIVBIT # 0 %THEN %CONTINUE
            GETBIT (ADDR(PLOOPDEF(0)),DD_COORD,BIT)
            %IF BIT # 0 %THEN %CONTINUE
            TT == RECORD (ATRIADS + OP2 * TRIADLENGTH)
            OPN = TT_OP
            %UNLESS OPN = ADD %OR OPN = SUB %THEN %CONTINUE
            %UNLESS TT_RES1_W = CURRVAR_W %AND LOOPCON2(OP2) = 1 %THENSTART
               %UNLESS TT_RES2_W = CURRVAR_W %AND OPN = ADD   %C
                          %AND LOOPCON1 (OP2) = 1 %THEN %CONTINUE %ELSESTART
                  OPD = TT_RES2
                  TT_RES2 = TT_RES1
                  TT_RES1 = OPD
               %FINISH
            %FINISH
!* CREATE AN ENTRY IN RD TABLE.
            RDPTR = CREATETAB (RDSZ)
            RR == RECORD (ATABS + RDPTR)
            RR_VAR = CURRVAR
            RR_TRIAD = CURRTRIAD
            RR_BLOCK = BLOCK
         %REPEAT
         CLOOPPTR = CL_PDCHAIN
      %REPEAT
      RDEND = RDPTR
!
%END;!  IDENTIFY
!
!
!
!
%INTEGERFUNCTION COLLECT
!
!****************************************************************************
!* COLLECTS AS MUCH INFORMATION AS POSSIBLE ABOUT THE RECURSIVE VARIABLE    *
!* INDICATED BY RDPTR.   IF ANYTHING RENDERS IT UNSUITABLE, WE EXIT FALSE,  *
!* ABORTING REDUCTION OF THIS VARIABLE.   OTHERWISE 3 TABLES ARE BUILT:     *
!*   RDEF, CONTAINING AN ENTRY FOR EACH RECURSIVE DEFN OF THE VAR (MAX 3)   *
!*   RTEST, CONTAINING AN ENTRY FOR EACH TEST AGAINST A LOOP CONST (MAX 3)  *
!*   RUSE, CONTAINING AN ENTRY FOR EACH OTHER USE.                          *
!****************************************************************************
!
%INTEGER BIT1,BIT2,OPN,CONST,UFLAG,RDENT,NEWTR,SIGN
!
!* ALL THE RECURSIVE DEFNS OF THE VAR ARE PICKED UP BY SCANNING THE REMAINDER
!*  OF RD TABLE, AND SKELETON ENTRIES PLACED ON RDEF TABLE.
      RDEFEND = RDEFSTART - RDEFSZ
      RDEFMAX = RDEFSTART + 2 * RDEFSZ
      %FOR RDENT = RDPTR,RDSZ,RDEND %CYCLE
         RR == RECORD (ATABS + RDENT)
         %IF RR_VAR_W = CURRVAR_W %THENSTART
            RR_VAR_FORM = NULL
            RDEFEND = RDEFEND + RDEFSZ
            %UNLESS RDEFEND > RDEFMAX %THENSTART
               RD == RECORD (ATABS + RDEFEND)
               RD_BLOCK = RR_BLOCK
               RD_ASSTRIAD = RR_TRIAD
               TT == RECORD (ATRIADS + RR_TRIAD * TRIADLENGTH)
               RD_INCTRIAD = TT_OPD2
            %FINISH
         %FINISH
      %REPEAT
      %IF RDEFEND > RDEFMAX %THEN %RESULT = 0;!  MORE THAN 3 DEFNS.
!* SCAN THROUGH EVERY BLOCK IN DLOOP WITH A BIT FOR I SET, WITH 2 OBJECTS IN
!*   MIND:  TO FIND REASONS TO DISQUALIFY I, AND TO FIND ALL USES OF I.
      RTESTEND = RTESTSTART -RTESTSZ
      RTESTMAX = RTESTSTART + 2 * RTESTSZ
      RTESTCT = 0
      CLOOPPTR = DLOOPHEAD
      %WHILE CLOOPPTR#0 %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         BLOCK = CL_BLOCK
         BB == RECORD (ABLOCKS + BLOCK * BLSIZE)
         GETBIT (ABLOCKS+BB_USE,COORD,BIT1)
         GETBIT (ABLOCKS+BB_DEF,COORD,BIT2)
         %IF BIT1 # 0 %OR BIT2 # 0 %THENSTART
            UFLAG = 0
            CURRTRIAD = BB_TEXT
            %WHILE NEXTTRIAD = 1 %CYCLE
               %IF DD_CLASS & CMNBIT # 0 %AND ALLDEF (CURRTRIAD) = -1 %C
                                        %THEN %RESULT = 0
               TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
               OPN = TT_OP
               %IF OPN=IOITEM %OR OPN=DIOITEM %THEN %RESULT=0
               %IF TT_RES1_W = CURRVAR_W %THENSTART
                  UFLAG = 1
                  %IF OPN = ASMT %THENSTART
                     RDEFPTR = RDEFSTART
                     %CYCLE
                        RD == RECORD (ATABS + RDEFPTR)
                        %IF RD_ASSTRIAD = CURRTRIAD %THEN %EXIT
                        RDEFPTR = RDEFPTR + RDEFSZ
                        %IF RDEFPTR > RDEFEND %THEN %RESULT = 0
                     %REPEAT
!* FIND INCREMENT TRIAD IN RUSE.  MUST ALWAYS BE THERE.
                     %FOR RUSEPTR = RUSEEND,-RUSESZ,RUSESTART %CYCLE
                        RU == RECORD (ATABS + RUSEPTR)
                        %IF RU_TRIAD = RD_INCTRIAD %THEN %EXIT
                     %REPEAT
                     TT == RECORD (ATRIADS + RU_TRIAD * TRIADLENGTH)
                     %IF TT_USE = 1 %THENSTART
!* IF INCREMENT TRIAD DOESN'T IMMEDIATELY PRECEDE ASMT, RECHAIN IT SO IT DOES.
                        %IF TT_CHAIN = CURRTRIAD %THENSTART
                           RD_INCPREV = RU_PREV
                        %FINISHELSESTART
                           RD_INCPREV = PREVTRIAD
                           TT1 == RECORD (ATRIADS + RU_PREV * TRIADLENGTH)
                           TT1_CHAIN = TT_CHAIN
                           TT_CHAIN = CURRTRIAD
                           TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
                           TT1_CHAIN = RU_TRIAD
                        %FINISH
                        RU_TRIAD = 0
                     %FINISHELSESTART
!* IF USE CT. OF INCREMENT TRIAD > 1, CREATE A NEW TRIAD WITH USE CT = 1.
                        TT_USE = TT_USE - 1
                        NEWTR = GETTRIAD
                        TT1 == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
                        TT1_OPD2 = NEWTR
                        TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
                        TT1_CHAIN = NEWTR
                        RD_INCTRIAD = NEWTR
                        RD_INCPREV = PREVTRIAD
                        TT1 == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
                        TT1 = TT
                        TT1_USE = 1
                        TT1_CHAIN = CURRTRIAD
                        %IF TT1_QOPD2 & TEXTMASK # 0 %THENSTART
                           TT1 == RECORD (ATRIADS + TT1_OPD2 * TRIADLENGTH)
                           TT1_USE = TT1_USE + 1
                        %FINISH
                     %FINISH
                     TT1 == RECORD ( ATRIADS + RD_INCTRIAD * TRIADLENGTH)
                     %IF TT1_OP = ADD %THEN SIGN = 0 %ELSE SIGN = 1
                     %IF TT1_QOPD2 & CONSTMASK = 0 %THENSTART
                        RD_INC = TT1_RES2
                        RD_SIGN = SIGN
                     %FINISHELSESTART
                        CONST = CONOUT (TT1_RES2)
                        %IF CONST < 0 %THENSTART
                           SIGN = SIGN !! 1
                           CONST = -CONST
                        %FINISH
                        RD_LITINC = CONST
                        RD_SIGN = SIGN ! LITBIT
                     %FINISH
                  %FINISHELSEIF OPN = ASGN %THEN %RESULT = 0   %C
                        %ELSEIF OPN = DIOITEM %THEN %RESULT = 0   %C
                        %ELSEIF OPN = DARG %THEN %RESULT = 0  %C
                        %ELSEUNLESS GT <= OPN <= LE %C
                            %AND LOOPCON2 (CURRTRIAD) = 1   %C
                            %AND RTENTRY = 1 %THENSTART
                     RUENTRY
                     %IF OPN # ADD %AND TT_RES2_W = CURRVAR_W %THEN RUENTRY
                  %FINISH
               %FINISHELSESTART
!*  IF OPD 1 WASN'T I AND OPD 2 IS:
!*    IF DEFARG:  NON-RECURSIVE DEFN SO ABORT
!*    IF COMPARISON AGAINST LOOP CONST:  CREATE RTEST ENTRY IF POSS
!*    ELSE:  CREATE RUSE ENTRY AS ABOVE.
                  %IF TT_RES2_W = CURRVAR_W %THENSTART
                     UFLAG = 1
                     %IF OPN = DARG %THEN %RESULT = 0   %C
                          %ELSEUNLESS GT <= OPN <= LE %C
                            %AND LOOPCON1 (CURRTRIAD) = 1   %C
                              %AND RTENTRY = 1 %THEN RUENTRY
                  %FINISH
               %FINISH
            %REPEAT
            %IF UFLAG = 0 %THENSTART ;!  A BIT STRIP WAS SET UNNECESSARILY, SO CLEAR THEM.
               CLEARBIT (ABLOCKS+BB_USE,COORD)
               CLEARBIT (ABLOCKS+BB_DEF,COORD)
               CLEARBIT (ABLOCKS+BB_BOE,COORD)
            %FINISH
         %FINISH
         CLOOPPTR = CL_PDCHAIN
      %REPEAT
      %RESULT = 1
!
%END;!  COLLECT
!
!
!
!
%INTEGERFUNCTION RTENTRY
!
!*************************************************************************
!* IF THERE IS ROOM IN THE FIXED-SIZE TABLE RTEST, A NEW ENTRY IS        *
!*   ADDED, FILLED WITH THE RELEVANT VALUES, AND TRUE IS RETURNED.       *
!*   IF NOT, FALSE IS RETURNED.                                          *
!*************************************************************************
!
      %IF RTESTEND = RTESTMAX %THEN %RESULT = 0
      RTESTEND = RTESTEND + RTESTSZ
      RT == RECORD (ATABS + RTESTEND)
      RT_TRIAD = CURRTRIAD
      RT_BLOCK = BLOCK
      RTESTCT = RTESTCT + 1
      %RESULT = 1
!
%END;!   RTENTRY
!
!
!
!
%ROUTINE RUENTRY
!
!**************************************************************************
!* CREATES A NEW RUSE ENTRY, AND FILLS WITH THE RELEVANT VALUES.          *
!**************************************************************************
!
      RUSEEND = CREATETAB (RUSESZ)
      RU == RECORD (ATABS + RUSEEND)
      RU_PREV = PREVTRIAD
      RU_TRIAD = CURRTRIAD
      RU_BLOCK = BLOCK
      RU_CHAIN = 0
      INTEGER (RUSECH) = RUSEEND
      RUSECH = ADDR (RU_CHAIN)
!
%END;!   RUENTRY
!
!
!
!
%INTEGERFUNCTION EXAMINE 
!
!****************************************************************************
!* EXAMINES THE TRIAD 'CURRTRIAD', TO SEE WHETHER IT IS A REDUCIVE USE OF   *
!*   TOP-OF-USE-STACK.  IF SO RETURNS TRUE, ELSE FALSE.                     *
!*   ALSO RETURNS USEFUL INFO ABOUT OPDS 1 & 2 IN SCOP1 & SCOP2.            *
!****************************************************************************
!
%INTEGER OPD
!
!*  STEP 1. CLASSIFY THE OPERATOR.
      TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
      OPN = TT_OP
      %if Opn=ADD %and TT_Qopd2=LIT %then %result=0
      %UNLESS ADD <= OPN <= MULT %OR OPN = NEG %OR   %C
              OPN = BRK %THEN %RESULT = 0
!*  STEP 2. CLASSIFY OPD 1.
      %IF TT_RES1_W>>1 = QTOUS_W>>1 %THEN SCOP1 = 1   %C
      %ELSEIF TT_RES1_W>>1 = CURRVAR_W>>1 %THEN SCOP1 = 2   %C
      %ELSEIF TT_QOPD1 & CONSTMASK # 0 %THENSTART
        %IF CONOUT(TT_RES1)<0 %THEN %RESULT=0
         SCOP1 = 4
      %FINISHELSEIF TT_QOPD1 & IDMASK # 0 %THENSTART
         DD == RECORD (ADICT + TT_OPD1 << DSCALE)
         GETBIT (ADDR(CLOOPDEF(0)),DD_COORD,BIT)
         %UNLESS BIT = 0 %THEN %RESULT = 0
         SCOP1 = 5
      %FINISHELSESTART
         %UNLESS TT_QOPD1 & TEXTMASK # 0 %THEN %RESULT = 0
         TT1 == RECORD (ATRIADS + TT_OPD1 * TRIADLENGTH)
         %IF TT1_OP & BMBIT = 0 %THEN %RESULT = 0
         SCOP1 = 6
      %FINISH
!*  STEP 3. CLASSIFY OPD2 (DISQUALIFYING QTOUS-OP-QTOUS, UNLESS QTOUS=CURRVAR)
      OPD = TT_RES2_W>>1
      %IF OPD = CURRVAR_W>>1 %THENSTART
         %IF OPD = QTOUS_W>>1 %THEN SCOP2 = 1 %ELSE SCOP2 = 2
      %FINISHELSEIF OPD = QTOUS_W>>1 %THENSTART
         %IF SCOP1 = 1 %THEN %RESULT = 0 %ELSE SCOP2 = 1
      %FINISHELSESTART
         OPD = TT_QOPD2
         %IF OPD & CONSTMASK # 0 %THEN SCOP2 = 4   %C
         %ELSEIF OPD & IDMASK # 0 %THENSTART
            DD == RECORD (ADICT + TT_OPD2 << DSCALE)
            GETBIT (ADDR(CLOOPDEF(0)),DD_COORD,BIT)
            %UNLESS BIT = 0 %THEN %RESULT = 0
            SCOP2 = 5
         %FINISHELSEIF OPD & TEXTMASK # 0 %THENSTART
            TT1 == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
            %IF TT1_OP & BMBIT = 0 %THEN %RESULT = 0
            SCOP2 = 6
         %FINISHELSEIF OPD = SRTEMP %THEN %RESULT = 0 %ELSE SCOP2 = 7
      %FINISH
!*  STEP 4. DISQUALIFY TOUS*I, I*I, I*TOUS.
      %IF OPN = MULT %AND SCOP1 + SCOP2 <= 4 %THEN %RESULT = 0   %C
                                             %ELSE %RESULT = 1
!
%END;!   EXAMINE
!
!
!
!
%ROUTINE REDUCE 
!
!****************************************************************************
!* A REDUCIVE USE OF THE CURRENT TOP-OF-USE-STACK HAS BEEN DETECTED IN      *
!*   TRIAD 'CURRTRIAD'.  THIS IS REDUCED BY  (A) CHAINING IT INTO THE BACK  *
!*   TARGET FOR SUBSEQUENT USE IN A TEMPORARY INITIALISATION SEQUENCE, AND  *
!*   (B) CONSIDERING CURRTRIAD AS A RECURSIVE VARIABLE & ADDING IT TO       *
!*   USESTACK WITH APPROPRIATE INCREMENT & SIGN.                            *
!****************************************************************************
!
%ROUTINESPEC GENROP
!
%INTEGER BLK,PTR,OLDUSEPTR,NEGM,CONST,LITSW,SIGN,CONST2,LITSW2,SIGN2,OPN2,I
%RECORD (RESF) OPD
%RECORD (USEF) %NAME US1
!
!* STAGE 1. CHAIN CURRTRIAD INTO BACK TARG.
      TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
      TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
      TT1_CHAIN = TT_CHAIN
      TT1 == RECORD (ATRIADS + BTARGTRIAD * TRIADLENGTH)
      TT_CHAIN = TT1_CHAIN
      TT1_CHAIN = CURRTRIAD
      BTARGTRIAD = CURRTRIAD
      CURRTRIAD = PREVTRIAD
      BB == RECORD (ABLOCKS + BACKTARG * BLSIZE)
!* IF EITHER OPD IS IDENT, SET BTARG BIT STRIPS.
      %IF SCOP1 = 5 %OR SCOP2 = 5 %THENSTART
         %IF SCOP1 = 5 %THEN DD == RECORD (ADICT + TT_OPD1 << DSCALE)   %C
                       %ELSE DD == RECORD (ADICT + TT_OPD2 << DSCALE)
         SETBIT (ABLOCKS+BB_USE,DD_COORD)
         GETBIT (ABLOCKS+BB_DEF,DD_COORD,BIT)
         %IF BIT = 0 %THEN SETBIT (ABLOCKS+BB_BOE,DD_COORD)
      %FINISH
!* IF 1ST TIME THRO' FOR THIS REC VAR, SET ITS BTARG BIT STRIPS.
      %IF BITS = 0 %THENSTART
         BITS = 1
         SETBIT (ABLOCKS+BB_USE,COORD)
         GETBIT (ABLOCKS+BB_DEF,COORD,BIT)
         %IF BIT = 0 %THEN SETBIT (ABLOCKS+BB_BOE,COORD)
      %FINISH
!* IF THIS IS A USE OF THE ORIGINAL RECURSIVE VAR THE RUSE ENTRY IS DELETED.
!*   IF NOT THE R.V.'S USE CT MUST BE INCREMENTED BY 1.
      %IF QTOUS_W>>1 = CURRVAR_W>>1 %THEN RU_TRIAD = 0 %ELSESTART
         TT1 == RECORD (ATRIADS + TOUS * TRIADLENGTH)
         TT1_USE = TT1_USE + 1
      %FINISH
!* SCAN THRO' REMAINDER OF RUSE TO CHECK THAT CHAINED-OUT TRIAD WASN'T 
!*   PREVTRIAD FOR ANOTHER ENTRY.
      %FOR PTR = RUSEPTR+RUSESZ,RUSESZ,RUSEEND %CYCLE
         RU == RECORD (ATABS + PTR)
         %IF RU_PREV = BTARGTRIAD %THEN RU_PREV = CURRTRIAD
      %REPEAT
!* IF WE HAVE THE REDUCIVE FORM  TOUS + I  (TOUS # I), THE RUSE ENTRY FOR THE
!*   I MUST BE DELETED & THE BIT STRIPS ADJUSTED.  (I + I YIELDS ONLY
!*   ONE RUSE ENTRY.)
      %IF SCOP1 + SCOP2 = 3 %THENSTART
         %FOR PTR = RUSEPTR+RUSESZ,RUSESZ,RUSEEND %CYCLE
            RU == RECORD (ATABS + PTR)
            %IF RU_TRIAD = BTARGTRIAD %THEN %EXIT
         %REPEAT
         RU_TRIAD = 0
         BLK = RU_BLOCK
         RU == RECORD (ATABS + PTR-RUSESZ)
         %UNLESS RU_BLOCK = BLK %THENSTART
            PTR = PTR + RUSESZ
            RU == RECORD (ATABS + PTR)
            %IF PTR > RUSEEND %OR RU_BLOCK # BLK %THENSTART
               BB == RECORD (ABLOCKS + BLK * BLSIZE)
               CLEARBIT (ABLOCKS+BB_USE,COORD)
               CLEARBIT (ABLOCKS+BB_DEF,COORD)
               CLEARBIT (ABLOCKS+BB_BOE,COORD)
            %FINISH
         %FINISH
      %FINISH
!* STAGE 2. SET UP THE NEW USESTACK ENTRY. (IF USES FIELD OF OLD ENTRY HAS REACHED
!*             0 THEN NEW ENTRY OVERWRITES OLD.)
      OLDUSEPTR = USESTACKPTR
      BLK = US_BLOCK
      US_USES = US_USES - 1
      %IF US_USES # 0 %THENSTART
         US_TRIAD = CURRTRIAD
         USESTACKPTR = CREATETAB (USESZ)
         US == RECORD (ATABS + USESTACKPTR)
         %FOR I =1,1,3 %CYCLE
            US_SIGN(I) = 0
            US_LITINC(I) = 0
         %REPEAT
      %FINISH
      TOUS = BTARGTRIAD
      QTOUS_H0 = BTARGTRIAD
      QTOUS_FORM = TRIAD
      QTOUS_MODE = CURRVAR_MODE
      US_RV = QTOUS
      US_TRIAD = CURRTRIAD
      US_BLOCK = BLK
      US_USES = TT_USE
      TT_USE = 0
      US_TEMP = 0
      US1 == RECORD (ATABS + OLDUSEPTR)
      I = 1
      %FOR RDEFPTR = RDEFSTART,RDEFSZ,RDEFEND %CYCLE
         NEGM = 0
         CONST = US1_LITINC(I)
         SIGN = US1_SIGN(I) & NOTLITBIT
         LITSW = US1_SIGN(I) >> LITSHIFT
         %IF SCOP1 + SCOP2 > 3 %THENSTART
!* NORMAL REDUCIVE CASE.
            %IF OPN = MULT %THENSTART
               %IF SCOP1 > 3 %THEN OPD = TT_RES1   %C
                             %ELSE OPD = TT_RES2
               SIGN2 = 0
               %IF OPD_FORM & CONSTMASK # 0 %THENSTART
                  CONST2 = CONOUT (OPD)
                  LITSW2 = 1
               %FINISHELSESTART
                  NEGM = 2
                  CONST2 = OPD_W
                  LITSW2 = 0
               %FINISH
               %IF LITSW = 1 %AND CONST = 1 %THENSTART;!   IF OLD TOUS INCT = 1.
                  CONST = CONST2
                  LITSW = LITSW2
               %FINISHELSESTART
                  %IF LITSW = LITSW2 = 1 %THENSTART
!* IF BOTH KNOWN CONSTANTS, EVALUATE NEW INCT.
                     CONST = CONVAL (CONST,CONST2,MULT,INT4)
                     %IF CONST < 0 %THENSTART
                        CONST = -CONST
                        NEGM = 1
                     %FINISH
                  %FINISHELSESTART
                     OPN2 = MULT
                     GENROP
                  %FINISH
               %FINISH
            %FINISH
         %FINISHELSESTART
!* SCOP1 +SCOP2 <= 3. I.E. 'TOUS +- I' OR 'I +- TOUS'
            RD == RECORD (ATABS + RDEFPTR)
            OPN2 = ((RD_SIGN !! SIGN) & 1 ) !! OPN;!   SWAPS ADD OR SUB IF SIGNS ARE DIFFERENT.
            LITSW2 = RD_SIGN >> LITSHIFT
            CONST2 = RD_LITINC
            %IF LITSW2 & LITSW # 0 %THENSTART
!* IF BOTH KNOWN CONSTANTS, EVALUATE NEW INCT.
               CONST = CONVAL (CONST,RD_LITINC,OPN2,INT4)
               LITSW = 1
            %FINISHELSE GENROP
         %FINISH
         US_LITINC(I) = CONST
         %IF (SCOP2 = 1 %AND OPN = SUB) %OR OPN = NEG %OR NEGM = 1 %THENSTART
            %IF SIGN <= 1 %THEN SIGN = SIGN !! 1   %C
                           %ELSE SIGN = SIGN + 1
         %FINISHELSE SIGN = SIGN + NEGM
         US_SIGN(I) = SIGN ! (LITSW << LITSHIFT)
         I = I + 1
      %REPEAT
      %UNLESS SRFLAGS & 2 = 0 %THEN PRINTUSESTACK
!
!
!
!
%ROUTINE GENROP
!
!***************************************************************************
!* GENERATE A TRIAD IN THE BACK TARGET TO COMPUTE THE INCREMENT FOR THE    *
!*   NEW T-O-US.  CALL TARGHK FOR EACH OPERAND TO ADJUST BIT STRIPS ETC.   *
!*      ON ENTRY TWO OPERANDS ARE IN LITSW, CONST                          *
!*                                   LITSW2, CONST2                        *
!*                  (IF LITSW = 0, CONST IS A RESF RECORD,                 *
!*                   IF LITSW = 1, CONST IS A 32-BIT VALUE.)               *
!*               OPERATION TO BE PERFORMED IS IN OPN2.                     *
!*      RETURNS TEXT POINTER IN CONST, & LITSW = 0.                        *
!***************************************************************************
!
%INTEGER NEWTRIAD
%RECORD (RESF) OPND1,OPND2
!
      %IF LITSW = 0 %THENSTART
         OPND1_W = CONST
         TARGHK (OPND1)
      %FINISHELSE OPND1_W = CONIN (CONST)
      %IF LITSW2 = 0 %THENSTART
         OPND2_W = CONST2
         TARGHK (OPND2)
      %FINISHELSE OPND2_W = CONIN (CONST2)
      NEWTRIAD = GETTRIAD
      TT == RECORD (ATRIADS + NEWTRIAD * TRIADLENGTH)
      TT_USE = 0
      TT_OP = OPN2
      TT_RES1 = OPND1
      TT_RES2 = OPND2
      TT1 == RECORD (ATRIADS + BTARGTRIAD * TRIADLENGTH)
      TT_CHAIN = TT1_CHAIN
      TT1_CHAIN = NEWTRIAD
      BTARGTRIAD = NEWTRIAD
      OPND1_H0 = NEWTRIAD
      OPND1_FORM = TRIAD
      CONST = OPND1_W
      LITSW = 0
!
%END;!    GENROP
!
%END;!   REDUCE
!
!
!
!
%ROUTINE TARGHK (%RECORD (RESF) OPD)
!
!***************************************************************************
!* WHEN ADDING AN OPERAND TO THE BACK TARGET (AS PART OF CALCULATION OF    *
!*   NEW INCREMENT):                                                       *
!*     A) IF IDENT, UPDATE BIT STRIPS                                      *
!*     B) IF A TEXT POINTER, UPDATE THE USE COUNT.                         *
!***************************************************************************
!
      %IF OPD_FORM & IDMASK # 0 %THENSTART
         DD == RECORD (ADICT + OPD_H0 << DSCALE)
         BB == RECORD (ABLOCKS + BACKTARG * BLSIZE)
         SETBIT (ABLOCKS+BB_USE,DD_COORD)
         GETBIT (ABLOCKS+BB_DEF,DD_COORD,BIT)
         %IF BIT = 0 %THEN SETBIT (ABLOCKS+BB_BOE,DD_COORD)
      %FINISHELSEIF OPD_FORM & TEXTMASK # 0 %THENSTART
         TT == RECORD (ATRIADS + OPD_H0 * TRIADLENGTH)
         TT_USE = TT_USE + 1
      %FINISH
!
%END;!   TARGHK
!
!
!
!
%ROUTINE SUBTEMP
!
!*****************************************************************************
!* REPLACE A USE (OR USES) OF T-O-US BY AN APPROPRIATE TEMPORARY, ACCORDING  *
!*   TO THE SETTING OF EFLAG.                                                *
!*    EFLAG = 0 => A NON-REDUCIVE USE OF T-O-US HAS BEEN FOUND, SO REPLACE IT*
!*    EFLAG = 1 => END OF OUTER LEVEL OF LOOP HAS BEEN REACHED BEFORE ALL    *
!*                   USES OF T-O-US HAVE BEEN PROCESSED, SO REPLACE ALL USES *
!*                   IN INNER LOOPS.                                         *
!*****************************************************************************
!
%INTEGER I
!
!* STAGE 1. IF NECESSARY, GENERATE A NEW TEMPORARY.
      %IF US_TEMP = 0 %THEN SRENTRY (0)   %C
                      %ELSE SRPTR = US_TEMP
      SR == RECORD (ABLOCKS + SRPTR << SRSCALE)
      %FOR I = 1,1,SR_USECT %CYCLE 
         %IF SR_USE(I) = 0 %THEN %EXIT
      %REPEAT
      %IF EFLAG = 0 %THENSTART
!* STAGE 2A. REPLACE THE USE OF T-O-US IN CURRTRIAD BY A USE OF THE SR TEMP.
         US_USES = US_USES - 1
         SR_USE(I) = CURRTRIAD
         TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
         %IF TT_RES1_W>>1 = QTOUS_W>>1 %THENSTART
            TT_QOPD1 = SRTEMP
            TT_OPD1 = SRPTR
            US_TRIAD = PREVTRIAD
         %FINISHELSESTART
            TT_QOPD2 = SRTEMP
            TT_OPD2 = SRPTR
            %IF TT_OP = ARR %OR TT_OP = DEFARR %THENSTART
               %IF CMPLX8 <= TT_MODE <= CMPLX32 %C
                                        %THEN SR_WEIGHT = SR_WEIGHT + 2   %C
                                       %ELSE SR_WEIGHT = SR_WEIGHT + 1
            %FINISH
         %FINISH
      %FINISHELSESTART
!* STAGE 2B. REPLACE ALL OUTSTANDING USES OF T-O-US IN INNER LOOPS BY USES OF
!*           THE SR TEMP.  THERE MAY BE SEVERAL USES, DEFINED BY US_USES.
!*           MUST ALL BE THERE IN PLOOP LIST. THESE USES DON'T AFFECT WEIGHTINGS.
         CLOOPPTR = PLOOPHEAD
         %WHILE CLOOPPTR # 0 %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            BB == RECORD (ABLOCKS + CL_BLOCK * BLSIZE)
            CURRTRIAD = BB_TEXT
            %WHILE NEXTTRIAD = 1 %CYCLE
               TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
               %IF TT_RES1_W>>1 = QTOUS_W>>1 %THENSTART
                  SR_USE(I) = CURRTRIAD
                  I = I + 1
                  TT_OPD1 = SRPTR
                  TT_QOPD1 = SRTEMP
                  US_USES = US_USES - 1
                  %IF US_USES = 0 %THEN -> L1
               %FINISH
               %UNLESS TT_RES2_W>>1 = QTOUS_W>>1 %THEN %CONTINUE
               SR_USE(I) = CURRTRIAD
               I = I + 1
               TT_OPD2 = SRPTR
               TT_QOPD2 = SRTEMP
               US_USES = US_USES - 1
               %IF US_USES = 0 %THEN -> L1
            %REPEAT
            CLOOPPTR = CL_PDCHAIN
         %REPEAT
      %FINISH
!* STAGE 3. COMPARE WEIGHT OF THIS TEMP WITH CURRENT MAXIMUM, & UPDATE IF NECESSARY.
L1:   %IF SR_WEIGHT > MAXWEIGHT %THENSTART
         MAXWEIGHT = SR_WEIGHT
         MAXTEMP = SRPTR
      %FINISH
!
%END;!   SUBTEMP
!
!
!
!
%INTEGERFUNCTION SCAN
!
!****************************************************************************
!* SCANS THE TOP LEVEL OF THE LOOP FOR THE NEXT USE OF TOP-OF-USE-STACK.    *
!*   RETURNS TRUE IF A USE IS FOUND, ELSE FALSE.                            *
!****************************************************************************
!
      US == RECORD (ATABS + USESTACKPTR)
      CURRTRIAD = US_TRIAD
!* STAGE 1. LOOK FOR THE NEXT USE IN THE CURRENT BLOCK.
      %WHILE NEXTTR = 1 %CYCLE
         TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
         %UNLESS TT_RES1_W>>1 = QTOUS_W>>1 %OR TT_RES2_W>>1 = QTOUS_W>>1  %c
                                 %THEN %CONTINUE
         %UNLESS TT_OP = REPL %THENSTART
            US_TRIAD = CURRTRIAD
            %RESULT = 1
         %FINISH
         US_USES = US_USES + TT_USE - 1
      %REPEAT
!* STAGE 2. IDENTIFY WHICH BLOCK FROM DLOOP LIST WE HAVE JUST COME TO THE END OF.
      CLOOPPTR = DLOOPHEAD
      %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         CLOOPPTR = CL_PDCHAIN
         %IF CL_BLOCK = US_BLOCK %THEN %EXIT
      %REPEAT
!* STAGE 3. SCAN EACH OF REMAINING BLOCKS IN DLOOP LIST UNTIL A USE IS FOUND.
      %WHILE CLOOPPTR # 0 %CYCLE
         CL == RECORD (ATABS + CLOOPPTR)
         BB == RECORD (ABLOCKS + CL_BLOCK * BLSIZE)
         CURRTRIAD = BB_TEXT
         %WHILE NEXTTR = 1 %CYCLE
            TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
            %UNLESS TT_RES1_W>>1 = QTOUS_W>>1 %OR TT_RES2_W>>1 = QTOUS_W>>1 %c
                            %THEN %CONTINUE
            %IF TT_OP # REPL %THENSTART
               US_TRIAD = CURRTRIAD
               US_BLOCK = CL_BLOCK
               %RESULT = 1
            %FINISH
            US_USES = US_USES + TT_USE - 1
         %REPEAT
         CLOOPPTR = CL_PDCHAIN
      %REPEAT
      %RESULT = 0
!
%END;!   SCAN
!
!
!
!
%ROUTINE IREPL
!
!********************************************************************
!* REPLACES ALL USES OF THE RECURSIVE VARIABLE I WHICH              *
!*          1. HAVE NOT BEEN REDUCED                                *
!*          2. ARE NOT RECURSIVE DEFNS IN RDEF TABLE                *
!*          3. ARE NOT TESTS IN RTEST TABLE                         *
!*     BY USES OF THE NEW SR TEMPORARY.                             *
!********************************************************************
!
%RECORD (RESF) OPD
!
!* STAGE 1. ALL BLOCKS IN INNER LOOPS ARE SCANNED FOR USES OF I, WHICH
!*           ARE THEN ADDED TO RUSE TABLE.  (RUSE ALREADY HAS 
!*            ENTRIES FOR ALL USES IN THE TOP LEVEL.)
      GETBIT (ADDR(PLOOPUSE(0)),COORD,BIT)
      %UNLESS BIT = 0 %THENSTART
         CLOOPPTR = PLOOPHEAD
         %WHILE CLOOPPTR # 0 %CYCLE
            CL == RECORD (ATABS + CLOOPPTR)
            BLOCK = CL_BLOCK;!    REQUIRED BY RUENTRY.
            BB == RECORD (ABLOCKS + BLOCK * BLSIZE)
            GETBIT (ABLOCKS+BB_USE,COORD,BIT)
            %UNLESS BIT = 0 %THENSTART
               CLEARBIT (ABLOCKS+BB_USE,COORD)
               CLEARBIT (ABLOCKS+BB_BOE,COORD)
               CURRTRIAD = BB_TEXT
               %WHILE NEXTTRIAD = 1 %CYCLE
                  TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
                  %UNLESS TT_RES1_W = CURRVAR_W %OR TT_RES2_W = CURRVAR_W %C
                                        %THEN %CONTINUE
                  RUENTRY
                  NRUSECT = NRUSECT + 1
               %REPEAT
            %FINISH
            CLOOPPTR = CL_PDCHAIN
         %REPEAT
      %FINISH
!* STAGE 2. IF THERE ARE ANY USES TO REPLACE, A NEW SR TEMP IS GENERATED,
!*             AND ITS USE AND WEIGHT FIELDS FILLED.
!*             (EVEN IF NO NON-REDUCIVE USES, WE NEED A NEW TEMP IF NONE OF THE
!*                PRESENT TEMPS IS SUITABLE FOR TEST REPLACEMENT, AND THERE ARE
!*                SOME TESTS TO REPLACE.)
      %IF NRUSECT # 0 %OR   %C
                 (MAXWEIGHT < 0 %AND RTESTEND >= RTESTSTART) %THENSTART
         SRENTRY (1)
         I = 1
         RUSEPTR = RUSEHEAD
         %WHILE RUSEPTR # 0 %CYCLE
            RU == RECORD (ATABS + RUSEPTR)
            %UNLESS RU_TRIAD = NULL %THENSTART
               SR_USE(I) = RU_TRIAD
               I = I + 1
               TT == RECORD (ATRIADS + RU_TRIAD * TRIADLENGTH)
               OPD_FORM = SRTEMP
               OPD_H0 = SRPTR
               OPD_MODE = CURRVAR_MODE
               %IF TT_RES1_W = CURRVAR_W %THEN TT_RES1 = OPD
               %IF TT_RES2_W = CURRVAR_W %THEN TT_RES2 = OPD
               BB == RECORD (ABLOCKS + RU_BLOCK * BLSIZE)
               %IF (TT_OP = ARR %OR TT_OP = DEFARR) %C
                                        %AND BB_DEPTH = LOOPDEPTH %THENSTART
                  %IF CMPLX8 <= TT_MODE <= CMPLX32 %C
                                        %THEN SR_WEIGHT = SR_WEIGHT + 2   %C
                                        %ELSE SR_WEIGHT = SR_WEIGHT + 1
               %FINISH
               CLEARBIT (ABLOCKS+BB_USE,COORD)
               CLEARBIT (ABLOCKS+BB_DEF,COORD)
               CLEARBIT (ABLOCKS+BB_BOE,COORD)
            %FINISH
            RUSEPTR = RU_CHAIN
         %REPEAT
         %IF SR_WEIGHT >= MAXWEIGHT %THENSTART
            MAXWEIGHT = SR_WEIGHT
            MAXTEMP = SRPTR
         %FINISH
      %FINISH
!
%END;!   IREPL
!
!
!
!
%ROUTINE SRENTRY (%INTEGER SFLAG)
!
!****************************************************************************
!* CREATES A NEW ENTRY IN TABLE OF STRENGTH REDUCTION TEMPORARIES,          *
!*   INITIALISING ALL FIELDS EXCEPT USES & TESTS. RETURNS SCALED POINTER    *
!*   IN SRPTR.                                                              *
!*  CALLED EITHER FROM SUBTEMP, WITH SFLAG = 0, IN WHICH CASE WE OBTAIN     *
!*   INFO ABOUT INCREMENT, SIGN, ETC FROM CURRENT T-O-US, OR FROM IREPL,    *
!*   WITH SFLAG = 1, WHERE NON-REDUCIVE USES OF THE ORIGINAL RECURSIVE      *
!*   VAR ARE TO BE REPLACED BY THE NEW TEMP, & WE GET THE INFO FROM RDTAB   *
!****************************************************************************
!
%INTEGER NEWTRIAD,TRID,SIGN,WEIGHT,WW,LITSW,LITINC,USES
!
!* CONSIDER EFFECT OF INIT TRIAD ON BACK TARGET:
!*   T - INIT - I      => BIT STRIPS MUST BE ADJUSTED
!*   T - INIT - TRIAD  => USE CT OF TRIAD MUST BE UPDATED.
      %IF SFLAG = 0 %THENSTART
         TT == RECORD (ATRIADS + TOUS * TRIADLENGTH)
         TT_USE = TT_USE + 1
         USES = US_USES
      %FINISHELSESTART
         %IF BITS = 0 %THENSTART
            BITS = 1
            BB == RECORD (ABLOCKS + BACKTARG * BLSIZE)
            SETBIT (ABLOCKS+BB_USE,COORD)
            GETBIT (ABLOCKS+BB_DEF,COORD,BIT)
            %IF BIT = 0 %THEN SETBIT (ABLOCKS+BB_BOE,COORD)                             
         %FINISH
         USES = NRUSECT
      %FINISH
!* CREATE NEW ENTRY. IF FIRST SR ENTRY FOR LOOP, PUT POINTER IN LOOP TABLE ENTRY.
      SRPTR = CREATEBTAB ((SRFIXED + USES * SRUSESZ + 3) & X'FFFFFFFC')
      SR == RECORD (ABLOCKS + SRPTR)
      SRPTR = SRPTR >> SRSCALE
      SR_CHAIN = 0
      %UNLESS SRHEAD=0 %THEN SRCH=SRCH+ABLOCKS
      INTEGER (SRCH) = SRPTR
      SRCH = ADDR (SR_CHAIN)-ABLOCKS
      LO == RECORD (ALOOPS + LOOP)
      %IF LO_ST = 0 %THEN LO_ST = SRPTR
      %IF SFLAG = 0 %THEN US_TEMP = SRPTR
      SR_LOOP = LOOP
      SR_USECT = USES
      SR_IDENT = CURRVAR_H0
      SR_MODE = CURRVAR_MODE
      SR_WEIGHT = 0
      RD == RECORD (ATABS + RDEFSTART)
!* SET FLAG IF TESTS MUST BE REVERSED.
      %IF SFLAG = 0 %AND (US_SIGN(1) & 1) # (RD_SIGN & 1) %C
                                        %THEN SR_FLAGS = REVTESTBIT   %C
                                                    %ELSE SR_FLAGS = 0
      SR_DUMP = 0
      %FOR I = 1,1,3 %CYCLE
         SR_INCR(I) = 0
         SR_TEST(I) = 0
      %REPEAT
      %FOR I = 1,1,USES %CYCLE
         SR_USE(I) = 0
      %REPEAT
!* GENERATE THE INIT TRIAD FOR THE NEW TEMPORARY.
      NEWTRIAD = GETTRIAD
      TT == RECORD (ATRIADS + NEWTRIAD * TRIADLENGTH)
      SR_INIT = NEWTRIAD
      TT1 == RECORD (ATRIADS + BTARGTRIAD * TRIADLENGTH)
      TT_CHAIN = TT1_CHAIN
      TT1_CHAIN = NEWTRIAD
      BTARGTRIAD = NEWTRIAD
      TT_OP = INIT
      TT_QOPD1 = SRTEMP
      TT_OPD1 = SRPTR
      TT_MODE = CURRVAR_MODE
      %IF SFLAG = 0 %THEN TT_RES2 = QTOUS   %C
                    %ELSE TT_RES2 = CURRVAR
!* FOR EACH RDEF ENTRY, GENERATE AN APPROPRIATE INCR OR DECR TRIAD.
      I = 1
      %FOR RDEFPTR = RDEFSTART,RDEFSZ,RDEFEND %CYCLE
         RD == RECORD (ATABS + RDEFPTR)
         NEWTRIAD = GETTRIAD
         TT == RECORD (ATRIADS + NEWTRIAD * TRIADLENGTH)
         TT_OPD1 = SRPTR
         TT_QOPD1 = SRTEMP
         TT_MODE = CURRVAR_MODE
         TT_CHAIN = RD_INCTRIAD
         TT_USE = 0
         TT1 == RECORD (ATRIADS + RD_INCPREV * TRIADLENGTH)
         %UNLESS TT1_CHAIN = RD_INCTRIAD %THENSTART
            BB == RECORD (ABLOCKS + RD_BLOCK * BLSIZE)
            TRID = BB_TEXT
            %CYCLE
               TT1 == RECORD (ATRIADS + TRID * TRIADLENGTH)
               %IF TT1_CHAIN = RD_INCTRIAD %THEN %EXIT
               TRID = TT1_CHAIN
            %REPEAT
         %FINISH
         TT1_CHAIN = NEWTRIAD
         RD_INCPREV = NEWTRIAD
!* INCR OR DECR? DEPENDS ON SIGN OF INCREMENT.
         %IF SFLAG = 0 %THENSTART
            SIGN = US_SIGN(I) & NOTLITBIT
            %IF SIGN < 2 %THEN -> L2
            WEIGHT = INFIN
         %FINISHELSESTART
            SIGN = RD_SIGN & NOTLITBIT
      L2:   WEIGHT = 0
            WW = SIGN !! 1
         %FINISH
         %IF SIGN & 1 = 0 %THEN TT_OP = INCR   %C
                          %ELSE TT_OP = DECR
!* WHAT IS INCREMENT? EITHER A LITERAL CONSTANT, A LOOP CONSTANT IDENT, OR A
!*                     TRIAD IN THE BACK TARGET.
         %IF SFLAG = 0 %THENSTART
            LITSW = US_SIGN(I) >> LITSHIFT
            LITINC = US_LITINC(I)
         %FINISHELSESTART
            LITSW = RD_SIGN >> LITSHIFT
            LITINC = RD_LITINC
         %FINISH
         %IF LITSW = 0 %THENSTART
            TT_RES2_W = LITINC
            %IF TT_QOPD2 & TEXTMASK # 0 %THENSTART
               TT1 == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
               TT1_USE = TT1_USE + 1
            %FINISHELSEIF TT_QOPD2 & IDMASK # 0 %THENSTART
               DD == RECORD (ADICT + TT_OPD2 << DSCALE)
               BB == RECORD (ABLOCKS + RD_BLOCK * BLSIZE)
               SETBIT (ABLOCKS+BB_USE,DD_COORD)
               SETBIT (ABLOCKS+BB_BOE,DD_COORD)
            %FINISH
         %FINISHELSESTART
            %IF LITINC = 1 %THEN WEIGHT = WEIGHT + WW
            TT_RES2_W = CONIN (LITINC)
         %FINISH
         SR_INCR(I) = NEWTRIAD
         %UNLESS WEIGHT = INFIN %THEN SR_WEIGHT = SR_WEIGHT + WEIGHT + 2   %C
                                %ELSE SR_WEIGHT = INFIN
         I = I + 1
      %REPEAT
!
%END;!   SRENTRY
!
!
!
!
%ROUTINE REPLACE
!
!***************************************************************************
!* THE TESTS INDICATED BY RTEST ARE REPLACED BY TESTS OF MAXTEMP           *
!*   AGAINST K, WHERE K IS:                                                *
!*      A) THE ORIGINAL CONSTANT IF MAXTEMP DIRECTLY REPLACES I            *
!*      B) THE LAST TRIAD OF A BACK TARGET SEQUENCE, CONSISTING OF THE     *
!*          INITIALISATION SEQUENCE FOR MAXTEMP, WITH THE ORIGINAL         *
!*          CONSTANT REPLACING ALL USES OF I.                              *
!*   FOR CASE B WE CONSTRUCT A TABLE TINIT, WITH AN ENTRY FOR EACH TRIAD   *
!*   IN THE INITIALISATION SEQUENCE (STARTING FROM TOP OF TREE).           *
!*     TINIT FIELDS ARE:                                                   *
!*       TRIAD = POINTER TO TRIAD IN INITIALISATION SEQUENCE FOR MAXTEMP   *
!*       OPD   = 0 IF NEITHER OPERAND IS I                                 *
!*               1 IF OPD1 IS I                                            *
!*               2 IF OPD2 IS I                                            *
!*               3 IF BOTH OPDS ARE I.                                     *
!*       REF   = 0 IF THIS IS LAST ENTRY IN THIS SEQUENCE                  *
!*               1 IF OPD1 POINTS TO NEXT TRIAD IN SEQUENCE                *
!*               2 IF OPD2 POINTS TO NEXT TRIAD IN SEQUENCE.               *
!***************************************************************************
!
%INTEGER TINITSTART,TINITPTR,TINITEND,CONUSE,TRID,FLAGS
!
%RECORD (RESF) TESTCON,OPD,OPD2
!
%CONSTINTEGER TINITSZ = 3<<WSCALE
!
      TINITSTART = FREETABS
      TINITEND = TINITSTART - TINITSZ
      CONUSE = 0;!   NO OF TIMES I HAS APPEARED IN INIT SEQ.
      SR == RECORD (ABLOCKS + MAXTEMP << SRSCALE)
      TT == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
      %UNLESS TT_RES2_W = CURRVAR_W %THENSTART
         TRID = TT_OPD2
         %CYCLE
            TINITEND = CREATETAB (TINITSZ)
            TI == RECORD (ATABS + TINITEND)
            TI_TRIAD = TRID
            TI_OPD = 0
            TI_REF = 0
            TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
            %IF TT_RES1_W = CURRVAR_W %THENSTART
               TI_OPD = 1
               CONUSE = CONUSE + 1
            %FINISHELSEIF TT_QOPD1 & TEXTMASK # 0 %THENSTART
               TT1 == RECORD (ATRIADS + TT_OPD1 * TRIADLENGTH)
!* IF BACKWARD MOVED (& HENCE CONSTANT), DON'T GENERATE TRIAD, BUT SIMPLY
!*   UPDATE ITS USE COUNT BY NO. OF TESTS TO BE GENERATED.
               %IF TT1_OP & BMBIT # 0 %THEN TT1_USE = TT1_USE + RTESTCT   %C
                                         %ELSE TI_REF = 1
            %FINISH
            %IF TT_RES2_W = CURRVAR_W %THENSTART
               TI_OPD = TI_OPD + 2
               CONUSE = CONUSE + 1
            %FINISHELSEIF TT_QOPD2 & TEXTMASK # 0 %THENSTART
               TT1 == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
               %IF TT1_OP & BMBIT # 0 %THEN TT1_USE = TT1_USE + RTESTCT   %C
                                         %ELSE TI_REF = 2
            %FINISH
            %IF TI_REF = 0 %THEN %EXIT
            %IF TI_REF = 1 %THEN TRID = TT_OPD1   %C
                           %ELSE TRID = TT_OPD2
         %REPEAT
      %FINISH
      %FOR RTESTPTR = RTESTSTART,RTESTSZ,RTESTEND %CYCLE
         RT == RECORD (ATABS + RTESTPTR)
         %UNLESS TINITEND < TINITSTART %THENSTART
            TT == RECORD (ATRIADS + RT_TRIAD * TRIADLENGTH)
            %IF TT_RES1_W = CURRVAR_W %THEN TESTCON = TT_RES2   %C
                                      %ELSE TESTCON = TT_RES1
            %IF TESTCON_FORM & TEXTMASK # 0 %THENSTART
               TT1 == RECORD (ATRIADS + TESTCON_H0 * TRIADLENGTH)
               TT1_USE = TT1_USE + CONUSE - 1
            %FINISHELSEIF TESTCON_FORM & IDMASK # 0 %THENSTART
               DD == RECORD (ADICT + TESTCON_H0 << DSCALE)
               BB == RECORD (ABLOCKS + BACKTARG * BLSIZE)
               SETBIT (ABLOCKS+BB_USE,DD_COORD)
               GETBIT (ABLOCKS+BB_DEF,DD_COORD,BIT)
               %IF BIT = 0 %THEN SETBIT (ABLOCKS+BB_BOE,DD_COORD)
            %FINISH
            %FOR TINITPTR = TINITEND,-TINITSZ,TINITSTART %CYCLE
               TI == RECORD (ATABS + TINITPTR)
               TRID = GETTRIAD
               TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
               TT_USE = 1
               TT1 == RECORD (ATRIADS + BTARGTRIAD * TRIADLENGTH)
               TT_CHAIN = TT1_CHAIN
               TT1_CHAIN = TRID
               TT1 == RECORD (ATRIADS + TI_TRIAD * TRIADLENGTH)
               TT_OP = TT1_OP
               OPD_H0 = BTARGTRIAD
               OPD_FORM = TRIAD
               OPD_MODE = CURRVAR_MODE
               %IF TI_REF = 1 %THEN TT_RES1 = OPD   %C
               %ELSEIF TI_OPD & 1 # 0 %THEN TT_RES1 = TESTCON   %C
                                      %ELSE TT_RES1 = TT1_RES1
               %IF TI_REF = 2 %THEN TT_RES2 = OPD   %C
               %ELSEIF TI_OPD & 2 # 0 %THEN TT_RES2 = TESTCON   %C
                                      %ELSE TT_RES2 = TT1_RES2
               BTARGTRIAD = TRID
            %REPEAT
         %FINISH
!* THE TEST TRIAD ITSELF CAN NOW BE SUITABLY AMENDED.
         TT == RECORD (ATRIADS + RT_TRIAD * TRIADLENGTH)
         %IF TT_RES1_W = CURRVAR_W %THEN FLAGS = 0   %C
                                   %ELSE FLAGS = REVTESTBIT
         OPD_H0 = MAXTEMP
         OPD_FORM = SRTEMP
         OPD_MODE = CURRVAR_MODE
         %IF TINITEND < TINITSTART %THENSTART
            %IF FLAGS = 0 %THEN TT_RES1 = OPD   %C
                          %ELSE TT_RES2 = OPD
         %FINISHELSESTART
            SR == RECORD (ABLOCKS + MAXTEMP << SRSCALE)
            OPD2_H0 = BTARGTRIAD
            OPD2_FORM = TRIAD
            OPD2_MODE = CURRVAR_MODE
            %IF SR_FLAGS !! FLAGS = 0 %THENSTART
               TT_RES1 = OPD
               TT_RES2 = OPD2
            %FINISHELSESTART
               TT_RES2 = OPD
               TT_RES1 = OPD2
            %FINISH
         %FINISH
      %REPEAT
      SR == RECORD (ABLOCKS + MAXTEMP << SRSCALE)
      I = 1
      %FOR RTESTPTR = RTESTSTART,RTESTSZ,RTESTEND %CYCLE
         RT == RECORD (ATABS + RTESTPTR)
         SR_TEST(I) = RT_TRIAD
         I = I + 1
      %REPEAT
      SR_FLAGS = TESTREPBIT
      SR_WEIGHT = SR_WEIGHT + RTESTCT
!
%END;!   REPLACE
!
!
!
!
%INTEGERFUNCTION BOEX (%INTEGER IDPTR)
!
!**************************************************************************
!* DETERMINES WHETHER THE VALUE OF THE RECURSIVE VARIABLE I IS REQUIRED   *
!*   ON EXIT FROM THE LOOP.  (IF NOT IT CAN BE COMPLETELY SUBSTITUTED     *
!*   IN THE LOOP BY A SR TEMP.)                                           *
!*     PARAMETER ON ENTRY IS IDENT PTR FOR THE RECURSIVE VARIABLE.        *
!*     RESULT IS TRUE (1) IF BUSY ON EXIT, ELSE FALSE.                    *
!**************************************************************************
!
%INTEGER I,BLK
!
      %FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
         CL == RECORD (ATABS +CLOOPPTR)
         BB == RECORD (ABLOCKS + CL_BLOCK * BLSIZE)
         CN == RECORD (ATABS + BB_FCON)
         %FOR I = 1,1,CN_COUNT %CYCLE
            BLK = CN_BLOCK(I)
            BB == RECORD (ABLOCKS + BLK * BLSIZE)
            %IF BB_DEPTH < LOOPDEPTH %THENSTART
               %IF BUSYONX (TO,BLK,IDPTR) = 1 %THEN %RESULT = 1
            %FINISH
         %REPEAT
      %REPEAT
      %RESULT = 0
!
%END;!  BOEX
!
!
!
!
%INTEGERFUNCTION CREATEBTAB (%INTEGER A)
!
!*********************************************************************
!* CREATES A TABLE ENTRY IN BLOCK TABLE AREA, OF LENGTH A BYTES.     *
!*********************************************************************
!
%INTEGER B
!
      Freeblocks=(Freeblocks+X'F')&X'FFFFFFF0'
      BLOCKSFULL %IF FREEBLOCKS + A > MAXBLOCKS
      B = FREEBLOCKS
      FILL(A,ABLOCKS+B,0,0)
      FREEBLOCKS = FREEBLOCKS + A
      %RESULT = B
!
%END;!   CREATEBTAB
!
!
!
!
%ROUTINE PRINTRD
!
!************************************************************************
!* PRINT CONTENTS OF RD TABLE.                                          *
!************************************************************************
!
%RECORD(RDF)%NAME RR
%INTEGER RDPTR
      NEWLINE
      PRINTSTRING ("RECURSIVE DEFINITIONS")
      NEWLINE
      PRINTSTRING ("     VAR      TRIAD    BLOCK")
      NEWLINE
      %FOR RDPTR = RDSTART,RDSZ,RDEND %CYCLE
         RR == RECORD (ATABS + RDPTR)
         WRITE (RR_VAR_FORM,3)
         PRINTSTRING ("/")
         WRITE (RR_VAR_H0,4)
         WRITE (RR_TRIAD,8)
         WRITE (RR_BLOCK,8)
         NEWLINE
      %REPEAT
!
%END;!   PRINTRD
!
!
!
!
%ROUTINE PRINTRUSE
!
!****************************************************
!* PRINT CONTENTS OF RUSE TABLE.                    *
!****************************************************
!
%RECORD(RUSEF)%NAME RU
%INTEGER RUSEPTR
      NEWLINE
      PRINTSTRING ("USES")
      NEWLINE
      PRINTSTRING ("    TRIAD    PREV    BLOCK")
      NEWLINE
      RUSEPTR = RUSEHEAD
      %WHILE RUSEPTR # 0 %CYCLE
         RU == RECORD (ATABS + RUSEPTR)
         WRITE (RU_TRIAD,7)
         WRITE (RU_PREV,7)
         WRITE (RU_BLOCK,7)
         NEWLINE
         RUSEPTR = RU_CHAIN
      %REPEAT
!
%END;!   PRINTRUSE
!
!
!
!
%ROUTINE PRINTRDEF
!
!***************************************************
!* PRINT CONTENTS OF RDEF TABLE.                   *
!***************************************************
!
%RECORD(RDEFF)%NAME RD
%INTEGER RDEFPTR
      NEWLINE
      PRINTSTRING ("DEFINITIONS")
      NEWLINE
      PRINTSTRING ("     ASMT    INCT    PREV    BLOCK   SIGN   LITINC")
      NEWLINE
      %FOR RDEFPTR = RDEFSTART,RDEFSZ,RDEFEND %CYCLE
         RD == RECORD (ATABS + RDEFPTR)
         WRITE (RD_ASSTRIAD,7)
         WRITE (RD_INCTRIAD,7)
         WRITE (RD_INCPREV,7)
         WRITE (RD_BLOCK,7)
         WRITE (RD_SIGN,7)
         WRITE (RD_LITINC,7)
         NEWLINE
      %REPEAT
!
%END;!   PRINTRDEF
!
!
!
!
%ROUTINE PRINTRTEST
!
!******************************************************
!* PRINT CONTENTS OF RTEST TABLE.                     *
!******************************************************
!
%RECORD(RTESTF)%NAME RT
%INTEGER RTESTPTR
      NEWLINE
      PRINTSTRING ("TESTS")
      NEWLINE
      PRINTSTRING ("     TRIAD    BLOCK")
      NEWLINE
      %FOR RTESTPTR = RTESTSTART,RTESTSZ,RTESTEND %CYCLE
         RT == RECORD (ATABS + RTESTPTR)
         WRITE (RT_TRIAD,8)
         WRITE (RT_BLOCK,7)
         NEWLINE
      %REPEAT
!
%END;!   PRINTRTEST
!
!
!
!
%ROUTINE PRINTUSESTACK
!
!***************************************************
!* PRINT CONTENTS OF USE STACK.                    *
!***************************************************
!
%RECORD(USEF)%NAME US
%INTEGER PTR
      NEWLINE
      PRINTSTRING ("USE STACK")
      NEWLINE
      PRINTSTRING ("   TRIAD  BLOCK     RV")
      PRINTSTRING("       USES     SIGNS     TEMP   LIT1   LIT2   LIT3")
      NEWLINE
      %FOR PTR = USESTACKSTART,USESZ,USESTACKPTR %CYCLE
         US == RECORD (ATABS + PTR)
         WRITE (US_TRIAD,6)
         WRITE (US_BLOCK,6)
         WRITE (US_RV_FORM,4)
         PRINTSTRING ("/")
         WRITE (US_RV_H0,4)
         WRITE (US_USES,6)
         WRITE (US_SIGN(1),4)
         WRITE (US_SIGN(2),3)
         WRITE (US_SIGN(3),3)
         WRITE (US_TEMP,5)
         WRITE (US_LITINC(1),6)
         WRITE (US_LITINC(2),6)
         WRITE (US_LITINC(3),6)
         NEWLINE
      %REPEAT
!
%END;!   PRINTUSESTACK
!
%END ;!  STRENGTHRED
!
%ENDOFFILE