*DECK     FLINK - CCG MODE FRONT END LINKAGES.
          IDENT  FLINK
 FLINK    SECT   (CCG MODE FRONT END LINKAGES.) 
 FLINK    SPACE  4,10 
*         IN ALLOC
          EXT    ALC
  
*         IN CCGLINK
          EXT    N$EXST,N.IL
  
*         IN CONRED 
          EXT    LVEC,LLVEC,RVEC,RLVEC,CTAA,CTA 
  
*         IN FEC
          EXT    OIL,BBC
  
*         IN FSKEL
          EXT    V=SEG,V=DIR.R,V=DIV.D,V=DIR.C,V=MUL.R,V=MUL.D,V=MUL.C
  
*         IN FTN
          EXT    CO.RNDD,CO.RNDM,F.IL 
  
*         IN PAR
          EXT    POP.DVA,SMOD,SOPR
  
*         IN PUC
          EXT    N.GL,T=BLST,T=DATS,T=GL,T=SCR,T=PAR,T.BLST,T.DATS,T.GL 
          EXT    T.PAR,T.SCR,T.SYM
  
*         IN UTILITY
          EXT    WTW= 
 VALUES   SPACE  4,10 
**        CCG MODE FRONT END FAKE LINKAGES. 
  
  
 DUC.     EQUENT 0           **** KLUDGE **** 
 DUC.1ST  EQUENT 1           **** KLUDGE **** 
 DUC.2ND  EQUENT 2           **** KLUDGE **** 
 DUC.BTH  EQUENT 3           **** KLUDGE **** 
  
 QCP      SUBR   =           QUICK CODE GENERATOR PRESETS 
          EQ     EXIT.       DO NOTHING...
 OX,X     SPACE  4,10 
**        OX,X - COMPUTE ORDINAL FROM INDEX.
* 
*         OX.R   X.I
* 
*         ENTRY  (X.I) = THE WORD INDEX OF AN INTERMEDIATE. 
* 
*         EXIT   (X.R) = THE ENTRY ORDINAL OF THAT INTERMEDIATE.
* 
*         USES   X.I  B.N 
  
  
 OX,X     OPDEF  R,I
          SX.R   43691
          IX.R   X.R*X.I
          AX.R   17 
          ENDM
 DER      SPACE  4,10 
**        DER -  DETECT EXTENDED RANGE DO LOOPS.
* 
*         ENTRY  (X6) = *WB* OF LABEL CURRENT SOURCE STMT COULD JUMP TO.
*                (B7) = SYMTAB *WB* INDEX OF LABEL. 
* 
*         EXIT   WB.DLEN IS SET ON DO-TOP LABEL FOR EACH CLOSED LOOP
*                CONTAINING ABOVE LABEL DEFINITION. 
* 
*         USES   X - 0,1,2,3,7  A - 1,7  B - 3 .
* 
*         KEEPS  X - 6  B - 7 
  
  
 DER      SUBR   =             ...ENTRY/EXIT... 
          SA1    T.SYM
          =B3    B7-WB.W+WC.W 
          SA3    X1+B3       X3 = *WC*
          MX0    -WC.LDTLL
          LX3    -WC.LDTLP
          BX2    -X0*X3      X2 = INITIAL LINK TO DO TOP LABEL
          =A3    A3-WC.W+WB.W      X3 = *WB*
  
 DER10    SBIT   X3,WB.DLPEP
          PL     X3,EXIT.    IF END OF CHAIN
          SB3    X2 
          LX2    1
          SB3    B3+X2
          =B3    B3+WC.W     CONVERT TO WC INDEX
          SA3    X1+B3       X3 = *WC*
          LX3    -WC.LDTLP
          BX2    -X0*X3 
          =A3    A3-WC.W+WB.W      X3 = *WB*
          BX7    X3 
          SBIT   X7,WB.DLCP 
          PL     X7,EXIT.    IF LOOP NOT CLOSED YET 
          SBIT   X7,WB.DLENP/WB.DLCP
          MI     X7,DER10    IF ALREADY MARKED
          CLAS=  X7,WB,(DLEN) 
          BX7    X3+X7
          SA7    A3          MARK LOOP AS HAVING AN ENTRY 
          EQ     DER10
 DPT      SPACE  4,10 
