*DECK     PRE 
          IDENT  PRE
 PRE      TITLE  PRE - SEQUENCE ACCUMULATION AND PRE PROCESSING 
*CALL     SSTCALL 
 B=PRE    RPVDEF
          PASS2TM 
  
 M.DOBGN  EQU    2           DO BEGIN MACRO NUMBER
  
**        PRE - SEQUENCE ACCUMULATION AND PRE PROCESSING
  
 M.BLK    EQU    2004B       MAX BLOCK SIZE ( IF EXT REFS ) 
  
          EXT    RRL,RLI,MACTYP,MACWDS,MACINS,O.EMRB,O.MAC,F.RDT
          EXT    OPTLVL,RSELECT,O.LOOP,L.LOOP,O.GLT,N.GL,O.API,N.AP 
          EXT    N.GL0,OPT2,CBN,O.LCM 
          EXT    LM,MU,TOV,O.TEND 
  
          TABLES TXT,CFT,IOL,APL,VDT,ALS,RND
          TABLES MOD
  
**        FLAGS 
  
          ENTRY  BRN
 BRN      BSS    2           BASE/LAST R-NUMBERS OCCURING IN THE BLOCK
  
 LSN      ENTRY. 0           LAST STATEMENT NUMBER ENCOUNTERED
  
 WB       ENTRY. 0           =1 IF IN A WELLBE LOOP, =1S59 IF OPT=0 
 M.TXT    CON    0           MAX *TXT* LENGTH ( WORKING STORAGE * 3/8 ) 
 RS       CON    0           "0 IF RETURNS IN APLIST ( OPT = 2 )
 XR       ENTRY. 0           EXTERNAL REFS IN BLOCK / SEQUENCE
 PAPL     CON    0           PREVIOUS LENGTH OF *APL* 
 PIOL     ENTRY. 0           PREVIOUS LENGTH OF *IOL* 
 AI       SPACE  3
**        AI. - APLIST INDEX TABLE ENTRY FORMAT 
  
          DESCRIBE AI.,60 
 EQV      DEFINE 1
 BASE     DEFINE 1           BASE MEMBER OF A CLASS OF EQUIV APLISTS
          DEFINE 4
 LINK     DEFINE 18 
 LEN      DEFINE 18 
 INDX     DEFINE 18 
  
 BIAS     DEQU   LEN
 ORD      DEQU   INDX 
 CFTE     SPACE  3,14 
**        CFTE - CONTROL FLOW TABLE ENTRY MACRO 
* 
*                FROM = BLOCK NUMBER OF *FROM* EDGE 
*                TO = BLOCK NUMBER / *IH* OF TARGET BLOCK 
*                TYPE = *IH* IF *TO* IS AN IH AND THIS IS A JUMP EDGE.
  
 CFTE     MACRO  FROM,TO,TYP
          IFC    EQ,/FROM/CBN/,2
          SA1    CBN
          ELSE   1
          R=     X1,FROM
          R=     X2,TO
          LX1    CF.FROMP 
          LX2    CF.TOP 
          IFC    EQ,/TYP/IH/,3
          MX0    1
          LX0    1+CF.IHP 
          BX2    X0+X2
          BX1    X1+X2
          ADDWRD CFT,X1 
          IF     DEF,/DEBUG/CFT,1 
          RJ     PFE
          ENDM
 DBG      IF     DEF,/DEBUG/CFT 
  
**        PFE - PRINT FLOW EDGE 
  
 PFE      ROUTINE 
          SX7    X6 
          SA7    PFEA+1 
          AX6    CF.FROMP 
          SX7    X6 
          SA7    A7-B1
          PL     X6,PFE1
          PRINT  CFT,(2I6,Z6),(LSN,PFEA,PFEA+1) 
          EQ     PFE
 PFE1     PRINT  CFT,(3I6),(LSN,PFEA,PFEA+1)
          EQ     PFE
  
 PFEA     BSS    2
 DBG      ENDIF 
 CFT      SPACE  2
**        CF - CONTROL FLOW TABLE FORMAT
*         BLOCK NUMBER CONVENTIONS
*                0 - EXIT BLOCK 
*                1 - PSEUDO ENTRY BLOCK 
*                2 - FIRST REAL BLOCK 
  
          DESCRIBE CF.,60 
 IH       DEFINE 1           "0 IF *TO* IS A SYMTAB ORD ( IH )
          DEFINE 11 
 FROM     DEFINE 18          BLOCK EDGE EMINATES FROM 
          DEFINE 12 
 TO       DEFINE 18          BLOCK NUMBER / IH OF SUCCESSOR 
 PRE      EJECT 
**        INITIALIZATION
  
 PRE      ENTRY.
          QUAL   CODE 
          SA2    =XN.FP 
          SA3    =XLEVEL2 
          BX7    X2+X3       FPL2 = N.FP ! LEVEL
          SA7    =XFPL2 
  
          SA1    =XCODE.
          CALL   CUB         CUB( CODE. )  */ CHANGE TO CODE. BLOCK 
  
*         INITIALIZE FIXED TABLES AT THE TOP OF CORE
*            *RA* , ... GLT , API , 0 , LOOP , MISC , SYMTAB , *FL*.
  
          SA1    =XLWAWORK
          SA4    =XR=FLAG 
          SB1    1
          BX6    X1          LW = LWAWORK 
          MX7    0
          ZR     X4,PRE1     IF R = 0      */ NO REFMAP 
          SA3    L.LOOP 
          LX3    1
          IX6    X6-X3       LW = LW - 2*L.LOOP 
          SA6    O.LOOP      O.LOOP = LW
  
 PRE1     SB6    -B1
          SA2    N.AP 
          SA3    N.GL 
          SX7    X2+B6       N.AP = N.AP - 1
          SB3    X6+B6
          IX6    X6-X7       LW = LW - N.AP 
          SA7    A2 
          SA6    O.API       O.API = LW 
          SB2    X6 
          SX7    X3+B6       N.GL = N.GL - 1
          IX6    X6-X7       LW = LW - N.GL 
          SA7    A3 
          SA7    N.GL0       N.GL0 = N.GL  */ NUMBER OF PASS 1 GL"S 
          SA6    O.GLT       O.GLT = LW 
          SX5    X6 
          SB1    X7 
          LE     B1,B0,PRE1B IF NO PASS 1 GL*S
          SETZERO X5,X7      ZERO GLT 
  
 PRE1B    SX6    X5+B6       LW = LW - 1
          SB1    1
          SA6    A1          LWAWORK = LW  */ FOR REFMAP
          SA6    O.TEND      O.TEND = LW
  
          MX7    1
+         SA7    B3          FOR I = N TO 0;  API(I) = *EQV*
          SB3    B3-B1
          GE     B3,B2,*
  
          CALL   CWS= 
          AX7    2           M.TXT = MAX-WORK-STORAGE / 4 
          SB2    X7 
          SB3    12000B 
          LE     B2,B3,PRE1A M.TXT = MIN( M.TXT , 12000B )
          SX7    B3+
 PRE1A    SA7    M.TXT
          AX1    B1,X6
          ALLOC  TXT,X1      GOOSE THE TABLE MANAGER
          SX7    4
          SA7    MU          MU = 4 
          SA7    A3          L.TXT = 4
  
*         INITIALIZE FOR GLOBAL FLOW ANALYSIS IF OPT \ 2
  
          SA1    OPT2 
          ZR     X1,PRE4     IF OPT2 = 0
  
          CALL   IMPA        INITIALIZE MASS I/O PROCESSING 
  
*         ALLOCATE AND CLEAR OUT A BASE TABLE FOR *UDI* 
  
          SA2    =XMAX.RL 
          SA5    LM          O.UDB = LM    */ USE/DEF HASH TABLE
          SX1    X2+101B
          ALLOC  TXT,X1      ALLOC( TXT , MAX.RL + 101B ) 
          IX6    X1+X5
          SA6    A5          LM = LM+100B+MAX.RL
          SX7    4
          SA6    A2          O.TXT = LM 
          SA7    A3          L.TXT = 4
          SETZERO X5,100B    SETZERO( O.UDB , 100B )
          ALLOC  UDI,2       ALLOC( UDI , 2 ) 
  
*         ENTER SPECIAL SYMBOLS WHICH ARE NOT DEAD ON EXIT IN *UDI* 
*         SO WE CAN FIND THEM EASLY LATER 
  
          SA1    =XVALUE. 
          SA5    =XFUNTYPE
          ZR     X1,PRE2     IF VALUE. = 0 */ NOT A FUNCTION SUBPROGRAM 
          SX5    X5-1 
          LX5    AP.P1P 
          BX1    X5+X1
          ADDWRD IOL,X1 
          SB2    B1 
          MX5    0
          SX6    A2          TBL = O.IOL
          CALL   CPL         ADD VALUE. TO IOL
          MX7    0
          SA7    L.IOL       L.IOL = 0
  
 PRE2     ALLOC  BST,4       ALLOC( BST , 4 )  */ RANDOM INDEX
  
          CFTE   1,2         FLOW( 1 , 2 )
          SA1    =XLCM.OA 
          BX6    X1 
          SA6    O.LCM       O.LCM = LCM.OA  */ SET BASE OF ALLOC LCM 
          SA2    =XRETURNS
          NZ     X2,PRE5     IF RETURNS " 0  */ NEED TO CHECK APLISTS 
  
 PRE4     SA1    PAL2 
          BX6    X1          [PAL1] = [PAL2]  */ PLUG CODE
          SA6    PAL1 
  
*         SETUP A *BOS* AT BEGINNING OF *TXT* AND *MOD*.
  
 PRE5     ALLOC  MOD,4
          SA5    F.RDT+OC.BOS 
          SA2    O.TXT
          SA1    O.SYM
          SA3    O.MOD
          MX6    0
          PX7    B1,X6
          SA7    X2 
          SA7    X3 
          SA6    X2+B1       [R2] = 0 
          SA6    X3+B1
          BX7    X5 
          SA7    A6+B1
          SA6    A7+B1
          SA7    X2+2 
          SA6    A7+B1
          SA6    X1-1        [O.SYM-1] = 0 */ SYM 0 IS ^FP, ETC ( GRA ) 
  
          ADDWRD ALS,B0      ADDWRD( ALS , 0 ) */ *ALS* SRCH TERMINATOR 
  
          SA1    OPTLVL 
          NZ     X1,PPS1     IF OPTLVL " 0
          MX6    1           WB = 1S59     */ FORCE SEQ ACCUMULATION
          SA6    WB                        */ TO END OF STMT
          EQ     PPS1 
          BSS    0
 PREBUF   EQU    PRE+1       FWA OF SCRATCH BUFFER SPACE
  
 L.INIT   EQU    *-PREBUF    L.INIT CODE, AVAILABLE AS A BUFFER 
 SCRB     SPACE  3
**        SCRB - DECLARE USE OF SCRATCH CELLS IN *INIT* CODE
  
 .SCR     SET    0
  
          MACRO  SCRB,LL,N
 LL       EQU    PREBUF 
 .SCR     MAX    .SCR,N 
          ERRPL  N-L.INIT    LL BUFFER EXCEEDS AVAIL SPACE
          ENDM
 PPS      TITLE  PPS - SEQUENCE PRE PROCESSING
**        PPS - PRE PROCESS SEQUENCE, MAIN LOOP 
  
 PPS0     RJ     ERM         ADD RLIST INSTRUCTIONS TO *TXT*
  
