! f2opt1
! 07/12/86 - copy of ftn2opt5
! - insert include files
! 13/06/86 - avoid back move of char array els
! 11/06/86 - BREAKCHECK to always return 0
! 10/06/86 - suppress backward movement of simple common var
! 02/12/85 - taken from op2p47, new include files incorporated
! 07/08/85 - include test for CHARMODE in ARR/DEFARR triad in BMOVECHECK
! 26/06/85 - line 976 0f LOOPBUILD, map on to next AR block
! - line 812 of LOOPBUILD, map on to current CL block
! 19/09/84 - clear relevant bit in CLOOPDEF if ASMT/ASGN triad backward moved
! - line 1510 corrected to VAL1=1, line 1515 moved back 7 lines
! 28/08/84 - correction to BTBITS for CMNCOORDS(1)
! 02/07/84 - change OPTSAB(CMPLX) entry to X'06'
! 11/04/84 - don't word align FREETABS in BMOVHECK
! 10/04/84 - scaling correction in bmovecheck
! 31/01/84 - UPDATE OPSTAB FOR DCMPLX & INTRIN
! 18/01/84 - ADJUST BIT STRIP ADDRESSES
! 17/01/84 - MAKE CALLS OF CREATETAB CONSISTTENT
! 23/11/83 call EDUMPTRACE in OP2A; set up LDUMPTRACE & BMTRACE
! 22/11/82 call CDUMPTRACE in OP2A
! 27/10/83 COPIED FROM ERCS06.REL90_OP2B13
!*
%INCLUDE "ftn_ht"
{%INCLUDE "ftn_fmts2"}
!* 09/12/85 - add recordformat SUBFMT
!* modified 14/03/85
!*
!***********************************************************************
!* Formats for accessing dictionary records *
!***********************************************************************
!*
%recordformat PRECF(%byteinteger CLASS,TYPE,X0,X1,
%integer LINK1, LINK2,
(%shortinteger COORD,LINK3 %OR %integer LAST %C
%OR %integer CONSTRES %OR %integer INF3),
%integer ADDR4,
%shortinteger DISP,LEN,IDEN,IIN,
%integer LINE,XREF,CMNLENGTH,CMNREFAD)
!*
%recordformat SRECF(%integer INF0, LINK1, INF2, INF3, INF4)
!*
%recordformat RESF((%integer W %OR %shortinteger H0,
(%shortinteger H1 %OR %byteinteger FORM,MODE)))
!*
%recordformat DORECF( %C
%integer LABEL, LINK1,
%record(RESF) LOOPAD, ENDREF, INDEXRD, INCRD, FINALRD, ICRD,
%integer LABLIST,LINE)
!*
%recordformat BFMT(%integer L,U,M)
!*
%recordformat ARRAYDVF(%integer DIMS, ADDRDV,ADDRZERO, %C
%integer ZEROTOFIRST, ADFIRST, NUMELS, ELLENGTH, %C
%record(BFMT) %ARRAY B(1 : 7))
!*
!*
%recordformat LRECF(%integer NOTFLAG,LINK1,
%record(RESF) ORLAB,ANDLAB,
%integer RELOP)
!*
%recordformat IFRECF(%integer TYPE,LINK1,
%record(RESF) ENDIFLAB,FALSELAB,
%integer LABLIST,LINE)
!*
%recordformat LABRECF(%shortinteger BLKIND,%byteinteger X0,X1, %C
%integer LINK1,LINK2,LINK3,ADDR4,LINK5,LAB,LINE, %C
%shortinteger DOSTART,DOEND,IFSTART,IFEND)
!*
%recordformat PLABF(%shortinteger BLKIND,%byteinteger USE,X1,
%integer INDEX,CODEAD,REF,REFCHAIN)
!*
%recordformat IMPDORECF(%integer VAL,LINK,IDEN)
!*
%recordformat CONSTRECF(%shortinteger MODE,LENGTH,
(%integer VALUE %OR %integer LINK1),
%integer DADDR,CADDR)
!*
%recordformat TMPF((%byteinteger CLASS,TYPE,
%shortinteger LEN %OR %integer W0),
%integer LINK1,
%byteinteger REG,MODE,%shortinteger INDEX,
%shortinteger COORD,USECNT,
%integer ADDR)
!*
%recordformat CHARF(%integer ADESC,LINK,LEN)
!*
%recordformat FNRECF(%integer FPTR,LINK1,HEAD,PCT)
!*
%recordformat TERECF(%shortinteger MODE,LOOP,
%integer CHAIN,DISP1,INDEX,
%shortinteger COORD,FLAGS)
!*
%recordformat DTRECF(%shortinteger MODE,IDENT,
%integer CHAIN,DISP2,
%shortinteger FLAGS,INDEX,
(%integer LOOP %OR %record(RESF) CONST))
!*
!*
!***********************************************************************
!* TRIAD record format *
!***********************************************************************
!*
%recordformat TRIADF( %C
%byteinteger OP,
(%byteinteger USE %OR %byteinteger VAL2),
%shortinteger CHAIN,
(%record(RESF) RES1 %OR %C
(%shortinteger OPD1,%byteinteger QOPD1,MODE %OR %C
(%integer SLN %OR %integer VAL1))),
(%record(RESF) RES2 %OR %C
%shortinteger OPD2,%byteinteger QOPD2,MODE2))
!*
!***********************************************************************
!* COM record format *
!***********************************************************************
!*
%recordformat COMFMT(%integer CONTROL,OPT,OPTIONS1,OPTIONS2,PTRACE,
ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR,
MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD,
SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST,
RESCOM1,RESCOM2,F77PARM,FNO,FAULTY,LINEST,CMNIIN,SFMK,
LISTL,LISTSTREAM,DIAGSTREAM,LISTMODE,XREF,
PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR,
HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN,
NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT,
UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR,
FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT,
COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR,
CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN,
ADEXT,MAXDICT,MAXNAMES,MAXOUTPUT,MAXEXT,
ACOMP,ASUBNAMES,MAXPSTACK,
ATRIADS,TRFILEID,TRBLOCK,CMNCNT,SCANONLY,NOISY,
MAXANAL,MAXGEN,SAVEANAL,SAVEGEN,OPTFLAGS,NEXTBIT,
ACMNBITS,NEXTTEMP,ASSGOTOS,TMPPTR,DESTEMPS,OBJADDR,
AREAADDR,PASTART,ADOPTDATA,TMINDEX,VRETURN,ENTRIES,
EQUCHK,LABWARN,LINENO,MAXIBUFF,
COMMENTS,DIAGLEVEL,WARNNOT77,WARNLENGTH,ALLOWUNIX,ALLOWVAX,
ONETRIP,HOST,TARGET,MONERRS,CODECA,
GLACA,DIAGCA,SSTCA,GSTCA,CONSTCA,SCALARCA,IOAREACA,ZGSTCA,STACKCA,
W1,W2,W4,STATORDERMODE,CURSTATCLASS,LISTPOINT,STACKBASE,
NEXTTRIAD,ASAVE,MAXSAVE,SUBTAB,LASTSUBTAB,
INHIBOP4,ARGCNT,IDCNT,LABCNT,TMLIST,MAINPROG,PROCINDEX,CONSOLE)
!*
!***********************************************************************
!* record format for communicating with optimiser *
!***********************************************************************
!*
%recordformat OBJFMT(%string(35) MODULE,%integer MAINEP,I,J,K,
ADATE,ATIME,OPTIONS2,EXTPROCS,ATRIADS,MAXTRIADS,
ABLOCKS,MAXBLOCKS,ALOOP,MAXLOOP,ATABS,MAXTABS,
SRFLAGS,INHIBMASK,OPT,OPTFLAGS,OPTDESC0,OPTDESC1,
D1,D2,D3,D4)
!*
!***********************************************************************
!*
!*
%RECORDFORMAT SUBRECF(%INTEGER LINK,FLAGS,TRIADS,DICT,NAMES,PTRS,PROG,
LABCNT,ARGCNT,IDCNT,TRCNT,REFSCNT,SUBSCNT,
DPTR,NEXTTRIAD,NAMESFREE,NEXTBIT,SUBPROGTYPE,SUBPROGPTR,
CBNPTR,SCPTR,CMNIIN,FUNRESDISP,CMNCNT,ASSGOTOS,VRETURN,ENTRIES,
TMLIST,ALABS,ALHEADS,NEXTPLAB,
%STRING(32) NAME,%INTEGERARRAY COORDS(0:15))
!*
%CONSTINTEGER SUBSIZE=232
%CONSTINTEGER LABSIZE=128
%CONSTINTEGER LHEADSIZE=620
!*
!*
{%INCLUDE "ftn_optspecs1"}
!*
!***********************************************************************
!* External data items *
!***********************************************************************
!*
%EXTRINSICINTEGER ADICT ;! @ of dictionary area
%EXTRINSICINTEGER MAXDICT ;! currect available length of dictionary
%EXTRINSICINTEGER ANAMES ;! @ of name table
%EXTRINSICINTEGER ABLOCKS ;! @ of block table
%EXTRINSICINTEGER MAXBLOCKS ;! current available length of block table area
%EXTRINSICINTEGER NEXTBLOCK ;! next available block index
%EXTRINSICINTEGER FREEBLOCKS
%EXTRINSICINTEGER CBNPTR ;! listhead of common block records
%EXTRINSICINTEGER SCPTR ;! listhead of local identifiers
%EXTRINSICINTEGER ATABS ;! @ of area for assorted optimiser tables
%EXTRINSICINTEGER MAXTABS ;! curent available length of opt table area
%EXTRINSICINTEGER FREETABS ;! next free location in opt table area
%EXTRINSICINTEGER EXBPTR ;! exit block table
%EXTRINSICINTEGER ENTBPTR ;! entry block table
%EXTRINSICINTEGER ALOOPS ;! @ loop table area
%EXTRINSICINTEGER MAXLOOPS ;! current available length of loop table area
%EXTRINSICINTEGER FREELOOPS ;! next free location in loop table area
%EXTRINSICINTEGER ATRIADS ;! @ of triad area
%EXTRINSICINTEGER LASTTRIAD ;! last allocated triad index
%EXTRINSICINTEGER MAXTRIADS ;! current available number of triads
%EXTRINSICINTEGER FREETRIADS;! listhead of released triads
%EXTRINSICINTEGER BLSIZE ;! length (in architecture units) of a block entry
%EXTRINSICINTEGER BSBITS ;! length (in bits) of bit string
%EXTRINSICINTEGER BSSIZE ;! length (in architecture units) of a bit strip
%EXTRINSICINTEGER BSWORDS ;! length in 2900 words of a bit strip
%EXTRINSICINTEGER OPT ;! optimisation level 0, 1 or 2
%EXTRINSICINTEGER OPTFLAGS ;! tracing level 1 Triads 2 Blocks 4 Loops
%EXTRINSICINTEGER INHIBMASK ;! inhibits specific optimisations
%EXTRINSICINTEGER SRFLAGS ;! strength reduction diagnostic flags
%EXTRINSICINTEGER SRHEAD
%EXTRINSICINTEGER SRCH
%EXTRINSICINTEGER APROPTABS ;! @ bsbits * prop table entries
%EXTRINSICINTEGER CLOOPHEAD ;! head of list of all blocks in current loop
%EXTRINSICINTEGER PLOOPHEAD ;! subset of CLOOPHEAD list already processed
%EXTRINSICINTEGER DLOOPHEAD ;! CLOOPHEAD list - PLOOPHEAD list
%EXTRINSICINTEGER CLOOPTAIL
%EXTRINSICINTEGER PLOOPTAIL
%EXTRINSICINTEGER DLOOPTAIL
%EXTRINSICINTEGER DLOOPPTR ;! current DLOOP record
%EXTRINSICINTEGER LOOP ;! current pointer to looptab
%EXTRINSICINTEGER BACKTARG ;! blocktab index of back target block
%EXTRINSICINTEGER BTARGTRIAD;! index of triad within back target block to which new triads chained
%EXTRINSICINTEGER OLDBTARGTRIAD
%EXTRINSICINTEGER LOOPDEPTH ;! depth of current loop
%EXTRINSICINTEGER LOOPENT ;! blocktab index of loop entry block
%EXTRINSICINTEGER CURRBLK ;! blocktab index of current block
%EXTRINSICINTEGER CURRTRIAD ;! triad index of triad currently being processed
%EXTRINSICINTEGER PREVTRIAD ;! previous triad (for rechaining)
%EXTRINSICINTEGER ACMNCOORDS;! @ CMNCOORDS
%EXTRINSICINTEGER ACURRDEF ;! @ CURRDEF
%EXTRINSICINTEGER ASTFNDEF
%EXTRINSICINTEGER ARGRISK
%EXTRINSICINTEGER VALTEMPHEAD
%EXTRINSICINTEGER DESTEMPHEAD
%EXTRINSICINTEGER DTINDEX
%EXTRINSICINTEGER TEINDEX
%EXTRINSICINTEGER TECH
%EXTRINSICINTEGER DTCH
!*
%EXTRINSICINTEGERARRAY CMNCOORDS(0:15) ;!
%EXTRINSICINTEGERARRAY CLOOPUSE(0:15) ;!
%EXTRINSICINTEGERARRAY PLOOPUSE(0:15) ;!
%EXTRINSICINTEGERARRAY DLOOPUSE(0:15) ;!
%EXTRINSICINTEGERARRAY CLOOPDEF(0:15) ;!
%EXTRINSICINTEGERARRAY PLOOPDEF(0:15) ;!
%EXTRINSICINTEGERARRAY DLOOPDEF(0:15) ;!
%EXTRINSICINTEGERARRAY CURRDEF(0:15) ;!
%EXTRINSICINTEGERARRAY STFNDEF(0:15)
!*
!***********************************************************************
!* Service procedures *
!***********************************************************************
!*
%EXTERNALROUTINESPEC BLOCKSFULL ;! to be called when block table exhausted
%EXTERNALROUTINESPEC TABSFULL ;! to be called when opt table exhausted
%EXTERNALROUTINESPEC DICTFULL ;! to be called when dictionary is full
%EXTERNALROUTINESPEC LOOPSFULL ;! to be called when loop table is full
!*
%EXTERNALINTEGERFNSPEC GETTRIAD
%EXTERNALINTEGERFNSPEC ALLDEF(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC NEXTTRIAD
%EXTERNALINTEGERFNSPEC NEXTTR
%EXTERNALROUTINESPEC UPDATE CURRDEF
%EXTERNALROUTINESPEC DELUSE(%INTEGER INDEX)
%EXTERNALROUTINESPEC DELUSEX(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC LOOPCON1(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC LOOPCON2(%INTEGER INDEX)
%EXTERNALROUTINESPEC TREVERSE(%INTEGER INDEX)
%EXTERNALINTEGERFNSPEC BUSYONX(%INTEGER FROMORTO,BLOCK,IDPTR)
%EXTERNALROUTINESPEC SETCMNBITS(%INTEGER STRIPADDR)
%EXTERNALROUTINESPEC SETARGBITS(%INTEGER BLIND)
%EXTERNALROUTINESPEC SETBIT(%INTEGER STRIPADDR,INDEX)
%EXTERNALROUTINESPEC PUTBIT(%INTEGER STRIPADDR,INDEX,VAL)
%EXTERNALROUTINESPEC CLEARBIT(%INTEGER STRIPADDR,INDEX)
%EXTERNALROUTINESPEC GETBIT(%INTEGER STRIPADDR,INDEX,%INTEGERNAME VAL)
%EXTERNALINTEGERFNSPEC CONOUT(%RECORD(RESF) R)
%EXTERNALINTEGERFNSPEC CONIN(%INTEGER VAL)
%EXTERNALINTEGERFNSPEC CONOP(%RECORD(RESF) RL,%INTEGER OP,
%RECORD(RESF) RR,%RECORD(RESF)%NAME R)
%EXTERNALINTEGERFNSPEC CONVAL(%INTEGER CONST1,CONST2,OP,MODE)
%EXTERNALINTEGERFNSPEC CREATETAB(%INTEGER A)
%EXTERNALINTEGERFNSPEC CREATEDTAB(%INTEGER A)
%EXTERNALROUTINESPEC PRBLOCK(%INTEGER BL)
%EXTERNALROUTINESPEC PRBLTRIADS(%INTEGER BL)
%EXTERNALROUTINESPEC PRINTBS(%INTEGERARRAYNAME B)
%EXTERNALROUTINESPEC PUSHFREE(%INTEGER VAL,%INTEGERNAME LINK)
!*
!*
{%INCLUDE "ftn_optfmts1"}
!*
!***********************************************************************
!* Optimiser record formats *
!***********************************************************************
!*
%RECORDFORMAT BLRECF(%BYTEINTEGER FLAGS,DEPTH,%SHORTINTEGER CHAIN,
%INTEGER FCON,
%INTEGER BCON,BDOM,BTARG,TEXT,
%INTEGER CORRUPT,BUB1,
%INTEGER USE,DEF,BOE)
!*
%RECORDFORMAT CONRECF((%INTEGER COUNT %OR %INTEGERARRAY BLOCK(0:1000)))
!*
%RECORDFORMAT LOOPRECF(%INTEGER BLOCK,DOWN,ACROSS,ST)
!*
%RECORDFORMAT CLOOPRECF(%INTEGER BLOCK,PDCHAIN,PDBACKCHAIN)
!*
%RECORDFORMAT PROPRECF(%SHORTINTEGER DEFCT,TEXT,DEFN,
%BYTEINTEGER FLAGS,COORD2,
%RECORD(RESF) REPL)
!*
%RECORDFORMAT SREDF(%SHORTINTEGER MODE,IDENT,LOOP,DUMP,INIT,
%BYTEINTEGER FLAGS,SPARE1,
%SHORTINTEGER USECT,SPARE2,
%INTEGER WEIGHT,
%INTEGER CHAIN,
(%SHORTINTEGERARRAY INCR(1:3),TEST(1:3),USE(1:1000) %C
%OR %SHORTINTEGERARRAY ALLREFS(1:1006)))
!*
!***********************************************************************
!* Constant definitions *
!***********************************************************************
!*
%CONSTINTEGER USE = 0 ;! variable usage
%CONSTINTEGER DEF = 1 ;!
!*
%CONSTINTEGER TDUMP = 1 ;! dump triads before optimiastion
%CONSTINTEGER BDUMP = 2 ;! dump block tables
%CONSTINTEGER LDUMP = 4 ;! dump loop tables
%CONSTINTEGER T1DUMP = 8 ;! dump triads after OP1
%CONSTINTEGER T2DUMP = 16 ;! dump triads after OP2
%CONSTINTEGER T3DUMP = X'200' ;! dump triads after OP3
%CONSTINTEGER SDUMP = 32 ;! give reconstructed source
%CONSTINTEGER S1DUMP = X'800' ;! reconstructed source after OP1
%CONSTINTEGER S2DUMP = X'1000' ;! reconstructed source after OP2
%CONSTINTEGER EDUMP = 64 ;! dump elimination info
%CONSTINTEGER CDUMP = X'80' ;! constant elimination
%CONSTINTEGER PDUMP = X'100';! proptabs
%CONSTINTEGER SEOBDUMP = X'400' ;! dump triads for block after SUBSEOB
%CONSTINTEGER SSDUMP = X'2000' ;! trace path through SUBSUM
!*
%CONSTINTEGER INHIBSUBSUM = 1
%CONSTINTEGER INHIBOP2A = 2
%CONSTINTEGER INHIBEXPOPTS = 4
%CONSTINTEGER INHIBBMOVE = 8
%CONSTINTEGER INHIBEXPELIM = 16
%CONSTINTEGER INHIBSTR = 32
!*
%CONSTINTEGER FUNCBIT = X'80' ;! block contains a function call
%CONSTINTEGER RETBIT = X'20' ;! block is a procedure return block
%CONSTINTEGER LEBIT = X'10' ;! block is a loop entry block
%CONSTINTEGER ARTICBIT = X'08' ;! block is an articulation block
!*
%CONSTINTEGER EBBIT = X'08' ;! entry block marker in label table
!*
%CONSTINTEGER SOB = X'80' ;! start of block marker in STMT triad
%CONSTINTEGER BMBIT = x'80' ;! in TR_OP indicates it has been backward moved
%CONSTINTEGER BMBIT OFF = x'7F' ;! mask for deleting BMBIT
%CONSTINTEGER BMBIT SHIFT = 7
!*
%CONSTINTEGER TESTREPBIT = 2
%CONSTINTEGER REVTESTBIT = 1
%CONSTINTEGER BREGBIT = 4
%CONSTINTEGER SCANDBIT = 8
!*
%CONSTINTEGER SRTEMPBIT = 1
%CONSTINTEGER ACTARGBIT = 2
%CONSTINTEGER INITLOADBIT = 4
!*
%CONSTINTEGER FROM = 0 ;! param to BUSYONX
%CONSTINTEGER TO = 1 ;! ditto
%CONSTINTEGER BUSY = 1
%CONSTINTEGER NOT BUSY = 0
!*
%CONSTBYTEINTEGERARRAY DEFTEST(0:116)= %C
0(7),1,0(4),1,0(38),5,0,1,0(11),3,4,0(3),6,0,2,0(44);! ASMT,ASGN,FUN,CALL,DARG
!*
!*
%RECORDFORMAT OPTDFMT( %C
%INTEGER ADICT ,{ @ of dictionary area}
%INTEGER MAXDICT ,{ currect available length of dictionary}
%INTEGER ANAMES ,{ @ of name table}
%INTEGER ABLOCKS ,{ @ of block table}
%INTEGER MAXBLOCKS ,{ current available length of block table area}
%INTEGER NEXTBLOCK ,{ next available block index}
%INTEGER FREEBLOCKS,
%INTEGER CBNPTR ,{ listhead of common block records}
%INTEGER SCPTR ,{ listhead of local identifiers}
%INTEGER ATABS ,{ @ of area for assorted optimiser tables}
%INTEGER MAXTABS ,{ curent available length of opt table area}
%INTEGER FREETABS ,{ next free location in opt table area}
%INTEGER EXBPTR ,{ exit block table}
%INTEGER ENTBPTR ,{ entry block table}
%INTEGER ALOOPS ,{ @ loop table area}
%INTEGER MAXLOOPS ,{ current available length of loop table area}
%INTEGER FREELOOPS ,{ next free location in loop table area}
%INTEGER ATRIADS ,{ @ of triad area}
%INTEGER LASTTRIAD ,{ last allocated triad index}
%INTEGER MAXTRIADS ,{ current available number of triads}
%INTEGER FREETRIADS,{ listhead of released triads}
%INTEGER BLSIZE ,{ length (in architecture units) of a block entry}
%INTEGER BSBITS ,{ length (in bits) of bit string}
%INTEGER BSSIZE ,{ length (in architecture units) of a bit strip}
%INTEGER BSWORDS ,{ length in 2900 words of a bit strip}
%INTEGER OPT ,{ optimisation level 0, 1 or 2}
%INTEGER OPTFLAGS ,{ tracing level 1 Triads 2 Blocks 4 Loops }
%INTEGER INHIBMASK ,{ inhibits specific optimisations}
%INTEGER SRFLAGS ,{ strength reduction diagnostic flags}
%INTEGER SRHEAD,
%INTEGER SRCH,
%INTEGER APROPTABS ,{ @ bsbits * prop table entries}
%INTEGER CLOOPHEAD ,{ head of list of all blocks in current loop }
%INTEGER PLOOPHEAD ,{ subset of CLOOPHEAD list already processed}
%INTEGER DLOOPHEAD ,{ CLOOPHEAD list - PLOOPHEAD list}
%INTEGER CLOOPTAIL,
%INTEGER PLOOPTAIL,
%INTEGER DLOOPTAIL,
%INTEGER DLOOPPTR ,{ current DLOOP record}
%INTEGER LOOP ,{ current pointer to looptab}
%INTEGER BACKTARG ,{ blocktab index of back target block}
%INTEGER BTARGTRIAD,{ index of triad within back target block to which new triads chained}
%INTEGER OLDBTARGTRIAD,
%INTEGER LOOPDEPTH ,{ depth of current loop}
%INTEGER LOOPENT ,{ blocktab index of loop entry block}
%INTEGER CURRBLK ,{ blocktab index of current block}
%INTEGER CURRTRIAD ,{ triad index of triad currently being processed}
%INTEGER PREVTRIAD ,{ previous triad (for rechaining)}
%INTEGER ACMNCOORDS,{ @ CMNCOORDS}
%INTEGER ACURRDEF ,{ @ CURRDEF}
%INTEGER ASTFNDEF,
%INTEGER ARGRISK,
%INTEGER VALTEMPHEAD,
%INTEGER DESTEMPHEAD,
%INTEGER DTINDEX,
%INTEGER TEINDEX,
%INTEGER TECH,
%INTEGER DTCH)
!*
!
{%INCLUDE "ftn_consts1"}
!* modified 23/09/86
!*
!*
%constinteger WSCALE = 2;! scale word address to byte address
%constinteger BSCALE = 0;! scaling factor for words to architectural units
%constinteger CSCALE = 0;! byte offset to architectural unit offset
%constinteger DSCALE = 2;! dict pointer scaling in RES records
!*
%constinteger W1 = 4 ;! 1 word in architectural units
%constinteger W2 = 8 ;! 2 words in architectural units
%constinteger W3 = 12 ;! 3 words in architectural units
%constinteger W4 = 16 ;! 4 words in architectural units
!*
%constinteger TRIADLENGTH = 12 ;! size of an individual triad
%constinteger BLRECSIZE = 44 ;! size of a block table entry in architectural units
%constinteger LOOPRECSIZE = 16 ;! size of a loop table entry
%constinteger PROPRECSIZE = 12 ;! size of a propagation table entry
%constinteger CLOOPSZ = 12 ;! size of cloop table entry
%constinteger FRSIZE = 8 ;! size of freelist created by PUSHFREE
%constinteger TESZ = 20
%constinteger DTSZ = 20
%constinteger ARTICSZ = 4
%constinteger CTSIZE = 2 ;! used in OP3
%constinteger EXTNSIZE = 4 ;! used in OP3
!*
!* following used in strength reduction
!*
%constinteger RDSZ = 8
%constinteger RUSESZ = 12
%constinteger RTESTSZ = 4
%constinteger RDEFSZ = 16
%constinteger USESZ = 32
%constinteger SRUSESZ = 2
%constinteger SRSCALE = 4;! SR==RECORD(ABLOCKS + SRPTR<<SRSCALE)
%constinteger SRFIXED = 36
!*
!*
%conststring(5) REG1="reg7"
%constinteger GLAOFFSET=32
%if target=ibm %thenstart
%constinteger dvarea=7
%finishelsestart
%constinteger DVAREA=2
%finish
!*
!***********************************************************************
!* Constants defining the size of DICT records *
!***********************************************************************
!*
%constinteger IDRECSIZE = 28;! size of dict entry reserved for a new identifier
%constinteger CONRECSIZE = 16
%constinteger CNSTRECMIN = 4
%constinteger IMPDORECSIZE = 12;! size of DATA-implied-DO list item
%constinteger LABRECSIZE = 40
%constinteger PLABRECSIZE = 8;! N.B. this is a reduced size for compiler using Put interfaces
%constinteger XREFSIZE = 8
%constinteger CMNRECEXT = 16;! extra space on iden record for common block name
%constinteger TMPRECSIZE = 20
%constinteger DVRECSIZE = 28
%constinteger TRIADSIZE = 12
%constinteger LBLKSIZE = 520
!*
!*
!********************* TRIAD qualifiers ********************************
!*
%CONSTINTEGER NULL = 0
%CONSTINTEGER LABID = 1
%CONSTINTEGER PLABID = 2
%CONSTINTEGER PROCID = 3
%CONSTINTEGER STKLIT = 4
%CONSTINTEGER GLALIT = 5
%CONSTINTEGER SRTEMP = 6
%CONSTINTEGER BREG = 7
%CONSTINTEGER VALTEMP = 8
%CONSTINTEGER DESTEMP = 9
%CONSTINTEGER LSCALID =16
%CONSTINTEGER OSCALID =17
%CONSTINTEGER CSCALID =18
%CONSTINTEGER ASCALID =19
%CONSTINTEGER PSCALID =20
%CONSTINTEGER ARRID =21
%CONSTINTEGER TMPID =22
%CONSTINTEGER PERMID =23
%CONSTINTEGER STFNID =24
%CONSTINTEGER ITMPID =22
%CONSTINTEGER RTMPID =22
%CONSTINTEGER ETMPID =22
%CONSTINTEGER TRIAD =32
%CONSTINTEGER ARREL =33
%CONSTINTEGER CHAREL =34
%CONSTINTEGER CHVAL =35
%CONSTINTEGER LIT =64
%CONSTINTEGER NEGLIT =65
%CONSTINTEGER CNSTID =66
!*
!********************* TRIAD masks *************************************
!*
%CONSTINTEGER CONSTMASK=X'40'
%CONSTINTEGER IDMASK =X'10'
%CONSTINTEGER TEXTMASK =X'20'
!*
!********************* other useful masks ******************************
!*
%CONSTINTEGER ARRAYBIT = X'04'
%CONSTINTEGER CMNBIT = X'02'
%CONSTINTEGER EQUIVBIT = X'80'
!*
!********************* modes *******************************************
!*
%CONSTINTEGER INT2 = 0, INT4 = 1, INT8 = 2
%CONSTINTEGER REAL4 = 3, REAL8 = 4, REAL16 = 5
%CONSTINTEGER CMPLX8 = 6, CMPLX16 = 7, CMPLX32 = 8
%CONSTINTEGER LOG1 = 9, LOG2 =10, LOG4 =11
%CONSTINTEGER LOG8 =12, CHARMODE=13, HOLMODE =14
%CONSTINTEGER BYTE =15, HEXCONST=16
!*
!********************* types *******************************************
!*
%CONSTINTEGER INTTYPE = 1
%CONSTINTEGER REALTYPE = 2
%CONSTINTEGER CMPLXTYPE = 3
%CONSTINTEGER LOGTYPE = 4
%CONSTINTEGER CHARTYPE = 5
!*
!********************* scaling factors *********************************
!*
!*
!********************* length of maximum source statement **************
!*
%CONSTINTEGER INPUT LIMIT = 1328
!*
!********************* mode to size/type *******************************
!*
%CONSTBYTEINTEGERARRAY MODETOST(0:15)= %C
X'41',X'51',X'61',X'52',X'62',X'72',
X'53',X'63',X'73',X'34',X'44',X'54',X'64',5,0,X'31'
!*
!********************* mode to bytes etc. ******************************
!*
%CONSTBYTEINTEGERARRAY CSIZE(0:15)= %c
2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoBytes(0:15)= %c
2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
%CONSTBYTEINTEGERARRAY ModetoTempBytes(0:15)= %c
4,4,8,4,8,16,8,16,32,4,4,4,8,4,4,4
%CONSTBYTEINTEGERARRAY SETMODE(0:63)= %C
0(4),10,13,0(11),1,3,6,11,0(12),2,4,7,8,0(12),15,5,8,9,0(11)
!*
!********************** location of pseudo common record in dict *******
!*
%CONSTINTEGER PSEUDOCMN=20
!*
!********************** location of blank common record in dict ********
!*
%CONSTINTEGER BLCMPTR=96
!*
!********************** other useful consts ****************************
!*
%CONSTINTEGER NO = 0
%CONSTINTEGER YES = 1
%CONSTINTEGER FULL= 2
!*
!********************** area identifiers *******************************
!*
%constinteger STACK = 0
%CONSTINTEGER GLA = 2
%CONSTINTEGER SST = 4
%CONSTINTEGER GST = 5
%CONSTINTEGER DIAGS = 6
%if target=ibm %thenstart
%constinteger scalars=7
%finishelsestart
%CONSTINTEGER SCALARS = 2
%finish
%CONSTINTEGER IOAREA = 8
%CONSTINTEGER ZEROGST = 9
%CONSTINTEGER CONSTS =10
!*
!********************** system procedures ******************************
!*
%constinteger F77AUX = 0
%constinteger F77STOP = 1
%constinteger F77PAUSE = 2
%constinteger F77IOA = 3
%constinteger F77IOB = 4
%constinteger F77IOC = 5
%constinteger F77IOD = 6
%constinteger F77IOE = 7
%constinteger F77IOF = 8
%constinteger F77FILE = 9
%constinteger IMPSTOP =10
%constinteger F77RTERR =11
%constinteger F77IOAR =12
%constinteger F77IOBR =13
%constinteger F77IOG =14
%constinteger F77CPSTR =15
%constinteger F77CONCAT=16
%constinteger F77INDEX =17
%constinteger FIBITS =18
%constinteger FISHFTC =19
%constinteger F77PCHECK=20
%constinteger F77IOH =21
%constinteger F77IOI =22
!***********************************************************************
!*
!*
{%INCLUDE "ftn_triadops1"}
!*
!*********************** TRIAD operator values *************************
!*
%constinteger ADD = X'02'
%constinteger SUB = X'03'
%constinteger MULT = X'04'
%constinteger DIV = X'05'
%constinteger NEG = X'06'
%constinteger ASMT = X'07'
%constinteger CVT = X'08'
%constinteger ARR = X'09'
%constinteger ARR1 = X'0A'
%constinteger BOP = X'0B'
%constinteger ASGN = X'0C'
%constinteger EXP = X'0E'
%constinteger EXP3 = X'0F'
%constinteger AND = X'10'
%constinteger OR = X'11'
%constinteger NOT = X'12'
%constinteger EQUIV = X'13'
%constinteger NEQ = X'14'
%constinteger GT = X'15'
%constinteger LT = X'16'
%constinteger NE = X'17'
%constinteger EQ = X'18'
%constinteger GE = X'19'
%constinteger LE = X'1A'
%constinteger SUBSTR = X'1B'
%constinteger CHAR = X'1C'
%constinteger CONCAT = X'1D'
%constinteger CHHEAD = X'1E'
%constinteger STOD1 = X'20'
%constinteger STOD2 = X'21'
%constinteger EOD1 = X'24'
%constinteger EOD2 = X'25'
%constinteger BRK = X'28'
%constinteger DARR = X'29'
%constinteger DEFARR = X'29'
%constinteger RRSUB = X'2A'
%constinteger RRDIV = X'2B'
%constinteger DCHAR = X'2C'
%constinteger ASH = X'2D'
%constinteger STRTIO = X'30'
%constinteger IOITEM = X'31'
%constinteger IODO = X'32'
%constinteger IOSPEC = X'33'
%constinteger IO = X'34'
%constinteger ENDIO = X'34'
%constinteger DIOITEM= X'35'
%constinteger SUBS = X'38'
%constinteger ARGARR = X'39'
%constinteger INIT = X'3A'
%constinteger INCR = X'3B'
%constinteger DECR = X'3C'
%constinteger DINIT = X'3D'
%constinteger PINCR = X'3E'
%constinteger NOOP = X'40'
%constinteger FUN = X'41'
%constinteger SUBR = X'42'
%constinteger ARG = X'43'
%constinteger STRTSF = X'44'
%constinteger ENDSF = X'45'
%constinteger CALLSF = X'46'
%constinteger IFUN = X'47'
%constinteger DARG = X'48'
%constinteger IARG = X'49'
%constinteger REPL = X'4A'
%constinteger REF = X'4B'
%constinteger LOADB = X'4C'
%constinteger STOREB = X'4D'
%constinteger MOO = X'4E'
%constinteger JIT = X'50'
%constinteger JIF = X'51'
%constinteger JINN = X'52'
%constinteger JINP = X'53'
%constinteger JINZ = X'54'
%constinteger JIN = X'55'
%constinteger JIP = X'56'
%constinteger JIZ = X'57'
%constinteger CGT = X'58'
%constinteger GOTO = X'59'
%constinteger RET = X'5A'
%constinteger STOP = X'5B'
%constinteger PAUSE = X'5C'
%constinteger EOT = X'5D'
%constinteger NINT = X'5E'
%constinteger ANINT = X'5F'
%constinteger STMT = X'60'
%constinteger ITS = X'61'
%constinteger PA = X'62'
%constinteger TOCHAR = X'63'
%constinteger DIM = X'64'
%constinteger DMULT = X'65'
%constinteger AINT = X'66'
%constinteger ABS = X'67'
%constinteger MOD = X'68'
%constinteger SIGN = X'69'
%constinteger MIN = X'6A'
%constinteger MAX = X'6B'
%constinteger REALL = X'6C'
%constinteger IMAG = X'6D'
%constinteger CMPLX = X'6E'
%constinteger CONJG = X'6F'
%constinteger LEN = X'70'
%constinteger ICHAR = X'71'
%constinteger CHIND = X'72'
%constinteger DCMPLX = X'73'
%constinteger INTRIN = X'74'
!*
!*
{%INCLUDE "ftn_copy1"}
!* modified 23/09/86
!*
%routine Copy(%integer Length,Fbase,Fdisp,Tbase,Tdisp)
!***********************************************************************
!* copy Length bytes from fbase(fdisp) to tbase(tdisp) *
!***********************************************************************
%integer I,From,To
%if Length<=0 %then %return
From=Fbase+Fdisp
To=Tbase+Tdisp
%cycle I=0,1,Length-1
byteinteger(To+I)=byteinteger(From+I)
%repeat
%end;! Copy
!*
!*
!*
%OWNINTEGER TRACE=0,BMTRACE=0
!
%EXTERNALROUTINESPEC PRINTTR(%INTEGER INDEX,ADICT,ANAMES,LEVEL,
%RECORD(TRIADF)%NAME TRIAD)
%ROUTINESPEC BACKMOVE
!
!
%ROUTINE LDUMPTRACE
TRACE=LDUMP&OPTFLAGS
%END
!
%ROUTINE SETBMTRACE
BMTRACE=CDUMP&OPTFLAGS
%END
!
%EXTERNALROUTINE OP2
!
!
%EXTERNALROUTINESPEC GLOBSUBS
%EXTERNALROUTINESPEC SUBSUM
%EXTERNALROUTINESPEC SUBSEOB
%EXTERNALROUTINESPEC EXPELIM
%EXTERNALROUTINESPEC CONELIM
%EXTERNALROUTINESPEC OPTDIV
%EXTERNALROUTINESPEC OPTNEG
%EXTERNALROUTINESPEC OPTCVT
%EXTERNALROUTINESPEC OPTFUN
%EXTERNALROUTINESPEC OPTEXP
%EXTERNALROUTINESPEC FACTORISE
%EXTERNALROUTINESPEC LINEARISE
%EXTERNALROUTINESPEC EXPELBTARG
%EXTERNALROUTINESPEC FLOWOFCONT
{!++!}%EXTERNALROUTINESPEC STRENGTHRED
!
%ROUTINESPEC OP2A
%ROUTINESPEC LOOPSEL (%INTEGER L)
%ROUTINESPEC LOOPBUILD
!
%RECORDFORMAT ARTICF (%INTEGER BLOCK)
%INTEGERARRAYFORMAT TABF (0:1000)
%INTEGERARRAYFORMAT BF (0:15)
%INTEGERARRAYFORMAT BS (0:1000)
%INTEGERARRAYNAME B1,B2,BLKBS,ENTBTAB
%RECORD (BLRECF) %NAME BB
%RECORD (LOOPRECF) %NAME LL
%RECORD (CLOOPRECF) %NAME CL
%RECORD (TRIADF) %NAME TT
%RECORD (ARTICF) %NAME AR
%RECORD (CONRECF) %NAME CN
!
%INTEGER PLOOPCH,DLOOPCH
%INTEGER I,J,NEWENT,BLOCK
%INTEGER BLKBSLENGTH,SAVEPTR,BLKBITS,BIT
!
!
!********************************************************************
!* FOR EACH PROGRAM LOOP IN TURN, BUILD UP ALL NECESSARY DATA & *
!* TABLES, AND THEN CALL ALL THE VARIOUS OPTIMISATION PROCESSES. *
!********************************************************************
!
!
BLKBSLENGTH = (NEXTBLOCK + 31) >> 5; ! LENGTH IN 32BIT WORDS
FREEBLOCKS = (NEXTBLOCK + 1) * BLSIZE
SRHEAD = 0
SRCH = ADDR (SRHEAD)
FREETABS = (FREETABS + 3) & X'FFFFFFFC'
BLKBITS = CREATETAB (BLKBSLENGTH << WSCALE) + ATABS
BLKBS == ARRAY (BLKBITS,BS)
LDUMPTRACE
%IF INHIBMASK & INHIBSUBSUM = 0 %THEN GLOBSUBS
!
LOOPSEL (0) %UNLESS FREELOOPS = 0
!
LOOP = X'FFFF'
LOOPDEPTH = 0
BACKTARG = 0
BTARGTRIAD = 0
OLDBTARGTRIAD = 0
%FOR I = 0,1,BSWORDS-1 %CYCLE
DLOOPUSE(I) = 0
DLOOPDEF(I) = 0
%REPEAT
SAVEPTR = FREETABS
PLOOPCH = ADDR (PLOOPHEAD)
DLOOPCH = ADDR (DLOOPHEAD)
PLOOPHEAD = 0
DLOOPHEAD = 0
PLOOPTAIL = 0
DLOOPTAIL = 0
BLKBS(I) = 0 %FOR I = 0,1,BLKBSLENGTH-1
ENTBTAB == ARRAY (ATABS + ENTBPTR,TABF)
%FOR J = 1,1,ENTBTAB(0) %CYCLE
NEWENT = CREATETAB (CLOOPSZ)
BLOCK = ENTBTAB(J)
CL == RECORD (ATABS + NEWENT)
CL_BLOCK = BLOCK
BB == RECORD (ABLOCKS+ BLOCK*BLSIZE)
B1 == ARRAY (ABLOCKS+BB_USE,BF)
B2 == ARRAY (ABLOCKS+BB_DEF,BF)
%FOR I = 0,1,BSWORDS-1 %CYCLE
DLOOPUSE(I) = DLOOPUSE(I) ! B1(I)
DLOOPDEF(I) = DLOOPDEF(I) ! B2(I)
%REPEAT
SETBIT (BLKBITS,BLOCK)
INTEGER (DLOOPCH) = NEWENT
DLOOPCH = ADDR (CL_PDCHAIN)
CL_PDCHAIN = 0
CL_PDBACKCHAIN = DLOOPTAIL
DLOOPTAIL = NEWENT
%REPEAT
CLOOPHEAD = DLOOPHEAD
!
%IF CLOOPHEAD#0 %THEN LOOPBUILD
!
! CODE NEEDED HERE TO OPTIMISE COPYING OF ARGUMENTS IN PROLOGUES
! & EPILOGUES
!
!
!
!
%ROUTINE LOOPSEL (%INTEGER L)
!
!***********************************************************************
!* OBTAIN NEXT LOOP TO BE OPTIMISED FROM LOOPTAB *
!* AND CALL LOOPBUILD TO BUILD THE NECESSARY TABLES. *
!* RECURSIVE ROUTINE, SO AS TO PRESENT DEEPEST LOOPS FIRST. *
!***********************************************************************
!
%INTEGER DOWN,LOOPPTR
!
LOOPPTR = L
%CYCLE
LL == RECORD (ALOOPS + LOOPPTR)
DOWN = LL_DOWN
%UNLESS DOWN = 0 %THENSTART
LOOPSEL (DOWN)
LL == RECORD (ALOOPS + LOOPPTR)
%FINISH
SAVEPTR = FREETABS
LOOP = LOOPPTR
NEWENT = CREATETAB (CLOOPSZ)
CL == RECORD (ATABS + NEWENT)
LOOPENT = LL_BLOCK
CL_BLOCK = LOOPENT
CL_PDCHAIN = 0
CL_PDBACKCHAIN = 0
CLOOPHEAD = NEWENT
DLOOPHEAD = NEWENT
PLOOPHEAD = 0
DLOOPTAIL = NEWENT
PLOOPTAIL = 0
DLOOPCH = ADDR (CL_PDCHAIN)
PLOOPCH = ADDR (PLOOPHEAD)
BLKBS(I) = 0 %FOR I = 0,1,BLKBSLENGTH-1
SETBIT (BLKBITS,LOOPENT)
BB == RECORD (ABLOCKS + LOOPENT*BLSIZE)
LOOPDEPTH = BB_DEPTH
BACKTARG = BB_BTARG
B1 == ARRAY (ABLOCKS+BB_USE,BF)
B2 == ARRAY (ABLOCKS+BB_DEF,BF)
%FOR I = 0,1,BSWORDS-1 %CYCLE
DLOOPUSE(I) = B1(I)
DLOOPDEF(I) = B2(I)
%REPEAT
BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
OLDBTARGTRIAD = BB_TEXT
!
LOOPBUILD
!
LOOPPTR = LL_ACROSS
%REPEAT %UNTIL LOOPPTR = 0
%END;! LOOPSEL
!
!
!
!
%ROUTINE LOOPBUILD
!
!*******************************************************************
!* BUILD CLOOPTAB & ASSOCIATED BIT STRIPS. *
!* IDENTIFY ARTICULATION BLOCKS. *
!* CALL OP2A & OP2B. *
!*******************************************************************
!
%INTEGER EXITCT,EXITBLK,I,J
%INTEGER FCON,CLOOPPTR,LEB
%INTEGER STACKPTR,TABSTART,TABLEEND,TAB2PTR,TABLE2
%INTEGER ARTI,ARTJ,ARTK
!
%FOR I = 0,1,BSWORDS-1 %CYCLE
PLOOPUSE(I) = 0
PLOOPDEF(I) = 0
%REPEAT
EXITCT = 0
EXITBLK = 0
CLOOPPTR = CLOOPHEAD
!* ADD INTO CLOOP ALL FCONS OF ALL CLOOP ENTRIES, PROVIDED INSIDE THE LOOP,
!* AND NOT ALREADY IN CLOOP.
%WHILE CLOOPPTR < FREETABS %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
BB == RECORD (ABLOCKS + CL_BLOCK*BLSIZE)
FCON = BB_FCON&X'7FFFFFFF'
%UNLESS FCON = 0 %THENSTART
CN == RECORD (ATABS + FCON)
%FOR J = 1,1,CN_COUNT %CYCLE
CL == RECORD(ATABS + CLOOPPTR)
BLOCK = CN_BLOCK(J)
%UNLESS BLOCK = 0 %THENSTART
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
%IF BB_DEPTH < LOOPDEPTH %THENSTART
EXITCT = EXITCT + 1
EXITBLK = CL_BLOCK
%FINISHELSESTART
!* USE BITSTRIP TO TEST WHETHER THIS BLOCK ALREADY IN CLOOP.
GETBIT (BLKBITS,BLOCK,BIT)
%IF BIT = 0 %THENSTART
SETBIT (BLKBITS,BLOCK)
NEWENT = CREATETAB (CLOOPSZ)
CL == RECORD (ATABS + NEWENT)
CL_BLOCK = BLOCK
CL_PDCHAIN = 0
B1 == ARRAY (ABLOCKS+BB_USE,BF)
B2 == ARRAY (ABLOCKS+BB_DEF,BF)
%IF BB_DEPTH = LOOPDEPTH %THENSTART
INTEGER (DLOOPCH) = NEWENT
DLOOPCH = ADDR (CL_PDCHAIN)
CL_PDBACKCHAIN = DLOOPTAIL
DLOOPTAIL = NEWENT
%FOR I = 0,1,BSWORDS-1 %CYCLE
DLOOPUSE(I) = DLOOPUSE(I) ! B1(I)
DLOOPDEF(I) = DLOOPDEF(I) ! B2(I)
%REPEAT
%FINISHELSESTART
INTEGER (PLOOPCH) = NEWENT
PLOOPCH = ADDR (CL_PDCHAIN)
CL_PDBACKCHAIN = PLOOPTAIL
PLOOPTAIL = NEWENT
%FOR I = 0,1,BSWORDS-1 %CYCLE
PLOOPUSE(I) = PLOOPUSE(I) ! B1(I)
PLOOPDEF(I) = PLOOPDEF(I) ! B2(I)
%REPEAT
%FINISH
%FINISH
%FINISH
%FINISH
%REPEAT
%FINISH
CLOOPPTR = CLOOPPTR + CLOOPSZ
%REPEAT
CLOOPTAIL = FREETABS - CLOOPSZ
%FOR I = 0,1,BSWORDS-1 %CYCLE
CLOOPUSE(I) = DLOOPUSE(I) ! PLOOPUSE(I)
CLOOPDEF(I) = DLOOPDEF(I) ! PLOOPDEF(I)
%REPEAT
!*************************************************************
!* IDENTIFY & FLAG ARTICULATION BLOCKS. *
!*************************************************************
!* STACK ALL BACK CONNECTIONS (INSIDE LOOP) OF LOOP ENTRY BLOCK.
%UNLESS BACKTARG = 0 %THENSTART
TABSTART = FREETABS
LL == RECORD (ALOOPS + LOOP)
LEB = LL_BLOCK
BB == RECORD (ABLOCKS + LEB*BLSIZE)
CN == RECORD (ATABS + BB_BCON)
NEWENT = CREATETAB (ARTICSZ)
AR == RECORD (ATABS + NEWENT)
AR_BLOCK = 0
%FOR I = 1,1,CN_COUNT %CYCLE
BLOCK = CN_BLOCK(I)
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
%UNLESS BB_DEPTH < LOOPDEPTH %THENSTART
NEWENT = CREATETAB (ARTICSZ)
AR == RECORD (ATABS + NEWENT)
AR_BLOCK = BLOCK
%FINISH
%REPEAT
STACKPTR = NEWENT - ARTICSZ
BLOCK = AR_BLOCK
TABLE2 = FREETABS
%IF STACKPTR = TABSTART %THEN ARTI = BLOCK %ELSESTART
!* IF MORE THAN ONE BACK CONNECTION, FIND THE COMMON NODE.
!* BUILD BACK DOMINATOR CHAIN OF ONE OF BACK CONNECTIONS.
NEWENT = CREATETAB (ARTICSZ)
AR == RECORD (ATABS + NEWENT)
AR_BLOCK = BLOCK
%WHILE BLOCK # LEB %CYCLE
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
BLOCK = BB_BDOM
NEWENT = CREATETAB (ARTICSZ)
AR_BLOCK = BLOCK
%REPEAT
TABLEEND = FREETABS
ARTK = TABLE2
%WHILE STACKPTR # TABSTART %CYCLE
AR == RECORD (ATABS + STACKPTR)
STACKPTR = STACKPTR - ARTICSZ
ARTI = AR_BLOCK
%CYCLE
TAB2PTR = ARTK
%WHILE TAB2PTR # TABLEEND %CYCLE
AR == RECORD (ATABS + TAB2PTR)
-> L1 %IF AR_BLOCK = ARTI
TAB2PTR = TAB2PTR + ARTICSZ
%REPEAT
BB == RECORD (ABLOCKS + ARTI*BLSIZE)
ARTI = BB_BDOM
%REPEAT
L1: ARTK = TAB2PTR
%REPEAT
%FINISH
!* ARTI IS NOW COMMON DOMINATOR.
!* NOW BUILD STACK OF DOMINATOR BLOCKS WHICH ARE ARTICULATION CANDIDATES.
FREETABS = TABSTART + ARTICSZ
%WHILE ARTI # LEB %CYCLE
BB == RECORD (ABLOCKS + ARTI*BLSIZE)
%UNLESS BB_DEPTH > LOOPDEPTH %THENSTART
NEWENT = CREATETAB (ARTICSZ)
AR == RECORD (ATABS +NEWENT)
AR_BLOCK = ARTI
ARTI = BB_BDOM
%FINISHELSE ARTI = BB_BTARG
%REPEAT
STACKPTR = FREETABS - ARTICSZ
TABLE2 = FREETABS
AR == RECORD (ATABS + TABSTART + ARTICSZ)
!* TEST FOR NORMAL LOOP, I.E. ONLY ONE EXIT.
%IF EXITCT = 1 %AND EXITBLK = AR_BLOCK %THENSTART
BB == RECORD (ABLOCKS + LEB*BLSIZE)
BB_FLAGS = BB_FLAGS ! ARTICBIT
STACKPTR = TABSTART + ARTICSZ
%WHILE STACKPTR # FREETABS %CYCLE
AR == RECORD (ATABS + STACKPTR)
BB == RECORD (ABLOCKS + AR_BLOCK*BLSIZE)
BB_FLAGS = BB_FLAGS ! ARTICBIT
STACKPTR = STACKPTR + ARTICSZ
%REPEAT
%FINISHELSESTART
%CYCLE
BB == RECORD (ABLOCKS + ARTI*BLSIZE)
BB_FLAGS = BB_FLAGS ! ARTICBIT
FREETABS = TABLE2
%EXIT %IF STACKPTR = TABSTART
AR == RECORD (ATABS + STACKPTR)
STACKPTR = STACKPTR - ARTICSZ
ARTJ = AR_BLOCK
NEWENT = CREATETAB (ARTICSZ*2)
AR == RECORD (ATABS + NEWENT)
AR_BLOCK = ARTJ
ARTK = NEWENT + ARTICSZ
AR == RECORD (ATABS + ARTK)
AR_BLOCK = ARTI
%CYCLE
BLOCK = AR_BLOCK
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
-> L4 %IF BB_DEPTH < LOOPDEPTH
CN == RECORD (ATABS + BB_FCON)
!* ADD ALL FCONS TO TABLE, UNLESS ALREADY THERE.
%FOR I = 1,1,CN_COUNT %CYCLE
FCON = CN_BLOCK(I)
TAB2PTR = TABLE2
%CYCLE
AR == RECORD (ATABS + TAB2PTR)
-> L3 %IF AR_BLOCK = FCON
TAB2PTR = TAB2PTR + ARTICSZ
%REPEAT %UNTIL TAB2PTR = FREETABS
NEWENT = CREATETAB (ARTICSZ)
AR == RECORD (ATABS + NEWENT)
AR_BLOCK = FCON
L3: %REPEAT
ARTK = ARTK + ARTICSZ
AR==RECORD(ATABS+ARTK)
%REPEAT %UNTIL ARTK = FREETABS
ARTI = ARTJ
%REPEAT
%FINISH
L4: FREETABS = TABSTART
%FINISH
!
!* DIAGNOSTICS FOR EACH LOOP IDENTIFIED.
%IF TRACE # 0 %THENSTART
NEWLINE
PRINTSTRING ("LOOPDATA BEFORE OP2A")
NEWLINE
NEWLINE
PRINTSTRING ("CLOOP (* = ARTIC): ")
%FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
BLOCK = CL_BLOCK
WRITE (BLOCK,4)
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
PRINTSTRING ("*") %IF BB_FLAGS & ARTICBIT # 0
%REPEAT
NEWLINE
PRINTSTRING ("DLOOP: ")
CLOOPPTR = DLOOPHEAD
%WHILE CLOOPPTR # 0 %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
WRITE (CL_BLOCK,4)
CLOOPPTR = CL_PDCHAIN
%REPEAT
NEWLINE
PRINTSTRING ("PLOOP: ")
CLOOPPTR = PLOOPHEAD
%WHILE CLOOPPTR # 0 %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
WRITE (CL_BLOCK,4)
CLOOPPTR = CL_PDCHAIN
%REPEAT
NEWLINE
PRINTSTRING ("LOOP= ")
WRITE (LOOP,3)
PRINTSTRING (" BACKTARG= ")
WRITE (BACKTARG,3)
PRINTSTRING (" LOOPDEPTH= ")
WRITE (LOOPDEPTH,2)
PRINTSTRING (" LOOPENT= ")
WRITE (LOOPENT,3)
NEWLINE
PRINTSTRING ("CLOOPUSE: ")
PRINTBS (CLOOPUSE)
PRINTSTRING ("CLOOPDEF: ")
PRINTBS (CLOOPDEF)
%FINISH
!
%IF INHIBMASK & INHIBOP2A = 0 %THEN OP2A
!
!* MORE LOOP-LEVEL DIAGNOSTICS.
%IF TRACE # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING ("BACK TARGET & CLOOP BLOCKS AFTER OP2A")
NEWLINE
NEWLINE
%UNLESS BACKTARG = 0 %THENSTART
PRBLOCK (BACKTARG)
PRBLTRIADS (BACKTARG)
%FINISH
%FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
PRBLOCK (CL_BLOCK)
PRBLTRIADS (CL_BLOCK)
%REPEAT
%FINISH
!
%UNLESS BACKTARG = 0 %THENSTART
!
{!++!} STRENGTHRED
!
!* AND YET MORE LOOP-LEVEL DIAGNOSTICS.
%IF SRFLAGS & 4 # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING (" BACK TARGET & CLOOP BLOCKS AFTER OP2B")
NEWLINE
NEWLINE
PRBLOCK (BACKTARG)
PRBLTRIADS (BACKTARG)
%FOR CLOOPPTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
CL == RECORD (ATABS + CLOOPPTR)
PRBLOCK (CL_BLOCK)
PRBLTRIADS (CL_BLOCK)
%REPEAT
%FINISH
%FINISH
!
FREETABS = SAVEPTR;! DELETE ALL OP2 TABLES.
!
%END;! LOOPBUILD
!
!
!
!
%ROUTINE OP2A
!
!****************************************************************
!* HAVING BUILT UP ALL THE DATA FOR A LOOP, INVOKE THE VARIOUS *
!* OPTIMISATION PROCESSES IN OP2A. *
!****************************************************************
!
%EXTERNALROUTINESPEC EDUMPTRACE
%EXTERNALROUTINESPEC CDUMPTRACE
!
%INTEGER OP,I,NEXT,STOB
!
%RECORD (PRECF) %NAME DD
!
DLOOPPTR = DLOOPHEAD
%CYCLE
CL == RECORD (ATABS + DLOOPPTR)
CURRBLK = CL_BLOCK
%UNLESS OLDBTARGTRIAD = 0 %THENSTART
NEXT = OLDBTARGTRIAD
TT == RECORD (ATRIADS + NEXT*TRIADLENGTH)
%CYCLE
BTARGTRIAD = NEXT
NEXT = TT_CHAIN
TT == RECORD (ATRIADS + NEXT*TRIADLENGTH)
%REPEAT %UNTIL TT_OP = GOTO %OR %C
(TT_OP = STMT %AND TT_USE & SOB # 0)
OLDBTARGTRIAD = BTARGTRIAD
%FINISH
BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
STOB = BB_TEXT
!
!* FIRST DO SUBSUMPTION FOR WHOLE BLOCK.
CURRTRIAD = STOB
%WHILE NEXTTRIAD = 1 %CYCLE
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
TT_OP = TT_OP & BMBITOFF ;! CLEAR BACKMOVED FLAG
%IF INHIBMASK & INHIBSUBSUM = 0 %THEN SUBSUM
%REPEAT
%IF INHIBMASK & INHIBSUBSUM = 0 %THEN SUBSEOB
CURRDEF(I) = 0 %FOR I = 0,1,BSWORDS-1
!
!* NOW ALL THE EXPRESSION OPTIMISATIONS FOR WHOLE BLOCK.
SETBMTRACE
CDUMPTRACE
CURRTRIAD = STOB
%WHILE NEXTTRIAD = 1 %CYCLE
%IF INHIBMASK & INHIBEXPOPTS = 0 %THENSTART
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
OP = TT_OP
%IF OP = DIV %THENSTART
OPTDIV
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
OP = TT_OP
%FINISH
%IF OP = ADD %OR OP = SUB %OR OP = MULT %THENSTART
CONELIM
FACTORISE
LINEARISE
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
OP = TT_OP
%FINISH
%IF OP = NEG %THENSTART
OPTNEG
%FINISHELSEIF OP = CVT %THENSTART
OPTCVT
%FINISHELSEIF JIT <= OP <= JIZ %THENSTART
FLOWOFCONT
%FINISHELSEIF OP = EXP %THENSTART
OPTEXP
%FINISHELSEIF OP = IFUN %THENSTART
OPTFUN ;! LIBRARY FUNCTIONS ONLY.
%FINISH
%FINISH
%IF INHIBMASK & INHIBBMOVE = 0 %THENSTART
BACKMOVE %UNLESS BACKTARG = 0
%FINISH
UPDATECURRDEF
%REPEAT
!
!* FINALLY DO EXPRESSION ELIMINATION FOR THE WHOLE BLOCK (BUT FIRST
!* FOR THE BACK TARG BLOCK IF THIS EXISTS & HAS BEEN ADDED TO).
EDUMPTRACE
EXPELBTARG %UNLESS OLDBTARGTRIAD = 0 %OR %C
OLDBTARGTRIAD = BTARGTRIAD
CURRTRIAD = STOB
CURRDEF(I) = 0 %FOR I = 0,1,BSWORDS-1
EXPELIM
DLOOPPTR = CL_PDCHAIN
%REPEAT %UNTIL DLOOPPTR = 0
!
%END;! OP2A
!
%END;! OP2
!
!
!
!
!*
!***********************************************************************
!* *
!***********************************************************************
!* *
!* B A C K M O V E *
!* *
!***********************************************************************
!* *
!***********************************************************************
!
!
%EXTERNALROUTINE BACKMOVE
!
%ROUTINESPEC MOVEOP (%RECORD (RESF) %NAME OPD)
%ROUTINESPEC BTBITS (%INTEGER ID)
%INTEGERFUNCTIONSPEC BMOVCHECK
%INTEGERFUNCTIONSPEC BREAKOUT (%INTEGER TR)
%INTEGERFUNCTIONSPEC BREAKIN (%INTEGER TR)
%INTEGERFUNCTIONSPEC LCON (%RECORD (RESF) OPD)
%INTEGERFUNCTIONSPEC BREAKCHECK (%INTEGER TR)
%INTEGERFUNCTIONSPEC BRNEW
%INTEGERFUNCTIONSPEC OPSCOM
%ROUTINESPEC SWAP
!
!
!
%CONSTBYTEINTEGERARRAY OPSTAB (0:116) = %C
X'00', X'00', X'47', X'47',
{ NULL (01) ADD SUB
X'47', X'07', X'05', X'33',
{ MULT DIV NEG ASMT
X'03', X'13', X'00', X'00',
{ CVT ARR ARR1 BOP
X'00', X'00', X'07', X'07',
{ ASGN (0D) EXP EXP3
X'07', X'07', X'05', X'07',
{ AND OR NOT EQUIV
X'07', X'07', X'07', X'07',
{ NEQ GT LT NE
X'07', X'07', X'07', X'00',
{ EQ GE LE SUBSTR
X'00', X'00', X'00', X'00',
{ CHAR CONCAT CHHEAD (1F)
X'00', X'00', X'00', X'00',
{ STOD1 STOD2 STODA (23)
X'00', X'00', X'00', X'00',
{ EOD1 EOD2 EODA EODB
X'07', X'11', X'07', X'07',
{ BRK DEFARR RSUB RDIV
X'00', X'07', X'00', X'00',
{ DCHAR ASH (2E)
X'00', X'00', X'00', X'00',
{ STRTIO IOITEM IODO IOSPEC
X'00', X'00', X'00', X'00',
{ IO DIOITEM (36)
X'00', X'03', X'02', X'00',
{ (38) ARGARR INIT INCR
X'00', X'00', X'00', X'00',
{ DECR DINIT PINCR (3F)
X'00', X'21', X'00', X'01',
{ NOOP FUN SUBR ARG
X'00', X'00', X'00', X'21',
{ STRTSF ENDSF CALLSF IFUN
X'00', X'01', X'00', X'01',
{ DARG IARG REPL REF
X'00', X'00', X'01', X'00',
{ LOADB STOREB MOO (4F)
X'04', X'04', X'04', X'04',
{ JIT JIF JINN JINP
X'04', X'04', X'04', X'04',
{ JINZ JIN JIP JIZ
X'04', X'04', X'00', X'00',
{ CGT GOTO RET STOP
X'00', X'00', X'07', X'07',
{ PAUSE EOT NINT ANINT
X'00', X'00', X'00', X'00',
{ STMT ITS PA TOCHAR
X'07', X'07', X'07', X'07',
{ DIM DMULT AINT ABS
X'07', X'07', X'07', X'07',
{ MOD SIGN MIN MAX
X'07', X'07', X'06', X'07',
{ REALL IMAG CMPLX CONJG
X'07', X'07', X'07', X'07',
{ LEN ICHAR CHIND DCMPLX
X'21'
{ INTRIN
!
!
%RECORD (BLRECF) %NAME BB
%RECORD (TRIADF) %NAME TT,TT1,TT2
%RECORD (PRECF) %NAME DD
%RECORD (CLOOPRECF) %NAME CL
%RECORD (CONRECF) %NAME CN
%RECORD (RESF) OPD
!
!
%INTEGER LINK,ACTNO,LINKPREV,LINKCHAIN,CONSTRIDS
%INTEGER NEWENT,CONFLAG,OP,ACTION
%INTEGER OPS,CLASS,COORD,TEXT,ID,WOPD,OLDOP2,LCON1,LCON2
%INTEGER DEF,BLOCK,BITS1,BITS2,VAL1,VAL2,CNBLOCK
%INTEGER DLOOPPTR,I,SAVEPTR,TABPTR,TABPTR2,TRID
%CONSTINTEGER IDBIT = 16
!
!
!******************************************************************
!* MOVE LOOP-CONSTANT TRIADS INTO BACK TARGET BLOCK. *
!******************************************************************
!
ACTION = BMOVCHECK
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
%IF ACTION = 1 %THENSTART
!
!* TRIAD CANNOT BE BACKWARD MOVED. TRY TO MOVE A SINGLE OPERAND
!* WHICH IS A LOOP CONSTANT COMMON VARIABLE.
!
!@@! %IF OPS & 4 # 0 %AND TT_QOPD1 = CSCALID %AND %C
!@@! TT_MODE # CHARMODE %THENSTART
!@@! %IF LOOPCON1 (CURRTRIAD) = 1 %THEN MOVEOP (TT_RES1)
!@@! %FINISH
!@@! %IF OPS & 2 # 0 %AND TT_QOPD2 = CSCALID %AND %C
!@@! TT_MODE # CHARMODE %THENSTART
!@@! %IF LOOPCON2 (CURRTRIAD) = 1 %THEN MOVEOP (TT_RES2)
!@@! %FINISH
%FINISHELSEUNLESS ACTION = 0 %THENSTART
!
!* PERFORM BACKWARD MOVEMENT. UPDATE BITSTRIPS & RECHAIN TRIAD.
!
%IF ACTION = 2 %AND TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
%IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
TT_OP = TT_OP ! BMBIT
TT2 == RECORD (ATRIADS + PREVTRIAD*TRIADLENGTH)
TT2_CHAIN =TT_CHAIN
TT2 == RECORD (ATRIADS + BTARGTRIAD*TRIADLENGTH)
TT_CHAIN = TT2_CHAIN
TT2_CHAIN = CURRTRIAD
I=btargtriad
BTARGTRIAD = CURRTRIAD
%IF BMTRACE#0 %START
PRINTSTRING("TRIAD HAS BEEN BACKWARD MOVED - ")
NEWLINE
printtr(i,adict,anames,0,tt2)
PRINTTR(BTARGTRIAD,ADICT,ANAMES,0,TT)
%FINISH
CURRTRIAD = PREVTRIAD
%FINISH
!
!
!
!
%INTEGERFUNCTION BMOVCHECK
!
!***********************************************************************
!* CHECK WHETHER BACKWARD MOVEMENT IS POSSIBLE, AND RETURN ONE *
!* OF FOUR VALUES: *
!* 0. NO BACKWARD MOVEMENT POSSIBLE. *
!* 1. TRIAD CANNOT BE MOVED. TRY ONE OF OPERANDS. *
!* 2. MOVE THE TRIAD. *
!* 3. MOVE TRIAD (ASGN OR ASMT) *
!***********************************************************************
!
BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
%IF OPT = 1 %AND BB_FLAGS & ARTICBIT = 0 %THEN %RESULT = 0
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
!*************************************************************************
!* PICK UP CLASS OF TRIAD FROM TABLE: *
!* B5 = OPD 1 CANDIDATE FOR COMMON VARIABLE REMOVAL *
!* B6 = OPD 2 CANDIDATE FOR COMMON VARIABLE REMOVAL *
!* B7 = CANDIDATE FOR BACKWARD MOVEMENT, WITH B0-3 CONTAINING *
!* SUBCLASSIFICATION *
!*************************************************************************
OPS = OPSTAB(TT_OP)
%UNLESS OPS & X'F1' # 0 %THEN %RESULT = 1
!*
!* TRIAD IS A CANDIDATE FOR BACKWARD MOVEMENT. DO FURTHER CHECKS ACCORDING
!* TO SUBCLASS.
!
CLASS = OPS >> 4
%IF BMTRACE#0 %THENSTART
PRINTSTRING("CURRTRIAD IS A CANDIDATE FOR BACKWARD MOVEMENT - ")
NEWLINE
PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
%FINISH
%IF CLASS = 0 %THENSTART
!
!* UNCLASSIFIED TRIAD
! ------------------
%IF LOOPCON1 (CURRTRIAD) = 1 %AND LOOPCON2 (CURRTRIAD) = 1 %THENSTART
%IF TT_MODE=CHARMODE {%AND NEQ<=TT_OP<=LE} %THEN %RESULT = 1 %ELSE %RESULT = 2
%FINISH %ELSE %RESULT=1
%FINISH
%IF CLASS = 1 %THENSTART
!
!* ARR OR DEFARR TRIAD
! -------------------
%if TT_Mode=Charmode %then %result=0
%IF LOOPCON2 (CURRTRIAD) = 1 %THENSTART
%IF LOOPCON1 (CURRTRIAD) = 1 {%OR TT_OP = DEFARR} %C
%THEN %RESULT = 2 %ELSE %RESULT = 0
%FINISH
!* OPD 2 IS VARIABLE, & SO A CANDIDATE FOR BREAK UP
!* (IF A TEXT POINTER, AND NOT COMPLEX).
%IF TT_QOPD2 & TEXTMASK = 0 %OR %C
CMPLX8 <= TT_MODE <= CMPLX32 %OR %C
TT_MODE=CHARMODE %THEN %RESULT = 0
CONFLAG = 0
%UNLESS BREAKCHECK (TT_OPD2) = 1 %AND CONFLAG = 1 %THEN %RESULT = 0
TT2 == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
WOPD = BREAKOUT (TT2_OPD2)
NEWENT = BRNEW
TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
TT_RES2_W = WOPD
TT_OP = DEFARR ! BMBIT
TT_RES1 = TT2_RES1
%IF TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
%IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
TT2_QOPD1 = TRIAD
TT2_OPD1 = NEWENT
OLDOP2 = TT2_OPD2
%IF BMTRACE#0 %THENSTART
PRINTSTRING("BMOVCHECK:PLANT TRIAD IN BACK TARGET - ")
NEWLINE
PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
%FINISH
TT2_RES2_W = BREAKIN (OLDOP2)
%IF TT2_QOPD2 & TEXTMASK # 0 %THENSTART
TT == RECORD (ATRIADS + TT2_OPD2*TRIADLENGTH)
TT_USE = TT_USE + 1
%FINISH
DELUSE (OLDOP2)
%IF BMTRACE#0 %THENSTART
PRINTSTRING("CURRTRIAD BECOMES - ")
NEWLINE
PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT2)
%FINISH
%RESULT = 0
%FINISH
%IF CLASS = 2 %THENSTART
!
!* FUN OR IFUN TRIAD
! -----------------
DD == RECORD (ADICT + TT_OPD1 << DSCALE)
%IF DD_X0 & 3 = 0 %THEN %RESULT = 0 ;! USER FUN.
%IF LOOPCON2 (CURRTRIAD) = 1 %THEN %RESULT = 2 ;! LIB FUN, CONST ARG
%RESULT = 1
%FINISH
%IF CLASS = 3 %THENSTART
!
!* ASGN OR ASMT TRIAD
! ------------------
%UNLESS LOOPCON2 (CURRTRIAD) = 1 %THEN %RESULT = 0
%IF BB_FLAGS & ARTICBIT = 0 %THEN %RESULT = 1
%IF TT_QOPD1 & TEXTMASK # 0 %THENSTART ;! MUST BE DEFARR.
%UNLESS LOOPCON1 (CURRTRIAD) = 1 %THEN %RESULT = 1
TEXT = TT_OPD1
TT == RECORD (ATRIADS + TEXT*TRIADLENGTH)
%FINISH
ID = TT_OPD1
DD == RECORD (ADICT + ID<<DSCALE)
COORD = DD_COORD ;! COORD OF ASSIGNMENT TARGET.
!* NO GOOD IF DEFINED/USED IN INNER LOOP.
BITS1 = ADDR (PLOOPUSE(0))
BITS2 = ADDR (PLOOPDEF(0))
GETBIT (BITS1,COORD,VAL1)
GETBIT (BITS2,COORD,VAL2)
%IF VAL1 = 1 %OR VAL2 = 1 %THEN %RESULT = 1
!* NO GOOD IF B-O-E TO CURRENT BLOCK, OR IF DEFINED EARLIER IN THIS BLOCK.
BITS1 = ADDR (CURRDEF(0))
GETBIT (ABLOCKS+BB_BOE,COORD,VAL1)
GETBIT (BITS1,COORD,VAL2)
%IF VAL1 = 1 %OR VAL2 = 1 %THEN %RESULT = 1
!* NO GOOD IF DEFINED LATER IN THIS BLOCK.
TT == RECORD (ATRIADS + CURRTRIAD*TRIADLENGTH)
TRID = TT_CHAIN
TT == RECORD (ATRIADS + TRID*TRIADLENGTH)
%WHILE TT_USE & SOB = 0 %CYCLE
DEF = ALLDEF (TRID)
%UNLESS DEF = 0 %THENSTART
%IF DEF < 0 %THENSTART
%IF COORD = 1 %THEN %RESULT = 1 %C
%ELSE DEF = - DEF
%FINISH
%IF DEF = COORD %THEN %RESULT = 1
%IF DEF = 1 %AND DD_CLASS & CMNBIT # 0 %THEN %RESULT = 1
%FINISH
TRID = TT_CHAIN
TT == RECORD (ATRIADS + TRID*TRIADLENGTH)
%REPEAT
!* NO GOOD IF DEFINED IN ANOTHER BLOCK IN THIS LOOP.
DLOOPPTR = DLOOPHEAD
%WHILE DLOOPPTR # 0 %CYCLE
CL == RECORD (ATABS + DLOOPPTR)
BLOCK = CL_BLOCK
%UNLESS BLOCK = CURRBLK %THENSTART
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
GETBIT (ABLOCKS+BB_DEF,COORD,VAL1)
%IF VAL1 = 1 %THEN %RESULT = 1
%FINISH
DLOOPPTR = CL_PDCHAIN
%REPEAT
!* NO GOOD IF USED EARLIER IN THE LOOP.
!* BUILD TABLE OF ALL BACK CONNECTIONS BACK TO L.E.B.
! FREETABS = (FREETABS + 3) & X'FFFFFFFC'
SAVEPTR = FREETABS
TABPTR = FREETABS
BLOCK = CURRBLK
%CYCLE
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
%UNLESS BLOCK = LOOPENT %THENSTART
CN == RECORD (ATABS + BB_BCON)
%FOR I = 1,1,CN_COUNT %CYCLE
CNBLOCK = CN_BLOCK(I)
%UNLESS CNBLOCK = 0 %THENSTART
L1: BB == RECORD (ABLOCKS + CNBLOCK*BLSIZE)
%IF BB_DEPTH > LOOPDEPTH %THENSTART
CNBLOCK = BB_BTARG
-> L1
%FINISH
%IF BB_DEPTH = LOOPDEPTH %THENSTART
%FOR TABPTR2 = SAVEPTR,W1,FREETABS-W1 %CYCLE
%IF INTEGER (TABPTR2+ATABS) = CNBLOCK %THEN -> L2
%REPEAT
TABPTR2 = CREATETAB (W1)
INTEGER (TABPTR2+ATABS) = CNBLOCK
%FINISH
L2: %FINISH
%REPEAT
%FINISH
%IF TABPTR = FREETABS %THENSTART
FREETABS = SAVEPTR
BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
SETBIT (ABLOCKS+BB_DEF,COORD)
BB == RECORD (ABLOCKS + CURRBLK*BLSIZE)
CLEARBIT (ABLOCKS+BB_DEF,COORD)
CLEARBIT(ADDR(CLOOPDEF(0)),COORD)
GETBIT (ABLOCKS+BB_USE,COORD,VAL1)
%IF VAL1 = 1 %THEN SETBIT (ABLOCKS+BB_BOE,COORD)
%RESULT = 3
%FINISH
BLOCK = INTEGER(TABPTR+ATABS)
BB == RECORD (ABLOCKS + BLOCK*BLSIZE)
GETBIT (ABLOCKS+BB_USE,COORD,VAL1)
%IF VAL1 = 1 %THENSTART
FREETABS = SAVEPTR
%RESULT = 1
%FINISH
TABPTR = TABPTR + W1
%REPEAT
%FINISH
%IF CLASS = 4 %THENSTART
!
!* ADD, SUB, MULT, MAX, MIN TRIADS
! -------------------------------
CONSTRIDS = (LOOPCON1 (CURRTRIAD) << 1) + LOOPCON2 (CURRTRIAD)
%UNLESS CONSTRIDS = 0 %THENSTART
%IF CONSTRIDS = 3 %THEN %RESULT = 2;! BOTH CONST. DO BACK MOVE.
%IF CONSTRIDS = 2 %THENSTART
%IF TT_QOPD2 & TEXTMASK = 0 %THEN %RESULT = 1;! NO LINK TRIAD. TRY TO MOVE OPD.
LINK = TT_OPD2
ACTNO = 2
%FINISHELSESTART
%IF TT_QOPD1 & TEXTMASK = 0 %THEN %RESULT = 1
LINK = TT_OPD1
ACTNO = 0
%FINISH
!
!* ONE CONST OPD & ONE TRIAD PTR. TRY FOR BACKWARD MOVEMENT BY ASSOCIATION.
!* (VAR + CONST1) + CONST2: TRY TO SWAP VAR & CONST2.
TT1 == RECORD (ATRIADS + LINK*TRIADLENGTH)
%IF TT1_USE # 1 %THEN %RESULT = 1
%IF OPSCOM = 0 %THEN %RESULT = 1;! INVALID COMBINATION OF OPERATORS.
%IF LOOPCON2 (LINK) = 0 %THENSTART
%IF LOOPCON1 (LINK) = 0 %THEN %RESULT = 1
ACTNO = ACTNO ! 1
%FINISH
SWAP ;! SWAPS OPERANDS ACCORDING TO VALUE OF ACTNO.
!* LINK NOW CONTAINS TWO CONSTANTS. CHAIN INTO BACK TARGET.
LINKPREV = BB_TEXT
%CYCLE
TT == RECORD (ATRIADS + LINKPREV*TRIADLENGTH)
%IF TT_CHAIN = LINK %THEN %EXIT
LINKPREV = TT_CHAIN
%REPEAT
TT1_OP = TT1_OP ! BMBIT
TT_CHAIN =TT1_CHAIN
TT == RECORD (ATRIADS +BTARGTRIAD*TRIADLENGTH)
TT1_CHAIN = TT_CHAIN
TT_CHAIN = LINK
BTARGTRIAD = LINK
%IF TT1_QOPD1 & IDBIT # 0 %THEN BTBITS (TT1_OPD1)
%IF TT1_QOPD2 & IDBIT # 0 %THEN BTBITS (TT1_OPD2)
%IF BMTRACE#0 %THENSTART
PRINTSTRING("BMOVCHECK:MOVE TRIAD TO BACK TARGET - ")
NEWLINE
PRINTTR(LINK,ADICT,ANAMES,0,TT1)
%FINISH
%RESULT = 0
%FINISH
!
!* BOTH OPERANDS VARIABLE. TRY FOR CONSTANT DESCENT.
!* (CONST + VAR1) + VAR2: TRY TO SWAP CONST & VAR2.
%IF TT_QOPD1 & TEXTMASK # 0 %THENSTART
%IF TT_QOPD2 & TEXTMASK # 0 %THEN %RESULT = 0
LINK = TT_OPD1
ACTNO = 0
OPD = TT_RES2
%FINISHELSESTART
%IF TT_QOPD2 & TEXTMASK = 0 %THEN %RESULT = 0
LINK = TT_OPD2
ACTNO = 2
OPD = TT_RES1
%FINISH
TT1 == RECORD (ATRIADS + LINK*TRIADLENGTH)
%IF TT1_USE # 1 %THEN %RESULT = 0
%IF OPSCOM = 0 %THEN %RESULT = 0
%IF LOOPCON1 (LINK) = 0 %THENSTART
%IF LOOPCON2 (LINK) = 0 %THEN %RESULT = 0
ACTNO = ACTNO + 1
%FINISH
%IF OPD_FORM & IDBIT # 0 %THENSTART
DD == RECORD (ADICT + OPD_H0 << DSCALE)
COORD = DD_COORD
!* CHECK THAT WE ARE NOT TRYING TO MOVE A USE OF A LOOP VARIABLE
!* BACKWARDS OVER ITS DEFINITION.
LINKCHAIN = TT1_CHAIN
%WHILE LINKCHAIN # CURRTRIAD %CYCLE
DEF = ALLDEF (LINKCHAIN)
%UNLESS DEF = 0 %THENSTART
%IF DEF < 0 %THENSTART
%IF COORD = 1 %THEN %RESULT = 0 %C
%ELSE DEF = - DEF
%FINISH
%IF DEF = COORD %THEN %RESULT = 0
%IF DEF = 1 %AND DD_CLASS & CMNBIT # 0 %THEN %RESULT = 0
%FINISH
TT2 == RECORD (ATRIADS + LINKCHAIN*TRIADLENGTH)
LINKCHAIN = TT2_CHAIN
%REPEAT
%FINISH
SWAP ;! SWAPS OPERANDS ACCORDING TO SETTING OF ACTNO.
%RESULT = 0
%FINISH
!
%END ;! BMOVCHECK
!
!
!
!
!@@!%ROUTINE MOVEOP (%RECORD (RESF) %NAME OPD)
!@@!!
!@@!!*******************************************************************
!@@!!* MOVE A LOOP CONSTANT COMMON OPERAND TO THE BACK TARGET. *
!@@!!*******************************************************************
!@@! NEWENT = BRNEW
!@@! TT1 == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
!@@! TT1_OP = REF ! BMBIT
!@@! TT1_RES1_W = OPD_W
!@@! TT1_RES2_W = 0
!@@! BTBITS (OPD_H0)
!@@! OPD_H0 = BTARGTRIAD
!@@! OPD_FORM = TRIAD
!@@! TREVERSE(CURRTRIAD)
!@@! %IF BMTRACE#0 %THENSTART
!@@! PRINTSTRING("MOVEOP:PLANT TRIAD IN BACK TARGET - ")
!@@! NEWLINE
!@@! PRINTTR(NEWENT,ADICT,ANAMES,0,TT1)
!@@! PRINTSTRING("CURRTRIAD BECOMES - ")
!@@! NEWLINE
!@@! PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
!@@! %FINISH
!@@!!
!@@!%END;! MOVEOP
!
!
!
!
%ROUTINE BTBITS (%INTEGER ID)
!
!*********************************************************************
!* SET RELEVANT BITS IN THE BACK TARGET BIT STRIPS. *
!*********************************************************************
!
DD == RECORD (ADICT + ID<<DSCALE)
BB == RECORD (ABLOCKS + BACKTARG*BLSIZE)
COORD = DD_COORD
SETBIT (ABLOCKS+BB_USE,COORD)
SETBIT(ABLOCKS+BB_USE,1) %IF (DD_CLASS&CMNBIT)\=0 %AND %C
CMNCOORDS(1)=1
GETBIT (ABLOCKS+BB_DEF,COORD,VAL1)
%IF VAL1 = 0 %THEN %START
SETBIT(ABLOCKS+BB_BOE,1) %IF (DD_CLASS&CMNBIT)\=0 %AND CMNCOORDS(1)=1
SETBIT (ABLOCKS+BB_BOE,COORD)
%FINISH
!
%END;! BTBITS
!
!
!
!
%INTEGERFUNCTION BREAKCHECK (%INTEGER TR)
!
!***************************************************************************
!* PERFORM TREE-WALK OF THE SUBSCRIPT EXPRESSION TO IDENTIFY A *
!* BREAK-UP CANDIDATE. (RECURSIVE FUNCTION) *
!* RETURN CONFLAG = 1 IF A LOOP CONSTANT OPERAND HAS BEEN FOUND *
!* RESULT = 1 IF ONLY OPERATORS ARE +, -, *. *
!***************************************************************************
!
%result=0
TT == RECORD (ATRIADS + TR*TRIADLENGTH)
%IF TT_OP & BMBIT = 0 %THENSTART
OP = TT_OP
%IF OP = ADD %OR OP = SUB %THENSTART
%IF LOOPCON1 (TR) = 1 %OR LOOPCON2 (TR) = 1 %THEN CONFLAG = 1
%FINISHELSEIF OP = MULT %THENSTART
%UNLESS (TT_QOPD1 & TEXTMASK = 0 %AND LOOPCON1 (TR) = 1) %OR %C
(TT_QOPD2 & TEXTMASK = 0 %AND LOOPCON2 (TR) = 1) %C
%THEN %RESULT = 0
%FINISHELSE %RESULT = 0
%IF TT_QOPD1 & TEXTMASK # 0 %THENSTART
%IF BREAKCHECK (TT_OPD1) = 0 %THEN %RESULT = 0
TT == RECORD (ATRIADS + TR*TRIADLENGTH)
%FINISH
%IF TT_QOPD2 & TEXTMASK # 0 %THENSTART
%IF BREAKCHECK (TT_OPD2) = 0 %THEN %RESULT = 0
%FINISH
%FINISH
%RESULT = 1
!
%END ;! BREAKCHECK
!
!
!
!
%INTEGERFUNCTION BREAKOUT (%INTEGER TR)
!
!************************************************************************
!* RECURSIVE ROUTINE WHICH PLANTS THE LOOP CONSTANT COMPONENTS OF THE *
!* SUBSCRIPT EXPRESSION IN THE BACK TARGET. *
!************************************************************************
!
%INTEGER OP
%RECORD (RESF) OPD,WOP1,WOP2
!
TT == RECORD (ATRIADS + TR*TRIADLENGTH)
OPD_MODE = TT_MODE
OPD_FORM = TRIAD
%IF TT_OP & BMBIT # 0 %THENSTART
!* ALREADY BACKWARD MOVED. UPDATE USE CT & RETURN IT.
TT_USE = TT_USE + 1
OPD_H0 = TR
%RESULT = OPD_W
%FINISH
WOP1 = TT_RES1
WOP2 = TT_RES2
OP = TT_OP
!* MAKE RECURSIVE CALLS FOR TEXT OPERANDS.
%IF WOP1_FORM & TEXTMASK # 0 %THEN WOP1_W = BREAKOUT (WOP1_H0)
%IF WOP2_FORM & TEXTMASK # 0 %THEN WOP2_W = BREAKOUT (WOP2_H0)
LCON1 = LCON (WOP1)
LCON2 = LCON (WOP2)
%IF LCON1 = 1 %AND LCON2 = 1 %THENSTART
!* BOTH OPDS CONSTANT. PLANT TRIAD IN BACK TARGET & UPDATE BIT STRIPS.
NEWENT = BRNEW
TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
TT_RES1 = WOP1
TT_RES2_W = WOP2_W
TT_OP = OP ! BMBIT
TREVERSE (NEWENT)
%IF TT_QOPD1 & IDBIT # 0 %THEN BTBITS (TT_OPD1)
%IF TT_QOPD2 & IDBIT # 0 %THEN BTBITS (TT_OPD2)
OPD_H0 = NEWENT
%IF BMTRACE#0 %THENSTART
PRINTSTRING("BREAKOUT:PLANT TRIAD IN BACK TARGET - ")
NEWLINE
PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
%FINISH
%RESULT = OPD_W
%FINISH
%IF OP = MULT %THEN %RESULT = 0
!* TRIAD IS ADD OR SUB. OPDS 1 & 2 NOT BOTH CONSTANT.
%IF LCON1 = 1 %THEN %RESULT = WOP1_W
%IF LCON2 = 0 %THEN %RESULT = 0
!* OPD 2 CONSTANT. IF SUB TRIAD, NEED TO PLANT A NEG TRIAD.
%IF OP = ADD %THEN %RESULT = WOP2_W
NEWENT = BRNEW
TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
TT_RES1 = WOP2
TT_OP = NEG ! BMBIT
TT_RES2_W = 0
%IF WOP2_FORM & IDBIT # 0 %THEN BTBITS (WOP2_H0)
OPD_H0 = NEWENT
%IF BMTRACE#0 %THENSTART
PRINTSTRING("BREAKOUT:PLANT TRIAD IN BACK TARGET - ")
NEWLINE
PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
%FINISH
%RESULT = OPD_W
!
%END;! BREAKOUT
!
!
!
!
%INTEGERFUNCTION BREAKIN (%INTEGER TR)
!
!*************************************************************************
!* RECURSIVE ROUTINE WHICH LEAVES ONLY THE LOOP VARIABLE COMPONENTS *
!* OF THE SUBSCRIPT EXPRESSION INSIDE THE LOOP. *
!*************************************************************************
!
%INTEGER OP
%RECORD (RESF) OPD,WOP1,WOP2
!
TT == RECORD (ATRIADS + TR*TRIADLENGTH)
OPD_H0 = TR
OPD_FORM = TRIAD
OPD_MODE = TT_MODE
WOP1 = TT_RES1
WOP2 = TT_RES2
OP = TT_OP
%IF WOP1_FORM & TEXTMASK # 0 %AND LCON (WOP1) = 0 %C
%THEN WOP1_W = BREAKIN (WOP1_H0)
%IF WOP2_FORM & TEXTMASK # 0 %AND LCON (WOP2) = 0 %C
%THEN WOP2_W = BREAKIN (WOP2_H0)
LCON1 = LCON (WOP1)
LCON2 = LCON (WOP2)
%IF LCON1 = 1 %AND LCON2 = 1 %THEN %RESULT = X'10000'
%IF OP # MULT %THENSTART
%IF LCON2 = 1 %THEN %RESULT = WOP1_W
%IF LCON1 = 1 %THENSTART
%IF OP = ADD %THEN %RESULT = WOP2_W %C
%ELSESTART
WOP1 = WOP2
OP = NEG
WOP2_W = X'10000'
%FINISH
%FINISH
%FINISH
!* TRIAD REQUIRED TO PERFORM CURRENT OPERATION IN LOOP. NEW TRIAD
!* ALWAYS GENERATED.
NEWENT = GETTRIAD
TT == RECORD (ATRIADS + NEWENT*TRIADLENGTH)
TT_USE=0
TT1 == RECORD (ATRIADS + OPD_H0*TRIADLENGTH)
TT_CHAIN = TT1_CHAIN
TT1_CHAIN = NEWENT
%IF WOP1_FORM & TEXTMASK # 0 %THENSTART
TT1 == RECORD (ATRIADS + WOP1_H0*TRIADLENGTH)
TT1_USE =TT1_USE + 1
%FINISH
%IF WOP2_FORM & TEXTMASK # 0 %THENSTART
TT1 == RECORD (ATRIADS + WOP2_H0*TRIADLENGTH)
TT1_USE = TT1_USE + 1
%FINISH
TT_RES1 = WOP1
TT_RES2 = WOP2
TT_OP = OP
TREVERSE (NEWENT)
OPD_H0 = NEWENT
%IF BMTRACE#0 %THENSTART
PRINTSTRING("BREAKIN:PLANT TRIAD IN BACK TARGET - ")
NEWLINE
PRINTTR(NEWENT,ADICT,ANAMES,0,TT)
%FINISH
%RESULT = OPD_W
!
%END;! BREAKIN
!
!
!
!
%INTEGERFUNCTION BRNEW
!
!**************************************************************************
!* CLAIM A NEW TRIAD IN THE BACK TARGET, CHAINED AFTER BTARGTRIAD. *
!**************************************************************************
!
%INTEGER TR,PTR
!
TR = GETTRIAD
TT == RECORD (ATRIADS + BTARGTRIAD*TRIADLENGTH)
PTR = TT_CHAIN
TT_CHAIN = TR
TT == RECORD (ATRIADS + TR*TRIADLENGTH)
TT_CHAIN = PTR
TT_USE = 1
BTARGTRIAD = TR
%RESULT = TR
!
%END;! BRNEW
!
!
!
!
%INTEGERFUNCTION LCON (%RECORD (RESF) OPD)
!
!*********************************************************************
!* CHECKS WHETHER OPERAND IS LOOP CONSTANT. YES = 1, NO = 0. *
!*********************************************************************
!
%INTEGER QUAL
!
QUAL = OPD_FORM
%IF QUAL = 0 %THEN %RESULT = OPD_H0;! 1 IF BREAKIN, 0 IF BREAKOUT.
%IF QUAL & IDBIT # 0 %THENSTART
DD == RECORD (ADICT + OPD_H0 << DSCALE)
BITS1 = ADDR (CLOOPDEF(0))
GETBIT (BITS1,DD_COORD,VAL1)
%IF VAL1 = 1 %THEN %RESULT = 0 %ELSE %RESULT = 1
%FINISH
%IF QUAL & TEXTMASK = 0 %THEN %RESULT = 1
TT == RECORD (ATRIADS + OPD_H0*TRIADLENGTH)
%IF TT_OP & BMBIT = 0 %THEN %RESULT = 0 %C
%ELSE %RESULT = 1 ;! CONSTANT IFF BACKWARD MOVED.
!
%END;! LCON
!
!
!
!
%INTEGERFUNCTION OPSCOM
!
!***********************************************************************
!* CHECKS FOR VALID OPERATOR PAIRS IN DESCENT, NAMELY ADD, SUB, MULT, *
!* MAX, OR MIN TWICE, OR COMBINATIONS OF ADD & SUB. *
!* TRIAD POINTERS ON ENTRY ARE *
!* TT -> CURRTRIAD *
!* TT1 -> LINK. *
!* RETURNS 1 IF OPERATORS ARE A VALID COMBINATION, ELSE 0 *
!***********************************************************************
!
%INTEGER OP
!
OP = TT_OP
%IF OP = TT1_OP %THENSTART
%IF OP = SUB %THEN ACTNO = ACTNO ! 12
%RESULT = 1
%FINISH
%IF OP = ADD %AND TT1_OP = SUB %THENSTART
ACTNO = ACTNO ! 4
%RESULT = 1
%FINISH
%IF OP # SUB %OR TT1_OP # ADD %THEN %RESULT = 0
ACTNO =ACTNO ! 8
%RESULT = 1
!
%END ;! OPSCOM
!
!
!
!
%ROUTINE SWAP
!
!********************************************************************************
!* INTERCHANGE OPERANDS FOR CONSTANT DESCENT, ADJUSTING OPERATORS AS NECESSARY. *
!* ON ENTRY TT -> CURRTRIAD *
!* TT1 -> LINK *
!* ACTNO: 1-BIT SET TO SWAP OPD2 OF LINK (ELSE OPD1) *
!* 2-BIT SET TO SWAP OPD1 OF CURRTRIAD (ELSE OPD2) *
!* 4-BIT SET FOR A + (B - C) *
!* 8-BIT SET FOR A - (B + C) *
!* 4 & 8 BITS SET FOR A - (B - C). *
!********************************************************************************
!
%INTEGER OP
%INTEGERNAME AD
%RECORD (RESF) OPD
%CONSTBYTEINTEGERARRAY ACTS (5:15) = 1,0,9,17,1,10,26,12,0,12,0
!
%IF ACTNO & 1 = 0 %THENSTART
OPD = TT1_RES1
AD == TT1_RES1_W
%FINISHELSESTART
OPD = TT1_RES2
AD == TT1_RES2_W
%FINISH
%IF ACTNO & 2 = 0 %THENSTART
AD = TT_RES2_W
TT_RES2 = OPD
%FINISHELSESTART
AD = TT_RES1_W
TT_RES1 = OPD
%FINISH
!
!* SOME COMBINATIONS OF OPERATORS REQUIRE SWAPPING OF EITHER OPERATORS
!* OR OPERANDS, AS DEFINED IN A SECOND SET OF ACTIONS.
%UNLESS ACTNO < 5 %THENSTART
ACTNO = ACTS (ACTNO)
%IF ACTNO & 1 # 0 %THENSTART ;! SWAP OPERATORS BETWEEN CURR & LINK
OP = TT_OP
TT_OP = TT1_OP
TT1_OP = OP
%FINISHELSEIF ACTNO & 2 # 0 %THEN TT1_OP = SUB %C
%ELSEIF ACTNO & 4 # 0 %THEN TT1_OP = ADD
%IF ACTNO & 8 # 0 %THENSTART ;! SWAP OPERANDS OF CURR.
OPD = TT_RES1
TT_RES1 = TT_RES2
TT_RES2 = OPD
%FINISH
%IF ACTNO & 16 # 0 %THENSTART ;! SWAP OPERANDS OF LINK.
OPD = TT1_RES1
TT1_RES1 = TT1_RES2
TT1_RES2 = OPD
%FINISH
%FINISH
!* ENSURE NEW OPERANDS ARE IN CORRECT ORDER OF PRECEDENCE
TREVERSE(CURRTRIAD)
TREVERSE(LINK)
%IF BMTRACE#0 %THENSTART
PRINTSTRING("SWAP:LINK TRIAD BECOMES - ")
NEWLINE
PRINTTR(LINK,ADICT,ANAMES,0,TT1)
PRINTSTRING("CURRTRIAD BECOMES - ")
NEWLINE
PRINTTR(CURRTRIAD,ADICT,ANAMES,0,TT)
%FINISH
!
%END ;! SWAP
!
!
%END;! BACKMOVE
!
%ENDOFFILE