COMPTFM 
COMMON
          CTEXT  COMPTFM - COMMON TFM ROUTINES. 
          IF     DEF,LST$,1 
          SPACE  4,10 
          LIST   X
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       COMPTFM - COMMON TFM SUBROUTINES. 
*         J.P. MOORE.        81/04/01.
          SPACE  4,10 
***       COMPTFM - COMMON TFM SUBROUTINES. 
* 
*         COMPTFM IS A COLLECTION OF SUBROUTINES REQUIRED 
*         TO ASSEMBLE AND EXECUTE TFM. EACH SUBROUTINE IS 
*         CONDITIONALLY ASSEMBLED BY DEFINING THE SUB-
*         ROUTINE NAME IN THE FORMAT- 
* 
*         XXX$   EQU   1   DEFINE XXX - YYYYY.
* 
*         XXX    = SUBROUTINE NAME. 
*         YYYYY  = SUBROUTINE TITLE.
* 
*         WARNING - IF THE DOLLAR SIGN ($) IS NOT INCLUDED
*         IT WILL RESULT IN A RETURN JUMP TO ADDRESS 1
*         DESTROYING PP RESIDENT. 
* 
*         IN THE CASES WHERE A SUBROUTINE IS DEFINED THAT 
*         DEPENDS ON OTHER COMPTFM SUBROUTINES TO EXECUTE 
*         THE SYMBOLS NECESSARY TO ASSEMBLE THE DEPENDENT 
*         SUBROUTINES WILL BE AUTOMATICALLY DEFINED.
          TITLE  COMPTFM - STAND ALONE SUBROUTINES. 
 CVA$     IF     DEF,CVA$ 
 CVA      SPACE  4,10 
**        CVA - CLEAR VOLUME ASSIGNMENT.
* 
*         ENTRY  (BA) = BUFFER ADDRESS (VSN INDEX). 
*                (BP) = BUFFER POINTER (VSN INDEX). 
* 
*         EXIT   1. VSN SET NOT BUSY. 
*                2. JOB ASSIGNMENT CLEARED. 
*                3. SYSTEM EVENT ENTERED. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 CVA      SUBR               ENTRY/EXIT 
          LDM    VBST+1,BP   CLEAR VOLUME BUSY
          SCN    VIVS 
          STM    VBST+1,BP
          LDN    0           CLEAR JOB ASSIGNMENT 
          STM    VBJS,BP
          LDN    ZERL        ENTER TMS EVENT
          CRD    CM 
          LDN    ESVB 
          STD    CM+4 
          MONITOR EATM       ENTER SYSTEM EVENT 
          UJN    CVAX        RETURN 
 CVA$     ENDIF 
 EOI$     IF     DEF,EOI$ 
 EOI      SPACE  4,10 
**        EOI - SET END OF INFORMATION. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   THE EOI BIT (2**1) IS SET IN 
*                WORD 0 OF THE FET. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS LDA. 
  
  
 EOI      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL 
          CRD    CM 
          LDD    CM+4 
          SCN    2
          LMN    2
          STD    CM+4 
          LDA    IR+3,REL 
          CWD    CM 
          UJN    EOIX        RETURN 
  
 EOI$     ENDIF 
 LTC$     IF     DEF,LTC$ 
 LTC      SPACE  4,10 
**        LTC    LOCATE TAPE CATALOG ON CURRENT VSN.
* 
*         ENTRY  (BA - RI+1) = POINTERS TO FIRST CATALOG ENTRY. 
*                (POFI - POFI+8) = FILE IDENTIFIER. 
*                (PBQN) = FILE SEQUENCE NUMBER. 
* 
*         EXIT   (A) = 0 IF NOT FOUND.
*                (CPCB) = POINTER TO CATALOG ENTRY. 
* 
*         USES   CI, RI - RI+1. 
* 
*         CALLS  RRP, VSP.
* 
*         MACROS COMPARE, ERROR, SAVEP. 
  
  
 LTC      SUBR               ENTRY/EXIT 
 LTC1     LDA    PBQN,ABS 
          ZJN    LTC4        IF SEQUENCE NUMBER NOT SPECIFIED 
          LMM    CBQN+1,BP   COMPARE WITH CATALOG SEQUENCE NUMBER 
          STD    T0 
          SHN    -14
          LMM    CBQN,BP
          LPN    77 
          ADD    T0 
          NJN    LTC5        IF NOT CORRECT ENTRY 
 LTC2     SAVEP  CPCB 
 LTC3     UJN    LTCX        RETURN 
  
 LTC4     LDC    CBPI        COMPARE PHYSICAL FILE IDENTIFIER 
*         LDC    CPLI        (COMPARE LOGICAL FILE IDENTIFIER)
 LTCA     EQU    *-1
          ADD    BP 
          STD    T1 
          COMPARE  ,,POFI,,FIKL 
          ZJN    LTC2        IF FILE FOUND
 LTC5     LDM    CBNC,BP
          ZJN    LTC3        IF NO ENTRY FOUND
          SHN    14 
          STD    CI 
          SHN    -14
          LMD    RI 
          NJN    LTC6        IF NOT SAME PRU
          LDM    CBNC+1,BP
          LMD    RI+1 
          ZJN    LTC7        IF SAME PRU
 LTC6     LDM    CBNC,BP     SET RANDOM INDEX 
          LPN    77 
          STD    RI 
          LDM    CBNC+1,BP
          STD    RI+1 
          RJM    RRP         READ RANDOM PRU
 LTC7     RJM    VSP         VALIDATE/SET CATALOG POINTERS
          PJP    LTC1 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
 LTC$     ENDIF 
 RCL$     IF     DEF,RCL$ 
 RCL      SPACE  4,10 
**        RCL - RECALL *TFM*. 
* 
*         ENTRY  (UTMS - UTMS+4) = *TMS* *UDT* WORD FOR *MAGF*. 
* 
*         EXIT   *TFM* PLACED IN RECALL STACK.
*                *UTMS* WORD OF *UDT* REWRITTEN FOR *MAGF*. 
*                TO *PPR*.
* 
*         MACROS MONITOR. 
  
  
 RCL      BSS    0           ENTRY
          LDD    FC 
          LMN    MAGF 
          NJN    RCL1        IF NOT MAGNET FUNCTION 
          UDTWT  UTMS,/MTX/UTMS,1  REWRITE *UDT*
 RCL1     LDN    ZERL 
          CRD    CM 
          LDD    MA          SET INPUT REGISTER 
          CWD    IR 
          ADN    1           CLEAR RECALL PARAMETER 
          CWD    CM 
          LDK    /COMSCPS/PTMF  SET TIMED RECALL AND DROP PP
          STD    CM+1 
          LDC    4000D       SET RECALL INTERVAL
          STD    CM+4 
          MONITOR  RECM      RECALL PP
          LJM    PPR         EXIT TO PP RESIDENT
 RCL$     ENDIF 
 SBP$     IF     DEF,SBP$ 
 SBP      SPACE  4,10 
**        SBP - SET FET BUFFER POINTERS.
* 
*         READS THE FIRST, IN, OUT, AND LIMIT POINTERS
*         FROM THE FET AND STORES THEM IN 8 CONSECUTIVE 
*         DIRECT CELLS. NO OTHER LOCATIONS ARE DESTROYED. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
* 
*         USES   T0 - T5. 
* 
*         MACROS LDA. 
  
  
 SBP      SUBR               ENTRY/EXIT 
          LDD    IN-3        SAVE OVERLAP WORD
          STD    T0 
          LDA    IR+3,REL 
          ADN    4           READ LIMIT 
          CRD    LM-3 
          SBN    1           READ OUT 
          CRD    OT-3 
          SBN    1           READ IN
          CRD    IN-3 
          SBN    1           READ FIRST 
          CRD    T1 
          LDD    T1+3        SET FIRST
          LPN    77 
          STD    FT 
          LDD    T1+4 
          STD    FT+1 
          LDD    T0          RESTORE OVERLAP WORD 
          STD    IN-3 
          UJN    SBPX        RETURN 
 SBP$     ENDIF 
 SVB$     IF     DEF,SVB$ 
 SVB      SPACE  4,10 
**        SVB - SET VSN BUSY. 
* 
*         ENTRY  NONE.
* 
*         EXIT   VSN SET BUSY AND EJT ORDINAL SET IF NOT BUSY.
*                TO ERROR PROCESSING IF BUSY. 
* 
*         THE CALLER OF SVB IS RESPONSIBLE FOR SETTING THE CORRECT EJT
*         ORDINAL IF *TFM* IS NOT ASSIGNED TO THE USER JOB-S CONTROL
*         POINT.
* 
*         USES   CM - CM+4. 
* 
*         MACROS ERROR. 
  
  
 SVB2     LDN    VIVS        SET VSN BUSY 
          RAM    VBST+1,BP
          LDM    VBMX,BP     SET CATALOG MACHINE INDEX-1
          SCN    17 
          LMM    CDMX 
          STM    VBMX,BP
          LDD    CM 
          STM    VBJS,BP
  
 SVB      SUBR               ENTRY/EXIT 
          LDD    CP          GET EJT ORDINAL
          ADN    TFSW 
          CRD    CM 
          LDM    VBST+1,BP
          LPN    VIVS 
          ZJN    SVB2        IF VSN NOT BUSY
          LDM    VBMX,BP     CHECK MACHINE INDEX
          LPN    17 
          LMM    CDMX 
          NJN    SVB1        IF NOT BUSY ON THIS MACHINE
          LDM    VBJS,BP     CHECK EJT ORDINAL
          LMD    CM+0 
          NJN    SVB1        IF NOT ASSIGNED TO THIS JOB
          ERROR  DLK         *DEADLOCK.*
  
 SVB1     ERROR  VBS         *(VSN) BUSY.*
 SVB$     ENDIF 
 IUC$     IF     DEF,IUC$ 
 IUC      SPACE  4,10 
**        IUC - INCREMENT USAGE COUNTER.
* 
*         ENTRY  NONE.
* 
*         EXIT   THE USAGE COUNTER WILL BE INCREMENTED AND IF 
*                THRESHOLD EXCEEDED, THE MAINTENANCE FLAG 
*                WILL BE SET. 
  
  
 IUC      SUBR               ENTRY/EXIT 
          LDD    HN          1S6
          RAM    VBUC,BP
          SHN    21-14
          PJN    IUC1        IF LT 63 USES
          LDC    77S6 
          RAM    VBUC,BP
          SHN    21-14
 IUC1     SHN    14-21-6
          SBN    VUMT 
          MJN    IUCX        IF THRESHOLD NOT EXCEEDED
          LDN    VUMT 
          ZJN    IUCX        IF THRESHOLD DISABLED
          LDM    VBST,BP     SET MAINTENANCE FLAG 
          SCN    HMVS/10000 
          LMN    HMVS/10000 
          STM    VBST,BP
          UJN    IUCX        RETURN 
 IUC$     ENDIF 
 UOP$     IF     DEF,UOP$ 
 UOP      SPACE  4,10 
**        UOP - UPDATE OUT POINTER. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
*                (OT - OT+1) = OUT POINTER. 
* 
*         EXIT   FET+3 UPDATED. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS LDA. 
  
  
 UOP      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDD    OT          CURRENT POSITION OF OUT
          STD    CM+3 
          LDD    OT+1 
          STD    CM+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    3
          CWD    CM 
          UJN    UOPX        RETURN 
 UOP$     ENDIF 
 UTR$     IF     DEF,UTR$ 
 UTR      SPACE  4,10 
**        UTR - UPDATE TRT. 
* 
*         ENTRY  (FS - FS+4) = FST ENTRY OF FAST ATTACH FILE. 
* 
*         EXIT   TRT UPDATED IF SHARED DEVICE.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 UTR      SUBR               ENTRY/EXIT 
          LDD    FS          SET EST ORDINAL
          LPC    777
          STD    CM+1 
          LDN    /COMSCPS/UTRS  UPDATE TRT
          STD    CM+3 
          MONITOR  STBM 
          UJN    UTRX        RETURN 
 UTR$     ENDIF 
 VRR$     IF     DEF,VRR$ 
 VRR      SPACE  4,10 
**        VRR - VERIFY RANDOM REQUEST.
* 
*         ENTRY  (RI - RI+1) = RANDOM INDEX.
* 
*         EXIT   TO ERROR PROCESSING IF INCORRECT ADDRESS.
* 
*         USES   T5 - T5+4. 
* 
*         CALLS  AFA, CRA.
* 
*         MACROS ERROR, LDA, SETMS. 
* 
  
  
 VRR2     LDA    CTSA,ABS    RESTORE RANDOM ADDRESS 
          STD    RI+1 
          SHN    -14
          STD    RI 
  
 VRR      SUBR               ENTRY/EXIT 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    T5 
          LDA    RI,ABS      SAVE RANDOM ADDRESS
          ZJN    VRR1        IF NO RANDOM ADDRESS 
          STM    CTSA+1 
          SHN    -14
          STM    CTSA 
          SETMS  STATUS 
          RJM    CRA         CONVERT RANDOM ADDRESS 
          PJN    VRR2        IF VALID ADDRESS 
 VRR1     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
 VRR$     ENDIF 
 VSP$     IF     DEF,VSP$ 
 VSP      SPACE  4,10 
