! 09/12/85 - taken from op3b45, new include files incorporated,
! remove include of targ_arrtr
! 29/11/84 - set Opcat for PAUSE to 21
! 24/10/84 - line 2345, also test for OP=MOO
! - line 2785, scaling factor corrected to SRSCALE
! 23/10/84 - call ADDCODE at line 1153
! 02/10/84 - remove error message at PASS1(0) & PASS2(0)
! 05/07/84 - put routine ARRTR in include file targ_arrtr
! 06/06/84 - extend array OPCAT for INTRIN & DCMPLX
! 05/06/84 - do not optimise arrays with constant subscripts (ARRTR)
! 13/03/84 - correct TYPES and LENGTHS in routine DESC
! 19/01/84 - CTSIZE & EXTNSIZE NOW IN HOST
! 18/01/84 - BLOCK BIT STRIP ADDRESSES ARE NOW RELATIVE TO ABLOCKS
! 07/11/83 COPIED FROM ERCS06.REL8002_OP3B23
!*
%include "ercs01:ftn_ht"
!
%include "ercs01:ftn_consts1"
!
%include "ercs01:ftn_fmts2"
!*
%include "ercs01:ftn_optspecs1"
!*
%include "ercs01:ftn_optfmts1"
!*
%include "ercs01:ftn_triadops1"
!*
!
!
!
!
%INTEGERFUNCTIONSPEC CREATETE (%INTEGER M)
%INTEGERFUNCTIONSPEC CREATEDT (%INTEGER M)
%INTEGERFUNCTIONSPEC ARBASE (%RECORD (RESF) OPD)
%INTEGERFUNCTIONSPEC CHAFTER (%INTEGER TR)
%ROUTINESPEC ELIM (%INTEGER TR)
%ROUTINESPEC TEXTPASS (%INTEGER BREG)
!
!
!
!
%EXTERNALROUTINE OP3
!
!
!
%ROUTINESPEC LOOPSEL (%INTEGER L)
%ROUTINESPEC LOOPBUILD
%ROUTINESPEC COMMTEMPS
%INTEGERFUNCTIONSPEC STRENGTH
%ROUTINESPEC REPLACE (%INTEGER S)
%ROUTINESPEC BTEMPREP (%INTEGER MAX)
%ROUTINESPEC VALUE (%INTEGER S)
%ROUTINESPEC DESC (%INTEGER S)
%ROUTINESPEC PRINTSR
%ROUTINESPEC PRINTTE
%ROUTINESPEC PRINTDT
!
!
%INTEGERARRAYFORMAT TABF (0:1000)
%INTEGERARRAYNAME ENTBTAB
%RECORD (CLOOPRECF) %NAME CL
%RECORD (BLRECF) %NAME BB
%RECORD (LOOPRECF) %NAME LO
%RECORD (CONRECF) %NAME CN
%RECORD (TRIADF) %NAME TT
%RECORD (SREDF) %NAME SR
!
%CONSTINTEGER INFIN = X'80000001'
!
%INTEGER I,SAVEPTR,DLOOPCH,BCOORD,CLOOPPTR,BREGTEMP,ADDTRIAD
%INTEGER TEMAXCOORD,COORDMAX,BACKTARG
!
!**********************************************************************
!* OP3 CONTROL. *
!* BUILD AND PROCESS ALL LOOPS, STARTING AT INNERMOST. *
!**********************************************************************
!
%IF SRFLAGS & 16 # 0 %THEN PRINTSR
COORDMAX = BSWORDS << 5
TEINDEX = 1
DTINDEX = 1
VALTEMPHEAD = 0
DESTEMPHEAD = 0
TECH = ADDR (VALTEMPHEAD)
DTCH = ADDR (DESTEMPHEAD)
BCOORD = BSBITS
TEMAXCOORD = BCOORD
!* PROCESS TEXT FROM INNERMOST LOOPS OUTWARDS.
%UNLESS FREELOOPS = 0 %THEN LOOPSEL (0)
!* NOW PROCESS ENTRY-LEVEL BLOCKS.
SAVEPTR = FREETABS
ENTBTAB == ARRAY (ATABS + ENTBPTR,TABF)
DLOOPCH = ADDR (DLOOPHEAD)
DLOOPHEAD = 0
DLOOPTAIL = 0
%FOR I = 1,1,ENTBTAB(0) %CYCLE
CLOOPTAIL = CREATETAB (CLOOPSZ)
CL == RECORD (ATABS + CLOOPTAIL)
CL_BLOCK = ENTBTAB (I)
INTEGER (DLOOPCH) = CLOOPTAIL
CL_PDCHAIN = 0
DLOOPCH = ADDR (CL_PDCHAIN)
CL_PDBACKCHAIN = DLOOPTAIL
DLOOPTAIL = CLOOPTAIL
%REPEAT
CLOOPHEAD = DLOOPHEAD
LOOPDEPTH = 0
BACKTARG = 0
BREGTEMP = 0
LOOP = X'FFFF'
LOOPBUILD
%IF SRFLAGS & 16 # 0 %THENSTART
PRINTTE
PRINTDT
%FINISH
!* ATTEMPT TO COMMON UP TEMPORARIES ALLOCATED IN OP3.
COMMTEMPS %UNLESS FREELOOPS = 0
!
!
!
!
%ROUTINE LOOPSEL (%INTEGER L)
!
!************************************************************************
!* RECURSIVE ROUTINE TO PROCESS ALL "SON" LOOPS OF A GIVEN LOOP. *
!* PARAMETER IS A LOOPTAB POINTER FOR CURRENT LOOP. CALLS ROUTINE TO *
!* HANDLE STRENGTH REDUCTION TEMPORARIES BEFORE PROCESSING INNER LOOPS.*
!************************************************************************
!
%INTEGER LOOPPTR,BTEMP
!
LOOPPTR = L
%CYCLE
LOOP = LOOPPTR
BTEMP = STRENGTH;! PROCESS SR TEMPS FOR THIS LOOP.
LO == RECORD (ALOOPS + LOOPPTR)
%UNLESS LO_DOWN = 0 %THENSTART
LOOPSEL (LO_DOWN)
LO == RECORD (ALOOPS + LOOPPTR)
%FINISH
SAVEPTR = FREETABS
CLOOPHEAD = CREATETAB (CLOOPSZ)
CL == RECORD (ATABS + CLOOPHEAD)
CL_BLOCK = LO_BLOCK
CL_PDCHAIN = 0
CL_PDBACKCHAIN = 0
DLOOPHEAD = CLOOPHEAD
CLOOPTAIL = CLOOPHEAD
DLOOPTAIL = CLOOPHEAD
DLOOPCH = ADDR (CL_PDCHAIN)
BB == RECORD (ABLOCKS + LO_BLOCK * BLSIZE)
LOOPDEPTH = BB_DEPTH
BACKTARG = BB_BTARG
LOOP = LOOPPTR
BREGTEMP = BTEMP
LOOPBUILD
LOOPPTR = LO_ACROSS;! PROCESS NEXT "BROTHER" IF ANY.
%REPEAT %UNTIL LOOPPTR = 0
!
%END;! LOOPSEL
!
!
!
!
%ROUTINE LOOPBUILD
!
!**************************************************************************
!* EXTEND CLOOP LIST TO HOLD ALL FORWARD CONNECTIONS OF THE ENTRY BLOCKS *
!* WHICH ARE IN THE LOOP. BLOCKS WHICH HAVE NOT YET BEEN PROCESSED ARE *
!* CHAINED INTO DLOOP LIST. *
!**************************************************************************
!
%INTEGER BLK,PTR
!
CLOOPPTR = CLOOPHEAD
%CYCLE
CL == RECORD (ATABS + CLOOPPTR)
BB == RECORD (ABLOCKS + CL_BLOCK * BLSIZE)
%UNLESS BB_FCON = 0 %THENSTART
CN == RECORD (ATABS + BB_FCON)
%FOR I = 1,1,CN_COUNT %CYCLE
BLK = CN_BLOCK(I)
%UNLESS BLK = 0 %THENSTART
BB == RECORD (ABLOCKS + BLK * BLSIZE)
%IF BB_DEPTH >= LOOPDEPTH %THENSTART
%FOR PTR = CLOOPHEAD,CLOOPSZ,CLOOPTAIL %CYCLE
CL == RECORD (ATABS + PTR)
%IF CL_BLOCK = BLK %THEN -> L1;! BLOCK ALREADY IN LIST
%REPEAT
CLOOPTAIL = CREATETAB (CLOOPSZ)
CL == RECORD (ATABS + CLOOPTAIL)
CL_BLOCK = BLK
%IF BB_DEPTH = LOOPDEPTH %THENSTART
INTEGER (DLOOPCH) = CLOOPTAIL
DLOOPCH = ADDR (CL_PDCHAIN)
CL_PDCHAIN = 0
CL_PDBACKCHAIN = DLOOPTAIL
DLOOPTAIL = CLOOPTAIL
%FINISH
%FINISH
%FINISH
L1: %REPEAT
%FINISH
CLOOPPTR = CLOOPPTR + CLOOPSZ
%REPEAT %UNTIL CLOOPPTR > CLOOPTAIL
!
!* LOOP-LEVEL DIAGNOSTICS:
%IF SRFLAGS & 8 # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING (" BACK TARGET & CLOOP BLOCKS AFTER OP3A")
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
!
TEXTPASS (BREGTEMP)
!
!* MORE LOOP-LEVEL DIAGNOSTICS:
%IF SRFLAGS & 32 # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING (" BACK TARGET & CLOOP BLOCKS AFTER OP3B")
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
!
FREETABS = SAVEPTR
!
%END;! LOOPBUILD
!
!
!
!
%INTEGERFUNCTION STRENGTH
!
!************************************************************************
!* DECIDES ON MAPPINGS FOR ALL STRENGTH REDUCTION TEMPORARIES *
!* ASSOCIATED WITH A GIVEN LOOP. ON ENTRY LOOP CONTAINS A LOOPTAB *
!* POINTER FOR THE CURRENT LOOP. RETURNS A POINTER INTO SRTEMP TABLE *
!* FOR ENTRY MAPPED ONTO B-REG. *
!************************************************************************
!
%RECORD (SREDF) %NAME SR1,SR2
%RECORD (TRIADF) %NAME TT2
!
%INTEGER TRID,SRPTR,MAXWEIGHT,MAXTEMP,IDENT,PTR1,PTR2,CHAIN
!
!* FIND LAST TRIAD IN LOOP'S BACK TARGET: WE MAY NEED TO ADD TRIADS THERE.
LO == RECORD (ALOOPS + LOOP)
BB == RECORD (ABLOCKS + LO_BLOCK * BLSIZE)
BB == RECORD (ABLOCKS + BB_BTARG * BLSIZE)
TRID = BB_TEXT
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
%CYCLE
ADDTRIAD = TRID
TRID = TT_CHAIN
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
%REPEAT %UNTIL TT_OP = INIT %OR TT_OP = GOTO %C
%OR (TT_OP = STMT %AND TT_USE & SOB # 0)
!* FIND MAX-WEIGHTED TEMP IN THIS LOOP & MAP ONTO B-REG. OTHERS ARE
!* REPLACED BY DT OR TE ENTRIES.
MAXWEIGHT = INFIN - 1
MAXTEMP = 0
CHAIN = LO_ST
%WHILE CHAIN # 0 %CYCLE
SRPTR = CHAIN
SR == RECORD (ABLOCKS + SRPTR << SRSCALE)
CHAIN = SR_CHAIN
!* STOP WHEN SR ENTRIES FOR A DIFFERENT LOOP ARE MET.
%IF SR_LOOP # LOOP %THEN %EXIT
!* IGNORE ENTRY IF ALREADY SCANNED.
%IF SR_FLAGS & SCANDBIT # 0 %THEN %CONTINUE
!* LOOK FOR IDENTICAL SR ENTRIES, & CHAIN THEM TOGETHER.
PTR1 = SRPTR
SR1 == SR
SR2 == SR
IDENT = SR_IDENT
SR_IDENT = 0
%CYCLE
PTR2 = SR2_CHAIN
%IF PTR2 = 0 %THEN %EXIT
SR2 == RECORD (ABLOCKS + PTR2 << SRSCALE)
%IF SR2_LOOP # LOOP %THEN %EXIT
%IF SR2_FLAGS & SCANDBIT # 0 %THEN %CONTINUE
%IF SR2_IDENT # IDENT %THEN %CONTINUE
TT == RECORD (ATRIADS + SR1_INIT * TRIADLENGTH)
TT2== RECORD (ATRIADS + SR2_INIT * TRIADLENGTH)
%IF TT_RES2_W # TT2_RES2_W %THEN %CONTINUE
%FOR I = 1,1,3 %CYCLE
%IF SR1_INCR(I) = 0 %THENSTART
%IF SR2_INCR(I) = 0 %THEN %EXIT %C
%ELSE -> L1
%FINISH
%IF SR2_INCR(I) = 0 %THEN -> L1
TT == RECORD (ATRIADS + SR1_INCR(I) * TRIADLENGTH)
TT2== RECORD (ATRIADS + SR2_INCR(I) * TRIADLENGTH)
%IF TT_RES2_W # TT2_RES2_W %OR TT_OP # TT2_OP %THEN -> L1
%REPEAT
!* TWO ENTRIES ARE IDENTICAL. ADD NEW ONE TO CHAIN.
SR1_IDENT = PTR2
PTR1 = PTR2
SR1 == SR2
SR1_IDENT = 0
!* WEIGHT OF COMBINED CHAIN IS MAX OF WEIGHTS OF ITS MEMBERS.
%IF SR1_WEIGHT > SR_WEIGHT %THEN SR_WEIGHT = SR1_WEIGHT
!* MARK NEW ENTRY AS SCANNED.
SR1_FLAGS = SR1_FLAGS ! SCANDBIT
!* IF ANY ENTRY IN CHAIN IS SUITABLE FOR TEST REPLACEMENT, THEN WHOLE CHAIN IS.
SR_FLAGS = SR_FLAGS ! (SR1_FLAGS & TESTREPBIT)
!* INIT & INCR TRIADS FOR NEW SR ENTRY NOT NEEDED, SO SET THEM TO NULL,
!* AND IF THEIR OPDS ARE TEXT, REDUCE THEIR USE CTS BY ONE.
TRID = SR1_INIT
I = 1
%WHILE TRID#0 %CYCLE
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
TT_OP = NULL
%IF TT_QOPD2 & TEXTMASK # 0 %THEN DELUSE (TT_OPD2)
%IF I = 4 %THEN %EXIT
TRID = SR1_INCR(I)
I = I + 1
%REPEAT
L1: %REPEAT
!* REPLACE LOWER WEIGHTED ENTRY BY A DT OR TE ENTRY.
%IF SR_WEIGHT > MAXWEIGHT %AND SR_MODE = INT4 %THENSTART
MAXWEIGHT = SR_WEIGHT
REPLACE (MAXTEMP) %UNLESS MAXTEMP = 0
MAXTEMP = SRPTR
%FINISHELSE REPLACE (SRPTR)
%REPEAT
%IF MAXTEMP = 0 %THEN %RESULT = 0 %C
%ELSESTART
BTEMPREP (MAXTEMP)
%RESULT = MAXTEMP
%FINISH
!
%END;! STRENGTH
!
!
!
!
%ROUTINE BTEMPREP (%INTEGER MAX)
!
!****************************************************************************
!* MARKS THE B-REG SR ENTRY AS SUCH. CHANGES THE OPD1 OF THE INIT TO B-REG,*
!* AND ENSURES THAT ALL OTHER TESTS & USES POINT TO MAIN SR ENTRY *
!* IN CHAIN. *
!****************************************************************************
!
%RECORD (RESF) SRMAX,SRCURRENT
!
SRMAX_H0 = MAX
SRMAX_FORM = SRTEMP
SRMAX_MODE = INT4
SR == RECORD (ABLOCKS + MAX << SRSCALE)
SR_FLAGS = SR_FLAGS ! BREGBIT
SR_DUMP = 0
TT == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
TT_QOPD1 = BREG
SRCURRENT = SRMAX
!* SCAN THRO' ENTRIES IN AN IDENTITY CHAIN, CHANGING REFS TO POINT TO HEAD-OF-CHAIN.
%WHILE SR_IDENT # 0 %CYCLE
SRCURRENT_H0 = SR_IDENT
SR == RECORD (ABLOCKS + SR_IDENT << SRSCALE)
%FOR I = 1,1,3 %CYCLE
%IF SR_TEST(I) = 0 %THEN %EXIT
TT == RECORD (ATRIADS + SR_TEST(I) * TRIADLENGTH)
%IF TT_RES1_W = SRCURRENT_W %THEN TT_RES1 = SRMAX
%IF TT_RES2_W = SRCURRENT_W %THEN TT_RES2 = SRMAX
%REPEAT
%FOR I = 1,1,SR_USECT %CYCLE
%IF SR_USE(I) = 0 %THEN %EXIT
TT == RECORD (ATRIADS + SR_USE(I) * TRIADLENGTH)
%IF TT_RES1_W = SRCURRENT_W %THEN TT_RES1 = SRMAX
%IF TT_RES2_W = SRCURRENT_W %THEN TT_RES2 = SRMAX
%REPEAT
%REPEAT
!
%END;! BTEMPREP
!
!
!
!
%ROUTINE REPLACE (%INTEGER SRENT)
!
!**************************************************************************
!* DECIDES WHETHER TO MAP AN SR TEMP ONTO A DT OR A TE ENTRY. *
!* (MAPPED ONTO DTEMP ONLY IF TEMP HAS NOT BEEN SELECTED FOR TEST *
!* REPLACEMENT, AND ALL THE USES ARE AS SUBSCRIPTS IN ARR OR DEFARR *
!* TRIADS USING THE SAME ARRAY.) *
!**************************************************************************
!
%RECORD (RESF) CURRARR
!
CURRARR_W = 0
SR == RECORD (ABLOCKS + SRENT << SRSCALE)
%IF SR_FLAGS & TESTREPBIT = 0 %THENSTART
%CYCLE
%FOR I = 1,1,SR_USECT %CYCLE
%IF SR_USE(I) = 0 %THEN %EXIT
TT == RECORD (ATRIADS + SR_USE(I) * TRIADLENGTH)
%UNLESS TT_OP = ARR %OR TT_OP = DEFARR %THEN -> L1
%IF TT_MODE=CHARMODE %THEN ->L1
%IF CURRARR_W = 0 %THEN CURRARR = TT_RES1 %C
%ELSESTART
%UNLESS TT_RES1_W = CURRARR_W %THEN -> L1
%FINISH
%REPEAT
%IF SR_IDENT = 0 %THEN %EXIT
SR == RECORD (ABLOCKS + SR_IDENT << SRSCALE)
%REPEAT
DESC (SRENT)
%FINISHELSESTART
L1: VALUE (SRENT)
%FINISH
!
%END;! REPLACE
!
!
!
!
%ROUTINE VALUE (%INTEGER S)
!
!*********************************************************************
!* REPLACES AN SR TEMP WITH A TE ENTRY. *
!*********************************************************************
!
%RECORD (RESF) TEPTR,CURRSR
!
%RECORD (TERECF) %NAME TE
!
SR == RECORD (ABLOCKS + S << SRSCALE)
TEPTR_W = CREATETE (INT4)
TE == RECORD (ADICT + TEPTR_H0 << DSCALE)
TE_FLAGS = SRTEMPBIT
TE_LOOP = LOOP
TEMAXCOORD = TEMAXCOORD + 1
TE_COORD = TEMAXCOORD
!* INIT TRIAD BECOMES AN ASMT.
TT == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
TT_OP = ASMT
CURRSR_H0 = S
CURRSR_FORM = SRTEMP
CURRSR_MODE = INT4
!* FOR EACH ENTRY IN SR IDENTITY CHAIN, REPLACE SR REFS BY TE REFS IN
!* INIT & ALL INCRS, TESTS, & USES.
%CYCLE
TT_RES1 = TEPTR
%FOR I = 1,1,SR_USECT+6 %CYCLE
%IF SR_ALLREFS(I) = 0 %THEN %CONTINUE
TT == RECORD (ATRIADS + SR_ALLREFS(I) * TRIADLENGTH)
%IF TT_RES1_W = CURRSR_W %THEN TT_RES1 = TEPTR
%IF TT_RES2_W = CURRSR_W %THEN TT_RES2 = TEPTR
%REPEAT
%IF SR_IDENT = 0 %THEN %EXIT
CURRSR_H0 = SR_IDENT
SR == RECORD (ABLOCKS + SR_IDENT << SRSCALE)
TT == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
%REPEAT
!
%END;! VALUE
!
!
!
!
%ROUTINE DESC (%INTEGER S)
!
!***********************************************************************
!* REPLACES AN SR TEMP WITH A DT ENTRY. *
!***********************************************************************
!
%RECORD (RESF) DTPTR,WINC,OPD
!
%RECORD (DTRECF) %NAME DT
%RECORD (TRIADF) %NAME TT1
!
%INTEGER MODE,BASE,TYPE,SCALE,NEWTR,CUSES,INC,TRID,I
!
%CONSTBYTEINTEGERARRAY TYPES(0:15) = INTTYPE(3),REALTYPE(3),CMPLXTYPE(3),
LOGTYPE(4),CHARTYPE,0,INTTYPE
%CONSTBYTEINTEGERARRAY LENGTHS(0:15) = 2,4,8,4,8,16,8,16,32,1,2,4,8,1,0,1
!
%ROUTINESPEC ADDCODE (%INTEGER TR)
!
SR == RECORD (ABLOCKS + S << SRSCALE)
I=1
TT == RECORD (ATRIADS + SR_USE(I) * TRIADLENGTH)
OPD = TT_RES1
BASE = ARBASE (OPD)
MODE = TT_MODE
DTPTR_W = CREATEDT (TT_MODE)
DT == RECORD (ADICT + DTPTR_H0 << DSCALE)
DT_IDENT = BASE
DT_FLAGS = SRTEMPBIT
DT_LOOP = LOOP
!* CALCULATE VALUE BY WHICH EACH INCREMENT MUST BE SCALED.
TYPE = TYPES (MODE)
SCALE = LENGTHS(MODE)
!*
%IF TYPE = CMPLXTYPE %THEN SCALE = SCALE >> 1
!*
%IF TARGET=PERQPNX %THENSTART
%IF SCALE#1 %THEN SCALE=SCALE>>1;! 16 bit word addresses
%FINISH
!*
%IF TARGET=ICL2900 %THENSTART
%IF SCALE=2 %THEN SCALE=1;! for string descriptor use
%FINISH
!*
!* MODIFY INIT TRIAD BY REPLACING SRTEMP BY THE NEW DTEMP, AND THE
!* INITIAL VALUE BY A DEFARR TRIAD.
TT1 == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
!* INSERT NEW TRIAD IMMEDIATELY BEFORE THE RELEVANT INIT.
TRID = ADDTRIAD
%CYCLE
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
%IF TT_CHAIN = SR_INIT %THEN %EXIT
TRID = TT_CHAIN
%REPEAT
NEWTR = CHAFTER (TRID)
TT == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
TT_RES1 = OPD
TT_RES2 = TT1_RES2
TT_OP = DEFARR
TT_USE = 1
TT1_RES1 = DTPTR
TT1_OPD2 = NEWTR
TT1_QOPD2 = TRIAD
TT1_MODE2 = MODE
TT1_OP = DINIT
!* MODIFY EACH OF THE INCR/DECR TRIADS BY SCALING THE INCREMENT AND
!* REPLACING THE OLD SR TEMP BY THE NEW DT ENTRY.
%FOR I = 1,1,3 %CYCLE
%IF SR_INCR(I) = 0 %THEN %EXIT
TT == RECORD (ATRIADS + SR_INCR(I) * TRIADLENGTH)
%IF TT_OP # INCR %THENSTART
TT_OP = INCR
SCALE = -SCALE
%FINISH
!* AMEND DT-INCR TRIADS SO THAT OPD 2 IS CORRECTLY SCALED FOR INCA.
!* MAY INVOLVE CHAINING INTO THE BACK TARGET.
%UNLESS SCALE = 1 %THENSTART
L1: INC = TT_OPD2
WINC = TT_RES2
%IF TT_QOPD2 & TEXTMASK # 0 %THENSTART
TT1 == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
%IF TT1_OP = REPL %OR TT1_OP = REF %THENSTART
ELIM (INC)
TT_RES2 = TT1_RES1
-> L1
%FINISH
%IF TT1_OP = MULT %AND TT1_USE = 1 %THENSTART
%IF TT1_QOPD2 & CONSTMASK # 0 %THEN %C
TT1_RES2_W = CONIN (SCALE * CONOUT (TT1_RES2)) %C
%ELSEIF TT1_QOPD1 & CONSTMASK # 0 %THEN %C
TT1_RES1_W = CONIN (SCALE * CONOUT (TT1_RES1)) %C
%ELSE ADDCODE(INC)
%FINISHELSE ADDCODE (INC)
%FINISHELSEIF TT_QOPD2 & CONSTMASK # 0 %THEN %C
TT_RES2_W = CONIN (SCALE * CONOUT (TT_RES2)) %C
%ELSE ADDCODE (ADDTRIAD) %AND ADDTRIAD = NEWTR
%FINISH
TT_RES1 = DTPTR
%REPEAT
!* EACH USE TRIAD BECOMES A REPL WITH OPD 1 = THE NEW DTEMP.
CUSES = 0
%CYCLE
%FOR I = 1,1,SR_USECT %CYCLE
%IF SR_USE(I) = 0 %THEN %EXIT
TT == RECORD (ATRIADS + SR_USE(I) * TRIADLENGTH)
TT_RES1 = DTPTR
TT_OP = REPL
TT_RES2_W = 0
CUSES = CUSES + 1
%REPEAT
%IF SR_IDENT = 0 %THEN %EXIT
SR == RECORD (ABLOCKS + SR_IDENT << SRSCALE)
%REPEAT
SR == RECORD (ABLOCKS + S << SRSCALE)
TT == RECORD (ATRIADS + SR_INIT * TRIADLENGTH)
TT == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
%IF TT_QOPD1 & TEXTMASK # 0 %THENSTART
TT == RECORD (ATRIADS + TT_OPD1 * TRIADLENGTH)
TT_USE = TT_USE + 1 - CUSES
%FINISH
!
!
!
!
%ROUTINE ADDCODE (%INTEGER TR)
!
!************************************************************************
!* GENERATES 'INC * SCALE' (OR 'INC NEG -' , IF SCALE = -1) TRIAD. *
!************************************************************************
!
NEWTR = CHAFTER (TR)
TT1 == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
TT1_RES1 = WINC
%UNLESS SCALE = -1 %THENSTART
TT1_RES2_W = CONIN (SCALE)
TT1_OP = MULT
%FINISHELSE TT1_OP = NEG
TT1_USE = 1
TT_OPD2 = NEWTR
TT_QOPD2 = TRIAD
TT_MODE2 = INT4
!
%END;! ADDCODE
!
%END;! DESC
!
!
!
!
%ROUTINE COMMTEMPS
!
!***************************************************************************
!* EQUIVALENCES TOGETHER DT & TE ENTRIES WHICH ARE NOT ACTIVE AT THE SAME *
!* POINT IN THE FORTRAN SECTION. *
!***************************************************************************
!
%INTEGERARRAYFORMAT BF(0:15)
%INTEGERARRAYNAME B
!
%INTEGER CTAREA,PTR,MODE,BITNO,CTEND,CTLENGTH,CHAIN,SAVE
!
%RECORDFORMAT CTEMPF (%HALFINTEGER TEMP)
!
%RECORD (TERECF) %NAME TE
%RECORD (DTRECF) %NAME DT
%RECORD (LOOPRECF) %NAME LO
%RECORD (BLRECF) %NAME BB
%RECORD (CTEMPF) %NAME CT
!
%ROUTINESPEC SETVAL (%INTEGER L)
%INTEGERFUNCTIONSPEC BITVAL (%INTEGER L)
%ROUTINESPEC ZEROBITS
!
!* FIRST COMMON UP TE ENTRIES.
SAVE = FREETABS
ZEROBITS
PTR = VALTEMPHEAD
%WHILE PTR # 0 %CYCLE
TE == RECORD (ADICT + PTR << DSCALE)
CHAIN = TE_CHAIN
LOOP = TE_LOOP
!* TEMPS USED AT OUTER LEVEL CAN'T BE COMMONED.
%UNLESS LOOP = X'FFFF' %THENSTART
TE_LOOP = 0
MODE = TE_MODE
BITNO = 0
!* SCAN CTEMP TABLE & BITSTRIPS TO FIND APPROPRIATE BIT-NO FOR TEMP.
%CYCLE
CT == RECORD (ATABS + CTAREA + BITNO * CTSIZE)
!* BIT-NO OK IF UNALLOCATED.
%IF CT_TEMP = 0 %THEN %EXIT
TE == RECORD (ADICT + CT_TEMP << DSCALE)
!* ALSO OK IF ALREADY ALLOCATED TO A TEMP OF SAME MODE, AND NEVER
!* ACTIVE IN SAME LOOPS.
%IF TE_MODE = MODE %AND BITVAL (LOOP) = 0 %THEN %EXIT
BITNO = BITNO + 1
%IF BITNO > COORDMAX %THEN -> L1;! NO SUITABLE BIT-NO.
%REPEAT
!* WE HAVE A GOOD BIT-NO. ATTACH IT TO CHAIN.
SETVAL (LOOP)
TE_LOOP = CT_TEMP
CT_TEMP = PTR
L1: %FINISH
PTR = CHAIN
%REPEAT
FREETABS = SAVE
!
!* NOW COMMON UP DT ENTRIES.
!
ZEROBITS
PTR = DESTEMPHEAD
%WHILE PTR # 0 %CYCLE
DT == RECORD (ADICT + PTR << DSCALE)
LOOP = DT_LOOP
!* TEMPS INITIALISED BY LOADER, OR USED AT OUTER LEVEL, CAN'T BE COMMONED.
%UNLESS DT_FLAGS & INITLOADBIT # 0 %OR LOOP = X'FFFF' %THENSTART
DT_LOOP = 0
BITNO = 0
!* SCAN CTEMP TABLE & BITSTRIPS TO FIND APPROPRIATE BIT-NO FOR TEMP.
%CYCLE
CT == RECORD (ATABS + CTAREA + BITNO * CTSIZE)
!* BIT-NO OK IF UNALLOCATED, OR ALLOCATED TO A TEMP WHICH IS NEVER
!* ACTIVE IN SAME LOOPS.
%IF CT_TEMP = 0 %OR BITVAL (LOOP) = 0 %THEN %EXIT
BITNO = BITNO + 1
%IF BITNO > COORDMAX %THEN -> L2
%REPEAT
SETVAL (LOOP)
DT_LOOP = CT_TEMP
CT_TEMP = PTR
L2: %FINISH
PTR = DT_CHAIN
%REPEAT
FREETABS = SAVE
!
!
!
!
%ROUTINE ZEROBITS
!
!*********************************************************************
!* SET UP A TABLE AREA & CLEAR BLOCK USE BIT-STRIPS. *
!*********************************************************************
!
PTR = ALOOPS
%WHILE PTR < ALOOPS + FREELOOPS %CYCLE
LO == RECORD (PTR)
BB == RECORD (ABLOCKS + LO_BLOCK * BLSIZE)
B == ARRAY (ABLOCKS+BB_USE,BF)
B(I) = 0 %FOR I = 0,1,BSWORDS - 1
PTR = PTR + LOOPRECSIZE
%REPEAT
CTLENGTH = CTSIZE * COORDMAX
CTAREA = CREATETAB (CTLENGTH)
CTEND = CTAREA + CTLENGTH
PTR = CTAREA
%CYCLE
CT == RECORD (ATABS + PTR)
CT_TEMP = 0
PTR = PTR + CTSIZE
%REPEAT %UNTIL PTR >= CTEND
!
%END;! ZEROBITS
!
!
!
!
%ROUTINE SETVAL (%INTEGER L)
!
!*********************************************************************
!* SETS GIVEN BIT FOR LOOP L & ALL CONTAINED LOOPS (RECURSIVELY). *
!*********************************************************************
!
%INTEGER DOWN
!
%RECORD (LOOPRECF) %NAME LO1
!
LO1 == RECORD (ALOOPS + L)
DOWN = LO1_DOWN
%WHILE DOWN # 0 %CYCLE
SETVAL (DOWN)
LO == RECORD (ALOOPS + DOWN)
DOWN = LO_ACROSS
%REPEAT
BB == RECORD (ABLOCKS + LO1_BLOCK * BLSIZE)
SETBIT (ABLOCKS+BB_USE,BITNO)
!
%END;! SETVAL
!
!
!
!
%INTEGERFUNCTION BITVAL (%INTEGER L)
!
!**************************************************************************
!* CHECKS WHETHER GIVEN BIT IS SET IN ANY LOOP CONTAINED IN LOOP L *
!* (RECURSIVELY). IF SO, SETS BIT FOR THIS LOOP (TO SAVE TIME NEXT *
!* TIME. RETURNS BIT VALUE FOR LOOP. *
!**************************************************************************
!
%INTEGER BIT,DOWN
!
%RECORD (BLRECF) %NAME BB
!
LO == RECORD (ALOOPS + L)
BB == RECORD (ABLOCKS + LO_BLOCK * BLSIZE)
DOWN = LO_DOWN
GETBIT (ABLOCKS+BB_USE,BITNO,BIT)
%IF BIT # 0 %THEN %RESULT = 1
%WHILE DOWN # 0 %CYCLE
%IF BITVAL (DOWN) = 1 %THENSTART
SETBIT (ABLOCKS+BB_USE,BITNO)
%RESULT = 1
%FINISH
LO == RECORD (ALOOPS + DOWN)
DOWN = LO_ACROSS
%REPEAT
%RESULT = 0
!
%END;! BITVAL
!
%END;! COMMTEMPS
!
!
!
!
%ROUTINE PRINTSR
!
!*************************************************************************
!* PRINT CONTENTS OF STRENGTH REDUCTION TEMPORARIES TABLE. *
!*************************************************************************
!
%INTEGER PTR
!
NEWLINE
NEWLINE
PRINTSTRING ("STRENGTH REDUCTION TABLE")
NEWLINE
PRINTSTRING (" IDENT LOOP DUMP INIT FLAGS USE CT WEIGHT")
NEWLINE
PTR = SRHEAD
%WHILE PTR # 0 %CYCLE
SR == RECORD (ABLOCKS + PTR << SRSCALE)
WRITE (SR_IDENT,6)
WRITE (SR_LOOP,6)
WRITE (SR_DUMP,6)
WRITE (SR_INIT,6)
WRITE (SR_FLAGS,6)
WRITE (SR_USECT,6)
WRITE (SR_WEIGHT,6)
NEWLINE
PTR = SR_CHAIN
%REPEAT
!
%END;! PRINTSR
!
!
!
!
%ROUTINE PRINTTE
!
!*************************************************************************
!* PRINT CONTENTS OF VALUE TEMPORARIES TABLE. *
!*************************************************************************
!
%RECORD (TERECF) %NAME TE
!
%INTEGER PTR
!
NEWLINE
NEWLINE
PRINTSTRING ("VALUE TEMPORARIES TABLE")
NEWLINE
PRINTSTRING (" MODE LOOP INDEX FLAGS")
NEWLINE
PTR = VALTEMPHEAD
%WHILE PTR # 0 %CYCLE
TE == RECORD (ADICT + PTR<<DSCALE)
WRITE (TE_MODE,6)
WRITE (TE_LOOP,6)
WRITE (TE_INDEX,6)
WRITE (TE_FLAGS,6)
NEWLINE
PTR = TE_CHAIN
%REPEAT
!
%END;! PRINTTE
!
!
!
!
%ROUTINE PRINTDT
!
!**************************************************************************
!* PRINT CONTENTS OF DESCRIPTOR TEMPORARIES TABLE. *
!**************************************************************************
!
%RECORD (DTRECF) %NAME DT
!
%INTEGER PTR
!
NEWLINE
NEWLINE
PRINTSTRING ("DESCRIPTOR TEMPORARIES TABLE")
NEWLINE
PRINTSTRING (" MODE IDENT FLAGS INDEX LOOP")
NEWLINE
PTR = DESTEMPHEAD
%WHILE PTR # 0 %CYCLE
DT == RECORD (ADICT + PTR<<DSCALE)
WRITE (DT_MODE,6)
WRITE (DT_IDENT,6)
WRITE (DT_FLAGS,6)
WRITE (DT_INDEX,6)
WRITE (DT_LOOP,6)
NEWLINE
PTR = DT_CHAIN
%REPEAT
!
%END;! PRINTDT
!
%END;! OP3
!
!
!
!
%INTEGERFUNCTION CREATETE (%INTEGER M)
!
!********************************************************************
!* CREATE A VALTEMP ENTRY AND FILL IN THE EASY FIELDS. *
!********************************************************************
!
%INTEGER TEADDR
!
%RECORD (RESF) TEPTR
%RECORD (TERECF) %NAME TE
!
TEADDR = CREATEDTAB (TESZ)
TE == RECORD (ADICT + TEADDR)
TEADDR = TEADDR >> DSCALE
TE_CHAIN = 0
%UNLESS VALTEMPHEAD=0 %THEN TECH=TECH+ADICT
INTEGER (TECH) = TEADDR
TECH = ADDR (TE_CHAIN)-ADICT
TEPTR_H0 = TEADDR
TEPTR_FORM = VALTEMP
TEPTR_MODE = M
TE_DISP1 = 0
TE_INDEX = TEINDEX
TEINDEX = TEINDEX + 1
TE_MODE = M
TE_LOOP=LOOP
TE_FLAGS=0
%RESULT = TEPTR_W
!
%END;! CREATETE
!
!
!
!
%INTEGERFUNCTION CREATEDT (%INTEGER M)
!
!********************************************************************
!* CREATE A DESTEMP ENTRY AND FILL IN THE EASY FIELDS. *
!********************************************************************
!
%INTEGER DTADDR
!
%RECORD (RESF) DTPTR
%RECORD (DTRECF) %NAME DT
!
DTADDR = CREATEDTAB (DTSZ)
DT == RECORD (ADICT + DTADDR)
DTADDR = DTADDR >> DSCALE
DT_CHAIN = 0
%UNLESS DESTEMPHEAD=0 %THEN DTCH=DTCH+ADICT
INTEGER (DTCH) = DTADDR
DTCH = ADDR (DT_CHAIN)-ADICT
DTPTR_H0 = DTADDR
DTPTR_FORM = DESTEMP
DTPTR_MODE = M
DT_DISP2 = 0
DT_INDEX = DTINDEX
DTINDEX = DTINDEX + 1
DT_MODE = M
DT_LOOP=LOOP
DT_FLAGS=0
%RESULT = DTPTR_W
!
%END;! CREATEDT
!
!
!
%INTEGERFUNCTION CHAFTER (%INTEGER TR)
!
!*************************************************************************
!* CHAINS A NEW TRIAD INTO THE TEXT BETWEEN THE GIVEN TRIAD AND ITS *
!* SUCCESSOR. RETURNS POINTER TO THE NEW TRIAD. *
!*************************************************************************
!
%INTEGER CHAIN,NEW
!
%RECORD (TRIADF) %NAME TT
!
TT == RECORD (ATRIADS + TR * TRIADLENGTH)
CHAIN = TT_CHAIN
NEW = GETTRIAD
TT_CHAIN = NEW
TT == RECORD (ATRIADS + NEW * TRIADLENGTH)
TT_CHAIN = CHAIN
%RESULT = NEW
!
%END;! CHAFTER
!
!
!
!
%ROUTINE ELIM (%INTEGER TR)
!
!***************************************************************************
!* REDUCE THE USE CT OF A REPL OR REF TRIAD BY ONE. IF USE CT IS NOW *
!* ZERO SET OPERATOR TO NULL, ELSE IF OPD 1 IS A TRIAD INCREASE ITS USE *
!* CT BY ONE. *
!***************************************************************************
!
%RECORD (TRIADF) %NAME TT
!
TT == RECORD (ATRIADS + TR * TRIADLENGTH)
TT_USE = TT_USE - 1
%IF TT_USE = 0 %THEN TT_OP = NULL %C
%ELSEIF TT_QOPD1 & TEXTMASK # 0 %THENSTART
TT == RECORD (ATRIADS + TT_OPD1 * TRIADLENGTH)
TT_USE = TT_USE + 1
%FINISH
!
%END;! ELIM
!
!
!
!
%INTEGERFUNCTION ARBASE (%RECORD (RESF) OPD)
!
!*************************************************************************
!* FINDS THE BASE ARRAY OF AN ARRAY ACCESSING FORM. *
!*************************************************************************
!
%INTEGER FORM,H0
!
%RECORD (TRIADF) %NAME TT
%RECORD (DTRECF) %NAME DT
!
FORM = OPD_FORM
H0 = OPD_H0
%CYCLE
%IF FORM & IDMASK # 0 %THEN %RESULT = H0
%IF FORM = DESTEMP %THENSTART
DT == RECORD (ADICT + H0 << DSCALE)
%RESULT = DT_IDENT
%FINISH
!* ELSE MUST BE TEXT PTR SO REPEAT PROCESS.
TT == RECORD (ATRIADS + H0 * TRIADLENGTH)
FORM = TT_QOPD1
H0 = TT_OPD1
%REPEAT
!
%END;! ARBASE
!
!
!*
!***********************************************************************
!* *
!***********************************************************************
!* *
!* T E X T P A S S *
!* *
!***********************************************************************
!* *
!***********************************************************************
!*
!
! 1/12/82 - INSERTED LINE 951 IN INCRTR & CHANGED BTEMP
!
!
!
%EXTERNALROUTINE TEXTPASS (%INTEGER BREGTEMP)
!
!
%ROUTINESPEC BLOKCHAIN
%INTEGERFUNCTIONSPEC GETNEXT
%INTEGERFUNCTIONSPEC OPND (%RECORD (RESF) OP,%INTEGER BUSE)
%ROUTINESPEC INITTR
%ROUTINESPEC INCRTR
%ROUTINESPEC ASMTCH
%ROUTINESPEC ARRTR
%ROUTINESPEC ARGCH
%ROUTINESPEC REDUSE (%RECORD (RESF) OP)
%ROUTINESPEC KEEPB (%INTEGER TR)
%ROUTINESPEC RESETB (%INTEGER TR)
%ROUTINESPEC BTEMP (%INTEGER BL)
%ROUTINESPEC RESARGS (%INTEGER TR)
%ROUTINESPEC CRENT
%INTEGERFUNCTIONSPEC BRDUMP(%INTEGER SRTEMP)
%INTEGERFUNCTIONSPEC OUTBLOCK (%INTEGER TR)
%INTEGERFUNCTIONSPEC BREGOPN (%RECORD (RESF) OP)
%ROUTINESPEC PRESVAL (%INTEGER TR)
%INTEGERFUNCTIONSPEC DTDUPL (%INTEGER DPTR)
%INTEGERFNSPEC TRSPEC(%RECORD(RESF) R)
%ROUTINESPEC CHECKBBOEX
!
!* DIVIDE OPERATIONS INTO 23 CATEGORIES TO DRIVE TEXT PASSES.
%CONSTBYTEINTEGERARRAY OPCAT (0:116) = %C
0, 0, 7, 7,
{ NULL (01) ADD SUB
7, 7, 3, 12,
{ MULT DIV NEG ASMT
5, 15, 0, 0,
{ CVT ARR ARR1 BOP
8, 7, 22, 7,
{ ASGN (0D) EXP EXP3
7, 0, 3, 7,
{ AND OR NOT EQUIV
7, 7, 7, 7,
{ NEQ GT LT NE
7, 7, 7, 7,
{ EQ GE LE SUBSTR
27, 27, 27, 0,
{ CHAR CONCAT CHHEAD (1F)
0, 0, 0, 0,
{ STOD1 STOD2 STODA (23)
0, 0, 0, 0,
{ EOD1 EOD2 EODA EODB
20, 15, 7, 7,
{ BRK DEFARR RSUB RDIV
1, 7, 0, 0,
{ DCHAR ASH (2E) (2F)
21, 13, 1, 24,
{ STRTIO IOITEM IODO IOSPEC
21, 13, 0, 0,
{ IO DIOITEM (36) (37)
0, 15, 17, 16,
{ (38) ARGARR INIT INCR
16, 18, 16, 0,
{ DECR DINIT PINCR (3F)
0, 10, 9, 11,
{ NOOP FUN SUBR ARG,
0, 0, 9, 10,
{ STRTSF ENDSF CALLSF IFUN,
11, 11, 1, 20,
{ DARG IARG REPL REF,
1, 19, 23, 0,
{ LOADB STOREB MOO (4F)
6, 6, 6, 6,
{ JIT JIF JINN JINP,
6, 6, 6, 6,
{ JINZ JIN JIP JIZ,
4, 14, 2, 1,
{ CGT GOTO RET STOP,
21, 1, 25, 25,
{ PAUSE EOT NINT ANINT
1, 0, 1, 7,
{ STMT ITS PA TOCHAR
7, 7, 25, 7,
{ DIM DMULT AINT ABS
26, 7, 7, 7,
{ MOD SIGN MIN MAX
7, 7, 7, 7,
{ REALL IMAG CMPLX CONJG
7, 7, 7, 7,
{ LEN ICHAR CHIND DCMPLX
10
{ INTRIN
!
%CONSTBYTEINTEGERARRAY CORRUPTB(0:29) = %C
0,0,0,0,0, 1,0,0,0,1, 1,0,0,1,0, 0,0,0,0,0, 0,1,1,1,0, 1,1,0,0,0
!
!
%RECORDFORMAT EXRECF (%HALFINTEGER TRIAD,USES)
!
%RECORD (EXRECF) %NAME EX
%RECORD (SREDF) %NAME SR
%RECORD (BLRECF) %NAME BB,BB1
%RECORD (TRIADF) %NAME TT,TT1
%RECORD (CONRECF) %NAME CN
%RECORD (CLOOPRECF) %NAME CL
%RECORD (DTRECF) %NAME DT
!
%RECORD (RESF) BREGOP
!
%CONSTINTEGER BBOEXBIT = X'04'
%CONSTINTEGER BUSEDBIT = X'02'
%CONSTINTEGER BUSEDORBOE = X'06'
%CONSTINTEGER NOTBBOEX = X'FB'
!
%INTEGER DLOOPPTR,START,LASTBUT1,INITB,BEFBUSE,LASTBUSE,BNEEDED,BUSED
%INTEGER BBOEXIT,BCORRUPT,OLDDTCH,BLOCK,I,SAVEB,EXTNSTART,EXTNEND
%INTEGER BLOADED,BSAVED
!
!**************************************************************************
!* PROCESSES THE TEXT FOR EACH BLOCK IN THE CURRENT LOOP, INCLUDING *
!* CONTROLLING THE B REGISTER OVER THE LOOP. *
!**************************************************************************
!
BREGOP_FORM = BREG
BREGOP_MODE = INT4
BREGOP_H0 = 0
SAVEB = 0
BLOADED=1
BSAVED=0
BBOEXIT=1
DLOOPPTR = DLOOPHEAD
!* PROCESS EACH BLOCK IN LOOP.
%WHILE DLOOPPTR # 0 %CYCLE
CL == RECORD (ATABS + DLOOPPTR)
BLOCK = CL_BLOCK
BB == RECORD (ABLOCKS + BLOCK * BLSIZE)
START = BB_TEXT
CN == RECORD (ATABS + BB_FCON)
!* TEST WHETHER THIS BLOCK IS THE BACK TARG OF AN INNER LOOP, SINCE
!* INNER LOOPS CAN CORRUPT B-REG.
BCORRUPT = 0
%IF BBOEXIT=0 %THEN BLOADED=0 %ELSE BLOADED=1
%IF CN_COUNT # 0 %AND CN_BLOCK(1) # 0 %THENSTART
BB1 == RECORD (ABLOCKS + CN_BLOCK(1) * BLSIZE)
%IF BB1_DEPTH > LOOPDEPTH %THENSTART
BCORRUPT = BB1_TEXT
SAVEB = 1
%FINISH
%FINISH
BLOKCHAIN
DLOOPPTR = CL_PDCHAIN
%REPEAT
!* IF B-REG HAS BEEN CORRUPTED IN LOOP, & SHOULD CONTAIN AN SR-TEMP,
!* MAKE SURE THAT 1ST USE OF B-REG IN EACH BLOCK IS OK, & PUT STOREB
!* TRIADS AFTER INIT, INCRS & DECRS.
%IF SAVEB # 0 %AND BREGTEMP # 0 %THENSTART
CHECKBBOEX
DLOOPPTR = DLOOPHEAD
%WHILE DLOOPPTR # 0 %CYCLE
CL == RECORD (ATABS + DLOOPPTR)
BTEMP (CL_BLOCK)
DLOOPPTR = CL_PDCHAIN
%REPEAT
SR == RECORD (ABLOCKS + BREGTEMP << SRSCALE)
KEEPB (SR_INIT)
%FOR I = 1,1,3 %CYCLE
%IF SR_INCR(I) # 0 %THEN KEEPB (SR_INCR(I))
%REPEAT
%FINISH
!
!
!
!
%ROUTINE BLOKCHAIN
!
!***************************************************************************
!* REORDERS & OPTIMISES TEXT IN THE GIVEN BLOCK, INCLUDING CONTROLLING THE *
!* B REGISTER. *
!***************************************************************************
!
%INTEGER PTR,CAT
!
%SWITCH PASS1(0:29),PASS2(0:29),PASS3(0:29)
!
LASTBUT1 = 0
INITB = 0
BEFBUSE = 0
LASTBUSE = 0
BNEEDED = 0
BUSED = 0
BBOEXIT = 0
%IF SAVEB#0 %THENSTART
BLOADED=0
BCORRUPT=1
%FINISH
!
!* PASS 1. USES OF REF REPL ETC RESOLVED. ALL USES OF TEMPS TIDIED UP.
CURRTRIAD = START
%WHILE GETNEXT = 1 %CYCLE
TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
CAT = OPCAT (TT_OP)
-> PASS1 (CAT)
!
PASS1(0):
! NEWLINE
! NEWLINE
! PRINTSTRING ("ERROR: OPERATOR VALUE ")
! WRITE (TT_OP,3)
! NEWLINE
PASS1(1):
PASS1(27): !* CHAR
-> PASS1END
PASS1(2):PASS1(3):PASS1(8):
TT_RES1_W = OPND (TT_RES1,2)
-> PASS1END
PASS1(4): !* CGT
TT_RES1_W = OPND (TT_RES1,2)
->CHECKB
PASS1(5):
TT_RES2_W = OPND (TT_RES2,2)
%IF TT_MODE<=INT8 %AND TT_MODE2>TT_MODE %THEN ->CHECKB
-> PASS1END
PASS1(6): !* JIT JIP JINN JINP JINZ JIN JIP JIZ
PASS1(7): !* MULT DIV DMULT EXP3 AND OR EQUIV NEQ GT LT NE EQ GE LE RSUB RDIV
!* ASH
TT_RES1_W = OPND (TT_RES1,2)
TT_RES2_W = OPND (TT_RES2,2)
-> PASS1END
PASS1(19): !* STOREB
BSAVED = 1
-> PASS1END
PASS1(22): !* EXP
TT_RES1_W = OPND(TT_RES1,2)
TT_RES2_W = OPND(TT_RES2,2)
->CHECKB
PASS1(23): !* MOO
TT_RES2_W=OPND(TT_RES2,2)
->CHECKB
PASS1(26): !* MOD
TT_RES1_W=OPND(TT_RES1,2)
PASS1(25): !* NINT ANINT AINT
TT_RES2_W = OPND (TT_RES2,2)
->CHECKB
PASS1(9): !* SUBR
PASS1(10): !* FUN IFUN
ARGCH
PASS1(21): ! STRTIO IO
CHECKB:
%IF BLOADED#0 %AND BSAVED=0 %AND BREGTEMP#0 %THENSTART
! KEEPB(PREVTRIAD)
SAVEB=1
BSAVED=1
%FINISH
BCORRUPT=1
BLOADED=0
-> PASS1END
PASS1(11): !* ARG DARG IARG
ARGCH
TT_RES1_W = OPND (TT_RES1,2)
DUMPB:%IF TT_QOPD1 = BREG %THENSTART
! %IF BSAVED=0 %THEN KEEPB(PREVTRIAD)
BCORRUPT=1
SAVEB=1
TT_OPD1 = BRDUMP(BREGTEMP)
TT_QOPD1 = VALTEMP
BSAVED=1
BLOADED=0
%FINISH
%IF CAT=13 %THEN ->CHECKB;! for IOITEM, DIOITEM
-> PASS1END
PASS1(12):
TT_RES1_W = OPND (TT_RES1,1)
TT_RES2_W = OPND (TT_RES2,2)
ASMTCH
-> PASS1END
PASS1(13): !* IOITEM DIOITEM
TT_RES1_W=OPND (TT_RES1,1)
%IF BLOADED#0 %AND BSAVED=0 %AND BREGTEMP#0 %THENSTART
! KEEPB(PREVTRIAD)
BCORRUPT=1
SAVEB=1
BLOADED=0
BSAVED=1
%FINISH
->DUMPB
PASS1(14):
LASTBUT1 = PREVTRIAD
TT_RES1_W = OPND (TT_RES1,2)
-> PASS1END
PASS1(15):
ARRTR
-> PASS1END
PASS1(16):
INCRTR
-> PASS1END
PASS1(17):
TT_RES2_W = OPND (TT_RES2,2)
INITTR
-> PASS1END
PASS1(18):
TT_RES2_W = OPND (TT_RES2,2)
DT == RECORD (ADICT + TT_OPD1 << DSCALE)
DT_LOOP = LOOP
-> PASS1END
PASS1(20):
TT_OP = REPL
->PASS1END
!
PASS1(24): !* IOSPEC
TT_RES1_W=OPND (TT_RES1,1)
!
PASS1END:
%REPEAT
!* IF AN INIT TRIAD HAS BEEN FOUND, CHAIN IT NEAR THE END OF THE BLOCK
!* (BUT BEFORE GOTO IF PRESENT).
%UNLESS INITB = 0 %THENSTART
TT == RECORD (ATRIADS + INITB * TRIADLENGTH)
TT1 == RECORD (ATRIADS + TT_CHAIN * TRIADLENGTH)
%IF TT1_OP = STOREB %THEN TT == TT1
%IF LASTBUT1 = 0 %THEN %C
TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH) %C
%ELSE TT1 == RECORD (ATRIADS + LASTBUT1 * TRIADLENGTH)
TT_CHAIN = TT1_CHAIN
TT1_CHAIN = INITB
%FINISH
!
!* BLOCK-LEVEL DIAGNOSTICS:
%IF SRFLAGS & 64 # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING ("BLOCK AFTER OP3B PASS 1")
NEWLINE
PRBLOCK (BLOCK)
PRBLTRIADS (BLOCK)
%FINISH
!
!* PASS 2. SET UP A TEXT EXTENSION TABLE TO ANALYSE USE CTS TO DETECT
!* OUT-OF-BLOCK REFS.
EXTNSTART = FREETABS
EXTNEND = EXTNSTART - EXTNSIZE
CURRTRIAD = START
%WHILE GETNEXT = 1 %CYCLE
TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
-> PASS2 (OPCAT (TT_OP))
!
PASS2(0):PASS2(20):
! NEWLINE
! NEWLINE
! PRINTSTRING ("ERROR: OPERATOR VALUE ")
! WRITE (TT_OP,3)
! NEWLINE
PASS2(1):PASS2(8):PASS2(14):PASS2(16):PASS2(19):PASS2(21):
-> PASS2END
PASS2(2):PASS2(4):PASS2(6):PASS2(13):PASS2(24):
REDUSE (TT_RES1)
-> PASS2END
PASS2(9): !* SUBR
PASS2(17):PASS2(18):
PASS2(23): !* MOO
PASS2(27): !* CHAR
REDUSE (TT_RES2)
-> PASS2END
PASS2(12):
REDUSE (TT_RES1)
REDUSE (TT_RES2)
-> PASS2END
PASS2(3):
REDUSE (TT_RES1)
CRENT
-> PASS2END
PASS2(5):PASS2(10):PASS2(25):
REDUSE (TT_RES2)
CRENT
-> PASS2END
PASS2(7):PASS2(11):PASS2(15):PASS2(22):PASS2(26):
REDUSE (TT_RES1)
REDUSE (TT_RES2)
CRENT
!
PASS2END:
%REPEAT
!
!* SCAN THRO' TEXT EXTN TABLE LOOKING FOR TRIADS WHICH HAVE OUTSTANDING
!* USES, & STORE THEM IN TEMPS.
%FOR PTR = EXTNSTART,EXTNSIZE,EXTNEND %CYCLE
EX == RECORD (ATABS + PTR)
%UNLESS EX_USES = 0 %THENSTART
TT == RECORD (ATRIADS + EX_TRIAD * TRIADLENGTH)
%IF TT_OP =ARG %OR TT_OP = DARG %OR TT_OP = IARG %C
%THEN RESARGS (EX_TRIAD) %C
%ELSE PRESVAL (EX_TRIAD)
%FINISH
%REPEAT
FREETABS = EXTNSTART
!
BB_FLAGS=BB_FLAGS!BUSED
BB_CORRUPT = BCORRUPT
%IF BCORRUPT = 0 %AND BLOADED # 0 %THENSTART
BB_FLAGS = BB_FLAGS ! BBOEXBIT
BBOEXIT=1
%FINISH
!
!* BLOCK-LEVEL DIAGNOSTICS:
%IF SRFLAGS & 64 # 0 %THENSTART
NEWLINE
NEWLINE
PRINTSTRING ("BLOCK AFTER OP3B PASS 2")
NEWLINE
PRBLOCK (BLOCK)
PRBLTRIADS (BLOCK)
%FINISH
!
CURRTRIAD = START
%WHILE GETNEXT=1 %CYCLE
TT==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
->PASS3 (OPCAT (TT_OP))
!
PASS3(0):PASS3(20):
PASS3(1):PASS3(8):PASS3(14):PASS3(16):PASS3(19):PASS3(21):PASS3(27):
-> PASS3END
PASS3(2):PASS3(4):PASS3(6):PASS3(13):PASS3(24):
TT_QOPD1 = TRSPEC (TT_RES1)
-> PASS3END
PASS3(9): !* SUBR
PASS3(17):PASS3(18):
PASS3(23): !* MOO
TT_QOPD2 = TRSPEC (TT_RES2)
-> PASS3END
PASS3(12):
TT_QOPD1 = TRSPEC (TT_RES1)
TT_QOPD2 = TRSPEC (TT_RES2)
-> PASS3END
PASS3(3):
TT_QOPD1 = TRSPEC (TT_RES1)
-> PASS3END
PASS3(5):PASS3(10):PASS3(25):
TT_QOPD2 = TRSPEC (TT_RES2)
-> PASS3END
PASS3(7):PASS3(11):PASS3(15):PASS3(22):PASS3(26):
TT_QOPD1 = TRSPEC (TT_RES1)
TT_QOPD2 = TRSPEC (TT_RES2)
!
PASS3END:
%REPEAT
!
%END;! BLOKCHAIN
!
!
!
!
%INTEGERFUNCTION OPND (%RECORD (RESF) OP,%INTEGER BUSE)
!
!**************************************************************************
!* CHECKS WHETHER OPERAND REFERS TO A SR-TEMP OR REPL OR REF, & CHANGES *
!* ACCORDINGLY. *
!* BUSE = 1 POTENTIAL DEFINING OF BREG *
!* 2 POTENTIAL USE OF BREG *
!* 3 MODIFICATION OF BREG *
!* 6 subscript to array el - avoid replacing by destemp *
!**************************************************************************
!
%INTEGER NEWTR,OPD
!
%RECORD (PRECF) %NAME DD
%RECORD (TRIADF) %NAME TT,TT1
!
%RECORD (RESF) TEPTR,WOPD
!
WOPD = OP
%CYCLE
OPD = WOPD_H0
%IF WOPD_FORM & TEXTMASK = 0 %THEN %EXIT
TT == RECORD (ATRIADS + OPD * TRIADLENGTH)
%IF BUSE=6 %THENSTART;! array element - check for dt
BUSE=2
%IF TT_OP=REPL %AND TT_QOPD1=DESTEMP %THEN ->L
%FINISH
%IF TT_OP = REF %THENSTART
!* REPLACE REF TRIAD BY ASMT-TO-TE & REPL-TO-TE.
TT_OP = REPL
%IF TT_QOPD1 & IDMASK # 0 %THENSTART
DD == RECORD (ADICT + TT_OPD1 << DSCALE)
%IF DD_CLASS & CMNBIT # 0 %THENSTART
L: TEPTR_W = CREATETE (TT_MODE)
NEWTR = CHAFTER (OPD)
TT1 == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
TT1_OP = ASMT
TT1_RES1 = TEPTR
TT1_RES2 = TT_RES1
TT_RES1 = TEPTR
%FINISH
%FINISH
%FINISHELSEUNLESS TT_OP = REPL %OR TT_OP = BRK %THENSTART
!* IF TRIAD IS OUT-OF-BLOCK, MUST PRESERVE IN A TEMP.
%IF OUTBLOCK (OPD) = 0 %THEN %RESULT = WOPD_W %C
%ELSE PRESVAL (OPD)
%FINISH
!* REPLACE REF TO REPL OR BRK TRIAD BY THEIR OPD1, & TRY AGAIN.
ELIM (OPD)
WOPD = TT_RES1
%REPEAT
!* REFERENCES TO SR-TEMP ARE REPLACED BY B-REG, IF VALID FOR THIS LOOP,
!* OR A SUITABLE VALTEMP.
%IF WOPD_FORM = SRTEMP %THENSTART
%IF OPD = BREGTEMP %THENSTART
BUSED = BUSEDBIT
%UNLESS BUSE=1 %THENSTART;! unless defining only
%IF BLOADED=0 %THENSTART
RESETB(PREVTRIAD)
BSAVED=1
%FINISH
BLOADED=1
%FINISH
%UNLESS BUSE=2 %THEN BSAVED=0
%RESULT = BREGOP_W
%FINISH
WOPD_H0 = BRDUMP(OPD)
WOPD_FORM = VALTEMP
%RESULT = WOPD_W
%FINISH
! %IF WOPD_FORM & IDMASK # 0 %THENSTART
!
!* CODE REQUIRED HERE TO OPTIMISE THE ACCESSING OF COMMON ITEMS IN LOOPS
!* (EITHER BY DESCRIPTOR OR BY XNB OR CTB).
!
! %FINISH
%RESULT = WOPD_W
!
%END;! OPND
!
!
!
!
%ROUTINE ARGCH
!
!***********************************************************************
!* PROCESSES OUT-OF-BLOCK ARGUMENT CHAIN. *
!***********************************************************************
!
%INTEGER CHARG,NEWTR
!
%RECORD (TRIADF) %NAME TT,TT1
!
TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
%WHILE TT_QOPD2 # NULL %CYCLE
CHARG = TT_OPD2
TT1 == RECORD (ATRIADS + CHARG * TRIADLENGTH)
%UNLESS TT1_OP = REPL %OR TT1_OP = BRK %THENSTART
%IF OUTBLOCK (CHARG) = 0 %THEN %EXIT
!* IF ARG IS OUT-OF-BLOCK, BRING A COPY INTO THIS BLOCK, ADJUSTING
!* USE-CTS ACCORDINGLY.
NEWTR = CHAFTER (PREVTRIAD)
TT_OPD2 = NEWTR
TT == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
TT_RES1=TT1_RES1
TT_RES2=TT1_RES2
TT_OP=TT1_OP
TT_USE=1
%IF TT1_USE # 1 %AND TT1_QOPD1 & TEXTMASK # 0 %THENSTART
TT == RECORD (ATRIADS + TT1_OPD1 * TRIADLENGTH)
TT_USE = TT_USE + 1
%FINISH
TT == RECORD (ATRIADS + NEWTR * TRIADLENGTH)
TT_RES1_W = OPND (TT_RES1,2)
%IF TT_QOPD1 = BREG %THENSTART
TT_OPD1 = BRDUMP(BREGTEMP)
TT_QOPD1 = VALTEMP
%FINISH
%FINISHELSESTART
TT_OPD2 = TT1_OPD2
%FINISH
ELIM (CHARG)
!* LOOP BACK TO CONSIDER NEXT ARG, IF ANY.
%REPEAT
!
%END;! ARGCH
!
!
!
!
%ROUTINE ASMTCH
!
!**********************************************************************
!* RECHAINS ASMT-TO-TE TRIADS. *
!**********************************************************************
!
%RECORD (TERECF) %NAME TE
!
%INTEGER CHAIN
!
%IF TT_QOPD1 = VALTEMP %THENSTART
TE == RECORD (ADICT + TT_OPD1 << DSCALE)
TE_LOOP = LOOP
%IF TT_QOPD2 & TEXTMASK # 0 %THENSTART
TT1 == RECORD (ATRIADS + TT_OPD2 * TRIADLENGTH)
CHAIN = TT1_CHAIN
%UNLESS CHAIN = CURRTRIAD %THENSTART
!* RECHAIN ASMT TRIAD AFTER OPD2 TRIAD.
TT1_CHAIN = CURRTRIAD
TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
TT1_CHAIN = TT_CHAIN
TT_CHAIN = CHAIN
CURRTRIAD=PREVTRIAD;! to avoid looping if same text assigned to several Valtemps
%FINISH
%FINISH
%FINISH
!
%END;! ASMTCH
!
!
%ROUTINE ARRTR
!
!**************************************************************************
!* PROCESSES SUBSCRIPTION TRIADS. REPLACES BY D-TEMPS IF SUBSCRIPT IS *
!* CONSTANT & ARRAY IS NOT A DUMMY ARGUMENT. *
!**************************************************************************
!
%RECORD (PRECF) %NAME DD
%RECORD (DTRECF) %NAME DT
!
%RECORD (RESF) DTPTR
!
%IF TARGET=ICL2900 %AND TT_QOPD2 & CONSTMASK # 0 %AND %C
TT_MODE#CHARMODE %AND TT_QOPD1 & IDMASK # 0 %THENSTART
DD == RECORD (ADICT + TT_OPD1 << DSCALE)
%UNLESS DD_CLASS & 1 # 0 %THENSTART
OLDDTCH = DTCH
DTPTR_W = CREATEDT (TT_MODE)
DT == RECORD (ADICT + DTPTR_H0 << DSCALE)
DT_CONST = TT_RES2
DT_FLAGS = INITLOADBIT
%IF TT_OP = ARGARR %AND %C
(TT_MODE = CHARMODE %OR TT_MODE = INT2) %THENSTART
DT_FLAGS = INITLOADBIT ! ACTARGBIT
%FINISH
TT_OP = REPL
DT_IDENT = TT_OPD1
DTPTR_H0 = DTDUPL (DTPTR_H0);! REMOVE DUPLICATE IF PRESENT.
TT_RES1 = DTPTR
%FINISH
%FINISHELSESTART ;! no benefit on other systems
TT_RES2_W = OPND (TT_RES2,6)
%FINISH
TT_RES1_W = OPND (TT_RES1,2)
!
%END;! ARRTR
!
!
!
%ROUTINE INCRTR
!
!************************************************************************
!* IF OPND1 IS SR-TEMP (I.E. WILL BE B-REG), AND FOLLOWING TRIAD IS *
!* ALSO INCR, SWAP THEM. *
!* IF OPND1 IS D-TEMP, CHAIN AFTER LAST USE. *
!************************************************************************
!
%INTEGER TRID,USETRID
!
%RECORD (RESF) OPD1
!
%IF TT_QOPD1 = SRTEMP %THENSTART
%IF BLOADED=0 %THEN RESETB(PREVTRIAD)
BLOADED=1
BSAVED=0
%CYCLE
TRID = TT_CHAIN
TT1 == RECORD (ATRIADS + TRID * TRIADLENGTH)
%IF TT1_OP # NULL %THEN %EXIT
TT_CHAIN = TT1_CHAIN
TT1_CHAIN = FREETRIADS
FREETRIADS = TRID
%REPEAT
%UNLESS TT1_OP = INCR %OR TT1_OP = DECR %THEN -> L1
TT_CHAIN = TT1_CHAIN
TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
TT1_CHAIN = CURRTRIAD
TT_CHAIN = TRID
CURRTRIAD = TRID
TT == TT1
%FINISH
%IF TT_QOPD1 # DESTEMP %THEN -> L1
!* TRIAD INCREMENTS A DESCRIPTOR. CHAIN AFTER LAST USE, OR LAST IFUN
!* (IF ANY), IN THIS BLOCK.
USETRID = 0
OPD1 = TT_RES1
TRID = START
TT1 == RECORD (ATRIADS + TRID * TRIADLENGTH)
%CYCLE
TRID = TT1_CHAIN
%IF TRID = CURRTRIAD %THEN %EXIT
TT1 == RECORD (ATRIADS + TRID * TRIADLENGTH)
%UNLESS TT1_RES1_W = OPD1_W %OR TT1_RES2_W = OPD1_W %THENSTART
%UNLESS TT1_OP = IFUN %OR TT1_OP=FUN %C
%OR TT1_OP=MOO %OR TT1_OP=SUBR %THEN %CONTINUE
%FINISHELSESTART
%IF TT1_OP = STMT %OR TT1_OP = REPL %OR TT1_OP = NULL %C
%THEN %CONTINUE
%FINISH
USETRID = TRID
%REPEAT
TT1==RECORD(ATRIADS+USETRID*TRIADLENGTH)
%UNLESS USETRID = 0 %OR TT1_OP = ARR %C
%OR TT1_OP = DEFARR %OR TT1_OP = ARGARR %C
%OR TT1_CHAIN = CURRTRIAD %THENSTART
TRID = TT_CHAIN
TT_CHAIN = TT1_CHAIN
TT1_CHAIN = CURRTRIAD
TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
TT1_CHAIN = TRID
TT_OP = PINCR
TT_RES2_W = OPND (TT_RES2,2)
TT_RES1_W = OPND (TT_RES1,1)
CURRTRIAD = PREVTRIAD
%FINISHELSESTART
L1: TT_RES2_W = OPND (TT_RES2,2)
TT_RES1_W = OPND (TT_RES1,1)
%FINISH
!
%END
!
!
!
!
%ROUTINE INITTR
!
!**********************************************************************
!* REMOVES INIT TRIAD (TOGETHER WITH FOLLOWING STOREB IF PRESENT), *
!* FOR CHAINING IN AT END OF BLOCK. *
!**********************************************************************
!
%INTEGER CHAIN
!
%RECORD (TERECF) %NAME TE
!
INITB = CURRTRIAD
CHAIN = TT_CHAIN
TT1 == RECORD (ATRIADS + CHAIN * TRIADLENGTH)
%IF TT1_OP = STOREB %THENSTART
TE == RECORD (ADICT + TT1_OPD1 << DSCALE)
TE_LOOP = LOOP
CHAIN = TT1_CHAIN
%FINISH
TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
TT_CHAIN = CHAIN
CURRTRIAD = PREVTRIAD
!
%END;! INITTR
!
!
!
!
%INTEGERFUNCTION BRDUMP(%INTEGER BREGTEMP)
!
!*****************************************************************************
!* FINDS OR CREATES A VALTEMP ENTRY IN WHICH TO SAVE THE VALUE OF THE *
!* SR-TEMP MAPPED ONTO B-REG. *
!*****************************************************************************
!
%RECORD (SREDF) %NAME SR
%RECORD (RESF) TEPTR
!
%RECORD (TERECF) %NAME TE
!
SR == RECORD (ABLOCKS + BREGTEMP << SRSCALE)
%IF SR_DUMP # 0 %THEN %RESULT = SR_DUMP
TEPTR_W = CREATETE (INT4)
TE == RECORD (ADICT + TEPTR_H0 << DSCALE)
TE_FLAGS = SRTEMPBIT
SR_DUMP = TEPTR_H0
%RESULT = TEPTR_H0
!
%END;! BRDUMP
!
!
!
!
%INTEGERFUNCTION OUTBLOCK (%INTEGER TR)
!
!***********************************************************************
!* DECIDES IF GIVEN TRIAD IS DEFINED OUTSIDE CURRENT BLOCK. *
!* IF SO RETURNS 1, ELSE 0. *
!***********************************************************************
!
%INTEGER TRID
!
%RECORD (TRIADF) %NAME TT
!
TRID = START
%CYCLE
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
TRID = TT_CHAIN
%IF TRID = TR %THEN %RESULT = 0
%IF TRID = CURRTRIAD %THEN %RESULT = 1
%REPEAT
!
%END;! OUTBLOCK
!
!
!
!
%ROUTINE PRESVAL (%INTEGER TR)
!
!***********************************************************************
!* SAVES INPUT EXPRESSION IN A VALTEMP OR DESTEMP ENTRY, IF NECESSARY. *
!***********************************************************************
!
%INTEGER MODE,FLAG,DICT,NEWTR1,NEWTR2,NEWOP,CHAIN
!
%RECORD (RESF) QTEMP
%RECORD (TRIADF) %NAME TT,TT1,TT2
%RECORD (PRECF) %NAME DD
%RECORD (DTRECF) %NAME DT
%RECORD (TERECF) %NAME TE
!
TT == RECORD (ATRIADS + TR * TRIADLENGTH)
MODE = TT_MODE
%IF TT_OP = ARGARR %THENSTART
%IF MODE = INT2 %OR MODE = CHARMODE %THEN FLAG = ACTARGBIT %C
%ELSE FLAG = 0
-> L1
%FINISHELSEIF TT_OP = DEFARR %OR (TT_OP = ARR %AND MODE = CHARMODE) %C
%THENSTART
FLAG = 0
!* IF EXPRESSION IS A SUBSCRIPTION, EITHER AS LHS OF ASMT, OR AS ACT ARG,
!* OR CHAR, WE NEED A DESCRIPTOR, SO SAVE IN A DESTEMP.
L1: DICT = ARBASE (TT_RES1)
OLDDTCH = DTCH
QTEMP_W = CREATEDT (MODE)
DT == RECORD (ADICT + QTEMP_H0 << DSCALE)
DT_LOOP = 0
DT_FLAGS = FLAG
DT_IDENT = DICT
NEWOP = DINIT
!* CHECK IF DESTEMP SUITABLE FOR GENERATION BY LOADER.
%IF TT_QOPD2 & CONSTMASK # 0 %AND TT_QOPD1 & IDMASK # 0 %THENSTART
DD == RECORD (ADICT + TT_OPD1 << DSCALE)
%IF DD_CLASS & 1 = 0 %THENSTART
FLAG = FLAG ! INITLOADBIT
DT_FLAGS = FLAG
DT_CONST = TT_RES2
QTEMP_H0 = DTDUPL (QTEMP_H0);! REMOVE DUPLICATE IF PRESENT.
-> L2
%FINISH
%FINISH
%FINISHELSESTART
!* NOT SUITABLE FOR DESTEMP, SO STORE IN A VALTEMP.
QTEMP_W = CREATETE (MODE)
TE == RECORD (ADICT + QTEMP_H0 << DSCALE)
TE_LOOP = 0
TE_FLAGS = 0
NEWOP = ASMT
%FINISH
NEWTR1 = CHAFTER (TR)
TT1 == RECORD (ATRIADS + NEWTR1 * TRIADLENGTH)
CHAIN = TT1_CHAIN
TT1 = TT
TT1_CHAIN = CHAIN
TT1_USE = 1
NEWTR2 = CHAFTER (NEWTR1)
TT2 == RECORD (ATRIADS + NEWTR2 * TRIADLENGTH)
TT2_OP = NEWOP
TT2_OPD2 = NEWTR1
TT2_MODE2 = MODE
TT2_QOPD2 = TRIAD
TT2_RES1 = QTEMP
L2: TT_RES1 = QTEMP
TT_OP = REPL
!
%END;! PRESVAL
!
!
!
!
%INTEGERFUNCTION DTDUPL (%INTEGER DPTR)
!
!*************************************************************************
!* CHECK FOR DUPLICATE LOADER-INITIALISED DTEMP. IF FOUND DELETE NEW *
!* ENTRY AND RETURN POINTER TO OLD ONE. *
!*************************************************************************
!
%INTEGER PTR
!
%RECORD (DTRECF) %NAME DT1,DT2
!
DT1 == RECORD (ADICT + DPTR << DSCALE)
PTR = DESTEMPHEAD
%CYCLE
%IF PTR = DPTR %THEN %RESULT = PTR
DT2 == RECORD (ADICT + PTR << DSCALE)
%IF DT1_IDENT = DT2_IDENT %AND %C
DT1_CONST_W = DT2_CONST_W %AND %C
DT1_FLAGS = DT2_FLAGS %THEN %EXIT
PTR = DT2_CHAIN
%REPEAT
DTCH = OLDDTCH
INTEGER (DTCH+ADICT) = 0; ! DTCH MUST ALWAYS BE RELATIVE TO ADICT HERE
%RESULT = PTR
!
%END;! DTDUPL
!
!
!
!
%ROUTINE REDUSE (%RECORD (RESF) OP)
!
!*************************************************************************
!* FINDS TEXT EXTN ENTRY FOR A TRIAD, & REDUCES ITS USE CT BY 1. *
!*************************************************************************
!
%INTEGER PTR
!
%IF OP_FORM & TEXTMASK # 0 %THENSTART
%FOR PTR = EXTNSTART,EXTNSIZE,EXTNEND %CYCLE
EX == RECORD (ATABS + PTR)
%IF EX_TRIAD = OP_H0 %THENSTART
EX_USES = EX_USES - 1
%RETURN
%FINISH
%REPEAT
%FINISH
!
%END;! REDUSE
!
!
!
!
%ROUTINE CRENT
!
!***************************************************************************
!* CREATES AN ENTRY IN THE TEXT EXTN TABLE FOR CURRENT TRIAD, & *
!* INITIALISES IT. *
!***************************************************************************
!
EXTNEND = CREATETAB (EXTNSIZE)
EX == RECORD (ATABS + EXTNEND)
EX_TRIAD = CURRTRIAD
EX_USES = TT_USE
!
%END;! CRENT
!
!
!
!
%ROUTINE BTEMP (%INTEGER BL)
!
!***************************************************************************
!* IF NECESSARY PUTS A LOADB IN FRONT OF FIRST USE OF B-REG IN A BLOCK. *
!***************************************************************************
!
%RECORD (BLRECF) %NAME BB,BB1
%RECORD (CONRECF) %NAME CN
%RECORD (TRIADF) %NAME TT
!
%INTEGER I,PTR,NEXT,TRID
!
BB == RECORD (ABLOCKS + BL * BLSIZE)
CN == RECORD (ATABS + BB_BCON)
%FOR I = 1,1,CN_COUNT %CYCLE
%UNLESS CN_BLOCK(I) = 0 %THENSTART
BB1 == RECORD (ABLOCKS + CN_BLOCK(I) * BLSIZE)
%IF BB1_DEPTH < LOOPDEPTH %THEN %CONTINUE
%IF BB1_DEPTH = LOOPDEPTH %AND BB1_FLAGS & BBOEXBIT # 0 %C
%THEN %CONTINUE
!* B-REG IS NOT BUSY ON EXIT
PTR = BB_TEXT
TT == RECORD (ATRIADS + PTR * TRIADLENGTH)
%CYCLE
NEXT = TT_CHAIN
TT == RECORD (ATRIADS + NEXT * TRIADLENGTH)
%IF (BREGOPN (TT_RES1) = 1 %OR BREGOPN (TT_RES2) = 1) %THENSTART
%IF TT_OP = LOADB %THEN ->SCAN
%IF TT_OP = INIT %AND TT_QOPD1 = BREG %THEN ->SCAN
TRID = CHAFTER (PTR)
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
TT_OP = LOADB
TT_RES1 = BREGOP
TT_QOPD2 = VALTEMP
TT_OPD2 = BRDUMP(BREGTEMP)
TT_MODE2 = INT4
SCAN: %CYCLE
NEXT=TT_CHAIN
TT==RECORD(ATRIADS+NEXT*TRIADLENGTH)
%IF CORRUPTB(OPCAT(TT_OP))#0 %THEN ->AGAIN
%REPEAT %UNTIL TT_OP=STMT %AND TT_USE&SOB#0
%RETURN
%FINISH
AGAIN: PTR = NEXT
%REPEAT %UNTIL TT_OP = STMT %AND TT_USE & SOB # 0
%RETURN
%FINISH
%REPEAT
%IF BB_CORRUPT = 0 %THEN BB_FLAGS = BB_FLAGS ! BBOEXBIT
!
%END;! BTEMP
!
!
!
!
%ROUTINE RESARGS (%INTEGER TR)
!
!**************************************************************************
!* ENSURES THAT EXPRESSIONS IN AN OUT-OF-BLOCK ARG-CHAIN ARE SAVED IN *
!* VALTEMP OR DESTEMP ENTRIES, IF THEY ARE EXPRESSIONS OR ARRAY ELMTS. *
!**************************************************************************
!
%RECORD (TRIADF) %NAME TT
!
%INTEGER TRID
!
TRID = TR
%CYCLE
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
%IF TT_QOPD1 & TEXTMASK # 0 %THEN PRESVAL (TT_OPD1)
TRID = TT_OPD2
%REPEAT %UNTIL TT_QOPD2 & TEXTMASK = 0
!
%END;! RESARGS
!
!
!
!
%ROUTINE KEEPB (%INTEGER TR)
!
!*************************************************************************
!* GENERATES A TRIAD TO PRESERVE CONTENTS OF B-REG IN A VALTEMP. *
!*************************************************************************
!
%RECORD (TRIADF) %NAME TT
!
%INTEGER TRID
!
TRID = CHAFTER (TR)
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
TT_OP = STOREB
TT_QOPD1 = VALTEMP
TT_OPD1 = BRDUMP(BREGTEMP)
TT_MODE = INT4
TT_RES2 = BREGOP
!
%END;! KEEPB
!
!
!
!
%ROUTINE RESETB (%INTEGER TR)
!
!*************************************************************************
!* GENERATES A TRIAD TO RELOAD CONTENTS OF B-REG FROM A VALTEMP. *
!*************************************************************************
!
%RECORD (TRIADF) %NAME TT
!
%INTEGER TRID
!
TRID = CHAFTER (TR)
TT == RECORD (ATRIADS + TRID * TRIADLENGTH)
TT_OP = LOADB
TT_RES1 = BREGOP
TT_QOPD2 = VALTEMP
TT_MODE2 = INT4
TT_OPD2 = BRDUMP(BREGTEMP)
TT_MODE = INT4
BSAVED = 1;! avoid redundant stores
!
%END;! RESETB
!
!
!
!
%INTEGERFUNCTION BREGOPN (%RECORD (RESF) OP)
!
!*************************************************************************
!* DETERMINE WHETHER THE GIVEN OPERAND IS, OR USES, B-REG. *
!*************************************************************************
!
%RECORD (TRIADF) %NAME TT
!
%IF OP_FORM = BREG %THEN %RESULT = 1
%UNLESS OP_FORM & TEXTMASK # 0 %THEN %RESULT = 0
TT == RECORD (ATRIADS + OP_H0 * TRIADLENGTH)
%UNLESS TT_OP = ARR %OR TT_OP = DEFARR %OR TT_OP = ARGARR %C
%THEN %RESULT = 0
%IF TT_QOPD2 = BREG %THEN %RESULT = 1 %C
%ELSE %RESULT = 0
!
%END;! BREGOPN
!
!
!
!
%INTEGERFUNCTION GETNEXT
!
!************************************************************************
!* GETS NEXT TRIAD, CHAINING OUT ANY NULLS, AND USING POINTERS CURR- *
!* AND PREV-TRIAD. *
!************************************************************************
!
PREVTRIAD = CURRTRIAD
%CYCLE
TT == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
CURRTRIAD = TT_CHAIN
%IF CURRTRIAD=0 %THEN %RESULT=0
TT == RECORD (ATRIADS + CURRTRIAD * TRIADLENGTH)
%IF TT_OP = STMT %AND TT_USE & SOB # 0 %THEN %RESULT = 0
%UNLESS TT_OP = NULL %THEN %RESULT = 1
TT1 == RECORD (ATRIADS + PREVTRIAD * TRIADLENGTH)
TT1_CHAIN = TT_CHAIN
TT_CHAIN = FREETRIADS
FREETRIADS = CURRTRIAD
%REPEAT
!
%END;! GETNEXT
!
%INTEGERFN TRSPEC(%RECORD(RESF) R)
!***********************************************************************
!* ENSURE THAT TRIAD AND ARREL OPERATORS ARE CORRECTLY SET *
!* FOR ARREL REFERENCES RELOAD BREG IF NECESSARY *
!***********************************************************************
%RECORD(TRIADF)%NAME TR,TT
%RECORD(SREDF)%NAME SR
%INTEGER CHAIN,CAT
%UNLESS R_FORM&TEXTMASK#0 %THEN %RESULT=R_FORM
TR==RECORD(ATRIADS+R_H0*TRIADLENGTH)
CAT=OPCAT(TR_OP)
%IF CAT=15 %AND (TR_USE<2 %OR TR_MODE=CHARMODE) %THENSTART;! ARRAY ELEMENT
!* must now check whether this reference will require Breg to be reloaded
%IF TR_QOPD2=BREG %THENSTART;! possible
CHAIN=TR_CHAIN
%WHILE CHAIN#CURRTRIAD %CYCLE
TT==RECORD(ATRIADS+CHAIN*TRIADLENGTH)
%IF CORRUPTB(OPCAT(TT_OP))#0 %THENSTART
%UNLESS TT_OP=CVT %AND TT_MODE>INT8 %THENSTART;! only CVT -> int causes problems
SR==RECORD(ABLOCKS+BREGTEMP<<SRSCALE)
%IF SR_DUMP=0 %THEN KEEPB(PREVTRIAD)
TR_OPD2=BRDUMP(BREGTEMP)
TR_QOPD2=VALTEMP
%RESULT=ARREL
%FINISH
%FINISH
CHAIN=TT_CHAIN
%REPEAT
%FINISH
%RESULT=ARREL
%FINISHELSESTART
%IF CAT=15 %AND CMPLX8<=TR_MODE<=CMPLX32 %THEN %RESULT=ARREL %C
%ELSE %RESULT=TRIAD
%FINISH
%END;! TRSPEC
!
%ROUTINE CHECKBBOEX
!
!***********************************************************************
!* ENSURE THAT BBOEXBIT IS NOT SET ERRONEOUSLY *
!***********************************************************************
!
%RECORD(BLRECF)%NAME BB,BB1
%RECORD(CONRECF)%NAME CN
%RECORD(CLOOPRECF)%NAME CL
%INTEGER CHECK,DLOOPPTR,I
%UNTIL CHECK=0 %CYCLE
CHECK=0
DLOOPPTR=DLOOPHEAD
%WHILE DLOOPPTR#0 %CYCLE
CL==RECORD(ATABS+DLOOPPTR)
BB==RECORD(ABLOCKS+CL_BLOCK*BLSIZE)
%IF BB_FLAGS&BBOEXBIT=0 %THENSTART
CN==RECORD(ATABS+BB_FCON)
%FOR I=1,1,CN_COUNT %CYCLE
%UNLESS CN_BLOCK(I)=0 %THENSTART
BB1==RECORD(ABLOCKS+CN_BLOCK(I)*BLSIZE)
%IF BB1_FLAGS & BUSEDORBOE = BBOEXBIT %THENSTART
BB1_FLAGS = BB1_FLAGS & NOTBBOEX
CHECK = 1
%FINISH
%FINISH
%REPEAT
%FINISH
DLOOPPTR=CL_PDCHAIN
%REPEAT
%REPEAT
%END;! CHECKBBOEX
!
%END;! TEXTPASS
!
!
%ENDOFFILE