**        DPT -  DEFINE PROGRAM TAG.
* 
*         ENTRY  (X6) = ENTRY FOR *T.GL*, (WC) FORMAT 
* 
*         USES   A1,A2,A6  X0,X7
* 
*         CALLS  ALLOC
  
  
 DPT      SUBR   =           ...ENTRY/EXIT... 
          SA1    N.GL 
          SA2    T=GL 
          SA6    DPTA        SAVE (X6)
          =X3    X1+1 
          IX0    X3-X2
          ALLOC  T.GL,X0     ENSURE TABLE LARGE ENOUGH FOR ALL GLS
          SA2    DPTA 
          BX6    X2 
          SA6    X1+B3       STORE ENTRY IN GL TABLE
          EQ     EXIT.
  
 DPTA     BSS    1           SAVE (X6)
 LPE      SPACE  4,10 
**        LPE -  LINK POSSIBLE-ENTRY DO LOOPS.
* 
*         ENTRY  WE ARE IN THE PROCESS OF CLOSING OFF A DO LOOP 
*                WHICH CONTAINS NO ENTRIES AND HAS AT LEAST ONE EXIT. 
* 
*                T.SCR CONTAINS DO LOOP INFORMATION IN T.BLST FORM. 
* 
*         EXIT   ALL LABELS DEFINED IN THIS LOOP THAT WERE NOT
*                PREVIOUSLY LINKED, ARE MARKED AS POSSIBLE ENTRIES, 
*                AND ARE LINKED TO THE CORRESPONDING DO-TOP LABEL.
*                THIS DO-TOP LABEL IS LINKED TO THE DO-TOP LABEL OF 
*                OF THE LOOP ONE LEVEL OUT, IF THERE IS ONE, AND IS 
*                MARKED WITH WB.DLPE = 1 SOLELY TO INDICATE THAT
*                THE LINK IS VALID. 
* 
*         USES   X - 0,1,2,3,5,6,7  A - 1,2,3,6  B - 2,3,7. 
  
  
 LPE      SUBR   =             ...ENTRY/EXIT... 
          SA1    T.SCR
          SB2    X1 
          SA1    B2+DORT.W   X1 = TP. FORMAT OPERAND OF DO-TOP LABEL
          MI     X1,EXIT.    IF EVAPORATED ONE TRIP LOOP
          MX0    -TP.ORDL 
          LX1    -TP.ORDP 
          BX5    -X0*X1      X5 = SYMORD OF DO-TOP LABEL
          LX5    WC.LDTLP 
          SA1    T=SCR
          SB3    X1-Z=BLST-1 B3 = NUMBER OF LABELS IN THE LOOP
          IFEQ   TEST,ON,1
          ZR     B3,"BLOWUP"
          SB2    B2+Z=BLST   ADVANCE TO 1ST LABEL 
          CLAS=  X7,WB,(DLPE)      X7 = POSSIBLE ENTRY BIT MASK 
          MX0    -WC.LDTLL
          LX0    WC.LDTLP    X0 = NEGATIVE MASK FOR LINK ERASURE
          SA1    T.SYM       X1 = FWA SYMTAB
  
 LPE10    SA2    B2          X2 = LABEL WORD
          HX2    LA.DEF 
          PL     X2,LPE20    IF NOT DEFINED IN THIS LOOP
          LX2    LA.DEFP+1-LA.ORDP
          SX2    X2          X2 = SYMORD OF LABEL 
          ERRNZ  LA.ORDL-18 
          SB7    X2 
          LX2    1
          SB7    X2+B7
          =B7    B7+WB.W     CONVERT TO WB INDEX
          SA2    X1+B7       X2 = *WB*
          HX2    WB.DLPE
          MI     X2,LPE20    IF ALREADY LINKED
          LX2    WB.DLPEP+1 
          BX6    X2+X7
          SA6    A2          MARK LABEL AS POSSIBLE ENTRY 
          =A2    A2-WB.W+WC.W      X2 = *WC*
          BX2    X0*X2       ASSURE THAT LINK IS ZERO 
          BX6    X2+X5
          SA6    A2          SET LINK 
  
 LPE20    =B2    B2+1 
          =B3    B3-1 
          NZ     B3,LPE10    IF MORE LABELS 
  
