*DECK     MIO 
          IDENT  MIO
 MIO      TITLE  MIO - MASS STORAGE RANDOM I/O
*CALL     SSTCALL 
 B=MIO    RPVDEF
*IF       DEF,MIO,1 
          TRACER (WMB,RTB,DMB)
  
**        MIO - MASS STORAGE I/O ROUTINES 
* 
*         THIS SET OF SUBROUTINES HANDLES DYNAMIC STORAGE ALLOCATION
*         FOR EXTENDED BASIC BLOCKS DURING OPT=2 PROCESSING.  BLOCKS
*         ARE PAGED FROM LCM/ECS OR DISK INTO AN SCM TABLE *BLK* AS THEY
*         ARE REQUESTED.  THE RANDOM INDEX WORDS IN *BIT* AND THE BLOCK 
*         ADDRESS WORDS IN *BST* ARE UPDATED FOR EACH BLOCK THAT IS 
*         MOVED.  THEY CONTAIN CURRENT POSITIONAL INFORMATION INCLUDING 
*         THE SCM FWA, DISK ADDRESS, LCM/ECS ADDRESS, LENGTH, AND STATUS
*         BITS FOR EACH BLOCK.
*         SPACE IN *BLK* AND LCM/ECS IS ALLOCATED USING KNUTHS BOUNDARY 
*         TAG METHOD.  IT REQUIRES HEADER AND TRAILER WORDS FOR EVERY 
*         BLOCK.  THE LINKED LIST OF AVAILABLE SPACE IS KEPT IN THE 
*         BLOCK TRAILER WORDS.  THE ADVANTAGE OF THIS TECHNIQUE IS THAT 
*         ESSENTIALLY A FIXED AMOUNT OF TIME IS REQUIRED TO FREE AN AREA
*         AND COLLAPSE IT WITH ANY ADJACENT FREE AREA, WHILE OTHER
*         METHODS WOULD REQUIRE A LIST SEARCH.  IT ALSO SIMPLIFIES
*         GARBAGE COLLECTION PROCEDURES.  THE METHOD  IS DESCRIBED BY 
*         GRIES IN "COMPILER CONSTRUCTION FOR DIGITAL COMPUTERS", 
*         SECTION 8.10. 
          IF     -DEF,.MI,1                                                     F1037CC 18
 .MI      EQU    0                                                              F1037CC 19
                                                                                F1037CC 20
 #MD      IFGE   CT.CPU,76                                                      F1037CC 21
 #MD      IFNE   .MI,1                                                          F1037CC 22
                                                                                F1037CC 23
 RXX,Q    OPDEF  I,J,Q                                                          F1037CC 24
          RX.I   X.J                                                            F1037CC 25
          ENDM                                                                  F1037CC 26
                                                                                F1037CC 27
 WXX,Q    OPDEF  I,J,Q                                                          F1037CC 28
          WX.I   X.J                                                            F1037CC 29
          ENDM                                                                  F1037CC 30
                                                                                F1037CC 31
 BLK.SIZ  EQU    1777B                                                          F1037CC 32
 #MD      ELSE                                                                  F1037CC 33
 RXX,Q    OPDEF  I,J,Q                                                          F1037CC 34
          R=     A0,Q                                                           F1037CC 35
          R=     X0,X_J                                                         F1037CC 36
          RL     B1                                                             F1037CC 37
          SA.I   A0                                                             F1037CC 38
 R        ERRPL  I-6         OPERAND NOT IN LD REG                              F1037CC 39
          ENDM                                                                  F1037CC 40
                                                                                F1037CC 41
 WXX,Q    OPDEF  I,J,Q                                                          F1037CC 42
          R=     A0,Q                                                           F1037CC 43
          R=     X0,X_J                                                         F1037CC 44
          SA.I   A0                                                             F1037CC 45
          WL     B1                                                             F1037CC 46
 R        ERRMI  I-6         OPERAND NOT IN ST REG                              F1037CC 47
          ENDM                                                                  F1037CC 48
                                                                                F1037CC 49
 BLK.SIZ  EQU    377B                                                           F1037CC 50
 #MD      ENDIF                                                                 F1037CC 51
  
 #MD      IF     -MIC,HF.E
  
          PURGDEF RLB 
          PURGDEF WLB 
 RLB      OPDEF  I
+         RL     B.I+0
-         EQ     ERRECSR
          ENDM
  
 WLB      OPDEF  I
+         WL     B.I+0
-         EQ     ERRECSW
          ENDM
  
 RE       OPSYN  ERR
 WE       OPSYN  ERR
  
 #MD      ELSE                                                                  F1037CC 53
          ERRNZ  .MI         SHOULD BE 7600 ONLY (NOT .MI)                      F1037CC 54
                                                                                F1037CC 55
 #MD      ENDIF 
  
          TABLES (BIT,BLK,BST,SEQ,TXT)
          EXT#   (PUNT,MOREFL,BSI,TO,TOB) 
          EXT    CP.AFLL
 LCM.FL   EQU    CP.AFLL
  
          EXT    F.MEM
 FWAB     EQU    F.MEM+100B 
          SPACE  4,8
 O.LCM    BSS    1           NEXT AVAIL LCM ADDRESS 
  
*         LOCAL VARIABLES 
  
          ENTRY MAX.LCM 
 MAX.LCM  DATA   200000B     MAX LCM COMPILER USES
 O.DISK   DATA   1           NEXT AVAILABLE RA ON DISK
 ADT      BSSZ   1           ADDRESS TYPE, 0=DISK, 1=LCM
 O.RRB    BSSZ   1           FWA OF RANDOM READ BUFFER ( RRB )
 O.RWB    VFD    42/,18/FWAB FWA OF RANDOM WRITE BUFFER 
 RLEN     BSSZ   1           LENGTH OF CURRENT RECORD IN WRITE BUFFER 
 N.RRB    BSSZ   1           RA OF RECORD IN RRB
 MX.AVS   ENTRY. 0,#         MAXIMUM AVAILABLE SPACE IN *BLK* 
 MX.AVL   BSSZ   1           MAXIMUM AVAILABLE SPACE IN LCM 
 LAS      BSSZ   1           HEAD OF BLK LIST OF AVAILABLE SPACE
 LAL      BSSZ   1           HEAD OF LCM LIST OF AVAILABLE SPACE
  
 MIN.AB   EQU    40B         MIN SIZE BLOCK ADDED TO LAS
 MIN.AL   EQU    100B        MIN SIZE BLOCK ADDED TO LAL
 LCM.XL   EQU    20B         EXTRA LENGTH ADDED TO LCM BLOCKS 
  
          LIST   X
*CALL     IOTBLD
 DEBUG    TITLE  DEBUGGING FACILITIES 
**        PRNTM - PRINT OUT SELECTED STRUCTURES 
* 
*         PRNTM  LAB,NAM,ARG,RLS
  
 PRNTM    MACRO  LAB,NAM,ARG,RLS
          LOCAL  APL
 O        IF     DEF,/DEBUG/LAB 
+         RJ     CPR
-         VFD    30/APL 
          USE    DEBUG
 APL      CON    10H LAB
 N        MICRO  2,1,/ARG/
          VFD    30/=XSV=X+"N"
          VFD    30/Q.NAM 
          USE    *
 O        ENDIF 
          ENDM
  
 .T       IFNE   TEST,0                                    * TEST MODE *
  
          USE    DEBUG
 .1       SET    1
          ECHO   2,X=(RIW,BAW,BHW,BTW,BIT,BST,BLK)
 Q.X      EQU    .1 
 .1       SET    .1+1 
  
  
 CPR      ROUTINE 
          RJ     =XSVR= 
          SA1    CPR
          LX1    30 
          SA2    X1-1 
          SA1    O.BIT
          SA4    O.BST
          SA5    O.BLK
          SA3    X2+1 
          SX7    X2+1 
          SX6    X2 
          LX3    30 
          SA6    CPRA 
          SA7    CPRA+1 
          BX6    X1 
          BX7    X4 
          SA6    CPRA+2 
          SA7    CPRA+4 
          BX6    X5 
          SX7    X3 
          SA6    CPRA+6 
          SA7    CPRA+9 
          SX6    X3-8 
          SA6    CPRA+8 
          SA1    CPRA 
          CALL   PRNTMIO
          RJ     =XRSR= 
          EQ     CPR
  
 CPRA     BSS    3
          VFD    42/,18/L.BIT 
          BSS    1
          VFD    42/,18/L.BST 
          BSS    1
          VFD    42/,18/L.BLK 
          BSSZ   3
          USE    0
  
 .T       ENDIF                                            * TEST MODE *
 SETFET   SPACE  3,14 
**        SETFET - SETUP FET FOR RANDOM READ OR WRITE ( 6000 CIO )
  
 SETFET   MACRO  FET,FWA,LEN,RW,NOADD 
          SA1    RFWA 
          R=     X6,FWA 
          R=     B2,LEN 
          BX6    X1+X6
          SA6    =XF.FET+1
          SX6    X6 
          SX7    X6+B2
          IFC    EQ,/RW/READ/ 
          SA6    A6+B1       I=F
          SA6    A6+B1       O=F
          ELSE
          SA7    A6+B1       I=F+LEN
          SA6    A7+B1       O=F
          ENDIF 
          IFC    EQ,/NOADD//,1
          SX7    X7+100B
          SA7    A6+B1       LIM=F+L+100B 
          ENDM
  
 RFWA     VFD    13/1,29/3,18/0 
          TTL    MIO - MASS STORAGE RANDOM I/O (EXTERNAL ROUTINES)
 IMP      TITLE  IMP - INITIALIZE MASS I/O PROCESSING 
**        IMP - INITIALIZE MASS I/O PROCESSING
  
 IMPA     ENTRY. **,# 
  
*         INITIALIZE FOR USING LCM
  
          SA1    =XHO$OFLL
          BX6    X1          O.LCM = HO$OFLL
          SA6    O.LCM
 #ECS     IFNE   CT.ECS,0 
          SA1    =XLCM.FL 
          ZR     X1,IMPA1    IF CP.AFLL = 0  */NO ECS AVAILABLE 
          SX7    1
          SA7    ADT         ADT = 1
 IMPA1    BSS    0
  
 #ECS     ENDIF 
  
 #MD      IFEQ   CP#RM,7
          OPENM  =XFI.OPT,I-O,N,WA
          STORE  =XFI.OPT,WA=X7    INITIALIZE WA
 #MD      ENDIF 
  
          PRINT  IMP,(* --LCM.FL,ADT,MAX.LCM = *3Z8),(X1,ADT,MAX.LCM) 
          EQ     IMPA 
 IMPB     SPACE  3
 IMPB     ENTRY. **,# 
          SA4    O.RWB
          SA5    RLEN 
          ZR     X5,IMPB1 
  
          CALL   SBD         DUMP LAST PHASE 1 BLOCKS TO DISK 
          MX7    0
          SA7    RLEN        RLEN = 0 
  
 IMPB1    SA1    =XHO$OBO 
          SX7    X1+=XHO$OBL
          SX6    X1 
          SA6    O.RRB       O.RRB = FWA OF OPT=2 PAGING BUFFER 
          MX6    59 
          SA7    O.RWB       O.RWB = O.RRB + HO$OBL 
          SA6    N.RRB       N.RRB = -1 
          PRINT  IMP,(* --O.RRB,O.RWB =*2Z8),(O.RRB,O.RWB)
          EQ     IMPB 
 IMP      SPACE  3,14 
