TT == RECORD (ATRIADS + TR * TRIADLENGTH)
         TR = TR + 1
         TT = 0
         TT_CHAIN = TR
      %REPEAT
      TT_CHAIN = 0
      TR = LASTTRIAD + 1
      FREETRIADS = LASTTRIAD + 2
      LASTTRIAD = LASTTRIAD + 10
      %RESULT = TR
!
!
%END ;!  GETTRIAD
!*
!*
!***********************************************************************
!*                                                                     *
!*            A L L D E F                                             *
!*                                                                     *
!***********************************************************************
!*
%EXTERNALINTEGERFN ALLDEF(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* identifies defining contexts within triad INDEX                     *
!*                                                                     *
!* result = 0   no defining context                                    *
!*          +ve result is coord of an item which is defined            *
!*                                      (no other items at risk)       *
!*         -1   unspecified common or ref args may be defined          *
!*        <-1   result is -coord of common item which is defined       *
!*                                      (ref args at risk)             *
!*                                                                     *
!* called by  UPDATE CURRDEF                                           *
!*            EXPELIM                                                  *
!*            BACKMOVE                                                 *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%RECORD(PRECF)%NAME ID
%INTEGER C
%SWITCH DEF(0:6)
!*
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      ->DEF(DEFTEST(TR_OP&BMBITOFF))
!*
DEF(0):                                 ! no defining context
      %RESULT=0
!*
DEF(1):                                 ! ASMT,ASGN,DIOITEM
      %WHILE TR_QOPD1&TEXTMASK#0 %CYCLE;! to reach DEFARR and DCHAR triads
         TR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
      %REPEAT
!*
SET:  ID==RECORD(ADICT+TR_OPD1<<DSCALE)
      C=ID_COORD
      %IF C=1 %OR C=3 %THEN %RESULT=-1;! args and all commons at risk
      %IF ID_CLASS & CMNBIT # 0 %THEN %RESULT=-C  %C
                                %ELSE %RESULT=C

!*
DEF(2):                               ! DARG
      %IF TR_QOPD1 & IDMASK # 0 %THEN ->SET
!*
      %IF TR_QOPD1 & TEXTMASK # 0 %THENSTART
         %CYCLE
            TR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
            %IF TR_OP&BMBITOFF = ARGARR %THEN ->SET
            %IF TR_OP&BMBITOFF = DCHAR %THENSTART
               %IF TR_QOPD1 & TEXTMASK #0 %THEN ->SET
            %FINISH
            %RESULT=0;! no defining context
         %REPEAT;! to locate character array element
      %FINISH
      %RESULT=0
!*
DEF(3):                                 ! FUN
      ID==RECORD(ADICT+TR_OPD1<<DSCALE)
      %IF ID_X0 & 3 # 0 %THEN %RESULT=0;! standard function
!*
DEF(4):                                 ! CALL
      %RESULT=-1;! unknown definitions of common or args
!*
DEF(5):                                 ! IOSPEC
      %IF TR_QOPD2<6 %THEN %RESULT=0
      %UNLESS TR_QOPD1&IDMASK#0 %THEN %RESULT=0
      ->DEF(1)
!*
DEF(6):                                 ! CALLSF
      %RESULT=-1
!*
%END;! ALLDEF
!*
!*
!*
%EXTERNALROUTINE SETBITS(%RECORD(RESF) TRIADOPD,
                         %INTEGER BLOCKPOINT,USEORDEF,TRIADIND)
!
!*******************************************************************
!* SET EITHER USE OR DEF IN BLOCKTAB BITSTRIPS.
!*   IF SETTING USE BIT, &DEF BIT IS NOT ALREADY SET, SET BOE TOO.
!*   IF DUMMY ARG, SET FOR ALL COMMON, &VICE VERSA.
!*******************************************************************
!
%RECORD(PRECF)%NAME PP
%RECORD(BLRECF)%NAME BB
%RECORD(PROPRECF)%NAME PR
!
!
%INTEGER COORD,BIT,I
%INTEGERARRAYFORMAT BF(0:15)
%INTEGERARRAYNAME B
!
!
      PP == RECORD(ADICT+TRIADOPD_H0<<DSCALE)
      BB == RECORD(ABLOCKS+BLOCKPOINT)
      COORD = PP_COORD
      %UNLESS COORD=1 %THENSTART
        %IF USEORDEF=USE %THENSTART
          SETBIT (ABLOCKS+BB_USE,COORD)
          SETBIT (ABLOCKS+BB_USE,1) %IF (PP_CLASS & CMNBIT) \= 0 %AND %C
            CMNCOORDS(1)=1
          GETBIT (ABLOCKS+BB_DEF,COORD,BIT)
          %IF BIT = 0 %THENSTART
            SETBIT (ABLOCKS+BB_BOE,COORD)
            SETBIT(ABLOCKS+BB_BOE,1) %IF (PP_CLASS & CMNBIT) \= 0 %AND %C
              CMNCOORDS(1)=1
          %FINISH
          PP_X1=PP_X1!8;! will ensure params are copied in
        %FINISHELSESTART
          SETBIT (ABLOCKS+BB_DEF,COORD)
          SETBIT (ABLOCKS+BB_DEF,1) %IF (PP_CLASS & CMNBIT) \= 0 %AND %C
            CMNCOORDS(1)=1
          PR == RECORD(ATABS+COORD*PROPRECSIZE)
          PR_DEFCT=PR_DEFCT+1
          PR_TEXT=TRIADIND
          PP_X0=PP_X0!X'2';! will ensure params are copied out
          PP_X1=PP_X1!X'A';! and copied in
        %FINISH
      %FINISHELSESTART
        %IF USEORDEF=USE %THENSTART
          GETBIT(ABLOCKS+BB_DEF,1,BIT)
          %IF BIT=0 %THENSTART
            B==ARRAY(ABLOCKS+BB_BOE,BF)
            B(I)=B(I)!CMNCOORDS(I) %FOR I=0,1,BSWORDS-1
          %FINISH
          B == ARRAY(ABLOCKS+BB_USE,BF)
        %FINISH %ELSE B == ARRAY(ABLOCKS+BB_DEF,BF)
        B(I)=B(I)!CMNCOORDS(I) %FOR I=0,1,BSWORDS-1
      %FINISH
%END
!*
!*
!***********************************************************************
!*                                                                     *
!*          U P D A T E   C U R R D E F                                *
!*                                                                     *
!***********************************************************************
!*
%EXTERNALROUTINE UPDATE CURRDEF
!***********************************************************************
!*                                                                     *
!* updates CURRDEF to reflect the definitions found in current triad   *
!*                                                                     *
!* called by  OP2 procedures                                           *
!*                                                                     *
!* calls      ALLDEF                                                   *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%INTEGER C
      TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
      C=ALLDEF(CURRTRIAD)
      %IF C=0 %THEN %RETURN;! no defining context
      %IF C>0 %THENSTART;! item defined - no other common or ref args at risk
         SETBIT(ACURRDEF,C)
      %FINISHELSESTART;! all common or ref args at risk
         SETBIT(ACURRDEF,1)
         %IF C=-1 %THENSTART;! ref arg at risk, common at risk
            SETCMNBITS(ACURRDEF)
         %FINISHELSESTART;! common item defined, ref arg at risk
            C=-C
            SETBIT(ACURRDEF,C)
         %FINISH
      %FINISH
!*
%END;! UPDATE CURRDEF
!*
!*
!***********************************************************************
!*                                                                     *
!*         T R E V E R S E                                             *
!*                                                                     *
!***********************************************************************
!*
%EXTERNALROUTINE TREVERSE(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* reverse operands of triad INDEX if possible and necessary to ensure *
!* that RES1 is logically greater than RES2                            *
!*                                                                     *
!* order of precedence:  text > iden > const                           *
!*                                                                     *
!***********************************************************************
%CONSTBYTEINTEGERARRAY STRENGTH(0:66)=0(16),2(16),3(32),1(3)
%CONSTBYTEINTEGERARRAY REVOP(0:29) =  %C
   0,0,ADD,0,MULT,0,0,0,0,0,
   0,0,0,0,0,0,0,0,0,0,
   0,LT,GT,NE,EQ,LE,GE,0,0,0
%RECORD(TRIADF)%NAME TR
%RECORD(RESF) R
%INTEGER I
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      %IF TR_OP&BMBITOFF<30 %THEN I=REVOP(TR_OP&BMBITOFF) %ELSE %RETURN
      %IF I=0 %THEN %RETURN;! not reversible
!*
      %IF TR_QOPD1=TR_QOPD2 %THENSTART
         %IF TR_OPD2<TR_OPD1 %THENSTART
SWAP:       TR_OP=(TR_OP&BMBIT)!I
            R=TR_RES1
            TR_RES1=TR_RES2
            TR_RES2=R
         %FINISH
          %RETURN
      %FINISH
!*
      %IF STRENGTH(TR_QOPD2)>STRENGTH(TR_QOPD1) %THEN ->SWAP
!*
%END;! TREVERSE
!*
%ROUTINE CHAINOUT
!***********************************************************************
!*                                                                     *
!* chain out the current triad                                         *
!*                                                                     *
!* CURRTRIAD is added to FREETRIADS list                               *
!* PREVTRIAD becomes CURRTRIAD                                         *
!*                                                                     *
!* called by  NEXTTRIAD                                                *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME PREVTR
%RECORD(TRIADF)%NAME CURRTR
      PREVTR==RECORD(ATRIADS+PREVTRIAD*TRIADLENGTH)
      CURRTR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
!*
      PREVTR_CHAIN=CURRTR_CHAIN
      CURRTR=0
      CURRTR_CHAIN=FREETRIADS
      FREETRIADS=CURRTRIAD
      CURRTRIAD=PREVTRIAD
%END;! CHAINOUT
!*
%EXTERNALINTEGERFN NEXTTR
!***********************************************************************
!*                                                                     *
!* get the next non_trivial triad from the chained text,deleting or    *
!* ignoring trivial triads                                             *
!*                                                                     *
!* set CURRTRIAD, PREVTRIAD                                            *
!*                                                                     *
!* result = 0  end of block                                            *
!*          1  normally                                                *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME CUR
%RECORD(TRIADF)%NAME PREV
%RECORD(TRIADF)%NAME TR
%INTEGER REPL INDEX
!*
!*
      %CYCLE
         PREVTRIAD=CURRTRIAD
!*
         %CYCLE
            PREV==RECORD(ATRIADS+PREVTRIAD*TRIADLENGTH)
            CURRTRIAD=PREV_CHAIN
            %IF CURRTRIAD=0 %THEN %RESULT=0
            CUR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
            %IF CUR_OP&BMBITOFF=STMT %AND CUR_VAL2&SOB#0 %THEN %RESULT=0;! returns end-of-block
            %IF CUR_OP&BMBITOFF#NULL %THEN %EXIT
            CHAINOUT
         %REPEAT
!*
!*
         %IF CUR_OP&BMBITOFF#STMT %AND CUR_OP&BMBITOFF#REPL %THENSTART
            %CYCLE
               %IF CUR_QOPD1 & TEXTMASK = 0 %THEN %EXIT
                REPL INDEX=CUR_OPD1
               TR==RECORD(ATRIADS+REPL INDEX*TRIADLENGTH)
               %IF TR_OP&BMBITOFF=REPL %THENSTART
                  CUR_RES1=TR_RES1;! perforn replacement
                  %IF CUR_QOPD1 & TEXTMASK # 0 %THENSTART;! update use count
                     TR==RECORD(ATRIADS+CUR_OPD1*TRIADLENGTH)
                     TR_USE=TR_USE+1
                  %FINISH
                  TREVERSE(CURRTRIAD)
                  DELUSE(REPL INDEX)
               %FINISHELSE %EXIT
            %REPEAT;! to reconsider RES1 in case TREVERSE caused a swap
!*
            %IF CUR_QOPD2 & TEXTMASK = 0 %THEN %RESULT=1
!*
            REPL INDEX=CUR_OPD2
            TR==RECORD(ATRIADS+REPL INDEX*TRIADLENGTH)
            %UNLESS TR_OP&BMBITOFF=REPL %THEN %RESULT=1
            CUR_RES2=TR_RES1;! perform replacement
            %IF CUR_QOPD2 & TEXTMASK # 0 %THENSTART;! update use count
               TR==RECORD(ATRIADS+CUR_OPD2*TRIADLENGTH)
               TR_USE=TR_USE+1
            %FINISH
            TREVERSE(CURRTRIAD)
            DELUSE(REPL INDEX)
            %RESULT=1
         %FINISH
      %REPEAT
%END;! NEXTTR
!*
%EXTERNALINTEGERFN NEXTTRIAD
!***********************************************************************
!*                                                                     *
!* as NEXTTR, but skips over REPL triads                               *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%INTEGER F
      %CYCLE
         F=NEXTTR
         TR==RECORD(ATRIADS+CURRTRIAD*TRIADLENGTH)
         %IF TR_OP&BMBITOFF#REPL %THEN %RESULT=F
      %REPEAT
%END;! NEXTTRIAD
!*
%EXTERNALROUTINE DELUSEX(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* delete one use of triad INDEX                                       *
!*                                                                     *
!* if use is then <1 and not a user function then change to a null tria*d
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%INTEGER I
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      I=TR_USE-1
      %IF I>=1 %THEN TR_USE=I %AND %RETURN
!*
      %IF TR_OP&BMBITOFF=FUN %THEN %RETURN;! user side effects must not be eliminated
!*
      TR_OP=NULL
%END;! DELUSEX
!*
%EXTERNALROUTINE DELUSE(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* delete one use of triad INDEX, including all triads referenced      *
!*                                                                     *
!* if use is then <1 and not a user function then change to a null tria*d
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%INTEGER I
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      I=TR_USE-1
      %IF I>=1 %THEN TR_USE=I %AND %RETURN
!*
      %IF TR_OP&BMBITOFF=FUN %THEN %RETURN;! user side effects must not be eliminated
!*
      TR_OP=NULL
!*
      %IF TR_QOPD1&TEXTMASK#0 %THEN DELUSE(TR_OPD1)
      %IF TR_QOPD2&TEXTMASK#0 %THEN DELUSE(TR_OPD2)
!*
%END;! DELUSE
!*
%EXTERNALINTEGERFN LOOPCON1(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* check if operand 1 of triad INDEX is a loop constant                *
!*                                                                     *
!* result = 0  no                                                      *
!*          1  yes                                                     *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%RECORD(PRECF)%NAME ID
%INTEGER C,A,BIT,QUAL
!*
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      QUAL=TR_QOPD1
!*
!* identifier entry is a loop constant if it is not defined in any
!* of the blocks in the loop
!*
      %IF QUAL&IDMASK#0 %THENSTART
         ID==RECORD(ADICT+TR_OPD1<<DSCALE)
         A=ADDR(CLOOPDEF(0))
         C=ID_COORD
         GETBIT(A,C,BIT)
         %RESULT=BIT!!1
      %FINISH
!*
!* a triad is loop constantif it has been moved out of the loop by
!* backward movement
!*
      %IF QUAL&TEXTMASK#0 %THENSTART
         TR==RECORD(ATRIADS+TR_OPD1*TRIADLENGTH)
         %RESULT=(TR_OP&BMBIT)>>BMBITSHIFT
      %FINISH
!*
!* strength reduction temporary is loop variable
!*
      %IF QUAL=SRTEMP %THEN %RESULT=0
!*
!* treat procid as loop variable - invalid backward move occurred
!*
      %IF QUAL=PROCID %THEN %RESULT=0
!*
!* anything else (const) must be loop const
!*
      %RESULT=1
!*
%END;! LOOPCON1
!*
%EXTERNALINTEGERFN LOOPCON2(%INTEGER INDEX)
!***********************************************************************
!*                                                                     *
!* check if operand 2 of triad INDEX is a loop constant                *
!*                                                                     *
!* result = 0  no                                                      *
!*          1  yes                                                     *
!*                                                                     *
!***********************************************************************
%RECORD(TRIADF)%NAME TR
%RECORD(PRECF)%NAME ID
%INTEGER C,A,BIT,QUAL
!*
      TR==RECORD(ATRIADS+INDEX*TRIADLENGTH)
      QUAL=TR_QOPD2
!*
!* identifier entry is a loop constant if it is not defined in any
!* of the blocks in the loop
!*
      %IF QUAL&IDMASK#0 %THENSTART
         ID==RECORD(ADICT+TR_OPD2<<DSCALE)
         A=ADDR(CLOOPDEF(0))
         C=ID_COORD
         GETBIT(A,C,BIT)
         %RESULT=BIT!!1
      %FINISH
!*
!* a triad is loop constantif it has been moved out of the loop by
!* backward movement
!*
      %IF QUAL&TEXTMASK#0 %THENSTART
         TR==RECORD(ATRIADS+TR_OPD2*TRIADLENGTH)
         %RESULT=(TR_OP&BMBIT)>>BMBITSHIFT
      %FINISH
!*
!* strength reduction temporary is loop variable
!*
      %IF QUAL=SRTEMP %THEN %RESULT=0
!*
!* treat procid as loop variable - invalid backward move occurred
!*
      %IF QUAL=PROCID %THEN %RESULT=0
!*
!* anything else (const) must be loop const
!*
      %RESULT=1
!*
%END;! LOOPCON2
!*
%ROUTINE P(%INTEGER I)
PRINTSTRING("BUSYONX ")
WRITE(I,1)
NEWLINE
%END
!*
%EXTERNALINTEGERFN BUSYONX(%INTEGER FROMORTO,BLOCK,IDPTR)
!*
!* test whether a given variable is busy on exit from or to a given block
!*
!* FROMORTO = 0  busy-on-exit from
!*            1  busy-on-exit to
!* BLOCK         block index
!* IDPTR         scaled identifier pointer
!*
!* result   = 0  not busy
!*            1  busy
!*
%RECORDFORMAT SAVFMT(%INTEGER PATH,NUMCON,ACON,CURBL)
%RECORD(SAVFMT)%NAME SAVREC
%RECORD(PRECF)%NAME ID
%RECORD(BLRECF)%NAME BL
%RECORD(COMFMT)%NAME COM
%INTEGER PATH,NUMCON,ACON,CURBL,CVAL,BIT,BLSTRIP,I
%INTEGER SAVIND
!*
      COM==RECORD(COMAD)