**        LINK THIS LOOP TO THE LOOP ONE LEVEL OUT. 
  
          SA2    T=BLST 
          SA3    T.BLST 
          SB2    X2 
          SB3    X3 
  
 LPE30    ZR     B2,EXIT.    IF NO OUTER LOOP 
          SB7    B2+B3
          =A2    B7-1        FETCH LC. WORD 
          MX0    LC.DOL 
          LX0    LC.DOL+LC.DOP
          BX0    X0*X2
          NZ     X0,LPE40    IF THIS BLOCK IS DO LOOP 
          LX2    -LC.CNTP 
          SB7    X2          LENGTH OF BLOCK IF ENTRY 
          SB2    B2-B7       DECREMENT
          EQ     LPE30       LOOP FOR A DO ENTRY
  
 LPE40    LX2    -LC.CNTP 
          SB2    X2          B2 = LENGTH OF LOOP ENTRY
          ERRNZ  LC.CNTL-18 
          =B2    B2-DORT.W-1
          SA2    A2-B2       X2 = DO-TOP LABEL (TP. FORMAT) 
          MX3    -TP.ORDL 
          LX2    -TP.ORDP 
          BX6    -X3*X2      X6 = SYMORD OF DO-TOP LABEL
          LX5    -WC.LDTLP
          SB2    X5 
          LX5    1
          SB2    X5+B2
          =B2    B2+WC.W     B2 = *WC* INDEX OF CURRENT DO-TOP LABEL
          SA2    X1+B2       X2 = *WC*
          BX2    X0*X2       ASSURE LINK IS ZERO
          BX6    X2+X6       SET LINK TO NEXT LOOP
          SA6    A2          UPDATE *WC*
          =A2    A2-WC.W+WB.W   X2 = *WB* 
          BX6    X2+X7       INDICATE VALID LINK
          SA6    A2          UPDATE *WC*
          EQ     EXIT.
 MAL      EJECT 
**        MAL - MARK LOOPS POSSIBLY ENTERED VIA ASSIGNED GOTO/S.
* 
*         USES   ALL REGISTERS. 
  
 MAL      SUBR   =
          SA1    =XT=ASG
          ZR     X1,EXIT.    IF NO ASSIGN STATEMENTS IN PROGRAM 
          SA4    T.SYM
          SA2    =XT.ASG
          SB6    X1 
          SA5    X2-1        INITIALIZE BEFORE ASSIGN TABLE 
  
*         LOOP THROUGH ASSIGN TABLE, CALLING *DER* ON ALL TARGET
*         LABELS TO MARK ALL CONTAINING LOOPS AS *ENTRY* .
  
 MAL10    ZR     B6,EXIT.    IF TABLE EXHAUSTED 
          =A5    A5+1 
          =B6    B6-1 
          SX3    X5          LABEL ORDINAL
          LX0    B1,X3
          IX6    X3+X0
          =B7    X6+WB.W     WB INDEX 
          SA2    X4+B7       WB 
          BX6    X2 
          RJ     DER         MARK CONTAING LOOPS ENTERED
          EQ     MAL10
 MDD      SPACE  4,10 
**        MDD -  MARK DO PARAMETERS DEFINED.
* 
*         THE PURPOSE OF THIS ROUTINE IS TO ENABLE MORE 
*         EFFICIENT CODE TO BE GENERATED FOR DO LOOPS.
* 
*         ENTRY  (X5) = OPERAND (TP. FORMAT) OF A STORE TARGET. 
*                (X6) = AMOUNT OF T.BLST TO SEARCH
* 
*         EXIT   WB.PRD SET IN SYMTAB ENTRY OF LOOP-TOP LABEL FOR 
*                EACH ACTIVE DO-LOOP WHOSE LIMIT PARAMETER COULD
*                HAVE BEEN RE-DEFINED.
* 
*         CALLS  BBC
* 
*         USES   X - 0,1,2,3,6,7  A - 1,2,7  B - 2,3,7
  
  
 MDD      SUBR   =           ENTRY/EXIT...
          ZR     X6,EXIT.    IF NO ACTIVE DO-LOOPS
          SA6    MDDA        PRESERVE LENGTH
          MX3    -0          BIAS FIELD SHOULD NOT BE IGNORED 
          BX0    X5 
          HX0    TP.INTR
          PL     X0,MDD10    IF NOT INTERMEDIATE
          LX0    TP.INTRP-TP.ARYP 
          PL     X0,EXIT.    IF NOT ARRAY MUST BE SUBSTRING 
          SA1    T.PAR
          MX7    -TP.ORDL 
          LX0    TP.ARYP+1-TP.ORDP
          BX7    -X7*X0      ISOLATE T.PAR INDEX
          =B2    X7+OR.1OP
          SA5    X1+B2
          =A5    A1+1        STORE TARGET IS ARRAY NAME 
          MX3    -TP.BIASL
          LX3    TP.BIASP    INDICATES BIAS SHOULD BE IGNORED 
  
 MDD10    RJ     BBC         BASE/BIAS CONVERSION OF X5 
  