**        IMPC - OPT=2 ENTRY TO INITIALIZE *BLK*
* 
*         ENTRY  (X7) = MAX BLK SPACE 
  
 IMPC     ENTRY. **,# 
          RJ     IBS         INITIALIZE *BLK* SPACE 
          SA1    O.BLK
          SA2    L.BLK
          IX6    X1+X2       O.TXT = O.BLK + L.BLK
          SA6    O.TXT
          PRINT  IMP,(*  MAX.BLK,O.BLK,L.BLK =*3Z7),(MAX.BLK,B2,B3) 
          SX7    =XTOB
          SA7    =XTO        SET OPT=2 TABLE OVERFLOW EXIT
          EQ     IMPC 
 IMPD     SPACE  2
**        IMPD - OPT=1 ENTRY TO INITIALIZE *BLK*
*         ALLOCATE BLOCK SPACE, MOVE LOOP BODY TO *BLK* 
  
 IMPD     ENTRY. **,# 
          SA1    L.TXT
          SX6    0
          SA6    LAS         LAS = 0
          SA6    MX.AVS      MX.AVS = 0 
          SX7    X1+200B
          RJ     IBS         INITIALIZE *BLK* SPACE 
          SA5    L.TXT
          ALLOC  BLK,X5+2    ALLOC( BLK , L.TXT+2 ) 
          SX3    X2+B6       TO = O.BLK + OLD(L.BLK)
          SB3    X2+B6       FTB = TO 
          SA2    O.TXT
          SB4    B3+X5       LTB = TO + L.TXT 
          SX6    X5 
          SA6    X2+B1       R2 = TXT + 1;  [R2] = L.TXT
          MOVE   X1,X2,X3    MOVE( L.TXT , O.TXT , TO ) 
          SX6    X5+2        LT = L.TXT + 2 
          SX7    4
          SA7    L.TXT       L.TXT = 4
          LX7    BH.BIP 
          SA6    B4          [LTB] = BTW(0,0,0,LT)
          BX6    X6+X7
          MX7    0
          SA7    A6+B1       [LTB+1] = 0   */ BLK BOUNDARY MARKER 
          SA6    B3-B1       [FTB-1]=BHW(0,4,0,LT)
          SA1    O.BIT
          MX0    1
          LX0    1+RI.ICP 
          LX5    RI.LENP
          SX4    B3 
          BX6    X0+X5
          LX4    RI.FWAP
          BX7    X4+X6
          SA7    X1+5        BIT(5) = RIW(IC,LT-2,FTB,0)
          EQ     IMPD 
 IBS      SPACE  2,10 
**        IBS - INTIALIZE *FREE* SPACE LIST IN *BLK*
* 
*         ENTRY  (X7) = LENGTH OF FREE SPACE LIST 
  
 IBS      ROUTINE 
          ALLOC  BLK,X7+2    ALLOC( BLK , LEN+2 ) 
          SA4    RBSA+1      DB = RBSA(2)  */ *RI* WORD FOR DUMMY BLOCK 
          SA5    O.BIT
          MX6    0
          SA6    X2          [BLK] = 0
          BX7    X4 
          SA7    X5+B1       BIT(1) = DB
          SA7    X5+3        BIT(3) = DB
          SB3    X3-2        LEN = L.BLK - 2
          SB2    X2+B1       FWA = O.BLK + 1
          SA6    B2+B3       BLK(L.BLK-1) = 0  */ TERMINAL BOUNDARY MARK
          CALL   ABB         CALL  ABB( FWA , LEN ) */ INIT FREE SPACE
          EQ     IBS
 WMB      TITLE  WMB - WRITE MODIFIED BLOCK 
**        WMB/WFB - WRITE MODIFIED BLOCK TO *BLK* 
* 
*         ENTRY  (BSI) = *BST* INDEX OF BLOCK 
*                FOR THE *WFB* ENTRY ONLY - 
*                (X1) = NL, NEW LENGTH
*                (X6) = FWAB , FWA OF BLOCK 
* 
*         EXIT   BLOCK COPIED TO *BLK*
*                *BST*, *BIT* ENTRIES UPDATED 
* 
*         CALLS  ASB, MVE=. 
  
 WFB      ENTRY. **,# 
          SA2    =XHO$OPT 
          SA3    O.BST
          SA4    =XBSI
          SB3    X3 
          SA5    B3+X4       BAW = BST(BSI) 
          PL     X2,WFB1     IF OPT " 2    */ FW NOT SET FOR OPT=1
          SX0    B1 
          LX0    BA.FWP 
          BX5    X0+X5       FW[BAW] = 1   */ INDICATE FINAL WRITE
 WFB1     BX7    X1 
          SA6    WFBA 
          SA7    A6+B1
          LX5    -BA.FWAP 
          SB2    X5-1        FWA = FWA[BAW] - 1 
          LX5    BA.FWAP-BA.LENP
          SB5    X5+2        OL = LEN[BAW] + 2
          LX5    BA.LENP
          MI     X5,WFB2     IF IC[BAW]     */ IF IN BLK
          SB2    B0          FWA = 0
          SB5    B1+B1       OL = 2 
 WFB2     SA2    WFB
          BX7    X2 
          SA7    WMB         [WMB] = [WFB] */ PLUG ENTRY POINT
          CALL   ASB
          SA4    WFBA        FSCM = FWAB
          SA1    A4+B1
          EQ     WMB1 
  
 WMB      ENTRY. **,# 
          SA3    O.BST
          SA4    BSI
          SB3    X3 
          SA5    B3+X4       BAW = BST(BSI) 
          LX5    -BA.FWAP 
          SB2    X5-1        FWA = FWA[BAW] - 1 
          LX5    BA.FWAP-BA.LENP
          SB5    X5+2        OL = LEN[BAW] + 2
          LX5    BA.LENP
          SA1    L.TXT       NL = L.TXT 
          MI     X5,WMB0     IF IC[BAW]     */ IF IN BLK
          SB2    B0          FWA = 0
          SB5    B1+B1       OL = 2 
 WMB0     CALL   ASB         FBLK = ASB(FWA,OL,NL)   */ ALLOCATE SPACE
          SA1    O.BST
          SA2    BSI
          IX6    X1+X2
          SA5    X6          BAW = BST(BSI) 
          SA4    O.TXT       FSCM = [O.TXT] 
          SA1    L.TXT       NL = L.TXT 
  
*         UPDATE *BST*, *BIT* ENTRIES 
  
 WMB1     SA2    O.BIT
          PRINT  WMB,(* --FBLK FROM ASB =*Z7),X3
          SB7    X4                        (B7) = FSCM
          MX0    -BA.SAVL 
          SB2    X2+B1
          LX0    BA.SAVP
          MX7    1
          BX5    -X0*X5 
          LX7    1+BA.BLKP   BLK[BAW] = 1 
          BX7    X5+X7
          LX5    -BA.BIP
          SB4    X5          AR = BI[BAW] 
          LX1    BA.LENP     LEN[BAW] = NL
          SA2    WMBA 
          SA4    B4+B2       RIW = BIT(AR+1)
          LX3    BA.FWAP     FWA[BAW] = FBLK
          IX6    X1+X3
          LX5    BA.BIP 
          BX7    X6+X7
          LX1    RI.LENP-BA.LENP   LEN[RI] = NL 
          SA7    A5          BST(BSI) = BAW 
          PRNTM  WMB,BAW,X7 
          MX7    1
          LX3    RI.FWAP-BA.FWAP   FWA[RI] = FBLK 
          LX7    1+RI.ICP    IC[RIW] = 1
          BX4    X2*X4
          BX7    X4+X7
          IX6    X1+X3
          BX7    X6+X7
          LX1    -RI.LENP 
          LX3    -RI.FWAP 
          SA7    A4          BIT(AR+1) = RIW
          PRNTM  WMB,RIW,X7 
  
*         STORE BLOCK HEADER AND TRAILER WORDS, MOVE BLOCK TO *BLK*.
  
          SA4    BSI
          BX7    X5 
          LX7    59-BH.FWP
          PL     X7,WMB2     IF ^ FW[BHW] 
  
          MX6    -BH.PRIL 
          SX4    B1 
          LX6    BH.PRIP
          BX5    X5*X6       PRI[BHW] = 0 
          LX4    17          BSI = 400000B
 WMB2     SX6    X1+2        L= NL + 2
          LX6    BT.LENP
          SB6    X3 
          SA6    B6+X1       [FBLK+NL] = BTW(0,0,0,L) 
          PRNTM  WMB,BTW,X6 
          LX6    BH.LENP-BT.LENP
          LX4    BH.BSTP
          BX6    X6+X4
          BX7    X5+X6
          SA7    B6-B1       [FBLK-1] = BHW(0,AR,BSI,L) 
          PRNTM  WMB,BHW,X7 
          MOVE   X1,B7,X3    MOVE( NL , FSCM , FBLK ) 
          EQ     WMB
  
 WMBA     BFMW   RI,(IC,AT,LCM) 
 WFBA     BSS    2           FWA , NL 
 RTB      TITLE  RTB - READ TEXT BLOCK
**        RTB - READ TEXT BLOCK INTO *BLK*
* 
*         ENTRY  (BSI) = *BST* INDEX OF BLOCK TO BE READ IN 
* 
*         EXIT   (O.SEQ) = FWA OF BLOCK IN *BLK*
*                (L.SEQ) = LEN OF BLOCK 
*                *BST*, *BIT* ENTRIES UPDATED 
* 
*         CALLS  ASB, GMB.
  
*         BLOCK IS ALREADY IN *BLK*, SET O.SEQ, L.SEQ 
  
 RTB0     LX3    1+BA.BLKP-BA.FWAP
          SX6    X3 
          LX3    BA.FWAP-BA.LENP
          SA6    O.SEQ       O.SEQ = FWA[BAW] 
          SX7    X3+
          SA7    L.SEQ       L.SEQ = LEN[BAW] 
  
          PRINT  RTB,(*  O.SEQ, L.SEQ = *2Z10),(O.SEQ,L.SEQ)
  
 RTB      ENTRY. **,# 
          SA1    O.BST
          SA2    BSI
          SB2    X1 
          SA3    X2+B2       BAW = BST(BSI) 
          LX3    59-BA.BLKP 
          MI     X3,RTB0     IF BLK[BAW]
  