**        VSP - VERIFY/SET CATALOG POINTERS.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (CI) = CATALOG INDEX.
*                (VSPA) = MAXIMUM ENTRIES PER PRU.
*                (VSPB) = ENTRY LENGTH IN CM WORDS. 
* 
*         EXIT   (A) = -0 IF POINTERS INCORRECT.
*                (BA) = BUFFER ADDRESS (UNCHANGED). 
*                (BP) = BUFFER POINTER (CALCULATED).
*                (CI) = CATALOG INDEX (UNCHANGED).
* 
*         CALLS  MLT. 
  
  
 VSP2     LDD    CI          SET BUFFER POINTER 
          SBN    1
          SHN    14 
          LMN    TCEL 
 VSPB     EQU    *-1         (TAEL IF ADMIT CONTINUATION) 
          RJM    MLT         (A) REGISTER MULTIPLY
          ADN    TBHL 
          STD    BP          CONVERT TO BYTES 
          SHN    2
          RAD    BP 
          ADD    BA          BIAS BY BUFFER ADDRESS 
          ADN    2
          STD    BP 
  
 VSP      SUBR               ENTRY/EXIT 
          LDD    CI          CHECK CATALOG INDEX
          ZJN    VSP1        IF OUT OF RANGE
          SBN    60D/TCEL+1 
 VSPA     EQU    *-1         (60D/TAEL+1) 
          MJN    VSP2        IF IN RANGE
 VSP1     LCN    0           SET INCORRECT POINTERS 
          UJN    VSPX        RETURN 
  
 MLT$     EQU    1           DEFINE MLT - (A) REGISTER MULTIPLY 
 VSP$     ENDIF 
 VUB$     IF     DEF,VUB$ 
 VUB      SPACE  4,10 
**        VUB - VERIFY USERS CATALOG/ADMIT BLOCK. 
* 
*         COMPARES THE OWNERS USERNAME TO THE USERNAME
*         IN THE BLOCK HEADER.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (PBUN - PBUN+3) = USERNAME.
* 
*         EXIT   (A) = 0 IF USERS BLOCK.
*                (A) = -0 IF NOT USERS DATA BLOCK.
* 
*         USES   T1, T2.
* 
*         CALLS  CSS. 
  
  
 VUB1     LCN    0           SET DATA BLOCK ERROR 
  
 VUB      SUBR               ENTRY/EXIT 
          LDC    PBUN 
          STD    T1 
          LDI    T1 
          ZJN    VUB1        IF DATA ERROR
          COMPARE ,,CWUN,BA,UNKL
          NJN    VUB1        IF NOT USERS CATALOG/ADMIT BLOCK 
          UJN    VUBX        RETURN 
 VUB$     ENDIF 
          TITLE  COMPTFM - DEPENDENCY SUBROUTINES.
 AUS$     IF     DEF,AUS$ 
 AUS      SPACE  4,10 
**        AUS - ALTERNATE USER SEARCH.
* 
*         *AUS* PERFORMS A INDEXED SEARCH OF THE
*         ADMIT ENTRIES FOR THE USERNAME AT (KA). 
* 
*         ENTRY  (KA) = KEY ADDRESS.
*                (RI - RI+1) = RANDOM ADDRESS OF
*                              FIRST ADMIT BLOCK. 
* 
*         EXIT   (A) = 0 IF FOUND.
*                (A) = -0 IF END OF ADMIT ENTRIES.
*                (A) .GT. 0 IF PREMATURE END OF SEARCH. 
*                (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER. 
* 
*         USES   CPAB - CPAB+4, BA, BP, KL. 
* 
*         CALLS  GIB, GNB, GNL, MBP, SIB. 
  
  
 AUS      SUBR               ENTRY/EXIT 
          CLEAR  CPAB,,10D
          LDN    UNKL        SET KEY LENGTH 
          STD    KL 
          RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GIB         GET INITIAL BLOCK
 AUS1     LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          RJM    SIB         SEARCH INDEX BUFFER
          STM    AUSA+1      SAVE EXIT CONDITION
          SHN    -14
          LMC    LDCI 
          STM    AUSA 
          LDA    AUSA,ABS 
          PJN    AUS2        IF FOUND OR END OF SEARCH
          RJM    GNL         GET NEXT LINK
          ZJN    AUS2        IF BLOCK NOT LINKED
          RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GNB         GET NEXT BLOCK 
          UJN    AUS1        SEARCH ADMIT BUFFER
  
 AUS2     SAVEP  CPAB        SAVE ADMIT POINTERS
          LDC    ** 
 AUSA     EQU    *-2         (EXIT CONDITION) 
          LJM    AUSX        RETURN 
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BLOCK
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 AUS$     ENDIF 
 CCB$     IF     DEF,CCB$ 
 CCB      SPACE  4,10 
**        CCB - CHECK CURRENT BUFFER. 
* 
*         ENTRY  (CPPI - CPPI+4) = PRIMARY INDEX POINTERS.
*                (CPSI - CPSI+4) = SECONDARY INDEX POINTERS.
* 
* 
*         USES   BA - BA+4. 
* 
*         CALLS  BSE, MBP, SIB. 
* 
*         MACROS LDA. 
  
  
 CCB3     LCN    0           SET BUFFERS NOT PRESENT
  
 CCB      SUBR               ENTRY/EXIT 
          RESTP  CPPI        RESTORE PRIMARY POINTERS 
          LDD    BA 
          ADN    2
          STD    BP 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          RJM    SIB         SEARCH INDEX BUFFER
          ZJN    CCB1        IF KEY FOUND 
          MJN    CCBX        IF END OF INDEX
          RJM    BSE         BACKWARD SKIP ONE ENTRY
          ZJN    CCB3        IF FIRST ENTRY 
 CCB1     SAVEP  CPPI        SAVE PRIMARY POINTERS
          LDM    3,BP 
          LPN    77 
          LMC    LMCI 
          STM    CCBA 
          LDM    4,BP 
          STM    CCBA+1 
          RESTP  CPSI        RESTORE SECONDARY POINTERS 
          LDD    BA 
          ADN    2
          STD    BP 
          LDA    CPSI+3,ABS 
          LMC    ** 
 CCBA     EQU    *-2         (SECONDARY INDEX)
          ZJN    CCB2        IF SECONDARY INDEX LOADED
          LJM    CCB3        SET BUFFERS NOT PRESENT
  
 CCB2     LDM    CWFE,BA     FIND SECONDARY INDEX 
          RJM    MBP         MOVE BUFFER POINTER
          RJM    SIB         SEARCH INDEX BUFFER
          STM    CCBB+1      SAVE EXIT CONDITION
          SHN    -14
          LMC    LDCI 
          STM    CCBB 
          SAVEP  CPSI        SAVE SECONDARY POINTERS
          LDC    ** 
 CCBB     EQU    *-2         (EXIT CONDITION) 
          LJM    CCBX        RETURN 
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BLOCK
 CCB$     ENDIF 
 CIE$     IF     DEF,CIE$ 
 CIE      SPACE  4,10 
**        CIE - CREATE INDEX ENTRY. 
* 
*         *CIE* IS USED TO CREATE TWO LEVEL INDEXED ENTRIES FOR 
*         USERNAME AND VSN INDICIES. ON EXIT THERE IS NO GUARANTEE
*         THAT THE INDEX POINTERS HAVE NOT BEEN CHANGED DUE TO AN 
*         INSERT. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS (SECONDARY INDEX)
*                (BP) = BUFFER POINTER (SECONDARY INDEX)
*                (PB) = ENTRY BUFFER ADDRESS. 
*                (KL) = KEY LENGTH. 
*                (CPPI - CPPI+4) = PRIMARY INDEX POINTERS.
*                (CPSI - CPSI+4) = SECONDARY INDEX POINTERS.
*                BUFA - ENTRY BUFFER ADDRESS. 
*                BUFB - OVERFLOW BUFFER ADDRESS.
* 
*         EXIT   (CPPI - CPPI+4) = CURRENT PRIMARY INDEX POINTER. 
*                (CPSI - CPSI+4) = CURRENT SECONDARY INDEX POINTER. 
* 
*         CALLS  GIB, GNL, IIE, MBP, WRP. 
* 
*         MACROS ERROR, MMOVE, RESTP, SAVEP.
  
  
 CIE      SUBR               ENTRY/EXIT 
          LDC    BUFB 
          STD    T7 
          RJM    IIE         INSERT INDEX ENTRY (SECONDARY) 
          STM    CIEA        SAVE OVERFLOW BLOCK STATUS 
          SAVEP  CPSI        SAVE BUFFER POINTERS (SECONDARY) 
          LDM    CWNE,BA
          LMN    1
          NJP    CIE4        IF NEW BLOCK NOT CREATED 
          LDD    KL 
          SBN    VSKL 
          ZJN    CIE1        IF VSN INDEX 
          LDM    3,PB 
          SCN    77 
 CIE1     LMD    RI          ENTER SECONDARY INDEX POINTER
          STM    3,PB 
          LDM    RI+1 
          STM    4,PB 
          RESTP  CPPI        RESTORE BUFFER POINTERS (PRIMARY)
          LDC    BUFA 
          STD    T7 
          SBD    PB 
          NJN    CIE2        IF OVERFLOW BUFFER NOT ENTRY BUFFER
          LDC    BUFB 
          STD    T7 
 CIE2     LDM    CWEL,BA
          RJM    MBP         MOVE BUFFER POINTER
          RJM    IIE         INSERT INDEX ENTRY (PRIMARY) 
          SAVEP  CPPI        SAVE BUFFER POINTERS (PRIMARY) 
 CIE3     LJM    CIEX        RETURN 
  
 CIE4     LDM    CWFE,BA     CHECK POSITIONING
          STD    T1 
          SHN    2
          RAD    T1 
          ADN    2
          ADD    BA 
          SBD    BP 
          NJN    CIE3        IF NOT POSITIONED AT FIRST INDEX 
          RESTP  CPPI        RESTORE BUFFER POINTERS (PRIMARY)
          LDC    0           NO OVERFLOW BLOCK
*         LDC    IIEX        (OVERFLOW BLOCK) 
 CIEA     EQU    *-1
          ZJN    CIE6        IF NOT OVERFLOW BLOCK
          LDM    CWEL,BA
          RJM    MBP         MOVE BUFFER POINTER
          MJN    CIE5        IF MOVE OUTSIDE BUFFER 
          LDI    BP 
          NJN    CIE6        IF NOT END OF INDEX
 CIE5     RJM    WRP         WRITE RANDOM PRU (PRIMARY) 
          RJM    GNL         GET NEXT LINK
          ZJN    CIE7        IF PRIMARY BLOCK NOT LINKED
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
 CIE6     MMOVE  ,PB,,BP,,KL
          RJM    WRP         WRITE RANDOM PRU (PRIMARY) 
          LJM    CIEX        RETURN 
  
 CIE7     ERROR  CLE         *CATALOG LINKAGE ERROR.* 
 IIE$     EQU    1           DEFINE IIE - INSERT INDEX ENTRY
 CIE$     ENDIF 
 DDE$     IF     DEF,DDE$ 
 DDE      SPACE  4,10 
**        DDE - DELETE DATA ENTRY.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER OF ENTRY TO DELETE.
  
  
 DDE      SUBR               ENTRY/EXIT 
          LDM    CWEL,BA     MOVE ENTRIES UP
          SHN    14 
          LMM    CWNE,BA
          RJM    MLT         (A) REGISTER MULTIPLY
          ADM    CWFE,BA
          STD    T0 
          SHN    2
          RAD    T0 
          LDD    BA          BIAS BY BUFFER ADDRESS 
          ADN    2
          RAD    T0 
          LDM    CWEL,BA     SET FWA AND DESTINATION OF MOVE
          STD    T1 
          SHN    2
          RAD    T1 
          LDD    BP 
          STD    T2 
          RAD    T1 
          LDD    T0          SET MOVE COUNT 
          SBD    T1 
          SHN    1
          RJM    MPM         MOVE PP MEMORY 
          LDD    T2 
          STD    T1 
          LDM    CWEL,BA
          STD    T0 
          SHN    2
          RAD    T0 
          SHN    1
          RJM    CPM         CLEAR PP MEMORY
          SOM    CWNE,BA     UPDATE CONTROL WORDS 
          LDM    CWUW,BA
          ADM    CWEL,BA
          STM    CWUW,BA
          LJM    DDEX        RETURN 
 MLT$     EQU    1           DEFINE MLT - (A) REGISTER MULTIPLY 
 DDE$     ENDIF 
 DLB$     IF     DEF,DLB$ 
 DLB      SPACE  4,10 
**        DLB - DELINK BLOCK. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) RANDOM INDEX OF BLOCK TO DELINK. 
  
  
 DLB      SUBR               ENTRY/EXIT 
          LDM    CPEB+1      SET EMPTY PRU LINKAGE
          STM    DLBA+1 
          LDM    CPEB 
          LPN    77 
          LMC    LDCI 
          STM    DLBA 
          LDD    RI          UPDATE HOLE POINTER
          STM    CPEB 
          LDD    RI+1 
          STM    CPEB+1 
          LDM    CWBI,BA     SET PREVIOUS BLOCK INDEX 
          LPN    77 
          LMC    LDCI 
          STM    DLBB 
          LDM    CWBI+1,BA
          STM    DLBB+1 
          LDM    CWRI,BA     SET NEXT BLOCK INDEX 
          LPN    77 
          LMC    LDCI 
          STM    DLBC 
          LDM    CWRI+1,BA
          STM    DLBC+1 
          RJM    GEP         GENERATE EMPTY PRU 
          LDC    ** 
 DLBA     EQU    *-2         (EMPTY BLOCK LINK) 
          STM    CWRI+1,BA
          SHN    -14
          STM    CWRI,BA
          RJM    WRP         WRITE RANDOM PRU 
          LDC    ** 
 DLBB     EQU    *-2         (PREVIOUS BLOCK RANDOM INDEX)
          ZJN    DLB1        IF FIRST BLOCK OF CHAIN
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDC    ** 
 DLBC     EQU    *-2         (NEXT BLOCK RANDOM INDEX)
          STM    CWRI+1,BA
          SHN    -14
          STM    CWRI,BA
          RJM    WRP         WRITE RANDOM PRU 
 DLB1     LDA    DLBC,ABS 
          ZJN    DLB2        IF LAST BLOCK OF CHAIN 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDM    DLBB+1 
          STM    CWBI+1,BA
          LDM    DLBB 
          LPN    77 
          STM    CWBI,BA
          RJM    WRP         WRITE RANDOM PRU 
 DLB2     LDN    TMSB        UPDATE SYSTEM BLOCK
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK (SYSTEM BLOCK) 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDM    CPEB+1 
          STM    SBHP+1,BP
          LDM    CPEB 
          LPN    77 
          STM    SBHP,BP
          RJM    WRP         WRITE RANDOM PRU 
          LJM    DLBX        RETURN 
 GEP$     EQU    1           DEFINE GEP - GENERATE EMPTY PRU
 DLB$     ENDIF 
 FTC$     IF     DEF,FTC$ 
 FTC      SPACE  4,10 
