*DECK     CGTM
          IDENT  CGTM 
 CGTM     TITLE  CGTM - CODE GENERATOR TABLE MANAGER
 B=CGTM   RPVDEF
*CALL     SSTCALL 
          SPACE  2
*         COMMENT COPYRIGHT CONTROL DATA SYSTEMS, INC. 1994.
          SPACE  2
  
**        CGTM - CODE GENERATOR TABLE MANAGER AND UTILITY ROUTINES
 OPT      SPACE  3
**        F.OPT - OPT=2 RANDOM FILE FET AND FIT 
  
          ENTRY  F.OPT
 F.OPT    BSS    0
  
 #RM      IFEQ   CP#RM,0
  
          VFD    42/7LZZZZZOP,18/3
          VFD    42/3,18/0
          BSSZ   2
          CON    200B 
          BSSZ   3
 #RM      ELSE
  
          ENTRY  FI.OPT 
 FI.OPT   BSS    0
 FF.OPT   FILE   LFN=ZZZZZOP,FO=WA,OF=R,CF=U,PD=IO,EO=T,RT=W,MRL=377777B
          BSSZ   FF.OPT+20D-* 
          ENTRY  FF.OPT 
  
 #RM      ENDIF 
 CONTV    SPACE  3,14 
 .T       IFNE   TEST,0 
**        CONTV - RETURN I TH VALUE FROM THE CON TABLE
  
 CONTV    ENTRY.
          SA1    X1 
          SA2    =XO$CVT
          IX3    X1+X2
          SA4    X3          CVT(ARG) 
          BX6    X4 
          EQ     CONTV
 .T       ENDIF 
 CG$IEP   TITLE  UTILITY ROUTINES 
**        CG$IEP - INITIALIZE END PROCESSING
*         CLOSE -OPT- FILE, ADJUST WORKING STORAGE LIMITS, ADJUST FL. 
  
 CG$IEP   ENTRY.
          SETB1 
          SX6    TOV# 
          SA6    TO          TO = TOV#     */ RESTORE TBL MGR EXIT
          SX6    =XHE$EPX 
          SA6    CG.MOX      SET END PROCESSING OVERFLOW EXIT 
          SA1    =XHO$OPT 
          PL     X1,IEP1     IF CO.OPT " 2
  
*         CLOSE THE OPT FILE
  
 #RM      IFEQ   CP#RM,0
          SX6    1000B
          SA6    =XF.OPT+1   CLEAR RANDOM BIT, SET POINTERS TO
          SA6    A6+B1       VALUE THAT IS < FL 
          SA6    A6+B1
          LX6    1
          SA6    A6+B1       LIMIT
          CLOSE  F.OPT,UNLOAD,R    RETURN THE FILE
 #RM      ELSE
          CLOSEM =XFF.OPT,U 
 #RM      ENDIF 
  
 IEP1     SX6    =XB=MIO     SET NEW LOW MEMORY LIMIT 
          SA6    LM 
          SA6    O$BLK
          SA6    O$TXT
          EQ     CG$IEP 
 PUNT     SPACE  3,14 
**        PUNT - TERMINATE CCG OVERLAY PROCESSING WHEN INSUFFICIENT 
*                MEMORY IS AVAILABLE TO COMPILE.
* 
*         ENTRY  (X1) = 7L_CHARS
  
 PUNTA    DIS    ,$ CCG - INSUFFICIENT MEMORY TO COMPILE - 1234567$ 
  
 PUNT     ENTRY. **,# 
          BX6    X1 
          SA6    PUNTA+4
          IFNE   TEST,0,1 
          MESSAGE PUNTA,,RCL * CCG - INSUFFICIENT MEM TO COMPILE *
          SA2    =XN$FERR 
          SX7    X2+B1       N.FERR = N.FERR + 1
          SA7    A2 
          SA3    CG.MOX 
          SB2    X3+
          JP     B2          EXIT TO CONTROL ROUTINE
  
 CG.MOX   ENTRY. =XHE$CTX,#  MEMORY OVERFLOW EXIT 
 CG$SCT   SPACE  3,14 
**        CG$SCT - SEARCH CON VALUE TABLE 
* 
*         ENTRY  (X1) = BINARY CONSTANT TO BE ADDED 
* 
*         EXIT   (X6) = ORDINAL OF CONSTANT IN THE TABLE
  
 SCT0     ADDWRD CUT,B0 
          SX6    X3-1 
  
 CG$SCT   ENTRY.
          SETB1 
          ADDWRD CVT,X1      ADDWRD( CVT , CON )
          SA4    X2+
          SB7    X2+1 
 SCT1     BX1    X4-X6
          SA4    A4+B1
          NZ     X1,SCT1     IF CON " CVT(I)
          MI     X1,SCT1     IF NOT COMPLEMENTS 
  
          SB7    A4-B7
          SX6    B7 
          EQ     B7,B6,SCT0  IF MATCH ON LAST ENTRY 
          SX7    B6 
          SA7    A3          L.CVT = OLD(L.CVT) 
          EQ     CG$SCT 
 ENC      SPACE  3,14 
**        ENC - ENTER N-WORD CONSTANT 
* 
*         ENTRY  (X0) = TBL , ADDRESS OF VECTOR OF CONSTANTS
*                (X5) = N , NUMBER OF CONSTANTS 
* 
*         EXIT   (X6) = ORDINAL OF FIRST CONSTANT IN CVT
  
 ENC0     SX6    B7          ORD = I
          SX7    B6 
          SA7    L$CVT       L.CVT = OLEN 
 CG$ENC   ENTRY.
          SETB1 
          ALLOC  CVT,X5      ALLOC( CVT , N ) , OLEN = OLD(L.CVT) 
          SB5    X5          (B5) = N 
          SB4    X2          (B4) = O.CVT 
          SX3    X2+B6
          MOVE   X5,X0,X3    MOVE( N , TBL , CVT(OLEN) )
          SB7    -1          I = -1 
  
 ENC1     SA4    B4+B7
          SA3    X0 
          SB3    B0          K = 0
          SB7    B7+B1       I = I + 1
  
 ENC2     BX6    X3-X4
          SA4    A4+B1
          SA3    A3+B1
          SB3    B3+B1       K = K + 1
          NZ     X6,ENC1     IF CVT(I+5) " TBL(K) 
          MI     X6,ENC1     IF COMPLEMENTS 
          LT     B3,B5,ENC2  IF K < N 
  
*         MATCH FOUND, SEE IF CONSTANT IS IN *OLD* TABLE
  
          SB3    B7+B5       LWAC = I + N  */ LWA OF NEW CON IN CVT 
          LE     B3,B6,ENC0  IF LWAC @ OLEN 
  
*         EXPAND *CVT*
  
          SX7    B3 
          SA7    L$CVT       L.CVT = LWAC 
          SX5    B7 
          ALLOC  CUT,B3-B6   ALLOC( CUT , LWAC-OLEN ) 
          SETZERO X2+B6,X1
          BX6    X5          ORD = I
          EQ     CG$ENC 
 CG$FCU   SPACE  3,14 
**        CG$FCU - FORCE USE OF K"TH CONSTANT IN *CVT*
* 
*         ENTRY  (X1) = ORDINAL OF THE CONSTANT 
  
 CG$FCU   ENTRY.
          SA2    =XO$CUT
          SX6    B1 
          SB2    X1 
          SA6    X2+B2       CUT(K) = 1 
          EQ     CG$FCU 
 WPW#     SPACE  3,14 
**        WPW# - WRITE PSEUDO OP WORD TO *SLIST* FILE 
* 
*         ENTRY  (B3,X6) = OPCODE VALUE & LOW 48 BITS OF WORD 
* 
*         PRESERVES A0, X0, A5, X5
  
 WPW1     WRITEW =XF.SLST,B6,B7 
  
 WPW      ENTRY. **,# 
          PX6    B3,X6
          SA6    WPWA 
          SB6    A6 
          SB7    B1 
          EQ     WPW1 
  
 WPWA     BSS    1
 CGEP     TITLE  CGEP - CODE GENERATOR END PROCESSOR ROUTINES 
**        CGEP - CODE GENERATOR END PROCESSOR 
* 
*         *CGEP* CONTAINS ROUTINE TO DO FINAL ADDRESS DEFINITION, 
*         BLOCK LENGTH CALCULATION, BLOCK SWITCHING, ETC. 
 N$SLBT   ENTRY. 0
 N$IT     ENTRY. 0
 N$OT     ENTRY. 0
  
 CC$LBO   ENTRY. 0           ORDINAL OF LOCAL BLOCK BEING PROCESSED 
 CC$PC    ENTRY. 0           PARCEL COUNTER ( 0 - 3 ) 
 CC$BLEN  ENTRY. 0           LENGTH OF CURRENT BLOCK
  
          QUAL   WII
 CG$RBT   SPACE  2,14 
**        CG$RBT - RELOCATE BLOCK TABLE 
  
 CG$RBT   ROUTINE 
          SA3    CC$PC
          SA4    CC$BLEN
          SX1    =XF$LBT
          SA2    CC$LBO 
          LX3    18 
          BX6    X3+X4
          SB2    X2 
          SA6    X1+B2       LBT(LBO) = (PC,BLEN) 
          SB2    B0          I = 0
          SA3    =XN$LBT
          SB3    X3+1        N = N$LBT + 1
          MX0    42 
          MX7    0           S = 0
  
 RBT1     SA3    X1+B2
          BX5    X0*X3
          ZR     X5,RBT2     IF PC[LBT(I)] = 0
          SX3    X3+1        BLEN[LBT(I)] = BLEN[LBT(I)] + 1
 RBT2     SA7    A3          LBT(I) = S    */ FWA 
          IX7    X7+X3       S = S + BLEN[LBT(I)] 
          SB2    B2+1        I = I + 1
          LT     B2,B3,RBT1 
  
          SA7    N$SLBT 
          EQ     CG$RBT 
 CG$CUB   TITLE  CG$CUB - CHANGE USE BLOCK