*         ALLOCATE SPACE IN *BLK* 
  
          SA4    O.BIT
          LX3    1+BA.BLKP-BA.BIP 
          SB4    X3+B1       I = BI[BAW] + 1
          SB2    B0          FWA = 0
          SB5    B1+B1       OL = 2 
          SA5    X4+B4       RIW = BIT(I)  */RANDOM INDEX WORD
          LX5    -RI.LENP 
          SX1    X5          L = LEN[RIW] 
          BX4    X5 
          LX4    59-RI.ICP+RI.LENP
          PL     X4,RTB1     IF ^ IC[RIW] 
  
          LX4    1+RI.ICP-RI.FWAP 
          SB5    B0 
          SX3    X4          FBLK = FWA[RIW]
          SX6    RBSB 
          IX7    X3-X6
          ZR     X7,RTB2     */IF DUMMY BLOCK 
  
          SA4    X4-1        BHW = [FBLK-1] 
          MX7    -BH.BSTL 
          LX4    -BH.BSTP 
          BX4    X4*X7
          BX6    X2+X4       BST[BHW] = BSI 
          LX6    BH.BSTP
          SA6    A4          [FBLK] = BHW 
          EQ     RTB2 
  
 RTB1     LX5    RI.LENP
          CALL   ASB         FBLK = ASB(FWA,OL,L)  */ALLOCATE SPACE 
          SA5    A5          RIW = BIT(I)  */ RELOAD RANDOM ADDR
          SB5    1
          LX5    -RI.LENP 
  
          PRINT  RTB,(* --FBLK FROM ASB = *Z7),X3 
  
*         UPDATE *BST*, *BIT* ENTRIES AND READ BLOCK
  
 RTB2     SA4    O.BST
          SA2    BSI
          SX1    X5 
          SB2    X4 
          LX1    BA.LENP     LEN[BAW] = L 
          MX0    1
          SA2    X2+B2       BAW = BST(BSI) 
          LX0    1+BA.BLKP   BLK[BAW] = 1 
          SX4    B1 
          BX1    X0+X1
          LX4    BA.PRIP     PRI[BAW] = 1 
          SX7    X3 
          LX3    BA.FWAP     FWA[BAW] = FBLK
          BX1    X1+X2
          IX4    X3+X4
          SA7    O.SEQ       O.SEQ = FBLK 
          PRINT  RTB,(*--O.SEQ =*Z7),X7 
          BX6    X1+X4
          SX7    X5 
          LX3    RI.FWAP-BA.FWAP
          SA6    A2          BST(BSI) = BAW 
          SA7    L.SEQ       L.SEQ = L
          PRNTM  RTB,BAW,X6 
          PRINT  RTB,(* --L.SEQ =*Z7),L.SEQ 
          ZR     B5,RTB      IF IC[RIW] 
  
          LX0    RI.ICP-BA.BLKP    IC[RIW] = 1
          SA4    RTBA        M1 = MASK [RI](AT,LCM,LEN) 
          BX0    X0+X3
          LX5    RI.LENP
          BX7    X4*X5       TRIW = M1 & RIW
          BX7    X0+X7       FWA[RIW] = FBLK
          LX3    -RI.FWAP 
          SA7    A5          BIT(I) = TRIW
          PRNTM  RTB,RIW,X7 
          CALL   GMB         CALL GMB(FBLK,RIW)  */READ BLOCK 
          EQ     RTB
  
 RTBA     BFMW   RI,(AT,LCM,LEN)
 RBS      TITLE  RBS - RELEASE BLOCK SPACE
**        RBS - RELEASE BLOCK SPACE 
* 
*         ENTRY  (BSI) = *BST* INDEX OF BLOCK 
* 
*         EXIT   BLOCK REDUCED TO BOS, EOQ
* 
*         CALLS  ABB, ABL.
  
 RBS      ENTRY. **,# 
          PRINT  RBS,(* --RELEASE BLOCK, BSI =*Z7),BSI
  
*         UPDATE *BST*, *BIT* ENTRIES 
  
          SA1    RBSA        DBAW = [RBSA] */BST ENTRY FOR DUMMY BLOCK
          SA2    A1+1        DRIW = [RBSA+1] */BIT ENTRY FOR DUMMY BLOCK
          SA3    O.BST
          SA4    BSI
          SA5    O.BIT
          SB4    RBSB 
          SB2    X3 
          SB3    X5+B1
          SA3    B2+X4       BAW = BST(BSI) 
          LX3    -BA.BIP     B = BI[BAW]
          SA4    B3+X3       RIW = BIT(B) 
          SX6    X3 
          BX7    X2 
          LX6    BA.BIP      BI[DBAW] = B 
          BX6    X1+X6
          SA6    A3          BST(BSI) = DBAW
          PRNTM  RBS,BAW,X6 
          SA7    B3+X3       BIT(B) = DRIW
          PRNTM  RBS,RIW,X7 
          LX3    BA.BIP+59-BA.BLKP
          PL     X3,RBS1     IF BLK[BAW] = 0
  
*         RELEASE STORAGE IN BLK
  
          LX3    1+BA.BLKP-BA.FWAP
          SB2    X3          FBLK = FWA[BAW]
          EQ     B2,B4,RBS   IF FBLK = RBSB  */NULL BLOCK 
  
          SB4    B1+B1
          LX3    BA.FWAP-BA.LENP
          SB3    X3+B4       L = LEN[BAW] + 2 
          SB2    B2-B1       FBLK = FBLK-1
          CALL   ABB         CALL ABB(FBLK,L) 
  
*         RELEASE STORAGE IN LCM
  
 RBS1     LX4    59-RI.ATP
          PL     X4,RBS      IF AT[RIW] = 0 
  
 #ECS     IFNE   CT.ECS,0 
          LX4    1+RI.ATP-RI.LCMP 
          SB2    X4 
          SX0    X4 
          RX1    X0,RBSC
          LX1    -BH.LENP 
          SB3    X1 
          CALL   ABL         CALL ABL(FBLK,L) 
          EQ     RBS
 #ECS     ENDIF 
  
 RBSA     VFD    1/1,23/0,18/8,18/RBSB
          VFD    1/1,2/0,18/8,3/0,18/RBSB,18/0
*         RBSB - DUMMY BLOCK ( BOS,EOQ )
  
 D.FT=1P  EQU    D.FTP
 D.FT=1L  EQU    1
 D.NRXP   EQU    D.NRP-1     *NR* EXPONENT BIT
 D.NRXL   EQU    1
  
 RBSB     VFD    12/1S10+OC.BOS,48/0
          DATA   8
          BFMW   D,(TY,NRX,^D,PI,JFT) 
          DATA   0
          VFD    12/2000B,48/0
 RBSC     BSSZ   1
          BFMW   D,(TY,FT=1,NRX,^D,BM,PI,JFT) 
          DATA   0
 RNB      TITLE  RNB - READ NEXT BLOCK
**        RNB - READ NEXT BLOCK OF *FTNOPT* FILE IN A SEQUENTIAL MANNER.
*                THIS SUBROUTINE MAY BE CALLED FROM *FBV* ONLY. 
* 
*         ENTRY  (X2) = BIW, BLOCK INDEX WORD 
*                (X3) = FBLK, FWA OF WORKING STORAGE TO READ BLOCK TO.
*                (X5) = RIW, RANDOM INDEX WORD
* 
*         CALLS  GMB
  
 RNB      ENTRY. **,# 
          PRNTM  RNB,RIW,X5 
  
 #RM      IFEQ   CP#RM,0
  
          BX6    X5 
          LX6    59-RI.ATP
  
          MI     X6,RNB2     IF AT[RIW]    */ IN ECS/LCM
          SX0    X3-1 
          SA1    RNS
          NZ     X1,RNB1     IF RNS " 0    */ FILE READ STARTED 
          SX7    B1 
          SA7    A1          RNS = 1       */ INDICATE READ STARTED 
          SA3    O.RRB
          SA7    F.OPT+6     DA = 1 
          LX4    1
          SETFET OPT,X3,HO$OBL,READ,NOADD  SETUP FET FOR READ 
          READNS F.OPT
  
 RNB1     LX5    -RI.LENP 
          READW  F.OPT,X0,X5+2     READW( OPT , FBLK , LEN[RIW]+2 ) 
          ZR     X1,RNB      IF EOR = 0 
  
          LX5    RI.LENP
          READNS X2          RESTART READ 
          EQ     RNB1 
 #RM      ENDIF 
  
 RNB2     CALL   GMB         GMB( FBLK , RIW )
          EQ     RNB
  
 RNS      BSSZ   1           READ NS STARTED FLAG 
 SMB      TITLE  SMB - SAVE MEMORY BLOCK
**        SMB - SAVE MEMORY BLOCK 
* 
*         ENTRY  (B2) = FLCM, OLD LCM ADDRESS 
*                (X4) = FSCM, SCM FWA OF BLOCK
*                (X5) = LEN, LENGTH OF BLOCK
* 
*         EXIT   (X1) = RIW, RANDOM INDEX WORD
*                BLOCK WRITTEN TO RWB, LCM, OR DISK 
* 
*         CALLS  SBL,SBD,ASL. 
  
*         MOVE BLOCK INTO RWB 
  
 SMB0     IX3    X1+X2       FDEST = RLEN+O.RWB 
          BX2    X4 
          SA4    O.DISK 
          SA7    RLEN        RLEN = NL
          LX1    RI.OFSP     OFS[RIW] = OL
          LX4    RI.RAP      RA[RIW] = O.DISK 
          BX7    X1+X4
          SX1    X5          L = LEN
          LX5    RI.LENP     LEN[RIW] = LEN 
          BX5    X5+X7
          MOVE   X1,X2,X3    MOVE(L,FSCM,FDEST) 
          BX1    X5 
  
 SMB1     SX2    B1+B1
          LX2    RI.LENP
          IX1    X1-X2       LEN[RIW] = LEN[RIW] - 2
  
          PRNTM  SMB,RIW,X1 
  
 SMB      ENTRY. **,# 
  
*         ALLOCATE SPACE IN LCM IF POSSIBLE 
  
          SX4    X4-1        FSCM = FSCM - 1
          SX5    X5+2        LEN = LEN + 2
          SB5    X5 
  
 #ECS     IFNE   CT.ECS,0 
          SA2    ADT
          ZR     X2,SMB2     IF ADT = 0    */WRITE IS TO DISK 
  
          LX5    30 
          BX5    X4+X5
          CALL   ASL         FLCM = ASL(FLCM,LEN,L)  */ALLOCATE LCM 
          SX4    X5 
          AX5    30 
          PRINT  SMB,(* --FLCM FROM ASL = *,Z8),X2
  
          MI     X2,SMB2     IF FLCM.LT.0  */WRITE IS TO DISK 
  