**        FTC - FIND TAPE CATALOG.
* 
*         *FTC* IS USED TO LOCATE THE TAPE FILE CATALOG 
*         AND TO VALIDATE USER ACCESS. IF THE EXTERNAL
*         VSN IS SUPPLIED, IT IS USED. IF THE EXTERNAL
*         VSN IS NOT SUPPLIED AND THE FILE NAME IS, A 
*         SEARCH BY FILE NAME IS INITIATED. 
* 
*         ENTRY  (PESN - PESN+2) = EXTERNAL VSN.
*                (PBUN - PBUN+3) = USERNAME.
*                (POFI - POFI+10B) = FILE NAME. 
* 
*         EXIT   (A) = 0 IF CATALOG FOUND.
*                (A) = ERROR CODE IF CATALOG NOT FOUND. 
* 
*         USES   CPCB - CPCB+4, KA, RI - RI+1, T1.
* 
*         CALLS  GIB, SCB, UIS, VIS, VSP, VUB.
* 
*         MACROS ERROR, SAVEP.
  
  
 FTC6     LDC    PBUN        FILE IDENTIFIER SEARCH 
          STD    KA 
          RJM    UIS         USERNAME INDEX SEARCH
          ZJN    FTC9        IF USERNAME FOUND
 FTC7     LDN    /EMSG/FNF   *(FILENAME) NOT FOUND.*
 FTC8     UJN    FTCX        RETURN 
  
 FTC9     LDC    BUF2        SET CATALOG BUFFER ADDRESS 
          STD    BA 
          LDM    UBCI,BP     SET CATALOG RANDOM INDEX 
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    UBCI+1,BP
          STD    RI+1 
          ZJN    FTC7        IF NO RANDOM ADDRESS 
          LDC    POFI        SET SEARCH KEY ADDRESS 
          STD    KA 
          RJM    SCB         SEARCH CATALOG BUFFER
          ZJN    FTC7        IF FILE NOT FOUND
          PJN    FTC10       IF NOT DUPLICATE FILENAME
          LDN    /EMSG/FAR   *(FILENAME) ALREADY RESERVED.* 
          UJN    FTCX        RETURN WITH ERROR
  
 FTC10    LDN    0           SET CATALOG FOUND
  
 FTC      SUBR               ENTRY/EXIT 
          LDC    PESN 
          STD    KA 
          LDI    KA 
          ZJP    FTC6        IF SEARCH BY USERNAME/FILE NAME
 FTC1     RJM    VIS         VSN INDEX SEARCH 
          NJN    FTC2        IF VSN NOT FOUND 
          LDM    VBRD+1,BP
          ZJN    FTC3        IF NO RELEASE DATE 
          LDN    CRDP 
          ZJN    FTC3        IF CRDP DEFINED ZERO 
          LDD    FC 
          LMN    SSJF 
          ZJN    FTC3        IF *TFSP* CALL 
 FTC2     LDN    /EMSG/VNF   *(VSN) NOT FOUND.* 
 FTC2.1   UJN    FTCX        RETURN 
  
 FTC3     LDM    VBCI,BP     SET CATALOG ADDRESS
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    VBCI+1,BP
          ZJN    FTC2        IF NOT ASSIGNED
          STD    RI+1        SET RANDOM ADDRESS 
          SHN    -14
          STD    RI 
          LDC    BUF2 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    FTC5        IF INCORRECT POINTERS
          SAVEP  CPCB        SAVE BUFFER POINTERS (CATALOG) 
          RJM    VUB         VERIFY USER BLOCK
          NJN    FTC2        IF NOT VSN RESERVED BY USER
          UJN    FTC2.1      RETURN 
  
 FTC5     ERROR  EID         *ERROR IN INDEX DATA.* 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS BLOCK LINK 
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SCB$     EQU    1           DEFINE SCB - SEARCH CATALOG BUFFER 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BLOCK
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEXED SEARCH 
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 FTC$     ENDIF 
 CAA$     IF     DEF,CAA$ 
 CAA      SPACE  4,10 
**        CAA - CHECK ALTERNATE USER ACCESS.
* 
*         ENTRY  (BA) = CATALOG BUFFER ADDRESS. 
*                (BP) = CATALOG BUFFER POINTER. 
* 
*         EXIT   (BA) = CATALOG BUFFER ADDRESS. 
*                (BP) = CATALOG BUFFER POINTER. 
*                (CT) = FILE CATEGORY TYPE. 
*                (MD) = FILE ACCESS MODE. 
* 
*         USES   CT, KA, MD, PB, RI - RI+1. 
* 
*         CALLS  AUS, IBC, IIE, MBP, TBA, WRP.
* 
*         MACROS CLEAR, COMPARE, ERROR, MMOVE, RESTP, 
*                SAVEP. 
  
  
 CAA      SUBR               ENTRY/EXIT 
          LDM    PAUN 
          ZJN    CAAX        IF USERS CATALOG BLOCK 
          LDM    CBCT,BP     SET CATEGORY TYPE
          SHN    14 
          STD    CT 
          SHN    -14         SET ACCESS MODE
          STD    MD 
          COMPARE PPWD,,CBPW,BP,PWKL
          ZJN    CAA3        IF COMPARE ON PASSWORD 
*         UJN    CAA3        (SKIP PASSWORD CHECK IF *RESEX* *POSMF*) 
 CAAB     EQU    *-1
 CAA1     LDM    PESN 
          ZJN    CAA2        IF VSN NOT SPECIFIED 
          LDN    /EMSG/VNF&/EMSG/FNF
 CAA2     LMN    /EMSG/FNF   *(FILENAME) NOT FOUND.*
          ERROR 
  
 CAA3     LDD    CT          CHECK FILE CATEGORY
          LMN    FCPU 
          ZJN    CAA4        IF PUBLIC FILE 
          LDM    CBAE,BP     SET ADMIT INDEX
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBAE+1,BP
          STD    RI+1 
          NJN    CAA6        IF ADMITS ASSIGNED TO FILE 
          LDD    CT 
          LMN    FCSP 
          NJN    CAA1        IF NOT SEMI-PRIVATE
          RJM    CMD         CHECK MODE 
          LDC    0           IF ADMIT ENTRY UPDATE
*         LDC    1           IF NO ADMIT ENTRY UPDATE 
 CAAC     EQU    *-1
          NJN    CAA5        IF NO ADMIT ENTRY UPDATE 
          LJM    CAA11       ENTER ADMIT ENTRY
  
 CAA4     RJM    CMD         COMPARE MODES
 CAA5     RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
          LJM    CAAX        RETURN 
  
 CAA6     LDC    PAUN        CHECK FOR EXPLICIT PERMISSION
          STD    KA 
          RJM    AUS         ALTERNATE USERNAME SEARCH
          NJN    CAA7        IF ALTERNATE USER NOT FOUND
          LDC    WRP         SET TO UPDATE EXISTING ENTRY 
          STM    CAAA 
          LDD    BP 
          UJN    CAA8        UPDATE ADMIT ENTRY 
  
 CAA7     LDD    CT          CHECK FOR PRIVATE FILE 
          LMN    FCPR 
          ZJP    CAA1        IF PRIVATE FILE
          CLEAR  BUFA,,2*10D   ENTER ADMIT ENTRY
          LDC    BUFB 
          STD    T7 
          LDC    BUFA 
 CAA8     STD    PB          UPDATE INDEX 
          LDM    ABAM,PB
          LPN    77 
          ZJN    CAA9        IF IMPLICIT USER 
          ERRNZ  FMIU 
          STD    MD 
 CAA9     RJM    CMD         CHECK MODE 
          LDM    CAAC        CHECK FOR ADMIT ENTRY UPDATE 
          NJN    CAA10       IF NO UPDATE 
          MMOVE  PAUN,,,PB,UNKL 
          LDD    HN          INCREMENT ACCESS COUNT 
          RAM    ABAN+1,PB
          SHN    -14
          RAM    ABAN,PB
          LIA    ABDT,PB
          RJM    EDT         ENTER PACKED DATE/TIME 
          RJM    IIE         INSERT INDEX ENTRY 
 CAAA     EQU    *-1         (RJM TO *WRP* IF INDEX FOUND)
 CAA10    LJM    CAA5        RESTORE CATALOG POINTERS 
  
 CAA11    RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    IBC         INITIALIZE BLOCK CHAIN 
          LDC    RTAB*100 
          STM    CWRT,BA
          LDN    TAEL 
          STM    CWEL,BA
          MMOVE  PBUN,,CWUN,BA,UNKL 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          SAVEP  CPAB        SAVE ADMIT BUFFER POINTERS 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          LDM    CPAB+3      SET ADMIT BUFFER POINTER 
          STM    CBAE,BP
          LDM    CPAB+4 
          STM    CBAE+1,BP
          RJM    WRP         WRITE RANDOM PRU (CATALOG) 
          RESTP  CPAB        RESTORE ADMIT BUFFER POINTERS
          LJM    CAA7        ENTER IMPLICIT USER
 CMD      SPACE  4,10 
**        CMD - COMPARE MODE REQUESTED WITH MODE ALLOWED. 
* 
*         ENTRY  (MD) = MODE ALLOWED. 
*                (PFTD+1) = WRITE REQUESTED.
* 
*         EXIT   TO CAA1 IF ACCESS DENIED.
*                TO ERR IF WRITE REQUESTED ON READ-ONLY FILE. 
  
  
 CMD      SUBR               ENTRY/EXIT 
          LDD    MD 
          LMN    FMNA 
          ZJP    CAA1        IF ACCESS DENIED 
          LMN    FMWR&FMNA
          ZJN    CMDX        IF WRITE ALLOWED 
          LDM    PFTD+1 
          SHN    21-4 
          PJN    CMDX        IF READ REQUESTED
          ERROR  WRF         *WRITE ON READ-ONLY FILE.* 
 IIE$     EQU    1           DEFINE IIE - INSERT INDEX ENTRY
 CAA$     ENDIF 
 IAM$     IF     DEF,IAM$ 
 IAM      SPACE  4,10 
**        IAM - ISSUE ACCOUNT FILE MESSAGE. 
* 
*         ENTRY  (A) = 0, IF RESERVE ACCOUNT MESSAGE. 
*                (A) = 1, IF RELEASE ACCOUNT MESSAGE. 
*                (CM - CM+4) = 0 IF UNCONDITIONAL RELEASE,
*                            = C* YY/MM/DD.* IF CONDITIONAL RELEASE.
* 
*         EXIT   ACCOUNT FILE MESSAGE ISSUED. 
* 
*         USES   T0 - T4. 
* 
*         CALLS  FAM, IRS.
  
  
 IAM      SUBR               ENTRY/EXIT 
          STD    T0 
          ZJN    IAM1        IF RESERVE ACCOUNT MESSAGE 
          LDC    2RCR&2RAU   SET RELEASE ACCOUNT MESSAGE
 IAM1     LMC    2RAU 
          STM    IAMA+1 
          LDD    T0 
          RJM    FAM         FORMAT ACCOUNT FILE MESSAGE
          RJM    IRS         ISSUE ACCOUNT MESSAGE
          UJP    IAMX        RETURN 
  
 IAMA     DATA   C*SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF,  YY/MM/DD.    *
*         DATA   C*SDAU, FAMNAME/USERNAM/QNZZZ/VSNFFF, VSNCCC.* 
*         DATA   C*SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF.* 
*         DATA   C*SDRA, FAMNAME/USERNAM/QNZZZ/VSNFFF, TFD/PASSWRD.*
*         DATA   C*SDRA, FAMNAME/USERNAM/QNZZZ/VSNFFF, TFD.*
*         DATA   C*SDRB, FAMNAMEXLOGICAL*FILE*IDNTYPHYSICAL*FILE*IDT.*
*         DATA   C*SDRC, FAMNAME/CONTROLWRDX/CHRGNUMBER, MULSIDY.*
 FAM$     EQU    1           DEFINE FAM - FORMAT ACCOUNT FILE MESSAGE 
 IRS$     EQU    1           DEFINE IRS - ISSUE RECOVERY MSG SUBROUTINE 
 SCC$     EQU    1           DEFINE SCC - SUBSTITUTE CHAR. FOR COLON
 CSN$     EQU    1           DEFINE CSN - CONVERT SEQUENCE NUMBER 
 IAM$     ENDIF 
 IRM$     IF     DEF,IRM$ 
 IRM      SPACE  4,15 