**        CG$CUB - CHANGE USE BLOCK 
* 
*         ENTRY  (X1) = *LBT* ORDINAL OF NEW USE BLOCK
  
 CG$CUB   ROUTINE 
          SETB1 
          SA2    CC$LBO      OBO = CC$LBO 
          IX7    X1-X2
          BX6    X1 
          ZR     X7,CG$CUB   IF NBO = OBO 
  
          SA6    A2          CC$LBO = NBO 
          SA3    CC$PC
          SA4    CC$BLEN
          LX3    54                                HX3   LB.PARC
          BX6    X3+X4
          SB3    F$LBT
          SA6    B3+X2       LBT(OBO) = SHIFT(PC,18) ! BLEN 
          SA5    B3+X1
          SX6    X5 
          SA6    A4 
          AX5    54          PARCNT = PARC[LBTI] / AX5   -LB.PARCL
          SX6    X5 
          SA6    A3 
          SX6    X1+1S15
          WRITEP USE         OUTPUT *USE* TO SLIST
          EQ     CG$CUB 
 FSU#     SPACE  3,14 
**        FSU# - FORCE NEXT SEQUENCE UPPER
  
 FSU#     ROUTINE 
          SA1    CC$PC
          ZR     X1,FSU#     IF PARCEL = 0
          MX7    0
          SA7    A1          PARCEL = 0 
          SA2    CC$BLEN
          SX6    X2+B1       BLEN = BLEN + 1
          SA6    A2 
          SA6    FU          FU = 1 
          EQ     FSU# 
  
 FU       DATA   0           "0 IF TO FORCE UPPER 
 CG$EP    TITLE  CG$EP - CCG END PROCESSOR
**        CG$EP - CODE GENERATOR END PROCESSOR
*         FUNCTIONS - 
*         SETUP *CVT* ORDINAL TABLE FOR *CGIA*
*         OUPUT TABLE OF CONSTANT LITERALS AS - * CON. BSS 0 FOLLOWED 
*         BY DATA WORDS.
*         DEFINE ADDRESS"S AND ALLOCATE STORAGE FOR OTHER SPECIAL SYMBOLS.
* 
*         ENTRY  CVT - CONSTANT VALUE TABLE 
*                CUT - CONSTANT USE TABLE ENTRIES ARE 0 OR 1 FOR UNUSED 
*                   OR USED.
*                N$IT, N$OT = NUMBER OF IT."S USED, ETC 
* 
*         EXIT   CVT REFORMATTED AS 60/ ORDINAL OF CONSTANT VALUE IN
*                   CON. ARRAY. 
*                ADDRESS OF SPECIAL SYMBOLS ( IT., OT., CON. , ETC )
*                   DEFINED AND OUTPUT TO *SLIST* FILE. 
  
 CG$EP    ROUTINE 
          SETB1 
  
*         REFORMAT *CUT* AS ORDINALS TO CON. ARRAY, SQUEEZE UNUSED
*         ENTRIES OUT OF *CVT*. 
  
          ADDWRD CUT,0
          SA1    O$CVT
          SB2    B0          I = 0
          SB3    X3          N = L.CUT
          SB4    X1                        (B4) = CVT 
          SB5    X2                        (B5) = CUT 
          SX7    0           J = 0
  
 EP1      SA5    B5+B2
          ZR     X5,EP2      IF CUT(I) = 0 */ CON NOT REFERENCED
  
          SA7    A5          CUT(I) = J    */ SET ORDINAL 
          SA4    B4+B2
          BX6    X4          CVT(J) = CVT(I)  */ MOVE TO FINAL POSITION 
          SA6    B4+X7
          SX7    X7+B1       J = J + 1
  
 EP2      SB2    B2+B1       I = I + 1
          LT     B2,B3,EP1   IF I < N 
  
          BX5    X7 
          ZR     X7,EP3      IF J = 0 
* 
*         DEFINE ADDRESS OF CON. AND OUTPUT TABLE OF DATA WORDS 
  
          SA1    =XS$CON
          SX2    B0 
          RJ     CG$DSA      DEFINE CON.
          SA3    CC$BLEN
          IX7    X3+X5
          SA7    A3          BLEN = BLEN + L$CVT
          BX6    X5 
          LX6    SI.CAP 
          WRITEP DATA        OUTPUT DATA HEADER WORD
          SA4    O$CVT
          WRITEW F.SLST,X4,X5      OUTPUT DATA WORDS
  
*         DEFINE ADDRESS"S OF SPECIAL SYMBOLS 
  
 EP3      SX6    0
          SA6    L$CVT             L$CVT = 0
 .PLI     IFNE   HC.ID,3
          ECHO   4,Z=(IT,OT)
          SA1    =XS$Z
          SA2    N$Z
+         ZR     X2,*+1 
          RJ     CG$DSA 
 .PLI     ENDIF 
  
          EQ     CG$EP
 CG$DSA   SPACE  3,14 
**        CG$DSA - DEFINE SYMBOL ADDRESS AND OUTPUT STORAGE FOR IT
* 
*         ENTRY  (X1) = IH, SYMTAB ORDINAL
*                (X2) = WDS , NUMBER OF WORDS RESERVED FOR THIS SYMBOL
* 
*         PRESERVES A0, X0, A5, X5
  
 CG$DSA   ROUTINE 
          SA4    CC$PC
          SETB1 
          SA3    CC$BLEN
          SX6    B1 
          LX6    WC.RLP 
          ZR     X4,DSA1     IF PARCEL = 0
          MX7    0
          SA7    A4          PARCEL = 0 
          SX3    X3+1        BLEN = BLEN + 1
 DSA1     IX7    X3+X2       RA = BLEN;  BLEN = BLEN + WDS
          SA4    CC$LBO 
          SA7    A3 
          ZR     X1,DSA2     IF IH = 0
          LX4    WC.RBP 
          LX3    WC.RAP 
          BX4    X4+X3
          SA3    =XO$SYM
          BX6    X6+X4       ADW = WC(1,0,CG.LBO,RA)
          SB2    X3+2 
          LX7    B1,X1
          IX7    X1+X7
          SA6    B2+X7       SYM(3*IH+2) = ADW
 DSA2     LX2    R1.CAP 
          BX6    X2+X1
          WRITEP LAB         OUTPUT * IH BSS WDS * TO SLIST 
          EQ     CG$DSA 
 WII      TITLE  WII - WRITE ISSUED INSTRUCTIONS TO *SLIST* 
**        WII - WRITE ISSUED INSTRUCTIONS IN *SI.* FORMAT TO *SLIST*. 
*         FUNCTIONS - 
*                MAINTAIN BLOCK LENGTH AND PARCEL COUNTER 
*                ADJUST SPECIAL INSTRUCTIONS ( TLD, TST, ETC. ) 
*                SET *MAT* BIT IN WORDB OF *SYM*
*                DEFINE ADDRESS"S OF TRANSFER LABELS
  
 SZ       MICRO  1,, B2      INSTRUCTION SIZE IN PARCELS
 PC       MICRO  1,, B5      PARCEL - 4 
 BL       MICRO  1,, B7      BLOCK LENGTH 
  
 WII#     ROUTINE 
          TRACE  WII,PIT
          SA5    O$PIT
          WRITEW F.SLST,X5,1       OUTPUT *BOS* TO SLIST
          SA1    FU 
          ZR     X1,WII0     IF FU = 0     */ NO FORCE UPPER
          MX6    0           FU = 0 
          SA6    A1 
          WRITEP LAB
  
 WII0     SA5    X5          PI = [O.PIT] 
          SA2    O$SYM
          SB6    X2+B1                     (B6) = SYM + 1 
          SA4    CC$PC
          SA3    CC$BLEN
          S"BL"  X3 
          S"PC"  X4-4 
          S"SZ"  B0          SZ = 0 
          SA2    O$CUT
          MX0    -6 
          SA0    X2                        (A0) = CUT 
  
*         RETURN POINT FOR PROCESSING OF MOST INSTRUCTIONS
  
 WII1     S"PC"  "PC"+"SZ"   PC = PC + SZ 
          SA5    A5+B1       PI = PI + 1
          LT     "PC",WII2   IF PC < 4
  
          SB3    "PC"        S = PC 
          S"PC"  -4          PC = 0 
          S"BL"  "BL"+B1     BLEN = BLEN + 1
          ZR     B3,WII2     IF S = 0      */ NO SIZE FAULT 
  
          S"PC"  "PC"+"SZ"   PC = SZ
  
*         SETUP REGISTERS, JUMP TO INSTRUCTION PROCESSOR
  
 WII2     UX7    B3,X5
          SX6    B3 
          S"SZ"  B1          SZ = 1 
          LX6    -1 
          SA3    WIIA+X6
          SX4    30 
          AX6    59 
          BX4    -X6*X4      0 OR 30
          SB4    X4 
          LX3    B4 
          SB4    X3 
          JP     B4+WII1     JUMP TO PROCESSOR
 NOP      SPACE  2,14 