*         WRITE BLOCK TO LCM
  
          SA1    X4 
          SA3    SMBB        M1 = MASK [BH](BI,BST,HB)
          SB3    X7-1 
          BX1    X1*X3       BHW = M1 & BHW 
          SB4    X2+B3
          LX7    BH.LENP     LEN[BHW] = L 
          BX6    X1+X7
          SA6    A1          [FSCM] = BHW 
          PRNTM  SMB,BHW,X6 
          CALL   SBL         CALL SBL(FLCM,FSCM,LEN,RIW)
          MX6    -RI.LENL 
          SX0    B4 
          LX6    RI.LENP
          PRNTM  SMB,BTW,X7 
          WX7    X0,SMBA     LEN[BTW] = L 
          BX7    X1*X6
          LX5    RI.LENP     LEN[RIW] = LEN 
          BX1    X5+X7
          EQ     SMB1 
 #ECS     ENDIF 
  
*         WRITE BLOCK TO RWB OR DISK
  
 SMB2     SX3    HO$OBL 
          SA1    RLEN        OL = RLEN
          SA2    O.RWB
          IX0    X5-X3
          IX7    X1+X5       NL = OL + LEN
          IX6    X7-X3
          MI     X6,SMB0     IF NL .LT. MAX.RL
  
*         DUMP RWB TO DISK
  
          ZR     X1,SMB3     IF OL = 0
          LX5    30 
          BX6    X4+X5
          SA6    SMBA 
          SA4    O.RWB       FRWB = O.RWB 
          BX5    X1          L = RLEN 
          CALL   SBD         CALL SBD(FRWB,L,RIW) 
          SA5    SMBA 
          SA2    O.RWB
          SX4    X5 
          AX5    30 
          SX7    X5 
          MX1    0           OL = 0 
          MI     X0,SMB0     IF LEN < MAX.RL
          MX6    0
          SA6    RLEN        RLEN = 0 
  
*         WRITE BLOCK DIRECTLY FROM BLK 
  
 SMB3     CALL   SBD         CALL SBD(FSCM,LEN,RIW) 
          EQ     SMB1 
  
  
 SMBA     BSS    1
 SMBB     BFMW   BH,(BI,BST,HB) 
 GMB      TITLE  GMB - GET MEMORY BLOCK 
**        GMB - GET MEMORY BLOCK
* 
*         ENTRY  (X3) = FSCM, SCM FWA OF BLOCK
*                (X5) = RIW, RANDOM INDEX WORD
* 
*         CALLS  GBL,GBD,MVE=.
  
 GMB      ENTRY. **,# 
          BX2    X5 
          LX2    59-RI.ICP
          PL     X2,GMB0     IF ^ IC[RIW] 
  
          LX2    1+RI.ICP-RI.LENP 
          SX1    X2+2        L = LEN[RIW] + 2 
          LX2    RI.LENP-RI.FWAP
          SX2    X2-1        FBLK = FWA[RIW] - 1
          SX3    X3-1        FSCM = FSCM - 1
          MOVE   X1,X2,X3    MOVE(L,FBLK,FSCM)
          EQ     GMB
  
 GMB0     SB4    HO$OBL 
          PRNTM  GMB,RIW,X5 
  
 #ECS     IFNE   CT.ECS,0 
          BX6    X5 
          LX6    59-RI.ATP
          PL     X6,GMB1     IF ^AT[RIW]   */READ FROM DISK 
  
*         READ BLOCK FROM LCM 
  
          LX5    -RI.LCMP 
          SX4    X5          FLCM = LCM[RIW]
          LX5    RI.LCMP-RI.LENP
          SX5    X5+2        L = LEN[RIW]+2 
          SX2    X3-1 
          CALL   GBL         CALL GBL(FLCM,L,FSCM)
          SA2    X2          BHW = [FSCM] 
          PRNTM  GMB,BHW,X2 
          SA4    BSI
          MX0    -BH.LENL    M1 = MASK[BH](LEN) 
          LX2    -BH.LENP 
          BX6    X0*X2       BHW = ^M1 & BHW
          LX4    BH.BSTP     BST[BHW] = BSI 
          SX0    B1 
          LX0    BH.PRIP     PRI[BHW] = 1 
          BX7    X5+X6       LEN[BHW] = L 
          IX4    X0+X4
          BX7    X4+X7
          SA7    A2          [FSCM] = BHW 
          PRNTM  GMB,BHW,X7 
          EQ     GMB
 #ECS     ENDIF 
  
*         CHECK IF BLOCK IS IN RRB OR RWB 
  
 GMB1     LX5    -RI.RAP
          MX0    -RI.RAL
          BX4    -X0*X5      RA = RA[RIW] 
          SA1    O.RRB
          SA2    N.RRB
          LX5    RI.RAP-RI.LENP 
          PRINT  GMB,(*  --N.RRB =*Z7),N.RRB
          SB2    X1          BUF = [O.RRB]
          IX6    X2-X4
          ZR     X6,GMB2     IF N.RRB = RA */BLOCK IN RRB 
  
          SA1    O.RWB
          SA2    O.DISK 
          PRINT  GMB,(* --O.DISK =*Z9),O.DISK 
          SB2    X1          BUF = [O.RWB]
          IX6    X2-X4
          ZR     X6,GMB2     IF O.DISK = RA   */BLOCK IN RWB
  
          SB5    X5+2 
          GE     B5,B4,GMB3  IF LEN[RIW]+2 \ HO$OBL 
  
          BX6    X3 
          BX7    X5 
          SA2    O.RRB
          SA6    GMBA 
          SA7    A6+B1
          BX7    X4 
          SX5    B4          L= HO$OBL
          SA7    N.RRB
          CALL   GBD         CALL GBD(O.RRB,L,RA) 
          SA1    O.RRB
          SA3    GMBA 
          SA5    A3+B1
          SB2    X1 
  
 GMB2     SX1    X5+2        L = LEN[RIW]+2 
          LX5    RI.LENP-RI.OFSP
          MX0    -RI.OFSL 
          BX7    -X0*X5      OFS = OFS[RIW] 
          SX2    X7+B2       FBLK = BUF+OFS 
          SX3    X3-1        FSCM = FSCM-1
          SA0    X3 
          MOVE   X1,X2,X3    MOVE(L,FBLK,FSCM)
          EQ     GMB4 
  
*         READ DIRECTLY INTO BLK
  
 GMB3     SX2    X3-1        FSCM = FSCM-1
          SA0    X2 
          SX5    X5+2        L = LEN[RIW]+2 
          CALL   GBD         CALL GBD(FSCM,L,RA)
  
 GMB4     SA2    A0 
          SA4    BSI
          SX0    B1 
          LX0    BH.PRIP     PRI[BHW] = 1 
          LX4    BH.BSTP
          IX4    X0+X4
          BX6    X2+X4
          SA6    A2 
          PRNTM  GMB,BHW,X6 
          EQ     GMB
  
 GMBA     BSS    2
          TTL    MIO - MASS STORAGE RANDOM I/O (INTERNAL ROUTINES)
 DMB      TITLE  DMB - DUMP MEMORY BLOCKS 
**        DMB - DUMP MEMORY BLOCKS
* 
*         ENTRY  (X1) = LEN, LENGTH OF SPACE REQUIRED 
*                (B2) = 0, GET ALL REQ.SPACE BY DUMPING BASIC BLOCKS
*                     " 0, DUMP INACTIVE BLOCKS ONLY. IF NOT ENOUGH 
*                          SPACE OBTAINED,CALL MOREFL TO EXTEND FL
* 
*         EXIT   (X1) = 0 - REQUIRED SPACE OBTAINED 
*                (X1) " 0 - NOT ENOUGH SPACE OBTAINED,X1 = NEW WN 
*                (X2) = WFL - WORDS OBTAINED BY CALLING MOREFL
* 
*         CALLS  SMB,ABB. 
  
 DMB      ENTRY. **,# 
          SB7    X1 
          SX6    B2 
          SA6    DMBH        SAVE B2
          BX6    X0 
          BX7    X5 
          SA6    DMBG        SAVE X0, X5
          SA7    DMBG+1 
          SX6    A0 
          SX7    A5 
          SA6    DMBG+2      SAVE A0,A5 
          SA7    DMBG+3 
  
          PRINT  DMB,(* -- REQUEST FOR*Z7* WORDS*),B7 
          SA5    DMBA        M1 = MASK FOR AV AND FW FLAGS
 DMB0     SA2    O.BST
          SA3    O.SEQ
          SA4    O.BLK       FBLK = O.BLK 
          SB6    60-BH.LENP 
          SB3    X2 
          SB4    X3-1        SEQ = O.SEQ - 1
          SA1    O.BIT
          SA3    A5+B1
          SB2    X1+B1
          BX0    X3 
          SA4    X4+B1       BHW = [FBLK+1] 
  
*         LOOP TO FIND BLOCK TO DUMP
  
 DMB1     ZR     X4,DMB3     IF BHW = 0    */END OF TABLE 
  
          BX6    X5*X4       TEST = M1 & BHW
          SB5    A4          OBLK = FBLK
          PRNTM  DMB,BHW,X4 
          LX2    B6,X4       TBHW = BHW 
          BX6    X0-X6       TEST = TEST .XOR. M3 
          SA4    X2+B5       BHW = [FBLK+LEN[BHW]]
          NZ     X6,DMB1     IF TEST " 0
  
          EQ     B4,B5,DMB1  OBLK = SEQ    */ DO NOT DUMP ACTIVE BLOCK
  
*         DUMP BLOCK TO MASS STORAGE
  
          PRINT  DMB,(* ABOVE BLOCK DUMPED TO MS. RIW FOLLOWS *)
          MX6    -BH.BSTL 
          LX6    BH.BSTP
          MX3    -BA.SVLL 
          SX5    X2          L = LEN[BHW] 
          BX6    X2*X6
          SA6    B5 
          LX2    BH.LENP-BH.BSTP   B = BST[BHW] 
          SB4    X2 
          MI     B4,DMB1A    IF B < 0      */NO BST ENTRY 
  
          SA1    X2+B3       BAW = BST(B) 
          LX3    BA.SVLP
          BX7    -X3*X1 
          PRNTM  DMB,BAW,X7 
          SA7    A1          BST(B) = BAW 
  
 DMB1A    LX2    BH.BSTP-BH.BIP    AR = BI[BHW] 
          SA3    X2+B2       RIW = BIT(AR+1)
          LX3    59-RI.ATP
          SB2    X4          L=LEN[BHW] 
          NE     B1,B2,DMB1B IF L = 1       */SKIP 1 WORD FREE SPACE
          SA4    A4+1 
 DMB1B    SX7    B7 
          IX6    X7-X5       LEN = LEN - L
          SX0    A5 
          LX6    18 
          SX1    A4 
          BX6    X0+X6
          LX6    18 
          BX6    X1+X6
          SA6    DMBE        T1 = LEN, M1, FBLK 
          SX7    B5 
          SX0    A3 
          LX7    18 
          BX7    X0+X7
          SX1    X5 
          LX7    18 
          BX7    X1+X7
          SA7    DMBF        T2 = OBLK, AR, L 
          SX5    X5-2 
          SB2    B0          FLCM = 0 
          PL     X3,DMB2     IF AT[RIW] = 0 
  
          LX3    1+RI.ATP-RI.LCMP 
          SB2    X3          FLCM = LCM[RIW]
  
 DMB2     SX4    B5+B1       FSCM = FBLK + 1
          CALL   SMB         CALL SMB(FLCM,L,FBLK) */SAVE BLOCK ON MS 
          SA2    DMBF 
          SB3    X2 
          BX7    X1 
          AX2    18 
          SA7    X2          BIT(AR+1) = RIW
          PRNTM  DMB,RIW,X7 
          AX2    18 
          SB2    X2 
          CALL   ABB         CALL ABB(OBLK,L) 
          SA1    DMBE 
          SA4    X1 
          AX1    18 
          SA5    X1 
          AX1    18 
          SB7    X1 
          SA3    A5+1 
          LE     B7,B0,DMB4  IF LEN @ 0 
  
          BX0    X3 
          SA1    O.BIT
          SA2    O.BST
          SA3    O.SEQ
          SB6    60-BH.LENP 
          SB2    X1+B1
          SB3    X2 
          SB4    X3-1 
          EQ     DMB1 
  