**        (X5) = STORE TARGET IN BASE/BIAS FORM (TP. FORMAT). 
*         (X3) = BIAS FIELD MASK. 
  
          BX7    X3 
          CLAS=  X3,TP,(BIAS,ORD) 
          BX5    X3*X5       X5 = BIAS, ORD FIELDS ONLY 
          BX5    X5*X7       X5 = COMPARE QUANTITY
          SA1    MDDA 
          SA2    T.BLST 
          IX2    X1+X2
          =A2    X2-1        A2 _ LC. WORD OF CURRENT BLOCK STRUCTURE 
          SB7    X1          B7 = NUMBER OF WORDS REMAINING IN T.BLST 
          SA1    T.SYM
          =B2    0           B2 = LENGTH OF CURRENT T.BLST SEGMENT
          SX0    X1+WB.W     X0 = FWA + 1 OF SYMTAB 
          CLAS=  X1,TP,(INTR,SHRT,ADDR) 
          BX6    X1          X6 = REJECTION MASK
  
 MDD20    SB7    B7-B2
          ZR     B7,EXIT.    IF TABLE EXHAUSTED 
          SA2    A2-B2       X2 = LC. WORD OF CURRENT BLOCK STRUCTURE 
          MX1    -LC.CNTL 
          LX2    -LC.CNTP 
          BX1    -X1*X2 
          SB2    X1          B2 = LENGTH OF THIS SEGMENT
          LX2    LC.CNTP-LC.DOP 
          MX1    -LC.DOL
          BX1    -X1*X2 
          ZR     X1,MDD20    IF NOT DO-LOOP STRUCTURE 
          =B3    B2-1-DOLI.W
          SA1    A2-B3       (A1,X1) _ DOLI.W WORD
          BX3    X1*X6
          NZ     X3,MDD20    IF COMPARE NOT VALID 
          CLAS=  X3,TP,(BIAS,ORD) 
          BX1    X1*X3       X1 = BIAS, ORD FIELDS ONLY 
          BX1    X1*X7       X1 = COMPARE QUANTITY
          BX1    X1-X5
          NZ     X1,MDD20    IF DO LIMIT NOT RE-DEFINED 
          SB3    B2-DORT.W
          =B3    B3-1 
          SA1    A2-B3       X1 = OPERAND OF DO-TOP LABEL 
          MX3    -TP.ORDL 
          LX1    -TP.ORDP 
          BX1    -X3*X1      X1 = SYMORD OF LABEL 
          SB3    X1 
          LX1    1
          SB3    X1+B3       CONVERT TO INDEX 
          SA1    X0+B3       X1 = *WB* OF LABEL 
          CLAS=  X3,WB,(PRD)
          BX2    X7 
          BX7    X1+X3
          SA7    A1          MARK LOOP WITH WB.PRD
          BX7    X2 
          EQ     MDD20
  
 MDDA     BSS    1           AMOUNT OF T.BLST TO SEARCH 
 PDC      SPACE  4,10 
**        PDC - PROCESS DIVIDE BY CONSTANT. 
* 
*         THIS ROUTINE WILL MAKE AN ATTEMPT TO OPTIMIZE THE EXPRESSION
*         X/C (WHERE X IS ANY EXPRESSION AND C IS A CONSTANT) BY TURNING
*         IT INTO  X*(1.0/C). 
* 
*         ENTRY  (SMOD) = INFO ABOUT DOMINANT MODE OF THE EXPRESSION. 
*                (X3) = OPERATION 
*                (X4) = 1OP.
*                (X5) = 2OP.
* 
*         EXIT   IF OPTIMIZATION SUCCESSFULL :  
* 
*                (X4)    = 1OP (POSSIBLY MODE CONVERTED)
*                (X5)    = OPERAND FOR 1.0/C  .  (2OP)
*                C(SOPR) = DESTROYED
*                C(SMOD) = UPDATED
*                C(POP.DVA) = .NZ.
*                C(B6-1) = X5 
*                C(B6-2) = X4 
  