**        NOP - TERMINATE PROCESSING
  
          PROCESS NOP 
          SX6    "PC"+4 
          SA6    CC$PC
          SX7    "BL"+
          SA7    CC$BLEN
          SA4    =XO$PIT
          SA3    =XL$PIT
          MX7    0
          SA7    A3          L.PIT = 0
          WRITEW F.SLST,X4+B1,X3-2 WRITE REST OF *PIT* TO SLIST 
          EQ     WII# 
 DRL      SPACE  2
 .FPAS    IFNE   HC.FPAS*.DAL      F.P. ADDSUB & LEVEL 2
  
          PROCESS (DRL,DWL) 
          AX7    SI.IHP 
          SB4    X7 
          ZR     B4,WII1     IF IH[PI] = 0 */ NOT A *SUB0*              001240
          SB4    X7-IH.LCM                                              001250
          SX6    B4+B4                                                  001260
          SB4    B6+B4
          SA4    B4+X6       WORDB = SYM(3*IH+1)
          MX7    -WB.FPOL 
          LX4    -WB.FPOP 
          SA3    =XO$FPI
          BX6    -X7*X4 
          SB4    X3-1 
          SA2    B4+X6
          SX3    B1 
          LX3    FP.SUB0P 
          IX6    X2+X3       SUB0[FPI(FPO)] = SUB0[FPI(FPO)] + 1
          SA6    =XCC$SUB0   CC$SUB0 = 1
          SA6    A2 
          EQ     WII1 
 .FPAS    ENDIF 
 TLD      SPACE  3,14 
**        TLD, TST - ADJUST *CA* TO REFLECT ASSIGNMENT MADE BY *GPO*
  
 TLD      PROCESS (TLD,TST) 
          LX7    -SI.RJP
          BX6    -X0*X7 
          NZ     X6,WII1     IF RJ[PI] " 0 */ CONVERTED TO A SHORT INSTRUCTION
  
*         SEARCH *TET* TO FIND LOCATION IN IT. BLOCK ASSIGNED 
*         TO THIS TLD/TST . 
  
          SA1    =XO$TET
          SB3    59-T.FAP 
          SB2    X1                        (B2) = TET 
          LX7    SI.RJP-SI.CAP
          SB4    59-T.EQVP
  
 TLD1     SA1    B2+X7       TI = TET(C)
          LX6    B3,X1
          SX7    X1          C = CA[TI] 
          LX2    B4,X1
          MI     X6,TLD3     IF FA[TI]     */ FINAL ASSIGNMENT MADE 
          MI     X2,TLD1     IF EQV[TI]    */ EQUIVALENT TO ANOTHER 
  
*         CA NOT ASSIGNED, MUST BE OPT=1, GET NEXT CELL AND SAVE
*         VALUE IN *CA* FIELD OF *TET* ENTRY. 
  
          SA2    =XN.GT#
          BX7    X2          C = N.GT 
          MX3    -T.CAL 
          SX6    X2+B1       N.GT = N.GT + 1
          SA6    A2 
          SA4    =XN$IT 
          SX2    B1 
          BX1    X3*X1
          BX1    X1+X7       CA[TI] = C 
          LX2    T.FAP
          BX6    X1+X2       FA[TI] = 1 
          SA6    A1 
          SX6    X7+B1
          IX4    X4-X6
          PL     X4,TLD3     N.IT = MAX( N.IT , C+1 ) 
          SA6    A4 
  
 TLD3     LX5    -SI.CAP
          MX1    -SI.CAL
          BX5    X1*X5
          BX7    X5+X7       CA[PI] = C 
          LX7    SI.CAP 
          S"SZ"  2           SZ = 2 
          SA7    A5 
          EQ     WII1 
 PLD      SPACE  2,12 
          PROCESS (PLD,PST,S) 
          AX7    SI.CAP 
          ZR     X7,WII1     IF CA[PI] = 0
          S"SZ"  B1+B1       SZ = 2 
          EQ     WII1 
 LD       SPACE  3,14 
          PROCESS ILD 
          SA2    =XS$IT 
          LX5    -SI.IHP
          BX1    X2-X5
          SB4    X1 
          LX5    SI.IHP 
          ZR     B4,TLD      IF IH[PI] = IT.                                    CCGA028 11
  
          PROCESS (LD,ST,STT) 
          AX7    SI.CAIHP 
          ZR     X7,WII1     IF CAIH[PI] = 0
          S"SZ"  B1+B1       SZ = 2 
  
          MX1    -IH.IL 
          LX1    IH.IP
          BX2    -X1*X7 
          NZ     X2,LD1      IF I[PI] " 0  */ NOT IN SYM
          IF     -DEF,WB.MATP,1 
          IFNE   HC.FPAS,0,3
          SX7    X7                                                             CCGA037 13
          LX6    B1,X7
          SB3    X7+B6
          SA3    B3+X6       WORDB = SYM(3*IH+1)
  
 .MAT     IF     DEF,WB.MATP
          SX1    B1 
          LX1    WB.MATP
          BX6    X1+X3       MAT[SYM(3*IH+1)] = 1 
          SA6    A3 
 .MAT     ENDIF 
  
 .FPAS    IFNE   HC.FPAS,0
          LX3    59-WB.FPP
+         PL     X3,*+1      IF ^FP[WORDB]
          RJ     CSR         COUNT SUB REF
 .FPAS    ENDIF 
  
 LD1      LX5    59-SI.H2P
          PL     X5,WII1     IF ^HI[PI] 
          SA5    A5+1        PI = PI + 1   */ SKIP WORD WITH *H2* IN IT 
          EQ     WII1 
 LDC      SPACE  2
          PROCESS LDC 
          LX5    -SI.CAP
          SX6    B1 
          S"SZ"  B1+B1       SZ = 2 
          SB3    A0 
          SA6    B3+X5       CUT(CA[SI]) = 1
          EQ     WII1 
 LDV      SPACE  2,14 
 .VD      IF     DEF,VD.MATP
  
*         LDV - CONVERT CA TO FINAL CA AND CHANGE OPCODE TO A *LD*
  
          PROCESS LDV 
          LX7    -SI.CAP
          SX1    X7 
          RJ     CG$AVO      CA = CG$AVO( CA[PI] )
          LX5    -SI.CAP
          MX7    -SI.CAL
          SB3    OC.LD
          BX5    X7*X5
          BX6    X5+X1
          LX6    SI.CAP 
          PX7    B3,X6       OC[PI] = OC.LD 
          SA7    A5 
          S"SZ"  B1+B1       SZ = 2 
          EQ     WII1 
 .VD      ENDIF 
 JPX      SPACE  3
*         JUMPS 
  
          PROCESS (JPX,JPBB)
          SB4    SI.IHP 
          RJ     RLV         CHECK REFERENCED LABEL 
          S"SZ"  2           SZ = 2 
          EQ     WII1 
  
          PROCESS JIN 
          SB4    SI.IHP 
          RJ     RLV         CHECK REFERENCED LABEL 
          EQ     UJP1 
  
          PROCESS UJP 
          SB4    B0 
          RJ     RLV         CHECK REFERENCED LABEL 
  
*         UNCONDITIONAL JUMP, FORCE UPPER AFTER 
  
          PROCESS RJ3 
 UJP1     SX6    "PC"+B1     S = PC + 1 
          S"BL"  "BL"+B1     BLEN = BLEN + 1
          S"PC"  -4          PC = 0 
          SA5    A5+B1       PI = PI + 1
          MI     X6,WII2     IF S < 3      */ OLD(PC)+1 < 3 
          S"BL"  "BL"+B1     BLEN = BLEN + 1
          EQ     WII2 
 RJXJ     SPACE  2,8
 .RJXJ    IFNE   HC.RJXJ,0
  
          PROCESS RJXJ
          SX6    "PC"+4 
          ZR     X6,RJXJ1    IF PC = 0
          S"PC"  -4          PC = 0        */ FORCE UPPER BEFORE
          S"BL"  "BL"+1      BLEN = BLEN + 1
 RJXJ1    SA5    A5+B1       PI = PI + 1
          S"BL"  "BL"+B1     BLEN = BLEN + 1
          EQ     WII2 
  
 .RJXJ    ENDIF 
 RJ6      SPACE  3,14 
 .RJ6     IFNE   HC.RJ6,0 
  
          PROCESS RJ6 
          SX6    "PC"+4 
          ZR     X6,RJ61     IF PC = 0
          S"PC"  -4          PC = 0 
          S"BL"  "BL"+1      BLEN = BLEN + 1
 RJ61     BSS    0
 .FPAS    IFNE   HC.FPAS,0
          SB3    X5+B6
          LX6    B1,X5
          SA3    B3+X6
          LX3    59-WB.FPP
+         PL     X3,*+1      IF ^FP[WORDB]
          RJ     CSR         COUNT SUB REF
 .FPAS    ENDIF 
  
          LX5    -SI.CAP
          SX1    X5-7776B 
          MI     X1,RJ62     IF CA[R1] < 4095 
          S"BL"  "BL"+1      BLEN = BLEN + 1
 RJ62     SA5    A5+B1       PI = PI + 1
          S"BL"  "BL"+B1     BLEN = BLEN + 1  */ COUNT RJ WORD
          EQ     WII2 
  
 .RJ6     ENDIF 
 CSR      SPACE  3,14 
 .FPAS    IFNE   HC.FPAS,0