**        IRM - ISSUE *TMS* RECOVERY MESSAGES.
* 
*         ENTRY  (BP) = TAPE CATALOG ENTRY TO ISSUE MESSAGES FOR. 
*                (TFMC) = HAS DATA ATTACH MODE. 
* 
*         EXIT   RECOVERY MESSAGES *SDRA*, *SDRC* AND POSSIBLY
*                *SDRB* ISSUED TO THE ACCOUNT DAYFILE.
* 
*         USES   T0 - T4, CM - CM+4.
* 
*         CALLS  CSN, FAM, IRS, RUC.
* 
*         MACROS MMOVE. 
  
  
 IRM      SUBR               ENTRY/EXIT 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          ZJN    IRMX        IF CATALOG IS IN LOCAL FILE MODE 
          LDA    CBQN,BP     CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          RJM    CSN
          LDC    2RRA 
          STM    IAMA+1 
          LDN    0           SET *RESERVE* FORMAT DESIRED 
          RJM    FAM         FORMAT ACCOUNT FILE MESSAGE
          LDC    IAMA+22     RESET MESSAGE POINTER
          STD    T2 
          LDM    CBFN,BP     GET TAPE FORMAT DESCRIPTORS
          SCN    77          ISOLATE LABEL FORMAT 
          SHN    6
          ADM    CBTD,BP     ADD TAPE FORMAT DESCRIPTORS
          ADC    10101       ENSURE NO COLON CHARACTERS 
          STI    T2 
          SHN    14 
          SCN    77 
          ADN    1R/
          STM    1,T2 
          AOD    T2 
          AOD    T2 
          STD    T3          SAVE START OF PASSWORD IN MESSAGE
          MMOVE  CBPW,BP,,,7 ADD PASSWORD 
          LDI    T3 
          NJN    IRM1        IF NON-NULL PASSWORD 
          SOD    T3          BACKUP POINTER 
          STD    T2 
 IRM1     RJM    IRS         ISSUE MESSAGE
          LDM    CBST,BP     CHECK IF TAPE HAS SYMBOLIC ACCESS
          LPN    1S2
          ZJN    IRM2        IF NOT SYMBOLIC ACCESS TAPE
          LIA    CBLI,BP     SET FWA OF STRING TO TEST FOR COLONS 
          STD    T1 
          LDN    22          NUMBER OF CHARACTERS TO TEST 
          RJM    RUC         REMOVE UNWANTED COLONS 
          LIA    CBPI,BP     SET FWA OF STRING TO TEST FOR COLONS 
          STD    T1 
          LDN    21          NUMBER OF CHARACTERS TO TEST 
          RJM    RUC         REMOVE UNWANTED COLONS 
          LDM    IAMA+6      SET SUBSTITUTION CHARACTER IN MESSAGE
          SCN    77 
          ADD    T3 
          STM    IAMA+6 
          RJM    IRS         ISSUE MESSAGE
 IRM2     LDM    IAMA+6      RESET */* IN MESSAGE 
          SCN    77 
          ADN    1R/
          STM    IAMA+6 
          LDC    2RRC        CHANGE TO *SDRC,*
          STM    IAMA+1 
          LIA    CBUC,BP     SET FWA OF STRING TO TEST
          STD    T1 
          LDN    12          NUMBER OF CHARACTERS 
          RJM    RUC         REMOVE UNWANTED COLONS 
          LDD    T3          SUBSTITUTION CHARACTER 
          SHN    6
          ADN    1R/
          STI    T2 
          AOD    T2 
          MMOVE  CBCN,BP,,,CNKL  ADD CHARGE NUMBER
          LDC    2R,
          STI    T2 
          AOD    T2 
          LIA    CBSI,BP     SET FWA OF STRING TO TEST
          STD    T1 
          LDN    6
          RJM    RUC         REMOVE UNWANTED COLONS 
          LDD    T3 
          SHN    6
          STI    T2 
          RJM    IRS         ISSUE MESSAGE
          LDM    CBST,BP     CLEAR *TMS* RECOVERY MESSAGES NEEDED FLAG
          LPC    7377 
          STM    CBST,BP
          UJP    IRMX        RETURN 
 IAMA     IF     -DEF,IAMA
 IAMA     DATA   C*SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF,  YY/MM/DD.    *
*         DATA   C*SDAU, FAMNAME/USERNAM/QNZZZ/VSNFFF, VSNCCC.* 
*         DATA   C*SDCR, FAMNAME/USERNAM/QNZZZ/VSNFFF, .* 
*         DATA   C*SDRA, FAMNAME/USERNAM/QNZZZ/VSNFFF, TFD/PASSWRD.*
*         DATA   C*SDRA, FAMNAME/USERNAM/QNZZZ/VSNFFF, TFD.*
*         DATA   C*SDRB, FAMNAMEXLOGICAL*FILE*IDNTYPHYSICAL*FILE*IDT.*
*         DATA   C*SDRC, FAMNAME/CONTROLWRDX/CHRGNUMBER, MULSIDY.*
 IAMA     ENDIF 
 RUC      SPACE  4,15 
**        RUC - REMOVE UNWANTED COLONS FROM MESSAGE.
* 
*         ENTRY  (A) = NUMBER OF CHARACTERS IN STRING.
*                (T1) = FWA OF STRING TO TEST.
*                (T2) = FWA OF STRING DESTINATION.
* 
*         EXIT   (T3) = SUBSTITUTION CHARACTER USED.
* 
*         USES   T0 - T4. 
  
  
 RUC2     LDD    T1          RESTORE T2 
          STD    T2 
  
 RUC      SUBR               ENTRY/EXIT 
          STD    T0 
          LDD    T2 
          STD    T4 
          LDN    1R;         SET FIRST SUBSTITUTION CHARACTER 
          STD    T3 
 RUC1     LDD    MA 
          CWD    T0 
          LDD    T0 
          RJM    MPM         MOVE CHARACTERS
          LDD    T2 
          STD    T1 
          RJM    SCC         SUBSTITUTE FOR COLONS
          NJP    RUC2        IF SUBSTITUTION SUCCESSFUL 
          LDD    MA          RESTORE MOVE PARAMETERS
          CRD    T0 
          SOD    T3          DECREMENT TO NEXT SUBSTITUTION CHARACTER 
          UJP    RUC1        TRY AGAIN
 CSN$     EQU    1           DEFINE CSN - CONVERT SEQUENCE NUMBER 
 FAM$     EQU    1           DEFINE FAM - FORMAT ACCOUNT FILE MESSAGE 
 IRS$     EQU    1           DEFINE IRS - ISSUE RECOVERY MSG SUBROUTINE 
 SCC$     EQU    1           DEFINE SCC - SUBSTITUTE CHAR. FOR COLON
 IRM$     ENDIF 
 IIE$     IF     DEF,IIE$ 
 IIE      SPACE  4,10 
**        IIE - INSERT INDEXED ENTRY. 
* 
*         *IIE* IS USED TO INSERT A VSN, USERNAME, OR ADMIT 
*         ENTRY INTO A INDEXED DATA BLOCK. IF THERE IS NOT
*         ENOUGH ROOM IN THE INDEX BLOCK A NEW INDEX BLOCK
*         WILL BE CREATED IN THE FOLLOWING WAY. 
* 
*         1. IF THE BLOCK IS NOT FULL THE NEW ENTRY IS
*            INSERTED INTO THE CURRENT INDEX BLOCK. 
* 
*         2. IF INSERTING AT THE END OF A FULL INDEX BLOCK, 
*            THE NEW INDEX IS INSERTED INTO THE NEXT INDEX
*            BLOCK. 
* 
*         3. IF INSERTING WITHIN A FULL INDEX BLOCK, THE
*            LAST INDEX OF THE CURRENT BLOCK IS MOVED TO
*            THE NEXT INDEX BLOCK, AND THE NEW INDEX IS 
*            INSERTED INTO THE CURRENT INDEX BLOCK. 
* 
*         4. IF THE CURRENT INDEX BLOCK IS FULL AND NOT 
*            LINKED, OR IT IS LINKED BUT THAT BLOCK IS FULL,
*            A NEW INDEX BLOCK IS CREATED.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER FOR INSERT.
*                (PB) = ENTRY BUFFER ADDRESS. 
*                (T7) = OVERFLOW BUFFER ADDRESS.
* 
*         EXIT   (BA) = UNCHANGED.
*                (BP) = BUFFER POINTER. 
*                (PB) = OVERFLOW BUFFER ADDRESS.
*                (A)  = 0 IF NO OVERFLOW INTO SUBSEQUENT BLOCK. 
* 
*         USES   T5 - T6. 
* 
*         CALLS  ABC, GIB, GNL, GPL, IDE, MBP, PLI, WRP.
* 
*         MACROS ERROR, MMOVE.
  
  
 IIE2     RJM    WRP         WRITE RANDOM PRU 
          RJM    GNL         GET NEXT LINK
          ZJN    IIE5        IF BLOCK NOT LINKED
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWUW,BA
          SBM    CWEL,BA
          PJN    IIE6        IF ROOM IN THIS BLOCK
          RJM    GPL         GET PREVIOUS LINK
          NJN    IIE4        IF BLOCK LINKED
 IIE3     ERROR  CLE         *CATALOG LINKAGE ERROR.* 
  
 IIE4     RJM    GIB         GET INITIAL BLOCK
 IIE5     LDM    CWRT,BA     SET RECORD TYPE/LEVEL
          STM    IIEB 
          LDM    CWEL,BA     SET ENTRY LENGTH 
          STM    IIEC 
          LDN    CWRI        DECLARE LINKAGE BYTE 
          RJM    ABC         ADD BLOCK TO CHAIN 
          LDC    ** 
 IIEB     EQU    *-1         (RECORD TYPE/LEVEL)
          STM    CWRT,BA
          LDC    ** 
 IIEC     EQU    *-1         (ENTRY LENGTH) 
          STM    CWEL,BA
 IIE6     LDM    CWFE,BA     POSITION TO FIRST INDEX
          RJM    MBP         MOVE BUFFER POINTER
          LDC    ** 
 IIED     EQU    *-1         (FWA OF BUFFER CONTAINING DATA)
          STD    PB 
          RJM    IDE         INSERT DATA ENTRY
          RJM    WRP         WRITE RANDOM PRU 
          LDC    IIEX 
          STM    IIEA 
  
 IIE      SUBR               ENTRY/EXIT 
          LDM    CWUW,BA
          SBM    CWEL,BA
          PJP    IIE1        IF ROOM IN THIS BLOCK
          LDD    BP 
          STD    T5 
          LDD    PB 
          STM    IIED 
          RJM    PLI         POSITION TO LAST INDEX 
          SBD    T5 
          MJP    IIE2        IF INSERT BEYOND LAST ENTRY
          LDM    CWEL,BA     FILL OVERFLOW BUFFER 
          STD    T6 
          SHN    2
          RAD    T6 
          SHN    1
          STD    T6 
          MMOVE  ,BP,,T7,,T6
          SOM    CWNE,BA     ADJUST HEADER CONTROL WORD 
          LDM    CWEL,BA
          RAM    CWUW,BA
          LDD    T5          RESET BUFFER POINTER 
          STD    BP 
          LDC    IIE2 
          STM    IIEA 
          LDD    T7 
          STM    IIED 
 IIE1     RJM    IDE         INSERT DATA ENTRY
          RJM    WRP         WRITE RANDOM PRU 
          LDN    0
          LJM    IIEX        RETURN 
 IIEA     EQU    *-1         (TO IIE2 IF GENERATING NEW INDEX BLOCKS) 
  
  
 ABC$     EQU    1           DEFINE ABC - ADD BLOCK TO CHAIN
 GEP$     EQU    1           DEFINE GEP - GENERATE EMPTY PRU
 GNL$     EQU    1           DEFINE GNL - GET NEXT BLOCK LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS BLOCK LINK 
 IDE$     EQU    1           DEFINE IDE - INSERT DATA ENTRY 
 LNB$     EQU    1           DEFINE LNB - LINK NEXT BLOCK 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 WES$     EQU    1           DEFINE WES - WRITE EOR/EOI SEQUENCE
 IIE$     ENDIF 
 PCE$     IF     DEF,PCE$ 
 PCE      SPACE  4,10 
**        PCE - PURGE CATALOG/ADMIT ENTRIES.
* 
*         ENTRY  (CPCB - CPCB+4) = CATALOG POINTERS.
* 
*         USES   RI - RI+1. 
* 
*         CALLS  DDE, DLB, RRP, UIS, VSP, WRP.
* 
*         MACROS CLEAR, ERROR, LDA, RESTP.
  
  
 PCE      SUBR               ENTRY/EXIT 
          RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
 PCE1     LDA    CBAE,BP     SET FIRST ADMIT BLOCK
          ZJP    PCE3        IF NO ADMIT BLOCKS 
 PCE2     STD    RI+1        DELINK ADMIT BLOCK(S)
          SHN    -14
          STD    RI 
          LDC    BUF0 
          STD    BA 
          RJM    RRP         READ RANDOM PRU (ADMIT)
          LDM    CWRI+1,BA
          STM    PCEA+1 
          LDM    CWRI,BA
          LPN    77 
          LMC    LDCI 
          STM    PCEA 
          RJM    DLB         DELINK BLOCK 
          LDC    ** 
 PCEA     EQU    *-2         (NEXT BLOCK RANDOM INDEX)
          NJN    PCE2        IF LINKED ADMIT BLOCK
          RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
 PCE3     LDM    CBNC,BP     SET NEXT CATALOG (MULTI-FILE)
          SHN    14 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDM    CBNC+1,BP
          STM    CPCB+4 
          CLEAR  ,BP,TCEL*10D  CLEAR ENTRY (CATALOG)
          LDM    CWEL,BA
          RAM    CWUW,BA
          SOM    CWNE,BA
          ZJN    PCE6        IF EMPTY CATALOG BLOCK 
          RJM    WRP         WRITE RANDOM PRU 
 PCE4     RESTP  CPCB        RESTORE CATALOG POINTERS (NEXT)
          LDD    CI 
          ZJP    PCEX        IF END OF SET
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    PCE5        IF INCORRECT POINTER 
          LDD    BP          SAVE BUFFER POINTER
          STM    CPCB+1 
          LJM    PCE1        CONTINUE CATALOG SET 
  
 PCE5     ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 PCE6     LDM    CWBI,BA     DELETE USERS CATALOG BLOCK 
          LPN    77 
          LMC    LDCI 
          STM    PCEC 
          LDM    CWBI+1,BA
          STM    PCEC+1 
          LDM    CWRI,BA
          LPN    77 
          LMC    LDCI 
          STM    PCED 
          LDM    CWRI+1,BA
          STM    PCED+1 
          RJM    DLB         DELINK BLOCK 
          LDC    ** 
 PCEC     EQU    *-2
          NJP    PCE4        IF NOT FIRST BLOCK OF CHAIN
          LDC    PBUN        SET KEY ADDRESS
          STD    KA 
          RJM    UIS         USERNAME INDEX SEARCH
          ZJN    PCE7        IF USERNAME FOUND
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PCE7     LDM    UBCI,BP     CLEAR CATALOG POINTER
          SCN    77 
          STM    UBCI,BP
          LDN    0
          STM    UBCI+1,BP
          LDC    **          CHECK FOR INDEX UPDATE 
 PCED     EQU    *-2         (RANDOM INDEX TO NEXT CATALOG BLOCK) 
          ZJN    PCE9        IF LAST CATALOG BLOCK
          STM    UBCI+1,BP
          SHN    -14
          RAM    UBCI,BP
 PCE8     RJM    WRP         WRITE RANDOM PRU 
          LJM    PCE4        CHECK FOR MULTI-FILE 
  
 PCE9     RJM    DDE         DELETE DATA ENTRY
          LDM    CWNE,BA
          NJN    PCE8        IF SECONDARY INDEX NOT EMPTY 
          RJM    DLB         DELINK BLOCK 
          RESTP  CPPI        SWAP TO PRIMARY INDEX BUFFER 
          RJM    DDE         DELETE DATA ENTRY
          LDM    CWNE,BA
          NJN    PCE8        IF PRIMARY INDEX NOT EMPTY 
          RJM    DLB         DELETE DATA BLOCK
          LJM    PCEX        RETURN 
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK BLOCK
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEX SEARCH 
 PCE$     ENDIF 
 RSP$     IF     DEF,RSP$ 
 RSP      SPACE  4,10 
**        RSP - RELEASE VSN(S) TO SCRATCH POOL. 
* 
*         ENTRY  (CPSB - CPSB+4) = *TMST* POINTERS. 
*                (CPSI - CPSI+4) = VSN INDEX BUFFER POINTERS. 
* 
*         USES   KA, RI - RI+1. 
* 
*         CALLS  RRP, SSP, VIS, WRP.
* 
*         MACROS CLEAR, ERROR, MMOVE, MONITOR, RESTP, SAVEP.
  
  
 RSP      SUBR               ENTRY/EXIT 
          RESTP  CPSI        RESTORE BUFFER POINTERS (VSN INDEX)
          LDM    VBST+1,BP   GET STATUS 
          SHN    -5 
          LPN    ACVS/40+CTVS/40  DETERMINE TAPE TYPE 
          RJM    SSP         SET SCRATCH POOL ADDRESS 
          LDM    RSPB,T3     SET ADDRESS OF COPY OF SCRATCH POOL WORD 
          STM    RSPA 
          STD    T2 
          LDM    3,T2        SAVE SCRATCH COUNT 
          STM    PVSN+3 
          LDM    4,T2 
          STM    PVSN+4 
 RSP0     LDM    VBST+1,BP
          LPC    SVVS 
          STM    RSPF 
          MMOVE  VBES,BP,PVSN,,VSKL 
 RSP1     LDC    PESN 
          STD    KA 
          MMOVE  VBNV,BP,,KA,VSKL  SAVE NEXT VSN
          LDN    0           RELEASE VSN(S) 
          STM    VBCI,BP
          STM    VBCI+1,BP
          CLEAR  VBFV,BP,2*10D
          LDA    VBST,BP
          LPC    777777&RTVS&ASVS&EOIV&VIVS 
          STM    VBST+1,BP
          SHN    -14
          STM    VBST,BP
          LDM    VBRD,BP     CLEAR RELEASE DATE 
          SCN    77 
          STM    VBRD,BP
          LDN    0
          STM    VBRD+1,BP
          LDC    ** 
 RSPF     EQU    *-1         (SYSTEM TAPE FLAG) 
          NJN    RSP1.1      IF SYSTEM TAPE 
          MMOVE  ,KA,VBNV,BP,VSKL  RESTORE NEXT VSN 
          LDN    ASVS/1S12   SET AVAILABLE SCRATCH
          RAM    VBST,BP
          AOM    PVSN+4      INCREMENT SCRATCH COUNT
          SHN    -14
          RAM    PVSN+3 
 RSP1.1   LDI    KA 
          ZJN    RSP2        IF END OF SET
          RJM    WRP         WRITE RANDOM PRU 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    RSP1.2      IF VSN NOT FOUND 
          LDM    RSPF 
          ZJP    RSP1        IF SCRATCH TAPE PROCESSED
          UJP    RSP0        SET SYSTEM/SCRATCH FLAG
  
 RSP1.2   ERROR  EID         *ERROR IN INDEX DATA.* 
  
 RSP2     LDM    RSPF 
          NJN    RSP2.1      IF SYSTEM TAPE ONLY - NO SCRATCH 
          LDC    **          ADDRESS OF FIRST SCRATCH VSN FOR TAPE TYPE 
 RSPA     EQU    *-1
          STD    T1 
          MMOVE  ,,VBNV,BP,VSKL 
 RSP2.1   RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPSB        RESTORE *TMST* POINTERS
          RJM    RRP         READ RANDOM PRU (TMST) 
          LDM    RSPF 
          NJN    RSP3        IF SYSTEM TAPE ONLY
          LDM    SCRP        ADDRESS OF TMST SCRATCH WORD FOR TAPE TYPE 
          ADD    BP 
          STD    T2 
          MMOVE  PVSN,,,,10D
          RJM    WRP         WRITE RANDOM PRU 
          LDN    ZERL        ENTER TMS EVENT (SCRATCH)
          CRD    CM 
          LDN    ESVB 
          STD    CM+4 
          MONITOR EATM
 RSP3     LJM    RSPX        RETURN 
  
  
 RSPB     BSS    0           ADDRESSES OF COPIES OF SCRATCH POOL WORDS
          CON    RSPC        *MT*/*NT* SCRATCH POOL WORD
          CON    RSPD        *CT* SCRATCH POOL WORD 
          CON    0
          CON    RSPE        *AT* SCRATCH POOL WORD 
  
 RSPC     BSS    5           *MT*/*NT* FIRST SCRATCH VSN, SCRATCH COUNT 
 RSPD     BSS    5           *CT* FIRST SCRATCH VSN, SCRATCH COUNT
 RSPE     BSS    5           *AT* FIRST SCRATCH VSN, SCRATCH COUNT
  
 ISP$     EQU    1           DEFINE ISP - INITIALIZE SCRATCH PROCESSOR
 SSP$     EQU    1           DEFINE SSP - SET SCRATCH POOL ADDRESS
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 RSP$     ENDIF 
 SCB$     IF     DEF,SCB$ 
 SCB      SPACE  4,10 
**        SCB - SEARCH CATALOG BUFFER.
* 
*         ENTRY  (KA) = KEY ADDRESS (FILE NAME).
*                     = 0 IF SEARCHING FOR HOLE.
*                (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM ADDRESS TO FIRST BLOCK. 
* 
*         EXIT   (A) = 0 IF CATALOG NOT FOUND.
*                    = CATALOG INDEX IF FILE FOUND. 
*                    = -0 IF DUPLICATE FILE NAME. 
*                (BA) = ADDRESS OF BUFFER CONTAINING CATALOG. 
*                (BP) = FWA OF CATALOG. 
*                (CI) = CATALOG INDEX.
*                (HP) = ADDRESS OF BUFFER CONTAINING HOLE.
*                (HP+1) = FWA OF HOLE.
* 
*         CALLS  GIB, GNB, GNL, MBP, RRP. 
* 
*         MACROS COMPARE, RESTP, SAVEP. 
  
  
 SCB      SUBR               ENTRY/EXIT 
          LDN    ZERL        INITIALIZE HOLE POINTER
          CRM    CPCB,ON
          SBN    1
          CRM    CPHP,ON
          RJM    GIB         GET INITIAL BLOCK
 SCB1     LDM    CWFE,BA     SET FIRST CATALOG ENTRY
          RJM    MBP         MOVE BUFFER POINTER
          LDN    0           INITIALIZE CATALOG INDEX 
          STD    CI 
 SCB2     AOD    CI          CHECK CATALOG
          LDI    BP 
          NJN    SCB4        IF NOT HOLE
          LDM    CPHP 
          NJN    SCB3        IF HOLE ALREADY FOUND
          SAVEP  CPHP        SAVE HOLE POINTER
          LDD    KA 
          ZJP    SCBX        IF SEARCHING FOR HOLE
 SCB3     UJN    SCB5        CHECK FOR END OF BUFFER
  
 SCB4     LDD    KA          CHECK SEARCH TYPE
          ZJN    SCB5        IF SEARCHING FOR HOLES 
          LDM    CBST,BP
          LPN    4
          ZJN    SCB5        IF NOT SYMBOLIC ACCESS FILE
          COMPARE  CBLI,BP,,KA,FIKL 
          ZJN    SCB6        IF FILE NAME 
 AMD$     IF     DEF,AMD$ 
          COMPARE  CBLI,BP,PNFI,,FIKL 
          ZJN    SCB7        IF NEW FILENAME FOUND
 AMD$     ENDIF 
 SCB5     LDN    TCEL        ADVANCE TO NEXT CATALOG
          RJM    MBP         MOVE BUFFER POINTER
          PJP    SCB2        IF WITHIN CURRENT BUFFER 
          RJM    GNL         GET NEXT LINK
          ZJN    SCB8        IF BLOCK NOT LINKED
          RJM    GNB         GET NEXT BLOCK 
          LJM    SCB1        SEARCH LINKED BLOCK
  
 SCB6     SAVEP  CPCB        SAVE BUFFER POINTERS (CATALOG) 
 AMD$     IF     DEF,AMD$ 
          LDM    PNFI 
          NJN    SCB5        IF NEW FILENAME SPECIFIED
          UJN    SCB9        RETURN 
  
 SCB7     MMOVE  PNFI,,POFI,,FIKL 
          LCN    0           FILE ALREADY RESERVED
          UJN    SCB10       RETURN 
 AMD$     ELSE
          UJN    SCB9        RETURN 
 AMD$     ENDIF 
  
 SCB8     LDM    CPCB        RESET BUFFER POINTERS
          ZJN    SCB10       IF CATALOG NOT FOUND 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          RJM    RRP         READ RANDOM PRU
 SCB9     LDD    CI          SET EXIT CONDITION 
 SCB10    LJM    SCBX        RETURN 
  
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 SCB$     ENDIF 
          TITLE  COMPTFM - SUBORDINATE SUBROUTINES. 
 ABC$     IF     DEF,ABC$ 
 ABC      SPACE  4,10 
**        ABC - ADD BLOCK TO CHAIN. 
* 
*         ENTRY  (A) = WORD IN PP BUFFER FOR BLOCK LINKAGE. 
*                (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM INDEX FOR CURRENT BLOCK.
  
  
 ABC      SUBR               ENTRY/EXIT 
          STM    LNBC        SET FWA FOR BLOCK LINKAGE
          ADN    1
          STM    LNBB 
          LDD    RI          SET BACKWARD POINTER 
          LMC    LDCI 
          STM    LNBD 
          LDD    RI+1 
          STM    LNBD+1 
          LDM    CWRI,BA     SET FORWARD POINTER
          LMC    LDCI 
          STM    LNBF 
          LDM    CWRI+1,BA
          STM    LNBF+1 
          RJM    LNB         LINK NEXT BLOCK
          UJN    ABCX        RETURN 
 ABC$     ENDIF 
 BSE$     IF     DEF,BSE$ 
 BSE      SPACE  4,10 
**        BSE - BACKWARD SKIP ONE ENTRY.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER. 
*                (CI) = CATALOG INDEX.
* 
*         EXIT   (BA) = BUFFER ADDRESS (UNCHANGED). 
*                (BP) = BUFFER POINTER (UPDATED). 
*                (CI) = CATALOG INDEX (UPDATED).
* 
*         USES   T1, CP, CI.
  
  
 BSE      SUBR               ENTRY/EXIT 
          LDM    CWFE,BA     CHECK BUFFER FOR ENTRY 
          STD    T1 
          SHN    2
          RAD    T1 
          ADN    2
          ADD    BA 
          SBD    BP 
          ZJN    BSEX        IF POSITIONED AT FIRST ENTRY 
          LDM    CWEL,BA     DECREMENT BUFFER POINTER 
          STD    T1 
          SHN    2
          RAD    T1 
          LMC    -0 
          RAD    BP 
          SOD    CI 
          UJN    BSEX        RETURN 
 BSE$     ENDIF 
 CMV$     IF     DEF,CMV$ 
 CMV      SPACE  4,15 
**        CMV - COMPARE/MOVE CHARACTER STRING.
* 
*         ENTRY  (A) = COMPARE LENGTH IN PP BYTES.
*                (T1) = SOURCE ADDRESS FOR COMPARE. 
*                (T2) = OBJECT ADDRESS FOR COMPARE. 
*                (T3) = PRESET TO ZERO(OR FROM PREVIOUS *CMOVE*). 
* 
*         EXIT   (A) = (T3) = 0 IF NAME(T1) = NAME(T2). 
*                    .NE. 0 IF NAME(T1) .NE. NAME(T2).
* 
*         USES   T0 - T3. 
  
  
 CMV      SUBR               ENTRY/EXIT 
          STD    T0          SAVE PP BYTE COUNT 
 CMV1     LDI    T1          COMPARE BYTES
          LMI    T2 
          ZJN    CMV2        IF BYTE(T1) .NE. BYTE(T2)
          AOD    T3          COUNT THE DIFFERENCES
 CMV2     LDI    T1 
          STI    T2 
          AOD    T1          INCREMENT TO NEXT BYTE 
          AOD    T2 
          SOD    T0          DECREMENT PP BYTE COUNT
          NJN    CMV1        IF NOT THROUGH WITH STRINGS
          LDD    T3 
          UJN    CMVX        RETURN 
 CMV$     ENDIF 
 CSN$     IF     DEF,CSN$ 
 CSN      SPACE  4,10 
**        CSN - CONVERT SEQUENCE NUMBER TO DISPLAY CODE.
* 
*         ENTRY  (A) = SEQUENCE NUMBER. 
* 
*         EXIT   DISPLAY CODE OF SEQUENCE NUMBER STORE IN *IAMA*. 
* 
*         USES   T1.
* 
*         CALLS  C2D. 
  
  
 CSN      SUBR               ENTRY/EXIT 
          STD    T1 
          SHN    -11
          RJM    C2D         CONVERT 2 OCTAL DIGITS 
          STM    IAMA+13
          LDD    T1 
          SHN    -3 
          RJM    C2D         CONVERT 2 OCTAL DIGITS 
          STM    IAMA+14
          LDD    T1 
          LPN    7
          SHN    6
          ADC    2R0/ 
          STM    IAMA+15
          UJN    CSNX        RETURN 
 CSN$     ENDIF 
 FAM$     IF     DEF,FAM$ 
 FAM      SPACE  4,10 
**        FAM - FORMAT ACCOUNT FILE MESSAGE.
* 
*         *FAM*  FORMATS THE ACCOUNT FILE MESSAGES FOR *IAM* AND *IRM*. 
* 
*         ENTRY  (A) = 0 IF RESERVE MESSAGE TO BE ISSUED. 
*                    .NE. 0 IF RELEASE MESSAGE TO BE ISSUED.
*                (CM - CM+4) = * YY/MM/DD.* IF CONDITIONAL RELEASE. 
*                            = 0, IF UNCONDITIONAL RELEASE. 
*                (CSNA - CSNA+2) = DISPLAY CODE FOR SEQUENCE NUMBER.
*                (PBUN - PBUN+3) = TAPE OWNER USERNAME. 
*                (PFAM - PFAM+3) = TAPE OWNER FAMILY NAME.
*                (PESN - PESN+2) = FIRST TAPE VSN.
*                (PVSN - PVSN+2) = CURRENT TAPE VSN.
* 
*         EXIT   (A) = 0, IF MESSAGE ENDED ON PP WORD BOUNDARY. 
*                    .NE. 0, IF TO USE LOWER SIX BITS FOR PERIOD. 
*                (T2) = POINTER TO LWA OF MESSAGE FORMATTED.
* 
*         USES   T0 - T3. 
* 
*         MACROS MMOVE. 
  
  
 FAM      SUBR               ENTRY/EXIT 
          STD    T0          SAVE RESERVE/RELEASE FLAG
          LDC    IAMA+3      SET POINTER TO FAMILY NAME 
          STD    T2 
          MMOVE  PFAM,,,,7
          AOD    T2 
          MMOVE  PBUN,,,,7
          LDI    T2 
          SCN    77 
          ADN    1R/
          STI    T2 
          LDN    4           SKIP OVER SEQUENCE NUMBER
          RAD    T2 
          MMOVE  PESN,,,,6
          LDC    2R,
          STI    T2 
          AOD    T2 
          LDD    T0          CHECK IF RESERVE 
          ZJN    FAM2        IF RESERVE 
          LDD    CM 
          ZJN    FAM1.1      IF UNCONDITIONAL RELEASE 
          MMOVE  CM,,,,11 
 FAM1     UJP    FAMX        RETURN 
  
 FAM1.1   SOD    T2          SET NO PARAMETER AT END OF MESSAGE 
          LDN    0
          STI    T2 
          UJN    FAM1        RETURN 
  
 FAM2     MMOVE  PVSN,,,,6
          UJN    FAM1        RETURN 
 FAM$     ENDIF 
 GEP$     IF     DEF,GEP$ 
 GEP      SPACE  4,10 
**        GEP - GENERATE EMPTY PRU. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
  
  
 GEP      SUBR               ENTRY/EXIT 
          LDD    BA 
          ADN    2
          STD    BP 
          STD    T1 
          CLEAR  ,,64D*10D
          LDD    HN 
          STM    CWWC,BA
          LDK    RTSB*100    SET RECORD TYPE
          STM    CWRT,BA
          LDN    64D-4       SET UNUSED WORD COUNT
          STM    CWUW,BA
          LDN    0
          STM    CWEL,BA
          STM    CWNE,BA
          LDN    TBHL        SET FIRST DATA WORD
          STM    CWFE,BA
          UJP    GEPX        RETURN 
 GEP$     ENDIF 
 GNB$     IF     DEF,GNB$ 
 GNB      SPACE  4,10 
**        GNB - GET NEXT BLOCK. 
* 
*         ENTRY  (CTSB, CTSB+1) = CATALOG FST ADDRESS.
*                (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM INDEX.
*                (CPRI - CPRI) = CURRENT POSITION.
* 
*         EXIT   (A) = RANDOM INDEX OF CURRENT BLOCK. 
*                (CPRI - CPRI+1) = CURRENT POSITION.
* 
*         USES   CPRI - CPRI+1. 
* 
*         CALLS  RRP. 
* 
*         MACROS ERROR. 
  
  
 GNB2     LDD    RI          SET CURRENT FILE POSITION
          STM    CPRI 
          SHN    14 
          LMD    RI+1 
          STM    CPRI+1 
  
 GNB      SUBR               ENTRY/EXIT 
          RJM    RRP         READ RANDOM PRU
          LDD    BA 
          ADN    2
          STD    BP 
          LDM    CWBI,BA
          LMM    CPRI 
          NJN    GNB1        IF INCORRECT LINKAGE 
          LDM    CWBI+1,BA
          LMM    CPRI+1 
          ZJN    GNB2        IF VALID LINKAGE 
 GNB1     ERROR  CLE         *CATALOG LINKAGE ERROR.* 
 GNB$     ENDIF 
 GNL$     IF     DEF,GNL$ 
 GNL      SPACE  4,10 
**        GNL - GET NEXT LINK.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
* 
*         EXIT   (A) = 1 IF BLOCK LINKED. 
*                (A) = 0 IF BLOCK NOT LINKED. 
*                (RI - RI+1) = RANDOM INDEX OF NEXT BLOCK.
* 
*         USES   RI - RI+1. 
  
  
 GNL      SUBR               ENTRY/EXIT 
          LDA    CWRI,BA
          ZJN    GNLX        IF BLOCK NOT LINKED
          STD    RI+1 
          SHN    -14
          STD    RI 
          LDN    1
          UJN    GNLX        RETURN 
 GNL$     ENDIF 
 GPL$     IF     DEF,GPL$ 
 GPL      SPACE  4,10 
**        GPL - GET PREVIOUS LINK.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
* 
*         EXIT   (A) = 1 IF BLOCK LINKED. 
*                (A) = 0 IF BLOCK NOT LINKED. 
*                (RI - RI+1) = RANDOM INDEX TO PREVIOUS BLOCK.
* 
*         USES   RI - RI+1. 
  
  
 GPL      SUBR               ENTRY/EXIT 
          LDA    CWBI,BA
          ZJN    GPLX        IF BLOCK NOT LINKED
          STD    RI+1 
          SHN    -14
          STD    RI 
          LDN    1
          UJN    GPLX        RETURN 
 GPL$     ENDIF 
 IBC$     IF     DEF,IBC$ 
 IBC      SPACE  4,10 
**        IBC - INITIALIZE BLOCK CHAIN. 
* 
  
  
 IBC      SUBR               ENTRY/EXIT 
          AOM    LNBA        BYPASS WRITE OF CURRENT BLOCK
          LDC    LDCI*100 
          STM    LNBD+1 
          STM    LNBF+1 
          SHN    -6 
          STM    LNBD 
          STM    LNBF 
          RJM    LNB         LINK NEXT BLOCK
          UJN    IBCX        RETURN 
 IBC$     ENDIF 
 IDE$     IF     DEF,IDE$ 
 IDE      SPACE  4,10 
**        IDE - INSERT DATA ENTRY.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER FOR INSERT.
*                (PB) = PARAMETER BLOCK ADDRESS FOR DATA ENTRY. 
  
  
 IDE      SUBR               ENTRY/EXIT 
          LDI    BP          CHECK FOR EMPTY ENTRY
          ZJN    IDE1        IF EMPTY ENTRY 
          LDM    CWEL,BA     MOVE ENTRIES DOWN
          SHN    14 
          LMM    CWNE,BA
          RJM    MLT         (A) REGISTER MULTIPLY
          ADM    CWFE,BA
          STD    T1          CONVERT TO BYTES 
          SHN    2
          RAD    T1 
          AOD    T1 
          LDD    BA          BIAS BY BUFFER ADDRESS 
          RAD    T1 
          SBD    BP          SET BYTE COUNT FOR MOVE
          ADN    1
 IDE1     ZJN    IDE3        IF BLOCK MOVE NOT NECESSARY
          STD    T0 
          LDM    CWEL,BA     SET FWA OF DESTINATION 
          STD    T2 
          SHN    2
          RAD    T2 
          LDD    T1 
          RAD    T2 
 IDE2     LDI    T1          MOVE BLOCK LOOP
          STI    T2 
          SOD    T1 
          SOD    T2 
          SOD    T0 
          NJN    IDE2        IF MORE TO MOVE
 IDE3     LDD    PB          ENTER DATA 
          STD    T1 
          LDD    BP 
          STD    T2 
          LDM    CWEL,BA
          STD    T0 
          SHN    2
          RAD    T0 
 IDE4     LDI    T1          MOVE DATA LOOP 
          STI    T2 
          AOD    T1 
          AOD    T2 
          SOD    T0 
          NJN    IDE4        IF MORE TO MOVE
          AOM    CWNE,BA     UPDATE BLOCK CONTROL WORDS 
          IF     DEF,RIB$,2 
          RJM    RIB         ROOM IN BLOCK
          SKIP   2
          LDM    CWUW,BA
          SBM    CWEL,BA
          STM    CWUW,BA
          LJM    IDEX        RETURN 
 IDE$     ENDIF 
 IRS$     IF     DEF,IRS$ 
 IRS      SPACE  4,15 
**        IRS - ISSUE *TMS* RECOVERY MESSAGES SUBROUTINE. 
* 
*         ENTRY  (A) = 0, IF ON A WORD BOUNDARY.
*                    .NE. 0, IF TO USE LOWER SIX BITS FOR PERIOD. 
* 
*         EXIT   (T2) = RESET FOR NEXT MESSAGE BUILD. 
*                (IAMA+1) = INCREMENTED TO NEXT MESSAGE ID. 
*                MESSAGE ISSUED TO ACCOUNT FILE.
* 
*         USES   T0 - T4. 
* 
*         CALLS  DFM, SCC.
  
  
 IRS1     LDI    T2 
          SCN    77 
          ADN    1R.
 IRS2     STI    T2 
          LDN    0           TERMINATE MESSAGE
          STM    1,T2 
          LDN    1R 
          STD    T3 
          LDC    IAMA+1 
          STD    T4 
          RJM    SCC         SPACE-FILL DAYFILE MESSAGE 
          LDC    TMSG+IAMA   ISSUE RECOVERY MESSAGES
          IFNE   TMSG,0,1 
          RJM    DFM
          AOM    IAMA+1      INCREMENT ACCOUNT MESSAGE IDENT
          LDC    IAMA+7      SETUP FOR *MMOVE* MACRO
          STD    T2 
  
 IRS      SUBR               ENTRY/EXIT 
          NJN    IRS1        IF NOT ON A WORD BOUNDARY
          LDC    5700        (.:) 
          UJN    IRS2        FINISH PROCESSING
  
 SCC$     EQU    1           DEFINE SCC - SUBSTITUTE CHAR. FOR COLON
 IRS$     ENDIF 
 SCC$     IF     DEF,SCC$ 
 SCC      SPACE  4,15 
**        SCC - SUBSTITUTE CHARACTER FOR COLON. 
* 
*         ENTRY  (T2) = LAST CHARACTER TO CHECK FOR SUBSTITUTION. 
*                (T3) = CHARACTER TO SUBSTITUTE FOR COLONS. 
*                (T4) = FWA OF STRING TO CHECK FOR COLONS.
* 
*         EXIT   (A) = (T0) = 0, IF CHARACTER IN STRING MATCHES 
*                                SUBSTITUTION CHARACTER.
*                           .NE. 0, IF NO MATCHES FOUND.
* 
*         USES   T0, T2.
  
  
 SCC5     LMD    T3 
          NJN    SCC6        IF NO MATCH WITH SUBSTITUTION CHARACTER
          STD    T0          SET MATCH FLAG 
 SCC6     SOD    T2          DECREMENT TO NEXT BYTE 
          SBD    T4 
          PJN    SCC1        IF NOT THROUGH CHECKING ALL CHARACTERS 
          LDD    T0 
  
 SCC      SUBR               ENTRY/EXIT 
          LDN    1           SET T0 NON-ZERO
          STD    T0 
 SCC1     LDI    T2          GET CHARACTER TO CHECK 
          SHN    -6 
          NJN    SCC4        IF CHARACTER IS NOT A COLON
          LDD    T3 
          SHN    6
          RAI    T2 
 SCC2     LDI    T2          GET NEXT CHARACTER TO CHECK
          LPN    77 
          NJP    SCC5        IF CHARACTER IS NOT A COLON
          LDD    T3 
          RAI    T2 
          UJP    SCC6        CHECK NEXT BYTE
  
 SCC4     LMD    T3 
          NJN    SCC2        IF NO MATCH WITH SUBSTITUTION CHARACTER
          STD    T0          SET MATCH FLAG 
          UJP    SCC2        CHECK NEXT CHARACTER 
  
 SCC$     ENDIF 
 ISK$     IF     DEF,ISK$ 
 ISK      SPACE  4,10 
**        ISK - INDEX SEARCH FOR KEY. 
* 
*         ENTRY  (KA) = KEY ADDRESS.
*                (RI - RI+1) = RANDOM INDEX OF PRIMARY INDEX. 
* 
*         EXIT   (A) .EQ. 0 IF FOUND. 
*                    .GT. 0 IF NOT FOUND. 
*                    .EQ. -0 IF END OF INDEX. 
*                (CPPI) = BUFFER ADDRESS OF PRIMARY INDEX.
*                (CPPI+4) = BUFFER POINTER OF PRIMARY INDEX.
*                (CPSI) = BUFFER ADDRESS OF SECONDARY INDEX.
*                (CPSI+4) = BUFFER POINTER OF SECONDARY INDEX.
* 
*         USES   CPPI - CPPI+4, CPSI - CPSI+4, RI - RI+1. 
* 
*         CALLS  BSE, GIB, GNB, GNL, GPL, MBP, PLI, SIB, TBA. 
* 
*         MACROS CLEAR, ERROR, SAVEP. 
  
  
 ISK6     STM    ISKA+1      SAVE EXIT CONDITION
          SHN    -14
          LMC    LDCI 
          STM    ISKA 
          SAVEP  CPSI        SAVE SECONDARY POINTERS
          LDC    ** 
 ISKA     EQU    *-2         (EXIT CONDITION) 
  
 ISK      SUBR               ENTRY/EXIT 
          CLEAR  CPPI,,2*10D
          RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GIB         GET INITIAL BLOCK
 ISK1     LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          RJM    SIB         SEARCH INDEX BUFFER
          ZJN    ISK4        IF KEY FOUND IN PRIMARY INDEX
          PJN    ISK2        IF POSSIBLE MATCH
          RJM    GNL         GET NEXT LINK
          ZJN    ISK2        IF BLOCK NOT LINKED
          RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GNB         GET NEXT BLOCK 
          UJN    ISK1        SEARCH PRIMARY INDEX 
  
 ISK2     RJM    BSE         BACK SPACE ONE ENTRY 
          NJN    ISK4        IF NOT FIRST ENTRY 
          RJM    GPL         GET PREVIOUS LINK
          NJN    ISK3        IF BLOCK NOT LINKED
          LCN    0           SET END OF INDEX 
          LJM    ISKX        RETURN 
  
 ISK3     RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    PLI         POSITION TO LAST INDEX 
 ISK4     SAVEP  CPPI        SAVE PRIMARY POINTERS
          LDM    3,BP        SET SECONDARY INDEX R.I. 
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    4,BP 
          STD    RI+1 
          NJN    ISK5        IF SECONDARY INDEX 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 ISK5     RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          RJM    SIB         SEARCH INDEX BUFFER
          LJM    ISK6        RETURN 
 ISK$     ENDIF 
 ISP$     IF     DEF,ISP$ 
 ISP      SPACE  4,10 
**        ISP - INITIALIZE SCRATCH PROCESSOR. 
* 
*         SETS THE CURRENT SCRATCH VSN AND SCRATCH COUNT FOR EACH TAPE
*         TYPE IN CELLS AVAILABLE TO ROUTINE *RSP* IN THIS OVERLAY. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS (TMST).
*                (BP) = BUFFER POINTER (TMST).
*                BUFFER LOADED FROM PRESET. 
* 
*         EXIT   (RSPC - RSPC+4) = *MT*/*NT* FIRST SCRATCH VSN, COUNT 
*                (RSPD - RSPD+4) = *CT* FIRST SCRATCH VSN, COUNT
*                (RSPE - RSPE+4) = *AT* FIRST SCRATCH VSN, COUNT
* 
*         MACROS MMOVE. 
  
  
 ISP      SUBR               ENTRY/EXIT 
          MMOVE  SBSM,BP,RSPC,,10D
          MMOVE  SBSC,BP,RSPD,,10D
          MMOVE  SBSA,BP,RSPE,,10D
          UJN    ISPX        RETURN 
 ISP$     ENDIF 
 LNB$     IF     DEF,LNB$ 
 LNB      SPACE  4,10 