*         GET MASK FOR NEXT GROUP 
  
 DMB3     SA5    A5+2        */ M3 OR M5 MASK OR ZERO 
          ZR     X5,DMB4     IF (X5) = 0 */ LAST BLK SCAN DONE
          SA3    A5+B1
          BX0    X3          */ M4 OR M6 MASK FOR 2ND OR 3RD SCAN 
          ZR     X0,DMB3A    IF M4 MASK */ 2ND SCAN IS TO START 
          SA4    DMBH 
          ZR     X4,DMB3A    IF  DMBH  = 0 */ STANDARD PROCESSING 
  
*         SPECIAL PROCESSING REQUESTED - CALL MOREFL TO GET 
*         REMAINING NO. OF WORDS BY EXTENDING FL RATHER THEN BY 
*         DUMPING THE HIGHEST PRIORITY BLOCKS 
  
          SX1    B7          WN = NO.OF WORDS NEEDED
          PRINT  DMB,(*  DMB CALLS MOREFL,WN =*Z7),(X1) 
          CALL   MOREFL      MOREFL(X6) = NO.OF WORDS GRANTED 
          SA6    DMBI        SAVE WG - NO.OF WORDS GRANTED
          IX6    X1-X6
          SB7    X6          RWN = REM.NO.OF WORDS NEEDED 
          LE     B7,DMB4     IF RWN @ 0 
          SA5    DMBA+4      M5 = MASK FOR 3RD SCAN 
          EQ     DMB0        */ GET RWN BY DUMPING THE TOP PRIOR.BLOCKS 
  
 DMB3A    SA4    O.BLK
          SA4    X4+B1
          EQ     DMB1 
  
 DMB4     SX1    B7 
          SA5    DMBG+3 
          SA4    DMBG+2 
          SA3    DMBG+1 
          SA2    DMBG 
          SA0    X4          RESTORE A0, A5 
          SA5    X5 
          BX5    X3 
          BX0    X2          RESTORE X0,X5
          PRINT  DMB,(* -- SUMMARY -- B7 =*Z7),B7 
          PRNTM  DMB,BIT
          PRNTM  DMB,BST
          PRNTM  BLK,,=1
  
          SA2    DMBI        WFL = NO OF WORDS GRANTED BY MOREFL
          MX6    0
          SA6    A2          DMBI = 0 
          PL     B7,DMB      IF NOT ENOUGH SPACE FREED
          MX1    0           X1 = 0        */ SUCCESS 
          EQ     DMB
  
 DMBA     BFMW   BH,(AV,FW) 
          BFMW   BH,(FW)
          BFMW   BH,(AV,PRI)
          BSSZ   1
          BFMW   BH,(AV,PRI)
          BFMW   BH,(PRI) 
          BSSZ   1
 DMBE     BSS    1
 DMBF     BSS    1
 DMBG     BSS    4
 DMBH     BSS    1
 DMBI     BSSZ   1
 ASB      TITLE  ASB - ALLOCATE SPACE IN BLK
**        ASB - ALLOCATE SPACE IN BLK 
* 
*         ENTRY  (B2) = ADDRESS OF BLOCK HEADER WORD
*                (B5) = OL, CURRENT LENGTH OF BLOCK 
*                (X1) = NL, NEW LENGTH OF BLOCK 
* 
*         EXIT   (X3) = FWA, FWA OF BLOCK ALLOCATED 
  
 ASB      ROUTINE 
          SB7    B1+B1
          SB6    RBSB-1 
          PRINT  ASB,(* BLK SIZE=*Z7),(L.BLK) 
          SB3    X1+B7       NL = NL + 2
          EQ     B5,B7,ASB1  IF OL = 2     */NO SPACE ALLOCATED 
  
          EQ     B2,B6,ASB1  IF FBLK = RBSB  */DUMMY BLOCK
  
          EQ     B5,B3,ASB5  IF OL = NL 
  
          GT     B5,B3,ASB4  IF OL > NL 
  
          SX4    B3 
          SB3    B5 
          CALL   ABB         CALL ABB(FBLK,OL)
          SB3    X4+
  
*         DUMP BLOCKS FROM BLK IF NEED EXTRA SPACE. 
  
 ASB1     SA1    MX.AVS      MAX = MX.AVS 
          SB6    X1+
          SX2    X1-100B
          PRINT ASB,(* MX.AVS,NL=*2Z7),(B6,B3)
          MI     X2,ASB1C 
  
          GE     B6,B3,ASB1A IF MAX \ NL
  
 ASB1C    SX1    B3-B6       DL = NL - MAX.AS 
          SA3    =XHO$OPT 
          SX6    B3 
          SA6    ASBA 
          PRINT  ASB,(* SPACE NEEDED = *,Z8),B3 
          PL     X3,ASB1E    IF OPT " 2 
          SX2    401B 
          IX7    X1-X2
          PL     X7,ASB1B    DL = MAX( DL , 401B )
          BX1    X2 
 ASB1B    SX6    B0 
          SB2    B1          */ SPEC. PROCESSING BY DMB 
          PRINT  ASB,(* ASB CALLS DMB,WN=*Z7),(X1)
          SA6    O.SEQ       O.SEQ = 0
          SA6    L.SEQ       L.SEQ = 0
          CALL   DMB         DUMP BLOCKS TO FREE UP SPACE 
          NZ     X1,ASB6     IF NOT ENOUGH SPACE OBTAINED 
          ZR     X2,ASB1D    ENOUGH SPACE BY DUMPING BLOCKS ONLY
  
*         DMB HAD TO CALL MOREFL TO GET ENOUGH SPACE, X2 = WFL
  
          BX1    X2 
  
*         INCREASE SIZE OF *BLK*
  
 ASB1E    SX1    X1+100B     LEN = LEN+100B 
  
          ALLOC  BLK,X1      ALLOC( BLK , LEN ) ; OL = OLD(L.BLK) 
          PRINT  ASB,(* INCREASE IN BLK = *,Z8),X1
          SB5    X2-1 
          MX7    0
          SA7    B5+X3       [O.BLK+NL-1] = 0 
          SB3    X1 
          SB2    B5+B6       FWA = O.BLK-1+OL 
          CALL   ABB         CALL ABB(FWA,LEN)  */ADD BLOCK TO LIST 
  
 ASB1D    SA2    ASBA 
          SB3    X2+
  
 ASB1A    SA1    LAS         BTW = LAS
          PRINT  ASB,(* --LAS = *Z20),LAS 
          LX1    -BT.LKFP    I = LKF[BTW] 
          SB5    X1 
          ZR     B5,ASB2A 
  
          SA2    X1+         BTW = [I]
          PRNTM  ASB,BTW,X2 
  
*         SEARCH LIST FOR AVAILABLE SPACE 
  
 ASB2     LX2    -BT.LENP 
          SB5    X2          L = LEN[BTW] 
          LX2    BT.LENP-BT.LKFP
          GE     B5,B3,ASB3  IF L \ NL
  
          SB6    X2          I = LKF[BTW] 
          SA2    X2          BTW = [I]
          PRNTM  ASB,BTW,X2 
          NZ     B6,ASB2     IF I " 0 
  
*         CALL GARBAGE COLLECTOR FOR BLK
  
 ASB2A    SX6    B3+
          SA6    ASBA 
          CALL   CGB         CALL CGB      */GARBAGE COLLECTOR
          SA2    ASBA 
          SB3    X2+
          EQ     ASB1 
  
*         REMOVE BLOCK FROM AVAILABLE LIST
  
 ASB3     LX2    BT.LKFP
          SB6    B5-B1
          SB2    A2-B6       FBLK = I-L+1 
          SA1    A2 
          CALL   RBB         CALL RBB(BTW)
          EQ     B5,B3,ASB5  IF L = NL
  
*         ADD REMAINDER OF BLOCK TO AVAILABLE LIST
  
 ASB4     SX4    B2+B1
          MX7    0
          SB2    B2+B3       FBLK = FBLK + NL 
          SB3    B5-B3       LX = L - NL
          SA7    B2-B1
          CALL   ABB         CALL ABB(FWAX,LX)
          BX3    X4 
          EQ     ASB
  
*         SET FWA OF ALLOCATED BLOCK
  
 ASB5     SX3    B2+B1
          EQ     ASB
  
 ASB6     SA1    =7LTBL-OVF 
          CALL   PUNT 
  
  
 ASBA     BSS    1
 ASBB     BSS    1
 ABB      TITLE  ABB - ADD BLOCK TO BLK LIST
**        ABB - ADD BLOCK TO BLK LIST 
* 
*         ENTRY  (B2) = FWA, FWA OF BLOCK (ADDRESS OF BHW)
*                (B3) = LEN, LENGTH OF BLOCK (INCLUDING BHW AND BTW)
* 
*         EXIT   BLOCK ADDED TO LINKED LIST 
* 
*         CALLS  RBB. 
  
 ABB      ROUTINE 
          SA1    MX.AVS 
          SB7    B3-B1
          SB4    B2+B7       ABTW = FBLK+L-1
          SX7    X1+B3       MX.AVS = MX.AVS+LEN
          SA7    A1 
  
*         GET BLOCK TRAILER WORDS FOR PRECEDING AND FOLLOWING BLOCKS. 
  
          SA1    B2-B1       PBTW = [FBLK]
          PRNTM  ABB,BTW,X1 
          ZR     X1,ABB1     IF PBTW = 0   */NO PRECEDING BLOCK 
  