**        CSR - COUNT *SUB* REFERENCE 
* 
*         ENTRY  (A3) = ADDRESS OF WORD B 
*                (X3) = SHIFT(WORDB,59-WB.FPP)
*                (X5) = [PI]
  
 CSR      ROUTINE 
          SA1    =XO$FPI
          LX3    1+WB.FPP-WB.FPOP 
          MX4    -WB.FPOL 
          BX2    -X4*X3 
          SB3    X2-1 
          SA2    B3+X1
          SX4    B1 
          LX4    FP.LENP
          IX6    X2+X4       FPI(FPO) = FPI(FPO) + 1
          SA6    A2 
          SA6    =XCC$SUB    CC$SUB = 1    */ INDICATE SUBS IN PROGRAM
          EQ     CSR
 .FPAS    ENDIF 
 LAB      SPACE  3,14 
**        LAB    CA,IH - DEFINE LABEL ADDRESS 
  
          PROCESS ENT 
          SX4    B1 
          LX4    SI.CAP 
          BX5    X4+X5       CA = 1 
  
          PROCESS LAB 
          SX6    "PC"+4 
          ZR     X6,LAB1     IF PC = 0
          S"PC"  -4          PC = 0 
          S"BL"  "BL"+1      BLEN = BLEN + 1
  
 LAB1     SA1    CC$LBO 
          SX2    B1 
          LX2    WC.RLP 
          SX3    "BL" 
          LX3    WC.RAP 
          LX1    WC.RBP 
          BX2    X1+X2
          BX6    X2+X3       ADW = WC(1,0,CG.LBO,BLEN)
          AX7    IH.IP
          MX1    -IH.IL 
          BX7    -X1*X7 
          SA1    LABA        MASK OF ADDRESS FIELDS 
          ZR     X7,LAB2     IF I[PI] = 0 
  
          SA3    =XF$FRT-1+X7      TABLE POINTER ADDRESS
          SA3    X3          BASE 
          MX4    -IH.HL 
          SB4    X7 
          BX7    -X4*X5 
          SB3    X7 
          SA2    X3+B3
          BX2    -X1*X2      MASK OUT ADDRESS FIELDS
          BX6    X2+X6       BUILD NEW C WORD 
          SA6    A2 
          NE     B4,B1,LAB3  IF I[PI] " 1  */ NOT A GL
          SA2    =XL.ELT# 
          ZR     X2,LAB3     IF L.ELT = 0  */ NO ELIMINATED LABEL DEFS
  
*         SEARCH ELT TO SEE IF THIS LABEL IS EQUIVALENT TO A
*         PROGRAMMER DEFINED LABEL, AND DEFINE THE ADDRESS OF IT. 
  
          SA3    =XO.ELT# 
          SA7    X3          [ELT] = H     */ STORE SEARCH TERMINATOR 
          SB4    X2 
          SA3    X3+B4       SEARCH TABLE 
+         BX4    X3-X7
          SA3    A3-B1
          SB4    X4 
          AX4    18 
          NZ     B4,*-1 
          ZR     X4,LAB3     IF NO EQUIVALENT 
  
          BX5    X4          SET IH OF EQUIVALENT, CA MUST BE 0 
  
 LAB2     LX7    B1,X5
          SB3    B6+X5
          SX7    X7+B1
          SA2    B3+X7       RETRIEVE WORDC 
          BX2    -X1*X2      BUILD NEW WORDC USING LABA MASK
          BX6    X2+X6
          SA6    A2          SYM(3*IH+2) = ADW
  
 LAB3     LX5    -SI.CAP
          S"BL"  "BL"+X5     BLEN = BLEN + CA[PI] 
          SA5    A5+1        PI = PI + 1
          EQ     WII2 
  
 LABA     BFMW   WC,(RL,RB,RA)
 RLV      SPACE  3,14 
**        RLV - CHECK REFERENCED LABEL VALUE FOR SUBSTITUTION 
* 
*         ENTRY  (B4) = SHIFT COUNT TO FIND *IH* IN *PI* WORD 
  
 RLV      ROUTINE 
          AX6    B4,X5
          MX3    -IH.IL 
          SB3    B6+X6
          LX3    IH.IP
          BX7    -X3*X6 
          NZ     X7,RLV      IF I[PI] " 0  */ NOT IN *SYM*
          SX6    X6 
          LX7    B1,X6
          SA3    B3+X7       WORDB = SYM(3*H+1) 
          LX3    59-WB.LCP
          PL     X3,RLV      IF ^LC[WORDB]
  
          SA2    A3-B1       WORDA = WORDB - 1
          MX1    -WA.LCOL 
          LX2    -WA.LCOP 
          BX3    -X1*X2      L = LCO[WORDA] 
          SA1    =XO.LCT# 
          SA2    =XO$BIT
          SB2    X1 
          SB3    X2 
  
 RLV1     SA1    B2+X3       LCW = LCT(L) 
          SA3    =XBN#
          MX5    -BI.OLNL 
  
 RLV2     BX7    X1-X3
          BX7    -X5*X7 
          ZR     X7,RLV3     IF K = HBN[LCW]
          SA3    B3+X3
          LX3    -BI.OLNP 
          BX3    -X5*X3      K = OLN[BIT(K)]
          NZ     X3,RLV2     IF K " 0 
  
          LX1    -LC.NEXTP
          SX3    X1          L = NEXT[LCW]
          NZ     X3,RLV1     IF L " 0      */ NOT END OF CHAIN
          EQ     RLV
  
 RLV3     LX1    -LC.GLNP 
          SX7    X1+I.GL     IH = GLN[LCW] + I.GL 
          LX6    B4 
          SA5    A5 
          BX5    X5-X6
          LX7    B4 
          BX7    X5+X7       SUBSTITUTE NEW VALUE 
          SA7    A5 
          EQ     RLV
  
          MACRO  OPR,N
          IFLT   OC.N,OC.CLR,4
          IF     DEF,/WII/.N,2
          VFD    12/,18//WII/.N-/WII/WII1 
          SKIP   1
          VFD    30/0                      N
          ENDM
  
 WIIA     BSS    0