**        LNB - LINK NEXT BLOCK.
* 
*         ENTRY  (CO) = CATALOG FST ADDRESS.
*                (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM INDEX OF BLOCK TO LINK. 
* 
*         EXIT   BUFFER (BA) LOADED AND INITIALIZED.
*                CONTROL WORDS UPDATED. 
* 
*         USES   FS - FS+4, RI - RI+1, T5 - T5+4. 
* 
*         CALLS  GEP, MBP, RRP, SEI, SRA, WES, WRP. 
* 
*         MACROS LDA. 
  
  
 LNB      SUBR               ENTRY/EXIT 
          LDA    CPEB,ABS    GET EMPTY BLOCK POINTER
          NJP    LNB2        IF EXISTING EMPTY PRU
          AOM    LNBE        SET WRITE EOI SECTOR 
          AOM    LNBH        SET NO HOLE POINTER UPDATE 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    FS 
          LDD    EQ 
          STD    T5 
          LDD    TK 
          STD    T6 
          RJM    SEI         SEARCH FOR END OF INFORMATION
          LDD    T6          SAVE EOI TRACK 
          STD    FS+3 
          LDD    T7          SAVE EOI SECTOR
          STD    FS+4 
          LDD    TK          SET FIRST TRACK
          RJM    SRA         SET RANDOM ADDRESS 
          ZJN    LNB1        IF TRACK/SECTOR VALID
          ERROR  EOI         *EOI NOT ON TRACK CHAIN.*
  
 LNB1     LDD    RI          LOAD EOR RANDOM INDEX TO (A) 
          SHN    14 
          LMD    RI+1 
          SBN    1
 LNB2     STM    LNBG+1      SET NEXT BLOCK RANDOM ADDRESS
          SHN    -14
          LMC    LDCI 
          STM    LNBG 
          LDN    0
 LNBA     EQU    *-1         (BYPASS WRITE OF CURRENT BLOCK)
          NJN    LNB3        IF BYPASS WRITE OF CURRENT BLOCK 
          LDA    LNBG,ABS    SET NEXT BLOCK LINKAGE 
          STM    **,BA
 LNBB     EQU    *-1         (FWA+1 OF LINKAGE BYTE)
          SHN    -14
          STM    **,BA
 LNBC     EQU    *-1         (FWA OF LINKAGE BYTE)
          LDC    **          REWRITE CURRENT BLOCK
 LNBD     EQU    *-2         (RANDOM ADDRESS OF CURRENT BLOCK)
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    WRP         WRITE RANDOM PRU 
 LNB3     LDN    0           CHECK FOR EOI WRITE
 LNBE     EQU    *-1         (WRITE EOI SECTOR) 
          ZJN    LNB4        IF NOT EOI WRITE 
          RJM    WES         WRITE EOR/EOI SEQUENCE 
 LNB4     LDC    **          UPDATE NEXT PRU
 LNBF     EQU    *-2         (NEXT BLOCK RANDOM INDEX)
          ZJN    LNB5        IF ADDING TO END OF CHAIN
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDC    ** 
 LNBG     EQU    *-2         (EMPTY BLOCK RANDOM INDEX) 
          STM    CWBI+1,BA
          SHN    -14
          STM    CWBI,BA
          RJM    WRP         WRITE RANDOM PRU 
 LNB5     LDA    LNBG,ABS    GET EMPTY PRU
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDN    0           CHECK HOLE POINTER UPDATE
 LNBH     EQU    *-1         (NO HOLE POINTER UPDATE) 
          NJP    LNB6        IF NOT UPDATING HOLE POINTER 
          LDM    CWRI,BA     SET EMPTY BLOCK ADDRESS
          STM    CPEB 
          LDM    CWRI+1,BA
          STM    CPEB+1 
          LDN    TMSB        READ SYSTEM BLOCK
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDA    CPEB,ABS 
          STM    SBHP+1,BP
          SHN    -14
          STM    SBHP,BP
          RJM    WRP         WRITE RANDOM PRU 
          LDA    LNBG,ABS 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
 LNB6     RJM    GEP         GENERATE EMPTY PRU 
          LDA    LNBD,ABS    PREVIOUS BLOCK RANDOM INDEX
          STM    CWBI+1,BA
          SHN    -14
          STM    CWBI,BA
          LDA    LNBF,ABS 
          STM    CWRI+1,BA
          SHN    -14
          STM    CWRI,BA
          LDC    LDNI 
          STM    LNBA        RESET WRITE CURRENT BLOCK
          STM    LNBE        RESET NO EOR/EOI WRITE 
          STM    LNBH        RESET HOLE POINTER UPDATE
          LJM    LNBX        RETURN 
 LNB$     ENDIF 
 PLI$     IF     DEF,PLI$ 
 PLI      SPACE  4,10 
**        PLI - POSITION TO LAST INDEX. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
* 
*         EXIT   (A) = BUFFER POINTER.
*                (BA) = BUFFER ADDRESS (UNCHANGED). 
*                (BP) = BUFFER POINTER (UPDATED). 
* 
*         USES   BP.
* 
*         CALLS  MBP, MLT.
  
  
 PLI      SUBR               ENTRY/EXIT 
          LDD    BA 
          ADN    2
          STD    BP 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDM    CWEL,BA
          SHN    14 
          LMM    CWNE,BA
          SBN    1
          RJM    MLT         (A) REGISTER MULTIPLY
          RJM    MBP         MOVE BUFFER POINTER
          UJN    PLIX        RETURN 
 MLT$     EQU    1           DEFINE MLT - (A) REGISTER MULTIPLY 
 PLI$     ENDIF 
 MLT$     IF     DEF,MLT$ 
 MLT      SPACE  4,10 
**        MLT - (A) REGISTER MULTIPLY.
* 
*         ENTRY  (A) = VALUES TO MULTIPLY IN THE FORMAT;
*                      6/ M2,12/ M1 
* 
*         EXIT   (A) = PRODUCT. 
*                (T1) = PRODUCT.
* 
*         USES   T0 - T2. 
  
  
 MLT3     LDD    T1          (A) = PRODUCT
  
 MLT      SUBR               ENTRY/EXIT 
          STD    T0          SAVE M1
          LMD    T0          CLEAR PRODUCT REGISTER 
          STD    T1 
          LMC    SHNI+0      INITIALIZE SHIFT COUNT 
          STM    MLTA 
          SHN    -14
 MLT1     STD    T2          SET M2 
          ZJN    MLT3        IF COMPLETE
          LPN    1
          ZJN    MLT2        IF NOT MULTIPLY
          LDD    T0 
          SHN    **          (A) = M1**2(N) 
 MLTA     EQU    *-1         (SHIFT COUNT)
          RAD    T1 
 MLT2     AOM    MLTA        INCREMENT SHIFT COUNT
          LDD    T2 
          SHN    -1 
          UJN    MLT1        CONTINUE MULTIPLY
 MLT$     ENDIF 
 RIB$     IF     DEF,RIB$ 
 RIB      SPACE  4,10 
**        RIB - ROOM IN BLOCK.
* 
*         ENTRY  (CWUW + (BA)) = WORDS LEFT IN BLOCK. 
*                (CWEL + (BA)) = LENGTH OF ENTRY. 
* 
*         EXIT   (A) = ROOM LEFT IN BLOCK IF NEW ENTRY ADDED. 
*                (A) .LT. 0 IF NO ROOM FOR ENTRY. 
  
  
 RIB      SUBR               ENTRY/EXIT 
          LDM    CWUW,BA     SPACE REMAINING IN BLOCK 
          SBM    CWEL,BA     ENTRY LENGTH 
          UJN    RIBX        EXIT 
 RIB$     ENDIF 
 SIB$     IF     DEF,SIB$ 
 SIB      SPACE  4,10 
**        SIB - SEARCH INDEX/ADMIT BUFFER.
* 
*         ENTRY  (BA) = BUFFER ADDRESS (BUFFER FULL). 
*                (BP) = (BA)+2. 
*                (KA) = KEY ADDRESS FOR COMPARISON. 
*                (KL) = KEY LENGTH IN CHARACTERS. 
* 
*         EXIT   (A).EQ.0 IF FOUND. 
*                (A).GT.0 IF NOT FOUND. 
*                (A).EQ.-0 IF END OF INDEX. 
*                (BP) = BUFFER POINTER. 
*                (CI) = CATALOG INDEX.
  
  
 SIB2     LMC    -0          SET END OF INDEX EXIT CONDITION
  
 SIB      SUBR               ENTRY/EXIT 
          LDN    0
          STD    CI 
 SIB1     AOD    CI          INCREMENT CATALOG INDEX
          LDI    BP 
          ZJN    SIB2        IF NO INDEX
          COMPARE ,KA,,BP,,KL 
          ZJN    SIBX        IF STRING(KA).EQ.STRING(BP)
          MJN    SIB2        IF STRING(KA).LT.STRING(BP)
          LDM    CWEL,BA
          RJM    MBP         MOVE BUFFER POINTER
          MJN    SIBX        IF MOVE OUTSIDE CURRENT BUFFER 
          UJN    SIB1        CHECK NEXT INDEX 
 SIB$     ENDIF 
 SSP$     IF     DEF,SSP$ 
 SSP      SPACE  4,10 
**        SSP - SET SCRATCH POOL ADDRESS. 
* 
*         SAVES THE *TMST* SCRATCH POOL WORD ADDRESS FOR THE SPECIFIED
*         TAPE TYPE IN A GLOBAL MEMORY CELL.
* 
*         ENTRY  (A) = TAPE TYPE (0=MT OR NT, 1=CT, 2=NT, 3=AT).
* 
*         EXIT   (T3) = TAPE TYPE.
*                (SCRP) = SCRATCH POOL POINTER ADDRESS IN *TMST*. 
  
  
 SSP      SUBR               ENTRY/EXIT 
          STD    T3          SAVE TAPE TYPE 
          LDM    SSPA,T3
          STM    SCRP        SAVE SCRATCH POOL POINTER
          UJN    SSPX        RETURN 
  
  
 SSPA     BSS    0           ADDRESSES OF SCRATCH POOL WORDS IN *TMST*
          CON    SBSM        *MT*/*NT* SCRATCH POOL WORD
          CON    SBSC        *CT* SCRATCH POOL WORD 
          CON    SBSM        *MT*/*NT* SCRATCH POOL WORD
          CON    SBSA        *AT* SCRATCH POOL WORD 
 SSP$     ENDIF 
 TBA$     IF     DEF,TBA$ 
 TBA      SPACE  4,10 
**        TBA - TOGGLE BUFFER ASSIGNMENT
* 
*         ENTRY  (IOB1, IOB2) = ALLOCATED BUFFERS.
* 
*         EXIT   (A) = BUFFER ADDRESS.
*                (BA) = BUFFER ADDRESS. 
  
  
 TBA      SUBR               ENTRY/EXIT 
          LDN    ** 
 TBAA     EQU    *-1         (LDNI + TOGGLE)
          STD    T1 
          LDN    1
          LMM    TBAA 
          STM    TBAA 
          LDM    ISBA,T1
          STD    BA 
          ADN    2
          STD    BP 
          UJN    TBAX        RETURN 
 TBA$     ENDIF 
 UDT$     IF     DEF,UDT$ 
 UDT      SPACE  4,30 
**        UDT - READ/WRITE UDT. 
* 
*         ALL COMMUNICATION BETWEEN TFM AND MAGNET IS ACCOM-
*         PLISHED THROUGH THE TDAM CPUMTR FUNCTION. TFM CAN 
*         EXECUTE AT THE USERS CONTROL POINT, AND ON CERTAIN
*         REQUESTS WILL REQUIRE ACCESS TO THE UDT(S) IN MAGNETS 
*         FIELD LENGTH. WHEN WRITING TO THE UDT, TFM USES THE 
*         /MTX/RUU (REQUEST UDT UPDATE) WHICH IS RECOGNIZED AND 
*         PROCESSED BY MAGNET. READING THE UDT DOES NOT REQUIRE 
*         MAGNET PROCESSING. IN THIS WAY INTERCONTROL POINT 
*         COMMUNICATION IS MAINTAINED WITHOUT REGARD FOR
*         STORAGE MOVES, OR MULTIPLE PPU CONSIDERATIONS.
* 
*         ENTRY  (A) = 3/RW,3/WC,12/UDT WORD. 
*                (UD) = UDT ADDRESS.
*                (T1) = 0 IF MESSAGE BUFFER CONTAINS UPDATES. 
*                (T1) = FWA OF PP BUFFER FOR UPDATES. 
*                (UDTA) = PRESET TO FWA OF UDT. 
* 
*         EXIT   (A) = ZERO IF NO ERRORS. 
*                (A) = NON-ZERO IF *MAGNET* NOT ACTIVE. 
* 
*         USES   CM - CM+4, T1, T2. 
* 
*         CALLS  PFR. 
* 
*         MACROS ISTORE, MONITOR. 
  
  
 UDT      SUBR               ENTRY/EXIT 
          STM    UDTE+2      SET UDT WORD OFFSET
          LMM    UDTE+2      SET READ/WRITE FLAG
          SHN    3
          STM    UDTE+1 
          SHN    -17         SET WORD COUNT 
          STD    T2 
          SHN    6
          STM    UDTE+3 
          LDM    UDTA        ADD FWA OF UDT 
          STM    UDTE+4 
          LDD    MA          SET REQUEST IN MESSAGE BUFFER
          CWM    UDTE,ON
          LDM    UDTE+1 
          ZJN    UDT1        IF READ REQUEST
          LDD    T1 
          ZJN    UDT4        IF NOT WRITE FROM BUFFER 
          STM    UDTB 
          LDD    MA 
          ADN    1
          CWM    **,T2
 UDTB     EQU    *-1         (ADDRESS OF PP BUFFER) 
          UJN    UDT3        ISSUE REQUEST
  
 UDT1     LDD    T1          PROCESS READ REQUEST 
          ZJN    UDT2        IF NOT READ TO BUFFER
          STM    UDTD 
          LDC    ** 
          ORG    *O-1 
          ZJN    *+UDT6-UDTC IF FINISHED
          STM    UDTC 
          UJN    UDT3        ISSUE REQUEST
  
 UDT2     BSS    0           REISSUE REQUEST
*         LDN    0           (A) = 0
          STM    PFRA 
          RJM    PFR         PAUSE FOR RELOCATION 
 UDT3     LDD    MA          BUILD *TDAM* REQUEST 
          CRD    CM 
          LDD    CM+1 
          NJN    UDT4        IF WRITE REQUEST 
          LDD    CM+2        SET RELATIVE WORD ADDRESS
          RAD    CM+4 
          UJN    UDT5        SET SUBSYSTEM PRIORITY 
  
 UDT4     LDD    HN          INCREMENT WORD COUNT 
          RAD    CM+3 
          LDN    /MTX/RCAL   SET RECEIVING BUFFER ADDRESS 
          STD    CM+4 
 UDT5     LDC    MTSI        SET MAGNET SUBSYSTEM ID
          STD    CM+2 
          MONITOR TDAM
          LDD    CM+1 
          ZJN    UDT7        IF OPERATION COMPLETE
*         ZJN    UDT6        (IF READ TO PP BUFFER) 
 UDTC     EQU    *-1
          SCN    3
          ZJN    UDT2        IF *MAGNET* ACTIVE 
          UJN    UDT7        RETURN WITH ERROR
  
 UDT6     LDD    MA          READ TO PP BUFFER
          CRM    **,T2
 UDTD     EQU    *-1         (ADDRESS OF PP BUFFER) 
          ISTORE  UDTC,(ZJN UDT7)  IF COMPLETE RETURN 
          LDN    0           SET NO ERROR 
 UDT7     LJM    UDTX        RETURN 
  
 UDTE     VFD    12//MTX/RUU,12/**,12/**,12/**,12/**
 UDT$     ENDIF 
 UIS$     IF     DEF,UIS$ 
 UIS      SPACE  4,10 
**        UIS - USERNAME INDEX SEARCH.
* 
*         ENTRY  (KA) = KEY ADDRESS (USERNAME). 
* 
*         EXIT   (A) .EQ. 0 IF FOUND. 
*                    .GT. 0 IF NOT FOUND. 
*                    .EQ. -0 IF END OF INDEX. 
*                (KL) = KEY LENGTH IN CHARACTERS. 
*                (CPPI) = BUFFER ADDRESS OF PRIMARY INDEX.
*                (CPPI+1) = BUFFER POINTER OF PRIMARY INDEX.
*                (CPSI) = BUFFER ADDRESS OF SECONDARY INDEX.
*                (CPSI+1) = BUFFER POINTER OF SECONDARY INDEX.
  
  
 UIS      SUBR               ENTRY/EXIT 
          LDN    UNKL        SET KEY LENGTH 
          STD    KL 
          LDN    FPUI        SET PRIMARY USERNAME INDEX 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    ISK         INDEXED SEARCH FOR KEY 
          UJN    UISX        RETURN 
 UIS$     ENDIF 
 VIS$     IF     DEF,VIS$ 
 VIS      SPACE  4,10 
**        VIS - VSN INDEX SEARCH. 
* 
*         ENTRY  (KA) = KEY ADDRESS (VSN) 
* 
*         EXIT   (A) .EQ. 0 IF FOUND. 
*                    .GT. 0 IF NOT FOUND. 
*                    .EQ. -0 IF END OF INDEX. 
*                (KL) = KEY LENGTH IN CHARACTERS. 
*                (CPPI) = BUFFER ADDRESS OF PRIMARY INDEX.
*                (CPPI+1) = BUFFER POINTER OF PRIMARY INDEX.
*                (CPSI) = BUFFER ADDRESS OF SECONDARY INDEX.
*                (CPSI+1) = BUFFER POINTER OF SECONDARY INDEX.
  
  
 VIS      SUBR               ENTRY/EXIT 
          LDN    VSKL        SET KEY LENGTH 
          STD    KL 
          LDN    FPVI        SET PRIMARY VSN INDEX
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    ISK         INDEXED SEARCH FOR KEY 
          UJN    VISX        RETURN 
 VIS$     ENDIF 
 WES$     IF     DEF,WES$ 
 WES      SPACE  4,10 
**        WES - WRITE EOR/EOI SEQUENCE. 
* 
*         ENTRY  (CO) = CATALOG FST ADDRESS.
*                (BA) = BUFFER ADDRESS. 
*                (EQ) = EQUIPMENT.
*                (FS+3) = CURRENT EOI TRACK.
*                (FS+4) = SECTORS USED THIS TRACK.
* 
*         EXIT   EOR/EOI PRU(S) WRITTEN TO CATALOG. 
* 
*         USES   CM - CM+4, FA, FS - FS+4, T6, T7.
* 
*         CALLS  WEI, WDS.
* 
*         MACROS CLEAR, ENDMS, MONITOR, SETMS.
  
  
 WES5     SETMS  IO          RESERVE CHANNEL
          LDD    BA 
          ADN    FSEI 
          STM    WESB 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRM    *,ON 
 WESB     EQU    *-1
          LDD    BA 
          RJM    WEI         WRITE (EOI) SECTOR 
          PJN    WES6        IF NOT MASS STORAGE ERROR
          LDC    LDCI+00002  SET WRITE ERROR FLAG 
          STM    TFMC-1 
 WES6     LDD    T7          SET EOI LINKAGE BYTE 
          NJN    WES7        IF NOT SECTOR LIMIT
          LDD    T6 
 WES7     STI    BA 
          LDD    FS+3        LAST EOI TRACK = EOR TRACK 
          STD    T6 
          LDD    FS+4        LAST EOI SECTOR = EOR SECTOR 
          STD    T7 
          LDD    BA 
          RJM    WDS         WRITE (EOR) SECTOR 
          PJN    WES8        IF NOT MASS STORAGE ERROR
          LDC    LDCI+40     SET MASS STORAGE ERROR FLAG
          STM    TFMC-1 
 WES8     ENDMS              DROP CHANNEL 
          LDD    EQ          SET EQUIPMENT/CHECKPOINT 
          LMC    4000 
          STD    CM+1 
          LDD    FS+1        SET TRACK
          LPC    3777 
          STD    CM+2 
          LDD    FS+2        SET SECTOR 
          STD    CM+3 
          MONITOR DTKM       DROP TRACK/SET EOI 
  
 WES      SUBR               ENTRY/EXIT 
          CLEAR  ,BA,502*2    CLEAR BUFFER
          LDD    FS+3        SET CURRENT EOI TRACK
          STD    FS+1 
          STD    T6 
          LDD    FS+4        INCREMENT CURRENT EOI SECTOR COUNT 
          ADN    1
          STD    FS+2 
          STD    T7 
          SBM    SLM
 WES0     NJP    WES5        IF NOT SECTOR LIMIT
          STD    FS+2        CLEAR SECTOR COUNT 
          STD    T7 
 WES1     LDN    ZERL        BUILD *RTCM* REQUEST 
          CRD    CM 
          LDD    EQ          SET EQUIPMENT
          STD    CM+1 
          LDD    FS+3        SET CURRENT EOI TRACK
          STD    CM+2 
          MONITOR RTCM       REQUEST TRACK CHAIN
          LDD    CM+4 
          STD    FS+1        SET TRACK
          STD    T6 
          NJP    WES0        IF TRACK ASSIGNED
          LDD    CP          ISSUE CONSOLE MESSAGE
          ADN    MS2W 
          CWM    WESA,TR
          PAUSE 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          NJN    WES4        IF NOT LOCAL FILE MODE 
          LDD    CM+1 
          LMN    ODET 
          ZJN    WES3        IF OPERATOR DROP 
          LMN    OKET&ODET
          ZJN    WES3        IF OPERATOR KILL 
          LMN    ORET&OKET
          NJN    WES4        IF NOT OPERATOR OVERRIDE 
 WES3     ERROR  TKL         *TRACK LIMIT.* 
  
 WES4     LDN    0
          SBN    1
          NJN    *-1         IF CONTINUING DELAY
          STD    CM          CLEAR MS2W 
          LDD    CP 
          ADN    MS2W 
          CWD    CM 
          UJP    WES1        REQUEST TRACK
  
 WESA     DATA   C*$TRACK LIMIT.* 
 WES$     ENDIF 
          SPACE  4,10 
          IF     DEF,LST$,1 
          LIST   *
          ENDX