*         COMBINE ADJACENT AVAILABLE BLOCKS 
  
          LX1    59-BT.AVP
          PL     X1,ABB1     IF ^AV[PBTW]  */NOT AVAILABLE SPACE
  
          LX1    1+BT.AVP-BT.LENP 
          SB7    X1          PL = LEN[PBTW] 
          SA2    MX.AVS 
          SB2    B2-B7       FBLK = FBLK-PL 
          SB3    B3+B7       L = L + PL 
          SX7    X2+B7
          LX1    BT.LENP
          SA7    A2 
          CALL   RBB         CALL RBB(PBTW) 
  
 ABB1     SA2    B4+B1       FBHW = [ABTW+1]
          ZR     X2,ABB2     IF FBHW = 0   */NO FOLLOWING BLOCK 
  
          LX2    -BH.LENP    LS = LEN[FBHW] 
          SA3    X2+B4       FBTW = [ABTW+LS] 
          PRNTM  ABB,BTW,X3 
          LX3    59-BT.AVP
          PL     X3,ABB2     IF ^AV[FBTW]  */NOT AVAILABLE SPACE
  
          LX3    1+BT.AVP-BT.LENP 
          SA2    MX.AVS 
          SB7    X3          FL = LEN[FBTW] 
          SB3    B3+B7       L = L+FL 
          SB4    B4+B7       ABTW = ABTW+FL 
          SX7    X2+B7
          SA1    A3 
          SA7    A2 
          CALL   RBB         CALL RBB(FBTW) 
  
*         STORE NEW BLOCK HEADER AND TRAILER WORDS. 
  
 ABB2     SX6    B3 
          MX1    1
          LX6    BH.LENP     LEN[BHW] = LEN 
          LX1    1+BH.AVP    AV[BHW] = 1
          BX6    X1+X6
          SB7    MIN.AB 
          BX7    X6          BTW = BHW
          SA6    B2          [FBLK] = BHW 
          PRNTM  ABB,BHW,X6 
          LT     B7,B3,ABB3  IF MIN.AB < LEN
  
          SA7    B4          [ABTW] = BTW 
          PRNTM  ABB,BTW,X7 
          EQ     ABB
  
 ABB3     SA3    LAS         OPTR = LAS 
          SX6    B4 
          LX6    BT.LKFP     LKF[NPTR] = ABTW 
          BX7    X3+X7       LKF[BTW] = LKF[OPTR] 
          SA6    A3          LAS = NPTR 
          PRINT  ABB,(* LAS = *Z20),LAS 
          LX3    -BT.LKFP 
          SX3    X3          LINKF = LKF[OPTR]
          ZR     X3,ABB4     IF LINKF = 0 
  
          SA1    X3 
          MX0    -BT.LKBL 
          LX0    BT.LKBP
          BX2    X0*X1       NWORD = LWORDF 
          LX6    BT.LKBP-BT.LKFP   LKB[NWORDF] = ABTW 
          BX6    X2+X6
          SA6    A1          [LINKF] = NWORD
          PRNTM  ABB,BTW,X6 
 ABB4     SA7    B4          [ABTW] = BTW 
          PRNTM  ABB,BTW,X7 
  
          EQ     ABB
 RBB      TITLE  RBB - REMOVE BLOCK FROM BLK LIST 
**        RBB - REMOVE BLOCK FROM BLK LIST
* 
*         ENTRY  (X1) = BTW, BLOCK TRAILER WORD 
*                (A1) = ABTW, ADDRESS OF BLOCK TRAILER WORD 
* 
*         EXIT   BLOCK REMOVED FROM LINKED LIST 
* 
*         CALLS  NONE.
  
 RBB      ROUTINE 
          SA2    MX.AVS 
          SB7    MIN.AB 
          LX1    -BT.LENP 
          SX6    X1          L = LEN[BTW] 
          SB6    X1 
          IX7    X2-X6       MX.AVS = MX.AVS - L
          SA7    A2 
          LT     B6,B7,RBB   IF L .LT. MIN.AB 
  
          LX1    BT.LENP-BT.LKFP
          SB6    X1          LINKF = LKF[BTW] 
          LX1    BT.LKFP-BT.LKBP
          SB7    X1          LINKB = LKB[BTW] 
          NZ     B7,RBB1     IF LINKB " 0  */NOT FIRST ENTRY ON LIST
  
          SA2    LAS
          LX2    -BT.LKFP 
          SX0    A1 
          IX0    X0-X2
          NZ     X0,RBB      IF ABTW .NE. LKF[LAS]
  
          LX2    BT.LKFP
          EQ     RBB2 
  
 RBB1     SA2    B7          LWORDB = [LINKB] 
          PRNTM  RBB,BTW,X2 
 RBB2     MX1    -BT.LKFL 
          SX0    B6 
          LX1    BT.LKFP
          BX2    X1*X2
          LX0    BT.LKFP     LKF[LWORDB] = LINKF
          BX6    X0+X2
          SA6    A2          [LINKB] = LWORDB 
          PRNTM  RBB,BTW,X6 
          ZR     B6,RBB      IF LINKF = 0  */LAST ENTRY ON LIST 
  
          SA2    B6          LWORDF = [LINKF] 
          PRNTM  RBB,BTW,X2 
          LX1    -BT.LKFP+BT.LKBP 
          SX0    B7 
          BX2    X1*X2
          LX0    BT.LKBP     LKB[LWORDF] = LINKB
          BX7    X0+X2
          SA7    A2          [LINKF] = LWORDF 
          PRNTM  RBB,BTW,X7 
          EQ     RBB
 CGB      TITLE  CGB - COLLECT GARBAGE IN BLK 
**        CGB - COLLECT GARBAGE IN BLK
* 
*         ENTRY  NONE 
* 
*         EXIT   ALLOCATED BLOCKS MOVED TO A CONTIGUOUS AREA
*                LIST OF AVAILABLE SPACE UPDATED
* 
*         CALLS  MVE=.
  
 CGB      ENTRY. **,# 
  
          PRINT  CGB,(* --MX.AVS = *Z8),MX.AVS
          SA3    O.SEQ
          SA1    O.BIT
          SA2    O.BST
          SA4    O.BLK
          SB4    X3 
          SB2    X1+B1
          SB3    X2 
          SX3    X4+B1       TO = O.BLK+1 
          SA4    X4+B1       FROM = O.BLK+1; BHW = [FROM] 
          PRNTM  CGB,BHW,X4 
          SB6    60-BH.LENP 
  
*         LOOP TO MOVE BLOCKS TO CONTIGUOUS AREA
  
 CGB1     ZR     X4,CGB5     IF BHW = 0    */ END OF TABLE
  
          LX6    B6,X4       TBHW = BHW 
          SX2    A4          TFROM = FROM 
          SB5    X6          L = LEN[TBHW]
          LX6    BH.LENP+59-BH.AVP
          SA4    A4+B5       FROM = FROM+L; BHW = [FROM]
          PRNTM  CGB,BHW,X4 
          MI     X6,CGB1     IF AV[TBHW] = 1  */BLOCK AVAILABLE 
  
          IX1    X3-X2
          NZ     X1,CGB2     IF TFROM " TO */BLOCK MUST BE MOVED
  
          SX3    X3+B5       TO = TO + L
          EQ     CGB1 
  
*         UPDATE *BST*,*BIT* ENTRIES
  
 CGB2     LX6    1+BH.AVP-BH.BIP
          MX1    -RI.FWAL 
          SA4    X6+B2       RIW = BIT(BI[TBHW]+1)
          PRNTM  CGB,RIW,X4 
          LX1    RI.FWAP
          BX4    X1*X4
          LX6    BH.BIP-BH.BSTP 
          SX7    X3+B1       NFWA = TO + 1
          SB7    X6          B = BST[TBHW]
          LX7    RI.FWAP
          BX6    X4+X7       FWA[RIW] = NFWA
          SA6    A4          BIT(BI[TBHW]+1) = RIW
          PRNTM  CGB,RIW,X6 
          MI     B7,CGB4     IF B < 0      */NO BST ENTRY 
  
          SA4    B3+B7       BAW = BST(B) 
          PRNTM  CGB,BAW,X4 
          LX7    -RI.FWAP 
          SB6    X2+B1       OFWA = TFROM + 1 
          NE     B4,B6,CGB3  IF O.SEQ " OFWA
  
          SA7    O.SEQ       O.SEQ = NFWA 
  
 CGB3     LX1    BA.FWAP-RI.FWAP
          BX4    X1*X4
          LX7    BA.FWAP
          BX6    X4+X7       FWA[BAW] = NFWA
          PRNTM  CGB,BAW,X6 
          SA6    A4          BST(B) = BAW 
  
*         UPDATE BLOCK TRAILER WORD AND MOVE BLOCK. 
  
 CGB4     SX7    B5 
          LX7    BT.LENP     LEN[BTW] = L 
          SB7    B5-1 
          SA7    X2+B7       [TFROM+L-1] = BTW
          PRNTM  CGB,BTW,X7 
          SX1    B5 
          SB6    B5+X2       SFROM = TFROM + L                          002540
          SB5    B5+X3       STO = STO + L                              002550
          MOVE   X1,X2,X3    MOVE(L,TFROM,TO) 
          SA4    B6          FROM = SFROM                               002570
          SX3    B5          TO = STO                                   002580
          SB6    60-BH.LENP 
          EQ     CGB1 
  
*         UPDATE LIST OF AVAILABLE SPACE. 
  
 CGB5     SA2    O.BLK
          SA4    L.BLK
          SB4    X4-1 
          SX4    X2+B4
          IX7    X4-X3       L = FROM-TO
          MX6    0
          SA6    X4          BLK(L.BLK) = 0 
          SA6    MX.AVS      MX.AVS = L    */MAX AVAILABLE SPACE IN BLK 
          SB2    X3 
          SB3    X7 
          PRINT  CGB,(* MAX SPACE AFTER CGB = *Z8),B3 
          SA6    LAS         LAS = 0
          ZR     X7,CGB      IF L = 0  */ NO FREE SPACE 
          CALL   ABB         CALL ABB(TO,L) 
          EQ     CGB
  
 #ECS     IFNE   CT.ECS,0 
 ASL      TITLE  ASL - ALLOCATE SPACE IN LCM
**        ASL - ALLOCATE SPACE IN LCM 
* 
*         ENTRY  (B2) = FBLK, FWA OF LCM BLOCK
*                (B5) = NL, NEW LENGTH REQUESTED
* 
*         EXIT   (X2) = FWA, FWA OF BLOCK ALLOCATED 
*                (X7) = L, LENGTH OF BLOCK ALLOCATED
* 
*         CALLS  ABL,CGL,RBL. 
  
 ASL      ROUTINE 
          ZR     B2,ASL1     IF FBLK = 0   */NO SPACE ALLOCATED 
  
*         CHECK IF BLOCK CAN BE REWRITTEN IN SAME SPACE 
  
          SX0    B2 
          RX1    X0,ASLA     BHW = [FLCM] 
          PRNTM  ASL,BHW,X1 
          LX1    -BH.LENP 
          SB3    X1          OL = LEN[BHW]
          LE     B5,B3,ASL7  IF NL .LE. OL */REUSE BLOCK
  
          CALL   ABL         CALL ABL(FBLK,OL)
  