*                BINARY FOR  1.0/C  AND  (1.0/C)*C  ENTERED 
*                IN THE CONSTANT TABLE. 
* 
*                IF OPTIMIZATION IS UNSUCCESSFULL : 
* 
*                C(POP.DVA) = 0 
*                EVERYTHING ELSE IS PRESERVED.
* 
*         CALLS  CTA. 
* 
*         USES   X - ALL  A - ALL BUT A0  B - 2,3,7.
  
  
**        HERE IF OPTIMIZATION WAS UNSUCCESSFULL. 
  
 .INV     IFEQ   NOINVERT,0 
 PDC30    SA3    PDCB 
          =A4    A3+1 
          =A5    A4+1        RESTORE REGS 
          MX6    0
          SA6    SMOD 
          BX6    X3 
          SA6    SOPR        RESTORE CELLS
          BX6    X5 
          SA6    B6-B1
          BX6    X4 
          =A6    A6-1        RESTORE THE STACK
  
 PDC      SUBR   =           ENTRY/EXIT...
          SA1    CO.RNDM
          SA2    CO.RNDD
          BX1    X1-X2
          NZ     X1,EXIT.    IF DIFFERENT ARITHMETIC SELECTED 
          BX6    X3 
          BX7    X4 
          SA6    PDCB 
          =A7    A6+1 
          BX7    X5 
          =A7    A7+1        PRESERVE X3,X4,X5
          CALL   SDM         SET DOMINANT MODE
          CALL   OMC         OUTPUT (NOT REALLY) MODE CONVERSION
          BX1    X5          CONVERTED (POSSIBLY) OPERAND 
          CALL   LCT         LOAD VALUE 
          NZ     X0,PDC5     IF NOT BOOLEAN 
          ERRNZ  M.BOOL 
          NE     B2,B1,PDC30 IF NOT SHORT CONSTANT
  
 PDC5     SA1    SMOD 
          SX2    X1-M.REAL
          SX0    X1-M.CPLX-1
          MI     X2,PDC30    IF DOMINANT MODE IS INT, LOG, OR BOOL
          PL     X0,PDC30    IF DOMINANT MODE IS NOT REAL, DBL OR CPLX
          ERRNZ  M.DBL-M.REAL-1 
          ERRNZ  M.CPLX-M.DBL-1 
          SA6    LVEC+1 
          SA7    LLVEC+1     STORE UPPER AND LOWER OF 2OP 
          SX6    1./1S45
          LX6    45 
          SA6    LVEC 
          MX7    0
          SA7    LLVEC       STORE UPPER AND LOWER OF 1OP (1.0) 
          SA3    ICRD+X2     X3 = INDEX OF CONSTANT REDUCER 
          SA3    =XF.SKCR+X3
          LX3    -VS.CRAP 
          BX6    X2 
          SA6    PDCA        PRESERVE OFFSET INTO ICRD (ICRM) 
          CALL   CTA         PERFORM  1./C
          ZR     X6,PDC30    IF DIVIDE RESULT NOT GOOD
          SA6    PDCA+1      PRESERVE OPERAND OF RESULT 
          SA1    RVEC        X1 = UPPER HALF OF RESULT
          SA2    RLVEC       X2 = LOWER HALF OF RESULT
          BX6    X1 
          BX7    X2 
          SA6    LVEC 
          SA7    LLVEC       MAKE RESULT AN OPERAND FOR (1./C)*C
          SA3    PDCA 
          SA3    ICRM+X3     X3 = INDEX OF CONSTANT REDUCER 
          SA3    F.SKCR+X3
          LX3    -VS.CRAP 
          CALL   CTA         PERFORM (1.0/C)*C
          ZR     X6,PDC30    IF RESULT NOT GOOD 
          SX6    1./1S45
          LX6    45 
          SA1    RVEC 
          BX6    X1-X6
          NZ     X6,PDC30    IF UPPER HALF OF RESULT NOT GOOD 
          SA2    RLVEC
          MX6    0
          SA1    SMOD 
          SX1    X1-M.DBL 
          MI     X1,PDC20    IF DOMINANT MODE REAL
          NZ     X1,PDC10    IF DOMINANT MODE NOT DOUBLE
          MX6    12 
  
 PDC10    BX6    -X6*X2      EXTRACT PROPER PORTION OF LOWER HALF 
          NZ     X6,PDC30    IF LOWER HALF OF RESULT NOT GOOD 
  
 PDC20    SA5    PDCA+1      X5 = NEW 2OP (1./C)
          BX6    X5 
          SA6    B6-B1       UPDATE 2OP ON STACK
          MX6    1
          SA6    POP.DVA     FLAG CONVERT TO MULTIPLY 
          EQ     EXIT.
  
 PDCA     BSS    2
 PDCB     BSS    3           PRESERVE X3,X4,X5 HERE 
  
 ICRD     CON    V=DIR.R,V=DIV.D,V=DIR.C
 ICRM     CON    V=MUL.R,V=MUL.D,V=MUL.C
 .INV     ELSE
 PDC      BSSENT 0
          EQ     "BLOWUP" 
 .INV     ENDIF 
 PDI      SPACE  4,10 
