!                                                                     feelim1
! 07/12/86 - copy of ftneelim2
!          - insert include files
! 02/12/85 - taken from eelimp45, new include files incorporated
! 21/08/95 - alter TRELIM to inhibit expression elimination of ARR triads
! 29/11/84 - correct TRELIM for TOCHAR and CONJG
! 31/01/84 - UPDATE TRELIM FOR DCMPLX & INTRIN
! 18/01/84 - BIT STRIP ADDRESSES ARE NOW RELATIVE TO ABLOCKS
! 23/11/83 set up TRACE flag and EDUMPTRACE routine
! 27/10/83 - copied from ERCS06.REL8002_eelimb7
%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'
!*
!*
!*
%ownINTEGER TRACE=0
!
%OWNINTEGER ELFLAG,ELIMEND,RWFLAG,HVAL
%OWNINTEGER COORD1,COORD2,MODE,MATCH
!*
! ARRAY FOR TRIADS WHICH MAY BE ELIMINATION CANDIDATES
%CONSTBYTEINTEGERARRAY TRELIM(0:116) = 0,0,1,1,1,1,1,0,1,0,
                                      0,0,0,0,1,1,1,1,1,1,
                                      1,0,0,0,0,0,0,0,0,0,
                                      0,0,0,0,0,0,0,0,0,0,
                                      0,0,1,1,0,1,0,0,0,0,
                                      0,0,0,0,0,0,0,1,0,0,
                                      0,0,0,0,0,0,0,1,0,0,
                                      0,1,0,0,0,0,0,0,0,1, { SET BIT FOR IARG ???
                                      0,0,0,0,0,0,0,0,0,0,
                                      0,0,0,0,1,0,0,0,0,0, { SET BIT FOR ANINT ???
                                      1,1,1,1,1,1,1,1,1,1,
                                      0,0,0,0,0,0,1

%EXTERNALROUTINE EDUMPTRACE
TRACE=OPTFLAGS&EDUMP
%END
!
%ROUTINE CREATETABLE(%INTEGER LEN,%INTEGERNAME TADDR)
! CREATE A TABLE ENTRY OF LEN ARCHITECTURAL UNITS AND RETURN ADDRESS IN TADDR

TABSFULL %IF FREETABS+LEN>MAXTABS
TADDR=FREETABS
FREETABS=FREETABS+LEN
%END; ! CREATETABLE

%INTEGERFUNCTION HASH
! CALCULATE HASH VALUE OF CURRENT TRIAD(TR)
%RECORD(TRIADF)%NAME TR
%INTEGER RES
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
RES=(TR_OPD1!!TR_OPD2!!TR_OP)&X'1F'
%IF TRACE#0 %START
  PRINTSTRING("HASH VALUE FOR CURRENT TRIAD IS")
  WRITE(RES,4)
  NEWLINE
%FINISH
%RESULT=RES
%END; ! HASH

%ROUTINE SETCOORDS
! SETUP COORD1,COORD2 & MODE
%RECORD(TRIADF)%NAME TR,MTR
%RECORD(PRECF)%NAME DENT
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
%IF TR_OP&BMBITOFF=CVT %THEN MODE=TR_MODE %ELSE MODE=-1
COORD2=-1
%IF TR_QOPD1&IDMASK=IDMASK %START
  ! CHECK FOR ARR & DEFARR TRIADS & GET COORD FOR THEIR BASE ARRAY
  %IF (TR_OP&BMBITOFF=ARR %OR TR_OP&BMBITOFF=DEFARR) %AND %C
            TR_QOPD1&TEXTMASK=TEXTMASK %START
    MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
    DENT==RECORD(MTR_OPD1<<DSCALE+ADICT)
  %FINISHELSE  DENT==RECORD(TR_OPD1<<DSCALE+ADICT)
  COORD1=DENT_COORD
%FINISH %ELSE COORD1=-1
%IF TR_QOPD2&IDMASK=IDMASK %START
  DENT==RECORD(TR_OPD2<<DSCALE+ADICT)
  %IF COORD1=-1 %THEN COORD1=DENT_COORD %ELSE COORD2=DENT_COORD
%FINISH
%IF TRACE#0 %START
  PRINTSTRING("COORD1="); WRITE(COORD1,1)
  PRINTSTRING(" COORD2="); WRITE(COORD2,1)
  PRINTSTRING(" MODE="); WRITE(MODE,1);NEWLINE
%FINISH
%END; ! SETCOORDS

%INTEGERFUNCTION TRDEF(%INTEGER TRIND)
! CHECK TRIAD WITH INDEX TRIND FOR DEFS. OF OPERANDS WITH COORDINATES
! COORD1 & COORD2
! RETURNS 1 IF DEFS. ELSE 0
%INTEGER RES
RES=ALLDEF(TRIND); ! IDENTIFIY THE DEFINING CONTEXT OF THE TRIAD
%IF RES=0 %THEN %RESULT=0; ! TRIAD HAS NO DEFINING CONTEXT
%IF RES=-1 %START; ! COMMON ITEM MAY BE DEFINED
  ! ASSUME CMNCOORDS HAS COORD(1) SET IF ANY CHAR OR ARRAY PARAMS IN PROG.
  GETBIT(ACMNCOORDS,COORD1,RES)
  %IF RES=1 %THEN %RESULT=1; ! VAR. WITH COORD1 IS DEFINED
  %IF COORD2#-1 %START
    GETBIT(ACMNCOORDS,COORD2,RES)
    %IF RES=1 %THEN %RESULT=1; ! VAR. WITH COORD2 IS DEFINED
  %FINISH
  %RESULT=0; ! NEITHER VAR. IS DEFINED
%FINISH
%IF RES<0 %START; ! COMMON ITEM DEFINED & VARS. WITH COORD(1) EXIST
  !RESULT FROM ALLDEF IS THE -VE COORD VALUE OF THE DEFINED COMMON
  %IF COORD1=1 %OR COORD2=1 %THEN %RESULT=1
  RES=-RES; ! CONTINUE AS FOR +VE RES
%FINISH
! HERE IF COMMON/LOCAL VARIABLE DEFINED BY THE TRIAD
! RESULT FROM ALLDEF IS THE COORD OF THE DEFINED VAR.
%IF RES=COORD1 %OR RES=COORD2 %THEN %RESULT=1
%RESULT=0
%END; ! TRDEF

%INTEGERFUNCTION MATCHTR(%INTEGER IND)
! CHECKS IF TRIAD IN IND MATCHES CURRTRIAD
! RESULT =1 IF MATCH ELSE 0
%RECORD(TRIADF)%NAME TR,MTR
TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
%IF TR_OP&BMBITOFF#MTR_OP&BMBITOFF %THEN %RESULT=0
%IF TR_RES1_W#MTR_RES1_W %THEN %RESULT=0
%IF TR_OPD2#MTR_OPD2 %THEN %RESULT=0
%IF TR_QOPD2#MTR_QOPD2 %THEN %RESULT=0
%RESULT=1
%END; ! MATCHTR

%INTEGERFUNCTION CURBLDEF
! CHECK IF VARIABLE WITH  COORD1 OR COORD2  DEFINED SO FAR IN CURBLK
! RESULT=1 IF DEFS. ELSE 0
%INTEGER RES
GETBIT(ACURRDEF,COORD1,RES)
%IF RES=1 %THEN %RESULT=1
%IF COORD2#-1 %START
  GETBIT(ACURRDEF,COORD2,RES)
  %IF RES=1 %THEN %RESULT=1
%FINISH
%RESULT=0
%END; ! CURBLDEF

%INTEGERFUNCTION BLDEF(%INTEGER IND)
! CHECK BLOCK WITH INDEX IND FOR DEFS. OF VARIABLES WITH
! COORD1 OR COORD2
! RESULT=1 IF DEFS. ELSE 0
%RECORD(BLRECF)%NAME BL
%INTEGER RES

BL==RECORD(ABLOCKS+IND*BLSIZE)
GETBIT(ABLOCKS+BL_DEF,COORD1,RES)
%IF RES=1 %THEN %RESULT=1
%IF COORD2#-1 %START
  GETBIT(ABLOCKS+BL_DEF,COORD2,RES)
  %IF RES=1 %THEN %RESULT=1
%FINISH
%RESULT=0
%END; ! BLDEF

%ROUTINE ELIMINATE
! PERFORM TRIAD ELIMINATION OF CURRTRIAD & SET ELFLAG
%INTEGER OP,NEWOP
%RECORD(TRIADF)%NAME TR,MTR

TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
MTR==RECORD(ATRIADS+MATCH*TRIADLENGTH)
%IF TRACE#0 %START
  PRINTSTRING("ELIMINATE CURRTRIAD, INDEX"); WRITE(CURRTRIAD,4);NEWLINE
  PRINTSTRING("MATCHING TRIAD IS");WRITE(MATCH,1);NEWLINE
%FINISH
%IF TR_QOPD1&TEXTMASK=TEXTMASK %THEN DELUSE(TR_OPD1)
%IF TR_QOPD2&TEXTMASK=TEXTMASK %THEN DELUSE(TR_OPD2)
! CHANGE CURRTRIAD(TR) TO REPL TRIAD
TR_OP=(TR_OP&BMBIT)!REPL
TR_OPD1=MATCH
OP=MTR_OP
%IF OP=ARR %OR OP=DEFARR %OR OP=ARGARR %THEN NEWOP=ARREL %ELSE NEWOP=TRIAD
TR_QOPD1=NEWOP
TR_RES2_W=0
MTR_USE=MTR_USE+1
ELFLAG=1
%END; !ELIMINATE

%ROUTINE CHECKOUT
! CHECK IF ELIM. POSS OUTSIDE CURBLK
! SETS ELFLAG TO 1 IF ELIMINATION HAS OCCURRED ELSE 0
%RECORD(TRIADF)%NAME TR,MTR
%RECORDFORMAT RWF(%INTEGER BL,EL)
%RECORD(BLRECF)%NAME CBL
%RECORD(RWF)%NAME RW
%RECORD(CLOOPRECF)%NAME DL
%RECORD(BLRECF)%NAME BDBL,RXBL
%RECORD(CONRECF)%NAME BCON
%INTEGERARRAYFORMAT ELIMF(0:31)
%INTEGERARRAYNAME RWELIM
%INTEGERARRAYFORMAT TABF(0:1000)
%INTEGERARRAYNAME RX
%INTEGER BD,RWPTR,RXPTR,RXEND,MBLK,RES
%INTEGER CNT,I,J

TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
CBL==RECORD(ABLOCKS+CURRBLK*BLSIZE)
%IF TRACE#0 %START
  PRINTSTRING("CHECK FOR POSSIBLE ELIMINATION OUTSIDE CURRBLK"); NEWLINE
%FINISH
ELFLAG=0
%IF COORD1>0 %START ; ! DEFS ARE POSSIBLE
  ! CHECK IF EITHER COORD DEFINED IN CURBL
  %IF CURBLDEF=1 %THEN %RETURN; ! DEF. OCCURS - ELIMINATION NOT POSSIBLE
%FINISH
%IF RWFLAG=0 %START; ! SET UP RW TO CONTAIN BDC OF CURBLK
  %IF TRACE#0 %START
    PRINTSTRING("SET UP RW TO CONTAIN BDC OF CURRBLK");NEWLINE
  %FINISH
  RWFLAG=1
  DL==RECORD(ATABS+DLOOPPTR)
  CNT=1; ! INITIALISE COUNT FOR ELIMTAB INDEX
  BD=CBL_BDOM; ! GET BDOM OF CURBLK
  %IF TRACE#0 %START
    PRINTSTRING("BDOM IS");WRITE(BD,1);NEWLINE
    PRINTSTRING("BACKTARG IS"); WRITE(BACKTARG,1);NEWLINE
  %FINISH
  %WHILE BD#BACKTARG %CYCLE; ! CYCLE UNTIL BDOM IS OUTSIDE THE LOOP
    BDBL==RECORD(ABLOCKS+BD*BLSIZE); ! GET BDOM BLOCK
    %IF BDBL_DEPTH=LOOPDEPTH %START; ! BDOM IS A MEMBER OF THIS LOOP
      CREATETABLE(2<<WSCALE,RWPTR); ! CREATE RW ENTRY
      RW==RECORD(RWPTR+ATABS)
      RW_BL=BD
      %IF TRACE#0 %START
        PRINTSTRING("SEARCH DLOOPTAB FOR BDOM ENTRY");NEWLINE
      %FINISH
      %CYCLE; ! SEARCH DLOOPTAB FOR BD ENTRY TO DETERMINE ITS ELIMTAB INDEX
        CNT=CNT+1
        DL==RECORD(ATABS+DL_PDBACKCHAIN)
        %IF DL_BLOCK=BD %THEN %EXIT
      %REPEAT
      RW_EL=ELIMEND-CNT*(32<<WSCALE)
      %IF TRACE#0 %START
        PRINTSTRING("NEW RW ENTRY AT LOCATION"); WRITE(RWPTR,7); NEWLINE
        PRINTSTRING("RW_BL=");WRITE(RW_BL,4)
        PRINTSTRING("  RW_EL=");WRITE(RW_EL,7);NEWLINE
      %FINISH
      BD=BDBL_BDOM
    %FINISHELSE BD=BDBL_BTARG
  %REPEAT
%FINISH; ! SETTING UP RW

! SCAN RW TO CHECK ALL BDOMS OF CURBLK FOR ANY POSS. ELIMS.
RWPTR=ELIMEND
%IF TRACE#0 %START
  PRINTSTRING("SCAN RW TO CHECK FOR ANY POSSIBLE ELIMINATIONS");NEWLINE
%FINISH
%WHILE RWPTR#FREETABS %CYCLE
  RW==RECORD(ATABS+RWPTR)
  RWELIM==ARRAY(RW_EL+ATABS,ELIMF)
  %IF RWELIM(HVAL)#0 %START; ! POSSIBLE TRIAD MATCH
    %IF TRACE#0 %START
      PRINTSTRING("ELIMTAB ENTRY AT"); WRITE(RW_EL,7)
      PRINTSTRING(" FOR HVAL");WRITE(HVAL,4)
      PRINTSTRING(" ALREADY SET - POSSIBLE TRIAD MATCH")
      NEWLINE
    %FINISH
    ! SEARCH FOR MATCH TILL EOB
    I=RWELIM(HVAL)
    MTR==RECORD(I*TRIADLENGTH+ATRIADS)
    MATCH1:
    %WHILE MTR_USE&SOB#SOB %CYCLE
      %IF MATCHTR(I)=1 %THEN ->NEXT1; ! MATCH FOUND
      I=MTR_CHAIN
      MTR==RECORD(ATRIADS+I*TRIADLENGTH)
    %REPEAT
    %IF TRACE#0 %START
      PRINTSTRING("NO MATCH - CONTINUE SCAN");NEWLINE
    %FINISH
    ->NOMATCH; !  NO MATCH - SCAN NEXT RW ENTRY

    NEXT1: ! HERE IF TRIAD MATCH FOUND - CHECK FOR CVT TRIAD
    %IF MODE#-1 %START
      %IF TR_MODE2#MTR_MODE2 %START; ! NOT A MATCH
        I=MTR_CHAIN
        MTR==RECORD(ATRIADS+I*TRIADLENGTH)
        ->MATCH1; ! CONTINUE CYCLE  TO LOOK FOR MATCH
      %FINISH
    %FINISH
    MATCH=I
    MBLK=RW_BL
    %IF TRACE#0 %START
      PRINTSTRING("MATCH FOUND WITH TRIAD"); WRITE(MATCH,4)
      PRINTSTRING(" IN BLOCK"); WRITE(MBLK,4);NEWLINE
    %FINISH

    ! MATCH FOUND - NOW CHECK IF DEFS. POSSIBLE
    %IF COORD1#-1 %START; ! DEFS. POSSIBLE
      %IF BLDEF(MBLK)=1 %START; ! DEF. OCCURS IN MATCHED BLOCK(MBLK)
        %IF TRACE#0 %START
          PRINTSTRING("DEFS. OCCUR IN MATCHED BLOCK"); NEWLINE
        %FINISH
        ! CHECK FOR DEFS. BETWEEN MATCH & EOB
        %CYCLE
          I=MTR_CHAIN
          MTR==RECORD(ATRIADS+I*TRIADLENGTH)
          %IF MTR_USE&SOB=SOB %THEN %EXIT; ! NO DEFS. FOUND IN MATCHED BLOCK
          %IF TRDEF(I)=0 %THEN %CONTINUE; ! NO DEFS - CHECK NEXT TRIAD
          LOOP1:
          %CYCLE; ! DEF. FOUND - LOOK FOR ANOTHER MATCH
          %IF TRACE#0 %START
            PRINTSTRING("DEF. FOUND - LOOF FOR ANOTHER MATCH");NEWLINE
            %FINISH
            I=MTR_CHAIN
            MTR==RECORD(ATRIADS+I*TRIADLENGTH)
            %IF MTR_USE&SOB=SOB %THEN ->NOMATCH; ! NO MATCH - SCAN NEXT RW ENTRY
            %IF MATCHTR(I)=1 %THEN %EXIT; ! MATCH FOUND - EXIT CYCLE
          %REPEAT
          %IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
            %IF MTR_MODE2#TR_MODE %THEN ->LOOP1; ! NOT A MATCH - CYCLE
          %FINISH
          MATCH=I; ! SET NEW MATCH
          %IF TRACE#0 %START
            PRINTSTRING("NEW MATCH WITH TRIAD");WRITE(MATCH,4);NEWLINE
          %FINISH
        %REPEAT; ! END OF CYCLE TO LOOK FOR DEFS. IN MATCHED BLOCK
      %FINISH
  
      ! HERE IF NO RELEVANT DEFS. FOUND IN MATCHED BLOCK
      ! CHECK FOR DEFS. BETWEEN MATCHED BLOCK& CURBLK(CBL)
      %IF TRACE#0 %START
        PRINTSTRING("CHECK FOR DEFS. BETWEEN MATCHED BLOCK & CURRBLK")
        NEWLINE
        PRINTSTRING("PUT BCS OF CURBLK ON RX")
        NEWLINE
      %FINISH
      BCON==RECORD(ATABS+CBL_BCON)
      RX==ARRAY(ATABS+FREETABS,TABF)
      RXEND=0
      ! PUT BCS OF CURBLK ON RX
      %FOR I=1,1,BCON_COUNT %CYCLE
        %IF BCON_BLOCK(I)#MBLK %THEN RXEND=RXEND+1 %AND %C
          RX(RXEND)=BCON_BLOCK(I)
      %REPEAT
      RXPTR=1
      %IF TRACE#0 %START
        PRINTSTRING("RX CONTAINS ")
        %FOR I=1,1,RXEND %CYCLE; WRITE(RX(I),1); %REPEAT
        NEWLINE
      %FINISH
      ! SCAN RX
      %WHILE RXPTR<=RXEND %CYCLE
        %IF BLDEF(RX(RXPTR))=1 %THEN ->NOELIM; ! DEF. FOUND - ELIM. NOT POSS.
        ! ADD BCS OF RX(RXPTR) TO RX UNLESS ALREADY PRESENT
        RXBL==RECORD(ABLOCKS+RX(RXPTR)*BLSIZE)
        BCON==RECORD(ATABS+RXBL_BCON)
        %FOR I=1,1,BCON_COUNT %CYCLE
          %IF BCON_BLOCK(I)=MBLK %THEN %CONTINUE
          %FOR J=1,1,RXEND %CYCLE
            %IF RX(J)=BCON_BLOCK(I) %THEN ->NEXT2
          %REPEAT
          RXEND=RXEND+1
          RX(RXEND)=BCON_BLOCK(I)
        NEXT2:
        %REPEAT
        RXPTR=RXPTR+1
      %REPEAT
    %FINISH; ! END OF CHECKING FOR POSS. DEFS.

    !HERE IF NO DEFS. BETWEEN TRIADS
    ELIMINATE
    %RETURN; ! TERMINATE CHECKOUT

    NOELIM:
    ! HERE IF DEF. FOUND
    %IF TRACE#0 %START
      PRINTSTRING("DEF. FOUND - ELIMINATION NOT POSSIBLE");NEWLINE
    %FINISH
    %RETURN; ! TERMINATE CHECKOUT

  %FINISH; ! END OF LOOKING FOR POSS. MATCH

  NOMATCH:
  ! HERE IF NO MATCH FOUND - CONTINUE SCAN
  %IF TRACE#0 %START
    PRINTSTRING("NO MATCH - CONTINUE SCAN");NEWLINE
  %FINISH
  RWPTR=RWPTR+2<<WSCALE
%REPEAT; ! END OF CYCLE TO SCAN RW
%END; ! CHECKOUT

%EXTERNALROUTINE EXPELBTARG
%RECORD(TRIADF)%NAME TR,MTR
%RECORD(BLRECF)%NAME BTBL
%INTEGER SOB
%INTEGER IND

BTBL==RECORD(ABLOCKS+BACKTARG*BLSIZE)
SOB=BTBL_TEXT
CURRTRIAD=OLDBTARGTRIAD
%IF TRACE#0 %START
  NEWLINES(2)
  PRINTSTRING("EXPRESSION ELIMINATION FOR BACK TARGET BLOCK")
  WRITE(BACKTARG,1);NEWLINES(2)
  PRINTSTRING("SCAN TRIADS IN BACKTARG");NEWLINE
%FINISH
%CYCLE
  TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
  %IF TRACE#0 %START
    PRINTSTRING("CURRTRIAD IS");WRITE(CURRTRIAD,1);NEWLINE
  %FINISH
  ! CHECK IF CURRTRIAD IS AN ELIM. CANDIDATE
  %IF TRELIM(TR_OP&BMBITOFF)=1 %START
    %IF TRACE#0 %START
      PRINTSTRING("CURRTRIAD IS AN ELIMINATION CANDIDATE");NEWLINE
    %FINISH
    HVAL=HASH; ! GET HASH VAULE OF CURRTRIAD
    ! CHECK IF EITHER OPERAND IS A TEXT REF. WITH USE=1
    %IF TR_QOPD1&TEXTMASK=TEXTMASK %START
      MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
      %IF MTR_USE=1 %THEN %CONTINUE; ! SCAN NEXT TRIAD
    %FINISH
    %IF TR_QOPD2&TEXTMASK=TEXTMASK %START
      MTR==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
      %IF MTR_USE=1 %THEN %CONTINUE; ! SCAN NEXT TRIAD
    %FINISH

    ! SETUP COORD1,COORD2 &MODE
    SETCOORDS

    !SEARCH FOR MATCH FROM SOB
    IND=SOB
    MATCH1:
    %WHILE IND#CURRTRIAD %CYCLE
      MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
      %IF MATCHTR(IND)=1 %THEN ->MATCH2; ! MATCH FOUND
      IND=MTR_CHAIN
    %REPEAT
    %IF TRACE#0 %START
      PRINTSTRING("NO MATCH - SCAN NEXT TRIAD"); NEWLINE
    %FINISH
    %CONTINUE; ! NO MATCH - SCAN NEXT TRIAD
    MATCH2:
    %IF MODE#-1 %START
      %IF TR_MODE2#MTR_MODE2 %THEN IND=MTR_CHAIN %AND ->MATCH1; ! NO MATCH
    %FINISH
    MATCH=IND
    %IF TRACE#0 %START
      PRINTSTRING("MATCH FOUND WITH TRIAD");WRITE(MATCH,1);NEWLINE
    %FINISH
    ! MATCH FOUND - CHECK IF DEFS. POSSIBLE FOR THIS TRIAD
    %IF COORD1=-1 %THEN ->ELIM; ! DEFS. NOT POSSIBLE - ELIMINATE
    %IF BLDEF(BACKTARG)=1 %START; ! DEF. OCCURS IN BACKTARG
      ! CHECK FOR DEFS. BETWEEN MATCH & CURRTRIAD
      %CYCLE
        IND=MTR_CHAIN
        %IF IND=CURRTRIAD %THEN ->ELIM; ! NO DEFS. FOUND
        MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
        %IF TRDEF(IND)=0 %THEN  %CONTINUE; ! NO DEF. - CHECK NEXT TRIAD
        MATCH3:
        %CYCLE
          %IF TRACE#0 %START
            PRINTSTRING("DEF. FOUND - LOOK FOR ANOTHER MATCH");NEWLINE
          %FINISH
          IND=MTR_CHAIN
          MTR==RECORD(ATRIADS+IND*TRIADLENGTH)
          %IF MATCHTR(IND)=1 %THEN %EXIT; ! MATCH FOUND
        %REPEAT
        %IF IND=CURRTRIAD %THEN %EXIT; ! MATCH WITH ITSELF
        %IF MODE#-1 %START; ! CVT TRIAD
          %IF MTR_MODE2#TR_MODE2 %THEN ->MATCH3; ! NOT A MATCH
        %FINISH
        ! HERE IF NEW MATCH
        MATCH=IND
        %IF TRACE#0 %START
          PRINTSTRING("NEW MATCH FOUND WITH TRIAD")
          WRITE(MATCH,1);NEWLINE
        PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
        %FINISH
      %REPEAT; ! END OF CYCLE TO LOOK FOR MATCH WITH NO DEFS.
      %CONTINUE; ! SCAN NEXT TRIAD
    %FINISH; ! END OF CHECK FOR DEFS.
    ELIM:; ! HERE IF NO DEFS.FOUND
    ELIMINATE
    %IF TRACE#0 %START
      PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
    %FINISH
    %CONTINUE; ! SCAN NEXT TRIAD
  %FINISH; ! END OF CURRTRIAD AS AN ELIMINATION CANDIDATE
%REPEAT %UNTIL NEXTTRIAD=0
%IF TRACE#0 %START
  PRINTSTRING("END OF EXPRESSION ELIMINATION FOR BACKTARG");NEWLINE
%FINISH
%END; ! EXPELBTARG

%EXTERNALROUTINE EXPELIM
%INTEGERARRAYFORMAT ELIMF(0:31)
%INTEGERARRAYNAME ELIMENT
%RECORD(BLRECF)%NAME CBL
%RECORD(TRIADF)%NAME TR,MTR
%INTEGER ELIMPTR
%INTEGER I
! CREATE ELIMTAB ENTRY FOR CURRENT BLOCK(CUBLK)
CREATETABLE(32<<WSCALE,ELIMPTR)
ELIMENT==ARRAY(ATABS+ELIMPTR,ELIMF)
ELIMENT(I)=0 %FOR I=0,1,31
!SAVE POINTER TO END OF ELIMTAB ENTRIES
ELIMEND=FREETABS

! INTIIALISE FLAGS
RWFLAG=0

! GET CURRENT BLOCK
CBL==RECORD(ABLOCKS+CURRBLK*BLSIZE)

%IF TRACE#0 %START
  NEWLINES(2)
  PRINTSTRING("EXPRESSION ELIMINATION FOR BLOCK")
  WRITE(CURRBLK,4);NEWLINE
  PRINTSTRING("ELIMTAB ENTRY CREATED AT LOCATION");
  WRITE(ELIMPTR,7);NEWLINES(2)
  PRINTSTRING("SCAN TRIADS IN CURRBLK");NEWLINE
%FINISH
%CYCLE; ! SCAN TRIADS IN CURRBLK
  TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH); ! GET CURRENT TRIAD
  %IF TRACE#0 %START
    PRINTSTRING("CURRTRIAD IS");WRITE(CURRTRIAD,4);NEWLINE
  %FINISH
  ! CHECK IF CURRTRIAD MAY CAUSE DEFS. & CALL UPDATECURRDEF
  %IF DEFTEST(TR_OP&BMBITOFF)>0 %THEN UPDATE CURRDEF

  %IF TRELIM(TR_OP&BMBITOFF)=1 %START
    ! CURRTRIAD IS AN ELIM. CANDIDIATE
    %IF TRACE#0 %START
      PRINTSTRING("CURRTRIAD IS AN ELIMINATION CANDIDATE");NEWLINE
    %FINISH
    HVAL=HASH; ! GET HASH VALUE OF CURRTRIAD(TR)
    %IF TR_QOPD1&TEXTMASK=TEXTMASK %START
      MTR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
      %IF MTR_USE=1 %THEN ->SETELIM1; ! OPERAND IS A TEXT REF. WITH USE=1
    %FINISH
    %IF TR_QOPD2&TEXTMASK=TEXTMASK %START
      MTR==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
      %IF MTR_USE=1 %THEN ->SETELIM1
    %FINISH

    ! SETUP COORD1,COORD2 & MODE
    SETCOORDS
  
    ! PERFORM ANY POSSIBLE ELIMINATIONS
    %IF ELIMENT(HVAL)#0 %START
      ! ELIMTAB ENTRY FOR THIS HASH VALUE IS SET
      %IF TRACE#0 %START
        PRINTSTRING("ELIMTAB ENTRY ALREADY SET FOR HASH VALUE")
        WRITE(HVAL,4);NEWLINE
      %FINISH
      I=ELIMENT(HVAL)
      MATCH1:
      ! SEARCH FOR TRIAD MATCH
      %WHILE I#CURRTRIAD %CYCLE
        MTR==RECORD(ATRIADS+I*TRIADLENGTH)
        %IF MATCHTR(I)=1 %THEN -> NEXT2; ! MATCH FOUND
        I=MTR_CHAIN
      %REPEAT
      %IF TRACE#0 %START
        PRINTSTRING("NO MATCH");NEWLINE
      %FINISH
      ->ELIM2; ! NO MATCH OCCURRED - ELIMINATE OUTSIDE BLOCK
  
      NEXT2:
      %IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
        %IF TR_MODE2#MTR_MODE2 %THEN I=MTR_CHAIN %AND ->MATCH1; ! NO MATCH
      %FINISH
  
      MATCH=I
      !MATCH FOUND, CHECK IF DEFS. POSS. FOR THIS TRIAD
      %IF TRACE#0 %START
        PRINTSTRING("MATCH FOUND WITH TRIAD"); WRITE(MATCH,1);NEWLINE
      %FINISH
      %IF COORD1=-1 %THEN ->ELIM1; ! DEFS. NOT POSS. - ELIMINATE
      %IF CURBLDEF=1 %START; ! DEF. OCCURS IN THIS BLOCK
        %CYCLE; ! ELIMINATE IF MATCHING TRIAD WITH NO DEFS. BEFORE CURRTRIAD
          I=MTR_CHAIN
          %IF I=CURRTRIAD %THEN ELIMINATE %AND %EXIT
          MTR==RECORD(ATRIADS+I*TRIADLENGTH)
          %IF TRDEF(I)=0 %THEN %CONTINUE; ! NO DEFS. - CHECK NEXT TRIAD
          LOOP1:
          %CYCLE; ! DEF. FOUND - LOOK FOR ANOTHER MATCH
          %IF TRACE#0 %START
            PRINTSTRING("DEF. FOUND - LOOK FOR ANOTHER MATCH");NEWLINE
          %FINISH
            I=MTR_CHAIN
            MTR==RECORD(ATRIADS+I*TRIADLENGTH)
            %IF MATCHTR(I)=1 %THEN %EXIT; ! MATCH FOUND - EXIT CYCLE
          %REPEAT
          %IF I=CURRTRIAD %THEN %EXIT; ! MATCH WITH ITSELF - EXIT
          %IF MODE#-1 %START; ! CVT TRIAD - CHECK MODES
            %IF MTR_MODE2#TR_MODE2 %THEN ->LOOP1; ! NOT A MATCH
          %FINISH
          ! HERE IF NEW MATCH FOUND
          MATCH=I
          %IF TRACE#0 %START
            PRINTSTRING("NEW MATCH FOUND WITH TRIAD"); WRITE(MATCH,1)
            NEWLINE
          %FINISH
        %REPEAT; ! END OF CYCLE TO LOOK FOR MATCHING TRIAD WITH NO DEFS.
        %IF TRACE#0 %START
          PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
        %FINISH
        %CONTINUE; ! SCAN NEXT TRIAD
        %FINISH; ! END OF DEFS. OCCURING IN CURRENT BLOCK
  
      ELIM1:
      ! HERE IF NO DEFS. IN CURRBLK
      ELIMINATE
      %IF TRACE#0 %START
        PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
      %FINISH
      %CONTINUE; ! SCAN NEXT TRIAD
  
      ELIM2:
      ! HERE FOR POSSIBLE ELIMS. OUTSIDE CURRBLK
      CHECKOUT
    %FINISH {ELIMTAB ENTRY SET} %ELSESTART
      %IF TRACE#0 %START
        PRINTSTRING("ELIMTAB ENTRY NOT SET FOR HVAL");NEWLINE
      %FINISH
      CHECKOUT
      %IF ELFLAG=0 %THEN ELIMENT(HVAL)=CURRTRIAD
    %FINISH
    %IF TRACE#0 %START
      PRINTSTRING("SCAN NEXT TRIAD");NEWLINE
    %FINISH
    %CONTINUE; ! SCAN NEXT TRIAD
  
    SETELIM1:
    ! HERE IF OPERANDS ARE TRIADS WITH USE=1
    %IF TRACE#0 %START
      PRINTSTRING("CURRTRIAD'S OPERANDS ARE TRIADS WITH USE=1");NEWLINE
    %FINISH
    %IF ELIMENT(HVAL)=0 %THEN ELIMENT(HVAL)=CURRTRIAD
  %FINISH; ! END OF CURRTRIAD AS AN ELIM. CNADIDATE
%REPEAT %UNTIL NEXTTRIAD=0

! CLEAR RW
FREETABS=ELIMEND
%IF TRACE#0 %START
  PRINTSTRING("END OF EXPRESSION ELIMINATION FOR CURRBLK");NEWLINE
%FINISH
%END; ! EXPELIM
%ENDOFFILE