*         CHECK IF SPACE AVAILABLE AT O.LCM 
  
 ASL1     SA2    O.LCM       FBLK = O.LCM 
          SA1    LCM.FL 
          SA3    MAX.LCM
          SB5    B5+LCM.XL   NL = NL + LCM.XL  */EXTRA LENGTH 
          PRINT  ASL,(* --O.LCM,LCM.FL,MAX.LCM,LEN OF BLOCK = *4Z8),(X2,
,X1,X3,B5)
          SX6    X2+B5       L = O.LCM + NL 
          SX4    X1+B5       FL = LCM.FL + NL 
          IX7    X6-X1
          MI     X7,ASL2     IF L .LT. LCM.FL 
  
          SX7    X4+10007B   NFL = FL + 10007B
          IX4    X7-X3
          PL     X4,ASL3     IF NFL . GE. MAX.LCM 
  
*         REQUEST MORE STORAGE
  
          AX7    9
          LX7    39 
          SA7    ASLA+1 
          BX3    X6 
          BX4    X2 
          MEMORY LCM,ASLA+1,R 
          BX6    X3 
          BX2    X4 
          SA3    ASLA+1 
          BX7    X3 
          AX7    30 
          SA7    LCM.FL 
          PRINT  ASL,(* LCM REQUEST - LCM.FL = *Z8),X7
  
 ASL2     SA6    A2          O.LCM = L
          SX7    B5 
          EQ     ASL
  
 ASL3     SA2    MX.AVL 
          AX1    2           L = LCM.FL / 4 
          SB4    X2 
          GT     B5,B4,ASL8  IF NL > MX.AVL 
  
          IX6    X1-X2
          MI     X6,ASL5     IF MX.AVL > L */GARBAGE COLLECT
  
*         SEARCH AVAILABLE LIST 
  
          SA1    LAL         BTW = LAL
          PRINT  ASL,(* --LAL = *Z20),LAL 
          LX1    -BT.LKFP    I = LKF[BTW] 
          SX0    X1 
          ZR     X0,ASL8     IF LAL = 0 
  
          RX2    X0,ASLA     BTW = [I]
          PRNTM  ASL,BTW,X2 
  
 ASL4     LX2    -BT.LENP 
          SB3    X2          L = LEN[BTW] 
          LX2    BT.LENP-BT.LKFP
          LE     B5,B3,ASL6  IF NL @ L
  
          SB6    X2          I = LKF[BTW] 
          SX0    X2 
          RX2    X0,ASLA     BTW = [I]
          PRNTM  ASL,BTW,X2 
          NZ     B6,ASL4
          EQ     ASL8 
  
 ASL5     SX6    B5 
          SA6    ASLA 
          CALL   CGL         CALL GCL 
          SA1    ASLA 
          SB5    X1-LCM.XL   NL = NL - LCM.XL 
          EQ     ASL1 
  
*         REMOVE BLOCK FROM AVAILABLE LIST
  
 ASL6     LX2    BT.LKFP
          BX1    X2 
          SB4    B1-B3
          SB2    X0+B4
          CALL   RBL         CALL RBL(BTW)
          SX2    B2 
          SX7    B3 
          EQ     ASL
  
 ASL7     SX2    B2          FWA = FBLK 
          SX7    B3          L = OL 
          EQ     ASL
  
 ASL8     SX2    -1 
          EQ     ASL
  
 ASLA     BSS    2
 ABL      TITLE  ABL - ADD BLOCK TO LCM LIST
**        ABL - ADD BLOCK TO LCM LIST 
* 
*         ENTRY  (B2) = FBLK, FWA OF BLOCK (ADDRESS OF BHW) 
*                (B3) = L, LENGTH OF BLOCK (INCLUDING BHW AND BTW)
* 
*         EXIT   BLOCK ADDED TO LINKED LIST 
* 
*         CALLS  RBL. 
  
 ABL      ROUTINE 
          SA1    MX.AVL 
          SB7    B3-B1
          SB4    B2+B7       ABTW = FBLK+L-1
          SX6    X1+B3       MX.AVL = MX.AVL + LEN
          SA6    A1+
  
*         GET BLOCK TRAILER WORDS FOR PRECEDING AND FOLLOWING BLOCKS. 
  
          SX0    B2-B1
          MI     X0,ABL1     IF APBTW < 0  */NO PRECEEDING BLOCK
  
          RX1    X0,ABLA     PBTW = [FBLK-1]
          PRNTM  ABL,BTW,X1 
  
*         COMBINE ADJACENT AVAILABLE BLOCKS 
  
          LX1    59-BT.AVP
          PL     X1,ABL1     IF ^AV[PBTW]  */NOT AVAILABLE SPACE
  
          LX1    1+BT.AVP-BT.LENP 
          SB7    X1          PL = LEN[PBTW] 
          SA2    MX.AVL 
          SB2    B2-B7       FBLK = FBLK-PL 
          SB3    B3+B7       L = L + PL 
          SX7    X2+B7
          LX1    BT.LENP
          SA7    A2 
          CALL   RBL         CALL RBL(PBTW) 
  
 ABL1     SA1    O.LCM
          SX0    B4+B1
          IX1    X1-X0
          ZR     X1,ABL2     IF AFBHW = 0  */NO FOLLOWING BLOCK 
  
          RX2    X0,ABLB     FBHW = [ABTW+1]
          LX2    -BH.LENP    LS = LEN[FBHW] 
          SX0    X2+B4
          RX3    X0,ABLB     FBTW = [ABTW+LS] 
          PRNTM  ABL,BTW,X3 
          LX3    59-BT.AVP
          PL     X3,ABL2     IF ^AV[FBTW]  */NOT AVAILABLE SPACE
  
          LX3    1+BT.AVP-BT.LENP 
          SB7    X3          FL = LEN[FBTW] 
          SA2    MX.AVL 
          SB3    B3+B7       L = L+FL 
          SB4    B4+B7       ABTW = ABTW+FL 
          BX1    X3 
          SX7    X2+B7
          LX1    BT.LENP
          SA7    A2 
          CALL   RBL         CALL RBL(FBTW) 
  
*         STORE NEW BLOCK HEADER AND TRAILER WORDS. 
  
 ABL2     SX6    B3 
          MX1    1
          LX6    BH.LENP     LEN[BHW] = LEN 
          LX1    1+BH.AVP    AV[BHW] = 1
          BX6    X1+X6
          SB7    MIN.AL 
          BX7    X6          BTW = BHW
          SX0    B2 
          WX6    X0,ABLA     [FBLK] = BHW 
          PRNTM  ABL,BHW,X6 
          LT     B7,B3,ABL3  IF MIN.AL < LEN
  
          SX0    B4 
          WX7    X0,ABLA     [ABTW] = BTW 
          PRNTM  ABL,BTW,X7 
          EQ     ABL
  
 ABL3     SA3    LAL         OPTR = LAL 
          SX6    B4 
          LX6    BT.LKFP     LKF[NPTR] = ABTW 
          BX7    X3+X7       LKF[BTW] = LKF[OPTR] 
          SA6    A3          LAS = NPTR 
          PRINT  ABL,(* LAL = *Z20),LAL 
          LX3    -BT.LKFP 
          SX3    X3          LINKF = LKF[OPTR]
          ZR     X3,ABL4     IF LINK = 0
  
          SX0    X3 
          RX1    X0,ABLA     LWORDF = [LINKF] 
          MX3    -BT.LKBL 
          LX3    BT.LKBP
          BX2    X3*X1       NWORD = LWORDF 
          LX6    BT.LKBP-BT.LKFP   LKB[NWORD] = ABTW
          BX6    X2+X6
          WX6    X0,ABLA     [LINKF] = NWORD
          PRNTM  ABL,BTW,X6 
  
 ABL4     SX0    B4 
          WX7    X0,ABLA     [ABTW] = BTW 
          PRNTM  ABL,BTW,X7 
          EQ     ABL
  
 ABLA     BSS    1
 ABLB     BSS    1
 RBL      TITLE  RBL - REMOVE BLOCK FROM LCM LIST 
**        RBL - REMOVE  BLOCK FROM LCM LIST 
* 
*         ENTRY  (X1) = BTW, BLOCK TRAILER WORD 
* 
*         EXIT   BLOCK REMOVED FROM LINKED LIST 
  
 RBL      ROUTINE 
          SA2    MX.AVL 
          SB7    MIN.AL 
          LX1    -BT.LENP 
          SX6    X1          L = LEN[BTW] 
          SB6    X1 
          IX7    X2-X6       MX.AVL = MX.AVL - L
          LX1    BT.LENP-BT.LKFP
          SA7    A2 
          LT     B6,B7,RBL   IF L .LT. MIN.AB 
  
          SB6    X1          LINKF = LKF[BTW] 
          LX1    BT.LKFP-BT.LKBP
          SB7    X1          LINKB = LKB[BTW] 
          NZ     B7,RBL1     IF LINKB " 0  */NOT FIRST ENTRY ON LIST
  
          SA2    LAL
          MX4    0
          EQ     RBL2 
  
 RBL1     SX0    B7 
          MX4    1
          RX2    X0,RBLA     LWORDB = [LINKB] 
          PRNTM  RBL,BTW,X2 
 RBL2     MX1    -BT.LKFL 
          SX7    B6 
          LX1    BT.LKFP
          BX2    X1*X2
          LX7    BT.LKFP     LKF[LWORDB] = LINKF
          BX6    X2+X7
          PL     X4,RBL3
  
          WX6    X0,RBLA     [LINKB] = LWORDB 
          PRNTM  RBL,BTW,X6 
          EQ     RBL4 
  
 RBL3     SA6    LAL
          PRINT  RBL,(* LAL = *Z20),LAL 
  
 RBL4     ZR     B6,RBL      IF LINKF = 0  */ LAST ENTRY ON LIST
          LX1    -BT.LKFP+BT.LKBP 
          SX0    B6 
          RX2    X0,RBLA     LWORDF = [LINKF] 
          PRNTM  RBL,BTW,X2 
          SX6    B7 
          BX2    X1*X2
          LX6    BT.LKBP     LKB[LWORDF] = LINKB
          BX7    X6+X2
          WX7    X0,RBLA     [LINKF] = LWORDF 
          PRNTM  RBL,BTW,X7 
          EQ     RBL
  
 RBLA     BSS    1
 CGL      TITLE  CGL - COLLECT GARBAGE IN LCM 
**        CGL - COLLECT GARBAGE IN LCM
* 
*         ENTRY  NONE 
* 
*         EXIT   ALLOCATED BLOCKS MOVED TO A CONTIGUOUS AREA
*                LIST OF AVAILABLE SPACE UPDATED
* 
*         CALLS  MVL. 
  
 CGL      ROUTINE 
          PRINT  CGL,(* -- MX.AVL =*Z8),MX.AVL
          SA3    O.LCM
          SA1    O.BIT
          MX6    0
          BX0    X3 
          WX6    X0,CGLA     LCM(O.LCM) = 0 */LOOP TERMINATOR 
          SB2    X1+B1
          SB6    60-BH.LENP 
          MX0    0           FROM = 0 
          SX3    B0          TO = 0 
          RX4    X0,CGLA     BHW = LCM(FROM)
          PRNTM  CGL,BHW,X4 
  