*CALL     OPRDEFS 
          BSS    0
  
          QUAL   *
  
          ECHO   2,Z=(CG$RBT,CG$CUB,FSU#,CG$DSA,CG$EP,WII#) 
 Z        EQU    /WII/Z 
          ENTRY  Z
 AVO      SPACE  3,14 
 .VD      IF     DEF,VD.MATP
**        CG$AVO - ADJUST VARDIM ORDINAL OF REF TO VD. CELL 
* 
*         ENTRY  (X1) = C, INDEX TO VDI 
*         EXIT   (X1) = CA, INDEX TO VD. CELL 
*         USES   X - 3, 4, 6  A - 1, 3, 4, 6
  
 AVO1     LX3    1+VD.MATP-VD.CAP 
          SX1    X3          CA = CA[VE]
 CG$AVO   ENTRY. ** 
          SA4    =XO$VDI
          IX6    X4+X1
          SA3    X6          VE = VDI(C)
          LX3    59-VD.MATP 
          MI     X3,AVO1     IF MAT[VE]    */ CA ASSIGNED 
  
          MX4    1
          BX3    X3+X4       MAT[VE] = 1   */  SET MAT BIT
          SA1    =XN$VD      CA = N$VD
          LX3    1+VD.MATP-VD.CAP 
          MX4    -VD.CAL
          BX3    X4*X3
          BX6    X3+X1       CA[VE] = N$VD */ ASSIGN A *CA* 
          LX6    VD.CAP 
          SA6    A3          VDI(C) = VE
          SX6    X1+B1       N$VD = N$VD + 1
          SA6    A1 
          EQ     CG$AVO 
 .VD      ENDIF 
 SYM      TITLE  SYM - CONVERT *IH* TO DPC NAME 
 .T       IFNE   TEST,0 
  
**        SYM - RETURN DISPLAY CODED VALUE OF SYMBOL NAME IN X6 
*                FOR FORTRAN CODED DEBUGGING ROUTINES 
*         CALL
*                NAM = SYM( IH )
  
 SYM1     SB1    1
          RJ     CSN         CONVERT ORDINAL TO BCD NAME
          MX5    48 
          BX1    X5*X6
          CALL   ZTB=        REMOVE ZERO BYTES
 SYM      ENTRY.
          SA2    X1+
          NZ     X2,SYM1
          SA3    =1H
          BX6    X3 
          EQ     SYM
  
**        GETNSYM - RETURN N.SYMS IN SYMBOL TABLE 
  
 GETNSYM  ENTRY.
          SA2    =XL$SYM
          SX3    3
          IX6    X2/X3,B2 
          SA6    X1 
          EQ     GETNSYM
  
 .T       ENDIF 
 CSN      SPACE  3,14 
**        CSN - CONVERT SYMTAB *IH* TO BCD NAME 
* 
*         ENTRY  (X2) = *IH*
* 
*         EXIT   (X6) = 0L_BCD-NAME 
*                (B3) = BC
* 
*         USES   X - 2, 3, 4, 6   B - 2, 3
  
 CSN0     MX3    -13         IH LESS IH.LCMA ETC.                       001280
          BX2    -X3*X2                                                 001290
          LX3    B1,X2                                                  001300
          SB2    X4 
          IX3    X2+X3
          SA4    B2+X3       WORDA = SYM(IH)
          MX6    -6 
          BX3    -X6*X4 
          SB3    X3 
          BX6    X6*X4
  
 CSN      ENTRY. ,# 
          MX3    -IH.HL 
          BX6    X3*X2
          SA4    O$SYM
          ZR     X6,CSN0     IF I[IH] = 0 
  
*         CONVERT FOWARD REFERENCE SYMBOL TO DISPLAY CODE.
  
          BX4    -X3*X2 
          AX2    IH.HL
          SA3    CSNA-1+X2
          LX4    60-IH.HL 
          BX6    X3 
          SB3    9*6-1       BC = 54-1
  
+         LX4    3
          SB3    B3-6        BC = BC - 6
          SX3    X4 
          ZR     X3,*-1      SKIP PAST LEADING ZEROS
  
          SB2    60-4*6 
 CSN1     IX4    X4-X3       REMOVE DIGIT 
          LX3    B2 
          IX6    X6+X3       ADD DIGIT TO STRING
          SB2    B2-6 
          LX4    3
          SX3    X4 
          NZ     X4,CSN1
  
          MX3    1
          AX3    B3 
          BX6    X3*X6       REMOVE GARBAGE FROM THE NAME 
          SB3    B3+B1       BC = BC + 1
          EQ     CSN
  
 CSNA     BSS    0
          ECHO   1,Z=("HC.FRTP")
          DATA   8L;A.00000 
 OPR      TITLE  F.RDT - CCG *IL* INSTRUCTION DESCRIPTOR TABLE
          LIST   -X,-R,-F 
          ECHO   2,A=(I,II,III,IV,BSSZ),B=(0,1,2,3,1) 
          NOREF  A
 A        EQU    B
  
 .T       IFNE   TEST,0 
          MACRO  OPR,NAME,SS
 TY       SET    SS 
          CON    TY+1+4L_NAME 
          ENDM
  
          USE    /OPRS/ 
*CALL     OPRDEFS 
          USE    *
 .T       ENDIF 
          LIST   -R,X,F 
 OPR      SPACE  4
**        OPR - DEFINE *OPR* MACRO TO FORM RLIST DESCRIPTOR TABLE 
  
*         DEFINE VALUES FOR USE IN *OPR* MACRO CALLS
  
 MC       SET    34-15
          IFEQ   .CPU,76,1
 MC       SET    37-15
          IF     MIC,CPU990,1    IF 990 CPU DEFINED 
 MC       SET    31-15
  
          ECHO   2,X=(COMM,USI,),V=(1,1,0)
          NOREF  .X 
 .X       =      V
  
*         SYMBOL DEFINED IF INSTRUCTION DOESN"T DEFINE AN RI
  
          ECHO   2,N=(JUMP,UJUMP,STORE,STORE2,REGST,ECJUMP) 
          NOREF  Y.N
 Y.N      EQU    1
  
          ECHO   2,N=(LOAD,STORE,JUMP,UJUMP,LOAD2,STORE2,ECJUMP),_______
,V=(4,2,1,1,14B,12B,20B)
          NOREF  Z.N
 Z.N      EQU    V
  
          ECHO   2,N=(FMA,S,CLR,LDC,LDV,ILD,TLD)
          NOREF  ZRP.N
 ZRP.N    = 1 
  
*         BITS SET FOR XMT , CON SHIFTS AND PSEUDO INSTRUCTION FIELDS 
  
          ECHO   2,N=(SXT,XMT,KLS,KRS,EOQ,BOS,EOS,DAR,RS,DEF,LAB,ENT),__
,V=(4,4,2,2,1,1,1,1,1,1,1,1)
          NOREF  S.N
 S.N      EQU    V
  
          MACRO  OPR,NAM,SS 
          ECHO   1,X=(BD,LSJ,XSP) 
 X        SET    0
 TYPE     SET    SS 
 S        GETARG 23,4,(SS)
 CO       SET    ."S" 
*                                  UNSAFE INSTRUCTION 
 S        GETARG 28,3,(SS)
 CO       SET    CO+4*."S"
*                            FUNCTION UNIT AND TIMES
 S        MICRO  MC,2,$SS$
 FT       SET    "S" 0
 JFT      SET    FT/FT
 S        GETARG 40,6,(SS)
 FU1      SET    0
          IFC    NE,//"S"/,1
 FU1      SET    /FUNIT/"S" 
 FU2      SET    FU1
*                            SECOND FUNCTIONAL UNIT ( 6600 )
 #MD      IFEQ   .CPU,74                                         ?6600
 S        GETARG 47,5,(SS)
          IFC    NE,/"S"//,3
 FU2      SET    FU1+1
          IFC    NE,/"S"/FU1/,1 
 FU2      SET    /FUNIT/"S" 
 #MD      ENDIF                                                  '6600
*                            INSTRUCTION SIZE 
 S        GETARG 54,2,(SS)
 PA       SET    "S" 1
 PA       SET    PA/15
 S        GETARG 63,6,(SS)
          IF     DEF,ZRP.NAM,1
 CO       SET    2
*                            LOAD / STORE / JUMP BITS 
          IF     DEF,Z."S",1
 LSJ      SET    Z."S"
*                            ^D - NO RI / RI NOT A DEF
          IFEQ   TYPE,3,2 
 BD       SET    1
          ELSE   2
          IF     DEF,Y."S",1
 BD       SET    1
*                            BOUNDARY MARKER
 S        GETARG 70,1,(SS)
          IFC    NE,/"S"//,1
 BD       SET    BD+2 
          IF     DEF,S.NAM,1
 XSP      SET    S.NAM
* 
  VFD 2/TYPE,5/FT,2/1,4/FU1,4/FU2,2/BD,8/LSJ,3/XSP,2/JFT,3/CO,2/PA,23/
 OPR      ENDM
 RDT      SPACE  3
**        F.RDT - CCG *IL* INSTRUCTION DESCRIPTOR TABLE 
  
          ENTRY  F$RDT       REFERENCED AS * F.RDT * WITHIN *CCG* 
 F$RDT    BSS    0
          LOC    0
*CALL     OPRDEFS 
          LOC    *O 
          LIST   F,R
 .ID      IFNE   HC.ID,3           ^ PL/I                    ?
*CALL     CCOMISC 
          ENTRY  ISC= 
 .ID      ENDIF                    ^ PL/I                    '
 SST#     TITLE  SST# - SHELL SORT TABLE
***       SST# - SHELL SORT OF A SINGLE WORD PER ENTRY TABLE. 
* 
*         SST# SORTS A TABLE USING A SHELL SORT TECHNIQUE.
*         THE TABLE IS SORTED IN PLACE INTO ASCENDING ORDER ON THE KEY
*         KEY(X) = XOR(SHIFT(KEYMASK&X,KEYSHIFT),UPDOWN)
* 
*                TIME(SST) @ TIME(RADIX) FOR N @ 250/575, B6 "0/=0
* 
*         ENTRY  (B7) = ADDRESS OF TABLE TO BE SORTED 
*                (B6) = SHIFT COUNT FOR EXTRACTED KEY PRIOR TO COMPARE
*                (X0) = MASK TO EXTRACT KEY FROM ENTRY
*                (X1) = NUMBER OF ELEMENTS IN ARRAY.
*                (X5) = ASCENDING/DESENDING SORT MASK ( +0 / -0 ) 
* 
*         USES   X - ALL
*                B - 2, 3, 4, 5, 6
*                A - 1, 2, 6, 7.
  
 SST0     SA2    B2          I = I + 1
          SA7    B5-B4
          EQ     B2,B3,SST4  IF I > N 
  
 SST1     BX7    X0*X2
          SA1    B2+B4       J = I - K
          LX6    B6,X7
          SB5    B2+B4
          BX3    X6-X5       SI = KEY(T(I)) 
          SB2    B2+1 
          LX7    X2 
  
 SST2     BX2    X0*X1
          LX6    B6,X2
          BX2    X6-X5       SJ = KEY(T(J)) 
          IX6    X3-X2
          PL     X6,SST0     IF ELEMENTS IN ORDER 
          BX6    X1 
          SA1    B5+B4       J = J - K
          SA6    B5-B4       T(J+K) = T(J)
          SB5    B5+B4
          GE     B5,B7,SST2  IF J \ 0 
          SA2    B2          I = I + 1
          SA7    B5-B4       T(J+K) = S 
          LT     B2,B3,SST1  IF I @ LENGTH
  
 SST4     AX4    1           K = K/2
          SB4    X4 
          SA2    B7-B4       I = K
          SB2    B7-B4
          NZ     X4,SST1     IF K " 0 
 SST      ENTRY. **,# 
          MX4    12 
          NX6    B2,X1       K = 2**FIX(LOG2(LENGTH))+1 
          SB1    1
          SB3    B7+X1       (B3) = LWA + 1 
          AX4    B2,X4
          NZ     B6,SST4     IF SHFTC " 0 
  
          QUAL   SHFTC=0
  
 SST0     AX4    1
          SB4    X4          K = K/2
          SA2    B7-B4
          SB2    B7-B4       I = K
          NZ     X4,SST2     IF K " 0 
          EQ     SST
  
 SST1     SA2    A2+B1       I = I + 1
          SA7    B5-B4       T(J+K) = S 
          EQ     B2,B3,SST0  IF I > N 
  
 SST2     BX6    X0*X2
          SA1    B2+B4       J = I - K
          LX7    X2          S = T(I) 
          SB5    B2+B4
          BX3    X6-X5       SI = KEY(T(I)) 
          SB2    B2+1 
          BX2    X0*X1
  
 SST3     BX2    X2-X5
          IX6    X3-X2
          PL     X6,SST1     IF ELEMENTS IN ORDER 
          LX6    X1 
          SA1    B5+B4
          SA6    B5-B4       T(J+K) = T(J)
          SB5    B5+B4       J = J - K
          BX2    X0*X1
          GE     B5,B7,SST3 
          SA2    A2+B1       I = I + 1
          SA7    B5-B4
          LT     B2,B3,SST2  IF I @ N 
          EQ     SST0 
  
          QUAL
 SHL#     TITLE  SHL# - SHELL SORT
**        SHL# - SHELL SORT FOR A 1 WORD PER ENTRY TABLES.
*         INPLACE SORT OF TABLE INTO ASCENDING ORDER
* 
*                TIME(SHL) @ TIME(RADIX) FOR N @ 1650 
* 
*         ENTRY  (X1) = N = TABLE LENGTH
*                (B7) = TBL = = FWA OF ARRAY TO BE SORTED 
* 
*         EXIT   (B3) = LWA+1 OF TABLE
*                (B7) = FWA 
* 
*         USES   X - 1, 2, 3, 4, 6, 7 
*                B - 2, 3, 4, 5 
*                A - 1, 2, 6, 7 
  
 SHL1     SA2    A2+B1       I = I + 1
          SA7    B5-B4       T(J+K) = S 
          EQ     B2,B3,SHL4  IF I > N 
  
 SHL2     SA1    B2+B4       J = I - K
          LX7    X2          S = T(I) 
          SB5    B2+B4
          SB2    B2+B1
  
 SHL3     IX3    X2-X1
          BX6    X1 
          PL     X3,SHL1     IF ELEMENTS IN ORDER 
          SA1    A1+B4
          NO
          SA6    B5-B4       T(J+K) = T(J)
          SB5    B5+B4       J = J - K
          GE     B5,B7,SHL3  IF J \ 0 
          EQ     SHL1 
  
 SHL4     AX4    1
          SB4    X4          K = K/2
          SA2    B7-B4       I = K
          SB2    B7-B4
          NZ     X4,SHL2     IF K " 0 
  
 SHL      ENTRY. **,# 
          MX4    12 
          SB1    1
          NX6    B2,X1       K = 2**(FIX(LOG2(N))+1)
          SB3    B7+X1       (B3) = LWA+1 
          AX4    B2,X4
          EQ     SHL4 
 TABLES   TITLE  CCG TABLES 
**        TABLE DEFINE MANAGED TABLE FOR CCG
  
          MACRO  TABLE,TNAM,EQUIV 
 TOC      IFEQ   HC.2OC,0 
 TNAM     B$TBL  EQUIV
 .T       SET    Z$TNAM+1 
 TOC      ELSE
          EXT    O$TNAM,L$TNAM
 FF       IFEQ   .T,0 
 FTAB     EQU    O$TNAM 
 LTAB     EQU    L$TNAM 
 FF       ENDIF 
 EE       IFC    EQ,/EQUIV//
 Z$TNAM   EQU    .T 
 .T       SET    .T+1 
 EE       ELSE
 Z$TNAM   EQU    Z$EQUIV
 EE       ENDIF 
 TOC      ENDIF 
 TABNAM   RMT 
          ORG    NAMTAB+Z$TNAM
          DATA   10H TNAM EQUIV 
 TABNAM   RMT 
          ENDM
  
 .T       SET    0
  
          IFEQ   HC.2OC,0,1 
 FTAB     BSS    0                 FWA TABLE VECTOR 
  
*CALL     CCGTMTV 
  
 NTAB     EQU    .T          N. TOTAL TABLES
  
          IFEQ   HC.2OC,0 
 LTAB     BSS    0
 TABLES   HERE
          EXT    F.MEM
          USE    *
  
          ELSE
 F.MEM    EQU    0
          ENDIF 
  
          ENTRY  F$FRT
 F$FRT    BSS    0           FOWARD REFERENCE POINTER TABLE 
          ECHO   1,Z=("HC.FRTP")
          VFD    42/,18/=XO$Z_T 
          IFNE   HC.IA,0,1
          VFD    42/,18/=XF$SST 
  
 LM       ENTRY. F.MEM,#     LOW MEMORY ADDRESS ( FWA WORKING STORAGE ) 
 TN       CON    N.DT+1      NUMBER OF ACTIVE TABLES
          BSS    4           SCRATCH TO SAVE - X0 , X5 , X1 , A0
 PL       CON    0           PREVIOUS LENGTH OF REQUESTING TABLE
 TO       ENTRY. TOV#,#      ADDRESS OF TABLE OVERFLOW PROCESSOR
 MX.BLN   ENTRY. 0,#
 THRESH   ENTRY. 6000B,#
 TOV      TITLE  TABLE OVERFLOW PROCESSING ROUTINES 
**        TOV - TABLE OVERFLOW PROCESSOR
  
 .IA      IFNE   HC.IA,0
          ENTRY  TOVA#
 TOVA#    SX0    B5 
          CALL   DAT#        RETURNS (B5) = SPACE FREED UP
          SB5    B5+X0
          PL     B5,ATS65    IF ENOUGH SPACE AVAILABLE
 .IA      ENDIF 
  
          ENTRY  TOV# 
 TOV#     SB5    -B5
          SX1    B5+2000B    WR = NO.OF WORDS REQUESTED 
          PRINT  TOV,(* TOV CALLS MOREFL,WR=*Z7),(X1) 
          CALL   MOREFL 
          PL     X7,ATS65 
 .T       IFNE   TEST,0                                    * TEST MODE *
          SA5    ATS
          LX5    30 
 TOV      SNAP   FTAB,TO
 .T       ENDIF                                            * TEST MODE *
  
 TOV1     SA1    =7LTBL-OVF 
          CALL   PUNT        ISSUE AN ERROR MESSAGE AND QUIT
 TOB      SPACE  3,14 
**        TOB - OVERFLOW PROCESSING FOR PASS2,OPT2
* 
*         ENTRY (B5) = - NO.OF WORDS NEEDED 
* 
*         TOB ATTEMPTS TO OBTAIN NEEDED WORDS BY DECREASING BLK TABLE 
*         IF IT IS AT LEAST 1.5 TIMES THE MAX.BASIC BLOCK SIZE,ELSE 
*         TOB CALLS MOREFL TO GET ADDIT.SPACE BY EXTENDING FIELD
*         LENGTH. IF NO FL AVAIL.,COMPILATION IS ABORTED
  
          ENTRY  TOB# 
 TOB#     SA2    MX.BLN 
          PRINT  TOB,(* OVERFLOW, WORDS NEEDED = *Z7),(B5)
          SA3    =XM.BBL# 
          AX2    1           X2 = MX.BLN/2
          BX1    X3 
          AX1    1
          IX1    X1+X3       X1 = 1.5*M.BBL 
          IX4    X2-X1
          PL     X4,TOB1     IF MX.BLN/2 > 1.5*M.BBL
          BX2    X1 
  
*         MIN.BLK = MAX(MX.BLN/2,1.5*M.BBL) 
  
 TOB1     SB5    -B5         WN = NO.OF WORDS NEEDED
          PRINT  TOB,(*  NO.OF WORDS NEEDED,MIN.BLK = *2Z7),(B5,X1) 
          SA3    L$BLK
          SX1    B5+200B     WR = WN+200B */ WORDS TO BE REQUESTED
          IX4    X3-X2       WA = L.BLK - MIN.BLK */ WORDS AVAIL.IN BLK 
          SB2    B1          SPECIAL PROC.BY DMB IF MOREFL NOT CALLED 
          IX2    X4-X1
          BX6    X1 
          SB3    A0                                                             CCGA027 12
          ZR     B3,TOB1A    IF ALLOC BLK                                       CCGA027 13
          PL     X2,TOB2     IF WA GT WR                                        CCGA027 14
                                                                                CCGA027 15
 TOB1A    BSS    0                                                              CCGA027 16
          CALL   MOREFL      MOREFL(X6) = WG */ WORDS GRANTED IN NEW FL 
          PL     X7,ATS65    IF WG > WR 
  
          IX6    X1-X6       WR = WR-WG 
          SB2    B0          STAND.PROC BY DMB IF MOREFL CALLED 
  
*         GET REMAINING NEEDED SPACE BY REDUCING *BLK* SIZE 
  
 TOB2     SA2    =XMX.AVS#
          IX1    X6-X2       WD = WR - MX.AVS */ WORDS TO BE DUMPED 
          SB2    X1 
          LE     B2,B0,TOB3  IF WD .LE. ZERO
          SA6    TOBA        SAVE WR
          PRINT  TOB,(*  TOB CALLS  DMB ; WDS,SP.FLG=*2Z7),(X1,B2)
          CALL   DMB#        DUMP BLOCKS TO FREE *WD* WORDS 
*         DMB(X2) = WFL */ NO. OF WORDS BY MOREFL 
          NZ     X1,TOV1     IF X1 " 0 */ CANNOT DUMP ENOUGH BLOCKS 
          SA1    TOBA        RELOAD WR
          IX6    X1-X2       BLK.DECR = WR - WFL
          MI     X6,TOB4     IF BLK.DECR @ 0
  
*         DECREASE BLOCK TABLE SIZE BY BLK.DECR 
  
 TOB3     SA1    L$BLK
          IX7    X1-X6
          SA7    A1          L.BLK = L.BLK - WR 
          PRINT  TOB,(*  NEW BLK SIZE,DIFFERENCE =*2Z7),(X7,X6) 
 TOB4     CALL   CGB#        COLLECT FREE SPACE AT THE END OF *BLK* 
          EQ     ATS65
  
 TOBA     BSS    1
 MOREFL   SPACE  3,14 
**        GET MORE MEMORY FROM THE SYSTEM 
* 
*         ENTRY (X1) = WN ,  NO.OF WORDS NEEDED 
* 
*         EXIT   (X1) = WN
*                (X6) = WG , NO. OF WORDS GRANTED 
*                (X7) = WG - WN 
  
 MOREFL   ENTRY. **,# 
          PRINT  MOREFL,(*  WN =*Z7),(X1) 
          SA2    HO$MFLS     MXFL = HO$MFLS  */ MAX FL THAT WE CAN GET
          SA3    =XCP.AFLS   CFL = FL CURRENTLY USED
          AX2    30 
          IX6    X2-X3       WA = NO. OF WORDS AVAILABLE IN MXFL
          MX7    44 
          ZR     X6,MOREFL   IF WA = 0 */ MAX FL USED ALREADY 
          SB3    X6 
          MX7    -6 
          IX2    X1-X7
          BX2    X7*X2       ROUND WN TO NEXT 100B
          SB2    X2+1000B 
          GE     B2,B3,MFL1 
          SX6    B2          WR = MIN(WA,WN+1000B) */ NO OF WDS REQ.
  
 MFL1     IX7    X6+X3
          LX7    30 
          SA7    MFLA 
          BX7    X1 
          SA7    A7+B1
          PRINT  MOREFL,(* WA,WR =*2Z7),(B3,X6) 
          MEMORY SCM,MFLA,RCL 
          SA2    MFLA 
          SA3    CP.AFLS     OFL = OLD FL 
          AX2    30          NFL = NEW FL 
          IX0    X2-X3       WG = NO. OF WORDS GRANTED
          BX6    X2 
          SA6    A3          CP.AFLS = NEW FL 
          SA3    =XHO$PMLS
          MX7    X2+X3       HO$PMLS = MAX( HO$PMLS , NFL ) 
          SA7    A3 
          PRINT  MOREFL,(*  NEW FL,WG =*2Z7),(X6,X0)
          RJ     AST         */ ADJUST SPECIAL TABLES 
          SA1    MFLB 
          BX6    X0          (X6) = NO.OF WORDS GRANTED */ EXIT PAR.
          IX7    X0-X1
          SA2    THRESH 
          PL     X7,MOREFL   IF ENOUGH SPACE GRANTED
          MX7    0
          IX6    X6+X2
          SA7    A2          RELINQUISH TABLE MANAGER SLOP
          IX7    X6-X1
          EQ     MOREFL 
  
 MFLA     BSS    1
 MFLB     BSS    1
 CWS=     SPACE  3,14 
**        CWS# - CALCULATE WORKING STORAGE SIZE 
* 
*         EXIT   (X6) = CURRENT WORKING STORAGE SIZE
*                (X7) = MAXIMUM WORKING STORAGE SIZE
  
 CWS      ENTRY. **,# 
          SA1    LM 
          SA2    FTAB+N.DT   LWA OF DYNAMIC TABLES
          SA3    =XCP.AFLS
          SA4    =XHO$MFLS
          AX4    30 
          IX6    X2-X1       CWS = O.TEND - LM
          IX7    X4-X3
          IX7    X7+X6       MWS = MAX.FL - CP.AFLS + CWS 
          EQ     CWS
  
  
**        AST - ADJUST SPECIAL TABLES IN HIGH CORE AND POINTERS TO THEM 
* 
*         ENTRY  (X0) = CHANGE
  
 AST      ROUTINE 
          PRINT  AST,(* AST CALLED,CHANGE =*Z7),(X0)
          SA4    TN 
          SA2    FTAB-1+X4   FWA OF STATIC TABLES 
          SB2    X4-1 
          SA4    =XCP.NFLS   FL-10
          IX7    X4+X0       NEW CP.NFLS = OLD CP.NFLS + CHANGE 
          SA7    A4 
          IX1    X4-X2       WDS = CP.NFLS - O.TEND 
          IX3    X2+X0       TO = O.TEND + CHANGE 
          SB3    NTAB 
 AST1     SA4    FTAB+B2
          IX7    X4+X0
          SB2    B2+B1
          SA7    A4 
          LT     B2,B3,AST1 
          MOVE   X1,X2,X3 
          EQ     AST
 CG$PTC   TITLE  CG$PTC - PRINT *CCG* TABLES AFTER A REPRIEVE 
 .T       IFNE   TEST,0                                    * TEST MODE *
  
 NAMTAB   BSS    0
 TABNAM   HERE
  
 CG$PTC   ENTRY.
          SETB1 
          PRINT  ,(//*  -- COMPILER TABLE DUMP --*/)
          SX1    4           SET TO *EXECUTIVE IS /PTC=/* 
          RJ     =XSOB       SET OUTPUT BIT FLAGS 
          SX6    1
          SA6    PTCA        INITIALIZE COUNTER 
  
 PTC1     SA1    PTCA 
          SA2    FTAB+X1     GET FWA OF TABLE 
          SA3    LTAB+X1     GET LENGTH OF TABLE
          SA5    NAMTAB+X1   GET NAME OF TABLE
          RJ     PMT
          SA1    PTCA 
          SA2    TN 
          SX6    X1+B1
          SA6    A1          INCREMENT COUNTER
          IX7    X6-X2
          MI     X7,PTC1     IF MORE TABLES 
  
          SA1    =XHO$OPT 
          PL     X1,PTC2     IF OPT " 2 
          ECHO   4,TBL=(BIT,SEQ)
          SA2    =XO$TBL
          SA3    =XL$TBL
          SA5    =10H TBL 
          RJ     PMT
  
 PTC2     SA1    L$TXT
          SB2    X1-8 
          LE     B2,PTC3
          SA1    O$TXT
          SA2    X1 
          UX6    B2,X2
          LE     B2,PTC3     IF NO EXPONENT 
          SNAPRL PTC
  
 PTC3     RECALL =XF.OUT
          EQ     CG$PTC 
  
 PTCA     BSS    1
  
 PMT      ROUTINE 
          ZR     X3,PMT      IF LEN = 0 
          PRINT  ,(/*  TABLE -*A10*  FWA,LEN =*2Z6/),(X5,X2,X3) 
          IX3    X2+X3
          MX4    0
          RJ     =XDCM=      DUMP CENTRAL MEMORY
          EQ     PMT
  
 .T       ENDIF                                            * TEST MODE *
 ATS      TITLE  TABLE MANAGER SUBROUTINES
**        ATS$ - ALLOCATE TABLE SPACE 
* 
*         ENTRY  (A0) = TABLE INDEX.
*                (X1) = CHANGE (+ OR -) TO TABLE SIZE.
* 
*         EXIT   (X1) = CHANGE. 
*                (X2) = FWA OF TABLE. 
*                (X3) = NEW LENGTH OF TABLE.
*                (B6) = PREVIOUS TABLE LENGTH 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 2, 3, 4, 5, 7
*                A - 1, 2, 3, 4, 6, 7 
*         RESTORES X0, X5, B4, B5, B7 
*         CALLS  AMU, MVE.
*         THE DYNAMIC TABLES ARE DIVIDED INTO TWO PORTIONS.  THE LOW
*         PORTION RECIEVES 7/8 OF THE FREE SPACE AVAILABLE, THEREFORE 
*         THE LARGER AND FAST GROWING TABLES ARE IN THE LOW PORTION.
*         ATSNAT# IS THE NUMBER OF ACTIVE TABLES (IN LOW).
*         ALSO, 6000B OF FREE STORAGE IS ALWAYS KEPT IN RESERVE.
*         OPT = 1, ATSNAT# = 7. 
*         OPT = 2, BEFORE AFT IS CALLED.  ATSNAT# = 8.
*         OPT = 2, AFTER AFT IS CALLED.   ATSNAT# = 6.
  
          ENTRY  ATSNAT#,ATSTOG#
 ATSNAT#  CON    8           NO. OF ACTIVE TABLES  (IN LOW) 
 ATSTOG#  CON    6&8         ATSNAT TOGGLE
  
 ATSX     SA2    FTAB+A0     (X2) = FWA TABLE 
          SA3    LTAB+A0     (X3) = NEW LENGTH
  
 ATS      ENTRY. **,$ 
 ATS1     SA2    FTAB+A0     CURRENT FWA
          SA3    LTAB+A0     CURRENT LENGTH 
          SA4    A2+B1       NEXT TABLE FWA 
          IX6    X1+X3       NEW LENGTH 
          SB6    X3          (B6) = PREVIOUS TABLE LENGTH 
          IX7    X4-X2       ROOM BETWEEN TABLES
          SA6    A3          SET NEW LENGTH 
          IX7    X7-X6
          PL     X7,ATSX     RETURN IF ROOM FOR CHANGE
          SX7    X3          SET PREVIOUS LENGTH
          PRINT  ATS,(* CRASHER, WORDS NEEDED = *2Z7),(A0,X1) 
  
**        INITIALIZE FOR TABLE MOVE.
  
          SA2    TN          (B2) = NUMBER OF TABLES
          BX6    X0          SAVE (X0)
          SA7    A3 
          SA7    PL          PL = PREVIOUS LENGTH 
          SB2    X2 
          LX7    X5          SAVE (X5)
          SA6    A2+B1
          SA7    A6+B1
          BX6    X1          SAVE (X1)
          SA6    A7+B1
          MX6    -18         SAVE B4, B5, B7
          SX7    B4 
          SX2    B5 
          BX7    -X6*X7 
          BX2    -X6*X2 
          LX7    18 
          BX2    X7+X2
          SX7    B7 
          BX7    -X6*X7 
          LX2    18 
          BX7    X7+X2
          SA7    ATSA 
  
**        COMPUTE REMAINING TABLE SPACE.
  
          SB3    B2-B1
 ATS5     SA2    ATSNAT#
          SB5    X2-1        LSTLOW = ATSNAT-1
          SX4    B0 
 ATS10    SB3    B3-B1       ACCUMULATE ASSIGNED TABLE LENGTHS
          SA3    LTAB+B3
          NE     B3,B5,ATS15 IF I " LSTLOW
          SB6    X4          SAVE HIGHAL
 ATS15    IX4    X4+X3
          NZ     B3,ATS10    LOOP FOR ALL TABLES
          IX4    X4+X1       TOTAL = TOTAL + CHANGE 
          SB4    A0-B5
          LE     B4,B0,ATS20 IF CRASHER LE LSTLOW 
          SB6    X1+B6       HIGHAL = HIGHAL + CHANGE 
 ATS20    SX7    B6 
          SA7    ATSB 
          SA2    LM          SET AVAILABLE LENGTH 
          SA3    FTAB-1+B2
          IX6    X3-X2
          SB4    X4          (B4) = TOTAL ASSIGNED LENGTH 
          IX7    X6-X4
          SB5    X7          (B5) = REMAINING SPACE 
          SA1    THRESH      1000B/6000B OPT = 1/2
          IX7    X7-X1       GUARANTEE ELBOW ROOM 
          MI     X7,ATS60    IF NO REMAINING SPACE
  
**        MOVE ALL TABLES DOWN. 
  
          SA1    LM          LOW MEMORY LIMIT 
          SB3    B1 
          LX0    X1 
 ATS25    SA2    FTAB-1+B3   ORIGIN = PREVIOUS FWA
          SA1    LTAB-1+B3   WORD COUNT = LENGTH
          BX3    X0          DESTINATION = NEW FWA
          IX0    X0+X1       NEXT FWA 
          SX7    X3          SET NEW FWA
          BX4    X2-X3       MOVE DIFFERENTIAL
          SA7    A2 
          SB3    B3+B1       COUNT TABLE
          ZR     X4,ATS30    IF NO MOVE REQUIRED
          RJ     MVE= 
 ATS30    NE     B3,B2,ATS25 LOOP FOR ALL TABLES
          SA1    TN+3        INCREMENT SIZE OF REQUESTED TABLE
          SA2    LTAB+A0
          IX6    X2+X1
          SA6    A2 
  
**        REALLOCATE TABLES.
*         ALLOCATE INTERSPACE FOR HIGH. 1/8*(HIGHLA/2)*(1/N+TL/HIGHAL)
  
          SA1    FTAB-1+B2   (X0) = LWA+1 LAST TABLE
          SB3    B2-B1
          BX0    X1 
          SA2    ATSNAT#
          SB6    X2          LC = ATSNAT
          SB2    B2-B6       NTABS = TOTAL TABS - ATSNAT
          SX7    B4 
          SA7    ATSC        SAVE TOTAL 
          SX6    B5 
          SA6    ATSD        SAVE TOTLA 
          SA2    ATSB 
          SB4    X2          AL = HIGHAL
          AX6    3           HIGHLA = TOTLA/8 
          SB5    X6          LA = HIGHLA
  
*         DO ACTUAL REALOCATION.
  
 ATS35    SB3    B3-B1       I = I + 1
          SA2    FTAB+B3     FWA(I) 
          SX4    B5          LA (LENGTH AVAILABLE)
          SA1    LTAB+B3     TL (LENGTH OF TABLE) 
          SX3    B2-B1       N  (NUMBER OF TABLES)
          AX5    X4,B1       LA/2 
          IX6    X4/X3       L1 = LA/N
          ZR     B4,ATS40 
          SX3    B4          AL (TOTAL ASSIGNED LENGTH) 
          IX7    X5*X1       (LA/2)*TL
          AX6    1           L1 = LA/2N 
          IX7    X7/X3       L2 = (TL*LA)/2 
          IX6    X6+X7       L = L1+L2
          SX1    X1 
 ATS40    IX6    X0-X6       FWA(I+1) - L 
          IX7    X6-X1       FWA(I) = FWA(I+1)-L-TL 
          BX3    X7          DESTINATION = FWA(I) 
          SA7    A2 
          LX0    X7          FWA(I+1) = FWA(I)
          BX4    X2-X3       CHECK MOVE DIFFERENTIAL
          ZR     X4,ATS45    IF NO MOVE REQUIRED
          RJ     MVE=        MOVE TABLE 
 ATS45    GT     B3,B6,ATS35 LOOP 
  
*         ALLOCATE INTERSPACE FOR LOW. 7/8*(LOWLA/2)*(1/N+TL/LOWAL) 
  
          SX1    B6-3 
          MI     X1,ATS55   IF LC < 3    */ALREADY DID LOW
          SA2    ATSFAT 
          SB6    X2          FIRST ACTIVE TABLE 
+         SA2    ATSNAT#
          SB2    X2+B1
          SB2    B2-B6       NTABS = ATSNAT + 1 - LC
          SA1    ATSC 
          SX2    B4 
          IX3    X1-X2       LOWAL = TOTAL - HIGHAL 
          SB4    X3          AL = LOWAL 
          SA1    ATSD 
          SX2    B5 
          IX3    X1-X2       LOWLA = TOTLA - HIGHLA 
          SB5    X3          LA = LOWLA 
          EQ     ATS35
  
**        RESTORE REGISTERS.
  
 ATS55    SA1    ATSA 
          SB7    X1 
          AX1    18 
          SB5    X1 
          AX1    18 
          SB4    X1 
          SA2    TN+1        RESTORE (X0) 
          SA3    A2+B1       RESTORE (X5) 
          BX0    X2 
          SA4    PL 
          LX5    X3 
          SA1    A3+B1       RESTORE (X1) 
          SB6    X4          (B6) = PREVIOUS LENGTH OF TABLE
          EQ     ATSX        RETURN 
  
 ATS60    SA3    TO          PROCESS TABLE OVERFLOW 
          SB5    X7 
          SX6    A0 
          SB2    X3 
          SA6    TN+4        (A0) 
          JP     B2          (B5) = - WORDS NEEDED
  
*         RETURN FROM USER TABLE OVERFLOW PROCESSOR ( SUCCESS ) 
  
 ATS65    SA1    TN+3        X1 
          SA4    A1-B1       X5 
          BX5    X4 
          SA3    A1+B1       A0 
          SA0    X3 
          SA4    A4-B1       X0 
          BX0    X4 
          SA2    A4-B1       TN 
          SB2    X2          (B2) = TN
          SB3    B2-B1
          EQ     ATS5 
  
 ATSA     CON    0           B4,B5, B7 SAVE IF A TABLE MOVE 
 ATSB     BSS    1
 ATSC     BSS    1
 ATSD     BSS    1
 ATSFAT   CON    2           FIRST ACTIVE TABLE 
 AFT      SPACE  3,14 
**        AFT - ACTIVATE FIRST TABLE
  
 AFT      ENTRY. **,# 
          SA2    ATSFAT 
          SX1    1&2
          BX6    X2-X1
          SA6    A2          TOGGLE ATSFAT
          SA1    ATSNAT#
          SA2    ATSTOG#
          BX6    X2-X1
          SA6    A1          TOGGLE ATSNAT
          SA1    LM 
          BX7    X1 
          SA7    FTAB 
          EQ     AFT
 ADW      EJECT              ADW
**        ADW$ - ADD A WORD TO THE END OF A MANAGED TABLE 
*         ENTRY  (A0) = TABLE NUMBER. 
*                (X1) = WORD. 
*         EXIT   (X1) = WORD. 
*                (X6) = WORD. 
*                (A6) = ADDRESS OF WORD.
*                (X2) = FWA TABLE.
*                (X3) = LENGTH OF TABLE.
*                (B6) = L.TBL - 1 
* 
*         USES   X - 1, 6, 7. 
*                B - NONE.
*                A - 1, 6.
*         CALLS  ATS. 
  
 ADW1     BX7    X3 
          IX4    X2+X3
          SA7    A3+         UPDATE LENGTH
          SB6    X3-1              (B6) = OLD LENGTH
          SA6    X4-1        STORE WORD 
 ADW      ENTRY. **,$ 
          SA2    FTAB+A0     FWA
          SA3    LTAB+A0
          SA4    A2+B1       NEXT TABLE FWA 
          BX6    X1 
          IX7    X4-X2       ROOM BETWEEN TABLES
          SX3    X3+B1
          IX4    X7-X3
          PL     X4,ADW1     IF ROOM TO ADD A WORD
          SX1    B1 
          SA6    ADWA 
          RJ     ATS         ALLOCATE SPACE 
          SA1    ADWA 
          IX4    X2+X3
          BX6    X1 
          SA6    X4-1 
          EQ     ADW
  
 ADWA     BSS    1
 MTU      SPACE  3
**        MTU$ - MOVE TABLES UP 
*         ENTRY  NONE.
*         EXIT   NONE.
*         USES   X - 0, 1, 2, 3, 7. 
*                B - 3. 
*                A - 1, 2, 7. 
*         CALLS  MVE. 
  
 MTU1     SB3    B3-B1       DECREMENT TABLE COUNT
          SA2    FTAB+B3
          SA1    LTAB+B3
          IX7    X0-X1       NEW FWA = L - LENGTH 
          LX0    X7          L = NEW FWA
          SA7    A2 
          BX3    X0          MOVE TABLE 
          ZR     X1,MTU2     IF LEN = 0 
          IX4    X2-X3
          ZR     X4,MTU2
          MOVE   X1,X2,X3 
 MTU2     NZ     B3,MTU1
  
 MTU      ENTRY. **,$ 
          SB3    NTAB-1      (B3) = NUMBER OF TABLES - 1
          SA1    FTAB+B3     (X0) = LWA+1 OF ALL TABLES (L) 
          BX0    X1 
          EQ     MTU1 
  
          END 