*         READ NEXT R-MACRO, CHECK FOR RLIST INSTRUCTION, SPECIAL OR
*         *MACROX* MACRO. 
  
 PPS1     RJ     RRL         GET NEXT RLIST INST/ MACRO 
          SA2    RLI+1       R1 = RLI(2)   */ R1  / HEADER WORD 
          UX7    B2,X2
          SB6    -B2
          SA7    BRN+1       [BRN+1] = HEADER WORD */ MAX R-NUM FOR *SQZ* 
          GT     B2,B1,PPS3  IF OC[R1] > OC.BOS  */ AN RLIST INSTRUCTION
          SB3    B2+=XMACORG
          SA1    O.MAC
          LE     B3,PPS2     IF -OC[R1] \ MACORG  */ *MACROX* MACRO 
          JP     PPS.M+B6    JUMP( -OC[R1] )
  
*         PPS.M - JUMP TABLE FOR THE SPECIAL MACROS 
  
          EQ     BOS         BEGINNING OF STMT MARKER 
 PPS.M    BSS    0
          LOC    0
          EQ     PPS6        EOQ
          EQ     PAL         APLIST 
          SB3    =XDOBGN
          EQ     PDB         DO BEGIN 
          SB3    =XDOEND
          EQ     PDE         DO END 
          SX6    OC.LD
          EQ     PAR         PROCESS ARRAY REFERENCE
          SX6    OC.ST
          EQ     PAR
          SX6    OC.STT 
          EQ     PAR
          EQ     *+1S17 
          EQ     EXM         EXPONENTIAL MACRO
          EQ     SFR         SAVE FUNCTION RESULT 
          EQ     PIO         I/O LIST USE/DEF INFO
          LOC    *O 
 PPS      EJECT 
**        PROCESS *MACROX* MACRO
  
 PPS2     CALL   EMR         EXPAND THE MACRO 
          SA1    MACTYP 
          SB2    X1+
          JP     PPS.MT+B2   JUMP( MACTYP(OC) ) 
  
 PPS.MT   BSS    0
          LOC    0
          EQ     PPS0 
          EQ     LAB         LABEL DEFINITION 
          EQ     ENT         ENTRY. DEFINITION
          EQ     EXIT        RETURN MACRO 
          EQ     UJP         UNCONDITIONAL JUMP 
          EQ     IFM         IF MACRO 
          EQ     AGO         ASSIGNED GOTO
          EQ     CGO         COMPUTED GOTO
          EQ     RJX         MACRO WITH A RETURN JUMP 
          EQ     RSM         REG STORE MACRO
          EQ     STM         STORE MACRO ( PROGRAMMER DEFINED VARIABLE )
          LOC    *O 
 PPS      SPACE  3
*         PROCESS RLIST INSTRUCTION 
  
 PPS3     RJ     ARI         ADD INSTRUCTION TO *TXT* 
          LX6    59-D.BMP 
          PL     X6,PPS1     IF ^BM[DI] 
  
          CALL   PROSEQ      PROCESS THE BLOCK
          SA1    CBN         PBN = CBN
          SX6    X1+B1       CBN = CBN + 1
          SA6    A1 
          CFTE   X1,X6       FLOW( PBN , CBN )
          EQ     PPS1 
  
 PPS4     RJ     ARI         ADD THE INSTRUCTION TO *TXT* 
  
 PPS5     SX7    0           L.RND = 0
          SA7    L.RND
          EQ     PPS1 
 EOQ      SPACE  3
 PPS6     SA2    L.TXT
          SX6    0           L.ALS = 0
          SA6    L.ALS
          SX7    X2-4 
          ZR     X7,PRE      IF L.TXT = 4 
  
          CALL   PROSEQ      CODE LAST SEQUENCE 
          EQ     PRE
 LAB      TITLE  SPECIAL MACRO PROCESSING 