*         LOOP TO MOVE BLOCKS TO CONTIGUOUS AREA. 
  
 CGL1     ZR     X4,CGL5     IF BHW = 0    */END OF LCM 
  
          LX6    B6,X4       TBHW = BHW 
          BX2    X0          TFROM = FROM 
          SX1    X6          L = LEN[TBHW]
          LX6    BH.LENP+59-BH.AVP
          IX0    X0+X1       FROM = FROM + L
          RX4    X0,CGLA     BHW = LCM(FROM)
          PRNTM  CGL,BHW,X4 
          MI     X6,CGL1     IF AV[TBHW]     */BLOCK AVAILABLE
  
          SB5    X1-2        LEN = L - 2
          IX7    X3-X2
          NZ     X7,CGL2     IF TFROM " TO  */BLOCK MUST BE MOVED 
  
          IX3    X1+X3       TO = TO + L
          EQ     CGL1 
  
*         UPDATE *BIT* ENTRY AND MOVE BLOCK HEADER WORD.
  
 CGL2     BX7    X4 
          LX6    1+BH.AVP-BH.BIP
          MX1    -RI.LCML 
          SA4    X6+B2       RIW = BIT(BI[TBHW]+1)
          PRNTM  CGL,RIW,X4 
          SA7    CGLA 
          LX1    RI.LCMP
          SX7    X3          NLCM = TO
          BX4    X1*X4
          LX7    RI.LCMP
          BX7    X4+X7       RA[RIW] = NLCM 
          SA7    A4          BIT(BI[TBHW+1]) = RIW
          PRNTM  CGL,RIW,X7 
          BX0    X3 
          LX6    BH.BIP 
          WX6    X0,CGLB     LCM(TO) = BHW
          PRNTM  CGL,BHW,X6 
  
*         MOVE BLOCK
  
          SX1    B5 
          SX2    X2+B1       TFROM = TFROM+1
          SX3    X3+B1       TO = TO+1
          CALL   MVL         MOVE(LEN,TFROM,TO) 
  
*         MOVE BLOCK TRAILER WORD.
  
          SB4    B1+B1
          SX7    X1+B4
          BX0    X3          TFROM = TFROM+L; TO = TO+L 
          LX7    BT.LENP     LEN[BTW] = L 
          WX7    X0,CGLB     LCM(TO) = BTW
          PRNTM  CGL,BTW,X7 
          SA4    CGLA 
          SB6    60-BH.LENP 
          SX0    X2+B1       FROM = TFROM+1 
          SX3    X3+B1       TO = TO+1
          EQ     CGL1 
  
*         UPDATE O.LCM AND LIST OF AVAILABLE SPACE. 
  
 CGL5     MX7    0
          BX6    X3 
          SA7    LAL         LAL = 0
          SA6    O.LCM       O.LCM = TO 
          PRINT  CGL,(* --O.LCM = *Z8),O.LCM
          SA7    MX.AVL      MX.AVL = 0 
          EQ     CGL
  
 CGLA     BSS    1
 CGLB     BSS    1
 MVL      TITLE  MVL - MOVE BLOCK OF LCM DATA 
**        MVL - MOVE BLOCK OF LCM DATA
* 
*         ENTRY  (X1) = WORD COUNT
*                (X2) = SOURCE FWA
*                (X3) = DESTINATION FWA 
  
 MVL      ROUTINE 
          SB7    X1 
          IX6    X2-X3
          SB6    100B        MOVE 100B WORDS AT A TIME. 
          SA0    =XB=FBV
          LE     B7,B6,MVL2  IF ONLY ONE MOVE NEEDED. 
  
          SB5    B6 
          PL     X6,MVL1     IF MOVE DOWN.
  
          SB5    B7-B6
          SX2    X2+B5       PREPARE FOR UPWARD MOVE. 
          SX3    X3+B5
          SB5    -B6
  
 MVL1     SX0    X2          READ BLOCK.
  
          RL     B6 
  
          SX2    X2+B5
          SX0    X3          WRITE BLOCK. 
  
          WL     B6 
  
          SB7    B7-B6       COUNT WORDS. 
          SX3    X3+B5
          GT     B7,B6,MVL1  LOOP.
  
 MVL2     LE     B7,B0,MVL   RETURN IF FINISHED.
  
          SB6    B7          SETUP FOR LAST MOVE. 
          SB5    B7 
          EQ     MVL1 
  
 #ECS     ENDIF 
          TTL    MIO - MASS STORAGE RANDOM I/O (BASIC I/O)
 SBD      TITLE  SBD - SAVE BLOCK TO DISK 
**        SBD - SAVE BLOCK TO DISK
* 
*         ENTRY  (X4) = FSCM, SCM FWA OF BLOCK
*                (X5) = LEN, LENGTH OF BLOCK
* 
*         EXIT   (X1) = RIW, RANDOM INDEX WORD
*                2/AT,1/0,18/LEN,9/0,30/RA. 
* 
*         CALLS  WRITER, PUTW.
  
 SBD      ENTRY. **,# 
  
*         WRITE RECORD TO DISK. 
  
          SA2    O.DISK      DA = O.DISK   */DISK ADDRESS.
          BX6    X5 
          SA6    SBDB 
  
 #RM      IFEQ   CP#RM,0
  
*         6000 MACE I/O 
  
          SX3    X5 
          AX3    6
          SX3    X3+B1       RL=LEN/100B+1 */RECORD LENGTH
          IX6    X2+X3
          SA6    A2          O.DISK = DA + RL 
                                           */SET OPT FET FOR WRITE
          SETFET OPT,X4,X5,WRITE   SET OPT FET FOR WRITE
          SX6    SBDA 
          SA6    =XF.OPT+6
          WRITER =XF.OPT,R   WRITE RECORD 
          SA2    SBDA 
 #RM      ELSE
  
*         7000 RECORD MANAGER I/O 
  
          PUTW   =XFI.OPT,X4,X5,,X2        PUTW(FSCM,LEN,,DA) 
          FETCH  =XFI.OPT,WA=X3 
          BX6    X3 
          SA6    A2          O.DISK = WA
 #RM      ENDIF 
  
*         FORM RANDOM INDEX WORD. 
  
          SA5    SBDB 
          LX5    RI.LENP     LEN[RIW] = LEN 
          LX2    RI.RAP      RA[RIW] = FSCM 
          BX1    X2+X5       RIW           */RANDOM INDEX WORD
          LX5    -RI.LENP 
          EQ     SBD
  
 SBDA     BSSZ   1
 SBDB     BSS    1
 GBD      TITLE  GBD - GET BLOCK FROM DISK
**        GBD - GET BLOCK FROM DISK 
* 
*         ENTRY  (X2) = FSCM, SCM FWA OF BLOCK
*                (X4) = DA, DISK ADDRESS
*                (X5) = LEN, LENGTH OF BLOCK
* 
*         EXIT   RECORD READ
* 
*         CALLS  READ, GETW.
  
 GBD      ENTRY. **,# 
  
*         READ RECORD FROM DISK.
  
 #RM      IFEQ   CP#RM,0
  
*         6000 MACE I/O 
  
          MX6    -RI.RAL
          BX7    -X6*X4 
          SA7    =XF.OPT+6   [F.OPT+6] = DA 
          SETFET OPT,X2,X5,READ 
          READ   =XF.OPT,R   READ RECORD
 #RM      ELSE
  
*         7000 RECORD MANAGER I/O 
  
          GETW   =XFI.OPT,X2,X5,,X4        GETW(FSCM,LEN,,DA) 
 #RM      ENDIF 
  
          EQ     GBD
  
 #ECS     IFNE   CT.ECS,0 
 SBL      TITLE  SBL - SAVE BLOCK TO LCM
**        SBL - SAVE BLOCK TO LCM 
* 
*         ENTRY  (X2) = FLCM, LCM FWA OF BLOCK
*                (X4) = FSCM, SCM FWA OF BLOCK
*                (X5) = LEN, LENGTH OF BLOCK
* 
*         EXIT   (X1) = RIW, RANDOM INDEX WORD
*                2/AT,1/0,18/LEN,9/0,30/RA. 
  
 SBL      ROUTINE 
  
*         FORM RANDOM INDEX WORD. 
  
          SA0    X4          FSCM = SCM FWA OF BLOCK
          BX0    X2          FLCM = LCM FWA OF BLOCK
          SB2    X5          L = LEN
          MX1    1
          SB3    BLK.SIZ
          LX1    1+RI.ATP    AT[RIW] = 1   */AT = LCM 
          LX2    RI.RAP      RA[RIW] = FLCM 
          BX1    X1+X2
          LX5    RI.LENP     LEN[RIW] = LEN 
          BX1    X1+X5       RIW           */RANDOM INDEX WORD
          LX5    -RI.LENP 
  
*         WRITE BLOCK TO LCM. 
  
          LE     B2,B3,SBL2  IF L .LE. BLK.SIZ
  
 SBL1     WL     B3          MOVE(BLK.SIZ,FSCM,FLCM)
  
          SB2    B2-B3       L = L - BLK.SIZ
          SA0    A0+B3       FSCM = FSCM + BLK.SIZ
          SX0    X0+B3       FLCM = FLCM + BLK.SIZ
          GT     B2,B3,SBL1  IF L.GT. BLK.SIZ 
  
 SBL2     WL     B2          MOVE(L,FSCM,FLCM)
  
          EQ     SBL
  
 ERRECSW  SX1    =C$ ECS WRITE ERROR$ 
          CALL   HE$ABT 
 GBL      TITLE  GBL - GET BLOCK FROM LCM 
**        GBL - GET BLOCK FROM LCM
* 
*         ENTRY  (X2) = FSCM, SCM FWA OF BLOCK
*                (X4) = FLCM, LCM FWA OF BLOCK
*                (X5) = LEN, LENGTH OF BLOCK
* 
*         EXIT   BLOCK TRANSFER COMPLETE
  
 GBL      ROUTINE 
  
*         READ BLOCK FROM LCM.
  
          SA0    X2          FSCM = SCM FWA OF BLOCK
          BX0    X4          FLCM = LCM FWA OF BLOCK
          SB2    X5          L = LEN
          SB3    BLK.SIZ
          LT     B2,B3,GBL2  IF L .LE. BLK.SIZ
  
 GBL1     RL     B3          MOVE(BLK.SIZ,FLCM,FSCM)
  
          SB2    B2-B3       L = L - BLK.SIZ
          SA0    A0+B3       FSCM = FSCM + BLK.SIZ
          SX0    X0+B3       FLCM = FLCM + BLK.SIZ
          GE     B2,B3,GBL1  IF L .GT. BLK.SIZ
  
 GBL2     RL     B2          MOVE(L,FLCM,FSCM)
  
          EQ     GBL
  
 ERRECSR  SX1    =C$ ECS READ ERROR$
          CALL   HE$ABT 
  
 #ECS     ENDIF 
  
          END 