**        PDI - PUBLISH DATA TO IL FILE.
* 
*         LIKE *PIS*, BELOW, THIS ROUTINE EXISTS IN QCG AND CCG.
*         IN QCG MODE, CAI IS CALLED TO COPY (T.DATS) TO (F.PB).
*         IN CCG MODE, THE (T.DATS) IS WRITTEN TO (F.PB). 
* 
*         ENTRY  LAST TURPLE IN (T.PAR) IS (V=DATA).
* 
*         USES   ALL. 
*         CALLS  OIL, WRITEW. 
  
  
 PDI      SUBR   =           ENTRY/EXIT...
          CALL   OIL         OUTPUT I.L.
          SA5    T=DATS 
          SA4    T.DATS 
          WRITEW F.IL,X4,X5 
          EQ     EXIT.
 PIS      SPACE  4,10 
**        PIS - PUBLISH IL SEGMENT. 
* 
*         THERE ARE TWO VERSIONS OF THIS ROUTINE. 
*         IN QCG MODE, CAI IS CALLED TO COMPILE ALL INSTRUCTIONS
*            TO T.PB. 
*         IN CCG MODE, THE IL IS WRITTEN TO A FILE FOR LATER
*            PROCESSING BY THE BRIDGE.
  
  
 PIS      SUBR   =           ...ENTRY/EXIT... 
          SA4    T=PAR
          SA1    N.IL        NUMBER OF WORDS WRITTEN TO IL
          SB7    Z=TURP 
          IX7    X1+X4
          SX6    X7+B7
          SX2    F.IL 
          SA6    A1          UPDATE IL WORD COUNT 
          WRITEW X2,PISA,B7 
  
          SA4    T=PAR
          SA3    T.PAR
          SA2    N$EXST 
          MX0    TH.LINEL 
          SHRINK A4          RELEASE IL TABLE SPACE 
          SA0    X2          (A0) = PREVIOUS (N.EXST) 
          =B2    59-TP.INTRP
          SB7    X4          (B7) = LENGTH OF SEGMENT 
          LX0    TH.LINEL+TH.LINEP
          =B5    OR.OPR 
          SB6    X3          (B6) = FWA SEGMENT 
          MX4    -TP.ORDL 
  
 PIS4     SA1    B6+B5       FETCH TURPLE HEADER
          SB5    B5+Z=TURP
          BX2    X0*X1       EXTRACT LINE NUMBER
          =A3    A1-OR.OPR+OR.1OP 
          ZR     X2,PIS5     IF NOT BEGINNING-OF-STATEMENT
          SA0    A0+B1
 PIS5     =A1    A3-OR.1OP+OR.2OP 
          LX7    X3,B2
          PL     X7,PIS6     IF (1OP) NOT INTERMEDIATE
          LX3    -TP.ORDP 
          BX6    -X4*X3      ISOLATE (X6) = INTERMEDIATE INDEX (1OP)
          BX3    X4*X3
          OX7    X6          (X7) = ORD (X6) = (X6) / Z=TURP
          BX6    X7+X3
          LX6    TP.ORDP
          SA6    A3 
 PIS6     LX7    X1,B2
          PL     X7,PIS7     IF (2OP) NOT INTERMEDIATE
          LX1    -TP.ORDP 
          BX6    -X4*X1      ISOLATE (X6) = INTERMEDIATE INDEX (2OP)
          BX3    X4*X1
          OX7    X6          (X7) = ORD (X6) = (X6) / Z=TURP
          BX6    X7+X3
          LX6    TP.ORDP
          SA6    A1 
 PIS7     LT     B5,B7,PIS4  IF MORE IL TO EXAMINE
  
          SX7    A0 
          SX2    F.IL 
          SA7    A2          UPDATE (N.EXST)
          WRITEW X2,B6,B7 
          EQ     EXIT.
  
 PISA     VFD    TH.SKELL/=XV=SEG,*P/0
          BSSZ   Z=TURP-1 
 END      SPACE  4,10 
          LIST   D
          END 