**        LAB - LABEL DEFINITION
  
 LAB      RJ     RRL
          MX0    -IH.IL 
          SA1    RLI+1       R1 WORD
          LX0    IH.IP
          BX2    -X0*X1 
          NZ     X2,LAB1     IF NOT IN SYMTAB ( GL"S ARE ALWAYS ACTIVE )
          MX0    -L.ADF-P.RB
          SA4    CVI
          SA5    O.SYM
          MX7    0
          BX6    X4 
          SA6    A1+B1       [RLI+2] = CVI
          SA7    A4          CVI = 0
          LX1    1
          SB2    X1+B1
          EQ     B2,B1,LAB2  IF IH[R1] = 0 */ UNREACHABLE CODE MARKER 
          SA0    X5 
          SA2    A0-B2       WORDB = [O.SYM-2*IH-1] 
          BX6    X0*X2       CLEAR ADDRESS DEF AND BLOCK ORDINAL FIELDS 
          SA6    A2 
          LX2    59-P.GEN 
          MI     X2,LAB1     IF A *DO* GENERATED LABEL
          LX2    P.GEN-P.RSN
          PL     X2,PPS1     IF ^ REFERENCED */ INACTIVE
  
 LAB1     SA1    WB 
          NZ     X1,PPS4     IF WB " 0     */ ADD LABEL AND CONTINUE
          SA5    OPT2 
          NZ     X5,LAB3     IF OPT2 " 0
  
          RJ     ARI         ADD LABEL DEF TO *TXT* 
          SX6    B6-4 
          ZR     X6,PPS1     IF L.TXT = 4  */ LABEL DEF FIRST IN SEQ
          EQ     UJP1 
  
*         UNREACHABLE CODE
  
 LAB2     CALL   FSU         FORCE NEXT SEQUENCE UPPER
          EQ     PPS1 
 LAB      SPACE  3
*         OPT=2 LABEL DEFINITION PROCESSING 
  
 LAB3     SA3    L.TXT
          SB3    X3-4 
          ZR     B3,LAB4     IF L.TXT = 4  */ LABEL AT BEGINNING
  
          CALL   PROSEQ      PROCESS CURRENT SEQUENCE 
          SA1    CBN         PBN = CBN
          SX6    X1+B1       CBN = CBN + 1
          SA6    A1 
          CFTE   X1,X6       FLOW( PBN , CBN )
 LAB      SPACE  1,10 
*         DEFINE BLOCK NUMBER ASSOCIATED WITH THIS LABEL
  
 LAB4     RJ     ARI         ADD LABEL DEF TO *TXT* 
          SA2    CBN
          SB2    X1-I.GL-1
          MI     B2,LAB5     IF IH[R1] < I.GL 
          SA3    O.GLT
          BX6    X2 
          SA6    X3+B2       GLT(H-1) = CBN 
          EQ     PPS1 
  
 LAB5     SA3    O.SYM
          LX1    1
          SB2    X1+B1
          SA0    X3 
          SA4    A0-B2       WORDB = [O.SYM-2*IH-1] 
          BX6    X4+X2       BN[WORDB] = CBN */ SET BLOCK NUMBER IN SYMTAB
          SA6    A4 
          EQ     PPS1 
 ENT      SPACE  3,9
**        ENT - ALTERNATE ENTRY POINT DEFINITION
  
 ENT      RJ     ERM         ADD INSTRUCTION TO SEQ 
          SA3    OPT2 
          ZR     X3,PPS1     IF OPT2 = 0
  
          SA2    CBN
          CFTE   1,X2        FLOW( 1 , CBN ) */ PSEUDO ENTRY TO THIS
          EQ     PPS1 
 EXIT     SPACE  3,9
**        EXIT MACRO ( RETURN / NSRETURN )
  
 EXIT     RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SA1    WB 
          SA2    OPT2 
          NZ     X1,PPS5     IF WB " 0
          ZR     X2,UJP1     IF OPT2 = 0
  
          CFTE   CBN,B0      FLOW( CBN , 0 ) */ SHOW FLOW TO EXIT 
          EQ     UJP3 
 GOTO     SPACE  3,14 
**        GOTO - ASSIGNED / COMPUTED GOTO PROCESSING
  
 AGO      RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SA5    =XCBUF+2 
          SB5    B0          FLAG = 0 
          SX6    X5          N.BRANCH = CBUF(2) 
          NZ     X6,CGO1     IF N.BRANCH " 0
          SA1    WB 
          ZR     X1,UJP1     IF WB = 0
          EQ     PPS1 
 CGO      SPACE  2
 CGO      RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SA2    =XCBUF+1    CBUF(1) = -( N.BRANCH + 1 )
          SB5    B1          FLAG = 1 
          SX3    X2+B1
          BX6    -X3
  
 CGO1     SA1    O.TXT
          SB2    X1 
          SX2    B7-B2       LT = LTXT - O.TXT  */ SAVE OLD TXT LENGTH
          PX7    B5,X2
          SA7    CGOA+1      CGOA = N.BRANCH
  
 CGO2     SA6    CGOA 
          RJ     RRL         READ IN UJP
          RJ     ARI         ADD IT TO *TXT*
          SA1    CGOA 
          SX6    X1-1        CGOA = CGOA - 1
          NZ     X6,CGO2     IF CGOA " 0
  
          SA1    WB 
          SA2    OPT2 
          NZ     X1,PPS5     IF WB " 0
          ZR     X2,UJP1     IF OPT2 = 0
  
*         COLLECT FLOW INFO 
  
          ADDWRD TXT,B0 
          SA1    CGOA+1 
          SB2    X2 
          SA5    B2+X1       R1J = O.TXT + LT 
  
 CGO3     CFTE   CBN,X5,IH   FLOW( CBN , IH[R1J] )
          SA5    A5+4        R1J = R1J + 4
          NZ     X5,CGO3     IF [R1J] " 0 
  
          SA1    CGOA+1 
          SA2    L.TXT
          SX6    X2-1        L.TXT = L.TXT - 1
          UX3    B2,X1
          NZ     B2,CGO4     IF FLAG " 0   */ C GOTO
          BX6    X3          L.TXT = LT 
 CGO4     SA6    A2 
          EQ     UJP3 
  
 CGOA     SCRB   2
 IFM      SPACE  3,24 
**        IFM - IF MACRO PROCESSING 
  
 IFM      RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SA1    OPT2 
          SX7    0           L.RND = 0
          SA7    L.RND
          ZR     X1,PPS1     IF OPT2 = 0
  
*         COLLECT FLOW INFORMATION
  
          SB2    B1+B1
          SB4    B2+B2
          SB7    B7-B4       R1A = LTXT - 4  */ R1 OF LAST JUMP 
          SA5    B7          R1L = [R1A]
          UX4    B3,X5
          SX6    B3 
          SA6    IFMA        I = IFMA;  [I] = OC[R1L] */ OC OF LAST JP
  
 IFM1     SA4    B7+B2       DI = R1A + 2 
          SB7    B7-B4       R1A = R1A - 4
          LX4    59-D.JPP 
          SA3    A4-B1       R2 = DI - 1
          PL     X4,IFM3     IF ^JP[DI] 
          LX3    -IH.IHP
          LX4    D.JPP-D.TYP
          PL     X4,IFM2     IF TY[DI] = III
          SA3    A3-1        R1 = R2 - 1
          LX3    -R1.IHP
 IFM2     SX6    X3 
          SA6    A6+B1       I = I + 1;  [I] = IH[R2/R1]
          GE     B7,B6,IFM1  IF R1A \ FTXT
  
 IFM3     MX6    0
          SA6    A6+B1       I = I + 1;  [I] = 0
          SA5    IFMA+1      I = IFMA + 1 
  
 IFM4     CFTE   CBN,X5,IH   FLOW( CBN , [I] )
          SA5    A5+B1       I = I + 1
          NZ     X5,IFM4     IF [I] " 0 
  
          SA1    IFMA 
          SX6    X1-OC.UJP
          ZR     X6,UJP3     IF OC[LASTJP] = OC.UJP  */ TERMINATE BLOCK 
  
          CFTE   CBN,X1+B1   FLOW( CBN , CBN + 1 )
          EQ     UJP3 
  
 IFMA     SCRB   5
 UJP      SPACE  3,14 
**        UJP - UNCONDITIONAL JUMP  ( UJP LAB ) PROCESSING
  
 UJP      RJ     ERM         ADD INSTRUCTION TO *TXT* 
          SA1    WB 
          SA2    OPT2 
          SX7    0           L.RND = 0
          SA7    L.RND
          NZ     X1,PPS1     IF WB " 0     */ OPT=1  & OPTIMIZABLE LOOP 
          NZ     X2,UJP2     IF OPT2 " 0   */ FLOW ANALYSIS 
  
 UJP1     CALL   PROSEQ      PROCESS CURRENT SEQUENCE 
          EQ     PPS1 
  
 UJP2     SA3    B6          R1 = FTXT     */ R1 OF UJP 
          CFTE   CBN,X3,IH   FLOW( CBN , IH[R1] ) 
  
 UJP3     CALL   PROSEQ      PROCESS BLOCK
          SA1    CBN
          SX6    X1+B1       CBN = CBN + 1 */ ADVANCE TO NEXT BLOCK 
          SA6    A1 
          EQ     PPS1 
 RJX      SPACE  3,14 
**        RJX - MACRO THAT CONTAINS A RETURN JUMP 
  
 RJX      RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          MX6    1           APLF = 1S59
          SA6    XR 
          MX7    0
          SA2    B6+2        DI = R1 + 2   */ OF FIRST INSTRUCTION
          MX0    1
          LX2    59-D.LDP 
          SA7    L.RND       L.RND = 0
  
          PL     X2,RJX1     IF ^LD[DI]    */ MACRO IS AN RJ ONLY 
          SA3    B6+B1       IH = R1 + 1
          LX0    1+IH.LDP 
          BX6    X0+X3       LD[IH] = 1  ( TO INHIBIT ST/LD SQUEEZING ) 
          SA6    A3          APLF = [IH]
  
 RJX1     SA1    B7-4        R1 = LTXT - 4
          SA2    O.SYM
          SA5    OPT2 
          SA6    RJXA        RJXA = APLF
          LX1    1
          SA0    X2 
          SB2    X1+B1
          SA3    A0-B2       WORDB = [O.SYM-2*IH[R1]-1] 
          MX0    -L.FTYP
          LX3    -P.FTYP
          BX0    -X0*X3      F = FTYP[WORDB]
          SX7    X0+B1
          LX7    FI.FTP 
          SB3    X0 
          SA7    A1+B1       R2 = R1 + 1;  FT[R2] = F + 1 
  
*         PROCESS *BEF* 
  
          NE     B3,B1,RJX2  IF F " 1 
          LX3    P.FTYP-P.RA
          SX4    X3 
          LX4    FI.REGPP 
          BX7    X4+X7       REGP[R2] = RA[WORDB]  */ B-REGS PRESERVED
          SA7    A7 
          EQ     PPS1 
  
*         PROCESS I/O LIST FUNCTION 
  
 RJX2     ZR     B3,RJX3     IF F = 0 
  
 RJX2A    ZR     X5,PPS1     IF OPT2 = 0
          SA1    PIOL        INDX[R1+1] = PIOL
          SA2    L.IOL
          IX3    X2-X1       LEN[R1+1] = L.IOL - PIOL 
          ZR     X3,PPS1     IF LEN[R1+1] = 0 
          LX3    FI.LENP
          IX4    X3+X1
          BX7    X4+X7
          SA7    A7 
          BX6    X2          PIOL = L.IOL 
          SA6    A1 
          EQ     PPS1 
  
*         PROCESS USER FUNCTION 
  
 RJX3     SB5    X6-I.AP
          MI     B5,PPS1     IF IH[APLF] < I.AP */ NO APLIST
          SB5    X6-I.IO
          PL     B5,RJX2A    IF IH[APLF] \ I.IO */ BUF I/O COM SPOIL
          ZR     X5,RJX6     IF OPT2 = 0
  
*         COUNT APLIST LENGTH, CHAIN APLIST TO *UDI*
  
          SA5    PAPL 
          SA4    L.APL
          SA2    RETURNS
          IX6    X4-X5       LEN = L.APL - PAPL 
          SB2    X6 
          ZR     X2,RJX5     IF RETURNS = 0  */ NO RETURNS IN APLIST
          SA1    O.APL
          SB3    B2          N = LEN
          SB2    -B1         LEN = -1 
          SB4    X5 
          SA4    X1+B4       AI = O.APL + PAPL
 RJX4     SB5    X4          IHF = IH[A 
          SB2    B2+B1       LEN = LEN + 1
          SA4    A4+1        AI = AI + 1
          ZR     B5,RJX5     IF IHF = 0 
          LT     B2,B3,RJX4  IF LEN < N 
  
 RJX5     ZR     B2,RJX6     IF LEN = 0 
          SX6    O.APL
          CALL   CPL         CHAIN PARAMETER LIST TO *UDI*
          SA2    O.TXT
          SA3    L.TXT
          LX0    FI.LENP
          SA7    PIOL        PIOL = L.IOL 
          IX7    X2+X3
          SA5    X7-3        R2 = O.TXT + L.TXT - 3 
          BX1    X0+X1
          IX6    X1+X5
          SA6    A5 
  
 RJX6     SA3    RJXA 
          CALL   PPL         PROCESS PARAMETER LIST 
          EQ     PPS1 
  
 RJXA     SCRB   1
 RSM      SPACE  3
**        RSM - REG STORE MACRO 
  
 RSM      RJ     RRL         GET INSTRUCTION
          SA2    O.TXT
          SA5    L.TXT
          SA1    RLI+1       R1 
          IX7    X2+X5
          MX0    -R1.RIL
          SA4    X7-4 
          SB2    -4          WC = -4
  
 RSM1     BX6    X1-X4
          SA4    A4-4 
          BX7    -X0*X6 
          SB2    B2+4        WC = WC + 4
          NZ     X7,RSM1     IF RI"S DONT MATCH 
  
          NZ     B2,RSM2     IF WC " 0
          RJ     ARI
          EQ     PPS1 
  
 RSM2     SX0    B2 
          ALLOC  TXT,4       SUFFLE SEQUENCE TO GET RS NEXT TO DEF
          IX5    X2+X5
          IX2    X5-X0       FROM = O.TXT + OLD(L.TXT) - WC 
          SX3    X2+4        TO = FROM + 4
          SB2    X2 
          SX1    X0 
          RJ     MVE=        MOVE JUNK IN BETWEEN DEF UP
          SA1    RLI+1       R1 
          SA2    RLI
          BX6    X1 
          MX7    0
          SA6    B2          [R1] = [RLI+1] 
          SA7    B2+B1       [R2] = 0 
          BX6    X2 
          SA6    A7+B1
          SA7    A6+B1
          EQ     PPS1 
 STM      SPACE  3
**        STM - PROCESS STORE TO PROGRAMMER DEFINED VARIABLE
*         SEARCH *RND* FOR STORE INTO SAME *IH* AND CLEAR IF FOUND
  
 STM      RJ     ERM         EXPAND MACRO 
  
 STM0     SA2    L.RND
          SA1    O.RND
          ZR     X2,PPS1     IF L.RND = 0 
          SA4    O.SYM
          SB2    OC.ST
          MX0    -IH.IHL
          SB3    X1 
          SA3    B3+X2       LW = O.RND + L.RND 
          SA0    X4+
          BX7    X3          LAST = [LW]
  
 STM1     SB7    B7-4        LTXT = LTXT - 4
          SA5    B7          R1 = LTXT
          UX6    B4,X5
          NE     B4,B2,PPS1  IF OC[R1] " OC.ST
          LT     B7,B6,PPS1  IF LTXT < FTXT  */ END OF MACRO
          SA5    B7+B1       R2 = LTXT + 1
          BX6    -X0*X5 
          LX5    1
          SB5    X5+B1
          SA1    A0-B5       WORDB = [O.SYM-2*IH[R2]-1] 
          LX1    59-P.SUB 
          PL     X1,STM1     IF ^SUB[WORDB]  */ IH NOT USED IN SUBSCRIPT
          SA2    B3          I = O.RND
          SA6    A3          [LW] = IH[R2]
  
 STM2     BX4    X6-X2
          SA2    A2+1        I = I + 1
          SB5    X4 
          NZ     B5,STM2     IF IH[I-1] " IH[R2]
  
          AX4    IH.CAIHL 
          SA7    A3          [LW] = LAST   */ RESTORE WORD
          ZR     X4,STM1     IF RN[I-1] = 0  */ ENTRY NOT IN TABLE
  
          SX7    0
          SA7    L.RND       L.RND = 0
          EQ     PPS1 
 PAL      EJECT 
**        PAL - PROCESS APLIST MACRO
  
 PAL      SA1    X1+B1
          ADDWRD APL,X1 
  
*         COLLECT FLOW INFO IF *RETURNS* APPEARED ON A *CALL* 
*         AND OPT2 " 0 . OTHERWISE CODE IS BYPASSED BY A PLUG . 
  
 PAL1     SA1    O.SYM
          LX6    -AP.IHP
          SB2    X6+
          ZR     B2,PPS1     IF IH[AP] = 0
          SX4    X6-I.GL
          PL     X4,PPS1     IF IH[AP] \ I.GL 
  
          SA0    X1-1 
          SB3    B2+B2
          SA2    A0-B3       WORDB = [O.SYM-1-2*IH] 
          MX6    -L.TYP 
          LX2    -P.TYP 
          BX3    -X6*X2 
          SX4    X3-T.LAB 
          NZ     X4,PPS1     IF TYPE[WORDB] " T.LAB 
  
          SA6    RS          RS = 1        */ INDICATE SEQ TERMINATION WANTED 
          CFTE   CBN,B2,IH   FLOW( CBN , IH[AP] ) 
 PAL2     EQ     PPS1 
 PIO      SPACE  3,14 
**        PIO - PROCESS I/O SYMBOL LIST FOR OPT=2 USE/DEF INFO
  
 PIO      LX2    -R1.SOP     RIGHT JUSTIFY FORMAT SYMBOL ORDINAL
          MX0    -R1.SOL
          BX6    -X0*X2 
          LX2    -R1.INP+R1.SOP RIGHT JUSTIFY OPERAND COUNT 
          ZR     X6,PIO2     IF NO FORMAT 
          SA1    O.SYM
          IX0    X6+X6       I*ORDINAL
          IX0    X1-X0
          SA1    X0-1        WORDB = [O.SYM-2*ORD-1]
          MX0    59 
          BX6    -X0*X1      BIT 0 = 1 MEANS V OR = IN FORMAT 
          LX6    -1 
          ZR     X6,PIO2
          SB2    X2          LENGTH, NO OF ENTRIES IN TABLE 
          SA5    O.MAC       ADDRESS OF MACRO REF, SEE READRL 
          SA5    X5 
 PIO1     SA5    A5+B1       X5 = IOLIST ENTRY
          BX7    -X6*X5      CLEAR DEF BIT IF V OR = IS IN FORMAT 
          SA7    A5          REPLACE MODIFIED IOLIST ENTRY
          SB2    B2-B1       N = N - 1
          NZ     B2,PIO1
 PIO2     SX6    O.MAC       ADDRESS OF MACRO REF, SEE READRL 
          SX5    B1          TABLE INDEX OF PARAMETER LIST
          SB2    X2          NUMBER OF ENTRIES IN TABLE 
          CALL   CPL         CHAIN I/O LIST ENTRIES TO *UDI*
          EQ     PPS1 
 BOS      EJECT 
**        BOS - PROCESS BEGIN OF STATEMENT MARKER 
  
 BOS      SA5    O.TXT
          SA4    L.TXT
          IX6    X4+X5
          SB7    X5+B1
          SA3    X6-4 
          UX7    B2,X3
          NE     B2,B1,BOS1  IF LAST IN *TXT* IS NOT A *BOS*
          BX7    X2 
          SA7    A3          OVERWRITE PREVIOUS *BOS* 
          AX7    R1.INP 
          SX6    X7 
          SA6    LSN         SET LAST STMT NUMBER 
          SX4    X4-4 
          NZ     X4,PPS1     IF NOT FIRST *BOS* 
          SA6    =XLINENR    LINENR = FSN  */ SET FIRST STMT NUMBER 
          SX7    X2 
          SA7    BRN         BRN = RI[R1]  */ BASE R-NUMBER 
          EQ     PPS1 
  
 BOS1     SA1    M.TXT
          SA2    OPTLVL 
          ZR     X2,BOS5     IF OPT = 0 
          SA3    RS 
          NZ     X3,BOS6     IF RS " 0     */ RETURNS TERMINATION 
          SA2    XR 
          IX6    X4-X1
          PL     X6,BOS4     IF L.TXT \ M.TXT 
          SX6    X4-M.BLK 
          MI     X6,BOS2     IF L.TXT < M.BLK 
          NZ     X2,BOS4     IF XR " 0     */ EXT REFS
  
*         ADD THE *BOS* TO THE SEQUENCE AND CONTINUE
  
 BOS2     RJ     ARI         ADD *BOS* TO *TXT* 
          AX1    R1.INP 
          SX7    X1 
          SA7    LSN         LSN = IN[R1] 
          SX6    0
          SA6    XR          XR = 0 
          EQ     PPS1 
  
 BOS4     SA4    OPT2 
          NZ     X4,BOS6     IF OPT2 " 0
  
          SA1    WB 
          AX6    B1,X1       WB = SHIFT(WB,-1)  */ CLEAR WB IF = 1
          SA6    A1 
  
 BOS5     CALL   PROSEQ      PROCESS THE ACCUMULATED INSTRUCTIONS 
          SA2    RLI+1
          EQ     BOS
  
*         OPT=2 AND SEQ OVERFLOW OR RETURNS TERMINATION 
  
 BOS6     CALL   PROSEQ      TERMINATE SEQUENCE 
          SA1    CBN         PBN = CBN
          MX7    0
          SX6    X1+B1       CBN = CBN + 1
          SA7    RS          RS = 0 
          SA6    A1 
          CFTE   X1,X6       FLOW( PBN , CBN )
          SA2    RLI+1
          EQ     BOS
 PSX      SPACE  3,8
 EXM      TITLE  EXM - EXPAND EXPONENTIAL MACRO 
**        EXM - EXPAND EXPONENTIAL MACRO
*         ALGORITHM ADAPTED FROM ARTICLE ON LOCAL OPTIMIZATIONS BY
*         J.C. BAGWELL IN SIGPLAN, JULY 1970. 
*         RMACRO ARGUMENT WORDS - 
*         WORD 1 28/,16/RI[OPERAND],16/RI[RESULT] 
*         WORD 2 24/,18/OPCODE,18/EXPONENT ( N )
  
 EXM      SA2    X1+B1       RI[OP],RI[RESULT]
          MX0    -RM.RIL
          SA3    A2+B1       OC.XX,EXP
          BX6    -X0*X2 
          AX2    RM.RIL 
          BX7    -X0*X2 
          SA7    EXMC        EXMC(1) = RI[OP] 
          SA5    EXMB-2+X3   ECW = EXMB(N) */ EXPANSION CONTROL WORD
          AX3    RM.CAL 
          SX0    X3 
          SA6    EXMC+X5     EXMC(N.INST) = RI[RESULT]
  
*         FILL IN INTERMEDIATE R-NUMBERS IN *EXMC*
  
          SX1    X5 
          LX1    2
          SB2    X5-1 
          ZR     B2,EXM2
          SA4    =XNIRN 
          SX6    X4+B2
          SX7    X4+B2       NIRN = NIRN + N.INST - 1 
 EXM1     SX6    X6-1 
          SB2    B2-B1
          SA6    A6-B1
          NZ     B2,EXM1
          SA7    A4 
  
 EXM2     ALLOC  TXT,X1      ALLOC( TXT , 4*N.INST )
          SB7    X2+B6
          SA3    EXMC+1      I = EXMC(2);  R = [I]
          SB2    X0 
          MX0    -3 
  
*         GENERATE A SERIES OF MULTIPLY MACROS, BASED ON THE *ECW*
  
 EXM3     LX5    3           ECW = SHIFT(ECW,3) 
          BX6    -X0*X5      J = OGET[ECW]
          ZR     X6,PPS1     IF J = 0      */ END OF EXPANSION
          SA4    EXMA-1+X6   OCW = EXMA(J)
          SB3    A3 
          SA1    B3+X4       RK = EXMC( I - RKO[OCW] )
          AX4    18 
          SA2    B3+X4       RJ = EXMC( I - RJO[OCW] )
          LX1    R1.RKP 
          LX2    R1.RJP 
          BX3    X3+X1
          MX7    0           R2 = 0 
          IX6    X3+X2       R1 = TYI(OC,RJ,RK,R) 
          RJ     SRI         SRI( R1 , R2 , OC ) */ STORE THE INST
          SA3    A3+B1       I = I + 1;  R = [I]
          EQ     EXM3 
  
**        EXMA - TABLE OF OPERAND R-NUMBER INDICES
  
 EXORN    MACRO  RJ,RK
          VFD    24/,18/-RJ,18/-RK
          ENDM
  
 EXMA     BSS    0
          LOC    1
          EXORN  1,1         (RI-1)*(RI-1)
          EXORN  1,2         (RI-1)*(RI-2)
          EXORN  1,3         (RI-1)*(RI-3)
          EXORN  1,4         (RI-1)*(RI-4)
          EXORN  1,5         (RI-1)*(RI-5)
          EXORN  2,3         (RI-2)*(RI-3)
          EXORN  3,4         (RI-3)*(RI-4)
          LOC    *O 
  
 EXOC     MACRO  A
 .N       SET    0
 .S       SET    A_B
          DUP    14,4        COUNT NUMBER OF OGITS IN STRING
 .S       SET    .S/8 
 .N       SET    .N+3 
          IFEQ   .S,0,1 
          STOPDUP 
          VFD    .N/A_B,*P/.N/3 
          ENDM
          NOREF  .N,.S
  
**        EXMB - EXPONENTIAL MACRO EXPANSION SKELTON CONTROL TABLE
*         FORMAT - 42/DDDD0,18/N.INST ( IN MACRO EXPANSION )
*                D = DIGIT INDICATING OPERANDS OF MULTIPLY OPERATOR.
*                I.E. AN INDEX INTO *EXMA*. 
  
 EXMB     BSS    0
          LOC    2
          EXOC   1           X**2 
          EXOC   12          X**2 * X 
          EXOC   11          (X**2)**2
          EXOC   113         (X**2)**2 * X
          EXOC   112         (X**2)**2) * X**2
          EXOC   1162        (X**2)**2 * (X**2 * X) 
          EXOC   111         ((X**2)**2)**2 
          EXOC   1114 
          EXOC   1131 
          EXOC   11623
          EXOC   1112 
          EXOC   11125
          EXOC   11124
          EXOC   12113
          EXOC   1111        (((X**2)**2)**2)**2
          LOC    *O 
  
 EXMC     SCRB   7           R-NUMBER BUFFER
 SFR      TITLE  SFR - SAVED FUNCTION RESULT MACRO
**        SFR - SAVE FUNCTION RESULT MACRO
*         THE EXPANSION OF THE MACRO IS JUST A STORE TO TEMPORARY,
*         BUT LATER IN THE STATEMENT, THE SAME R-NUMBER IS USED IN A
*         *LD* FROM THE TEMP, WHICH WE CANT ALLOW.
  
*         SEARCH BACKWARD FOR THE DEFINATION OF THE R-NUMBER IN THE STORE 
*         AND CHANGE THE OCCURANCE OF IT TO AN INTERMEDIATE R-NUMBER. 
  
 SFR      SX1    4
          RJ     ISE         INITIALIZE FOR AN EXPANSION
  
          SB4    4
          MX0    -R1.RIL
          SA4    B7-B4
          SA1    A0+B1       RI = [BASE+1]
          SB2    OC.ST
  
 SFR1     BX6    X4-X1
          BX7    -X0*X6 
          SA4    A4-B4
          NZ     X7,SFR1     IF RI[TXT] " RI
  
          SA4    A4+B4
          BX5    X0*X4
          SX6    B6 
          IX7    X5+X6       RI[TXT] = NIRN 
          SA7    A4 
          SA1    A0 
          SA2    A0+2 
          LX1    IH.IHP 
          LX2    IH.CAP 
          BX7    X1+X2
          RJ     SRI         ST  NIRN,0,IH,CA 
          SB6    B6+B1       NIRN = NIRN + 1
          RJ     TSE         TERMINATE THE EXPANSION
          EQ     PPS1 
 PDM      TITLE  PDM - PROCESS DO BEGIN/END MACROS
**        PDM - PROCESS DO BEGIN/END MACROS 
  
 PDB      MX0    -1 
          AX2    18+2 
          EQ     PDB1 
  
 PDE      MX0    -2 
          LX2    -R1.INP
          SB7    X2          WC = IN[R1]
          LX2    R1.INP-18
  
 PDB1     BX3    -X0*X2 
          SA4    X1+4        DOI = [O.MAC+4]  */ LOOP INFO WORD 
          SB3    X3+B3       OC[O.MAC] = BASE + CV(B/CD)[RLI(2)]
          SA3    O.LOOP 
          SB2    B2+M.DOBGN 
          SA5    LSN
          SB4    -B3
          PX7    B4,X7
          SB3    X3 
          SA7    X1 
          NZ     B2,PDE1     IF OC " M.DOBGN
  
*         ADD INFO FROM RMACRO TO LOOP TABLE FOR REFMAP 
  
          ZR     X3,PDB2     IF O.LOOP = 0 */ NO LOOP TABLE 
          MX0    24 
          BX6    X0*X4       LOOP(LN[DOI]) = [DOI]
          LX4    -18
          SA6    B3+X4
          BX7    X5          LOOP(LN[DOI]+1) = LSN
          SA7    A6+B1
  
*         IF OPT = 1 AND LOOP IS OPTIMIZABLE, THEN SET WB = 1 
  
 PDB2     SA2    OPTLVL 
          SX0    167B        NON OPTIMIZABLE LOOP FLAGS 
          SX7    X2-1 
          NZ     X7,PDB4     IF OPTLVL " 1
  
          SA3    O.SYM
          SA2    X1+B1
          SA0    X3 
          LX2    1
          SB3    X2+B1
          LX0    P.FLG
          SA4    A0-B3       WORDB = [O.SYM-2*IH[LGL]-1]
          BX7    X0*X4
          NZ     X7,PDB4     IF OPTF[WORDB] " 0  */ LOOP NOT OPTIMIZABLE
  
          SX7    B1 
          SA7    WB          WB = 1 
  
 PDB4     CALL   EMR         EXPAND MACRO 
          RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SX7    0
          SA7    L.RND       L.RND = 0
  
*         ADD LOOP CV TO ACTIVE LOOP STACK AND ENTER IN *UDI* 
  
          SA1    B7-3        R2L = LTXT - 3 
          ADDWRD ALS,X1      ADDWRD( ALS , CAIH[R2L] )
          SA5    OPT2 
          ZR     X5,PDB5     IF OPT2 = 0
          SX6    A2 
          SB2    B1 
          SX5    X3-1 
          CALL   CPL         GET *UDI* INDEX OF LOOP CV 
          SX7    X7-1 
          SX6    B5 
          SA7    A7          L.IOL = L.IOL - 1
          SA6    CVI         CVI = CPL(CA,HI)  */ *UDI* INDEX OF CV 
          EQ     PPS1 
  
 PDB5     SA1    WB 
          SX6    X1-1 
          NZ     X6,PPS1     IF WB " 1
  
          SA6    A1+         WB = 0 
          CALL   PROSEQ      CODE THE PROLOGUE
          SX6    1
          SA6    WB          WB = 1 
          EQ     PPS1 
  
 CVI      BSSZ   1           *UDI* INDEX OF LOOP CONTROL VAR
 PDM      EJECT 
*         PROCESS DO END
  
 PDE1     SA2    L.ALS
          SX6    X2-1        L.ALS = L.ALS - 1
          SB3    B3+B1
          SA6    A2 
          ZR     B7,PPS1     IF WC = 0     */ 1 TRIP LOOP DO-END MACRO
  
          ZR     X3,PDE2     IF O.LOOP = 0
          LX4    -18
          SA2    B3+X4
          LX5    18 
          BX7    X5+X2
          SA7    A2          LOOP(LN[DOI]+1) = LSN+FSN    FOR LOOP
  
*         ADD INSTRUCTIONS TO *TXT*, SET *RF* BIT FOR *LD*"S IN MACRO 
*         SINCE THEY MUST ALL BE < 377777B ( REFERENCE MANUAL ).
  
 PDE2     CALL   EMR         EXPAND THE MACRO 
          SA2    F.RDT+OC.LD
          SX3    B1 
          LX3    D.RFP
          BX6    X3+X2       RF[RDT(OC.LD)] = 1 
          SA6    A2 
          RJ     ERM         ADD INSTRUCTIONS TO *TXT*
          SA2    F.RDT+OC.LD
          SA1    OPT2 
          SX3    B1 
          LX3    D.RFP
          BX6    -X3*X2      RF[RDT(OC.LD)] = 0 
          SA6    A2 
          ZR     X1,UJP1     IF OPT2 = 0
  
          SA3    B7-3        R2J = LTXT - 3  */ LOOP BACK JUMP
          SA5    CBN
          CFTE   X5,X3,IH    FLOW( CBN , IH[R2J] )
          CFTE   X5,X5+B1    FLOW( CBN , CBN + 1 )
          EQ     UJP3 
 PPL      TITLE  PPL - PROCESS PARAMETER LIST 
**        PPL - PROCESS PARAMETER LIST
*                SETUP *API* TABLE ENTRY DESCRIBING THE PARAM LIST. 
*                THEN TRY TO REDUCE THE LIST IF IT IS COMMON WITH THE 
*                TAIL END OF ANOTHER APLIST.
* 
*         ENTRY  (X3) = IH OF PARAMETER LIST
  
 PPLA     BFMW   AP,(ST,CAIH) 
  
 PPL0     SX6    B4+
          SA6    PAPL        PAPL = L.APL 
  
 PPL      ROUTINE 
          SB7    X3-I.AP     N = H[IH]     */ APLIST NUMBER 
          SA1    O.API
          SA2    PAPL 
          SA3    L.APL
          SA0    X1-1 
          IX7    X3-X2
          SB5    X7          LN = LEN[N]   */ LENGTH OF THIS LIST 
          LX7    AI.LENP
          SB4    X3          IN = INDX[N]  */ INDEX TO LWA+1
          LX3    AI.INDXP 
          BX6    X7+X3
          SA6    A0+B7       API(N) = AINFO(0,0,L.APL-PAPL,L.APL) 
  
*         NOW SEARCH THE ACCUMULATED APLISTS AND ATTEMPT TO ELIMINATE 
*         ANY COMMON APLISTS
  
          SA4    O.APL
          SA5    X4-1        BASE = O.APL - 1 
          SA1    PPLA 
          SB6    B7          J = N
          BX6    X1 
  
 PPL1     SB6    B6-B1       J = J - 1
          SA1    A0+B6       AJ = API(J)
          ZR     B6,PPL0     IF J = 0 
          LX1    59-AI.EQVP 
          MI     X1,PPL1     IF EQV[AJ] 
  
          LX1    1+AI.EQVP-AI.INDXP 
          SB2    X1          IJ = INDX[AJ]
          LX1    AI.INDXP-AI.LENP 
          SB3    X1          LJ = LEN[AJ] 
          SX0    X1 
          SX7    B6 
          LT     B3,B5,PPL2  (LS,EI) = IF( LJ < LN )  (LJ,J) ELSE (LN,N)
          SX0    B5 
          SX7    B7 
  
 PPL2     SA2    A5+B4       SN = BASE + IN 
          SA3    A5+B2       SI = BASE + IJ 
          BX4    -X0         M = -LS
  
 PPL3     BX5    X2-X3
          SX4    X4+1        M = M + 1
          BX3    X6*X5
          NZ     X3,PPL1     IF (ST,CAIH)[SN] " (ST,CAIH)[SJ] 
          SA2    A2-B1       SN = SN - 1
          SA3    A3-B1       SJ = SJ - 1
          NZ     X4,PPL3     IF M " 0 
  
*         EQUIVALENCE THE SHORTER LIST TO THE LONGER ONE
  
          SX5    B6+B7
          MX6    1
          LX6    1+AI.EQVP
          IX4    X5-X7       ORD[API(EI)] = J + N - EI
          SX3    B3+B5
          LX4    AI.ORDP
          LX0    1
          IX2    X3-X0       BIAS[API(EI)] = MAX(LJ,LN) - LS
          LX2    AI.BIASP 
          IX4    X2+X4
          BX6    X4+X6
          SB6    X7 
          SA6    A0+B6
          SX7    B4-B5                     (X7) = PAPL
          LX4    -AI.ORDP    K = ORD[API(EI)]  */ ORD OF BASE OF CLASS
          SB5    X4 
          SA4    A0+B5
          SX6    B1 
          LX6    AI.BASEP 
          BX6    X6+X4       BASE[API(K)] = 1  */ MARK AS *BASE*
          SA6    A4 
          NE     B6,B7,PPL4  IF EI " N     */ ELIMINATED NOT LAST 
          SA7    L.APL       L.APL = PAPL 
          EQ     PPL
  
*         LOWER ONE IS SHORTER, MOVE APLISTS ABOVE IT DOWN
  
 PPL4     SB6    B6+B1       K = J + 1
          SX4    B3 
          LX4    AI.INDXP 
          SA1    L.APL
  
 PPL5     SA2    A0+B6       AK = O.API-1 + K 
          SB6    B6+B1       K = K + 1
          LX2    59-AI.EQVP 
          MI     X2,PPL6     IF EQV[AK] 
          IX6    X2-X4
          SA6    A2+         INDX[AK] = INDX[AK] - LEN[AJ]
 PPL6     LE     B6,B7,PPL5  IF K @ N 
  
          LX4    -AI.INDXP
          IX6    X1-X4       L.APL = L.APL - LEN[AJ]
          SA6    A1 
          SA6    PAPL        PAPL = L.APL 
          SB6    A5+B1
          SX2    B6+B2
          IX3    X2-X4
          MOVE   B4-B2,X2,X3 MOVE( IN-IJ , O.APL+IJ , O.APL+IJ-LJ ) 
          EQ     PPL
 ARI      TITLE  SUBROUTINES
**        ARI - ADD RLIST INSTRUCTION TO SEQUENCE 
* 
*         EXIT   (B6) = L.TXT - 4 , PREVIOUS VALUE OF *L.TXT* 
*                (X1) = [R1] , R1 WORD OF INSTRUCTION 
*                (X6) = DESCRIPTOR
  
 ARI0     SA3    A1-B1       DESCR
          LX7    X2 
          SA7    X4+B1
          BX6    X3 
          MX7    0
          SA6    A7+B1
          SA7    A6+B1       [R1+3] = 0 
 ARI      ROUTINE 
          ALLOC  TXT,4
          SA1    RLI+1       R1 
          SX4    X2+B6
          SA2    A1+B1       R2 
          BX6    X1 
          SA6    X4 
          EQ     ARI0 
 ISE      SPACE  3           ISE
**        ISE - INITIALIZE SPECIAL MACRO EXPANSION
* 
*         ENTRY  (X1) = 4* MAX NUMBER OF INSTRUCTIONS IN EXPANSION
  
 ISE      ROUTINE 
          ALLOC  TXT,X1 
          SA5    NIRN 
          SA1    O.MAC
          SB7    X2+B6       (B7) = STORE ADDRESS 
          SB6    X5          (B6) = NEXT AVAIL R-NUMBER 
          SA0    X1+B1       (A0) = FWA OF MACRO PARAMETERS 
          EQ     ISE
 SRI      SPACE  3,8         SRI
**        SRI - STORE RLIST INSTRUCTION 
* 
*         ENTRY  (B2,X6,X7) = OPCODE, R1,R2 WORDS 
* 
*         EXIT   (A6,X6) = DESCRIPTOR 
  
 SRI      ROUTINE 
          SA4    F.RDT+B2 
          PX6    B2,X6
          SA7    B7+B1       R2 
          SA6    B7          R1 
          MX7    0
          BX6    X4 
          SA6    A7+B1       DESCR
          SA7    A6+B1       LINK = 0 
          SB7    A7+B1       SA = SA + 4
          EQ     SRI
 TSE      SPACE  3,8         TSE
**        TSE - TERMINATE SPECIAL EXPANSION 
  
 TSE      ROUTINE 
          SA4    O.TXT
          SX6    B6 
          SB4    X4 
          SA6    NIRN 
          SX7    B7-B4
          SA7    L.TXT       UPDATE L.TXT 
          EQ     TSE
 ERM      SPACE  3,8         ERM
**        ERM - EXPAND REFERENCED MACRO 
*         EXIT   (B6) = FTXT = FWA OF MACRO EXPANSION 
*                (B7) = LTXT = LWA+1 OF MACRO EXPANSION 
  
 ERM1     SA6    A7-B1       [TA+1] = 0    */ CLEAR R2 WORD 
          SB7    B7+B4       TA = TA + 4
          ZR     B5,ERM      IF N = 0 
  
 ERM2     UX3    B3,X5       OC = OC[W] 
          BX6    X5 
          SA4    A0+B3       D = RDT(OC)
          SA5    A5+B1       W = W + 1
          SB5    B5-B4       N = N - 4
          BX7    X4 
          SA6    B7          [TA] = [W-1] 
          AX4    D.TYP
          BX3    X0+X4
          SX2    X3+B1
          SA7    B7+B2       [TA+2] = [D] 
          MX6    0
          SA6    A7+B1       [TA+3] = 0    */ CLEAR LINK WORD 
          NZ     X2,ERM1     IF TYPE[DI] " III
  
          BX7    X5 
          SA5    A5+B1       W = W + 1
          SB7    B7+4        TA = TA + 4
          SA7    A7-B1       [TA-2] = [W-1] 
          NZ     B5,ERM2     IF N " 0 
  
 ERM      ROUTINE 
          SA1    MACINS 
          SA5    O.EMRB      W = O.EMRB 
 ERM3     LX1    2
          ALLOC  TXT,X1      ALLOC( TXT , 4*MACINS )
          SA0    F.RDT
          SB2    B1+B1
          SB4    B2+B2
          MX0    -D.TYL 
          SB5    X1          N = 4*MACINS 
          SB6    X2+B6
          MX6    0
          SB7    B6          TA = O.TXT + (L.TXT-4*MACINS)
          SA6    MACWDS      MACWDS = 0 
          EQ     ERM2 
 PAR      TTL    PRE / PAR - PROCESS ARRAY REFERENCE
 PAR      TITLE  ISSUE MACRO
          MACRO  OPR,N,P
 N$T      MICRO  18-15,3,/P/
          ENDM
  
*CALL     OPRDEFS 
  
**        ISSUE - MACRO TO ISSUE AN RLIST INSTRUCTION 
  
 ISSUE    MACROE OP,IH,CA,RF,RJ,RK,IN,TY,CAIH 
 CAT      IFC    NE, CAIH 
 IHT      MICRO  1,,/CAIH/
 CAT      ELSE
 IHT      MICRO  1,,/IH/
 CAT      ENDIF 
 TYT      IFC    NE, TY 
          TYPE_TY  OP,"IHT",CA,RF,RJ,RK,IN
 TYT      ELSE
          TYPE"OP$T" OP,"IHT",CA,RF,RJ,RK,IN
 TYT      ENDIF 
          ENDM
  
 TYPEI    MACRO  OP,IH,CA,RF,RJ,RK,IN 
          SX6    B7 
 OPT      IFC    NE, OP B3
          SB3    OC.OP
 OPT      ENDIF 
          LX6    R1.RIP 
 RJT      IFC    NE, RJ 
          L_RJ   R1.RJP 
          BX6    X6+RJ
 RJT      ENDIF 
 RKT      IFC    NE, RK 
          L_RK   R1.RKP 
          BX6    X6+RK
 RKT      ENDIF 
          SB7    B7+B1
          PX7    B3,X6
          SA7    B2 
          SB2    B2+B1
          ENDM
  
 TYPEII   MACRO  OP,IH,CA,RF,RJ,RK,IN 
          SX6    B7 
 OPT      IFC    NE, OP B3
          SB3    OC.OP
 OPT      ENDIF 
          LX6    R1.RIP 
 INT      IFC    NE, IN 
          L_IN   R1.INP 
          BX6    X6+IN
 INT      ENDIF 
          SB7    B7+B1
          PX7    B3,X6
          SA7    B2 
          SB2    B2+B1
          ENDM
  
 TYPEIII  MACRO  OP,IHR,CA,RF,RJ,RK,IN
          SX6    B7 
 OPT      IFC    NE, OP B3
          SB3    OC.OP
 OPT      ENDIF 
          LX6    R1.RIP 
 CAT      IFC    NE, CA 
          L_CA   IH.CAP 
 CAT      ENDIF 
          PX7    B3,X6
          SA7    B2 
          SB7    B7+B1
 RFT      IFC    NE, RF 
          L_RF   IH.RFP 
 IHT      IFC    NE, IHR
          L_IHR  IH.IHP 
          BX6    RF+IHR 
 CAT      IFC    NE, CA 
          BX6    X6+CA
 CAT      ENDIF 
 IHT      ELSE
 CAT      IFC    NE, CA 
          BX6    RF+CA
 CAT      ELSE
          BX6    RF 
 CAT      ENDIF 
 IHT      ENDIF 
 RFT      ELSE
 IHT      IFC    NE, IHR
          L_IHR  IH.IHP 
 CAT      IFC    NE, CA 
          BX6    CA+IHR 
 CAT      ELSE
          BX6    IHR
 CAT      ENDIF 
 IHT      ELSE
 CAT      IFC    NE, CA 
          BX6    CA 
 CAT      ELSE
          MX6    0
 CAT      ENDIF 
 IHT      ENDIF 
 RFT      ENDIF 
          SA5    =XMACINS    NUMBER OF TYPE 3/S GENERATED 
          SA6    B2+B1
          SX6    X5+B1
          SB2    A6+B1
          SA6    A5          MACINS = MACINS + 1
          ENDM
 TABLES   TITLE  TABLE FORMATS
**        TERM TABLE FORMAT.
  
          DESCRIBE TT.,60 
 LD       DEFINE 18          LOOP DEPTH 
 P        DEFINE 18          LINK TO RND
 SUB      DEFINE 6           SUBSCRIPT TERM ORDINAL 
 MC       DEFINE 18          MULTIPLICITIVE CONSTANT
  
**        R-NUMBER DEFINITION TABLE.
  
          DESCRIBE RN.,60 
          DEFINE 6
 RI       DEFINE 18          R-NUMBER OF VARIABLE 
 CA       DEFINE 18          BIAS 
 IH       DEFINE 18          SYMBOL ORDINAL 
  
 CAIH     DEQU   IH,36
  
 MDIMS    =      3           MAX NUMBER OF DIMENSIONS 
  
*         ITS - IXFN TEMPORARY STORAGE, INITIALIZED AT START OF PAR.
  
 IXFNO    BSS    0           SAVE ORG COUNTER 
          ORG    PREBUF+.SCR+1
 O.ITS    BSS    0
 TIF      BSS    1           TERM ISSUED FLAG 
 CA       BSS    1           CONSTANT ADDEND
  
**        TTS - TERM TEMPORARY STORAGE. 
*         INITIALIZED AT START OF PROCESSING FOR EACH UNIQUE IH,CA. 
  
 O.TTS    BSS    0
 STF      BSS    1           SUB-TERM ISSUED FLAG 
 SCC      BSS    MDIMS       SUBSCRIPT COMPUTATION COEFFICIENTS 
 L.TTS    EQU    *-O.TTS
 L.ITS    EQU    *-O.ITS
  
 ITT      BSS    2*MDIMS+1     IXFN TERM TABLE
 OP       BSS    1
 MRESULT  BSS    1           HOLDS 1/XMTC-FLAG,59/R-NUMBER OF PRODUCT 
 TEMP     BSS    5
 LRND     BSS    1           LOCAL L.RND
 LVDT     BSS    1           LOCAL L.VDT
*                                  DIT,CDC,VDS PRESERVED BETWEEN CALLS
 DIT      BSS    MDIMS       DIMENSION INDEX TABLE
 CDC      BSS    MDIMS       CONSTANT DIMENSION COEFFICIENTS
 VDS      BSS    MDIMS       VARIABLE DIMENSION SYMBOLS 
          ERRPL  *-PREBUF-L.INIT   MAKE INIT CODE LONGER
          ORG    IXFNO       RESTORE ORG COUNTER
  
          USE    /TABLES/ 
 ICB      BSS    200B        IXFN CODE BUFFER 
          USE    0
  
 PDIM     BSSZ   1           DIM WORD OF PREVIOUS IXFN
 PAR      TITLE  MAIN LOOP
**        PAR - PROCESS ARRAY REFERENCE ( IXFN )
*         LOOP THROUGH VARIABLE INFORMATION OF IXFN MACRO (A1 CONTAINS
*         ADDRESS OF FIRST VARIABLE TERM WORD ON EXIT FROM ISP).  PVT 
*         IS CALLED TO PROCESS EACH VARIABLE WORD, AND MAKES AN ENTRY IN
*         THE IXFN TERM TABLE.  PCT IS CALLED FOR EACH ADDITIVE CONSTANT
*         WORD, AND EITHER DRIVES THAT CONSTANT INTO THE FINAL CA (IF 
*         NO PERTINENT DIMENSIONS ARE VARIABLE) OR ISSUES A TERM TO 
*         THE IXFN CODE BUFFER. 
  
 PAR      CALL   ISP         INITIALIZE SUBSCRIPT PROCESSING
  
 PAR1     CALL   PVT         PROCESS VARIABLE 1 
          SA1    A1+B1
          CALL   PVT         PROCESS VARIABLE 2 
          SA1    A1+B1
          CALL   PCT         PROCESS ADDITIVE CONSTANT
          SA1    A1+B1
          NZ     X1,PAR1     IF MACRO NOT FULLY SCANNED 
  
          MX6    0
          SA6    A0          ZERO FOLLOWING ITT 
  
*         THE IXFN TERM TABLE HAS NOW BEEN CONSTRUCTED.  WE PROCEED TO
*         SORT THE TABLE, WHICH CONSISTS OF ONE ENTRY PER VARIABLE
*         REFERENCE, INTO SIMPLE ASCENDING ORDER.  THIS GROUPS REFS TO
*         A SINGLE VARIABLE TOGETHER, WITH VARIABLES APPEARING AS LOOP
*         CONTROL VARIABLES SINKING TO THE BOTTOM, INNERMOST LOOP LAST. 
*         THIS GROUPING HAS THE EFFECT OF PLACING MOST-INVARIANT
*         VARIABLE REFS FIRST, TO AID THE LATER REMOVAL OF INVARIANT
*         EXPRESSIONS.
  
          SA3    ITT-1
          SA1    A3 
  
 PAR3     SA3    A3+B1       ITT(I) 
          ZR     X3,PAR6     IF END OF ITT, END OF SORT 
          SA2    A3 
  
 PAR4     SA2    A2+B1       ITT(J) 
          ZR     X2,PAR3     IF END OF ITT
          IX0    X3-X2
          PL     X0,PAR4     IF ITT(I) .LE. ITT(J)
  
*         SWITCH ITT(I) AND ITT(J). 
  
          BX6    X3 
          LX7    X2 
          SA6    A2 
          BX3    X2 
          SA7    A3 
          EQ     PAR4 
            EJECT 
*         LOOP THROUGH SORTED ITT, ISSUING THE CONTRIBUTION OF EACH 
*         UNIQUE VARIABLE TO THE ULTIMATE ARRAY INDEX.  FOR EACH ENTRY
*         IN THE ITT, WE MAKE A CONTRIBUTION TO THE APPROPRIATE SCC 
*         ELEMENT, AND WHEN THE END OF THE ENTRIES FOR THE CURRENT
*         VARIABLE IS REACHED, IST IS CALLED TO ISSUE THAT VARIABLE/S 
*         CONTRIBUTION TO THE IXFN. 
* 
*         THE SCC VECTOR CONTAINS THE COEFFICIENTS OF THE MDIMS TERMS 
*         THAT MAY POSSIBLY PERTAIN TO AN INDEX VARIABLE, WHERE MDIMS 
*         IS THE NUMBER OF DIMENSIONS THAT THE REFERENCED ARRAY HAS.
*         SCC(1) IS THE COEFFICIENT OF THE VARIABLE, SCC(2) IS THE COEF-
*         FICIENT OF THE VARIABLE TIMES THE FIRST VARDIM, SCC(3) IS THE 
*         COEFFICIENT OF THE VARIABLE TIMES THE FIRST  VARDIM TIMES THE 
*         SECOND VARDIM, ETC. 
*         SOME EXAMPLES OF THE SCC SCHEME (USED TO ASSOSCIATE SIMILAR 
*         TERMS) SHOULD HELP CLARIFY ITS IMPLEMENTATION.
* 
*         DIMENSION A(M,N,1),B(M,2,1),C(4,5,1)
* 
*         A(I,I,3*I)
* 
*         SCC(1)=1
*         SCC(2)=1
*         SCC(3)=3   OR  LOC(A) + I + M*I + 3*M*N*I + CA
* 
*         B(I,I,3*I)
* 
*         SCC(1)=1
*         SCC(2)=1+2*3
*         SCC(3)=0   OR  LOC(B) + I + 7*M*I + CA
* 
*         C(I,I,3*I)
* 
*         SCC(1)=1+4*1+4*5*3
*         SCC(2)=0
*         SCC(3)=0   OR  LOC(C) + 65*I + CA 
* 
*         THE CONTRIBUTION OF THE CONSTANT DIMENSIONS TO AN SCC TERM, 
*         SUCH AS 4*5 FOR THIRD TERM REFERENCES TO C, IS LOADED FROM
*         THE CDC (CONSTANT DIMENSION COEFFICIENTS) TABLE, FORMED DURING
*         IXFN INITIALIZATION.  IT SHOULD BE FURTHER NOTED THAT A NEW 
*         SCC TABLE IS CONSTRUCTED FOR EACH UNIQUE VARIABLE IN AN IXFN. 
  
 PAR6     MX0    -TT.SUBL 
          SA1    A1+B1       ITT(I) 
          ZR     X1,PAR7     IF END OF ITT
          LX1    -TT.SUBP 
          BX2    -X0*X1      SUBSCRIPT ORDINAL
          SA3    DIT-1+X2    DIT(SUB) 
          SA4    CDC-1+X2    CDC(SUB) 
          LX1    TT.SUBP-TT.MCP 
          SX2    X1          MC 
          SA3    SCC-1+X3    SCC(DIT(SUB))
          IX5    X4*X2
          IX6    X3+X5
          SA6    A3        SCC(DIT(SUB)) = SCC(DIT(SUB)) + MC * CDC(SUB)
          MX0    -TT.PL 
          LX1    TT.MCP-TT.PP 
          BX1    -X0*X1      POINTER TO RND ENTRY 
          SA2    A1+B1
          LX2    -TT.PP 
          BX2    -X0*X2      POINTER TO RND ENTRY FOR NEXT ITT ENTRY
          IX6    X1-X2
          ZR     X6,PAR6     IF IH,CA OF NEXT TERM MATCHES THIS TERM
          CALL   IST         ISSUE SUBSCRIPT TERM 
          EQ     PAR6 
          SPACE  4
*         PRODUCE LD/ST/STT TO ARRAY. 
  
 PAR7     SA1    O.MAC       (X1) = FWA MACRO 
          SA2    X1          MACRO HEADER 
          SX6    B7 
          SA6    =XNIRN 
          MX0    -RM.RIL
          BX3    -X0*X2      R-NUMBER FROM MACRO
          SB7    X3          FOR ISSUE
          MX0    -1 
          AX2    RM.RIL 
          BX3    -X0*X2 
          SB5    X3          DOUBLE/COMPLEX ARRAY BIT 
          SA2    X1+B1       ARRAY IH,CA
          SX3    X2          (X3) = IH
          LX2    -IH.CAP
          SB3    X2          B3 = CA
          SA1    CA          CA FROM TERM CALCULATION 
          SX6    X1+B3
          SA4    TIF         R-NUMBER OF LAST TERM ISSUED 
          SA5    OP          OC.LD/ST/STT 
          SB6    OC.STT 
          SB3    X5 
          BX1    X6 
  
 PAR8     MX0    -IH.CAL
          BX1    -X0*X1 
          ISSUE  OP=B3,TY=III,IH=X3,CA=X1,RF=X4 
          ZR     B5,PAR9     IF NOT DOUBLE WORD ARRAY 
          EQ     B3,B6,PAR9  IF SET IXFN
          LX1    -IH.CAP
          SB5    B0 
          LX3    -IH.IHP
          SX1    X1+B1       CA = CA + 1
          LX4    -IH.RFP     RESTORE SEMANTIC INFO
          EQ     PAR8        ISSUE SECOND LD/ST/STT 
  
 PAR9     SA1    MACINS      NUMBER OF TYPE 3 INSTRUCTIONS ISSUED 
          SA5    ICB         FWA OF CODE FOR EEM
          SX0    A5-B2       (X0) = - NUMBER OF WORDS IN CODE BUFFER
          BX0    -X0
          IX6    X0-X1
          SA6    A1          MACINS = INSTRUCTIONS ISSUED 
          SA2    TEMP+2 
          SA1    A2+B1
          BX6    X2 
          SA6    X1          RESTORE WORD FOLLOWING IXFN
          SA1    LRND 
          SA2    LVDT 
          BX6    X1 
          LX7    X2 
          SA6    L.RND
          SA7    L.VDT
          SA1    MACINS 
          SA3    OP 
          SA2    PAR.JT+X3-OC.LD
          BX6    X2 
          SA6    ERM         PLUG ERM RETURN ADDRESS
          EQ     ERM3        FILE EXPANSION IN TEXT 
  
 PAR.JT   BSS    0
          LOC    OC.LD
          EQ     PPS1        FOR OC.LD
          EQ     STM0        FOR OC.ST
          EQ     PPS1        FOR OC.STT 
          LOC    *O 
 ISP      TITLE  ISP - INITIALIZE SUBSCRIPT PROCESSING. 
**        ISP - INITIALIZE SUBSCRIPT PROCESSING.
  
 ISP0     SA2    =XNIRN 
          SA1    A1+B1
          SB7    X2          (B7) = NEXT AVAILABLE INTERMEDIATE R 
  
 ISP      ROUTINE 
          SA6    OP          OP = OC.LD/ST/STT
          ALLOC  RND,6       ALLOCATE FOR R-NUMBER DEFINITION TABLE 
          SX6    B6 
          SA6    LRND 
          ALLOC  VDT,2
          SX6    B6 
          SA6    LVDT 
          SETZERO  O.ITS,L.ITS
          SB2    ICB         (B2) = NEXT ICB STORE ADDRESS
          SA0    ITT         A0 = NEXT ITT ENTRY ADDRESS
          MX6    0
          SA3    O.MAC
          SA2    X3 
          LX2    -R1.INP
          SA6    =XMACINS 
          SB5    X2+B1       (B5) = MACRO LENGTH
          SA1    A2+B5
          BX7    X1 
          SA6    A2+B5       (LWA IXFN + 1) = 0 
          SA7    TEMP+2      SAVE WORD FOLLOWING IXFN, AND ADDRESS
          SX6    A6 
          SA6    TEMP+3 
          SA1    X3+2        DIMENSION INFO 
          SA2    PDIM        X2 = DIM INFO OF PREVIOUS IXFN 
          BX6    X1 
          IX0    X2-X1
          SA6    A2          PDIM = DIM INFO
          ZR     X0,ISP0     IF PDIM .EQ. DIM INFO
          SB3    DIT
          SB4    CDC
          SB5    VDS
          SX7    B1 
          SA7    B3          DIT(1) = 1 
          SA7    B4          CDC(1) = 1 
          MX7    0
          SA7    B5          J = 1 ;  VDS(J) = 0
          SB6    B0          I = 2
          BX3    X1 
          LX1    3+1         PABC(DIMENSION 1) = PABC(1) TO BIT 0 
          MX0    -1 
  
 ISP1     BX2    -X0*X1      (X2) = PABC(I - 1) 
          SA4    B3+B6       DIT(I - 1) 
          IX6    X4+X2
          SA6    A4+B1       DIT(I) = DIT(I - 1) + PABC(I -  1) 
          SX5    X3          (X3) = DT = DIM(I - 1) 
          ZR     X2,ISP2     IF DIM(I - 1) IS CONSTANT
          BX7    X7+X5
          SA7    A7+B1       J = J + 1 ;  VDS(J) = VDS(J-1) ! DIM(J-1)
          SX5    B1          DT = 1 
          LX7    18 
  
 ISP2     SA4    B4+B6       CDC(I - 1) 
          IX6    X4*X5
          LX1    1           ADVANCE PABC 
          SA6    A4+B1       CDC(I) = CDC(I - 1) * DT 
          SB6    B6+B1       I = I + 1
          LX3    -18         ADVANCE DIM
          SX5    B6-2 
          NZ     X5,ISP1     IF I .NE. 4
          EQ     ISP0 
 PVT      TITLE  PVT - PROCESS VARIABLE TERM. 
**        PVT - PROCESS VARIABLE TERM.
  
 PVT      ROUTINE 
          MX0    -IX.CAIHL
          LX1    -IX.CAIHP
          BX2    -X0*X1 
          ZR     X2,PVT      IF IH,CA .EQ. 0
          SX4    V.SUB
          SA3    O.SYM
          SB6    X2          IH 
          SB4    X3-1 
          SB5    B6+B6
          SA3    B4-B5       WORD B 
          BX6    X3+X4       SET SUB BIT
          SA6    A3 
          SA3    O.RND       ORIGIN OF R-NUMBER DEFINITION TABLE
          SA4    LRND        LOCAL L.RND
          IX6    X3+X4
          SB6    X6          B6 = LWA(RND) + 1
          SA5    X3-1 
  
 PVT1     SB5    A5+B1       I = I + 1
          EQ     B5,B6,PVT5  IF END OF RND
          SA5    B5          (X5) = RND(I)
          LX5    -RN.CAIHP
          BX5    -X0*X5 
          IX6    X2-X5
          NZ     X6,PVT1     IF CA,IH NOT IN RND
  
 PVT2     LX1    IX.CAIHP-IX.MCP
          SA4    O.ALS       (X4) = FWA OF ACTIVE LOOP STACK
          SB6    X4 
          SA3    L.ALS
          SA4    X3+B6
  
 PVT3     SA4    A4-B1       I = I - 1 ,  X4 = ALS(I) 
          ZR     X4,PVT4     IF HEAD OF TABLE 
          IX6    X4-X2
          NZ     X6,PVT3     IF CA,IH NOT IN TABLE
  
 PVT4     SX4    A4-B6       ALS ORDINAL
          LX4    TT.LDP 
          MX0    -IX.SUBL-IX.MCL
          BX2    -X0*X1      (X2) = SUB AND MC
          LX2    TT.MCP 
          BX6    X2+X4       OR (TT.SUB,TT.MC,TT.LD)
          SX3    A5          POINTER TO RND TABLE 
          LX3    TT.PP
          BX7    X6+X3
          SA7    A0          TT(NTE) = OR(LD,P,SUB,MC)
          SA0    A0+B1       NEXT AVAILABLE ITT ADDRESS 
          EQ     PVT
  
 PVT5     BX3    X2 
          ISSUE  OP=LD,CAIH=X3
          SX0    B7-B1
          LX0    RN.RIP 
          LX2    RN.CAIHP 
          BX6    X0+X2
          SA6    B6          B6 = NEW LWA OF RND TABLE
          SX7    X4+B1
          SA7    A4          L.RND = L.RND + 1
          SA5    A6          RESTORE FOR TERM TABLE 
          EQ     PVT2 
 PCT      SPACE  4,18        PCT
**        PCT - PROCESS CONSTANT TERM.
  
 PCT0     SA3    CA 
          IX7    X6+X3       CA = CA + AC * CDC(SUB)
          SA7    A3 
  
 PCT      ROUTINE 
          SA2    A1-B1       PREVIOUS VARIABLE TERM 
          MX0    -IX.SUBL 
          LX2    -IX.SUBP 
          BX4    -X0*X2      SUBSCRIPT NUMBER 
          SA3    DIT-1+X4    DIT(SUB) 
          SA5    CDC-1+X4    (X5) = CDC(SUB)
          SA2    VDS-1+X3    (X2) = VDS(DIT(SUB)) 
          IX6    X1*X5       (X6) = AC  * CDC(SUB)
          ZR     X6,PCT      IF MULTIPLIER FOR CON CALCULATION .EQ. 0 
          ZR     X2,PCT0     IF NO VARIABLE DIMENSION PERTAIN 
          SA6    TEMP        SAVE MULTIPLIER
          CALL   LVE         LOAD VARDIM EXPRESSION 
          SA2    TEMP 
          SB6    B7-B1
          CALL   ICM         ISSUE LOGICAL MULTIPLY BY CONSTANT 
          SA3    MRESULT
          CALL   ITA         ISSUE ADD OF GENERATED TERM
          EQ     PCT
 PAR      TITLE  SUBROUTINES
**        LVE - LOAD VARDIM EXPRESSION. 
  
 LVE0     SA2    =XVD.
          SX0    B6 
          ISSUE  OP=LD,IH=X2,CA=X0
  
 LVE      ROUTINE 
          SB6    B0 
          SA4    O.VDT
          SA3    LVDT 
          ZR     X3,LVE2     IF NO VARDIM TABLE 
          SA5    X4          FIRST ENTRY OF VDT 
          SB5    X3 
  
 LVE1     IX6    X5-X2
          ZR     X6,LVE0     IF EXPRESSION MATCHES THIS VDT ENTRY 
          SB6    B6+B1
          SA5    A5+B1
          LT     B6,B5,LVE1  IF MORE ENTRIES IN VDT 
  
 LVE2     BX6    X2 
          SA6    X4+B6       VDT(N) = X2
          SX7    B6+B1
          SA7    A3          LVDT = LVDT + 1
          EQ     LVE0 
 IST      SPACE  3,18        IST
**        IST - ISSUE SUBSCRIPT TERM. 
  
 IST0     SA2    TEMP+4 
          SA1    X2          RESTORE A1 
  
 IST      ROUTINE 
          SX6    A1 
          SA6    TEMP+4      SAVE A1
          SA2    X1 
          LX2    -RN.RIP
          SX6    X2 
          SA6    TEMP        TEMP = R-NUMBER OF VARIABLE
          SA1    SCC+3       I = 4
  
 IST1     SA1    A1-B1       I = I - 1 ,  (I) = SCC(I)
          SB6    SCC-1
          SX0    A1-B6
          ZR     X0,IST5     IF END OF SCC TABLE
          ZR     X1,IST1     IF NO SUBTERM
          SA2    A1+VDS-SCC  VDS(I) 
          ZR     X2,IST3     IF NO VARDIM IN SUBTERM
          CALL   LVE         LOAD VARDIM EXPRESSION 
          SA2    A1          X2 = SCC(I)
          SB6    B7-B1       OPERAND OF MULTIPLY ( = VARDIM)
          CALL   ICM         ISSUE LOGICAL MULTIPLY 
          SA2    MRESULT
          SA4    STF
          SX7    X2 
          ZR     X4,IST2     IF FIRST SUBTERM 
          MX0    1
          BX5    X0*X2
          LX5    1
          SB3    OC.IA+X5    OC.IA/IS 
          ISSUE  OP=B3,TY=I,RJ=X4,RK=X7 
          SX6    B7-B1
          SA6    A4 
          EQ     IST1 
  
 IST2     SA7    A4          STF = R-NUMBER OF ACCUMULATION 
          PL     X2,IST1     IF XMTC FLAG NOT SET BY ICM
          ISSUE  OP=XMTC,RJ=X7
          SX6    B7-B1
          SA6    A4 
          EQ     IST1 
  
 IST3     SA4    STF
          MX0    -IH.CAL
          BX2    -X0*X1 
          NZ     X4,IST4     IF NOT FIRST SUBTERM 
          SA3    TEMP 
          SX2    X2          EXTEND SIGN FOR ICM
          SB6    X3          B6 = R-NUMBER OF VARIABLE
          CALL   ICM         ISSUE MULTIPLY BY CONSTANT 
          SA3    MRESULT
          EQ     IST6 
  
 IST4     ISSUE  OP=STT,RF=X4,CA=X2 
          SX6    B7-B1
          SA6    A4          STF = R-NUMBER OF ACCUMULATION 
  
 IST5     SA2    STF
          SA3    TEMP        R-NUMBER OF VARIABLE 
          ZR     X2,IST0     IF NOTHING ISSUED
          ISSUE  OP=IM,RJ=X2,RK=X3
          SX3    B7-B1       FOR ITA
  
 IST6     CALL   ITA         ADD TERM TO PREVIOUS TERM ACCUMULATION 
          SETZERO  O.TTS,L.TTS
          EQ     IST0 
 ITA      SPACE  3,18        ITA
**        ITA - ISSUE TERM ADD. 
  
 ITA0     SX6    B7-1 
          SA6    TIF         TIF = R-NUMBER OF THIS ACCUMULATION
  
 ITA      ROUTINE 
          SA2    TIF
          SX7    X3 
          MX0    1
          NZ     X2,ITA2     IF NOT FIRST TERM ISSUED 
          MI     X3,ITA1     IF XMTC FLAG ON
          SA7    TIF
          EQ     ITA
  
 ITA1     ISSUE  OP=XMTC,RJ=X7
          EQ     ITA0 
  
 ITA2     BX5    X0*X3
          LX5    1
          SB3    OC.IA+X5    OC.IA/IS 
          ISSUE  OP=B3,TY=I,RJ=X2,RK=X7 
          EQ     ITA0 
 ICM      EJECT  ISSUE CONSTANT MULTIPLY. 
**        ICM - ISSUE CONSTANT MULTIPLY.
*         ISSUES RLIST TO IXFN CODE BUFFER FOR A LOGICAL INTEGER
*         MULTIPLY OF A CONSTANT TIMES SOME OPERAND.  MULTIPLIES ARE
*         REDUCED IN STRENGTH TO ADDS (IF CONSTANT = 2) OR TO SHIFT 
*         AND ADD SEQUENCES (IF CONSTANT = 2**J, 2**J+2**K OR 2**K-2**J)
* 
*         ENTRY  X2 = CONSTANT MULTIPLIER 
*                B6 = R-NUMBER OF MULTIPLICAND
*                B7 = NEXT AVAILABLE INTERMEDIATE R-NUMBER
*                B2 = NEXT AVAILABLE ADDRESS IN IXFN CODE BUFFER
*                B1 = 1 
* 
*         EXIT   B7 - UPDATED 
*                B2 - UPDATED 
*                B1 - PRESERVED 
*                A0 - PRESERVED 
*                A1 - PRESERVED 
*                (MRESULT) - 1/XMTC-NECESSARY FLAG,59/R-NUMBER OF RESULT
* 
*         USES   ALL OTHER REGISTERS
  
 ICM0     SX6    B7-1 
  
 ICM0A    SA2    TEMP+1 
          MX0    1
          BX1    X0*X2       SIGN BIT OF ORIGINAL CONSTANT
          BX6    X6+X1
          SA6    MRESULT
  
 ICM      ROUTINE 
          ZR     X2,ICM7     IF CONSTANT .EQ. 0 
          BX6    X2 
          SA6    TEMP+1      SAVE CON 
          AX6    59 
          BX2    X2-X6       (X2) = ABS(CON)
          SB5    47 
          SX1    B1          X1 = 1 
          IX6    X2-X1
          BX0    X2*X6
          NZ     X0,ICM3     IF CON NOT 2**J
          NX6    B4,X2
          SB4    B5-B4       B4 = J = LOG2(CON) 
          SX2    B6          X2 = OPERAND 
          ZR     B4,ICM1     IF CONSTANT .EQ. 1 
          NE     B4,B1,ICM2  IF CONSTANT .NE. 2 
          BX1    X2          X1 = OPERAND 
          ISSUE  OP=IA,RJ=X1,RK=X2  ISSUE OP + OP 
          EQ     ICM0 
  
 ICM1     SX6    X2 
          EQ     ICM0A
  
 ICM2     ISSUE  OP=SXT,RJ=X2 
          SX2    B4          CA = SHIFT COUNT = J 
          SX3    B7-B1
          ISSUE  OP=KLS,RF=X3,CA=X2 
          EQ     ICM0 
  
 ICM3     IX5    X0-X1
          BX3    X0*X5
          NZ     X3,ICM4     IF CONSTANT NOT 2**J + 2**K
          NX6    B4,X0
          SB4    B5-B4       B4 = MAX(J,K)
          IX6    X2-X0
          SX2    B6          X2 = R-NUMBER OF OPERAND 
          NX0    B3,X6
          SB5    B5-B3       B5 = MIN(J,K)
          SX1    B4-B5       X1 = MAX(J,K) - MIN(J,K) 
          BX4    X2 
          ISSUE  OP=SXT,RJ=X4 
          SX3    B7-B1
          ISSUE  OP=KLS,RF=X3,CA=X1 
          SX3    B7-B1
          ISSUE  OP=IA,RJ=X3,RK=X2
          ZR     B5,ICM0     IF MIN(J,K) .EQ. 0 
          SX3    B7-B1
          ISSUE  OP=SXT,RJ=X3 
          SX3    B7-B1
          SX1    B5 
          ISSUE  OP=KLS,RF=X3,CA=X1 
          EQ     ICM0 
  
 ICM4     BX7    X2+X6
          IX0    X7+X1
          BX1    X0*X7
          NZ     X1,ICM6     IF CONST NOT 2**K - 2**J 
          NX6    B4,X0
          SB4    B5-B4       B4 = K 
          IX2    X0-X2
          NX3    B3,X2
          SX2    B6          X2 = OPERAND 
          SB5    B5-B3       B5 = J 
          BX4    X2 
          ISSUE  OP=SXT,RJ=X4 
          SX3    B7-B1
          SX4    B4 
          ISSUE  OP=KLS,RF=X3,CA=X4 
          SX0    B7-B1
          ZR     B5,ICM5     IF J .EQ. 0
          ISSUE  OP=SXT,RJ=X2 
          SX4    B5          J
          SX2    B7-B1
          ISSUE  OP=KLS,RF=X2,CA=X4 
          SX2    B7-B1
  
 ICM5     ISSUE  OP=IS,RJ=X0,RK=X2
          EQ     ICM0 
  
 ICM6     SA3    TEMP+1      ORIGINAL CONSTANT
          MX0    -18
          BX2    -X0*X3      IN 
          ISSUE  OP=S,IN=X2 
          SX1    B6          OPERAND
          SX2    B7-B1
          ISSUE  OP=IM,RJ=X1,RK=X2
          SX6    B7-B1
          SA6    MRESULT
          EQ     ICM
  
 ICM7     ISSUE  OP=CLR 
          SX6    B7-B1
          SA6    MRESULT
          EQ     ICM
  
          END 
