TFM 
          IDENT  TFM,TFM
          PERIPH J
          BASE   MIXED
          SST    PUCW 
          TITLE  TFM - TAPE FILE MANAGER. 
*COMMENT  TFM - TAPE FILE MANAGER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 TFM      SPACE  4,10 
*****     TFM - TAPE FILE MANAGER.
* 
*         J.P. MOORE.        81/04/01.
          SPACE  4
*****     *TFM* HAS SUPERVISORY CONTROL OVER THE TMS TAPE CATALOGS, 
*         AND DIRECTS PROCESSING OF TAPE ASSIGNMENTS AND FINAL
*         DISPOSITION. IT ACCEPTS PROCESSING REQUESTS FROM
*         RESEX, MAGNET, TFSP AND THE TMS COMMAND 
*         PROCESSOR, TFILES. TFM INTERFACES WITH THE EXTERNAL 
*         REQUESTS THROUGH FETS, AND MAGNETS UNIT DESCRIPTOR TABLE
*         (UDT).
* 
*         TFM IS A GENERAL PURPOSE FUNCTION PROCESSOR FOR THE TAPE
*         FILE MANAGER. TO ADD A NEW FUNCTION TO *TFM* AN 
*         ENTRY IS MADE IN THE FUNCTION TABLE THAT POINTS TO THE
*         APPROPRIATE SET OF CODE.  THE FUNCTION TABLE IS NOT ORDER 
*         DEPENDENT.  OVERLAYS ARE AUTOMATICALLY DEFINED BY THE OVERLAY 
*         MACRO AND THE FUNCTIONS ENTRY POINT BY THE ENTRY MACRO. 
*         NORMAL RETURN FROM A FUNCTION IS THROUGH A RETURN JUMP
*         FROM THE MAIN LOOP. ABNORMAL RETURN IS THROUGH THE ERROR
*         PROCESSING OVERLAY. 
* 
*         TFM IS A NON-DEDICATED FUNCTION PROCESSOR. ALL TFM
*         REQUESTS ARE VALIDATED AGAINST CRITERIA WHICH IS
*         UNIQUE TO THE FUNCTION BEING CALLED. IF THIS CRITERIA 
*         IS NOT MET, THE CALLING PROGRAM WILL BE ABORTED AS
*         A *TFM INCORRECT REQUEST.*. 
* 
*         TFM IS THE ONLY PROGRAM WHICH HAS DIRECT ACCESS TO THE
*         TAPE FILE CATALOGS. CREATION, UPDATE, AND INQUIRY 
*         REQUESTS ARE MADE TO TFM, AND ANY RETURNS ARE MADE
*         THROUGH FETS, BUFFERS, AND/OR THE UDT TABLE IN
*         MAGNET. 
* 
*         THE TAPE FILE MANAGER CONSISTS OF FIVE MAIN AREAS 
*         WHICH ARE STRUCTURED TO MAKE OPTIMAL USE OF AVAILABLE 
*         PPU MEMORY AND FOR EASE OF MAINTENANCE. THESE ARE-
* 
*         1. RESIDENT ROUTINES. 
*         2. OVERLAYABLE PRESET.
*         3. PROCESSING OVERLAYS. 
*         4. CONDITIONALLY ASSEMBLED SUBROUTINES. 
*         5. I/O BUFFER AREAS.
* 
* 
*         RESIDENT ROUTINES CONSIST OF THE MAIN LOOP AND
*         SUBROUTINES WHICH ARE LOADED WITH THE PRIMARY 
*         LOAD AND ARE NOT OVERLAYED AT ANY TIME. THESE 
*         ROUTINES CAN BE USED BY ALL SUBORDINATE SUB-
*         ROUTINES AND OVERLAYS.
* 
*         OVERLAYABLE PRESET CONSISTS OF THE RA+1 REQUEST 
*         PROCESSORS, RESIDENT SUBFUNCTION PROCESSORS,
*         OVERLAYABLE SUBROUTINES, PRESET, AND PRESET SUB-
*         ROUTINES. THIS CODE IS ARRANGED IN SECTIONS,
*         DEFINED BY THE OVERLAY LOAD ADDRESS. THE RESIDENT 
*         SUBFUNCTION PROCESSORS DO NOT REQUIRE A OVERLAY 
*         LOAD TO NORMALLY COMPLETE, BUT ERROR CONDITIONS 
*         WILL CAUSE PART OF THIS CODE TO BE OVERLAYED BY 
*         THE ERROR PROCESSOR.
* 
*         PROCESSING OVERLAYS ARE THE SUBFUNCTION PROCESSORS
*         WHICH ARE NOT AVAILABLE IN THE PRIMARY LOAD. THESE
*         OVERLAYS ARE AUTOMATICALLY GENERATED BY THE OVERLAY 
*         MACRO AND ARE QUALIFIED BY THE THREE CHARACTER
*         OVERLAY NAME. EACH OVERLAY CAN DEFINE DIRECT CELLS
*         S1 - S3+4 FOR ITS OWN PURPOSES, AS THESE CELLS ARE
*         NOT USED BY ANY OTHER ROUTINES. 
* 
*         CONDITIONALLY ASSEMBLED SUBROUTINES ARE CONTAINED 
*         IN *COMPTFM*. THIS IS A COLLECTION OF SUBROUTINES 
*         THAT OVERLAYABLE PRESET OR ANY OVERLAY CAN USE. 
*         ONLY THE SUBROUTINES REQUESTED BY DEFINING XXX$ 
*         (XXX = SUBROUTINE NAME) WILL BE ASSEMBLED. BY 
*         DEFAULT THE LISTING OF THIS COMMON DECK IS TURNED 
*         OFF. TO OBTAIN A ASSEMBLED LIST OF *COMPTFM*
*         DEFINE LST$.
* 
*         THERE ARE THREE I/O BUFFERS DEFINED. IN SOME CASES
*         THEY ARE OVERLAYED BUT IN GENERAL EXTREME CARE MUST 
*         BE TAKEN BEFORE USING ANY OF THE BUFFER AREAS FOR 
*         CODE. SOME TFM SUBROUTINES RANDOMLY SELECT BUFFER 
*         SPACE.
* 
*         DIRECT CELLS HAVE BEEN ARRANGED IN SUCH A WAY AS TO 
*         ALLOW 15D CONTIGUOUS LOCATIONS (THREE CM WORDS) TO
*         BE UNIQUELY DEFINED BY EACH OF THE PROCESSING 
*         OVERLAYS. THE REMAINING DIRECT CELLS ARE COMMON TO
*         TFM AS A WHOLE. 
          SPACE  4,10 
***       TFM INPUT REGISTER CALL FORMAT -
* 
*T,       18/ *TFM*, 6/40B, 12/FC, 6/0 , 18/FA
* 
*         FC     = FUNCTION CODE. 
* 
*         FA     = FUNCTION PARAMETER ADDRESS RELATIVE TO 
*                  THE CONTROL POINT (SEE *COMSTFM FOR FORMATS).
* 
*         CALLS TO TFM ARE MADE WITH THE AUTO-RECALL FLAG SET 
*         EXCEPT WHEN CALLED BY *MAGNET*. 
          SPACE  4,10 
***       DAYFILE MESSAGES. 
* 
*         (VSN) BUSY. 
*                THE VSN REQUESTED IS CURRENTLY BUSY. 
* 
*         (LFN) NOT FOUND.
*                THE LOCAL FILE NAME REQUESTED IS NOT 
*                IN THE FNT OR IS NOT ASSIGNED TO THE JOB.
* 
*         (FILENAME) NOT FOUND. 
*                THE FILENAME SPECIFIED WHEN ATTEMPTING 
*                SYMBOLIC ACCESS COULD NOT BE FOUND IN
*                THE USERS CATALOG. 
* 
*         (VSN) NOT FOUND.
*                THE VSN SPECIFIED WHEN ATTEMPTING VSN
*                ACCESS TO A TAPE FILE COULD NOT BE 
*                FOUND OR WAS NOT ASSIGNED TO THE USER. 
* 
*         (USERNAME) NOT FOUND. 
*                THE USERNAME IS NOT KNOWN TO TMS.
* 
*         (LFN) NOT ON MAGNETIC TAPE. 
*                THE LOCAL FILE REQUESTED IS NOT A
*                MAGNETIC TAPE FILE.
* 
*         (VSN) ALREADY RESERVED. 
*                ATTEMPT TO RESERVE A VSN THAT IS 
*                ALREADY RESERVED 
* 
*         (FILENAME) ALREADY RESERVED.
*                ATTEMPT TO RESERVE A FILENAME THAT 
*                IS ALREADY RESERVED TO THE USER. 
* 
*         TFM ABORTED.
*                ABNORMAL TERMINATION OF THE TAPE FILE
*                MANAGER
* 
*         TFM INCORRECT REQUEST.
*                TFM DETECTED A ERROR IN THE REQUEST. 
* 
*         TMS DISABLED. 
*                THE TAPE MANAGER IS DISABLED.
* 
*         MAGNET NOT ACTIVE.
*                ATTEMPT TO COMMUNICATED WITH THE MAGNETIC
*                TAPE EXECUTIVE WHICH IS CURRENTLY NOT IN 
*                THE SYSTEM.
* 
*         ERRONEOUS BUFFER POINTER. 
*                TFM INTERNAL ERROR.
* 
*         TMS UTILITY ACTIVE. 
*                THE TMS UTILITY (TFSP) IS CURRENTLY
*                ACTIVE. NO USER ACTIONS ARE POSSIBLE.
* 
*         BUFFER ARGUMENT ERROR.
*                A ERROR WAS DETECTED WHEN VALIDATING 
*                THE FET. 
* 
*         ERROR IN INDEX DATA.
*                A DATA ERROR WAS DISCOVERED IN EITHER
*                A VSN OR USERNAME INDEX. 
* 
*         ERROR IN CATALOG DATA.
*                A DATA ERROR WAS DISCOVERED IN THE TAPE
*                CATALOG ENTRY. 
* 
*         ERROR IN ADMIT DATA.
*                A DATA ERROR WAS DISCOVERED IN A ADMIT 
*                ENTRY FOR THE FILE.
* 
*         (NNNNNN) RANDOM ADDRESS ERROR.
*                ATTEMPT TO WRITE INTO THE SYSTEM SECTOR
*                OR BEYOND THE EOI IN THE TAPE CATALOG. 
* 
*         EQXX, DNYY, MASS STORAGE ERROR. 
*                A UNRECOVERABLE READ/WRITE ERROR HAS 
*                OCCURRED.
* 
*         (FAMILY) TAPE CATALOG NOT FOUND.
*                NO TAPE CATALOG COULD BE FOUND 
*                FOR THIS FAMILY. 
* 
*         EMPTY CATALOG.
*                NO CATALOG ENTRIES COULD BE FOUND
*                FOR THIS USER ON A AUDIT REQUEST.
* 
*         CATALOG LINKAGE ERROR.
*                THE CATALOG LINKAGE HAS BEEN BROKEN. 
* 
*         I/O SEQUENCE ERROR ON CATALOG.
*                THE LOCAL FILE CATALOG WAS BUSY. 
* 
*         EOI NOT ON TRACK CHAIN. 
*                THE EOI ON THE TAPE CATALOG COULD
*                NOT BE FOUND.
* 
*         NO ADMITS.
*                NO ADMIT ENTRIES COULD BE FOUND ON 
*                A AUDIT REQUEST. 
* 
*         TMS PROCESSING INHIBITED. 
*                TMS CONTROL OVER TAPE FILES IS INHIBITED 
*                BECAUSE THIS IS A SYSTEM ORIGIN JOB OR 
*                AS A USER SPECIFIED REQUEST. 
* 
*         ACTIVITY SUSPENDED. 
*                TMS ACTIVITY IS TEMPORARILY SUSPENDED. 
* 
*         (FAMILY) TAPE CATALOG ERROR.
*                THERE IS A FATAL CATALOG ERROR OUTSTANDING 
*                FOR THIS FAMILY. 
* 
*         WAIT SCRATCH ASSIGNMENT.
*                NO SCRATCH TAPES ARE CURRENTLY AVAILABLE 
*                TO SATISFY THIS REQUEST. 
* 
*         LINKED CATALOG NOT ACCESSIBLE.
*                THE LINKED TAPE CATALOG CANNOT BE ACCESSED FROM THE
*                CURRENT FAMILY.
          SPACE  4,10 
***       ACCOUNT FILE MESSAGES.
* 
*         SDAU, FAMNAME, USERNAM, FVSNXX, VSNXXX. 
*                RESERVE
* 
*         SDCR, FAMNAME, USERNAM, FVSNXX. 
*                RELEASE. 
          SPACE  4,10 
***       ASSEMBLY OPTIONS. 
  
  
 IRA$     EQU    1           DEFINE RANDOM PROCESSOR INITIALIZATION 
 LST$     EQU    1           DEFINE *COMPTFM* LIST OPTION 
*TRP$     EQU    1           DEFINE TRAP ON ERROR CODES 
 WEI$     EQU    1           DEFINE EOI BUFFER SPECIFIED
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
          SPACE  4,10 
***       COMMON DECKS (SYMBOLS/MACROS) 
* 
  
  
*CALL     COMPMAC 
          QUAL   COMSCPS
*CALL     COMSCPS 
          QUAL   *
*CALL     COMSEJT 
*CALL     COMSMSP 
*CALL     COMSPIM 
*CALL     COMSWEI 
          QUAL   EVT
*CALL     COMSEVT 
          QUAL   PFM
*CALL     COMSPFM 
          QUAL   PRD
*CALL     COMSPRD 
          QUAL   SSJ
*CALL     COMSSSJ 
          QUAL   UAM
          QUAL
*CALL     COMSSSD 
          SPACE  4,10 
***       MAGNET, RESEX, TFM SYMBOL DEFINITIONS.
* 
  
  
          LIST   X
          QUAL   MTX
*CALL     COMSMTX 
          QUAL
*CALL     COMSTFM 
          LIST   *
          SPACE  4,10 
*         VERIFY COMPATIBILITY OF TMS DEFINITIONS IN COMMON DECKS.
  
  
          QUAL   TFM
*CALL     COMSTFM 
          QUAL   *
          TITLE  TAPE FILE MANAGER EQUIVALENCES.
          SPACE  4,10 
***       FET PARAMETER BLOCK.
* 
*         THE FOLLOWING SYMBOLS DEFINE THE FET
*         PARAMETERS RELATIVE TO THE FIRST WORD 
*         OF THE PARAMETER BLOCK. 
  
  
 FBES     EQU    TFES-TFFP   EXTERNAL VSN 
 FBTD     EQU    TFTD-TFFP   TAPE DESCRIPTORS 
 FBVS     EQU    TFVS-TFFP   INTERNAL VSN 
 FBFI     EQU    TFID-TFFP   FILE IDENTIFIER
 FBSI     EQU    TFSI-TFFP   SET I.D., VERSION, GENERATION
 FBNI     EQU    TFNI-TFFP   FILE IDENTIFIER (NEW)
 FBCR     EQU    TFCR-TFFP   CREATION/RETENTION DATE
 FBAC     EQU    TFCE-TFFP   CE, AN PARAMETERS
 FBUN     EQU    TFUN-TFFP   ALTERNATE USER NAME
 FBUC     EQU    TFUC-TFFP   USER CONTROL WORD
 FBPW     EQU    TFPW-TFFP   FILE PASSWORD
          SPACE  4,10 
***       BUFFER CONTROL WORD (PP BYTE POSITIONS) 
  
  
 CWSC     EQU    0           SECTOR COUNT 
 CWWC     EQU    1           SECTOR WORD COUNT
 CWRT     EQU    BWRT*5+0+2  RECORD TYPE,LEVEL NUMBER 
 CWUW     EQU    BWRT*5+1+2  UNUSED WORD COUNT (CM WORDS) 
 CWEL     EQU    BWRT*5+2+2  DATA ENTRY LENGTH IN CM WORDS
 CWNE     EQU    BWRT*5+3+2  NUMBER OF DATA ENTRIES 
 CWFE     EQU    BWRT*5+4+2  FIRST DATA WORD
 CWDT     EQU    BWDT*5+2+2  LAST MODIFICATION DATE/TIME (PACKED) 
 CWBI     EQU    BWRI*5+1+2  RANDOM INDEX TO PREVIOUS BLOCK 
 CWRI     EQU    BWRI*5+3+2  RANDOM INDEX TO NEXT BLOCK 
 CWUN     EQU    BWUN*5+0+2  CATALOG/ADMIT/SYSTEM BLOCK USERNAME
 CWMX     EQU    BWUN*5+3+2  UTILITY MACHINE INDEX (SYSTEM BLOCK) 
          SPACE  4,10 
***       SYSTEM BLOCK LOCATIONS (PP BYTE POSITIONS)
  
 SBFN     EQU    TMFM*5+0    FAMILY NAME
 SBST     EQU    TMFM*5+3    CATALOG STATUS 
 SBID     EQU    TMID*5+0    MACHINE I.D. 
 SBHP     EQU    TMID*5+3    HOLE POINTER 
 SBTC     EQU    TMCT*5+1    TRACK COUNT
 SBPC     EQU    TMCT*5+2    SECTOR (PRU) COUNT 
 SBSM     EQU    TMSM*5+0    FIRST *MT*/*NT* SCRATCH VOLUME 
 SBCM     EQU    TMSM*5+3    *MT*/*NT* SCRATCH COUNT
 SBLF     EQU    TMLF*5+0    LINKED FAMILY NAME 
 SBPF     EQU    TMPA*5+0    PERMITTED ALTERNATE FAMILY NAMES 
 SBSC     EQU    TMSC*5+0    FIRST *CT* SCRATCH VOLUME
 SBCC     EQU    TMSC*5+3    *CT* SCRATCH COUNT 
 SBSA     EQU    TMSA*5+0    FIRST *AT* SCRATCH VOLUME
 SBCA     EQU    TMSA*5+3    *AT* SCRATCH COUNT 
          SPACE  4,10 
***       VSN ENTRY LOCATIONS (PP BYTE POSITIONS) 
  
  
 VBES     EQU    VEES*5+0    EXTERNAL VSN 
 VBCI     EQU    VEES*5+3    CATALOG RANDOM INDEX 
 VBVS     EQU    VEVS*5+0    INTERNAL VSN 
 VBRC     EQU    VEVS*5+3    REEL COUNT (UPPER 6 BITS)
 VBST     EQU    VEVS*5+3    VSN STATUS (LOWER 18 BITS) 
 VBFV     EQU    VEFV*5+0    FIRST VSN OF SET 
 VBMX     EQU    VEFV*5+3    VSN BUSY MACHINE INDEX 
 VBJS     EQU    VEFV*5+4    EJT ORDINAL
 VBNV     EQU    VENV*5+0    NEXT VSN OF SET
 VBUC     EQU    VENV*5+3    USAGE COUNTER (UPPER 6 BITS) 
 VBRD     EQU    VENV*5+3    RELEASE DATE (LOWER 18 BITS) 
          SPACE  4,10 
***       USERNAME INDEX LOCATIONS (PP BYTE POSITIONS)
  
  
 UBUN     EQU    0           USERNAME 
 UBCI     EQU    UBUN+3      CATALOG INDEX (18 BITS)
          SPACE  4,10 
***       CATALOG ENTRY LOCATIONS (PP BYTE POSITIONS) 
  
 CBLI     EQU    CELI*5+0    FILE NAME (102 BITS) 
 CBST     EQU    CEST*5+4    STATUS FLAGS (12 BITS) 
 CBES     EQU    CEES*5+0    EXTERNAL SERIAL NUMBER (36 BITS) 
 CBRC     EQU    CEES*5+4    REEL COUNT (12 BITS) 
 CBTD     EQU    CETD*5+0    TAPE FILE DESCRIPTORS (60 BITS)
 CBFN     EQU    CETD*5+2    TAPE FORMAT AND NOISE SIZE 
 CBSZ     EQU    CETD*5+3    BLOCK SIZE (24 BITS) 
 CBVS     EQU    CEVS*5+0    VOLUME SERIAL NUMBER (36 BITS) 
 CBFA     EQU    CEVS*5+3    FILE ACCESSIBILITY (6 BITS)
 CBSN     EQU    CEVS*5+3    SECTION NUMBER (18 BITS) 
 CBPI     EQU    CEPI*5+0    PHYSICAL FILE I.D. (102 BITS)
 CBQN     EQU    CESQ*5+3    FILE SEQUENCE NUMBER (18 BITS) 
 CBSI     EQU    CESI*5+0    SET IDENTIFIER (36 BITS) 
 CBVN     EQU    CESI*5+3    VERSION NUMBER (9 BITS)
 CBGN     EQU    CESI*5+3    GENERATION NUMBER (15 BITS)
 CBLD     EQU    CERC*5+0    LABEL RETENTION/CREATION DATE (60 BITS)
 CBPW     EQU    CEPW*5+0    PASSWORD (42 BITS) 
 CBCT     EQU    CEPW*5+4    CATAGORY TYPE (6 BITS) 
 CBAM     EQU    CEPW*5+4    ACCESS MODE (6 BITS) 
 CBNC     EQU    CECD*5+0    RANDOM INDEX TO CATALOG
 CBCD     EQU    CECD*5+2    CREATION DATE/TIME (36 BITS) 
 CBAE     EQU    CEMD*5+0    RANDOM INDEX TO FIRST ADMIT BLOCK
 CBMD     EQU    CEMD*5+2    MODIFICATION DATE/TIME (36 BITS) 
 CBAC     EQU    CEAD*5+0    ACCESS COUNT (24 BITS) 
 CBAD     EQU    CEAD*5+2    LAST ACCESS DATE/TIME (36 BITS)
 CBUC     EQU    CEUC*5+0    USER CONTROL WORD (60 BITS)
 CBCN     EQU    CECN*5+0    CHARGE NUMBER (60 BITS)
 CBPN     EQU    CEPN*5+0    PROJECT NUMBER (120 BITS)
          SPACE  4,10 
***       ADMIT ENTRY LOCATIONS (PP BYTE POSITIONS).
  
 ABUN     EQU    AEUN*5+0    ALTERNATE USER NAME (42 BITS)
 ABAN     EQU    AEAC*5+0    ACCESS COUNT (18 BITS) 
 ABAM     EQU    AEAC*5+1    ACCESS MODE (6 BITS) 
 ABDT     EQU    AEAC*5+2    LAST ACCESS DATE/TIME (36 BITS)
          SPACE  4,10 
***       TFM EVENT SKELETONS.
  
  
 ESVB     EQU    /EVT/TVBE   VSN BUSY OR WAIT SCRATCH 
 ESUA     EQU    /EVT/TUIE   TMS UTILITY INTERLOCK
 ESMR     EQU    /EVT/TRME   ROLLOUT FOR MAGNET 
 ESVR     EQU    /EVT/VSNE   VSN RESOURCE 
          SPACE  4,10 
***       BUFFER ALLOCATION.
  
  
 BUF0     EQU    BFMS        MASS STORAGE I/O BUFFER
 BUF1     EQU    BUF0-502    MASS STORAGE I/O BUFFER
 BUF2     EQU    BUF1-502    MASS STORAGE I/O BUFFER
          TITLE  MACRO/MICRO DEFINITIONS. 
*         OVERLAY CONTROL.
  
  
 PREFIX   MICRO  1,, 5T      BASE OVERLAY NAME
 .A.      SET    0           SCRATCH
 .B.      SET    0           SCRATCH
 .X.      SET    0           OVERLAY GENERATION COUNT 
 .Y.      MICRO  1,, TFM     GENERATED OVERLAY NAME 
 .Z.      SET    0           FUNCTION TABLE GENERATION
          NOREF  .A.,.B.
 OP=      SPACE  4,10 
**        OP= - CONDITIONALLY GENERATE INSTRUCTION. 
* 
*         OP=    P1,P2,P3 
* 
*         ENTRY  P1 = ARGUMENT. 
*                P2 = INSTRUCTION IF ARGUMENT .LT. 100B.
*                P3 = INSTRUCTION IF ARGUMENT .GE. 100B.
  
  
          PURGMAC OP= 
  
 OP=      MACRO  P1,P2,P3 
          IF     DEF,P1,3 
          IFLT   P1,100B
          P2     P1 
          ELSE
          P3     P1 
          ENDIF 
          ENDM
 CLEAR    SPACE  4,10 
**        CLEAR - CLEAR PP MEMORY.
* 
*         CLEAR  P1,P2,P3,P4
* 
*         ENTRY  P1 = STARTING WORD IN PPU TO BE SET TO ZERO. 
*                P2 = CELL CONTAINING INDEX TO P1.
*                P3 = NUMBER OF CHARACTERS (HALF BYTES) TO
*                     CLEAR.
*                P4 = CELL CONTAINING NUMBER OF CHARACTERS TO CLEAR.
* 
*         CALLS  CPM. 
  
  
          PURGMAC CLEAR 
  
 CLEAR    MACRO  P1,P2,P3,P4
          MACREF CLEAR
          EVAL   P1,P2,T1 
          EVAL   P3,P4
          RJM    CPM
          ENDM
 CMOVE    SPACE  4,15 
**        CMOVE - COMPARE/MEMORY MOVE.
* 
*         CMOVE  P1,P2,P3,P4,P5,P6
* 
*         ENTRY  P1 = FWA OF MOVE.
*                P2 = MODIFIER TO P1. 
*                P3 = FWA OF DESTINATION. 
*                P4 = MODIFIER TO P3. 
*                P5 = MOVE COUNT IN PP BYTES. 
*                P6 = MOVE COUNT IN PP BYTES, STORED IN MEMORY. 
* 
*         CALLS  CMV. 
  
  
          PURGMAC CMOVE 
  
 CMOVE    MACRO  P1,P2,P3,P4,P5,P6
          MACREF CMOVE
          EVAL   P1,P2,T1 
          EVAL   P3,P4,T2 
          EVAL   P5,P6
          RJM    CMV
 CMV$     EQU    1           DEFINE CMV - COMPARE/MOVE PP BYTE STRING 
          ENDM
 COMPARE  SPACE  4,10 
**        COMPARE - COMPARE CHARACTER STRING. 
* 
*         COMPARE P1,P2,P3,P4,P5,P6 
* 
*         ENTRY  P1 = ADDRESS OF STRING 1.
*                P2 = CELL CONTAINING INDEX.
*                P3 = ADDRESS OF STRING 2.
*                P4 = STRING 2 MODIFIER.
*                P5 = LENGTH OF COMPARE.
*                P6 = CELL CONTAINING LENGTH OF COMPARE.
  
  
          PURGMAC COMPARE 
  
 COMPARE  MACRO  P1,P2,P3,P4,P5,P6
          MACREF COMPARE
          EVAL   P1,P2,T1 
          EVAL   P3,P4,T2 
          EVAL   P5,P6
          RJM    CCS
          ENDM
 EMSG     SPACE  4,10 
**        EMSG - GENERATE ERROR MESSAGE.
* 
* 
*         EMSG   P1,P2,(P3) 
* 
*         ENTRY  (P1) = ERROR MESSAGE TYPE AND PROCESSING DISPOSITION.
*                (P2) = CONTROL WORD FOR MESSAGE DESTINATION. 
*                (P3) = ERROR MESSAGE.
  
  
          PURGMAC EMSG
  
          MACRO  EMSG,P1,P2,P3,P4 
          MACREF EMSG 
          IFC    EQ,*P2*BEGIN*,3
 P1       BSS    0
          QUAL   P1 
          SKIP
          IFC    EQ,*P2*END*,4
          QUAL   *
          LOC    *O 
 P1_L     EQU    *-P1 
          SKIP
 .A.      MICRO  1,,$P4$
 .B.      MICCNT .A.
          ERRNG  40D-.B.     DAYFILE MESSAGE TOO LONG 
          LOC    P1 
          CON    P2,P3,=C$P4$ 
          ENDIF 
          ENDM
 ENTRY    SPACE  4,10 
**        ENTRY - DEFINE OVERLAY ENTRY POINT. 
* 
* P1      ENTRY 
* 
*         ENTRY  P1 = ENTRY/EXIT POINT FOR ROUTINE. 
  
  
          PURGMAC ENTRY 
  
          MACRO  ENTRY,P1 
          MACREF ENTRY
 P1_X     LJP    *
          IFEQ   .X.,0
 P1       EQU    *-1
          ELSE
          IFGT   *,PPFW,4 
          QUAL
 .A.      MICRO  3,1, ".Y." 
 P1       EQU    1R".A."*10000+*-1
          QUAL   ".Y."
          ENDIF 
          ENDM
 ERROR    SPACE  4,10 
**        ERROR - CALL ERROR PROCESSOR. 
* 
*         ERROR  P1 
* 
*         ENTRY  P1 = ERROR CODE MNEMONIC.
*                IF P1 IS NOT SPECIFIED, THE ACCUMULATOR ALREADY
*                CONTAINS THE ERROR CODE MNEMONIC.
* 
*         EXIT   (A) = ERROR CODE.
* 
*         CALLS  ERR. 
  
  
          PURGMAC ERROR 
  
 .ERRJP   SET    0           INITIALIZE POINTER TO *RJM ERR*
  
 ERROR    MACRO  P1 
          MACREF ERROR
          IFC    NE,*P1**,1 
          OP=    /EMSG/P1,LDN,LDC 
 .1       IFLT   *-.ERRJP,40B 
          UJN    .ERRJP      GO TO *ERR* CALL 
 .ERRJP   SET    *-1
 .1       ELSE
 .ERRJP   SET    *
          RJM    ERR
 .1       ENDIF 
          ENDM
 EVAL     SPACE  4,10 
**        EVAL - EVALUATE PARAMETER PAIRS.
* 
*         EVAL   P1,P2,P3 
* 
*         ENTRY  P1 = CONSTANT. 
*                P2 = BASE ADDRESS. 
*                P3 = ADDRESS RESULT TO BE STORED IN. 
  
  
          PURGMAC  EVAL 
  
 EVAL     MACRO  P1,P2,P3 
          IFC    NE,?_P2_??,5 
          OP=    P2,LDD,LDM 
          IFEQ   P1,0,1 
          SKIP   4
          OP=    P1,ADN,ADC 
          SKIP   2
          IFC    NE,?_P1_??,3 
          OP=    P1,LDN,LDC 
          IFC    NE,?_P3_??,1 
          OP=    P3,STD,STM 
          ENDM
 EXOVL    SPACE  4,10 
**        EXOVL - EXECUTE OVERLAY.
* 
*         EXOVL  P1 
* 
*         ENTRY  P1 = PROCESSOR ADDRESS.
  
  
          PURGMAC EXOVL 
  
 .EXOVL   SET    0           INITIALIZE POINTER TO NEAREST *EXOVL*
  
 EXOVL    MACRO  P1 
          MACREF EXOVL
          LDN    P1/10000 
          STM    TFMA 
          LDC    P1-P1/10000*10000
 .1       IF     DEF,.EXOVLO
 .2       IFLT   *-.EXOVL,40B 
 .EX      SET    .EXOVL 
          UJN    .EX         GO LOAD OVERLAY
 .EXOVL   SET    *-1
 .2       ELSE
          LJM    .EXOVLO     GO LOAD OVERLAY
 .EXOVL   SET    *-2
 .2       ENDIF 
 .1       ELSE
 .EXOVLO  EQU    *
 .EXOVL   SET    *
          STM    TFMB 
          LJM    TFMA-1      LOAD OVERLAY 
 .1       ENDIF 
          ENDM
 EXSUB    SPACE  4,10 
**        EXSUB - EXECUTE SUBROUTINE. 
* 
*         EXSUB  P1 
* 
*         ENTRY  P1 = SUBROUTINE ADDRESS. 
  
  
          PURGMAC EXSUB 
  
 EXSUB    MACRO  P1 
          MACREF EXSUB
          RJM    P1-P1/10000*10000
          ENDM
 FCN      SPACE  4,10 
**        FCN - DEFINE FUNCTION PROCESSOR.
* 
* P1      FCN    P2,P3,P4,P5
* 
*         ENTRY  P1 = FUNCTION TABLE NAME.
*                     *BEGIN* FWA OF A TABLE. 
*                     *END*   END OF THE TABLE. 
*                P2 = FUNCTION CODE.
*                P3 = PROCESSOR ADDRESS.
*                P4 = CATALOG ACCESS MODE.
*                     4XXX = NOT ACCESSING CATALOG. 
*                     2XXX = NOT CHANGING CONTROL POINTS. 
*                P5 = MINIMUM FET LENGTH. 
*                     4XXX = NO BUFFER VALIDATION.
  
  
          PURGMAC FCN 
  
          MACRO  FCN,P1,P2,P3,P4,P5 
          MACREF FCN
          IFC    EQ,*P2*BEGIN*,3
 P1       BSS    0
          LOC    0
 .1       SKIP
          IFC    EQ,*P2*END*,3
          LOC    *O 
 P1_L     EQU    *-P1 
 .1       SKIP
          LOC    P2 
          CON    P3/10000,P3-P3/10000*10000 
 .2       IFC    NE,*P4** 
          CON    P4 
 .2       ELSE
          CON    0
 .2       ENDIF 
 .3       IFC    NE,*P5** 
          CON    P5 
 .3       ELSE
          CON    0
 .3       ENDIF 
 .1       ENDIF 
          ENDM
 LIA      SPACE  4,10 
**        LIA - LOAD INDIRECT ADDRESS TO A REGISTER.
* 
*         LIA    P1,P2
* 
*         ENTRY  P1 = BASE ADDRESS OF OPERAND.
*                P2 = ADDRESS OF THE INDEX FOR MODIFYING
*                     THE BASE ADDRESS OF THE OPERAND.
* 
*         EXIT   (A) = P1 + (P2). 
  
  
          PURGMAC LIA 
  
 LIA      MACRO  P1,P2
          MACREF LIA
          EVAL   P1,P2
          ENDM
 LDA      SPACE  4,11 
**        LDA - LOAD ABSOLUTE/RELATIVE ADDRESS. 
* 
*         LDA    P1,P2
* 
*         ENTRY  P1 = TWO CELLS WITH ADDRESS
*                P2 = CELL CONTAINING BIAS. 
*                   = *ABS* IF ADDRESS IS ABSOLUTE. 
*                     *REL* IF ADDRESS IS RELATIVE
*                     TO CONTROL POINT. 
* 
*         EXIT   (A) = (P1+(P2))+(P1+1+(P2)). 
*                (A) = (P1)*4096+(P1+1)  IF P2 = *ABS*
*                (A) = (P1)*4096+(RA)*64+(P1+1)  IF P2 = *REL*. 
  
          PURGMAC  LDA
  
 LDA      MACRO  P1,P2
          MACREF LDA
          IFC    EQ,*P2*REL*,7
          OP=    P1,LDD,LDM 
          LPN    77 
          SHN    6
          ADD    RA 
          SHN    6
          OP=    P1+1,ADD,ADM 
          SKIP   10 
          IFC    EQ,*P2*ABS*,5
          OP=    P1,LDD,LDM 
          LPN    77 
          SHN    14 
          OP=    P1+1,LMD,LMM 
          SKIP   4
          LDM    P1,P2
          LPN    77 
          SHN    14 
          LMM    P1+1,P2
          ENDM
 MMOVE    SPACE  4,10 
**        MMOVE - MEMORY MOVE.
* 
*         MMOVE  P1,P2,P3,P4,P5,P6
* 
*         ENTRY  P1 = FWA OF MOVE.
*                P2 = MODIFIER TO P1. 
*                P3 = FWA OF DESTINATION. 
*                P4 = MODIFIER TO P3. 
*                P5 = MOVE COUNT IN HALF BYTES. 
*                P6 = MOVE COUNT IN HALF BYTES, STORED IN MEMORY. 
* 
*         CALLS  MPM. 
  
  
          PURGMAC MMOVE 
  
 MMOVE    MACRO  P1,P2,P3,P4,P5,P6
          MACREF MMOVE
          EVAL   P1,P2,T1 
          EVAL   P3,P4,T2 
          EVAL   P5,P6
          RJM    MPM
          ENDM
 MULT3    SPACE  4,10 
**        MULT3 - MULTIPLY BY 3.
* 
*         MULT3  P1 
* 
*         ENTRY  (P1) = DIRECT CELL CONTAINING VALUE TO 
*                MULTIPLIED BY 3. 
* 
*         EXIT   (A) = SPECIFIED VALUE MULTIPLIED BY 3. 
  
  
          PURGMAC MULT3 
  
 MULT3    MACRO  P1 
          MACREF MULT3
          LDD    P1 
          SHN    1           *2 
          ADD    P1          *3 
          ENDM
 MULT4    SPACE  4,10 
**        MULT4 - MULTIPLY BY 4.
* 
*         MULT4 
* 
*         ENTRY  (A) = VALUE TO BE MULTIPLIED BY 4. 
* 
*         EXIT   (A) = (T1) = SPECIFIED VALUE MULTIPLIED BY 4.
* 
*         USES   T1.
  
  
          PURGMAC MULT4 
  
 MULT4    MACRO 
          MACREF MULT4
          SHN    2           *4 
          STD    T1 
          ENDM
 OVERLAY  SPACE  4,10 
**        OVERLAY - GENERATE OVERLAY CONSTANTS. 
* 
*         OVERLAY (P1),P2 
* 
*         ENTRY  P1 = ENTRY OF SUBTITLE.
*                P2 = SPECIFIES LOAD ADDRESS. 
  
  
          PURGMAC OVERLAY 
  
 OVERLAY  MACRO  P1,P2
          MACREF OVERLAY
          QUAL
 .X.      SET    .X.+1
 .A.      MICRO  .X.,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ
 .Y.      MICRO  1,3, "PREFIX"".A." 
          QUAL   ".Y."
          TTL    TFM/".Y." - P1 
          TITLE 
          IDENT  ".Y.",P2+5  P1 
*COMMENT  TFM - P1
          ORG    P2+5 
 .ERRJP   SET    0           RESET POINTER TO *RJM ERR* 
 .EXOVL   SET    0           INITIALIZE POINTER TO NEAREST *EXOVL*
          LJM    *
          UJN    *-2
          ENDM
 SAVEP    SPACE  4,10 
**        SAVEP - SAVE CATALOG POINTERS.
* 
*         SAVEP  P1 
* 
*         ENTRY  P1 = FWA OF FIVE CONSECUTIVE WORDS 
*                     TO STORE CELLS (BA - BA+4). 
  
  
          PURGMAC SAVEP 
  
 SAVEP    MACRO  P1 
          MACREF SAVEP
          LDD    MA 
          CWD    BA 
 .1       IF     DEF,P1 
 .2       IFLT   P1,100B
          CRD    P1 
 .2       ELSE
          CRM    P1,ON
 .2       ENDIF 
 .1       ELSE
          CRM    P1,ON
 .1       ENDIF 
          ENDM
 RESTP    SPACE  4,10 
**        RESTP - RESTORE CATALOG POINTERS. 
* 
*         RESTP  P1 
* 
*         ENTRY  P1 = FWA OF FIVE CONSECUTIVE BYTES 
*                     TO BE RETURNED TO CELLS BA - BA+4.
  
  
          PURGMAC RESTP 
 RESTP    MACRO  P1 
          MACREF RESTP
          LDD    MA 
 .1       IF     DEF,P1 
 .2       IFLT   P1,100B
          CWD    P1 
 .2       ELSE
          CWM    P1,ON
          SBN    1
 .2       ENDIF 
 .1       ELSE
          CWM    P1,ON
          SBN    1
 .1       ENDIF 
          CRD    BA 
          ENDM
 UDTRD    SPACE  4,10 
**        UDTRD - READ UDT WORD(S). 
* 
*         UDTRD  P1,P2,P3 
* 
*         ENTRY  P1 = ADDRESS OF RECEIVING BUFFER 
*                P2 = FIRST UDT WORD TO READ. 
*                P3 = NUMBER OF WORDS TO READ.
* 
*         CALLS  UDT. 
  
  
          PURGMAC UDTRD 
  
 UDTRD    MACRO  P1,P2,P3 
          MACREF UDTRD
          IFC    NE,*P1*T1*,2 
          OP=    P1,LDN,LDC 
          STD    T1 
          LDC    P3*10000+P2
          RJM    UDT
 UDT$     EQU    1           DEFINE UDT - READ/WRITE UDT ENTRY. 
          ENDM
 UDTWT    SPACE  4,10 
**        UDTWT - WRITE UDT WORD(S).
* 
*         UDTWT  P1,P2,P3 
* 
*         ENTRY  P1 = ADDRESS OF SENDING BUFFER.
*                P2 = FIRST UDT WORD TO WRITE.
*                P3 = NUMBER OF WORDS TO WRITE. 
* 
*         CALLS  UDT. 
  
  
          PURGMAC UDTWT 
  
 UDTWT    MACRO  P1,P2,P3 
          MACREF UDTWT
          IFC    NE,*P1*T1*,2 
          OP=    P1,LDN,LDC 
          STD    T1 
          LDC    P3*10000+100000+P2 
          RJM    UDT
 UDT$     EQU    1           DEFINE UDT - READ/WRITE UDT ENTRY. 
          ENDM
          TITLE  GLOBAL DIRECT CELL LOCATIONS.
***       GLOBAL DIRECT LOCATION ASSIGNMENTS. 
* 
*         THE FOLLOWING DIRECT CELLS ARE DEFINED AND
*         USED BY ALL OVERLAYS IN TFM, AND AS SUCH ARE
*         INVIOLATE. IN MANY CASES THEY ARE ORDER 
*         DEPENDENT SO CARE MUST BE USED IF CHANGES 
*         ARE REQUIRED. 
* 
*         S1, S2, AND S3 ARE DEFINED AS SCRATCH, THAT 
*         IS THEY CAN AND ARE REDEFINED AND USED BY 
*         PRESET AND ANY OVERLAY AS REQUIRED. ALL OF
*         THE REMAINING DIRECT CELLS ARE USED FOR 
*         SPECIFIC PURPOSES BY OVERLAYS AND TFM COMMON
*         SUBROUTINES.
  
  
 S1       EQU    16 - 22     SCRATCH (5 LOCATIONS)
 S2       EQU    23 - 27     SCRATCH (5 LOCATIONS)
 S3       EQU    30 - 34     SCRATCH (5 LOCATIONS)
 FN       EQU    35 - 41     FNT ENTRY (5 LOCATIONS)
 FS       EQU    42 - 46     FST ENTRY (5 LOCATIONS)
 EQ       EQU    FS          EQUIPMENT (FS+0) 
 TK       EQU    FS+1        TRACK (FS+1) 
 SC       EQU    FS+2        SECTOR (FS+2)
 FO       EQU    47          FNT ORDINAL
 FC       EQU    IR+2        FUNCTION CODE (REDEFINES IR+2) 
 BA       EQU    60          BUFFER ADDRESS 
 BP       EQU    61          BUFFER POINTER 
 CI       EQU    62          CATALOG INDEX
 RI       EQU    63 - 64     RANDOM INDEX (2 LOCATIONS) 
 PB       EQU    65          PARAMETER BLOCK ADDRESS
 KA       EQU    66          KEY ADDRESS
 KL       EQU    67          KEY LENGTH 
 EC       EQU    KL          ERROR CODE (REDEFINES KL)
          TITLE  ASSEMBLED LIST OF *COMPTFM* ROUTINES.
          SPACE  4
          ORG    PPFW 
          SPACE  4
          QUAL   COMPTFM
 COMPTFM  SPACE  4,10 
**        DEFINE ALL CONDITIONALS FOR *COMPTFM* LIST. 
  
  
 ABC$     EQU    1           DEFINE ABC - ADD BLOCK TO CHAIN
 AMD$     EQU    1           DEFINE AMD - AMEND PROCESSING
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 CAA$     EQU    1           DEFINE CAA - CHECK ALTERNATE USER ACCESS 
 CCB$     EQU    1           DEFINE CCB - CHECK CURRENT BUFFER
 CIE$     EQU    1           DEFINE CIE - CREATE INDEX ENTRY
 CMV$     EQU    1           DEFINE CMV - COMPARE/MOVE PP BYTE STRING 
 CSN$     EQU    1           DEFINE CSN - CONVERT SEQUENCE NUMBER 
 CVA$     EQU    1           DEFINE CVA - CLEAR VSN ASSIGNMENT
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK BLOCK
 EOI$     EQU    1           DEFINE EOI - SET END OF INFORMATION
 FAM$     EQU    1           DEFINE FAM - FORMAT ACCOUNT FILE MESSAGE 
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 GEP$     EQU    1           DEFINE GEP - GENERATE EMPTY PRU
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS BLOCK LINK 
 IAM$     EQU    1           DEFINE IAM - ISSUE ACCOUNT FILE MESSAGE
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 IDE$     EQU    1           DEFINE IDE - INSERT DATA ENTRY 
 IIE$     EQU    1           DEFINE IIE - INSERT INDEX ENTRY
 IRM$     EQU    1           DEFINE IRM - ISSUE RECOVERY MESSAGES.
 IRS$     EQU    1           DEFINE IRS - ISSUE RECOVERY MSG SUBROUTINE 
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 ISP$     EQU    1           DEFINE ISP - INITIALIZE SCRATCH PROCESSOR
 IUC$     EQU    1           DEFINE IUC - INCREASE USAGE COUNTER
 LNB$     EQU    1           DEFINE LNB - LINK NEXT BLOCK 
 LTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 MLT$     EQU    1           DEFINE MLT - (A) REGISTER MULTIPLY 
 PCE$     EQU    1           DEFINE PCE - PURGE CATALOG ENTRIES 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST ENTRY
 RCL$     EQU    1           DEFINE RCL - PP RECALL 
 RIB$     EQU    1           DEFINE RIB - ROOM IN BLOCK 
 RSP$     EQU    1           DEFINE RSP - RELEASE VSNS TO SCRATCH POOL
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 SCB$     EQU    1           DEFINE SCB - SEARCH CATALOG BUFFER 
 SCC$     EQU    1           DEFINE SCC - SUBSTITUTE CHAR. FOR COLON
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BLOCK
 SVB$     EQU    1           DEFINE SVB - SET VSN BUSY
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 UDT$     EQU    1           DEFINE UDT - READ/WRITE UDT ENTRY. 
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEXED SEARCH 
 UOP$     EQU    1           DEFINE UOP - UPDATE OUTPUT POINTER 
 UTR$     EQU    1           DEFUNE UTR - UPDATE TRT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VRR$     EQU    1           DEFINE VRR - VERIFY RANDOM REQUEST 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USERS BLOCK
 WES$     EQU    1           DEFINE WES - WRITE EOR/EOI SEQUENCE
 COMPTFM  SPACE  4,10 
**        DEFINE TEMPS FOR *COMPTFM* ASSEMBLY.
  
  
 CT       EQU    16          FILE CATAGORY TYPE 
 FT       EQU    25          FET FIRST POINTER
 IN       EQU    27          FET IN POINTER 
 LM       EQU    33          FET LIMIT POINTER
 MD       EQU    17          FILE ACCESS MODE 
 OT       EQU    31          FET OUTPUT POINTER 
 BUFA     EQU    *           ENTRY BUFFER ADDRESS 
 BUFB     EQU    BUFA+12     OVERFLOW BUFFER ADDRESS
 COMMON   SPACE  4,10 
**        COMMON DECKS FOR *COMPTFM* ASSEMBLY.
  
  
*CALL     COMPC2D 
*CALL     COMPWEI 
          LIST   F,X
*CALL     COMPTFM 
          LIST   *
          SPACE  4
          QUAL   *
          TITLE  MAIN PROGRAM.
          ORG    PPFW 
          SPACE  4
**        TFM - MAIN PROGRAM. 
* 
*         THE TFM MAIN LOOP IS THE ONLY ENTRY AND 
*         EXIT POINT IN TFM. FROM HERE ALL OVERLAYS 
*         ARE LOADED AND EXECUTED VIA A RETURN JUMP.
* 
*         ENTRY  (TFMC) = 6/ MASS STORAGE ERROR FLAGS,12/ ACCESS FLAGS. 
*                  ACCESS FLAGS = 1/ NA,1/ NC,4/ 0,6/ MD. 
*                    NA = NOT ACCESSING CATALOG.
*                    NC = NO CONTROL POINT CHANGE.
*                    MD = FAST ATTACH FILE ACCESS MODE. 
*                       = /PFM/PTLM IF LOCAL FILE MODE. 
* 
*         EXIT   CATALOG FILE RETURNED IF FAST ATTACH MODE. 
*                FST SET COMPLETE IF LOCAL FILE MODE. 
*                FET OR UDT SET COMPLETE. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  PLL, PPR, PRS, TFM SUBFUNCTION 
*                PROCESSORS.
* 
*         MACROS LDA, MONITOR, UDTRD, UDTWT.
  
  
  
 TFM      BSS    0           TFM MAIN ENTRY POINT 
          RJM    /PRESET/PRS PRESET PROGRAM 
          LDC    **          SET OVERLAY NAME 
 TFMA     EQU    *-1         (OVERLAY NAME) 
          ZJN    TFM1        IF NO OVERLAY REQUIRED 
          LMC    2L"PREFIX"  LOAD OVERLAY 
          RJM    EXR
 TFM1     RJM    **          EXECUTE PROCESSOR
 TFMB     EQU    *-1         (PROCESSOR ADDRESS)
          LDC    **          GET CATALOG ACCESS MODE
 TFMC     EQU    *-1         (MASS STORAGE ERROR FLAG/MODE FLAGS) 
          PJN    TFM2        IF NOT MASS STORAGE ERROR
          LDC    LDCI+0      CLEAR MASS STORAGE ERROR FLAG
          STM    TFMC-1 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    FS 
          SBN    1
          CRD    FN 
          ERROR  MSE         *EQXX, DNYY, MASS STORAGE ERROR.*
  
 TFM2     LPN    77 
          LMN    /PFM/PTLM
          NJN    TFM3        IF NOT LOCAL FILE MODE 
          LDD    FO 
          ZJN    TFM4        IF NO CATALOG FILE 
          RJM    AFA         READ LOCAL FST ENTRY 
          CRD    FS 
          AOD    FS+4        SET FST COMPLETE 
          LDD    FO          WRITE FST ENTRY
          RJM    AFA
          CWD    FS 
          UJN    TFM4        SET FET COMPLETE 
  
 TFM3     LMN    /PFM/PTLM   SET ACCESS MODE
          STD    T2 
          LDD    FO          SET FNT ORDINAL
          ZJN    TFM4        IF CATALOG NOT ATTACHED
          STD    T1 
          LDN    RFAS        SET RETURN FILE
          RJM    ARF         RETURN FAST ATTACH CATALOG 
 TFM4     LDD    FC 
          LMN    MAGF 
          ZJN    TFM6        IF CALLED BY *MAGNET*
          LDA    IR+3,REL    SET FET COMPLETE 
          CRD    CM 
          LDD    CM+4 
          SCN    1
          LMN    1
          STD    CM+4 
          LDA    IR+3,REL 
          CWD    CM 
 TFM5     MONITOR DPPM       DROP PP
          LJM    PPR         EXIT TO PP RESIDENT
  
 TFM6     EXOVL  CTC         COMPLETE *TFM* CALL BY *MAGNET*
*         UJN    DPP         EXIT PATH FROM *CTC* 
          TITLE  TFM RESIDENT SUBROUTINES.
 AFA      SPACE  4,10 
**        AFA - GET ABSOLUTE FST ADDRESS. 
* 
*         ENTRY  (A) = FNT ORDINAL IF SYSTEM FILE.
* 
*         EXIT   (A) = ABSOLUTE FNT ADDRESS.
* 
*         MACROS CFI, NFA.
  
  
 AFA      SUBR               ENTRY/EXIT 
 AFAA     BSS    0
*         CFI    FNT         GET FST ADDRESS FOR SYSTEM FILE
*AFAB     ADC    ** 
*         ADN    FSTG 
          NFA    FO,R        GET FST ADDRESS FOR LOCAL FILE 
          ADN    FSTL 
 AFAAL    EQU    *-AFAA      ROUTINE LENGTH 
          UJN    AFAX        RETURN 
 ARF      SPACE  4,10 
**        ARF - ATTACH/RETURN FAST ATTACH FILE. 
* 
*         ENTRY  (A) = AFAS IF ATTACH FILE. 
*                    = RFAS IF RETURN FILE. 
*                (T1) = SYSTEM FNT ORDINAL. 
*                (T2) = ACCESS MODE.
* 
*         EXIT   (A) = 0. 
*                (T1) = FNT ORDINAL.
*                (T2) = ACCESS MODE.
* 
*         USES   T1, T2, T3, CM - CM+4. 
* 
*         CALLS  AFA. 
* 
*         MACROS DELAY, MONITOR, PAUSE. 
  
  
 ARF      SUBR               ENTRY/EXIT 
          STD    T3          SAVE SUBFUNCTION 
 ARF1     LDD    T1          SET FNT ORDINAL
          STD    CM+4 
          RJM    AFA         READ FST ENTRY 
          CRD    FS 
          SBN    FSTG-FNTG   READ FNT ENTRY 
          CRD    FN 
          LDD    FN+3        CHECK FAT/MACHINE INDEX
          LPN    77 
          ZJN    ARF2        IF NOT GLOBAL FAST ATTACH FILE 
          LDD    FS          SET GLOBAL FAST ATTACH EST ORDINAL 
 ARF2     STD    CM+1        SET GLOBAL FILE FLAG 
          LDD    T2          SET MODE 
          STD    CM+2 
          LDD    T3 
          STD    CM+3 
          MONITOR AFAM       ATTACH OR RELEASE FILE 
          LDD    CM+1 
          ZJN    ARFX        IF FUNCTION COMPLETE 
          LDC    1400        PRESET DELAY 
          STM    T0 
 ARF3     DELAY 
*         LDN    0           RESET I/O PAUSE COUNTER
          STM    PFRA 
          RJM    PFR         PAUSE FOR RELOCATION 
          SOD    T0 
          PJN    ARF3        IF MORE DELAY NEEDED 
          UJP    ARF1        REISSUE FUNCTION 
 CCS      SPACE  4,10 
**        CCS - COMPARE CHARACTER STRING. 
* 
*         ENTRY  (A) = COMPARE LENGTH IN CHARACTERS.
*                (T1) = SOURCE ADDRESS FOR COMPARE. 
*                (T2) = OBJECT ADDRESS FOR COMPARE. 
* 
*         EXIT   (A) = 0 IF NAME(T1) = NAME(T2).
*                (A) .LT. 0 IF NAME(T1) .LT. NAME(T2).
*                (A) .GT. 0 IF NAME(T1) .GT. NAME(T2).
* 
*         USES   T0 - T2. 
  
  
 CCS2     LDI    T1          COMPARE BYTES
          SBI    T2 
          NJN    CCSX        IF BYTE(T1) .NE. BYTE(T2)
          AOD    T1          INCREMENT TO NEXT BYTE 
          AOD    T2 
          SOD    T0          DECREMENT CHARACTER COUNT
          SOD    T0 
          NJN    CCS1        IF NAME(T1) .NE. NAME(T2)
  
 CCS      SUBR               ENTRY/EXIT 
          STD    T0          SAVE CHARACTER COUNT 
 CCS1     SBN    1           CHECK FOR ODD COUNT
          NJN    CCS2        IF NOT ODD CHARACTER COUNT 
          LDI    T1          CHECK TRAILING CHARACTER 
          SCN    77 
          LMN    77 
          SBI    T2 
          SCN    77 
          UJN    CCSX        RETURN 
 CME      SPACE  4,10 
**        CME - CHECK FOR MASS STORAGE ERROR. 
* 
*         ENTRY  (A) = MASS STORAGE ERROR, IF PRESENT.
* 
*         EXIT   MASS STORAGE ERROR FLAG HAS BEEN SET IF PRESENT. 
* 
*         CALLS  PFR. 
* 
*         MACROS ENDMS. 
  
  
 CME      SUBR               ENTRY/EXIT 
          PJN    CME1        IF NO MASS STORAGE ERROR 
          LDC    LDCI+40     SET MASS STORAGE ERROR FLAG
          STM    TFMC-1 
 CME1     ENDMS              RELEASE CHANNEL RESERVE
          RJM    PFR         PAUSE FOR RELOCATION 
          UJN    CMEX        RETURN 
 CPM      SPACE  4,10 
**        CPM - CLEAR CONSECUTIVE PP MEMORY.
* 
*         ENTRY  (A) = HALF BYTE COUNT. 
*                (T1) = FWA OF AREA TO CLEAR. 
* 
*         EXIT   (A) = 0. 
*                AREA FROM (A) TO ((A)+(T1)) SET TO ZERO. 
* 
*         USES   T0, T1.
  
  
 CPM2     LDN    0           CLEAR ONE WORD 
          STI    T1 
          AOD    T1 
          SOD    T0 
 CPM3     SOD    T0          CHECK FOR TERMINATION
          NJN    CPM1        IF MORE TO CLEAR 
  
 CPM      SUBR               ENTRY/EXIT 
          STD    T0          SET WORD COUNT 
 CPM1     SBN    1           CHECK FOR ODD COUNT
          NJN    CPM2        IF NOT LAST CHARACTER
          LDI    T1          CLEAR UPPER 6 BITS 
          LPN    77 
          STI    T1 
          UJN    CPM3        DECREMENT COUNT AND RETURN 
 CTS      SPACE  4,10 
**        CTS - CONVERT TO ABSOLUTE TRACK/SECTOR. 
* 
*         ENTRY  (RI - RI+1) = CURRENT RANDOM ADDRESS.
* 
*         EXIT   (T5) = EQUIPMENT.
*                (T6) = TRACK (CALCULATED). 
*                (T7) = SECTOR (CALCULATED).
*                (RI - RI+1) = RANDOM ADDRESS (UNCHANGED).
* 
*         USES   T5 - T5+4. 
* 
*         CALLS  CRA. 
* 
*         MACROS ENDMS, ERROR, LDA, SETMS.
  
  
 CTS2     LDA    CTSA,ABS    RESTORE RANDOM ADDRESS 
          STD    RI+1 
          SHN    -14
          STD    RI 
  
 CTS      SUBR               ENTRY/EXIT 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    T5 
          LDA    RI,ABS      SAVE RANDOM ADDRESS
          ZJN    CTS1        IF SYSTEM SECTOR 
          STM    CTSA+1 
          SHN    -14
          STM    CTSA 
          SETMS  IO,RW       RESERVE CHANNEL
          RJM    CRA         CONVERT RANDOM ADDRESS 
          PJP    CTS2        IF NO RANDOM ADDRESS ERROR 
 CTS1     BSS    0
          ERROR  RAE         *RANDOM ADDRESS ERROR.*
  
 CTSA     CON    0,0         RANDOM ADDRESS CELLS 
 DPP      SPACE  4,10 
**        DPP - DROP PP.
* 
*         DEFINES THE TFM EXIT LOCATION FOR RELINQUISHING 
*         THE PPU WITHOUT CHANGING THE COMPLETION STATUS
*         FOR THE REQUEST.
  
  
 DPP      EQU    TFM5        DEFINE DROP PP LOCATION
 EDT      SPACE  4,10 
**        EDT - ENTER PACKED DATE/TIME. 
* 
*         ENTRY  (A) = ADDRESS OF WORD TO RECEIVE DATE/TIME.
* 
*         EXIT   PACKED DATE/TIME ENTERED IN 3 CONSECUTIVE
*                WORDS STARTING AT (A). 
* 
*         USES   CM - CM+4, T2. 
* 
*         MACROS MMOVE. 
  
  
 EDT      SUBR               ENTRY/EXIT 
          STD    T2 
          LDN    PDTL 
          CRD    CM 
          MMOVE  CM+2,,,,6
          UJN    EDTX        RETURN 
 EML      SPACE  4,10 
**        EML - EXIT TO MAIN LOOP.
* 
*         DEFINES THE TFM EXIT PATH FOR SETTING THE 
*         COMPLETION STATUS AND DROPPING THE PPU FOR
*         SPECIAL CASES AND ABNORMAL TERMINATION. 
  
  
 EML      EQU    TFM1+2      DEFINE EXIT TO MAIN LOOP LOCATION
 ERR      SPACE  4,10 
**        ERR - CALL ERROR PROCESSING OVERLAY.
* 
*         *ERR* IS CALLED EITHER DIRECTLY OR BY THE 
*         *ERROR* MACRO TO ENTER THE ERROR PROCESSING 
*         OVERLAY. IF TRP$ IS DEFINED, CODE IS ASSEMBLED
*         TO ALLOW THE PP TO BE STEPPED ON ANY ERROR
*         CONDITION BEFORE THE OVERLAY IS CALLED. THIS
*         PROVIDES A WAY TO DUMP THE PP ON A ERROR AND
*         INSURE THAT IT HAS NOT BEEN DESTROYED BY THE
*         OVERLAY LOAD. 
* 
*         THE FOLLOWING FORMAT WILL STEP THE PP ON ERRORS;
* 
*                STEP,*RSJM*,3,CODE.
* 
*         RSJM   = THE NUMERIC VALUE FOR THE *RSJM* 
*                  MONITOR FUNCTION.
*         CODE   = THE TFM ERROR CODE TO BE TRAPPED.
* 
*         ENTRY  (A) = ERROR CODE.
* 
*         EXIT   TO ERROR PROCESSING OVERLAY. 
* 
*         USES   EC, CM - CM+4
* 
*         CALLS  OVERLAY 5TA (NO RETURN)
* 
*         MACROS MONITOR. 
  
  
 ERR      SUBR               CALL ERROR OVERLAY 
          STD    EC          SAVE ERROR CODE
          IF     DEF,TRP$ 
          LDN    ZERL 
          CRD    CM 
          LDD    EC 
          STD    CM+3 
          LDM    ERR
          STD    CM+4 
          MONITOR RSJM
          ENDIF 
          EXOVL  TME         TAPE MANAGER ERROR PROCESSING
 GIB      SPACE  4,10 
**        GIB - GET INITIAL BLOCK.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM ADDRESS.
* 
*         EXIT   (A) = CURRENT RANDOM ADDRESS.
*                (BA) = UNCHANGED.
*                (BP) = (BA) + 2. 
*                (CPRI - CPRI+1) = CURRENT POSITION.
* 
*         USES   BP, CPRI - CPRI+1. 
* 
*         CALLS  RRP. 
  
  
 GIB      SUBR               ENTRY/EXIT 
          RJM    RRP         READ RANDOM PRU
          LDD    BA 
          ADN    2
          STD    BP 
          LDD    RI          SET CURRENT FILE POSITION
          STM    CPRI 
          SHN    14 
          LMD    RI+1 
          STM    CPRI+1 
          UJN    GIBX        RETURN 
 MBP      SPACE  4,13 
**        MBP - MOVE BUFFER POINTER.
* 
*         *MBP* ADVANCES THE BUFFER POINTER (BP) THE NUMBER OF
*         CM WORDS REQUESTED. 
* 
*         ENTRY  (A) = NUMBER OF CM WORDS TO MOVE.
*                (BA) = BUFFER ADDRESS. 
*                (BP) = ADDRESS OF CURRENT WORD.
* 
*         EXIT   (A) = ADDRESS OF REQUESTED WORD. 
*                (A) = 777777 IF END OF FILE ENCOUNTERED. 
*                (BP) = ADDRESS OF REQUESTED WORD.
* 
*         USES   T1, BA, BP.
* 
*         CALLS  RRP. 
* 
*         MACROS ERROR. 
  
  
 MBP1     ERROR  EBP         *ERRONEOUS BUFFER POINTER* 
  
 MBP2     LDD    T1          INCREMENT WORD COUNT 
          RAD    BP 
          LCN    0           SET END OF BUFFER
  
 MBP      SUBR               ENTRY/EXIT 
          STD    T1 
          SHN    2
          RAD    T1 
          LDD    BP          CHECK VALIDITY 
          SBD    BA 
          MJN    MBP1        IF OUT OF RANGE
          ADC    -502 
          PJN    MBP1        IF OUT OF RANGE
          ADD    T1 
          PJN    MBP2        IF MOVE OUTSIDE BUFFER 
          LDD    T1 
          RAD    BP          SET BUFFER POINTER 
          UJN    MBPX        RETURN 
 MPM      SPACE  4,10 
**        MPM - MOVE CONSECUTIVE PP MEMORY. 
* 
*         MOVE MUST BEGIN ON A WORD BOUNDARY. 
* 
*         ENTRY  (A) = MOVE COUNT IN CHARACTERS.
*                (T1) = FWA OF AREA TO MOVE.
*                (T2) = FWA OF RECEIVING AREA.
* 
*         EXIT   AREA FROM (T1) TO (T2) MOVED.
* 
*         USES   T0 - T2. 
  
  
 MPM2     LDI    T2          MOVE LAST CHARACTER
          LPN    77 
          STI    T2 
          LDI    T1 
          SCN    77 
          RAI    T2 
  
 MPM      SUBR               ENTRY/EXIT 
 MPM1     BSS    0
          ZJN    MPMX        IF NO MOVE COUNT 
          STD    T0 
          SBN    1           CHECK FOR ODD COUNT
          ZJN    MPM2        IF LAST MOVE HALF BYTE 
          LDI    T1          MOVE BYTE
          STI    T2 
          AOD    T1          INCREMENT TO NEXT BYTE 
          AOD    T2 
          SOD    T0          DECREMENT CHARACTER COUNT
          SOD    T0 
          UJN    MPM1        CHECK IF MOVE COMPLETE 
 PFR      SPACE  4,10 
**        PFR - PAUSE FOR RELOCATION. 
* 
*         *PFR* CHECKS THE I/O PAUSE LIMIT TO DETERMINE 
*         IF A PAUSE IS NECESSARY. IF A PAUSE IS REQUIRED 
*         THE PAUSE FLAG IS SET, AND THE COUNTER IS RESET 
*         TO *IOPL*.
* 
*         MACROS PAUSE. 
* 
  
  
 PFR      SUBR               ENTRY/EXIT 
          SOM    PFRA        DECREMENT PAUSE COUNTER
          PJN    PFRX        IF PAUSE NOT NECESSARY 
          PAUSE  -STSW
          LDK    IOPL        RESET PAUSE COUNTER
          STM    PFRA 
          UJN    PFRX        RETURN 
  
 PFRA     CON    IOPL        PAUSE COUNTER
 RRP      SPACE  4,10 
**        RRP - READ RANDOM PRU.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM INDEX.
* 
*         EXIT   (BA) = UNCHANGED.
*                (BP) = UNCHANGED.
*                BUFFER FILLED. 
* 
*         CALLS  CME, CTS, RDS. 
  
  
 RRP      SUBR               ENTRY/EXIT 
          RJM    CTS         CONVERT TO ABSOLUTE TRACK/SECTOR 
          LDD    BA          SET BUFFER 
          RJM    RDS         READ SECTOR
          RJM    CME         CHECK FOR MASS STORAGE ERROR 
          UJN    RRPX        RETURN 
 WRP      SPACE  4,10 
**        WRP - WRITE RANDOM PRU. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (RI - RI+1) = RANDOM ADDRESS.
* 
*         EXIT   WRITE OR REWRITE OF PRU. 
* 
*         CALLS  CME, CTS, EDT, WDS.
  
  
 WRP      SUBR               ENTRY/EXIT 
          RJM    CTS         CONVERT TO ABSOLUTE TRACK/SECTOR 
          LIA    CWDT,BA
          RJM    EDT         ENTER PACKED DATE/TIME 
          LDD    BA          SET BUFFER 
          RJM    WDS         WRITE SECTOR 
          RJM    CME         CHECK FOR MASS STORAGE ERROR 
          UJP    WRPX        RETURN 
          SPACE  4,10 
***       RESIDENT COMMON DECKS.
  
  
*CALL     COMPCRA 
*CALL     COMPSEI 
*CALL     COMPSRA 
          TITLE  RESIDENT WORKING STORAGE.
          SPACE  4,10 
***       WORKING STORAGE.
  
  
 CPRI     BSSZ   2           CURRENT POSITION RANDOM INDEX
 CPEB     BSSZ   2           CURRENT POSITION EMPTY BLOCK 
 CPSB     BSSZ   5           CURRENT POSITION SYSTEM BUFFER 
 CPPI     BSSZ   5           CURRENT POSITION PRIMARY INDEX 
 CPSI     BSSZ   5           CURRENT POSITION SECONDARY INDEX 
 CPCB     BSSZ   5           CURRENT POSITION CATALOG BUFFER
 CPAB     BSSZ   5           CURRENT POSITION ADMIT BUFFER
 CPHP     BSSZ   5           CURRENT POSITION HOLE POINTER
 UTMS     BSSZ   5           *UTMS* FROM *MAGNET* 
 UDTA     CON    0           CURRENT UDT ADDRESS BEING PROCESSED
 ISBA     CON    BUF0,BUF1   INDEXED SEARCH BUFFER ADDRESS
 MFID     EQU    TFM         MAINFRAME I.D. 
 CDMX     EQU    TFM+1       CATALOG DEVICE MACHINE INDEX-1 
 DFFO     CON    0           RSXDID FILE FNT ORDINAL IF ATTACHED
          ERRZR  RDFO        ORDINAL MUST BE NON-ZERO 
 SCRP     CON    0           ADDRESS IN *TMST* OF CORRECT SCRATCH POOL
 TFMF     SPACE  4,10 
***       TFMF - TFM FLAGS. 
* 
*         FLAGS - 
*                0010 = NOTIFY OPERATOR ON ANY ERROR. 
  
 TFMF     BSS    0
          VFD    8/0         RESERVED FOR FUTURE USE
          VFD    1/0         NOTIFY OPERATOR ON ERROR 
          VFD    3/0         RESERVED FOR FUTURE USE
  
          SPACE  4,10 
***       PARAMETER BUFFER. 
* 
  
  
 PFAM     BSSZ   5           FAMILY NAME/INDEX
 PBUN     BSSZ   5           USERNAME FOR CATALOG SEARCH
 PBUF     BSSZ   TFPL*5      PARAMETER BUFFER 
          SPACE  4,10 
***       FET PARAMETER BUFFER (PP BYTE POSITIONS). 
  
  
 PESN     EQU    FBES*5+PBUF    EXTERNAL VOLUME SERIAL NUMBER (36 BITS) 
 PFLG     EQU    FBES*5+3+PBUF  MISC FLAGS
 PFTD     EQU    FBTD*5+PBUF    TAPE DESCRIPTORS (60 BITS)
 PVSN     EQU    FBVS*5+PBUF    INTERNAL VOLUME SERIAL NUMBER (36 BITS) 
 PBFA     EQU    PVSN+3         FILE ACCESSIBILITY (6 BITS) 
 PBSN     EQU    PVSN+3         FILE SECTION NUMBER (18 BITS) 
 POFI     EQU    FBFI*5+PBUF    FILE IDENTIFIER (OLD - 102 BITS)
 PBQN     EQU    POFI+10B       FILE SEQUENCE NUMBER (18 BITS)
 PBSI     EQU    FBSI*5+PBUF    SET IDENTIFIER (36 BITS)
 PBVN     EQU    PBSI+3         VERSION NUMBER (9 BITS) 
 PBGN     EQU    PBSI+3         GENERATION NUMBER (15 BITS) 
 PNFI     EQU    FBNI*5+PBUF    FILE IDENTIFIER (NEW - 102 BITS)
 PBCE     EQU    PNFI+11        CLEAR ERROR FLAG (UPPER 6 BITS) 
 PBAN     EQU    PNFI+11        CHANGE CHARGE/PROJECT (LOWER 6 BITS)
 PBCR     EQU    FBCR*5+PBUF    LABEL CREATION/RETENTION DATE (60 BITS) 
 PAUN     EQU    FBUN*5+PBUF    ALTERNATE USERNAME (42 BITS)
 PBTO     EQU    PAUN+3         TAPE OPTIONS (LOWER 18 BITS)
 PUCW     EQU    PAUN           USER CONTROL WORD (60 BITS) 
 PPWD     EQU    FBPW*5+PBUF    FILE PASSWORD (42 BITS) 
 PBAC     EQU    PPWD+3         AUDIT ACCESS MODE (LOWER 6 BITS)
 PBCT     EQU    PPWD+4         FILE CATEGORY (UPPER 6 BITS)
 PBMD     EQU    PPWD+4         FILE ACCESS MODE (LOWER 6 BITS) 
          SPACE  4,10 
***       VSN PARAMETER BUFFER (PP BYTE POSITIONS). 
  
  
 PVES     EQU    VBES+PBUF   EXTERNAL VSN 
 PVCI     EQU    VBCI+PBUF   CATALOG RANDOM INDEX 
 PVVS     EQU    VBVS+PBUF   INTERNAL VSN 
 PVRC     EQU    VBRC+PBUF   REEL COUNT (UPPER 6 BITS)
 PVST     EQU    VBST+PBUF   VSN STATUS (I8 BITS) 
 PVFV     EQU    VBFV+PBUF   FIRST VSN OF SET 
 PVJS     EQU    VBJS+PBUF   EJT ORDINAL
 PVNV     EQU    VBNV+PBUF   NEXT VSN OF SET (36 BITS)
          TITLE  OVERLAYABLE SUBROUTINES (LEVEL 1). 
          SPACE  4,10 
***       LEVEL 1 OVERLAYS. 
* 
*         LEVEL 1 OVERLAYABLE CODE WILL BE DESTROYED BY 
*         AN OVERLAY LOAD AT *OVL1*.
  
  
 OVL1     EQU    *           DEFINE FIRST LEVEL OVERLAY ADDRESS 
          SPACE  4
          QUAL   PRESET 
          SPACE  4,10 
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 SI       EQU    S2+2        SUBSYSTEM ID 
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 CN       EQU    FN - FN+4   FAMILY NAME (COMPFAT)
 FA       EQU    S1          FNT ORDINAL (COMPSAF)
 MAGF     SPACE  4,10 
***       MAGF - *MAGNET* REQUEST FUNCTION. 
* 
*         THIS FUNCTION CAN ONLY BE CALLED  BY *MAGNET*.
*         *MAGNET* WILL ISSUE THIS REQUEST WITH A SUB-
*         FUNCTION CODE IN BYTE 0 OF UDT+UTMS, AND CALL 
*         TFM WITHOUT AUTO-RECALL. THIS IS THE ONLY 
*         TFM RA+1 REQUEST VALIDATED FOR NO AUTO-RECALL.
* 
*         ENTRY  (FC) = MAGF. 
*                (IR+4) = UDT ADDRESS.
* 
*         EXIT   (TFMA) = OVERLAY NAME. 
*                (TFMB) = PROCESSOR ADDRESS.
*                (TFMC) = CATALOG ACCESS MODE.
*                (UDTA) = UDT ADDRESS.
* 
*         USES   CM - CM+4, S1 - S1+4, T1.
* 
*         CALLS  CCP, CRS, GUO, TTB.
* 
*         MACROS ERROR, FCN, MULT4, UDTRD, UDTWT. 
* 
  
  
 MAG      SUBR               ENTRY/EXIT 
          LDD    IR+4 
          STM    UDTA 
          RJM    CRS         CHECK RECALL STATUS
          NJN    MAG1        IF CALLED WITH AUTO-RECALL 
          LDD    SI          CHECK SUBSYSTEM ID 
          LMK    MTSI 
          NJN    MAG1        IF NOT CALLED BY *MAGNET*
          UDTRD  UTMS,/MTX/UTMS,1 
          LDM    UTMS+4 
          LPN    RSIL 
          ZJN    MAG1        IF INTERLOCK NOT SET 
          LDM    UTMS        SET SUBFUNCTION CODE 
          ZJN    MAG1        IF INCORRECT FUNCTION
          SBN    1
          MULT4              MULTIPLY (FUNCTION-1)*4
          ADC    -MAGAL 
          MJN    MAG2        IF LEGAL FUNCTION
 MAG1     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 MAG2     LDM    MAGA,T1     SET OVERLAY NAME 
          LPN    77 
          STM    TFMA 
          LDM    MAGA+1,T1   SET PROCESSOR ADDRESS
          STM    TFMB 
          LDM    MAGA+2,T1   SET FILE ACCESS MODE 
          STM    TFMC 
          UDTRD  S1,/MTX/UTCI,1 
          LDD    S1+1 
          ZJN    MAG3        IF NO *POSMF* IN PROGRESS
          UDTRD  CM,/MTX/UCIB,1 
          LDD    CM 
          SHN    -2 
          LPC    377
          LMN    22 
          ZJN    MAG3        IF *CIO* FUNCTION NOT *POSMF*
*         UJN    MAG3        (*SKIP SETTING FUNCTION TO *CPPS*) 
 MAGB     EQU    *-1
          LDM    UTMS+4      SET *RE-ISSUE REQUEST* 
          SCN    RSRR 
          LMN    RSRR 
          STM    UTMS+4 
          LDN    CPPS*4-4    SET *CPPS* INTERNAL FUNCTION 
          STD    T1 
          ISTORE  MAGB,(UJN MAG3  )  SKIP SETTING FUNCTION TO *CPPS*
          LJM    MAG2        RESET FUNCTION 
  
 MAG3     LDM    TFMC 
          SHN    21-12
          MJN    MAG5        IF NOT CHANGING CONTROL POINTS 
          RJM    CCP         CHANGE TO USER CONTROL POINT 
          ZJN    MAG5        IF CONTROL POINT CHANGED 
 MAG4     LJM    MAG7        JOB NOT AT CONTROL POINT 
  
 MAG5     UDTRD  PBUN,/MTX/UUFN,1 
          UDTRD  PESN,/MTX/UESN,1 
          UDTRD  PVSN,/MTX/UISN,1 
          LDC    7S12+PBUN
          RJM    TTB         TRIM TRAILING BLANKS 
          LDM    TFMC        CHECK IF PARAMETER BLOCK NEEDS UPDATE
          SHN    21-11
          PJN    MAG6        IF NO UPDATE FROM UDT NEEDED 
          RJM    GUO         GET USER OPTIONS FROM UDT
 MAG6     LJM    MAGX        RETURN 
  
 MAG7     LDM    UTMS+4      SET REISSUE REQUEST
          SCN    RSRR 
          LMN    RSRR 
          STM    UTMS+4 
          LDM    UTMS+3      SET WAIT FOR JOB ROLLIN
          SCN    WUJR 
          LMN    WUJR 
          STM    UTMS+3 
 MAG8     LJM    EML         EXIT TO MAIN LOOP
  
  
 MAGA     FCN    BEGIN
          FCN    AVSS,AVF,2000+/PFM/PTWR  ADVANCE VSN FILE
          FCN    CPPS,CPP,2000+/PFM/PTUP  CLEAR *POSMF* CATALOG POINTER 
          FCN    RFVS,AVF,2000+/PFM/PTUP  REWIND TO FIRST VOLUME
          FCN    RTFS,RRF,3000+/PFM/PTUP  RETURN/RESERVE TAPE FILE
          FCN    UCES,UCE,3000+/PFM/PTWR  UPDATE CATALOG ENTRY
          FCN    VMFS,VMF,1000+/PFM/PTWR  VALIDATE MULTI-FILE SET 
          FCN    VTLS,VTL,3000+/PFM/PTWR  VERIFY TAPE LABELS
 MAGA     FCN    END
 RSXF     SPACE  4,10 
***       RSXF - *RESEX* REQUEST FUNCTION.
* 
*         THIS FUNCTION IS CALLED ONLY BY *RESEX* ON
*         FIRST REEL ASSIGNMENT. IT MUST BE CALLED
*         WITH AUTO-RECALL SET BY A JOB WITH AN SSJ=
*         ENTRY POINT.
* 
*         ENTRY  (FC) = RSXF. 
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (TFMA) = OVERLAY NAME. 
*                (TFMB) = PROCESSOR ADDRESS.
*                (TFMC) = CATALOG ACCESS MODE.
* 
*         USES   CM - CM+4, S1 - S1+4, T1.
* 
*         CALLS  BPB, CFS, SUL. 
* 
*         MACROS ERROR, FCN, LDA, MULT4.
  
  
 RSX      SUBR               ENTRY/EXIT 
          LDN    SSTL        CHECK IF TMS IS ENABLED
          CRD    CM 
          LDD    CM+2 
          SHN    21-0 
          PJN    RSX1        IF TMS ENABLED 
          ERROR  TMD         *TMS DISABLED.*
  
 RSX1     LDD    CP          CHECK FOR SSJ= 
          ADC    SEPW 
          CRD    CM 
          LDD    CM 
          SHN    21-2 
          PJN    RSX2        IF NO SSJ= ENTRY POINT 
          LDA    IR+3,REL    SET SUBFUNCTION CODE 
          CRD    S1 
          LDD    S1+4 
          SHN    -3 
          LPN    77 
          ZJN    RSX2        IF INCORRECT FUNCTION
          SBN    1
          MULT4              MULTIPLY (FUNCTION-1)*4
          ADC    -RSXAL 
          MJN    RSX3        IF LEGAL FUNCTION
 RSX2     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 RSX3     LDM    RSXA,T1     SET OVERLAY NAME 
          LPN    77 
          STM    TFMA 
          LDM    RSXA+1,T1   SET PROCESSOR ADDRESS
          ZJN    RSX2        IF NOT DEFINED 
          STM    TFMB 
          LDM    RSXA+2,T1   SET FILE ACCESS MODE 
          STM    TFMC 
          LDM    RSXA+3,T1
          RJM    CFS         CHECK FET STATUS 
          RJM    BPB         BUILD PARAMETER BLOCK
          LDM    BPBA        ADDRESS OF USERNAME
          STD    T0 
          LDI    T0 
          ZJN    RSX4        IF NO USERNAME 
          RJM    SUL         SET UDT ADDRESS FROM LOCAL FILE
          LJM    RSXX        RETURN 
  
 RSX4     ERROR  TPI         *TMS PROCESSING INHIBITED.*
  
 RSXA     FCN    BEGIN
          FCN    RFAS,RFA,/PFM/PTWR,4020  FIRST-REEL ASSIGNMENT 
          FCN    RAPS,RAP,/PFM/PTWR,4020  ABORT PROCESSING
          FCN    MFAS,MFA,/PFM/PTWR,4020  MULTI-FILE SET ASSIGNMENT 
 RSXA     FCN    END
 SSJF     SPACE  4,10 
***       SSJF - SSJ= REQUEST FUNCTION. 
* 
*         THIS FUNCTION IS CALLED ONLY BY *TFSP*, THE 
*         TMS TAPE FILE SUPERVISOR. IT MUST BE CALLED 
*         WITH AUTO-RECALL SET BY A JOB WITH A SSJ= 
*         ENTRY POINT.
* 
*         ENTRY  (FC) = SSJF. 
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (TFMA) = OVERLAY NAME. 
*                (TFMB) = PROCESSOR ADDRESS.
*                (TFMC) = CATALOG ACCESS MODE.
* 
*         USES   CM - CM+4, S1 - S1+4, T1.
* 
*         CALLS  BPB, CFS, CRS. 
* 
*         MACROS ERROR, FCN, LDA, MULT4.
  
  
 SSJ      SUBR               ENTRY/EXIT 
          RJM    CRS         CHECK RECALL STATUS
          ZJN    SSJ1        IF NOT CALLED WITH AUTO-RECALL 
          LDD    CP 
          ADC    SEPW 
          CRD    CM 
          LDD    CM          CHECK FOR SSJ= ENTRY POINT 
          SHN    21-2 
          PJN    SSJ1        IF NOT SSJ= JOB
          LDA    IR+3,REL    SET SUBFUNCTION CODE 
          CRD    S1 
          LDD    S1+4 
          SHN    -3 
          LPN    77 
          ZJN    SSJ1        IF INCORRECT FUNCTION
          SBN    1
          MULT4              MULTIPLY (FUNCTION-1)*4
          ADC    -SSJAL 
          MJN    SSJ2        IF LEGAL REQUEST CODE
 SSJ1     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 SSJ2     LDM    SSJA,T1     SET OVERLAY NAME 
          LPN    77 
          STM    TFMA 
          LDM    SSJA+1,T1   SET PROCESSOR ADDRESS
          ZJN    SSJ1        IF NOT DEFINED 
          STM    TFMB 
          LDM    SSJA+2,T1   SET FILE ACCESS MODE 
          STM    TFMC 
          LDM    SSJA+3,T1
          RJM    CFS         CHECK FET STATUS 
          RJM    BPB         BUILD PARAMETER BLOCK
          LJM    SSJX        RETURN 
  
 SSJA     FCN    BEGIN
          FCN    AUCS,AUD,/PFM/PTRU,20    AUDIT TAPE CATALOG
          FCN    CUAS,CUA,/PFM/PTUP,4005  CLEAR UTILITY ACTIVE
          FCN    DVES,DVE,/PFM/PTWR,5     DELETE VSN ENTRY(S) 
          FCN    GNSS,GNS,/PFM/PTWR,7     GET NEXT SCRATCH
          FCN    ICES,ICE,/PFM/PTWR,20    INSERT CATALOG ENTRY
          FCN    ISFS,ISF,/PFM/PTWR,4005  INITIALIZE FAMILY CATALOG 
          FCN    IUES,IUE,/PFM/PTWR,5     INSERT USERNAME ENTRY(S)
          FCN    LAES,LAE,/PFM/PTRU,7     LIST ADMIT ENTRY(S) 
          FCN    LVES,LVE,/PFM/PTUP,5     LIST VSN ENTRY(S) 
          FCN    RAES,RAE,/PFM/PTWR,7     REPLACE/ADD ADMIT ENTRY(S)
          FCN    RCES,RCE,/PFM/PTUP,20    REPLACE CATALOG ENTRY 
          FCN    RDRS,RDR,/PFM/PTRU,7     BLOCK READ REQUEST
          FCN    RTCS,RLS,/PFM/PTUP,4020  RELEASE TAPE CATALOG
          FCN    RVES,RAV,/PFM/PTWR,5     REPLACE/ADD VSN ENTRY(S)
          FCN    SUAS,SUA,/PFM/PTUP,4005  SET UTILTY ACTIVE 
          FCN    WRRS,WRR,/PFM/PTUP,7     BLOCK REWRITE REQUEST 
 SSJA     FCN    END
 TCSF     SPACE  4,10 
***       TCSF - TFM COMMAND FUNCTION.
* 
*         THIS FUNCTION REQUIRES NO SPECIAL VALIDATION
*         AND IS USED TO PROCESS TMS SPECIFIC 
*         COMMAND REQUESTS. IT MUST BE CALLED WITH
*         AUTO-RECALL SET AND TMS ENABLED.
* 
*         ENTRY  (FC) = TCSF. 
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (TFMA) = OVERLAY NAME. 
*                (TFMB) = PROCESSOR ADDRESS.
*                (TFMC) = CATALOG ACCESS MODE.
* 
*         USES   CM - CM+4, S1 - S1+4, T1.
* 
*         CALLS  BPB, CFS, CRS. 
* 
*         MACROS ERROR, FCN, LDA, MULT4.
  
  
 TCS      SUBR               ENTRY/EXIT 
          LDN    SSTL        CHECK IF TMS IS ENABLED
          CRD    CM 
          LDD    CM+2 
          SHN    21-0 
          PJN    TCS1        IF TMS ENABLED 
          ERROR  TMD         *TMS DISABLED.*
  
 TCS1     RJM    CRS         CHECK RECALL STATUS
          ZJN    TCS2        IF NOT CALLED WITH AUTO-RECALL 
          LDA    IR+3,REL    SET SUBFUNCTION CODE 
          CRD    S1 
          LDD    S1+4 
          SHN    -3 
          LPN    77 
          ZJN    TCS2        IF INCORRECT FUNCTION
          SBN    1
          MULT4              MULTIPLY (FUNCTION-1)*4
          ADC    -TCSAL 
          MJN    TCS3        IF LEGAL FUNCTION
 TCS2     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 TCS3     LDM    TCSA,T1     SET OVERLAY NAME 
          LPN    77 
          STM    TFMA 
          LDM    TCSA+1,T1   SET PROCESSOR ADDRESS
          ZJN    TCS2        IF NOT DEFINED 
          STM    TFMB 
          LDM    TCSA+2,T1   SET FILE ACCESS MODE 
          STM    TFMC 
          LDM    TCSA+3,T1
          RJM    CFS         CHECK FET STATUS 
          RJM    BPB         BUILD PARAMETER BLOCK
          LDM    BPBA        ADDRESS OF USERNAME
          STD    T0 
          LDI    T0 
          ZJN    TCS4        IF NO USERNAME 
          LJM    TCSX        RETURN 
  
 TCS4     ERROR  TPI         *TMS PROCESSING INHIBITED.*
  
 TCSA     FCN    BEGIN
          FCN    RSVS,RSV,/PFM/PTUP,4005  RESERVE 
          FCN    ADMS,ADM,/PFM/PTWR,4020  ADMIT 
          FCN    AUDS,AUD,/PFM/PTRU,20    AUDIT 
          FCN    AMDS,AMD,/PFM/PTUP,4020  AMEND 
          FCN    RLSS,RLS,/PFM/PTUP,4020  RELEASE 
          FCN    GVSS,GVS,/PFM/PTRU,5     GET VSN 
 TCSA     FCN    END
          SPACE  4
          TITLE  RESIDENT SUBFUNCTIONS (LEVEL 2). 
 CUAS     SPACE  4,10 
***       CUAS - CLEAR UTILITY ACTIVE.
* 
*         *CUAS* IS CALLED ONLY BY *TFSP* TO CLEAR THE
*         INTERLOCKS WHICH WERE SET BY A PREVIOUS CALL. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER. 
*                (FA) = CATALOG FNT ORDINAL.
*                (RI - RI+1) = RANDOM ADDRESS OF *TMST* 
*                *TMST* READ TO (BA). 
* 
*         EXIT   *TMST* REWRITTEN.
*                TMS EVENT ISSUED.
* 
*         USES   CM - CM+4. 
* 
*         CALLS   WRP.
* 
*         MACROS MONITOR. 
  
  
 CUA      ENTRY              ENTRY/EXIT 
          LDM    SBST+1,BP   CLEAR UTILITY ACTIVE INTERLOCK 
          SCN    UITS 
          STM    SBST+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          LDN    ZERL        ENTER TMS EVENT
          CRD    CM 
          LDN    ESUA 
          STD    CM+4 
          MONITOR EATM
          UJN    CUAX        RETURN 
 SUAS     SPACE  4,10 
***       SUAS - SET UTILITY ACTIVE.
* 
*         *SUAS* IS USED BY *TFSP* TO SET THE UTILITY 
*         INTERLOCK SO THAT ONLY *TFSP* CAN HAVE
*         ACCESS TO THE CATALOG.
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER. 
*                (FA) = CATALOG FNT ORDINAL.
*                *TMST* READ TO (BA). 
* 
*         EXIT   UTILITY ACTIVE AND JOB SEQUENCE
*                NNUMBER SET IN *TMST*. 
* 
*         USES   CM - CM+4. 
* 
*         CALLS  WRP. 
  
  
 SUA      ENTRY              ENTRY/EXIT 
          LDM    SBST+1,BP   SET UTILITY INTERLOCK STATUS 
          SCN    UITS 
          LMN    UITS 
          STM    SBST+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          UJN    SUAX        RETURN 
 VMF      SPACE  4,10 
***       VMF - VALIDATE MULTI-FILE SET ACCESS. 
* 
*         ENTRY  (UTMS+2) = 0 IF FILE NOT WRITTEN TO. 
* 
*         EXIT   TO *RDC* IF CURRENT FILE WAS WRITTEN ON. 
*                TO *PMF* IF CURRENT FILE WAS ONLY READ.
* 
*         CALLS  CME, PMF, RDC. 
* 
*         MACROS EXOVL. 
  
  
 VMF      ENTRY              ENTRY/EXIT 
          RJM    CME         CHECK FOR MEDIA ERROR
          LDM    UTMS+2 
          NJN    VMF1        IF FILE WRITTEN TO 
          EXOVL  PMF         PROCESS MULTI-FILE REQUEST 
  
 VMF1     EXOVL  RDC         RELEASE DELETED CATALOG ENTRIES
 AVF      SPACE  4,10 
***       AVF - ADVANCE VSN FILE. 
* 
*         *AVF* CALL *CME* TO DETERMINE IF ERROR AND MAINTENANCE FLAGS
*         SHOULD BE SET, AND CALL *AVS* TO SET THE NEXT VOLUME
*         OF TAPE IN THE UDT. 
* 
*         ENTRY  NONE.
* 
*         EXIT   TO *AVS* TO ADVANCE VSN FILE.
* 
*         CALLS  AVS, CME.
* 
*         MACROS EXOVL. 
  
  
 AVF      ENTRY              ENTRY/EXIT 
          RJM    CME         CHECK FOR MEDIA ERRORS 
          EXOVL  AVS         ADVANCE VSN FILE 
 RRF      SPACE  4,10 
***       RRF - RETURN/RESERVE TAPE FILE. 
* 
*         *RRF* CALL *CME* TO DETERMINE IF ERROR AND MAINTENANCE FLAGS
*         SHOULD BE SET AND CALL *RTF* TO PROCESS RETURN TAPE FILES.
* 
*         ENTRY  NONE.
* 
*         EXIT   TO *RTF* TO RETURN TAPE FILES. 
* 
*         CALLS  CME, RTF.
* 
*         MACROS EXOVL. 
  
  
 RRF      ENTRY              ENTRY/EXIT 
          RJM    CME         CHECK FOR MEDIA ERRORS 
          EXOVL  RTF         RETURN TAPE FILES. 
 CME      SPACE  4,10 
***       CME - CHECK FOR MEDIA ERRORS. 
* 
*         ENTRY  NONE.
* 
*         EXIT   THE ERROR AND MAINTENANCE FLAGS ARE SET IN THE VSN 
*                ENTRY, AND DATA ERROR WILL BE FLAGGED IN THE 
*                CATALOG ENTRY, IF THE UNRECOVERED FLAG IS SET. 
* 
*         USES   BA, CI, KA, RI - RI+1, 
* 
*         CALLS  GIB, MBP, RRP, VIS, VSP, WRP.
* 
*         MACROS SAVEP, UDTRD, UDTWT. 
  
  
 CME5     LDN    0
          STM    UTMS+1      CLEAR THE RECOVERED ERROR COUNT
          LDM    UTMS+4 
          LPC    7577 
          STM    UTMS+4      CLEAR THE UNRECOVERED ERROR FLAG 
          UDTWT  UTMS,/MTX/UTMS,1 
          LDC    BUF0        RESTORE SYSTEM BLOCK 
          STD    BA 
          LDN    TMSB 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTERS 
          SAVEP  CPSB        SAVE BUFFER POINTERS 
  
 CME      SUBR               ENTRY/EXIT 
          UDTRD  CM,/MTX/UTCI,1  READ CATALOG ENTRY 
          LDD    CM+3 
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDD    CM+4 
          STD    RI+1 
          LDC    BUF0        SET BUFFER 
          STD    BA 
          RJM    RRP         GET INITIAL BLOCK (CATALOG)
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    CMEX        IF ERROR IN CATALOG INDEX
          LDM    UTMS+4 
          SHN    21-7 
          MJN    CME2        IF UNRECOVERED ERROR FLAG SET
          LDC    REMT 
          NJN    CME1        IF NOT DISABLES RECOVERED ERROR THRESHOLD
          LJM    CME5        CLEAR THE UNRECOVERED ERROR FLAG 
  
 CME1     SBM    UTMS+1 
          MJN    CME3        IF COUNT GREATER THAN THRESHOLD LIMIT
          ZJN    CME3        IF COUNT EQUAL TO THRESHOLD LIMIT
          LJM    CME5        IF COUNT LESS THAN THRESHOLD LIMIT 
  
 CME2     LDM    CBST,BP
          SCN    2
          LMN    2
          STM    CBST,BP     SET DATA ERROR FLAG IN CATALOG ENTRY 
          RJM    WRP         WRITE RANDOM PRU 
 CME3     LDC    PESN        FIND CURRENT VSN 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    CME4        IF VSN FOUND 
          LJM    CMEX        RETURN 
  
 CME4     LDM    VBST,BP
          SCN    HMVS/10000 
          LMN    HMVS/10000 
          STM    VBST,BP     SET MAINTENANCE FLAG IN VSN ENTRY
          LDM    VBST+1,BP
          SCN    ERVS 
          LMN    ERVS 
          STM    VBST+1,BP   SET ERROR FLAG IN VSN ENTRY
          RJM    WRP         WRITE RANDOM PRU 
          LJM    CME5        CLEAR UNRECOVERED FLAG 
          SPACE  4
***       COMMON DECKS. 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ON ENTRY
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS LINK 
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 SVB$     EQU    1           DEFINE SVB - SET VSN BUSY
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 UTR$     EQU    1           DEFINE UTR - UPDATE TRT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
*CALL     COMPTFM 
          TITLE  PRESET TAPE FILE MANAGER (LEVEL 2).
 PRS      SPACE  4,10 
**        PRS - PRESET PROGRAM. 
* 
*         ENTRY  (FC) = RA+1 REQUEST FUNCTION.
* 
*         EXIT   (BUF0) = *TMST* FROM CATALOG.
*                (MFID) = MACHINE ID. 
* 
*         USES   CM - CM+4, CN - CN+4, S2 - S2+4, FC, FO, FN - FN+4,
*                T1, T3.
* 
*         CALLS  AFC, AST, EML,MAG , RCL, RSX, SFN, SSJ, TCS. 
* 
*         MACROS COMPARE, ERROR, INDEX, MMOVE.
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR CATALOG ADDRESS
          STD    FO 
          LDD    CP          READ JOB STATUS
          ADN    STSW 
          CRD    CN 
          ADN    JCIW-STSW   READ SUBSYSTEM ID
          CRD    S2 
          LDD    CN+1 
          NJP    EML         IF ERROR FLAG SET
          LDC    MMFL        SET MACHINE ID 
          CRD    CM 
          LDD    CM 
          STM    MFID 
          LDD    IR+2        CHECK FUNCTION CODE
          LPN    77 
          STD    FC 
          LDD    FC 
          SBN    MXNR 
          MJN    PRS2        IF LEGAL REQUEST TYPE
 PRS1     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 PRS2     LDM    PRSB,FC     SET PROCESSOR ADDRESS
          STM    PRSA 
          RJM    ** 
 PRSA     EQU    *-1         (PROCESSOR ADDRESS)
          LDM    TFMC 
          SHN    21-13
          MJP    PRSX        IF NOT ATTACHING THE CATALOG 
          LDD    FC          CHECK ACCESS TYPE
          LMN    SSJF 
          NJN    PRS3        IF NOT PROCESSING LOCAL FILE 
          LDA    IR+3,REL 
          CRD    FN 
          LDD    FN 
          ZJN    PRS3        IF NOT PROCESSING LOCAL FILE 
          LDM    TFMC        SET LOCAL FILE MODE
          SCN    77 
          LMN    /PFM/PTLM
          STM    TFMC 
          UJN    PRS6        SET FAMILY NAME
  
*         PRESET FAST ATTACH CATALOG ACCESS.
  
 PRS3     LDK    AFAAL       SET SYSTEM FILE *AFA*
          STD    T1 
 PRS4     SOD    T1 
          MJN    PRS5        IF SUBROUTINE MOVED
          LDM    PRSD,T1
          STM    AFAA,T1
          UJN    PRS4        CHECK NEXT WORD OF ROUTINE 
  
 PRS5     LDK    FNTP        GET SYSTEM FNT ADDRESS 
          CRD    CM 
          LDD    CM          SAVE SYSTEM FNT ADDRESS
          SHN    14 
          ADD    CM+1 
          STM    AFAB+1 
          SHN    -14
          RAM    AFAB 
 PRS6     RJM    SFN         SET FAMILY NAME
          RJM    AFC         ACCESS FAMILY CATALOG
          LDD    FC 
          LMN    SSJF 
          ZJN    PRS7        IF SSJF FUNCTION 
          LDM    SBLF,BP
 PRS7     ZJP    PRS9        IF NOT LINKED CATALOG
          LDM    TFMC        SET MODE 
          LPN    77 
          STD    T2 
          LDD    FO          SET FNT ORDINAL
          STD    T1 
          LDN    RFAS        RETURN CURRENT CATALOG 
          RJM    ARF
          LDN    0           CLEAR FNT ORDINAL
          STD    FO 
          MMOVE  PFAM,,PRSA,,FNKL  SAVE CURRENT FAMILY NAME 
          MMOVE  SBLF,BP,PFAM,,FNKL  SET LINKED FAMILY NAME 
          RJM    AFC         ACCESS LINKED CATALOG
          LDD    BP          SET PERMITTED FAMILY LIST ADDRESS
          ADK    SBPF 
          STD    T3 
 PRS8     COMPARE  ,T3,PRSA,,FNKL  CHECK NEXT ENTRY 
          ZJN    PRS9        IF MATCH 
          LDN    5           INCREMENT ENTRY ADDRESS
          RAD    T3 
          SBD    BP 
          LMK    SBPF+PAFL*5
          NJN    PRS8        IF NOT END OF ENTRIES
          ERROR  CNA         *LINKED CATALOG NOT ACCESSIBLE.* 
  
 PRS9     LDM    SBST+1,BP   CHECK CATALOG STATUS 
          SHN    21-2 
          PJN    PRS11       IF NOT CATALOG ERROR 
          LDD    FC          CHECK FUNCTION 
          LMN    SSJF 
          NJN    PRS10       IF NOT SSJ= FUNCTION 
          LDA    IR+3,REL    CHECK SUBFUNCTION
          CRD    CM 
          LDD    CM+4 
          SHN    -3 
          LPN    77 
          LMN    ISFS 
          NJN    PRS11       IF NOT *ISF* SUBFUNCTION 
          LDD    CM+4        SET OPERATOR NOTIFICATION REQUIRED 
          LPN    4
          SHN    3-2
          RAM    TFMF 
 PRS10    ERROR  FCE         *(FAMILY) CATALOG ERROR.*
  
 PRS11    LDM    SBST+1,BP   CHECK IDLE FLAG
          SHN    21-1 
          PJN    PRS12       IF NOT SUSPEND ACTIVITY
          LDD    FC 
          LMN    RSXF 
          NJN    PRS12       IF NOT CALLED BY *RESEX* 
          ERROR  SFA         *(FAMILY) ACTIVITY SUSPENDED.* 
  
 PRS12    LDM    SBST+1,BP   CHECK UTILITY INTERLOCK
          SHN    21-0 
          PJN    PRS14       IF NOT UTILITY INTERLOCK 
          LDD    FC 
          LMN    SSJF 
          ZJN    PRS14       IF CALLED BY SSJ= JOB
 PRS13    ERROR  TUA         *TMS UTILITY ACTIVE.*
  
 PRS14    LDM    CWUN,BA
          ZJN    PRS15       IF NO CATALOG USERNAME 
          COMPARE  PBUN,,CWUN,BA,UNKL 
          NJN    PRS15       IF NOT USERNAME INTERLOCK FROM *TFSP*
          LDD    FC 
          LMN    SSJF 
          NJN    PRS13       IF NOT *TFSP* CALL 
 PRS15    LDM    SBHP,BP     SET HOLE POINTER 
          STM    CPEB 
          LDM    SBHP+1,BP
          STM    CPEB+1 
          LJM    PRSX        RETURN 
  
 PRSB     INDEX              TABLE OF FUNCTION PROCESSORS 
          INDEX  TCSF,TCS    COMMAND PROCESSOR
          INDEX  RSXF,RSX    *RESEX* PROCESSOR
          INDEX  MAGF,MAG    *MAGNET* PROCESSOR 
          INDEX  SSJF,SSJ    SSJ= PROCESSOR 
          INDEX  MXNR 
  
 PRSD     BSS    0           SYSTEM FILE *AFA* ROUTINE
          LOC    AFAA 
          CFI    FNT         GET FST ADDRESS FOR SYSTEM FILE
 AFAB     ADC    ** 
          ADN    FSTG 
*         NFA    FO,R        GET FST ADDRESS FOR LOCAL FILE 
*         ADN    FSTL 
 AFAAL    EQU    *-AFAA      ROUTINE LENGTH 
          LOC    *O 
          TITLE  PRESET SUBROUTINES (LEVEL 2).
 BPB      SPACE  4,10 
**        BPB - BUILD PARAMETER BLOCK.
* 
*         BUILDS A PARAMETER BLOCK FROM CONTROL POINT 
*         VALUES AND THE FET. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (PBUN - PBUN+4) = ACCESS USERNAME. 
*                (PCHG - PCHG+4) = CHARGE NUMBER. 
*                (PPRJ - PPRJ+12B) = PROJECT NUMBER.
*                (PBUF - PBUF+55B) = FET PARAMETERS.
* 
*         USES   CM - CM+4, T1, T2. 
* 
*         CALLS  CCS. 
* 
*         MACROS CLEAR, LDA.
  
  
 BPB      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL    SET PARAMETER BLOCK WORD COUNT 
          ADN    1
          CRD    CM 
          LDD    CM+3 
          SHN    -6 
          SBN    TFFP-5 
          ZJN    BPBX        IF NO FET PARAMETER BLOCK
          MJN    BPBX        IF NO FET PARAMETER BLOCK
          STD    T1 
          SBN    TFPL+1 
          MJN    BPB1        IF FET LENGTH .LT. MAXIMUM 
          LDN    TFPL        SET FET PARAMETER LENGTH 
          STD    T1 
 BPB1     LDA    IR+3,REL    GET FET PARAMETER BLOCK
          CRD    CM 
          ADN    TFFP 
          CRM    PBUF,T1
          LDA    PAUN+3,ABS  SAVE TAPE MANAGER OPTIONS
          STM    BPBB+1 
          SHN    -14
          RAM    BPBB 
          LDM    PAUN 
          ZJN    BPB3        IF NOT ALTERNATE USER ACCESS 
          LDD    FC 
          LMN    TCSF 
          NJN    BPB2        IF NOT COMMAND 
          LDD    CM+4 
          SHN    -3 
          LPN    77 
          LMN    AUDS 
          NJN    BPB3        IF NOT *AUDIT* SUBFUNCTION 
 BPB2     LDC    PAUN        SWAP USERNAMES 
          STM    BPBA 
          MMOVE  PAUN,,PBUN,,UNKL 
 BPB3     LDD    CP          CHECK FOR SSJ= JOB 
          ADC    SEPW 
          CRD    CM 
          LDD    CM 
          SHN    21-2 
          PJN    BPB4        IF NOT SSJ= JOB
          LDA    CM+3        CHECK FOR SSJ= BLOCK 
          ZJN    BPB4        IF NO SSJ= BLOCK 
          LDA    CM+3,REL    GET USERNAME FROM SSJ= BLOCK 
          ADN    /SSJ/UIDS
          UJN    BPB5        SET USERNAME 
  
 BPB4     LDD    CP          GET USERNAME FROM CONTROL POINT
          ADN    UIDW 
 BPB5     CRM    PBUN,ON     SET USERNAME 
 BPBA     EQU    *-1         (PAUN IF ALTERNATE USER) 
          LDM    PAUN+3      SET TAPE MANAGER OPTIONS.
          SCN    77 
          STM    PAUN+3 
          LDC    ** 
 BPBB     EQU    *-2         (TO=OPTIONS FROM FET)
          STM    PBTO+1 
          SHN    -14
          RAM    PBTO 
          COMPARE PBUN,,PAUN,,UNKL
          NJN    BPB6        IF NOT USERS CATALOG 
          CLEAR  PAUN,,UNKL 
          LDC    PBUN        USERNAME IN PBUN 
          STM    BPBA 
 BPB6     LJM    BPBX        RETURN 
 AFC      SPACE  4,10 
**        AFC - ACCESS FAMILY TAPE CATALOG. 
* 
*         ENTRY  (FO) = 0.
*                (FN - FN+4) = FNT ENTRY IF LOCAL FILE MODE.
* 
*         EXIT   (A) = 0 IF CATALOG ATTACHED. 
*                (A) .NE. 0 IF CATALOG BUSY.
*                (FO) = GLOBAL FNT ORDINAL OR NFL ADDRESS OF CATALOG. 
*                SYSTEM BLOCK READ TO BUF0 BUFFER IF CATALOG ATTACHED.
* 
*         USES   BA, CM - CM+4, FO, FN - FN+4, RI - RI+1, T1, T5 - T5+4.
* 
*         CALLS  AFA, ARF, FAT, GIB, IRA, MBP, SAF, SFB, UTR. 
* 
*         MACROS ERROR, MMOVE, SAVEP. 
  
  
 AFC      SUBR               ENTRY/EXIT 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          NJN    AFC3        IF NOT LOCAL FILE MODE 
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          LDD    FA          SET NFL ADDRESS
          ZJN    AFC1        IF FILE NOT FOUND
          STD    FO          SET FILE ADDRESS 
          RJM    SFB         SET FILE BUSY
          ZJP    AFC4        IF FILE SET BUSY 
          LMN    2
          ZJN    AFC1        IF NAME COMPARE ERROR
          ERROR  IOS         *I/O SEQUENCE ERROR ON CATALOG.* 
  
 AFC1     ERROR  CNF         *CATALOG NOT FOUND.* 
  
 AFC2     ERROR  FCE         *(FAMILY) CATALOG ERROR.*
  
 AFC3     MMOVE  AFCA,,CM,,PFKL  SET CATALOG NAME 
          MMOVE  PFAM,,FN,,PFKL  SET FAMILY NAME
          RJM    FAT         SEARCH FOR FAST ATTACH FILE
          NJN    AFC1        IF FILE NOT FOUND
          LDD    T1          SET GLOBAL FNT ORDINAL 
          STD    FO 
          LDM    TFMC        SET FILE ACCESS MODE 
          LPN    77 
          STD    T2 
          LDN    /COMSCPS/AFAS  ATTACH CATALOG FILE 
          RJM    ARF
          RJM    UTR         UPDATE TRT 
 AFC4     LDD    FO          GET FST ADDRESS
          RJM    AFA
          CRD    T5          SET EQUIPMENT
          RJM    IRA         INITIALIZE RANDOM ADDRESS PROCESSING 
          SFA    EST,T5      READ EST ENTRY 
          CRD    CM 
          LDD    CM+4        READ MACHINE INDEX 
          SHN    3
          ADN    DULL 
          CRD    CM 
          LDD    CM+2        SET MACHINE INDEX-1
          LPN    17 
          STM    CDMX 
          LDC    BUF0        READ SYSTEM BLOCK
          STD    BA 
          LDN    TMSB 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK (SYSTEM BLOCK) 
          LDN    6           COUNT = 1 CM WORD + 2 HEADER BYTES - 1 
          STD    T1 
 AFC5     LDM    BUF0,T1
          LMM    AFCB,T1
          NJP    AFC2        IF NOT SYSTEM BLOCK
          SOD    T1 
          PJN    AFC5        IF MORE TO COMPARE 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          SAVEP  CPSB        SAVE BUFFER POINTERS 
          LDN    0           SET NO ERROR 
          LJM    AFCX        RETURN 
  
 AFCA     VFD    48D/0L"TMFC"  TMS CATALOG NAME 
 AFCB     CON    2           NEXT SECTOR
          CON    100         WORD COUNT 
          CON    0           SYSTEM LEVEL 
          CON    0           UNUSED WORDS 
          CON    74          ENTRY LENGTH 
          CON    1           NUMBER ENTRIES 
          CON    4           FIRST WORD OF ENTRY
 CCP      SPACE  4,10 
**        CCP - CHANGE CONTROL POINT. 
* 
*         EXIT   (A) = 0 IF CONTROL POINT CHANGED.
*                (A) .NE. 0 IF CONTROL POINT NOT CHANGED. 
* 
*         USES   CM - CM+4, S1 - S1+4, T1 - T5. 
* 
*         MACROS MONITOR, UDTRD.
  
  
 CCP      SUBR               ENTRY/EXIT 
          UDTRD  S1,/MTX/UVRI,1  GET EJT ORDINAL
          SFA    EJT,S1 
          ADK    JSNE 
          CRD    CM 
          ADK    SCHE-JSNE
          CRD    T1 
          LDD    CM+4 
          LPC    176
          LMN    EXJS*2 
          NJN    CCPX        IF JOB ROLLED OR ROLLING OUT 
          LDD    T1+3        SET CP NUMBER
          ADK    /COMSCPS/ALCS  SET ALTERNATE CP OPTION 
          STD    CM+1 
          MONITOR CCAM       CHANGE CONTROL POINT ASSIGNMENT
          LDD    CM+1 
          NJN    CCPX        IF CHANGE NOT MADE 
          LDD    CP 
          ADK    TFSW 
          CRD    CM 
          LDD    CM          VERIFY EJT ORDINAL 
          LMD    S1 
          ZJN    CCP1        IF CORRECT JOB 
          LDK    /COMSCPS/ALCS  SET RETURN TO MAGNET CP 
          STD    CM+1 
          MONITOR CCAM       RETURN TO MAGNET CP
          LDN    1           SET CP NOT CHANGED 
 CCP1     LJM    CCPX        RETURN 
 CFS      SPACE  4,10 
**        CFS - CHECK FET STATUS. 
* 
*         *CFS* CHECKS THE VALIDITY OF THE FET POINTERS.
* 
*         ENTRY  (A) = MINIMUM FET LENGTH.
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   FT - FT+1 = FIRST POINTER. 
*                IN - IN+1 = IN POINTER.
*                OT - OT+1 = OUT POINTER. 
*                LM - LM+1 = LIMIT POINTER. 
* 
*         USES   T0, CM - CM+4. 
* 
*         MACROS LDA. 
  
  
 CFS      SUBR               ENTRY/EXIT 
          STD    S1 
          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 
          SBN    1
          CRD    CM 
          LDD    CM+4 
          SHN    21-0 
          MJN    CFS1        IF FET COMPLETE
          LDD    CM+3        CHECK LAST STATUS
          LPN    77 
          SHN    14 
          LMD    CM+4 
          SHN    -11
          NJN    CFS1        IF ERRORS ON PREVIOUS OPERATION
          LDD    T0          RESTORE OVERLAP WORD 
          STD    IN-3 
          LDD    S1 
          SHN    21-13
          MJP    CFSX        IF NOT CHECKING BUFFER POINTERS
          LDD    T1+3        SET FIRST
          LPN    77 
          STD    FT 
          LDD    T1+4 
          STD    FT+1 
          LDD    LM          CHECK LIMIT
          LPN    37 
          STD    LM 
          SHN    14 
          LMD    LM+1 
          SBN    1
          SHN    -6 
          SBD    FL 
          MJN    CFS2        IF LIMIT .LT. FL 
 CFS1     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 CFS2     LDD    OT          CHECK OUT
          LPN    37 
          STD    OT 
          SBD    LM 
          SHN    14 
          ADD    OT+1 
          SBD    LM+1 
          PJN    CFS1        IF OUT .GE. LIMIT
          LDD    IN          CHECK IN 
          LPN    37 
          STD    IN 
          SBD    LM 
          SHN    14 
          ADD    IN+1 
          SBD    LM+1 
          PJN    CFS1        IF IN .GE. LIMIT 
          LDD    OT          CHECK OUT
          SBD    FT 
          SHN    14 
          ADD    OT+1 
          SBD    FT+1 
          MJN    CFS1        IF OUT .LT. FIRST
          LDD    IN          CHECK IN 
          SBD    FT 
          SHN    14 
          ADD    IN+1 
          SBD    FT+1 
          MJN    CFS1        IF IN .LT. FIRST 
          LJM    CFSX        RETURN 
 GUO      SPACE  4,10 
**        GUO - GET USER OPTIONS FROM UDT.
* 
*         *GUO* IS USED TO OBTAIN THE USER OPTIONS, INSURING
*         THE PHYSICAL TAPE ATTRIBUTES IN THE CATALOG MATCH 
*         HOW THE TAPE WAS WRITTEN. THIS IS NECESSARY IF
*         THE USER REQUESTS A TAPE FILE WITH THE TO=D 
*         OPTION AND WRITES TO A EXISTING TAPE FILE.
* 
*         ENTRY  (UDTA) = UDT ADDRESS.
* 
* 
*         USES   CM - CM+4, FN - FN+4, S1 - S1+4, 
*                S2 - S2+4, S3 - S3+4.
* 
*         MACROS LDA, MMOVE, UDTRD. 
  
  
 GUO      SUBR               ENTRY/EXIT 
          UDTRD  S1,/MTX/UST1,4 
          LDD    S1+4        GET RING STATUS
          SHN    4-7
          LPN    1S4
          STM    PFTD+1 
          LDD    FN 
          LPC    3777        SET TAPE DESCRITPTORS
          STM    PFTD 
          LDD    FN+2        SET FORMAT AND NOISE 
          STM    PFTD+2 
          UDTRD  CM,/MTX/UFSN,1 
          LDA    CM+3,ABS    SET FILE SECTION NUMBER
          STM    PBSN+1 
          SHN    -14
          STM    PBSN 
          UDTRD  CM,/MTX/USID,1 
          MMOVE  CM,,PBSI,,6
          LDD    CM+3        SET FILE ACCESSIBILITY 
          SCN    77 
          RAM    PBFA 
          UDTRD  CM,/MTX/UGNU,1 
          LDA    CM+3,ABS    SET GENERATION NUMBER
          STM    PBGN+1 
          SHN    -14
          LPN    3
          STM    PBGN 
          LDD    CM+3        SET VERSION NUMBER 
          SCN    77 
          SHN    6
          LMD    CM+2 
          SHN    11 
          SCN    7
          RAM    PBVN 
          LJM    GUOX        RETURN 
 SFN      SPACE  4,10 
**        SFN - SET FAMILY NAME.
* 
*         *SFN* SETS THE FAMILY NAME FROM THE *MST*,
*         OR FROM THE UDT IF CALLED BY *MAGNET*.
* 
*         ENTRY  (FC) = FUNCTION CODE.
* 
*         EXIT   (PFAM - PFAM+3) = FAMILY NAME
* 
*         USES   CM - CM+4. 
* 
*         MACROS UDTRD. 
  
 SFN      SUBR               ENTRY/EXIT 
          LDD    FC          CHECK FOR *MAGNET* CALL
          LMN    MAGF 
          NJN    SFN1        IF NOT CALLED BY *MAGNET*
          UDTRD  CM,/MTX/UUFN,1 
          LDD    CM+3 
          LPN    77 
          STD    CM+3 
          LDC    FOTP        READ *FOT* POINTER 
          CRD    FN 
          LDD    FN          READ FWA OF *FOT*
          SHN    14 
          LMD    FN+1 
          ADD    CM+3 
          UJN    SFN2        READ FAMILY NAME 
  
 SFN1     LDD    CP          GET FAMILY EQUIPMENT 
          ADN    PFCW 
          CRD    CM 
          SFA    EST,CM+3    READ EST ENTRY 
          CRD    CM 
          LDD    CM+4        GET FAMILY NAME
          SHN    3
          ADN    PFGL 
 SFN2     CRM    PFAM,ON
          LDM    PFAM+3 
          SCN    77 
          STM    PFAM+3 
          LDN    0
          STM    PFAM+4 
          LJM    SFNX        RETURN 
 SUL      SPACE  4,10 
**        SUL - SET UDT ADDRESS FROM LOCAL FILE.
* 
*         SETS THE RELATIVE UDT ADDRESS FROM THE
*         FST ENTRY OF A ASSIGNED MAGNETIC TAPE 
*         FILE AND UPDATES THE ASSIGNMENT FET WITH
*         THE PARAMETERS FROM THE UDT.
* 
*         ENTRY  (IR+3 - IR+4) FET ADDRESS. 
* 
*         EXIT   (UDTA) = UDT ADDRESS IF ASSIGNED 
*                         MAGNETIC TAPE FILE. 
* 
*                PARAMETER BLOCK UPDATED. 
* 
*                TO *EML* IF NON-SYMBOLIC FILE. 
* 
*         USES   CM - CM+4, CN - CN+4.
* 
*         CALLS  GUO, SAF.
* 
*         MACROS ERROR, LDA, MMOVE, UDTRD.
  
  
 SUL      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL    SET FILE NAME
          CRD    FN 
          LDN    0           NO INITIAL SEARCH ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          ZJN    SULX        IF FILE NOT FOUND
          NFA    FA,R 
          ADN    FSTL 
          CRD    FS          GET FST EST ENTRIES
          SFA    EST,FS 
          CRD    CM 
          LDD    CM+3        VALIDATE MT/NT EQUIPMENT 
          LMC    2RMT 
          ZJN    SUL1        IF 7 TRACK TAPE
          LMC    2RNT&2RMT
          ZJN    SUL1        IF 9 TRACK TAPE
          LMC    2RCT&2RNT
          ZJN    SUL1        IF CTS CARTRIDGE TAPE
          LMC    2RAT&2RCT
          NJP    SULX        IF NOT ACS CARTRIDGE TAPE
 SUL1     LDD    FS+1        SET UDT ADDRESS
          ZJP    SULX        IF NO UDT ADDRESS
          STM    UDTA 
          LDD    CP          VALIDATE JOB ASSIGNMENT
          ADN    TFSW 
          CRD    CN 
          UDTRD  CM,/MTX/UVRI,1 
          LDD    CM 
          LMD    CN 
          NJN    SUL3        IF NOT EJT ORDINAL 
          UDTRD  UTMS,/MTX/UTMS,1 
          LDM    UTMS+4 
          SHN    21-13
          PJN    SUL3        IF NOT A TMS CONTROLLED FILE 
          UDTRD  CM,/MTX/UST4,1 
          LDD    CM 
          SHN    21-12
          PJN    SUL2        IF UNLABELED FILE
          SHN    21-11-21+12
          PJN    SUL4        IF STANDARD LABELS 
 SUL2     LJM    EML         EXIT TO MAIN LOOP
  
 SUL3     ERROR  TPI         *TMS PROCESSING INHIBITED.*
  
 SUL4     LDM    PFTD        UPDATE FET FROM UDT
          LPC    4000 
          STM    PFTD 
          RJM    GUO         GET USER OPTIONS FROM UDT
          LDM    UTMS+4 
          SHN    21-10
          PJN    SUL2        IF NON-SYMBOLIC ACCESS 
          LDM    PBTO+1      FORCE TMS FILE, SYMBOLIC ACCESS
          SCN    24 
          LMN    24 
          STM    PBTO+1 
          LJM    SULX        RETURN 
 TTB      SPACE  4,10 
**        TTB - TRIM TRAILING BLANKS. 
* 
*         ENTRY  (A, 0-11) = ADDRESS OF STRING. 
*                (A, 12-17)= STRING COUNT.
* 
*         EXIT   TRAILING BLANKS CONVERTED TO BINARY ZERO.
* 
*         USES   T0, T1, T2.
  
  
 TTB      SUBR               ENTRY/EXIT 
          STD    T1          SAVE ADDRESS 
          SHN    -14
          STD    T2          SAVE CHARACTER COUNT 
          SHN    -1 
          RAD    T1 
 TTB1     LDD    T2          CHECK FOR CHARACTER POSITION 
          LPN    1
          ZJN    TTB2        IF EVEN CHARACTER
          LDI    T1          PRESET ZERO CHARACTER
          LPN    77 
          STD    T0 
          LDI    T1          LOAD CHARACTER 
          SHN    -6 
          UJN    TTB3        CHECK CHARACTER
  
 TTB2     LDI    T1          PRESET ZERO CHARACTER
          SCN    77 
          STD    T0 
          LMI    T1          LOAD CHARACTER 
 TTB3     ZJN    TTB4        IF ALREADY ZERO
          LMN    1R 
          NJN    TTBX        IF NOT BLANK 
          LMD    T0          RESTORE OTHER CHARACTER
          STI    T1 
 TTB4     SOD    T2 
          LPN    1
          NJN    TTB1        IF ODD CHARACTER TO DO 
          SOD    T1          DECREMENT STRING POINTER 
          LDD    T2 
          NJN    TTB1        IF MORE TO BLANK 
          UJN    TTBX        RETURN 
          SPACE  4
***       LEVEL 2 COMMON DECKS. 
  
*CALL     COMPAST 
*CALL     COMPCRS 
*CALL     COMPFAT 
 EJT$     EQU    1           ASSEMBLE EJT CODE
*CALL     COMPGFP 
*CALL     COMPIRA 
*CALL     COMPSAF 
*CALL     COMPSFB 
          SPACE  4
          ERRNG  BUF0-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (ERROR PROCESSING.),OVL1
          SPACE  4,10 
***       TAPE MANAGER ERROR PROCESSING.
* 
* 
*         COMMAND OR CENTRAL PROGRAM CALLS. 
* 
*         IF THE ERROR PROCESSING BIT IS SET IN THE FET, TFM
*         RETURNS THE ERROR CODE, SETS THE COMPLETE BIT AND ISSUE 
*         THE DAYFILE MESSAGE.  THE ERROR CODE IS RETURNED IN 
*         WORD 0 OF THE FET BITS 9 - 16.
* 
*         IF THE ERROR PROCESSING BIT IS NOT SET, A DAYFILE 
*         MESSAGE IS ISSUED, THE CONTROL POINT ABORTED, AND THE 
*         PPU IS DROPPED. 
* 
*         IF ERROR RETURN ADDRESS *ERAD* IS SET AND USER IS 
*         PROCESSING ERRORS, MESSAGE WILL NOT BE ISSUED BUT WILL
*         BE RETURNED TO USER AT RA + ERAD. FOUR WORDS MUST 
*         BE ALLOCATED AT *ERAD* FOR MESSAGE. 
* 
*         IF THE ERROR CONDITION IS ONE THAT THE USER CAN 
*         ROLLOUT AND WAIT ON, THE ROLLOUT INDICATOR IS 
*         SET IN WORD 0 OF THE FET, BIT 17, AND THE 
*         EVENT DESCRIPTION WILL BE SET IN *TERW* IN CP 
*         AREA SO CALLING PROGRAM MAY ISSUE ROLLOUT IF IT 
*         DESIRES TO WAIT FOR THE CONDITION TO CLEAR. 
* 
          SPACE  4,10 
***       COMMON SYMBOL DEFINITIONS.
  
  
*CALL     COMS1DS 
          SPACE  4,10 
***       DIRECT CELL LOCATIONS.
  
  
 CN       EQU    S1 -S1+4    SCRATCH WORD (5 LOCATIONS) 
 EA       EQU    S2          ERROR MESSAGE ADDRESS
 AP       EQU    S2+1        ASSEMBLY POINTER 
 HB       EQU    S2+2        HALF BYTE FLAG 
 TME      SPACE  4,20 
**        TME - TAPE MANAGER ERROR PROCESSING.
* 
*         ENTRY  (EC) = ERROR CODE. 
*                (FO) = CATALOG FNT ORDINAL.
* 
*         USES   CM - CM+4, T1 - T2.
* 
*         CALLS  ABT, BEM, IEM, IOE, MMC, PRF, SSE, UEP.
* 
*         MACROS LDA, MONITOR, MULT3. 
  
  
 TME      ENTRY              OVERLAY ENTRY POINT
          LDD    CP          CHECK DMP= STATUS
          ADC    SEPW 
          STD    T1 
          CRD    CM 
          LDD    CM 
          LPN    20 
          NJN    TME1        IF DMP= ENTRY POINT PRESENT
          LDN    ZERL 
          CRD    CM          CLEAR CPU COMMUNICATION WORD 
          LDD    T1 
          ADN    SPCW-SEPW
          CWD    CM 
 TME1     MULT3  EC          MULTIPLY (ERROR CODE)*3
          ADC    EMSG-3      OFFSET FOR ERROR CODE 0
          STD    EA 
          RJM    BEM         BUILD ERROR MESSAGE
          RJM    MMC         MOVE TO MAGNET CONTROL POINT 
          LDI    EA 
          SHN    21-2 
          MJP    TME5        IF UNCONDITIONAL ABORT 
          LDD    FC 
          LMN    MAGF 
          ZJN    TME3        IF CALLED BY *MAGNET*
          LDM    DFFO 
          ZJN    TME2        IF DEMAND FILE NOT ATTACHED
          STD    T1          SET FNT ORDINAL
          LDN    /PFM/PTUP   SET MODE 
          STD    T2 
          LDN    RFAS        RETURN DEMAND FILE 
          RJM    ARF
 TME2     LDA    IR+3,REL    CHECK USER ERROR PROCESSING FLAG 
          ADN    1
          CRD    CM 
          LDD    CM+1 
          SHN    21-10
          PJP    TME5        IF USER NOT PROCESSING ERRORS
          RJM    UEP         USER ERROR PROCESSING
          LJM    TME6        CHECK FOR *TFSPE* CALL 
  
 TME3     LDI    EA          PROCESS ERRORS FOR *MAGNET*
          SHN    21-3 
          PJP    TME5        IF NON-ROLLABLE ERROR
          RJM    IEM         ISSUE ERROR MESSAGE
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          NJP    TME4        IF JOB NOT ROLLABLE
          RJM    SSE         SET SYSTEM EVENT 
          LDM    UTMS+3      SET WAIT JOB ROLLIN
          SCN    WUJR 
          LMN    WUJR 
          STM    UTMS+3 
          LDN    ZERL        REQUEST ROLLOUT
          CRD    CM 
          LDC    4000B+/COMSCPS/ROTE
          STD    CM+1 
          LDD    CP 
          SHN    -7 
          STD    CM+2 
          MONITOR ROCM       ROLLOUT CONTROL POINT
 TME4     LDM    UTMS+4      SET REISSUE REQUEST
          SCN    RSRR 
          LMN    RSRR 
          STM    UTMS+4 
          UJN    TME6        CHECK FOR *TFSPE* CALL 
  
 TME5     RJM    IEM         ISSUE ERROR MESSAGES 
          RJM    ABT         ABORT USER JOB 
 TME6     LDM    TFMF        CHECK FOR OPERATOR NOTIFICATION REQUIRED 
          SHN    21-3 
          MJN    TME7        IF OPERATOR FLAG SET 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          ZJN    TME10       IF LOCAL FILE MODE 
          LDI    EA 
          SHN    21-1 
          PJN    TME8        IF NOT CALLING *TFSPE* 
 TME7     RJM    IOE         INFORM OPERATOR OF ERROR 
 TME8     LDI    EA          CHECK FOR PP HANG
          SHN    21-0 
          PJN    TME10       IF NOT HANG CONDITION
          LDD    FO          SET FNT ORDINAL
          ZJN    TME9        IF CATALOG NOT ATTACHED
          STD    T1 
          LDM    TFMC        SET MODE 
          LPN    77 
          STD    T2 
          LDN    RFAS        RETURN CATALOG 
          RJM    ARF
*         LDN    0           CLEAR FNT ORDINAL
          STD    FO 
 TME9     MONITOR CHGM       CONDITIONALLY HANG PP
 TME10    LJM    TMEX        RETURN 
          TITLE  SUBROUTINES. 
 ABT      SPACE  4,10 
**        ABT - ABORT USER JOB. 
* 
*         FOR ALL NON-MAGNET REQUESTS, THE FET IS SET 
*         COMPLETE. FOR MAGNET REQUESTS, THE USER JOB 
*         ABORT AND FUNCTION COMPLETE FLAGS ARE SET.
*         IN ALL CASES THE *PPET* SYSTEM ERROR FLAG 
*         IS SET FOR THE USER JOB.
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR, UDTRD, UDTWT. 
  
  
 ABT1     LDA    IR+3,REL    SET FET COMPLETE 
          CRD    CM 
          LDD    CM+4 
          SCN    1
          LMN    1
          STD    CM+4 
          LDA    IR+3,REL 
          CWD    CM 
 ABT2     LDN    ZERL        SET ERROR FLAG 
          CRD    CM 
          LDN    PPET 
          STD    CM+1 
          MONITOR CEFM       CHANGE ERROR FLAG
  
 ABT      SUBR               ABORT USER JOB 
          LDD    FC          CHECK CALLER 
          LMN    MAGF 
          NJN    ABT1        IF NOT CALLED BY *MAGNET*
          LDM    UTMS+4      SET ABORT USER JOB STATUS
          SCN    RSAJ 
          LMN    RSAJ 
          STM    UTMS+4 
          LDD    CP 
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          LMC    MTSI 
          NJN    ABT2        IF NOT *MAGNET* CONTROL POINT
          UJN    ABTX        RETURN 
 BEM      SPACE  4,10 
**        BEM - BUILD ERROR MESSAGE.
* 
*         ENTRY  (EA) = ERROR MESSAGE CONTROL WORD. 
* 
*         EXIT   (MBUF) = COMPLETED ERROR MESSAGE.
* 
*         USES   AP, HB.
* 
*         CALLS  EQM, FMM, FNM, LFM, MVM, RAM, UNM, 
*                VSM. 
* 
  
  
 BEM      SUBR               ENTRY/EXIT 
          LDC    MBUF        INITIALIZE ASSEMBLY POINTER
          STD    AP 
          CLEAR  ,AP,MBML*10D 
          LDN    0
          STD    HB 
          LDI    EA 
          SHN    21-13
          PJN    BEM1        IF NOT EQUIPMENT MESSAGE 
          RJM    EQM         BUILD EQUIPMENT MESSAGE
          LJM    BEM7        COMPLETE ERROR MESSAGE 
  
 BEM1     SHN    21-12-21+13 CHECK FAMILY MESSAGE 
          PJN    BEM2        IF NOT FAMILY NAME MESSAGE 
          RJM    FMM         BUILD FAMILY NAME MESSAGE
          LJM    BEM7        COMPLETE ERROR MESSAGE 
  
 BEM2     SHN    21-11-21+12 CHECK FILE NAME MESSAGE
          PJN    BEM3        IF NOT FILE NAME MESSAGE 
          RJM    FNM         BUILD FILE NAME MESSAGE
          UJN    BEM7        COMPLETE ERROR MESSAGE 
  
 BEM3     SHN    21-10-21+11 CHECK LOCAL FILE NAME MESSAGE
          PJN    BEM4        IF NOT LOCAL FILE NAME MESSAGE 
          RJM    LFM         BUILD LOCAL FILE NAME MESSAGE
          LDI    EA 
          SHN    21-10
 BEM4     SHN    21-7-21+10  CHECK VSN MESSAGE
          PJN    BEM5        IF NOT VSN MESSAGE 
          RJM    VSM         BUILD VSN MESSAGE
          UJN    BEM7        COMPLETE ERROR MESSAGE 
  
 BEM5     SHN    21-6-21+7   CHECK USERNAME MESSAGE 
          PJN    BEM6        IF NOT USERNAME MESSAGE
          RJM    UNM         BUILD USERNAME MESSAGE 
          UJN    BEM7        COMPLETE ERROR MESSAGE 
  
 BEM6     SHN    21-5-21+6   CHECK RANDOM ADDRESS MESSAGE 
          PJN    BEM7        IF NOT RANDOM ADDRESS MESSAGE
          RJM    RAM         BUILD RANDOM ADDRESS MESSAGE 
 BEM7     LDD    EA          COMPLETE ERROR MESSAGE 
          ADN    2
          STM    BEMA 
          LDM    **          GET MESSAGE ADDRESS
 BEMA     EQU    *-1         (ERROR MESSAGE ADDRESS)
          RJM    MVM         MERGE VARIABLE MESSAGE 
          LDD    HB 
          ZJN    BEM8        IF BYTE FILLED 
          AOD    AP 
          LDN    0
 BEM8     STI    AP          SET END OF MESSAGE 
          LJM    BEMX        RETURN 
 CSZ      SPACE  4,10 
**        CSZ - CONVERT TRAILING SPACES TO ZEROS. 
* 
*         ENTRY  (A) = 6/ CC,12/ ADDR 
*                WHERE - CC = CHARACTER COUNT.
*                        ADDR = ADDRESS.
* 
*         USES   T1, T2, T3.
  
  
 CSZ      SUBR               ENTRY/EXIT 
          STD    T1 
          SHN    -14
          ZJN    CSZX        IF CHARACTER COUNT NOT GIVEN 
          STD    T2 
          LPN    1           SET HALF BYTE FLAG 
          STD    T3 
          LDD    T2          SET LAST WORD ADDRESS
          SHN    -1 
          SBN    1
          ADD    T3 
          RAD    T1 
          LDD    T3 
          ZJN    CSZ2        IF TERMINATE ON WORD BOUNDARY
 CSZ1     LDI    T1          CHECK LEFT MOST CHARACTER
          SHN    -6 
          LMN    1R 
          NJN    CSZX        IF NOT SPACE 
          LDI    T1 
          LPN    77 
          STI    T1 
          SOD    T1          DECREMENT WORD COUNT 
          SOD    T2          DECREMENT CHARACTER COUNT
          ZJN    CSZX        IF LAST CHARACTER
 CSZ2     LDI    T1          CHECK RIGHT MOST CHARACTER 
          LPN    77 
          LMN    1R 
          NJN    CSZ3        IF NOT SPACE 
          LDI    T1 
          SCN    77 
          STI    T1 
          SOD    T2          DECREMENT CHARACTER COUNT
          NJN    CSZ1        IF NOT LAST CHARACTER
 CSZ3     LJM    CSZX        RETURN 
 EQM      SPACE  4,10 
**        EQM - BUILD EQUIPMENT MESSAGE.
* 
*         SETS EQUIPMENT AND DEVICE NUMBER IN MESSAGE.
* 
*         ENTRY  (EQ) = EQUIPMENT NUMBER. 
*                (AP) = ASSEMBLY POINTER. 
* 
*         USES   CM - CM+4, T1, CN. 
* 
*         CALLS  C2D, MVM.
  
  
 EQM      SUBR               ENTRY/EXIT 
          LDD    EQ          CONVERT UPPER TWO DIGITS OF EST ORDINAL
          SHN    -3 
          RJM    C2D         CONVERT TWO DIGITS 
          STM    EQMA+1 
          LDD    EQ 
          LPN    7
          SHN    6
          ADC    2R0, 
          STM    EQMA+2 
          SFA    EST,EQ      READ EST ENTRY 
          CRD    CM 
          LDD    CM+3        SET EQUIPMENT TYPE 
          LPC    3777 
          STM    EQMA 
          LDD    CM+4        READ MST 
          SHN    3
          ADN    PFGL 
          CRD    CM 
          LDD    CM+3        SET DEVICE NUMBER
          RJM    C2D         CONVERT TWO DIGITS 
          SHN    -6 
          LPN    77 
          STD    T1 
          LDM    EQMA+4 
          SCN    77 
          ADD    T1 
          STM    EQMA+4 
          LDD    CM+3 
          LPN    7
          SHN    6
          ADC    2R0, 
          STM    EQMA+5 
          LDC    EQMA 
          RJM    MVM         MERGE VARIABLE MESSAGE 
          LJM    EQMX        RETURN 
  
 EQMA     DATA   C*EQXXX, DNYY,*
 FMM      SPACE  4,10 
**        FMM - BUILD FAMILY NAME MESSAGE.
* 
*         SETS FAMILY NAME IN MESSAGE.
* 
*         ENTRY  (PFAM - PFAM+3) = FAMILY NAME. 
* 
*         CALLS  MVM. 
* 
  
  
 FMM      SUBR               ENTRY/EXIT 
          LDM    PFAM+3      INSURE END OF FAMILY NAME
          SCN    77 
          STM    PFAM+3 
          LDC    PFAM 
          RJM    MVM         MOVE VARIABLE MESSAGE
          UJN    FMMX        RETURN 
 FNM      SPACE  4,10 
**        FNM - BUILD FILENAME MESSAGE. 
* 
*         SETS FILENAME IF MESSAGE. 
* 
*         ENTRY  (EC) = ERROR CODE. 
*                (POFI - POFI+8D) = OLD FILE NAME.
*                (PNFI - PNFI-8D) = NEW FILE NAME.
* 
*         CALLS  CSZ, MVM.
  
  
 FNM      SUBR               ENTRY/EXIT 
          LDC    FIKL*10000+POFI
          RJM    CSZ         CONVERT TRAILING SPACES TO ZEROS 
          LDC    POFI 
          RJM    MVM         MOVE VARIABLE MESSAGE
          UJN    FNMX        RETURN 
 IDM      SPACE  4,10 
**        IDM - ISSUE DAYFILE MESSAGE.
* 
*         ENTRY  (A) = DESTINATION CODE/10000.
* 
*         CALLS  DFM. 
  
  
 IDM      SUBR               ENTRY/EXIT 
          LPN    77          SET MESSAGE DESTINATION
          SHN    14 
          LMC    MBUF 
          RJM    DFM         ISSUE DAYFILE MESSAGE
          UJN    IDMX        RETURN 
 IEM      SPACE  4,10 
**        IEM - ISSUE ERROR MESSAGES. 
* 
*         DETERMINES THE DISPOSITION OF THE ERROR  MESSAGES.
* 
*         ENTRY  (EA) = FWA OF ERROR MESSAGE CONTROL WORD.
*                (CO) = CATALOG FST ORDINAL.
* 
*         EXIT   ALL DAYFILE AND/OR DISPLAY MESSAGES ISSUED.
* 
*         USES   BA, BP, FN - FN+4, HB, T5 - T5+4.
* 
*         CALLS  IDM, MBP, RDS, WDS.
* 
*         MACROS ENDMS, MMOVE, UDTRD, UDTWT.
  
  
 IEM      SUBR               ENTRY/EXIT 
          LDD    EA          SET DESTINATION CODE ADDRESS 
          ADN    1
          STD    HB 
          LDD    FC          CHECK CALLER 
          LMN    MAGF 
          NJP    IEM2        IF NOT CALLED BY *MAGNET*
          UDTWT  MBUF,/MTX/UMSG,4  SET MESSAGE IN UDT BUFFER
          LDD    CP          CHECK PP ASSIGNMENT
          ADN    JCIW 
          CRD    CM 
          LDD    CM+2 
          LMC    MTSI 
          ZJP    IME6        IF *MAGNET* CONTROL POINT
 IEM2     LDI    HB          CHECK FOR CP DAYFILE MESSAGE 
          SHN    21-0 
          PJN    IEM3        IF NOT FOR CONTROL POINT DAYFILE 
          LDN    CPON/10000 
          RJM    IDM         ISSUE DAYFILE MESSAGE
 IEM3     LDI    HB          CHECK FOR SYSTEM DAYFILE MESSAGE 
          SHN    21-1 
          PJN    IEM4        IF NOT FOR SYSTEM DAYFILE
          LDN    0
          RJM    IDM         ISSUE DAYFILE MESSAGE
 IEM4     LDI    HB          CHECK FOR ERROR LOG MESSAGE
          SHN    21-2 
          PJN    IEM5        IF NOT FOR ERROR LOG 
          LDN    ERLN/10000 
          RJM    IDM         ISSUE DAYFILE MESSAGE
 IEM5     LDI    HB          CHECK FOR ACCOUNT DAYFILE MESSAGE
          SHN    21-3 
          PJN    IME6        IF NOT FOR ACCOUNT DAYFILE 
          LDN    ACFN/10000 
          RJM    IDM         ISSUE DAYFILE MESSAGE
 IME6     LDI    HB          CHECK FOR CATALOG BUFFER MESSAGE 
          SHN    21-5 
          PJP    IEMX        IF NOT FOR CATALOG BUFFER
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    T5 
          SBN    1
          CRD    FN 
          LDD    T5          SET ABSOLUTE TRACK/SECTOR
          LPC    777
          STD    T5 
          LDN    1
          STD    T7 
          LDC    BUF0        SET BUFFER ADDRESS/POINTER 
          STD    BA 
          ADN    2
          STD    BP 
          SETMS  IO,RW
          LDD    BA 
          RJM    RDS         READ SECTOR
          MJN    IME8        IF MASS STORAGE ERROR OCCURRED 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDM    SBST+1,BP   SET ERROR, SUSPEND ACTIVITY FLAGS
          SCN    FETS 
          LMN    FETS 
          STM    SBST+1,BP
          LDN    TMMB 
          RJM    MBP         MOVE BUFFER POINTER
          MMOVE  MBUF,,,BP,MBML*10D 
          LDD    BA 
          RJM    WDS         WRITE SECTOR 
          MJN    IME8        IF MASS STORAGE ERROR OCCURRED 
 IME7     ENDMS              RELEASE CHANNEL
          LJM    IEMX        RETURN 
  
 IME8     RJM    ISM         ISSUE SYSTEM CONTROL POINT MESSAGE 
          UJN    IME7        EXIT 
 IOE      SPACE  4,20 
**        IOE - INFORM OPERATOR OF ERROR. 
* 
*         EXIT   (A) = 0 IF TAPE CATALOG ERROR EVENT ISSUED.
*                    .NE. 0 IF UNABLE TO ISSUE EVENT. 
*                *CHECK TMSDIS,FAM* MESSAGE IN A,OPERATOR IF
*                EVENT IS ISSUED. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS  MONITOR.
  
  
 IOE      SUBR               ENTRY/EXIT 
          LDN    ZERL        BUILD EVENT
          CRD    CM 
          LDN    /EVT/TCSE
          STD    CM+4 
          MONITOR  EATM      ISSUE EVENT
          LDD    CM+0 
          UJN    IOEX        RETURN 
 ISM      SPACE  4,10 
**        ISM - ISSUE MESSAGE TO SYSTEM CONTROL POINT.
* 
*         ENTRY  (EC) = ERROR CODE. 
* 
*         EXIT   MESSAGE POSTED ON LINE 2 OF B DISPLAY FOR
*                SYSTEM CONTROL POINT.  *GO,SYS.* REQUIRED TO CLEAR IT. 
* 
*         USES   CM - CM+4. 
  
  
 ISM      SUBR               ENTRY/EXIT 
          LDD    EC 
          RJM    C2D
          STM    ISMA+4 
          LDK    ISMA+7 
          STD    AP 
          LDN    0
          STD    HB 
          RJM    FMM         INSERT FAMILY NAME IN MSG
          LDD    HB          RE-DIRECT MESSAGE POINTER
          SBN    1
          RAD    AP 
          LDD    HB          TERMINATE MESSAGE WITH *.* 
          ZJN    ISM1        IF SPACE IN LOWER 6 BITS 
          LDC    1R.*100-1R *100-1R.+1R 
 ISM1     ADN    1R.-1R 
          RAI    AP 
          LDK    NCPL 
          CRD    CM 
          LDD    CM+1 
          ADN    1
          SHN    7
          ADK    MS2W        MESSAGE 2 AREA FOR SYSTEM CONTROL POINT
          CWM    ISMA,TR
          UJN    ISMX        RETURN 
  
 ISMA     DATA   C* TMS ERRXX ON FAM.*
          BSSZ   3           SPACE FOR 7 CHARACTER FAMILY NAMES 
 LFM      SPACE  4,10 
**        LFM - BUILD LOCAL FILE NAME MESSAGE.
* 
*         SETS THE LOCAL FILE NAME IN THE MESSAGE.
* 
*         ENTRY  (FN - FN+3) = LOCAL FILE NAME. 
* 
*         CALLS  MVM. 
  
  
 LFM      SUBR               ENTRY/EXIT 
          LDD    FN+3        INSURE END OF LFN
          SCN    77 
          STD    FN+3 
          LDN    FN 
          RJM    MVM         MOVE VARIABLE MESSAGE
          UJN    LFMX        RETURN 
 MMC      SPACE  4,10 
*         MMC - MOVE TO MAGNET CONTROL POINT. 
* 
*         ENTRY  (FC) = FUNCTION CODE.
*                (UTMS) = REQUEST SUBFUNCTION.
* 
*         EXIT   CONTROL POINT ASSIGNMENT CHANGE TO MAGNET IF THIS IS 
*                A *VMFS* MAGNET REQUEST. 
* 
*         USES   CM+1.
* 
*         MACROS MONITOR. 
  
  
 MMC      SUBR               ENTRY/EXIT 
          LDD    FC 
          LMN    MAGF 
          NJN    MMCX        IF NOT MAGNET REQUEST
          LDM    UTMS 
          LMN    VMFS 
          NJN    MMCX        IF NOT *VMFS*
          LDK    /COMSCPS/ALCS  SET RETURN TO CALLING CP
          STD    CM+1 
          MONITOR  CCAM      RETURN TO MAGNET CP
          UJN    MMCX        RETURN 
 MVM      SPACE  4,10 
**        MVM - MERGE VARIABLE MESSAGE. 
* 
*         *MVM* WILL MERGE VARIABLE LENGTH MESSAGES 
*         TO A ASSEMBLY BUFFER INSURING THAT THERE
*         WILL BE A SPACE (BLANK) BETWEEN EACH
*         MERGED MESSAGE. THIS ROUTINE IS USED TO 
*         COMBINE SEVERAL DISJOINTED MESSAGES INTO
*         ONE COHERENT MESSAGE WHICH IS THEN ISSUED 
*         ACCORDING THE DISPOSITION CODE. 
* 
*         ENTRY  (A) = ADDRESS OF CHARACTER STRING. 
*                (AP) = ASSEMBLY POINTER. 
*                (HB) = HALF BYTE FLAG. 
* 
*         USES   T1.
* 
  
  
 MVM      SUBR               ENTRY/EXIT 
          STD    T1 
          LDD    HB 
          NJN    MVM2        IF NOT FULL WORD 
 MVM1     LDI    T1          MOVE FULL BYTE 
          ZJN    MVM4        IF END OF MESSAGE
          STI    AP 
          LPN    77 
          ZJN    MVM3        IF END OF MESSAGE
          AOD    T1          ADVANCE TO NEXT BYTE 
          AOD    AP          ADVANCE ASSEMBLY POINTER 
          UJN    MVM1        MOVE NEXT BYTE 
  
 MVM2     LDI    T1          MOVE LOWER CHARACTER 
          SHN    -6 
          ZJN    MVM3        IF END OF MESSAGE
          RAI    AP 
          AOD    AP          ADVANCE ASSEMBLY POINTER 
          LDI    T1          MOVE UPPER CHARACTER 
          LPN    77 
          ZJN    MVM4        IF END OF MESSAGE
          SHN    6
          STI    AP 
          AOD    T1 
          UJN    MVM2        MOVE NEXT BYTE 
  
 MVM3     LDN    1R          INSERT SPACE IN LOWER BYTE 
          RAI    AP 
          AOD    AP 
          LDN    0
          UJN    MVM5        TOGGLE HALF BYTE 
  
 MVM4     LDC    1R *100     INSERT SPACE IN UPPER BYTE 
          STI    AP 
          LDN    1
 MVM5     STD    HB          TOGGLE HALF BYTE 
          LJM    MVMX        RETURN 
 RAM      SPACE  4,10 
**        RAM - BUILD RANDOM ADDRESS MESSAGE. 
* 
*         CONVERTS THE RANDOM ADDRESS TO DISPLAY CODE 
*         AND MOVES IT TO THE ASSEMBLY BUFFER.
* 
*         ENTRY  (CTSA - CTSA+1) = RANDOM ADDRESS.
* 
*         CALLS  C2D, MVM.
  
  
 RAM      SUBR               ENTRY/EXIT 
          LDM    CTSA 
          SHN    -6 
          RJM    C2D         CONVERT TWO DIGITS 
          STM    RAMA 
          LDM    CTSA 
          LPN    77 
          RJM    C2D         CONVERT TWO DIGITS 
          STM    RAMA+1 
          LDM    CTSA+1 
          SHN    -6 
          RJM    C2D         CONVERT TWO DIGITS 
          STM    RAMA+2 
          LDM    CTSA+1 
          LPN    77 
          RJM    C2D         CONVERT TWO DIGITS 
          STM    RAMA+3 
          LDC    RAMA 
          RJM    MVM         MOVE VARIABLE MESSAGE
          LJM    RAMX        RETURN 
  
 RAMA     DATA   C*00000000*
 SSE      SPACE  4,10 
**        SSE - SET SYSTEM EVENT. 
* 
*         ENTRY  (EC) = ERROR CODE. 
* 
*         EXIT   CONTROL POINT EVENT WORD UPDATED.
* 
*         USES   CN - CN+4. 
  
  
 SSE      SUBR               ENTRY/EXIT 
          LDD    CP 
          ADN    TERW 
          CRD    CN 
          LDD    EC 
          LMN    /EMSG/TUA
          ZJN    SSE1        IF TMS UTILITY ACTIVE
          LMN    /EMSG/CNF&/EMSG/TUA
          NJN    SSE2        IF NOT CATALOG NOT FOUND ERROR 
 SSE1     LDN    ESUA 
          UJN    SSE3        SET EVENT IN CONTROL POINT 
  
 SSE2     LDN    ESVB        VSN BUSY OR WAIT SCRATCH 
 SSE3     STD    CN+4        SET EVENT IN CONTROL POINT 
          SHN    -14
          ADC    FBRT*1000
          STD    CN+3 
          LDD    CN+2 
          SCN    77 
          ADN    FBRT/10     SET ROLLOUT TIME 
          STD    CN+2 
          LDD    CP 
          ADN    TERW 
          CWD    CN 
          LJM    SSEX        RETURN 
 UEP      SPACE  4,10 
**        UEP - USER ERROR PROCESSING.
* 
*         IF THE USER IS PROCESSING ERRORS, THE ERROR 
*         CODE IS SET IN THE FET. IF THE ERROR IS ONE 
*         THAT THE USER HAS A ROLLOUT OPTION ON, THE
*         ROLLOUT FLAG IS SET IN FET+0 BIT 17 AND 
*         THE EVENT IS BUILT A ND SET IN *TERW*. IF 
*         THE USER HAS SPECIFIED A ERROR MESSAGE
*         RETURN BUFFER, THE DETAILED MESSAGE IS
*         WRITTEN TO THAT BUFFER. 
* 
*         ENTRY  (EC) = ERROR CODE. 
*                (MBUF) = ASSEMBLED ERROR MESSAGE.
* 
*         USES   CM - CM+4, CN - CN+4, T1 - T3. 
  
  
 UEP      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL    SET ERROR CODE IN FET
          CRD    CM 
          LDD    CM+3 
          SCN    77 
          STD    CM+3 
          LDD    CM+4 
          LPC    777
          STD    CM+4 
          LDD    EC 
          SHN    21-2 
          RAD    CM+3 
          SHN    -6 
          LPC    7000 
          RAD    CM+4 
          LDI    EA          CHECK IF ROLLABLE ERROR
          SHN    21-3 
          PJN    UEP1        IF NON-ROLLABLE ERROR
          RJM    SSE         SET SYSTEM EVENT 
          LDD    CM+3        SET ROLLOUT EVENT FLAG 
          LMN    40 
          STD    CM+3 
 UEP1     LDA    IR+3,REL    REWRITE FET+0
          CWD    CM 
          ADN    TFEA 
          CRD    CM 
          LDA    CM+3,ABS 
          ZJP    UEPX        IF NO USER MESSAGE BUFFER
          LDC    MBUF        COPY ERROR MESSAGE 
          STD    T1 
          LDN    5           SET BYTES PER WORD 
          STD    T2 
          LDN    1
          STD    T3          INITIALIZE CM WORD COUNT 
 UEP2     LDI    T1          SEARCH FOR END OF MESSAGE
          ZJN    UEP3        IF ZERO BYTE FOUND 
          AOD    T1 
          SOD    T2 
          NJN    UEP2        IF NOT FULL CM WORD
          AOD    T3 
          LDN    5
          STD    T2          RESET BYTES PER WORD 
          UJN    UEP2        CONTINUE TO END OF MESSAGE 
  
 UEP3     AOD    T1          CLEAR REMAINDER OF MESSAGE TO FULL WORD
          SOD    T2 
          ZJN    UEP4        IF FULL CM WORD
          LDN    0
          STI    T1          CLEAR MESSAGE TAIL 
          UJN    UEP3        LOOP FOR FULL CM WORD
  
 UEP4     LDA    IR+3,REL    WRITE TO USERS MESSAGE BUFFER
          ADN    TFEA 
          CRD    CM 
          LDA    CM+3,REL 
          CWM    MBUF,T3     SEND MESSAGE TO CENTRAL
          LJM    UEPX        RETURN 
 UNM      SPACE  4,10 
**        UNM - BUILD USERNAME MESSAGE. 
* 
*         SETS THE USERNAME IN THE MESSAGE. 
* 
*         ENTRY  PBUN - PBUN+3) = USERNAME. 
* 
*         CALLS  MVM. 
  
  
 UNM      SUBR               ENTRY/EXIT 
          LDM    PBUN+3      INSURE END OF USERNAME 
          SCN    77 
          STM    PBUN+3 
          LDC    PBUN 
          RJM    MVM         MOVE VARIABLE MESSAGE
          UJN    UNMX        RETURN 
 VSM      SPACE  4,10 
**        VSM - BUILD VSN MESSAGE.
* 
*         SETS THE VSN IN THE MESSAGE.
* 
*         ENTRY  (PESN - PESN+2) = EXTERNAL VSN.
* 
*         CALLS  MVM. 
  
  
 VSM      SUBR               ENTRY/EXIT 
          MMOVE  PESN,,VSMA+2,,VSKL 
          LDC    VSMA 
          RJM    MVM         MOVE VARIABLE MESSAGE
          UJN    VSMX        RETURN 
  
 VSMA     DATA   C*VSN XXXXXX*
          SPACE  4,10 
**        COMMON DECKS. 
  
  
 MVM$     EQU    1           DEFINE MVM - MOVE VARIABLE MESSAGE 
 RCL$     EQU    1           DEFINE RCL - PP RECALL 
*CALL     COMPTFM 
*CALL     COMPC2D 
          TITLE  ERROR MESSAGES.
 EMSG     SPACE  4,15 
**        ERROR MESSAGES. 
* 
*         FORMAT (BYTE 0), ERROR DISPOSITION FLAGS. 
*                (BYTE 1), MESSAGE TYPE AND DESTINATION FLAGS.
*                (BYTE 2), FIRST WORD ADDRESS OF MESSAGE. 
* 
*         MESSAGE DISPOSITION FLAGS.
*                0001 = HANG PPU. 
*                0002 = CALL TFSP TO A CONTROL POINT. 
*                0004 = UNCONDITIONAL ABORT OF USER CONTROL POINT.
*                0010 = ROLLOUT USER CONTROL POINT. 
*                0020 = RESERVED. 
*                0040 = RANDOM ADDRESS MESSAGE. 
*                0100 = USERNAME MESSAGE. 
*                0200 = VSN MESSAGE.
*                0400 = LOCAL FILE NAME MESSAGE.
*                1000 = FILE NAME MESSAGE.
*                2000 = FAMILY NAME MESSAGE.
*                4000 = EQUIPMENT MESSAGE.
* 
*         MESSAGE DESTINATION CODES.
*                0001 = SEND TO CONTROL POINT DAYFILE.
*                0002 = SEND TO SYSTEM DAYFILE. 
*                0004 = SEND TO SYSTEM ERROR LOG. 
*                0010 = SEND TO ACCOUNT DAYFILE.
*                0020 = SEND TO E,P DISPLAY IF UNIT ASSIGNED. 
*                0040 = SEND TO CATALOG MESSAGE BUFFER. 
*                0100 = RESERVED. 
*                0200 = RESERVED. 
*                0400 = RESERVED. 
*                1000 = RESERVED. 
*                2000 = RESERVED. 
*                4000 = RESERVED. 
  
  
 EMSG     EMSG   BEGIN
  
 VBS      EMSG   0210,0001,(BUSY.)
 LNF      EMSG   0400,0001,(NOT FOUND.) 
 FNF      EMSG   1000,0001,(NOT FOUND.) 
 VNF      EMSG   0200,0001,(NOT FOUND.) 
 UNF      EMSG   0100,0001,(NOT FOUND.) 
 NMT      EMSG   0400,0001,(NOT ON MAGNETIC TAPE.)
 VSR      EMSG   0200,0001,(RESERVED.)
 VSD      EMSG   0200,0000,(DUPLICATE.) 
 FAR      EMSG   1000,0001,(ALREADY RESERVED.)
 VAR      EMSG   0200,0001,(ALREADY RESERVED.)
 DLK      EMSG   0200,0006,(DEADLOCK.)
 ILR      EMSG   0000,0001,(TFM INCORRECT REQUEST.) 
 TMD      EMSG   0000,0001,(TMS DISABLED.)
 MNA      EMSG   0000,0001,(MAGNET NOT ACTIVE.) 
 EBP      EMSG   2006,0047,(ERRONEOUS BUFFER POINTER.)
 TUA      EMSG   0010,0001,(TMS UTILITY ACTIVE.)
 BAE      EMSG   0000,0001,(BUFFER ARGUMENT ERROR.) 
 EID      EMSG   0000,0001,(ERROR IN INDEX DATA.) 
 ECD      EMSG   0000,0001,(ERROR IN CATALOG DATA.) 
 EAD      EMSG   0000,0001,(ERROR IN ADMIT DATA.) 
 RAE      EMSG   0046,0041,(RANDOM ADDRESS ERROR.)
 TKL      EMSG   4000,0006,(TRACK LIMIT.) 
 MSE      EMSG   4004,0046,(MASS STORAGE ERROR.)
 CNF      EMSG   2010,0007,(TAPE CATALOG NOT FOUND.)
 ECF      EMSG   0000,0001,(EMPTY CATALOG.) 
 CLE      EMSG   2006,0047,(CATALOG LINKAGE ERROR.) 
 IOS      EMSG   0004,0001,(I/O SEQUENCE ERROR ON CATALOG.) 
 EOI      EMSG   0001,0007,(EOI NOT ON TRACK CHAIN.)
 NAE      EMSG   0000,0001,(NO ADMITS.) 
 TPI      EMSG   0000,0001,(TMS PROCESSING INHIBITED.)
 SFA      EMSG   2010,0001,(ACTIVITY SUSPENDED.)
 FCE      EMSG   2004,0001,(TAPE CATALOG ERROR.)
 WSA      EMSG   0012,0001,(WAIT SCRATCH ASSIGNMENT.) 
 NEU      EMSG   0004,0001,(NO EXTEND ON USER OWNED FILE.)
 WRF      EMSG   0000,0001,(WRITE REQUEST ON READ-ONLY FILE.) 
 MPE      EMSG   0000,0001,(MULTI-FILE PROCESSING ERROR.) 
 FCI      EMSG   0000,0001,(FILE CREATION NOT ALLOWED.) 
 EFD      EMSG   0000,0001,(ERROR IN FILE DATA.)
 CNA      EMSG   0000,2010,(LINKED CATALOG NOT ACCESSIBLE.) 
  
 EMSG     EMSG   END
  
  
 CBUF     SPACE  4,10 
***       BUFFERS.
  
  
 MBUF     BSS    40 
          SPACE  4,10 
          USE    //          FORCE LITERALS 
  
  
          ERRNG  BUF0-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (INITIALIZE FAMILY TAPE CATALOG.),OVL1
          SPACE  4
***       LOCAL DIRECT CELL LOCATIONS.
  
  
 TT       EQU    S1          TAPE TYPE (0=MT/NT, 1=CT, 3=AT)
 NV       EQU    S1+1 - S1+3 NEXT VOLUME
 IC       EQU    S1+1        INITIAL CATALOG FLAG 
 RC       EQU    S1+2        REEL COUNT 
 SV       EQU    S1+4        SYSTEM VSN FLAG
 CV       EQU    S2          CURRENT VSN POINTER
 PV       EQU    S3          PREVIOUS SCRATCH VSN POINTER 
          SPACE  4,10 
***       BUFFER ALLOCATION.
* 
*         THE FOLLOWING BUFFER IS CREATED BY THIS OVERLAY, AND IS 
*         USED BY THE *ISFS* POSTPROCESSOR OVERLAY. 
  
  
 TSPW     BSS    0           TABLE OF SCRATCH POOL WORDS
*                            (INDEXED BY TAPE TYPE) 
          VFD    36/-0,24/0 
          VFD    36/-0,24/0 
          VFD    36/-0,24/0 
          VFD    36/-0,24/0 
  
 OVL2     EQU    *+2         LOAD ADDRESS FOR *ISFS* POSTPROCESSOR
 ISFS     SPACE  4,30 
***       ISFS - INITIALIZE FAMILY TAPE CATALOG.
* 
*         ENTRY  (IR - IR+3) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  60/ 0 
*T,   +7  46/ 0,2/ OP,12/ 0 
* 
*         OP = PROCESSING OPTION. 
*              0 = REORDER SCRATCH ONLY (*TFSP* *ISV* DIRECTIVE). 
*              1 = REORDER SCRATCH AND CLEAR ALL INTERLOCKS (FIRST
*                  *ISF* ON DEVICE).
*              2 = REORDER SCRATCH AND CLEAR CURRENT AND INACTIVE 
*                  MACHINE INTERLOCKS (*ISF* LINK TO SHARED DEVICE).
*              3 = REORDER SCRATCH AND CLEAR INACTIVE MACHINE 
*                  INTERLOCKS (*TFSPR* COMMAND).
* 
*         USES   TT, T2, CV - CV+4, PV - PV+4.
* 
*         CALLS  CFB, GNB, GNL, MBP, PRS, RVB, TBA, WRP.
* 
*         MACROS EXOVL, MMOVE.
  
  
 ISF      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
 ISF0     LDI    BP 
          ZJN    ISF2        IF NO ENTRIES IN FIRST VSN BLOCK 
 ISF1     RJM    CFB         CHECK FILE BUSY
          LDM    CWEL,BA     POSITION TO NEXT INDEX 
          RJM    MBP         MOVE BUFFER POINTER
          MJN    ISF2        IF MOVE OUTSIDE BUFFER 
          LDI    BP 
          NJN    ISF1        IF NOT END OF INDEX
 ISF2     LDC    0           NO BUFFER REWRITE
*         LDC    1           (IF BUFFER REWRITE)
 ISFA     EQU    *-1
          ZJN    ISF3        IF NO BUFFER REWRITE 
          RJM    WRP         WRITE RANDOM PRU 
          LDN    0           CLEAR BUFFER REWRITE NEEDED
          STM    ISFA 
 ISF3     RJM    GNL         GET NEXT LINK
          ZJN    ISF5        IF BLOCK NOT LINKED
          LDC    0           NO BUFFER SWITCH 
*         LDC    1           (BUFFER SWITCH)
 ISFB     EQU    *-1
          ZJN    ISF4        IF NO BUFFER SWITCH
          LDN    0           CLEAR BUFFER SWITCH NEEDED 
          STM    ISFB 
          RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
 ISF4     RJM    GNB         GET NEXT BLOCK 
          LDM    CWFE,BA     SKIP BLOCK CONTROL WORDS 
          RJM    MBP         MOVE BUFFER POINTER
          LJM    ISF1        SEARCH INDEX BUFFER
  
 ISF5     LDD    TT 
          SHN    21-13
          MJP    ISF7        IF NO VSN ENTRIES OF ANY TYPE FOUND
          LDD    TT          SAVE SCRATCH POOL WORD FOR THIS TAPE TYPE
          SHN    2
          ADD    TT 
          ADC    TSPW 
          STD    T2 
          MMOVE  PESN,,,,10D
          LCN    0           CLEAR *VSN ENTRY FOUND* FLAG FOR TAPE TYPE 
          STM    ISFC,TT
          LDN    4           CHECK FOR OTHER TAPE TYPES TO PROCESS
          STD    TT 
 ISF6     SOD    TT          CHECK NEXT TAPE TYPE 
          MJP    ISF7        IF NO MORE TAPE TYPES
          LDM    ISFC,TT
          ZJN    ISF6        IF NO VSN ENTRIES FOUND FOR THIS TAPE TYPE 
          SHN    21-13
          MJN    ISF6        IF TAPE TYPE ALREADY PROCESSED 
          LDD    MA          RESTORE POINTERS FOR FIRST VSN BLOCK 
          CWM    ISFD,ON
          SBN    1
          CRD    CV 
          CWM    ISFE,ON     PRESET PREVIOUS VSN
          SBN    1
          CRM    PESN,ON
          LDN    ZERL        CLEAR PREVIOUS VSN BUFFER POINTERS 
          CRD    PV 
          RJM    RVB         RESTORE VSN BUFFERS
          LJM    ISF0        SCAN FOR NEXT VSN TYPE 
  
 ISF7     EXOVL  ISP         EXECUTE *ISFS* POSTPROCESSOR 
  
  
 ISFC     BSSZ   4           TABLE OF *VSN ENTRY FOUND* FLAGS 
*                            (INDEXED BY TAPE TYPE) 
  
 ISFD     BSS    5           POINTERS TO FIRST LEVEL-2 VSN BLOCK
  
 ISFE     VFD    36/-0,24/0  DEFAULT VALUE FOR SCRATCH POOL WORD
          TITLE  SUBROUTINES. 
 CFB      SPACE  4,20 
**        CFB - CHECK FILE BUSY.
* 
*         ENTRY  (BA) = BUFFER ADDRESS (VSN INDEX). 
*                (BP) = BUFFER POINTER (VSN INDEX). 
*                (TT) = TAPE TYPE (0=MT/NT, 1=CT, 3=AT).
*                (TT) = 4000, IF NO VSN ENTRY OF ANY TYPE FOUND YET.
* 
*         EXIT   (BA) = UNCHANGED.
*                (BP) = UNCHANGED.
*                (TT) = TAPE TYPE, IF THIS VSN IS THE FIRST VSN ENTRY 
*                  OF ANY TYPE FOUND. 
*                (ISFC) WORD FOR THE VSN-S TAPE TYPE SET NONZERO, IF
*                  THE VSN IS NOT THE CORRECT TAPE TYPE.
* 
*         USES   TT, T1.
* 
*         CALLS  CSV, RLV, RSV, SCP.
  
  
 CFB8     RJM    CSV         CHECK FOR SCRATCH VOLUME 
  
 CFB      SUBR               ENTRY/EXIT 
          LDM    VBST+1,BP   DETERMINE TAPE TYPE
          SHN    -5 
          LPN    ACVS/40+CTVS/40
          STD    T1 
          LMD    TT 
          ZJN    CFB3        IF SAME TYPE AS CURRENT SCAN TYPE
          SHN    21-13
          PJN    CFB1        IF NOT FIRST TAPE VSN FOUND OF ANY TYPE
          LDD    T1 
          STD    TT          SET TAPE TYPE FOR THIS SCAN
          UJN    CFB3        PROCESS VSN ENTRY
  
 CFB1     LDM    ISFC,T1
          NJN    CFB2        IF NOT FIRST VSN OF THIS TAPE TYPE 
          AOM    ISFC,T1     INDICATE THAT VSN OF THIS TYPE FOUND 
 CFB2     UJN    CFBX        RETURN 
  
 CFB3     LDM    VBST+1,BP
*         UJN    CFB8        (IF NOT CLEARING INTERLOCKS) 
 CFBA     EQU    *-2
          LPN    VIVS 
          NJN    CFB4        IF VOLUME BUSY 
          LDM    VBJS,BP
          ZJN    CFB8        IF VOLUME NOT ASSIGNED 
 CFB4     LDM    VBMX,BP     SET MACHINE INDEX HOLDING VSN BUSY 
          LPN    17 
          STD    T1 
          LDM    TACM,T1
          NJP    CFBX        IF NOT PROCESSING THIS MACHINE 
          LDM    VBRC,BP     CHECK REEL NUMBER
          SHN    -6 
          SBN    2
          PJP    CFB8        IF NOT FIRST REEL
          RJM    SCP         SET CATALOG BUFFER POINTERS
          LDD    BA          CHECK FOR CATALOG ENTRY
          ZJN    CFB5        IF NO CATALOG ENTRY
          LDM    CBST,BP     CHECK FOR INITIAL ASSIGNMENT 
          SHN    21-11
          PJN    CFB7        IF NOT INITIAL ASSIGNMENT
 CFB5     RJM    RLV         RELEASE CATALOG ENTRIES AND VSNS 
 CFB6     LJM    CFBX        RETURN 
  
 CFB7     RJM    RSV         RESERVE CATALOG ENTRIES AND VSNS 
          UJN    CFB6        RETURN 
 CSV      SPACE  4,20 
**        CSV - CHECK SCRATCH VOLUME. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS (VSN INDEX). 
*                (BP) = BUFFER POINTER (VSN INDEX). 
*                (PV - PV+4) = PREVIOUS SCRATCH VSN POINTERS. 
* 
*         EXIT   (BA) = UNCHANGED.
*                (BP) = UNCHANGED.
*                VSN ADDED TO THE SCRATCH STRING, IF THE VSN STATUS 
*                  IS SCRATCH.
* 
*         USES   CV - CV+4, PV - PV+4.
* 
*         CALLS  CRD, RLV, SCP, WRP.
* 
*         MACROS CLEAR, LDA, MMOVE, RESTP, SAVEP. 
  
  
 CSV4     PJN    CSVX        IF NOT RESERVED
          ERRNZ  RTVS-400000 *CODE MUST BE CHANGED* 
          LDM    VBRC,BP     CHECK REEL NUMBER
          SHN    -6 
          SBN    2
          PJN    CSVX        IF NOT FIRST REEL
          RJM    CRD         CHECK RELEASE DATE 
          ZJN    CSVX        IF NOT TO BE RELEASED
          RJM    SCP         SET CATALOG BUFFER POINTERS
          RJM    RLV         RELEASE CATALOG ENTRIES AND VSNS 
          UJN    CSVX        RETURN 
  
 CSV9     LMM    VBST,BP     CLEAR TEMPORARY SCRATCH
          STM    VBST,BP
          AOM    ISFA        REWRITE BUFFER 
  
 CSV      SUBR               ENTRY/EXIT 
          LDM    VBJS,BP
          NJN    CSVX        IF VOLUME ASSIGNED 
          LDM    VBST,BP     CHECK FOR TEMPORARY SCRATCH
          LPN    TSVS/1S12
          NJN    CSV9        IF TEMPORARY SCRATCH 
          LDA    VBST,BP
          LPC    RTVS+HMVS+UOVS+SVVS+TVVS+MVVS+ERVS 
          ZJN    CSV1        IF AVAILABLE SCRATCH 
          LJM    CSV4        CHECK CONDITIONAL RELEASE
  
 CSV1     LDM    VBST+1,BP   SET AVAILABLE SCRATCH
          LPC    CTVS+ACVS
          STM    VBST+1,BP
          LDN    ASVS/1S12
          STM    VBST,BP
          AOM    PESN+4      INCREMENT SCRATCH COUNT
          SHN    -14
          RAM    PESN+3 
          LDD    PV 
          NJN    CSV2        IF PREVIOUS SCRATCH FOUND
          MMOVE  VBES,BP,PESN,,VSKL 
          UJN    CSV3        SAVE SCRATCH POINTERS
  
 CSV2     MMOVE  VBES,BP,VBNV,PV+1,VSKL 
          LDD    PV 
          LMD    BA 
          ZJN    CSV3        IF SAME BUFFER 
          SAVEP  CV 
          RESTP  PV 
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CV 
 CSV3     AOM    ISFA 
          AOM    ISFB 
          SAVEP  PV 
          CLEAR  VBFV,BP,2*10D
          STM    VBCI,BP
          STM    VBCI+1,BP
          LCN    0           SET END OF SCRATCH DELIMITER 
          STM    VBNV,BP
          STM    VBNV+1,BP
          STM    VBNV+2,BP
          LJM    CSVX        RETURN 
 RLV      SPACE  4,20 
**        RLV - RELEASE CATALOG ENTRIES AND VSNS. 
* 
*         ENTRY  (CV - CV+4) = CURRENT VSN POINTERS.
*                (PV - PV+4) = PREVIOUS SCRATCH POINTERS. 
*                (CPCB - CPCB+4) = CATALOG BUFFER POINTERS. 
* 
*         EXIT   CATALOGS RELEASED. 
*                VSNS RELEASED. 
*                (PV - PV+4) = LAST SCRATCH VSN POINTERS
* 
*         USES   KA, SV, CM - CM+4, CV - CV+4, NV - NV+2, PV - PV+4.
* 
*         CALLS  CSN, IAM, PCE, RVB, VIS, WRP.
* 
*         MACROS CLEAR, COMPARE, ERROR, MMOVE, RESTP, SAVEP.
  
  
 RLV      SUBR               ENTRY/EXIT 
          RESTP  CV          RESTORE CURRENT POINTERS 
          CRM    RLVB,ON     SAVE (CV)
          SBN    1           SAVE FIRST SCRATCH VSN AND COUNT 
          CWM    PESN,ON
          SBN    1
          CRM    RLVA,ON
          MMOVE  VBES,BP,PESN,,VSKL  SAVE FIRST VSN FOR MESSAGE/COMPARE 
          LDN    0
 RLV0     STD    NV          SET/CLEAR PRECEDING SYSTEM VSN FLAG
          LDM    VBST+1,BP   CHECK SYSTEM VSN FLAG
          LPC    SVVS 
          STD    SV          SET PROCESSING SYSTEM VSN FLAG 
          NJN    RLV0.1      IF PROCESSING SYSTEM VSN 
          LDD    PV 
          NJN    RLV1        IF PREVIOUS SCRATCH FOUND
          MMOVE  VBES,BP,RLVA,,VSKL  SET FIRST SCRATCH VSN
 RLV0.1   UJP    RLV2        SKIP TO LAST VSN 
  
 RLV1     LDD    NV 
          ZJN    RLV1.1      IF NO PRECEDING SYSTEM VSN 
          SAVEP  CV          MAKE THIS VSN CURRENT TEMPORARILY
          RJM    RVB         RESTORE VSN BUFFERS
 RLV1.1   MMOVE  VBES,BP,VBNV,PV+1,VSKL  SET NEXT IN CHAIN TO FIRST VSN 
          LDD    PV 
          LMD    BA 
          ZJN    RLV1.2      IF SAME BUFFER 
          RESTP  PV          RESTORE PREVIOUS SCRATCH VSN POINTERS
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CV          RESTORE CURRENT SCRATCH VSN POINTERS 
 RLV1.2   LDD    MA          RESTORE ORIGINAL (CV)
          CWM    RLVB,ON
          SBN    1
          CRD    CV 
 RLV2     LDN    NV          SET NEXT VOLUME
          STD    KA 
          MMOVE  VBNV,BP,NV,,VSKL  SAVE NEXT VSN
          CLEAR  VBFV,BP,2*10D  CLEAR VSN BLOCK 
          STM    VBCI,BP     CLEAR CATALOG POINTERS 
          STM    VBCI+1,BP
          LDM    VBST+1,BP   CLEAR EXTRANEOUS STATUS FLAGS
          LPK    SVVS+TVVS+MVVS+ERVS+CTVS+ACVS
          STM    VBST+1,BP
          LDM    VBST,BP
          LPK    HMVS/1S12+UOVS/1S12
          STM    VBST,BP
          LDD    SV 
          NJN    RLV3        IF SYSTEM VSN
          MMOVE  NV,,VBNV,BP,VSKL  RESTORE NEXT VSN 
          AOM    RLVA+4      INCREMENT SCRATCH COUNT
          SHN    -14
          RAM    RLVA+3 
          LDN    ASVS/1S12   SET AVAILABLE SCRATCH
          RAM    VBST,BP
          COMPARE  PESN,,VBES,BP,VSKL 
          PJN    RLV3        IF VSN IN BUFFER ALREADY PROCESSED 
          LDN    TSVS/1S12   FLAG TEMPORARY SCRATCH 
          RAM    VBST,BP
 RLV3     LDD    NV 
          ZJN    RLV4        IF LAST VOLUME 
          RJM    WRP         WRITE RANDOM PRU 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    RLV3.1      IF VSN FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 RLV3.1   LDD    SV 
          ZJP    RLV2        IF NOT PRECEDED BY SYSTEM VSN
          LJM    RLV0        SET FLAG AND CHECK NEXT SCRATCH VSN
  
 RLV4     STM    ISFA        CLEAR BUFFER REWRITE FLAG
          STM    ISFB        CLEAR BUFFER TOGGLE FLAG 
          LDD    SV 
          NJN    RLV4.1      IF ONLY SYSTEM VSN(S) PROCESSED
          LCN    0           SET END OF SCRATCH VOLUMES 
          STM    VBNV,BP
          STM    VBNV+1,BP
          STM    VBNV+2,BP
          SAVEP  PV          SAVE LAST SCRATCH POINTERS 
 RLV4.1   RJM    WRP         WRITE LAST SCRATCH 
          LDM    CPCB 
          ZJN    RLV6        IF NO CATALOG ENTRY
          MMOVE  CWUN,CPCB,PBUN,,UNKL  SET USERNAME TO TAPE FILE
          LDM    CPCB+1      GET FILE STATUS
          STD    CM 
          LDM    CBST,CM
          SHN    21-11
          MJN    RLV5        IF INITIAL CATALOG 
          LDN    1
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDN    ZERL        SET UNCONDITIONAL RELEASE
          CRD    CM 
          LDN    1           FLAG RELEASE 
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 RLV5     RJM    PCE         PURGE CATALOG ENTRIES
 RLV6     RJM    RVB         RESTORE VSN BUFFERS
          LDD    MA          SET/RESTORE FIRST SCRATCH VSN AND COUNTS 
          CWM    RLVA,ON
          SBN    1
          CRM    PESN,ON
          LJM    RLVX        RETURN 
  
  
 RLVA     BSS    5           FIRST SCRATCH VSN
 RLVB     BSS    5           CURRENT VSN POINTERS 
 RSV      SPACE  4,10 
**        RSV - RESERVE CATALOG ENTRIES AND VSNS. 
* 
*         ENTRY  (CV - CV+4) = CURRENT VSN POINTERS.
*                (PV - PV+4) = PREVIOUS SCRATCH POINTERS. 
*                (CPCB - CPCB+4) = CATALOG BUFFER POINTERS. 
* 
*         EXIT   CATALOG ENTRIES AND VSNS RESERVED. 
*                (BA) = UNCHANGED 
*                (BP) = UNCHANGED 
* 
*         USES   CM, IC, KA, RC.
* 
*         CALLS  CSN, IAM, IRM, RRP, RVB, VIS, VSP, WRP.
* 
*         MACROS ERROR, LDA, MMOVE, RESTP, SAVEP. 
  
  
 RSV      SUBR               ENTRY/EXIT 
          LDD    MA          SAVE SCRATCH POINTERS AND COUNT
          CWM    PESN,ON
          SBN    1
          CRM    RLVA,ON
          RESTP  CV          RESTORE CURRENT VSN POINTERS 
          MMOVE  VBES,BP,PESN,,VSKL  SET FIRST VSN AND CURRENT VSN
          LDC    PVSN 
          STD    KA 
          MMOVE  PESN,,,KA,VSKL 
          SAVEP  CPSI        SAVE SECONDARY VSN POINTERS
          RESTP  CPCB 
          MMOVE  CWUN,BA,PBUN,,UNKL 
 RSV1     LDA    CBQN,BP     SET SEQUENCE NUMBER
          RJM    CSN
          LDM    CBST,BP     GET INITIAL CATALOG STATUS 
          STD    T0 
          LPC    1000 
          STD    IC 
          LMD    T0          CLEAR INITIAL CATALOG STATUS 
          SCN    1           CLEAR BUSY 
          STM    CBST,BP
          LDM    CBRC,BP
          STD    RC 
          RESTP  CPSI        RESTORE SECONDARY VSN POINTERS 
 RSV2     LDD    IC 
          NJN    RSV3        IF INITIAL CATALOG 
          LDM    VBST,BP     CHECK RESERVED STATUS
          LPN    RTVS/1S12
          NJN    RSV4        IF RESERVED
 RSV3     LDN    0           SET RESERVE MESSAGE
          RJM    IAM         ISSUE ACCOUNTING MESSAGE 
 RSV4     LDM    VBST,BP     CLEAR EOI AND SCRATCH STATUS 
          SCN    EOIV/1S12+RTVS/1S12+ASVS/1S12
          LMN    RTVS/1S12   SET RESERVED STATUS
          STM    VBST,BP
          LDM    VBST+1,BP   CLEAR VSN BUSY STATUS
          SCN    VIVS 
          STM    VBST+1,BP
          LDN    0
          STM    VBJS,BP
          SOD    RC 
          ZJN    RSV7        IF NO MORE REELS 
          RJM    WRP         WRITE RANDOM PRU 
          MMOVE  VBNV,BP,,KA,VSKL 
          LDI    KA 
          NJN    RSV6        IF NEXT REEL EXISTS
 RSV5     ERROR  EID         *ERROR IN INDEXED DATA.* 
  
 RSV6     RJM    VIS         VSN INDEXED SEARCH 
          NJN    RSV5        IF NOT FOUND 
          LJM    RSV2        UPDATE NEXT VSN
  
 RSV7     RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
          LDM    CBST,BP
          SHN    21-10
          PJN    RSV8        IF NO RECOVERY MESSAGES TO ISSUE 
          RJM    IRM         ISSUE *TMS* RECOVERY MESSAGES
 RSV8     LDM    CBNC,BP
          SHN    14 
          STD    CI 
          SHN    -14
          LMD    RI 
          NJN    RSV9        IF DIFFERENT CATALOG BLOCK 
          LDM    CBNC+1,BP
          LMD    RI+1 
          ZJN    RSV10       IF DIFFERENT CATALOG BLOCK 
 RSV9     RJM    WRP         WRITE RANDOM PRU 
          LDM    CBNC,BP     CHECK FOR NEXT CATALOG 
          LPN    77 
          STD    RI 
          LDM    CBNC+1,BP
          STD    RI+1 
          ADD    RI 
          ZJN    RSV12       IF LAST CATALOG
          RJM    RRP         READ RANDOM PRU
 RSV10    RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    RSV11       IF POINTER VALID 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 RSV11    SAVEP  CPCB        SAVE CATALOG BUFFERS 
          LJM    RSV1        PROCESS NEXT CATALOG 
  
 RSV12    LDM    CPSI+1      CHECK FOR EXCESS VOLUMES 
          STD    CM 
          LDM    VBNV,CM
          ZJN    RSV13       IF NO EXCESS VOLUMES 
          AOD    RC          FAKE REEL COUNT
          RESTP  CPCB        RESTORE CATALOG BUFFERS
          LJM    RSV2        SET VSN STATUS, ISSUE ACCOUNT FILE MESSAGE 
  
 RSV13    RESTP  CPSI        RESTORE VSN POINTERS 
          RJM    WRP         WRITE RANDOM PRU 
          RJM    RVB         RESTORE VSN BUFFERS
          LDD    MA          RESTORE SCRATCH POINTERS 
          CWM    RLVA,ON
          SBN    1
          CRM    PESN,ON
          LJM    RSVX        RETURN 
 RVB      SPACE  4,15 
**        RVB - RESTORE VSN BUFFERS.
* 
*         ENTRY  (CV - CV+4) = CURRENT SCRATCH BUFFER POINTERS. 
*                (PV - PV+4) = PREVIOUS SCRATCH BUFFER POINTERS.
* 
*         EXIT   (BA - RI+1) = CURRENT SCRATCH BUFFER POINTERS. 
*                BUFFERS RELOADED.
* 
*         CALLS  RRP, TBA.
* 
*         MACROS RESTP. 
  
  
 RVB      SUBR               ENTRY/EXIT 
          LDN    0
          STM    ISFA        NO WRITE NECESSARY 
          STM    ISFB        NO BUFFER TOGGLE NECESSARY 
          RESTP  PV          READ LAST SCRATCH BUFFER 
          LDD    BA 
          ZJN    RVB1        IF NO PREVIOUS SCRATCH 
          RJM    TBA         TOGGLE BUFFER ALLOCATION 
          RJM    RRP         READ RANDOM PRU
          LDD    PV+1        RESET PREVIOUS SCRATCH BUFFER POINTER
          SBD    PV 
          ADD    BA 
          STD    PV+1 
          STD    BP 
          LDD    BA          RESET PREVIOUS SCRATCH BUFFER ADDRESS
          STD    PV 
          LDD    RI          COMPARE RANDOM INDICES 
          LMD    CV+3 
          NJN    RVB1        IF DIFFERENT 
          LDD    RI+1 
          LMD    CV+4 
          NJN    RVB1        IF DIFFERENT 
          AOM    ISFB        BUFFER TOGGLE REQUIRED FOR NEXT VSN BLOCK
          UJN    RVB2        SET CURRENT VSN POINTERS 
  
 RVB1     RESTP  CV          RESTORE CURRENT VSN POINTERS 
          RJM    TBA         TOGGLE BUFFER ALLOCATION 
          RJM    RRP         READ RANDOM PRU
 RVB2     LDD    CV+1        RESET CURRENT VSN BUFFER POINTER 
          SBD    CV 
          ADD    BA 
          STD    CV+1 
          STD    BP 
          LDD    BA          RESET CURRENT VSN BUFFER ADDRESS 
          STD    CV 
          LDD    RI          RESET CURRENT POSITION RANDOM INDEX
          STM    CPRI 
          LDD    RI+1 
          STM    CPRI+1 
          LJM    RVBX        RETURN 
 SCP      SPACE  4,15 
**        SCP - SET CATALOG BUFFER POINTERS 
* 
*         ENTRY  (BA - RI+1) = SECONDARY VSN BUFFER POINTERS. 
* 
*         EXIT   (CV - CV+4) = SECONDARY VSN BUFFER POINTERS. 
*                (CPCB - CPCB+4) = CATALOG ENTRY BUFFER POINTERS. 
*                (BA - RI+1) = CATALOG ENTRY BUFFER POINTERS. 
* 
*         USES   BA, BP, CI, CV - CV+4, RI - RI+1.
* 
*         CALLS  RRP, VSP.
* 
*         MACROS SAVEP. 
  
  
 SCP2     LDI    BP 
          ZJN    SCP1        IF HOLE FOUND
 SCP3     SAVEP  CPCB        SAVE CATALOG POINTERS
  
 SCP      SUBR               ENTRY/EXIT 
          SAVEP  CV          SAVE CURRENT POINTERS
          LDM    VBCI,BP
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    VBCI+1,BP
          ZJN    SCP1        IF NO CATALOG INDEX
          STD    RI+1 
          SHN    -14
          STD    RI 
          LDC    BUF2        DEFINE CATALOG BUFFER
 SCP1     STD    BA 
          ZJN    SCP3        IF NO CATALOG INDEX
          RJM    RRP         READ RANDOM PRU (CATALOG)
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    SCP2        IF VALID CATALOG 
          LDN    0
          UJN    SCP1        SET NO CATALOG 
 CRD      SPACE  4,10 
**        CRD - CHECK RELEASE DATE. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS (VSN INDEX). 
*                (BP) = BUFFER POINTER (VSN INDEX). 
*                (PV - PV+4) = PREVIOUS SCRATCH VSN POINTERS. 
* 
*         EXIT   (A) = 0 IF RELEASE DATE OLD FORMAT, NO RELEASE DATE, 
*                      OR IF RELEASE DATE NOT YET REACHED.
*                (A) .NE. 0 IF RELEASE DATE NEW FORMAT AND EXPIRED. 
* 
*         USES   CM - CM+4. 
* 
*         MACROS MONITOR. 
  
  
 CRD      SUBR               ENTRY/EXIT 
          LDM    VBST+1,BP   VSN STATUS 
          LPN    RDVS 
          ZJN    CRDX        IF RELEASE DATE OLD FORMAT 
          LDM    VBRD+1,BP   RELEASE DATE 
          ZJN    CRDX        IF NO RELEASE DATE 
          STD    CM+4 
          LDM    VBRD,BP     RELEASE DATE YEAR
          LPN    77 
          STD    CM+3 
          LDN    /COMSCPS/VEDS  CHECK RELEASE DATE REACHED
          STD    CM+1 
          MONITOR  VSAM      VALIDATE SECURITY ACCESS FUNCTIONS 
          LDD    CM+1 
          UJN    CRDX        RETURN 
 TACM     SPACE  4,10 
*         TACM - TABLE OF ACTIVE MACHINES.
* 
*         INDEXED BY MACHINE INDEX-1. NONZERO ENTRY FLAGS MACHINE 
*         ACTIVE. 
  
  
 TACM     EQU    OVL1-20
          SPACE  4
**        LOCAL COMMON DECKS. 
  
*CALL     COMPC2D 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 DDE$     EQU    1           DEFINE DDE - DELETE DATA BLOCK 
 DLB$     EQU    1           DEFINE DLB - DELINK BLOCK
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS LINK 
 IAM$     EQU    1           DEFINE IAM - ISSUE ACCOUNT FILE MESSAGE
 IRM$     EQU    1           DEFINE IRM - ISSUE RECOVERY MESSAGES.
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH BY KEY 
 PCE$     EQU    1           DEFINE PCE - PURGE CATALOG ENTRIES 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
*CALL     COMPTFM 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,15 
**        PRS - PRESET FOR *ISF*. 
* 
*         ENTRY  (CPSB - CPSB+4) = SYSTEM BUFFER POINTERS.
* 
*         EXIT   (TT) = 7777. 
*                (BA - RI+1) =  FIRST VSN TO CHECK FOR SCRATCH. 
*                (ISFD - ISFD+4) = (BA - RI+1). 
* 
*         USES   TT, T1, PV - PV+4, RI - RI+1.
* 
*         CALLS  GIB, MBP, RRP, SAM, TBA. 
* 
*         MACROS COMPARE, ERROR, ISTORE, RESTP, SAVEP.
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDM    PFLG 
          LPN    3
          NJN    PRS0        IF CLEARING INTERLOCKS 
          ISTORE CFBA,(UJN CFB8)  BYPASS INTERLOCK CLEARING 
          LDN    0
 PRS0     SBN    2
          MJN    PRS1        IF CLEARING NO OR ALL INTERLOCKS 
          RJM    SAM         SEARCH FOR ACTIVE MACHINES 
 PRS1     LDN    ZERL 
          CRD    PV          CLEAR PREVIOUS SCRATCH POINTERS
          CRM    PESN,ON     CLEAR SCRATCH COUNT
          LCN    0           SET END OF SCRATCH 
          STM    PESN 
          STM    PESN+1 
          STM    PESN+2 
          RESTP  CPSB        RESTORE BUFFER POINTERS
          RJM    RRP         READ RANDOM PRU (TMST) 
          LDM    CWRT,BA
          LMC    RTSB*100B
          NJN    PRS2        IF NOT TMST
          COMPARE PFAM,,,BP,PFKL
          ZJN    PRS3        IF FAMILY CATALOG
 PRS2     ERROR  CNF         *(FAMILY) CATALOG NOT FOUND.*
  
 PRS3     LDM    CWUN,BA
          ZJN    PRS4        IF *TFSP* INTERLOCK NOT SET
          LDM    CWMX,BA     GET INDEX OF MACHINE HOLDING INTERLOCK 
          LPN    17 
          STD    T1 
          LDM    TACM,T1     CHECK PROCESSING INHIBITED FOR MACHINE 
          ZJN    PRS4        IF PROCESSING NOT INHIBITED
          ERROR  TUA         * TMS UTILITY ACTIVE.* 
  
 PRS4     RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          LDN    FPVI        SET PRIMARY VSN INDEX
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK (PRIMARY VSN)
          LDM    CWRT,BA
          LMC    RTVB*100+1 
          ZJN    PRS6        IF PRIMARY VSN INDEX BLOCK 
 PRS5     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS6     LDM    CWFE,BA     FIND FIRST SECONDARY INDEX BLOCK 
          RJM    MBP         MOVE BUFFER POINTER
          LDA    VBCI,BP
          ZJN    PRS5        IF NO SECONDARY INDEX
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK (SECONDARY INDEX)
          LDM    CWFE,BA     SKIP FIRST INDEX ENTRY 
          ADM    CWEL,BA
          RJM    MBP         MOVE BUFFER POINTER
          SAVEP  ISFD        SAVE POINTERS TO FIRST VSN BLOCK 
          LCN    0           INDICATE THAT FIRST SCRATCH NOT YET FOUND
          STD    TT 
          LJM    PRSX        RETURN 
 SAM      SPACE  4,10 
**        SAM - SEARCH FOR ACTIVE MACHINES. 
* 
*         ENTRY  (FO) = CATALOG EST ORDINAL.
* 
*         EXIT   TACM TABLE INITIALIZED.
* 
*         USES   CM - CM+4, FN - FN+4, T1.
* 
*         CALLS  AFA. 
  
  
 SAM2     LCN    0           SET CURRENT MACHINE ACTIVE 
          STM    TACM 
 SAM3     LDM    CDMX 
          STD    T1 
          LDM    PFLG        CHECK PROCESSING OPTION
          LPN    3
          LMN    2
          NJN    SAMX        IF NOT TO PROCESS CURRENT MACHINE
          STM    TACM,T1     CLEAR CURRENT MACHINE ENTRY
  
 SAM      SUBR               ENTRY/EXIT 
          LDD    FO          READ CATALOG FILE EST ENTRY
          RJM    AFA
          CRD    CM 
          SFA    EST,CM      READ EST ENTRY 
          CRD    CM 
          LDD    CM 
          SHN    21-4 
          PJN    SAM2        IF NOT INDEPENDENT SHARED DEVICE 
          LDD    CM+4        READ TRT LENGTH
          SHN    3
          ADK    TDGL 
          CRD    CM 
          ADN    TRLL-TDGL   READ TRT POINTER 
          CRD    FN 
          LDD    CM+2 
          ADN    7
          SHN    -3          MRT LENGTH 
          ADD    CM+2        TRT LENGTH 
          STD    T1          SET DIT OFFSET 
          LDD    FN+3        SET FWA OF DIT 
          LPN    77 
          SHN    14 
          ADD    FN+4 
          ADD    T1 
          STM    SAMA 
          SHN    -14
          RAM    SAMA-1 
          LDN    0           INITIALIZE DIT ENTRY INDEX 
          STD    T1 
 SAM1     LDC    0           READ DIT ENTRY 
 SAMA     EQU    *-1         (DIT FWA)
          ADD    T1 
          CRD    CM 
          LDD    CM+4        SET MACHINE ACTIVE FLAG
          STM    TACM,T1
          AOD    T1          ADVANCE ND OF ENTRIES
          LMN    20 
          NJN    SAM1        IF MORE ENTRIES TO PROCESS 
          LJM    SAM3        CHECK INTERLOCK CLEAR OPTION 
  
  
          ERRNG  BUF1-*      OVERFLOW INTO *BUF1* 
          OVERLAY (*ISFS* POSTPROCESSOR.),/5TB/OVL2 
          SPACE  4
***       LOCAL DIRECT CELL LOCATIONS.
  
  
 TT       EQU    /5TB/TT     TAPE TYPE (SET BY *5TB*) 
          SPACE  4,10 
***       BUFFER ALLOCATION.
* 
*         THE FOLLOWING BUFFER IS CREATED BY OVERLAY *5TB*. 
  
  
 TSPW     EQU    /5TB/TSPW   TABLE OF SCRATCH POOL WORDS
*                            (5 BYTES/ENTRY; INDEXED BY TAPE TYPE)
 ISP      SPACE  4,10 
***       ISP - *ISFS* POSTPROCESSOR. 
* 
*         ENTRY  (PFLG) = PROCESSING OPTION (BITS 1-0). 
*                0 = REORDER SCRATCH ONLY (*TFSP* *ISV* DIRECTIVE). 
*                1 = REORDER SCRATCH AND CLEAR ALL INTERLOCKS (FIRST
*                    *ISF* ON DEVICE).
*                2 = REORDER SCRATCH AND CLEAR CURRENT AND INACTIVE 
*                    MACHINE INTERLOCKS (*ISF* LINK TO SHARED DEVICE).
*                3 = REORDER SCRATCH AND CLEAR INACTIVE MACHINE 
*                    INTERLOCKS (*TFSPR* COMMAND).
* 
*         USES   CM - CM+4. 
* 
*         CALLS  RRP, SEI, WRP. 
* 
*         MACROS CLEAR, MMOVE, MONITOR, RESTP.
  
  
 ISP      ENTRY              ENTRY/EXIT 
          RESTP  CPSB        REREAD SYSTEM BLOCK
          RJM    RRP         READ RANDOM PRU
          RJM    SEI         SET EOI SECTOR LOCATION
          STM    SBTC,BP     SET TRACK COUNT
          LDA    T2,ABS      SET SECTOR COUNT 
          STM    SBPC+1,BP
          SHN    -14
          STM    SBPC,BP
          MMOVE  TSPW,,SBSM,BP,10D  SET *MT*/*NT* SCRATCH VSN POINTER 
          MMOVE  TSPW+5,,SBSC,BP,10D  SET *CT* SCRATCH VSN POINTER
          MMOVE  TSPW+17,,SBSA,BP,10D  SET *AT* SCRATCH VSN POINTER 
          LDM    PFLG 
          LPN    3
          ZJN    ISP1        IF NOT CLEARING INTERLOCKS 
          CLEAR  CWUN,BA,10D CLEAR *TFSP* USER NAME INTERLOCK 
          LDM    SBST+1,BP   CLEAR UTILITY ACIVE AND SUSPEND FLAGS
          SCN    UITS+SATS
          STM    SBST+1,BP
          LDM    SBST,BP
          SCN    FFTS/10000 
          STM    SBST,BP
          LDM    SBID,BP     CHECK MACHINE ID 
          LMM    MFID 
          ZJN    ISP1        IF HOME MAINFRAME
          LDM    SBST,BP
          SCN    GFTS/10000  CLEAR GLOBAL SCRATCH STATUS
          LMN    FFTS/10000  SET FOREIGN MAINFRAME
          STM    SBST,BP
 ISP1     RJM    WRP         WRITE SYSTEM BLOCK 
          LDN    ZERL        POST UTILITY ACTIVE EVENT
          CRD    CM 
          LDN    ESUA 
          STD    CM+4 
          MONITOR EATM       ENTER EVENT
          LDM    TSPW+3      CHECK IF ANY SCRATCH VOLUMES FOUND 
          ADM    TSPW+4 
          ADM    TSPW+5+3 
          ADM    TSPW+5+4 
          ADM    TSPW+17+3
          ADM    TSPW+17+4
          ZJN    ISP2        IF NO SCRATCH VOLUMES OF ANY TYPE FOUND
          LDN    ZERL 
          CRD    CM 
          LDN    ESVB 
          STD    CM+4 
          MONITOR  EATM      ENTER EVENT
 ISP2     LJM    ISPX        RETURN 
  
  
          OVERFLOW  /5TB/OVL2,BUF2  OVERFLOW INTO *BUF2*
          OVERLAY (*RESEX* FIRST REEL ASSIGNMENT.),OVL1 
          SPACE  4
***       LOCAL DIRECT CELL LOCATIONS 
  
  
 CT       EQU    S1          FILE CATEGORY
 MD       EQU    S1+1        FILE ACCESS MODE 
 FV       EQU    S2 - S2+2   FIRST VSN
 RAP      SPACE  4,10 
 RFA      SPACE  4,10 
***       RFAS - *RESEX* FIRST REEL ASSIGNMENT. 
* 
*         CALLED BY *RESEX* TO ASSIGN THE FIRST VOLUME
*         OF A TAPE FILE. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
*T,   +7  36/ VSN,12/ FLAGS,12/ 0 
*T,  +10  60/ TAPE DESCRIPTORS
*T,  +11  36/ PRN,6/ FA,18/ BLOCK SIZE
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/SEQ. NUM.
*T,  +14  36/ SET I.D.,9/ VER.,15/ GEN. 
*T,  +15  30/ RETENTION DATE,30/ CREATION DATE
*T,  +16  42/ ALT. USERNAME,18/ TO
*T,  +17  42/ PASSWORD,6/ AC,6/ CT,6/ MD
* 
*         EXIT   1. IF THIS IS A RESERVED FILE THE TAPE 
*                   FILE PARAMETERS ARE DEFAULTED FROM
*                   THE CATALOG AND THE VSN IS ASSIGNED.
*                2. IF THIS IS A NON- RESERVED FILE, THE
*                   CATALOG IS BUILT AND A SCRATCH VOLUME 
*                   IS ASSIGNED.
* 
*         USES   BP, CM - CM+4, EC, KA. 
* 
*         CALLS  ASR, CAA, ECI, EDT, ERR, FTC, GIB, IUC, PRS, RRP, SMF, 
*                SSP, SVB, VIS, VSP, WRP. 
* 
*         MACROS COMPARE, ERROR, EXOVL, LDA, MMOVE, RESTP, SAVEP. 
  
  
 RFA      ENTRY              ASSIGN FIRST REEL FUNCTION 
          RJM    PRS         PRESET 
          ZJN    RFA1        IF NOT REENTERED REQUEST 
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          MJN    RFA1        IF INCORRECT POINTER 
          SAVEP  CPCB        SAVE BUFFER POINTER (CATALOG)
          LJM    RFA11       CHECK ASSIGNED VOLUME
  
 RFA1     LDM    PESN 
          NJN    RFA1.1      IF A VSN IS SPECIFIED
          LDM    PBTO+1      CHECK FOR SYMBOLIC ACCESS
          SHN    21-2 
          MJN    RFA1.1      IF SYMBOLIC ACCESS 
          LDN    /EMSG/ILR   PRESET *TFM INCORRECT REQUEST.*
          STD    EC 
          LDM    PFLG        CHECK FOR VSN=SCRATCH
          SHN    21-12
          MJN    RFA1.2      IF VSN=SCRATCH 
 RFA1.1   RJM    FTC         FIND TAPE CATALOG
          STD    EC          SET ERROR CODE 
          ZJN    RFA4        IF CATALOG FOUND 
          LMN    /EMSG/VNF
          ZJN    RFA2        IF VSN NOT FOUND ERROR 
 RFA1.2   BSS    0
          LDM    PFTD 
          SHN    21-13
          MJN    RFA3        IF WRITE LABEL 
          LDM    PFTD+1 
          SHN    21-4 
          MJN    RFA3        IF PO=W SELECTED 
 RFA2     LDD    EC          RESTORE ERROR CODE 
          ERROR 
  
 RFA3     LDM    PAUN        CHECK ALTERNATE USER ACCESS
          NJN    RFA2        IF ALTERNATE USER SPECIFIED
          EXOVL  ECI         ENTER CATALOG IMAGE
  
 RFA4     LDM    PBTO+1      SET RESERVE SCRATCH ASSIGNED 
          LPC    7763        CLEAR RESERVE AND SYMBOLIC ACCESS FLAGS
          LMN    10 
          STM    PBTO+1 
          LDN    6
          STD    T0 
          LDM    PESN 
          NJN    RFA5        IF A VSN WAS SPECIFIED 
          LDN    5*10D
          STD    T0 
          LDM    PFLG        CHECK IF THE VSN= PARAMETER WAS SPECIFIED
          SHN    21-12
          PJN    RFA5        IF VSN= WAS NOT SPECIFIED
          ERROR  FAR         *(FILENAME) ALREADY RESERVED.* 
  
 RFA5     MMOVE  CBVS,BP,PVSN,,,T0
          LDM    CBST,BP     SET SYMBOLIC ACCESS FLAG 
          LPN    4
          RAM    PBTO+1 
          SHN    21-0 
          MJN    RFA6        IF USER SUPPLYING PARAMETERS 
          LDM    CBST,BP
          SHN    21-12
          MJN    RFA6        IF RECOVERED FILE
          SHN    21-11-21+12
 RFA6     MJN    RFA7        IF SHOULD CHECK SYMBOLIC REQUEST 
          LDM    PFTD        SET LABEL,TAPE TYPE, DENSITY, CONVERSION 
          LPC    4000 
          STM    PFTD 
          LDM    CBTD,BP
          LPC    3777 
          RAM    PFTD 
          LDM    CBTD+2,BP   SET FORMAT/NOISE 
          STM    PFTD+2 
          LDM    CBTD+3,BP   SET BLOCK SIZE 
          STM    PFTD+3 
          LDM    CBTD+4,BP
          STM    PFTD+4 
 RFA7     LDM    CBST,BP
          SHN    21-2 
          PJP    RFA10       IF NOT SYMBOLIC ACCESS 
          AOM    CAAC        DO NOT UPDATE ADMIT ENTRY
          LDM    PESN 
          ZJN    RFA9        IF VSN NOT SPECIFIED 
          LDM    POFI 
          NJN    RFA8        IF FILE IDENTIFIER SPECIFIED 
 RFAA     LDC    0
*         LDC    (PBQN) 
          ZJN    RFA10       IF NO SEQUENCE NUMBER
 RFA8     EXOVL  SMF         SET MULTI-FILE PARAMETERS
  
 RFA9     LDC    0
*         LDC    (PBQN) 
          ZJN    RFA10       IF NO SEQUENCE NUMBER
          LMM    CBQN+1,BP
          STD    T0 
          SHN    -14
          LMM    CBQN,BP
          LPN    77 
          ADD    T0 
          ZJN    RFA10       IF CORRECT SEQUENCE NUMBER 
          ERROR  FNF         *FILE NOT FOUND.*
  
 RFA10    RJM    CAA         CHECK ALTERNATE USER ACCESS
 RFA11    LDM    CBST,BP     CHECK DATA ERROR FLAG
          SHN    21-1 
          PJN    RFA12       IF NOT DATA ERROR
          LDM    PBTO+1      CHECK FOR *TO=C* 
          SHN    21-11
          MJN    RFA11.1     IF CHECK FOR CATALOG ERROR 
          SHN    21-7-21+11  CHECK FOR *TO=E* 
          MJN    RFA12       IF IGNORE CATALOG ERROR
 RFA11.1  BSS    0
          ERROR  EFD         * ERROR IN FILE DATA.* 
  
 RFA12    LDM    CBES,BP     CHECK ASSIGNED VOLUME
          NJN    RFA15       IF VOLUME ASSIGNED TO CATALOG
          LDM    PFTD 
          SHN    21-13
          MJN    RFA13       IF WRITE LABEL 
          LDM    PFTD+1 
          SHN    21-4 
          PJN    RFA14       IF PO=W NOT SELECTED, ERROR
  
 RFA13    LDM    CBTD,BP     DETERMINE TAPE TYPE
          SHN    -7 
          LPN    3
          RJM    SSP         SET SCRATCH POOL ADDRESS 
          EXOVL  ASR         ASSIGN SCRATCH REEL
  
 RFA14    ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 RFA15    LDC    PESN        GET VSN INDEX
          STD    KA 
          COMPARE ,KA,CBES,BP,VSKL
          ZJN    RFA16       IF VSN INDEX = CATALOG FIRST VOLUME
          LDI    KA 
          ZJN    RFA15.1     IF NO VSN SPECIFIED
          LDM    CBNC,BP
          NJN    RFA15.1     IF MULTIFILE TAPE SET
          LDM    PBTO+1      CHECK IF PRN MOUNT REQUEST BY *RECLAIM*
          SHN    21-10
          MJN    RFA16       IF PRN MOUNT 
 RFA15.1  BSS    0
          MMOVE  CBES,BP,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    RFA17       IF VSN INDEX FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
*         (A) .LT. 0 IF PRN MOUNT.
  
 RFA16    SHN    0-21        FLAG IF PRN MOUNT
          STM    RFAB 
          RESTP  CPSI        RESTORE VSN INDEX
          RJM    RRP         READ RANDOM PRU
          LDC    0
*         LDC    1           (PRN MOUNT)
 RFAB     EQU    *-1
          ZJN    RFA17       IF NOT PRN MOUNT 
          MMOVE  VBVS,BP,PVSN,,VSKL  RESET INTERNAL VSN TO PRN
 RFA17    RJM    IUC         INCREMENT USAGE COUNT
          LDM    PFLG 
          LPC    6377 
          STM    PFLG 
          LDM    VBST,BP
          LPN    UOVS/10000 
          SHN    11-0        SET USER OWNED STATUS
          RAM    PFLG 
          LDM    VBST+1,BP
          LPN    TVVS 
          SHN    10-3        SET OFFSITE STATUS 
          RAM    PFLG 
          LDM    VBRC,BP
          SHN    -6 
          SBN    1
          STM    PESN+4      SET REEL NUMBER
          SBN    1
          MJN    RFA18       IF FIRST REEL
          RJM    WRP         WRITE RANDOM PRU 
          LDN    FV 
          STD    KA 
          MMOVE  VBFV,BP,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    RFA18       IF VSN FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 RFA18    RJM    SVB         SET VSN BUSY 
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          AOM    CBAC+1,BP   INCREMENT ACCESS COUNT 
          SHN    -14
          RAM    CBAC,BP
          LIA    CBAD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
          LDM    PFTD+1 
          SHN    21-4 
          PJN    RFA19       IF PO=W NOT SPECIFIED
          LIA    CBMD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
 RFA19    RJM    WRP         WRITE RANDOM PRU (CATALOG) 
          LDN    ZERL        UPDATE FET 
          CRD    CM 
          LDD    CI 
          LPN    77 
          SHN    6
          LMD    RI 
          STD    CM+3 
          LDD    RI+1 
          STD    CM+4 
          LDN    TFUN-TFES+1
          STD    T1 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWM    CM,ON
          CWM    PBUF,T1
          LJM    RFAX        RETURN 
          TITLE  SUBROUTINES. 
          SPACE  4
**        COMMON DECKS. 
  
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 CAA$     EQU    1           DEFINE CAA - CHECK ALTERNATE USER ACCESS 
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG.
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 IUC$     EQU    1           DEFINE IUC - INCREASE USAGE COUNTER
 SSP$     EQU    1           DEFINE SSP - SET SCRATCH POOL ADDRESS
 SVB$     EQU    1           DEFINE SVB - SET VSN BUSY
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USERS BLOCK
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
***       BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        PRS - PRESET FOR SUBFUNCTION RFAS.
* 
*         ENTRY  NONE.
* 
*         EXIT   (A) = 0 IF NOT A RE-ENTRY REQUEST. 
*                (RI - RI+1) = CATALOG ENTRY IF RE-ENTRANT REQUEST. 
* 
*         USES   BA, CI, CM - CM+4, RI - RI+1.
* 
*         MACROS ERROR
  
  
 PRS      SUBR               ENTRY/EXIT 
          LDM    PBTO+1      CHECK OPTION 
          SHN    21-5 
          PJN    PRS1        IF NOT *TO=A*
          LDC    9999D
          STM    PBQN+1 
          LDM    PBQN 
          SCN    77 
          LMN    9999D/1S12 
          STM    PBQN 
 PRS1     LDM    PBQN        SET *PBQN* FOR IN-LINE CHECKS
          LPN    77 
          ADC    LDCI 
          STM    RFAA 
          STM    RFA9 
          LDM    PBQN+1 
          STM    RFAA+1 
          STM    RFA9+1 
          LDA    IR+3,REL 
          ADN    TFRR 
          CRD    CM 
          LDD    CM+3        SET CATALOG INDEX IF REENTRANT REQUEST 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CM+4 
          ZJN    PRS2        IF NOT REENTRANT REQUEST 
          STD    RI+1        SET CATALOG RANDOM ADDRESS 
          SHN    -14
          STD    RI 
          LDC    BUF2        SET BUFFER ADDRESS 
          STD    BA 
 PRS2     LJM    PRSX        RETURN 
          SPACE  4,10 
          ERRNG  BUF1-* 
          OVERLAY (SET MULTI-FILE PARAMETERS.),OVL1 
          SPACE  4,10 
***       DIRECT CELLS. 
  
  
 CT       EQU    S1          CATEGORY 
 MD       EQU    S1+1        MODE 
 FV       EQU    S1+2 - S1+4 FIRST VOLUME OF MULTI-FILE SET 
 CN       EQU    S2 - S2+4   SCRATCH
 SMF      SPACE  4,10 
**        SMF - SET MULTI-FILE PARAMETERS.
* 
*         IF BOTH FILE NAME AND VSN ARE SPECIFIED ON A RESEX
*         FIRST ASSIGNMENT, AND THE VSN IS A SYMBOLIC ACCESS
*         TAPE, SMF IS CALLED FROM RFA TO SEARCH FOR THE
*         CORRECT FILE CATALOG.  THE INFORMATION FOR THE FILE 
*         IS RETURNED TO THE FET. 
* 
*         USES   KA, T1, CM - CM+4, CN - CN+4.
* 
*         CALLS  CAA, FTC, VIS, WRP.
* 
*         MACROS COMPARE, ERROR, LDA, LIA, MMOVE, RESTP, SAVEP. 
  
  
 SMF      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          NJP    SMF6        IF NOT FILE EXTENSION
          RJM    FTC         FIND TAPE CATALOG
          NJN    SMF1        IF FILE NOT FOUND
          ERROR  FAR         *(FILE) ALREADY RESERVED.* 
  
 SMF1     RESTP  SMFA        GET CATALOG ENTRY FOR FIRST FILE 
          RJM    RRP         READ RANDOM PRU
          MMOVE  CBSI,BP,PBSI,,6  FORCE SETID TO BE SAME AS FIRST FILE
          RJM    VSI         VERIFY SET ID NOT BLANK OR ZERO
          LDN    CN          LOCATE LAST VOLUME OF TAPE 
          STD    KA 
 SMF2     RJM    VIS         VSN INDEXED SEARCH 
          ZJN    SMF4        IF VSN FOUND 
 SMF3     ERROR  EID         *ERROR IN INDEXED DATA.* 
  
 SMF4     LDM    VBST,BP
          LPN    EOIV/1S12
          NJN    SMF5        IF EOI VOLUME
          MMOVE  VBNV,BP,,KA,VSKL 
          LDI    KA 
          NJN    SMF2        IF MORE VOLUMES
          LDN    FV          READ FIRST VOLUME
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    SMF3        IF VSN NOT FOUND 
 SMF5     LJM    SMF11       COPY FET 
  
 SMF6     RJM    RRP         READ CATALOG ENTRY 
          RJM    LTC         LOCATE TAPE CATALOG
          NJN    SMF8        IF FOUND 
 SMF7     ERROR  FNF         *(FILE) NOT FOUND.*
  
 SMF8     LDM    POFI 
          ZJN    SMF9        IF FILE IDENTIFIER NOT SPECIFIED 
          LDD    BP 
          ADM    LTCA 
          STD    T1 
          COMPARE  ,,POFI,,FIKL 
          NJN    SMF7        IF NAMES DO NOT MATCH
 SMF9     LDM    PBTO+1      CHECK FOR *TO=D* 
          SHN    21-0 
          MJN    SMF10       IF *TO=D*
          MMOVE  CBPI,BP,POFI,,4*10D
 SMF10    SAVEP  SMFA        SAVE CATALOG POINTERS
          AOM    CAAC        DO NOT UPDATE ADMIT ENTRY
          RJM    CAA         CHECK ALTERNATE USER ACCESS
          LIA    CBES,BP
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    SMF11       IF VSN FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 SMF11    LDM    CBST,BP     CHECK DATA ERROR FLAG
          SHN    21-1 
          PJN    SMF12       IF NO DATA ERROR 
          LDM    PBTO+1      CHECK FOR *TO=C* 
          SHN    21-11
          MJN    SMF11.1     IF CHECK FOR CATALOG ERROR 
          SHN    21-7-21+11 
          MJN    SMF12       IF IGNORE CATALOG ERROR
 SMF11.1  ERROR  EFD         * ERROR IN FILE DATA.* 
  
 SMF12    MMOVE  VBES,BP,PESN,,VSKL 
          MMOVE  VBVS,BP,PVSN,,VSKL 
          LDM    VBRC,BP     SET REEL NUMBER
          SHN    -6 
          SBN    1
          STM    PESN+4 
          LDN    FV          SET FIRST VOLUME BUSY
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJP    SMF3        IF VSN NOT FOUND 
          RJM    SVB         SET VSN BUSY 
          RJM    WRP         WRITE UPDATED VSN
          RESTP  SMFA        RESTORE CATALOG INDEX POINTERS 
          LDN    ZERL        SET CATALOG INDEX
          CRD    CM 
          LDD    CI 
          SHN    6
          LMD    RI 
          STD    CM+3 
          LDD    RI+1 
          STD    CM+4 
          LDM    PBTO+1      CHECK FOR *TO=D* 
          SHN    21-0 
          MJN    SMF13       IF *TO=D* SPECIFIED
          LDM    PFTD        SAVE WRITE FLAG
          LPC    4000 
          STM    PFTD 
          LDM    CBTD,BP     SET LABEL, TAPE TYPE, DENSITY, CONVERSION
          LPC    3777 
          RAM    PFTD 
          LDM    CBTD+2,BP   SET FORMAT/NOISE 
          STM    PFTD+2 
          LDM    CBTD+3,BP   SET BLOCK SIZE 
          STM    PFTD+3 
          LDM    CBTD+4,BP
          STM    PFTD+4 
 SMF13    LDN    TFUN-TFES+1 UPDATE FET 
          STD    T1 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWD    CM 
          ADN    TFES-TFRR
          CWM    PESN,T1
          LJM    SMFX        RETURN 
  
 SMFA     BSS    5           CATALOG INDEX
          TITLE  SUBROUTINES. 
VSI       SPACE  4,10 
**        VSI - VERIFY SET IDENTIFIER 
* 
*         ENTRY  (PBSI - PBSI+2) = SET ID FROM TAPE CATALOG 
* 
*         EXIT   IF VALID SET IDENTIFIER
* 
*         ERROR  *MULTI-FILE PROCESSING ERROR* IF SET ID
*                IS ZEROES OR BLANKS. 
* 
*         USES   T1, T2.
  
  
 VSI4     ERROR  MPE         *MULTI-FILE PROCESSING ERROR.* 
  
 VSI      SUBR               ENTRY/EXIT 
          LDN    0           CHECK FOR ZEROES 
          STD    T2 
 VSI1     LDN    3           VERIFY SET IDENTIFIER
          STD    T1 
 VSI2     SOD    T1 
          MJN    VSI4        IF INCORRECT SET IDENTIFIER
          LDM    PBSI,T1
          LMD    T2 
          NJN    VSI3        IF VALID CHARACTERS
          UJN    VSI2 
  
 VSI3     LDD    T2 
          NJN    VSIX        IF NEITHER BLANKS NOR ZEROES 
          LDC    2R          CHECK FOR BLANKS 
          STD    T2 
          UJN    VSI1        VERIFY SET IDENTIFIER
          SPACE  4,10 
***       COMMON DECKS. 
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 CAA$     EQU    1           DEFINE CAA - CHECK ALTERNATE USER ACCESS 
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 LTC$     EQU    1           DEFINE LTC - LOCATE TAPE CATALOG 
 SVB$     EQU    1           DEFINE SVB - SET VSN BUSY
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USER BLOCK 
  
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4,10 
**        BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4,10 
          ERRNG  BUF2-* 
          TITLE  PRESET.
 PRS      SPACE  4,15 
**        PRS - PRESET. 
* 
*         ENTRY  (CPCB - CPCB+4) = CATALOG BUFFER POINTERS. 
*                (FV - FV+2) = FIRST VSN. 
*                (CN - CN+2) = FIRST VSN. 
* 
*         EXIT   (A) = 0     IF FILE EXTENSION. 
* 
*         USES   BA, BP, CI, KA, RI - R1+1. 
* 
*         CALLS  SIB, VIS, VSP. 
* 
*         MACROS ERROR, LDA, MMOVE, RESTP, SAVEP. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          RESTP  CPSI        RESTORE SECONDARY VSN INDEX POINTERS 
          MMOVE  VBFV,BP,FV,,VSKL 
          MMOVE  FV,,CN,,VSKL 
          LDN    FV 
          STD    KA 
          LDD    BA 
          ADN    2
          STD    BP 
          RJM    SIB         SEARCH FOR VSN IN BUFFER 
          ZJN    PRS2        IF VSN FOUND 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    PRS2        IF VSN FOUND 
 PRS1     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS2     LDM    VBCI,BP
          ZJN    PRS1        IF NO CATALOG ENTRY
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDM    VBCI+1,BP
          STD    RI+1 
          LDC    BUF2 
          STD    BA 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          SAVEP  SMFA        SAVE CATALOG POINTERS
          LDA    PBQN,ABS 
          LMC    9999D
          ZJN    PRS3        IF EXTENSION 
          LDM    PBTO+1 
          SHN    21-5 
          PJN    PRS6        IF NOT EXTENSION 
          LDM    PBQN 
          SCN    77 
          LMN    9999D/1S12 
          STM    PBQN 
          LDC    9999D
          STM    PBQN+1 
 PRS3     LDM    PAUN 
          ZJN    PRS4        IF NOT ALTERNATE USER
          ERROR  FCI         *FILE CREATION NOT ALLOWED.* 
  
 PRS4     STM    PESN        FORCE SEARCH ON LOGICAL FILENAME 
 PRS5     LJM    PRSX        RETURN 
  
 PRS6     LDM    PBTO+1 
          SHN    21-5 
          PJN    PRS7        IF NOT *TO=D*
          LDN    CBLI        FORCE SEARCH ON LOGICAL FILENAME 
          STM    LTCA 
 PRS7     LDN    1
          UJN    PRS5        RETURN 
          SPACE  4,10 
          OVERFLOW  OVL1,BUF1 
          OVERLAY (CLEAR *POSMF* POINTER / MULTI-FILE ASSIGNMENT.),OVL1 
          SPACE  4,10 
***       DIRECT CELLS. 
  
  
 FV       EQU    S1+2 - S1+4 FIRST VOLUME OF MULTI-FILE SET 
 CN       EQU    S2 - S2+4   SCRATCH
 CPP      SPACE  4,10 
***       CPPS - CLEAR *POSMF* CATALOG POINTER. 
* 
*         IF THE CATALOG POINTED TO BY THE *POSMF* CATALOG HAS
*         NOT BEEN A VALIDATED TAPE LABEL, THE CATALOG ENTRY
*         IS PURGED.
* 
*         ENTRY  NONE.
* 
*         EXIT   *POSMF* FLAG CLEARED.
*                CATALOG ENTRY DELETED IF EXTENSION.
* 
*         USES   BA, CI, KA, T1, CM - CM+4, CN - CN+4, RI - RI+1. 
* 
*         CALLS  DCE, RRP, VIS, VSP.
* 
*         MACROS ERROR, LDA, UDTRD, UDTWT.
  
  
 CPP      ENTRY              ENTRY/EXIT 
          UDTRD  CN,/MTX/UTCI,1 
          LDD    CN+1 
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDD    CN+2 
          STD    RI+1 
          LDC    BUF2 
          STD    BA 
          RJM    RRP         GET CATALOG BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    CPP2        IF NO ERROR
 CPP1     LDN    0
          STD    CN+1 
          STD    CN+2 
          UDTWT  CN,/MTX/UTCI,1 
          LJM    CPPX        RETURN 
  
 CPP2     LDA    CBQN,BP
          LMC    9999D
          NJN    CPP1        IF NOT *POSMF 9999*
          LDD    CN+3        SAVE VSN POINTER TO CATALOG
          STD    CM 
          LDD    CN+4 
          STD    CM+1 
 CPP3     LDD    CM          COMPARE NEXT CATALOG INDEX TO CURRENT
          SHN    14 
          STD    CI 
          SHN    -14
          LMD    RI 
          SHN    14 
          LMD    CM+1 
          LMD    RI+1 
          ZJN    CPP4        IF SAME CATALOG BLOCK
          LDD    CM 
          LPN    77 
          STD    RI 
          LDD    CM+1 
          STD    RI+1 
          RJM    RRP         GET CATALOG BLOCK
 CPP4     RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    CPP6        IF NO ERROR
 CPP5     ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 CPP6     LDM    CBNC,BP     COMPARE NEXT CATALOG 
          LMD    CN+1 
          NJN    CPP7        IF NOT *POSMF 9999* CATALOG
          LDM    CBNC+1,BP
          LMD    CN+2 
          ZJN    CPP8        IF *POSMF 9999* CATALOG
 CPP7     LDM    CBNC,BP
          ZJN    CPP5        IF NO NEXT CATALOG 
          STD    CM 
          LDM    CBNC+1,BP
          STD    CM+1 
          LJM    CPP3        CHECK NEXT CATALOG ENTRY 
  
 CPP8     LDN    0
          STM    CBNC,BP
          STM    CBNC+1,BP
          LDD    CN+1 
          SHN    14 
          STD    CI 
          SHN    -14
          LMD    RI 
          NJN    CPP9        IF DIFFERENT PRU 
          LDD    CN+2 
          LMD    RI+1 
          ZJN    CPP10       IF SAME PRU
 CPP9     RJM    WRP         WRITE RANDOM PRU 
          LDD    CN+1 
          LPN    77 
          STD    RI 
          LDD    CN+2 
          STD    RI+1 
          RJM    RRP         READ RANDOM PRU
 CPP10    RJM    VSP         VERIFY/SET CATALOG ENTRY 
          MJP    CPP5        IF ERROR 
          LDN    0
          STD    CN+1 
          STD    CN+2 
          UDTWT  CN,/MTX/UTCI,1 
          RJM    PCE         PURGE CATALOG ENTRIES
          LJM    CPPX        RETURN 
 MFA      SPACE  4,24 
***       MFAS - *RESEX* MULTI-FILE ASSIGNMENT. 
* 
*         CALLED BY *RESEX* TO TRANSLATE A MULTI-FILE SET REQUEST 
*         BY SYMBOLIC FILE NAME.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/R,8/ AT,6/ CODE,3/ST
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FILE IDENTIFIER (CONT.),18/ SEQ. NUM
*T,  +14  36/ SET I.D.,9/ VER.,15/ GEN. 
*T,  +15  30/ RETENTION DATE,30/ CREATION DATE
*T,  +16  42/ ALTERNATE USERNAME,18/ TO 
*T,  +17  42/ PASSWORD,6/ AC,6/ CT,6/ MD
* 
*         EXIT   IF THE FILE IS FOUND, THE VALUES IN THE CATALOG
*                ENTRY ARE PLACED IN THE FET.  IF THE FILE IS AN
*                EXTENSION, THE VALUES FROM THE UDT ARE PLACED IN 
*                THE FET. 
* 
*         USES   KA, T1.
* 
*         CALLS  CPP, DCE, FTC, PRS, VIS. 
* 
*         MACROS COMPARE, ERROR, LDA, LIA, MMOVE. 
  
  
 MFA      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          ZJN    MFAX        IF NON-SYMBOLIC ACCESS 
          LDM    VBCI,BP     GET FIRST CATALOG ENTRY FOR VSN
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDM    VBCI+1,BP
          STD    RI+1 
          LDC    BUF2 
          STD    BA 
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    MFA1        IF NO ERROR
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 MFA1     COMPARE  PBUN,,CWUN,BA,UNKL  FLAG ALTERNATE USER ACCESS 
          STM    PAUN 
          MMOVE  CWUN,BA,PBUN,,UNKL 
          SAVEP  MFAA        SAVE CATALOG POINTERS
          LDD    CN+1        CHECK FOR INTERRUPTED *POSMF*
          ZJN    MFA2        IF NO *POSMF*
          EXSUB  CPP         CLEAR *POSMF* CATALOG POINTER
          RESTP  MFAA        RESTORE FIRST CATALOG ENTRY
          RJM    RRP         READ RANDOM PRU
 MFA2     LDM    UTMS+2      CHECK IF FILE WAS WRITTEN ON 
          ZJN    MFA3        IF NOT WRITTEN ON
          RJM    DCE         DELETE EXCESS CATALOG ENTRIES
          RESTP  MFAA        RESTORE FIRST CATALOG ENTRY
          RJM    RRP         READ RANDOM PRU
 MFA3     RJM    LTC         FIND TAPE CATALOG
          NJN    MFA5        IF FOUND 
          LDM    PBTO+1 
          SHN    21-5 
          PJN    MFA4        IF NOT TAPE FILE EXTENSION 
          MMOVE  CBSI,BP,PBSI,,6
          LJM    MFA8        UPDATE FET 
  
 MFA4     ERROR  FNF         *(FILE) NOT FOUND
  
 MFA5     LDM    POFI        COMPARE FILE IDENTIFIERS 
          ZJN    MFA6        IF NOT SPECIFIED 
          LDD    BP 
          ADM    LTCA 
          STD    T1 
          COMPARE  ,,POFI,,FIKL 
          NJN    MFA4        IF NO MATCH
 MFA6     LDM    PAUN 
          ZJN    MFA7        IF NOT ALTERNATE USER ACCESS 
          COMPARE  PPWD,,CBPW,BP,PWKL 
          NJN    MFA4        IF INCORRECT PASSWORD
 MFA7     LDM    CBST,BP     CHECK FOR DATA ERROR 
          SHN    21-1 
          PJN    MFA7.2      IF NO DATA ERROR 
          LDM    PBTO+1      CHECK FOR *TO=C* 
          SHN    21-11
          MJN    MFA7.1      IF CHECK FOR CATALOG ERROR 
          SHN    21-7-21+11 
          MJN    MFA7.2      IF IGNORE CATALOG ERROR
 MFA7.1   ERROR  EFD         * ERROR IN FILE DATA.* 
  
 MFA7.2   LDM    PBTO+1 
          SHN    21-0 
          MJN    MFA9        IF *TO=D* SPECIFIED
          MMOVE  CBVS,BP,PVSN,,5*10D
 MFA8     LDN    TFUN-TFES+1 UPDATE FET 
          STD    T1 
          LDA    IR+3,REL 
          ADN    TFES 
          CWM    PBUF,T1
 MFA9     LJM    MFAX        RETURN 
  
 MFAA     BSS    5           FIRST CATALOG ENTRY FOR VSN
          TITLE  SUBROUTINES. 
 PEC      SPACE  4,10 
**        PEC - PURGE EXCESS CATALOG ENTRIES. 
* 
*         ENTRY  NONE.
* 
*         EXIT   EXCESS CATALOGS RELEASED.
*                EOI VSN STATUS SET.
*                REEL WRITTEN ON CLEARED. 
* 
*         USES   KA, CN - CN+4. 
* 
*         CALLS  DCE, VIS, WRP. 
* 
*         MACROS COMPARE, ERROR, MMOVE, UDTRD.
  
  
 PEC3     LDM    VBST,BP     SET *EOI* VOLUME 
          SCN    EOIV/1S12
          LMN    EOIV/1S12
          STM    VBST,BP
          RJM    WRP         UPDATE STATUS
 PEC4     LDN    0           CLEAR *REEL WRITTEN* FLAG
          STM    UTMS+2 
  
 PEC      ENTRY              ENTRY/EXIT 
          UDTRD  CN,/MTX/UTCI,1 
          RJM    DCE         DELETE CATALOG ENTRIES 
          LDC    PESN 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    PEC4        IF NOT FOUND 
          COMPARE  VBFV,BP,PESN,,VSKL 
          ZJN    PEC1        IF FIRST VOLUME
          MMOVE  VBFV,BP,PESN,,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    PEC2        IF FOUND 
 PEC1     LDM    VBRC,BP     CHECK FOR *EOI* VOLUME 
          SHN    -6 
          LMM    UTMS+2 
          ZJP    PEC3        IF *EOI* VOLUME
          MMOVE  VBNV,BP,PESN,,VSKL 
          RJM    VIS
          ZJN    PEC1        IF NEXT VSN FOUND
 PEC2     ERROR  EID         *ERROR IN INDEX DATA.* 
 RDC      SPACE  4,10 
***       RDC - RELEASE DELETED CATALOG ENTRIES.
* 
*         ANY CATALOG ENTRIES WHICH FOLLOW THE CURRENT CATALOG ARE
*         DELETED BECAUSE THE FILES ON THE TAPE WERE OVERWRITTEN. 
* 
*         ENTRY  NONE.
* 
*         EXIT   TO PMF TO PROCESS MULTI-FILE SET REQUEST.
* 
*         USES   CN - CN+4. 
* 
*         CALLS  CPP, DCE, PMF. 
* 
*         MACROS EXOVL, EXSUB, UDTRD. 
  
  
 RDC      ENTRY              ENTRY/EXIT 
          UDTRD  CN,/MTX/UTCI,1 
          LDD    CN+1        CHECK FOR POSMF IN PROGRESS
          ZJN    RDC1        IF NOT *POSMF* 
          EXSUB  CPP         CLEAR *POSMF* CATALOG POINTER
 RDC1     LDC    BUF2 
          STD    BA 
          RJM    DCE         DELETE EXCESS CATALOG ENTRIES
          ZJN    RDCX        IF NO CATALOG ENTRY
          EXOVL  PMF         POSITION MULTI-FILE
 DCE      SPACE  4,10 
**        DCE - DELETE EXCESS CATALOG ENTRIES 
* 
*         ENTRY  (CN - CN+4) = *UTCI* FROM UDT. 
* 
*         EXIT   (A) = 0 IF NO CATALOG ENTRY. 
* 
*         USES   CI, KA, RI - RI+1. 
* 
*         CALLS  CSN, IAM, PCE, RRP, VIS, VSP, WRP. 
* 
*         MACROS ERROR, LDA, MMOVE, RESTP.
  
  
 DCE5     LDN    0
  
 DCE      SUBR               ENTRY/EXIT 
          LDD    CN+3 
          ZJN    DCEX        IF NO CATALOG ENTRY
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDD    CN+4 
          STD    RI+1 
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    DCE5        IF ERROR 
          SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          LIA    CBES,BP
          STD    KA 
          LDI    KA 
          ZJP    DCE2        IF NO FIRST VSN
          RJM    VIS         VSN INDEXED SEARCH 
          NJP    DCE2        IF NO FIRST VSN
          LDM    VBRC,BP     GET REEL COUNT 
          SHN    -6 
          STD    T0 
          LDM    UTMS+2      GET LAST REEL NUMBER 
          SBD    T0 
          ADN    1
          STD    S1          REEL COUNT 
          MMOVE  PESN,,DCEA,,VSKL   SAVE CURRENT VSN
          MMOVE  VBFV,BP,PESN,,VSKL 
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
          LDD    S1 
          STM    CBRC,BP
          LDM    CBNC,BP
          NJN    DCE1        IF NEXT CATALOG FOUND
          RJM    WRP         WRITE RANDOM PRU (CATALOG ENTRY) 
          MMOVE  DCEA,,PESN,,VSKL   RESTORE CURRENT VSN 
          LDN    1
          LJM    DCEX        RETURN 
  
 DCE1     SHN    14          SET NEXT CATALOG POINTER 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDM    CBNC+1,BP
          STM    CPCB+4 
          LDD    BA 
          STM    CPCB 
          LDN    0           CLEAR NEXT CATALOG POINTER 
          STM    CBNC,BP
          STM    CBNC+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    DCE3        IF NO ERROR
 DCE2     ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 DCE3     LDD    BP          SAVE BUFFER POINTER
          STM    CPCB+1 
          LDM    CBST,BP
          SHN    21-10
          MJP    DCE4        IF CATALOG NOT RESERVED
          LDA    CBQN,BP
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDN    ZERL 
          CRD    CM 
          LDN    1           RELEASE VSN/CATALOG ENTRY
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 DCE4     RJM    PCE         PURGE CATALOG ENTRIES
          MMOVE  DCEA,,PESN,,VSKL   RESTORE CURRENT VSN 
          LDN    1
          LJM    DCEX        RETURN 
  
 DCEA     BSS    VSKL        SAVE CURRENT VSN 
          SPACE  4,10 
***       COMMON DECKS. 
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK BLOCK
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS LINK 
 IAM$     EQU    1           DEFINE IAM - ISSUE ACCOUNT FILE MESSAGE
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH WITH KEY 
 LTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 PCE$     EQU    1           DEFINE PCE - PURGE CATALOG ENTRIES 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAAT INDEX
 SIB$     EQU    1           DEFINE SIB - SEARCH IN BUFFER
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USER BLOCK 
  
*CALL     COMPC2D 
*CALL     COMPTFM 
          SPACE  4,10 
**        BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4,10 
          ERRNG  BUF2-* 
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        PRS - PRESET FOR SUBFUNCTION MFAS.
* 
*         ENTRY  NONE 
* 
*         EXIT   (A) = 0 IF NOT A SYMBOLIC ACCESS REQUEST.
*                (CN - CN+4) = *UTCI* FROM *MAGNET*.
* 
*         USES   BA, CI, KA, T1, CN - CN+4, FV - FV+4, RI - RI+1. 
* 
*         CALLS  RRP, VIS, VSP. 
* 
*         MACROS COMPARE, ERROR, LDA, MMOVE, UDTRD. 
  
  
 PRS6     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS7     LDI    T1          SPACE FILL LAST CHARACTER
          LPN    77 
          LMC    1S6*1R 
          STI    T1 
 PRS8     LDM    PBTO+1 
          SHN    21-5 
          MJN    PRS9        IF *TO=A* SPECIFIED
          LDA    PBQN,ABS    CHECK FOR MULTI-FILE EXTENSION 
          LMC    9999D
          NJN    PRSX        IF NOT MULTI-FILE EXTENSION
 PRS9     LDC    9999D       FORCE MULTI-FILE SET EXTENSION 
          STM    PBQN+1 
          LDM    PBQN 
          SCN    77 
          LMN    9999D/1S12 
          STM    PBQN 
          LDM    PBTO+1      SET *TO=A* 
          SCN    1S5
          LMN    1S5
          STM    PBTO+1 
          UJN    PRSX        RETURN 
  
 PRS10    LDN    0           NON-SYMBOLIC ACCESS REQUEST
  
 PRS      SUBR               ENTRY/EXIT 
          LDM    UDTA 
          ZJN    PRSX        IF NOT MULTI-FILE
          LDM    UTMS+4 
          LPC    RSSA 
          ZJN    PRSX        IF NON-SYMBOLIC ACCESS 
          LDM    PBTO+1 
          LPN    1
          NJN    PRS1        IF *TO=D* NOT SPECIFIED
          LDN    CBLI        SEARCH FOR LOGICAL FILE IDENTIFIER 
          STM    LTCA 
 PRS1     UDTRD  FV,/MTX/USID,1 
          RJM    VSI         VERIFY SET IDENTIFIER
          MMOVE  FV,,PBSI,,6
          UDTRD  FV,/MTX/UESN,1 
          UDTRD  CN,/MTX/UTCI,1 
          LDN    FV 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJP    PRS10       IF VSN NOT FOUND 
          COMPARE  VBFV,BP,FV,,VSKL 
          ZJN    PRS2        IF FIRST VSN 
          MMOVE  VBFV,BP,FV,,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    PRS2        IF FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS2     LDM    POFI 
          NJP    PRS8        IF FILE NAME SUPPLIED
          LDA    IR+3,REL    GENERATE FILE IDENTIFIER FROM FILE NAME
          CRM    POFI,ON
          LDC    POFI 
          STD    T1 
          LDM    3,T1 
          SCN    77 
          STM    3,T1 
 PRS3     LDI    T1          SEARCH FOR ZERO BYTE 
          SCN    77 
          ZJN    PRS5        IF ZERO BYTE 
          LDI    T1 
          LPN    77 
          ZJN    PRS4        IF ZERO BYTE 
          AOD    T1 
          UJN    PRS3        CONTINUE SEARCH
  
 PRS4     LDI    T1          MERGE SPACE IN LOWER BYTE
          LMC    1S6*1R 
 PRS5     LMC    2R 
          STI    T1 
          AOD    T1 
          LMC    POFI+10
          ZJP    PRS7        IF DONE WITH SPACE FILL
          LDN    0
          UJN    PRS5        CONTINUE SPACE FILL
 VSI      SPACE  4,10 
**        VSI - VERIFY SET IDENTIFIER.
* 
*         ENTRY  (FV - FV+2) = SET ID FROM *UDT*. 
* 
*         EXIT   IF VALID SET IDENTIFIER. 
* 
*         ERROR  *MULTI-FILE PROCESSING ERROR* IF SET ID
*                IS ZEROES OR BLANKS. 
* 
*         USES   T1, T2.
  
  
 VSI4     ERROR  MPE         *MULTI-FILE PROCESSING ERROR.* 
  
 VSI      SUBR               ENTRY/EXIT 
          LDN    0           CHECK FOR ZEROES 
          STD    T2 
 VSI1     LDN    3           VERIFY SET IDENTIFIER
          STD    T1 
 VSI2     SOD    T1 
          MJN    VSI4        IF INCORRECT SET IDENTIFIER
          LDM    FV,T1
          LMD    T2 
          NJN    VSI3        IF VALID CHARACTERS
          UJN    VSI2        CHECK NEXT TWO CHARACTERS
  
 VSI3     LDD    T2 
          NJN    VSIX        IF NEITHER BLANKS NOR ZEROES 
          LDC    2R          CHECK FOR BLANKS 
          STD    T2 
          UJN    VSI1        VERIFY SET IDENTIFIER
          SPACE  4,10 
          ERRNG  BUF1-* 
          OVERLAY (POSITION MULTI-FILE.),OVL1 
          SPACE  4,10 
***       DIRECT CELLS. 
  
  
 CT       EQU    S1          CATEGORY 
 MD       EQU    S1+1        MODE 
 CB       EQU    S3 - S3+1   CATALOG BUFFER POINTER 
          QUAL   PMF
 CB       EQU    /".Y."/CB   FOR *ENTER CATALOG IMAGE*
          QUAL   *
 PMF      SPACE  4,10 
**        PMF - POSITION MULTI-FILE.
* 
*         *PMF* READS THE *POSMF* REQUEST FROM THE USER-S FET,
*         AND VALIDATES THAT IT IS ACCESSIBLE TO THE USER.  IF
*         THE USER IS ALLOWED TO USE IT, IT UPDATES THE ACCESS
*         COUNTS AND SETS THE *POSMF* FLAGS IN THE *UDT*. 
* 
*         ENTRY  NONE.
* 
*         EXIT   *POSMF* CATALOG ENTRY PLACED IN *UDT*. 
* 
*         USES   CI, KA, CB - CB+1, CM - CM+4, RI - RI+1. 
* 
*         CALLS  ECI, RRP, VIS, VSP.
* 
*         MACROS COMPARE, ERROR, MMOVE. 
  
  
 PMF      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          ZJN    PMFX        IF NON-SYMBOLIC ACCESS 
          RJM    RRP         GET CATALOG BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    PMF14       IF INCORRECT POINTERS
          COMPARE  PBUN,,CWUN,BA,UNKL 
          ZJN    PMF1        IF NOT ALTERNATE USER
          MMOVE  PBUN,,PAUN,,UNKL 
          MMOVE  CWUN,BA,PBUN,,UNKL 
          LDM    PBTO+1      CHECK FOR EXTENSION
          SHN    21-5 
          PJN    PMF1        IF NOT EXTENSION 
          ERROR  FCI         *FILE CREATION INCORRECT*
  
 PMF1     SAVEP  CPCB        SAVE CATALOG BUFFERS 
          LDA    PBQN,ABS 
          ZJP    PMF7        IF QN NOT SPECIFIED
          LMM    CBQN+1,BP   COMPARE SEQUENCE NUMBER WITH CATALOG 
          STD    T0 
          SHN    -14
          LMM    CBQN,BP
          LPN    77 
          ADD    T0 
          NJP    PMF8        IF NOT CORRECT CATALOG 
 PMF2     LDM    PESN        SAVE VSN 
          STM    PMFA 
          LDN    0           CLEAR VSN (IN CASE CAA ERROR)
          STM    PESN 
          LDM    POFI 
          NJN    PMF3        IF FILE IDENTIFIER SPECIFIED 
          MMOVE  PMFC,,POFI,,FIKL 
 PMF3     RJM    CAA         CHECK ALTERNATE USER ACCESS
 PMF4     LDC    0           RESTORE VSN
*         LDC    (PESN) 
 PMFA     EQU    *-1
          STM    PESN 
          AOM    CBAC+1,BP   INCREMENT ACCESS COUNT 
          SHN    -14
          RAM    CBAC,BP
          LIA    CBAD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
          LDM    PFTD+1      CHECK FOR WRITE ACCESS 
          SHN    21-4 
          PJN    PMF5        IF NOT WRITE ACCESS
          LIA    CBMD,BP     MODIFICATION DATE
          RJM    EDT         ENTER PACKED DATE/TIME 
 PMF5     RJM    WRP         WRITE RANDOM PRU 
          COMPARE  PESN,,CBES,BP,VSKL 
          ZJN    PMF6        IF SAME VOLUME 
          LDM    UTMS+3      SET REWIND FILE FLAG 
          SCN    WURF 
          LMN    WURF 
          STM    UTMS+3 
 PMF6     UDTRD  CM,/MTX/UTCI,1 
          LDM    CPCB+2 
          SHN    6
          LMM    CPCB+3 
          STD    CM+1 
          LDM    CPCB+4 
          STD    CM+2 
          UDTWT  CM,/MTX/UTCI,1 
          LJM    PMFX        RETURN 
  
 PMF7     COMPARE  POFI,,CBPI,BP,FIKL 
          ZJP    PMF2        IF FILE FOUND
 PMF8     LDM    CBNC,BP     POSITION TO NEXT CATALOG 
          SHN    14 
          STD    CI 
          SHN    -14
          LMD    RI 
          SHN    14 
          LMM    CBNC+1,BP
          LMD    RI+1 
          ZJN    PMF9        IF SAME CATALOG BLOCK
          LDM    CBNC,BP     SAVE RANDOM INDEX
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBNC+1,BP
          STD    RI+1 
          ZJN    PMF10       IF END OF CATALOG BLOCKS 
          RJM    RRP         READ RANDOM PRU (CATALOG)
 PMF9     RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJP    PMF1        IF VALID POINTER 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 PMF10    LDM    PBTO+1      CHECK FOR EXTENSION
          SHN    21-5 
          PJP    PMFX        IF NOT APPENDING FILE
          LDM    CPCB+2      SAVE CATALOG POINTERS
          SHN    6
          LMM    CPCB+3 
          STD    CB 
          LDM    CPCB+4 
          STD    CB+1 
          RESTP  CPSI        RESTORE SECONDARY VSN POINTERS 
          LDC    PVSN 
          STD    KA 
 PMF11    LDM    UTMS+2 
          ZJN    PMF13       IF TAPE NOT WRITTEN ON 
          LDM    VBRC,BP     CHECK FOR LAST REEL
          SHN    -6 
          LMM    UTMS+2 
          NJN    PMF12       IF NOT LAST REEL 
          LDN    EOIV/1S12
          RAM    PMFB 
 PMF12    LDM    VBST,BP     SET *EOI* VOLUME 
          SCN    EOIV/1S12
          LMN    0           NOT *EOI* VOLUME 
*         LMN    EOIV/1S12   (*EOI* VOLUME) 
 PMFB     EQU    *-1
          STM    VBST,BP
 PMF13    LDM    VBST,BP
          LPN    EOIV/1S12
          NJN    PMF15       IF LAST VOLUME 
          LDM    VBNV,BP
          ZJP    PMF16       IF LAST VOLUME 
          MMOVE  VBNV,BP,,KA,VSKL 
          RJM    SFV         SEARCH FOR VOLUME
          ZJP    PMF11       IF VSN FOUND 
 PMF14    ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PMF15    COMPARE  PESN,,PVSN,,VSKL 
          ZJN    PMF16       IF SAME VOLUME 
          LDM    UTMS+3      SET REWIND FLAG
          SCN    WURF 
          LMN    WURF 
          STM    UTMS+3 
 PMF16    MMOVE  VBES,BP,PESN,,VSKL 
          MMOVE  VBVS,BP,,KA,VSKL 
          LDM    PBTO+1      FORCE SYMBOLIC ACCESS
          SCN    4
          LMN    4
          STM    PBTO+1 
          LDM    PBSN 
          SCN    77 
          STM    PBSN 
          LDN    1
          STM    PBSN+1 
          EXOVL  ECI         CREATE CATALOG ENTRY 
  
 PMFC     DATA   17HREQUESTED FILE
          TITLE  SUBROUTINES. 
 SFV      SPACE  4,10 
**        SFV - SEARCH FOR VSN
* 
*         ENTRY  (BA) = SECONDARY INDEX BLOCK.
*                (KA) = KEY ADDRESS.
* 
*         EXIT   (A) = 0 IF VSN FOUND.
* 
*         USES   BP.
* 
*         CALLS  SIB, VIS.
* 
*         MACROS SAVEP. 
  
  
 SFV1     SAVEP  CPSI        SAVE SECONDARY VSN INDEX POINTERS
          LDN    0           EXIT *VSN FOUND* 
  
 SFV      SUBR               ENTRY/EXIT 
          LDD    BA 
          ADN    2
          STD    BP 
          RJM    SIB         SEARCH INDEXED BUFFER (VSN)
          ZJN    SFV1        IF FOUND IN THIS BUFFER
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    SFV1        IF VSN FOUND 
          UJN    SFVX        RETURN 
          SPACE  4,10 
***       COMMON DECKS. 
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 CAA$     EQU    1           DEFINE CAA - CHECK ALTERNATE USER ACCESS 
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USER BLOCK 
  
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4,10 
          SPACE  4,10 
***       BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4,10 
          ERRNG  BUF2-* 
          TITLE  PRESET SUBROUTINES.
 CDB      SPACE  4,10 
**        CDB - CONVERT DECIMAL DISPLAY CODE TO BINARY. 
* 
*         ENTRY  (A) = ADDRESS OF STRING (BITS 0-11). 
*                    = CHARACTER COUNT (BITS 12-14).
*                    = HALF BYTE FLAG (BIT 15). 
* 
*         EXIT   (A) = CONVERTED VALUE. 
* 
*         USES   S2, S1 - S1+4. 
* 
*         MACROS ERROR. 
  
  
 CDB      SUBR               ENTRY/EXIT 
          STD    S2          ADDRESS OF STRING
          SHN    -14         COUNT AND HALF BYTE FLAG 
          STD    S1 
          SHN    -3          HALF BYTE FLAG 
          STD    S1+1 
          LDD    S1          CHARACTER COUNT
          LPN    7
          ADD    S1+1 
          STD    S1 
          LDD    S1+1        CHECK IF FIELD SPECIFIED 
          SHN    21-0 
          LMI    S2 
          MJN    CDB1        IF HALF BYTE 
          SHN    -6 
 CDB1     LPN    77 
          ZJN    CDBX        IF NOT SPECIFIED 
          LDN    0
          STD    S1+3        ACCUMULATOR (HIGH) 
          STD    S1+4        ACCUMULATOR (LOW)
 CDB2     LDD    S1+1 
          SHN    -1 
          ADD    S2 
          STD    T0 
          LDD    S1+1 
          LPN    1
          SHN    21-0 
          LMI    T0 
          MJN    CDB3        IF ODD BYTE
          SHN    -6 
 CDB3     LPN    77 
          SBN    1R0
          PJN    CDB5        IF POSSIBLE VALID DIGIT
 CDB4     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 CDB5     STD    T0 
          SBN    1R9-1R0+1
          PJN    CDB4        IF NOT VALID DIGIT 
          LDD    S1+3        CALCULATE 10D * ACCUMULATED RESULT 
          SHN    14 
          ADD    S1+4 
          SHN    2+6         TIMES 4
          ADD    S1+3        TIMES 5
          SHN    14 
          ADD    S1+4 
          SHN    1           TIMES 10D
          ADD    T0          ADD THIS DIGIT 
          STD    S1+4        STORE RESULT 
          SHN    -14
          STD    S1+3 
          AOD    S1+1 
          SBD    S1 
          NJP    CDB2        IF MORE TO CONVERT 
          LDD    S1+3 
          SHN    14 
          LMD    S1+4 
          LJM    CDBX        RETURN 
 ELA      SPACE  4,10 
**        ELA - EXTENDED LABELS ADDRESS PROCESSING. 
* 
*         ENTRY  (T6 - T7) = POSITION TO START AT IN BUFFER.
* 
*         EXIT   (A) = ABSOLUTE ADDRESS.
*                (A) = 0, END OF LABEL BUFFER.
  
  
 ELA2     LDN    0           INDICATE END OF BUFFER 
  
 ELA      SUBR               ENTRY/EXIT 
          LDA    CM+3,REL 
          ADN    11 
          CRD    S1 
          LDD    S1+3 
          SHN    14 
          STD    S1+1 
          SHN    -14
          STD    S1+3 
          SHN    14 
          LMD    S1+4 
          SBN    2
          MJN    ELA2        IF NO LABEL BUFFER 
          LDD    S1+2 
          SHN    6
          LMD    S1+1 
          STD    S1+2 
          SHN    -14
          STD    S1+1 
          LDD    T6 
          SBD    S1+1 
          SHN    14 
          ADD    T7 
          SBD    S1+2 
          ADN    11          ALLOW FOR LABEL
          PJP    ELA2        IF END OF LABEL BUFFER 
          LDD    S1+1        CHECK IF BUFFER WITHIN FL
          ADD    S1+3 
          SHN    14 
          ADD    S1+2 
          ADD    S1+4 
          SHN    -6 
          SBD    FL 
          MJN    ELA1        IF BUFFER WITHIN FL
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 ELA1     LDD    S1+3        CALCULATE LABEL ADDRESS
          ADD    T6 
          SHN    6
          ADD    RA 
          SHN    6
          ADD    S1+4 
          ADD    T7 
          LJM    ELAX        RETURN 
 PRS      SPACE  4,10 
**        PRS - PRESET FOR SUBFUNCTION PMFS.
* 
*         ENTRY  NONE 
* 
*         EXIT   (A) = 0 IF NOT A SYMBOLIC TAPE REQUEST.
* 
*         USES   BA, CI, KA, CM - CM+4, RI - RI+1.
* 
*         CALLS  RLF, SFV, VIS. 
* 
*         MACROS COMPARE, ERROR, MMOVE. 
  
  
 PRS3     LDN    0           NOT A SYMBOLIC TAPE REQUEST
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    RLF         READ LABELS FROM FET 
          LDC    PESN        FIND FIRST VOLUME
          STD    KA 
          RJM    VIS         VSN INDEX SEARCH 
          NJN    PRS3        IF NOT FOUND 
          LDC    PVSN 
          STD    KA 
          MMOVE  VBFV,BP,,KA,VSKL 
          COMPARE  PESN,,,KA,VSKL 
          ZJN    PRS1        IF FIRST VOLUME
          RJM    SFV         SEARCH FOR VOLUME
          ZJN    PRS1        IF VSN FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS1     LDM    VBCI,BP     GET CATALOG ENTRY
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDM    VBCI+1,BP
          STD    RI+1 
          LDC    BUF2 
          STD    BA 
          LDD    CP          CHECK FOR *POSMF* FROM *RESEX* 
          ADN    JCIW 
          CRD    CM 
          LDD    CM          CPU PRIORITY 
         LPC     177
          LMN    /PRD/RXCS
          NJN    PRS2        IF NOT RESEX CP PRIORITY 
          LDM    PRSA        SKIP PASSWORD CHECK
          STM    CAAB 
 PRS2     LJM    PRSX        RETURN 
  
 PRSA     BSS    0
          LOC    CAAB 
          UJN    CAA3        SKIP PASSWORD CHECK
          LOC    *O 
          SPACE  4
          ERRNG  BUF1-* 
 RLF      SPACE  4,10 
**        READ *HDR1* LABEL FROM USER-S FET.
* 
*         ENTRY  (UDTA) = UDT ADDRESS.
* 
*         EXIT   POFI UPDATED FROM USER-S FET.
*                PBSI UPDATED FROM USER-S FET.
*                PBQN UPDATED FROM USER-S FET.
* 
*         USES   T1, T5, T6, T7, CM - CM+4, S1 - S1+4, S2 - S2+4
* 
*         CALLS  CDB, ELA.
* 
*         MACROS ERROR, UDTRD.
  
  
 RLF      SUBR               ENTRY/EXIT 
          UDTRD  S1,/MTX/UCIB,1  FET OPTIONS
          UDTRD  CM,/MTX/UCIA,1  FET ADDRESS
          LDD    S1+1 
          SHN    21-5 
          PJP    RLF8        IF NOT EXTENDED LABELS 
          LDN    0
          STD    T6 
          STD    T7 
 RLF1     RJM    ELA         SEARCH FOR *HDR1* LABEL
          ZJN    RLF3        IF END OF LABEL BUFFER 
          CRD    S1 
          ADN    1
          CRD    S2 
          LDD    S1+4 
          ZJN    RLF3        IF END OF LABELS IN BUFFER 
          LMC    80D
          NJN    RLF3        IF NOT CORRECT LENGTH
          LDD    S2 
          LMC    2RHD 
          NJN    RLF2        IF NOT *HDR1* LABEL
          LDD    S2+1 
          LMC    2RR1 
          ZJN    RLF4        IF LABEL IS *HDR1* 
 RLF2     LDN    11          INCREMENT LABEL POINTER
          RAD    T7 
          SHN    -14
          RAD    T6 
          UJN    RLF1        CONTINUE SEARCH
  
 RLF3     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 RLF4     LDN    10          READ *HDR1* LABEL
          STD    T5 
          RJM    ELA         SEARCH FOR *HDR1* LABEL
          ADN    1           OFFSET RECORD LENGTH 
          CRM    BUF0,T5
          MMOVE  BUF0+2,,POFI,,FIKL 
          LDN    2           MOVE SET-ID WITH SHIFT 
          STD    T7 
 RLF5     LDM    BUF0+10D,T7 HIGH ORDER BYTE
          LPN    77 
          SHN    14 
          LMM    BUF0+11D,T7 LOW ORDER BYTE 
          SHN    14 
          STM    PBSI,T7
          SOD    T7 
          PJN    RLF5        IF MOVE NOT COMPLETE 
          LDM    PBQN        CLEAR PBQN 
          SCN    77 
          STM    PBQN 
          LDC    14S12+BUF0+15D 
          RJM    CDB         CONVERT DECIMAL TO BINARY
          STM    PBQN+1      SAVE FILE SEQUENCE NUMBER
          SHN    -14
          RAM    PBQN 
          LPN    77 
          SHN    14 
          ADM    PBQN+1 
          LMC    9999D
          NJN    RLF7        IF NOT EXTENSION 
          LDM    PBTO+1      SET *TO=A* 
          SCN    1S5
          LMN    1S5
          STM    PBTO+1 
 RLF7     LJM    RLFX        RETURN 
  
 RLF8     LDN    4
          STD    T1 
          LDA    CM+3,ABS 
          SBN    2
          PJN    RLF10       IF FET IN BOUNDS 
 RLF9     LJM    RLF3        BUFFER ARGUMENT ERROR
  
 RLF10    ADC    77+2+15
          SHN    -6 
          SBD    FL 
          PJN    RLF9        IF FET OUT OF BOUNDS 
          LDA    CM+3,REL 
          ADN    11 
          CRM    BUF0,T1
          MMOVE  BUF0,,POFI,,FIKL 
          MMOVE  BUF0+15,,PBSI,,6 
          LDM    PBQN 
          SCN    77 
          STM    PBQN 
          LDC    13S12+BUF0+8D
          RJM    CDB         CONVERT DECIMAL TO BINARY
          ADC    -999D
          NJN    RLF11       IF NOT *POSMF 9999*
          LDC    9000D
 RLF11    LJM    RLF5        STORE FILE SEQUENCE NUMBER 
          SPACE  4,10 
          ERRNG  BUF0-* 
          SPACE  4
          OVERLAY (VERIFY TAPE LABELS / UPDATE CATALOG ENTRY.),OVL1 
          SPACE  4,10 
***       DIRECT CELLS. 
  
  
 FV       EQU    S1 - S1+2   FIRST VOLUME 
 RC       EQU    S1+3        REEL COUNT 
 CN       EQU    S2 - S2+4   SCRATCH
 FE       EQU    CN+1 - CN+2 FINAL CATALOG ENTRY
 CB       EQU    CN+3 - CN+4 CURRENT CATALOG ENTRY
 VTL      SPACE  4,10 
***       VTL - VERIFY TAPE LABELS. 
* 
*         VTL COMPARES THE TAPE LABELS WITH THE CATALOG ENTRY TO ENSURE 
*         THAT THE TAPE HAD NOT BEEN MODIFIED IF IT HAD BEEN REMOVED
*         FROM THE CONTROL OF THE TAPE MANAGEMENT SYSTEM. 
* 
*         ENTRY  PARAMETER BLOCK SET UP BY GUO. 
* 
*         EXIT   CATALOG ENTRY VERIFIED.
* 
*         CALLS  FCE, MCE, VCE. 
  
  
 VTL      ENTRY              ENTRY/EXIT 
          RJM    FCE         FIND CATALOG ENTRY 
          ZJN    VTLX        IF CATALOG NOT FOUND 
          RJM    CPC         CHECK FOR PURGED CATALOGS
          LDM    CBSI,BP     CHECK FOR ORIGINAL TMS CATALOG ENTRY 
          ZJN    VTL1        IF SETID NOT SPECIFIED 
          LDM    CBLD+2,BP   CHECK RETENTION DATE 
          LPN    77 
          ZJN    VTL1        IF RETENTION DATE NOT SPECIFIED
          LDM    CBST,BP     CHECK FOR RECOVERED FILE 
          LPC    2000 
          ZJN    VTL2        IF NOT RECOVERED FILE
 VTL1     RJM    UCT         UPDATE CATALOG ENTRY FROM TAPE LABEL 
          UJN    VTLX        RETURN 
  
 VTL2     RJM    VCE         VERIFY CATALOG ENTRY 
          UJN    VTLX        RETURN 
 UCE      SPACE  4,10 
***       UCES - UPDATE CATALOG ENTRY SUBFUNCTION.
* 
*         UPDATE THE CATALOG ENTRY TO MATCH THE INFORMATION WRITTEN ON
*         THE TAPE. 
* 
*         ENTRY  PARAMETER BLOCK SET UP BY *GUO*. 
* 
*         EXIT   CATALOG ENTRY UPDATED. 
* 
*         CALLS  FCE, UCT.
  
  
 UCE      ENTRY              ENTRY/EXIT 
          RJM    FCE         FIND CATALOG ENTRY 
          ZJN    UCEX        IF NOT FOUND 
          RJM    UCT         UPDATE CATALOG ENTRY FROM TAPE LABEL 
          UJN    UCEX        RETURN 
          TITLE  SUBROUTINES. 
 CPC      SPACE  4,10 
**        CPC - CHECK TO PURGE CATALOGS.
* 
*         ENTRY  (UTMS+2) = TAPE WRITTEN ON.
*                (CI - RI+1) = CURRENT TAPE CATALOG.
*                (CB - CB+1) = *UTCI* CURRENT CATALOG.
* 
*         EXIT   TO *RDC* IF TAPE WRITTEN ON AND CURRENT CATALOG
*                POINTERS DO NOT MATCH. 
* 
*         CALLS  CPF. 
  
  
 CPC      SUBR               ENTRY/EXIT 
          LDM    UTMS+2 
          ZJN    CPCX        IF NOT WRITTEN ON
          LDD    CI          COMPARE CATALOG ENTRIES
          SHN    6
          LMD    RI          (A) = CURRENT TAPE CATALOG 
          LMD    CB 
          NJN    CPC1        IF NOT SAME CATALOG
          LDD    RI+1 
          LMD    CB+1 
          ZJN    CPCX        IF SAME CATALOG
 CPC1     LDM    UTMS+4      RE-ISSUE CURRENT REQUEST 
          SCN    RSRR 
          LMN    RSRR 
          STM    UTMS+4 
          EXOVL  PEC         PURGE EXCESS CATALOG ENTRIES 
 CTC      SPACE  4,10 
**        CTC - COMPLETE *MAGNET* *TFM* CALL. 
* 
*         ENTRY  NONE.
* 
*         EXIT   *TFM* REQUEST FLAG CLEARED, AND NORMAL COMPLETION
*                SET IN *UDT*.  EXIT IS TO *DPP*. 
* 
*         MACROS UDTWT. 
  
  
 CTC      ENTRY              ENTRY
          LDM    UTMS+4      CLEAR TFM REQUEST FLAG 
          SCN    RSIL 
          STM    UTMS+4 
          UDTWT  UTMS,/MTX/UTMS,1 
          LDN    ZERL        SET NORMAL COMPLETION
          CRD    CM 
          LDN    /MTX/NCP 
          STD    CM 
          UDTWT  CM,/MTX/UXRQ,1 
          LJM    DPP         EXIT PP
 FCE      SPACE  4,10 
**        FCE - FIND CATALOG ENTRY. 
* 
*         ENTRY  PARAMETER BLOCK SET UP BY *GUO*. 
* 
*         EXIT   (A) = 0 IF CATALOG ENTRY NOT FOUND.
*                (CB - CB+1) = CURRENT CATALOG ENTRY. 
*                (FE - FE+1) = *POSMF* CATALOG ENTRY. 
* 
*         USES   CI, KA, RC, CM - CM+4, CN - CN+4,
*                FV - FV+2, R1 - RI+1.
* 
*         CALLS  RRP, VIS, VSP. 
* 
*         MACROS COMPARE, ERROR, MMOVE, SAVEP, UDTRD. 
  
  
 FCE11    LDN    0           CATALOG ENTRY NOT FOUND
  
 FCE      SUBR               ENTRY/EXIT 
          LDC    PESN 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    FCE11       IF NOT FOUND 
          LDM    VBRC,BP
          SHN    -6 
          STD    RC 
          UDTRD  POFI,/MTX/UFID,2  READ FILE IDENTIFIER 
          UDTRD  CM,/MTX/USID,1  READ SEQUENCE NUMBER 
          LDM    PBQN 
          SCN    77 
          STM    PBQN 
          LDD    CM+3 
          LPN    77 
          RAM    PBQN 
          LDD    CM+4 
          STM    PBQN+1 
          UDTRD  PBCR,/MTX/UDAT,1  READ CREATION AND RETENTION DATES
          MMOVE  VBFV,BP,FV,,VSKL 
          COMPARE  PESN,,FV,,VSKL 
          ZJN    FCE1        IF FIRST VOLUME
          LDN    FV          READ FIRST VOLUME
          STD    KA 
          RJM    VIS         READ FIRST VOLUME
          NJN    FCE2        IF VSN NOT FOUND 
 FCE1     LDM    VBCI,BP     SEARCH FOR CATALOG ENTRY 
          NJN    FCE3        IF CATALOG ENTRY FOUND 
 FCE2     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 FCE3     SHN    14          SET POINTERS TO CATALOG
          STD    CI 
          SHN    -14
          STD    RI 
          LDM    VBCI+1,BP
          STD    RI+1 
          LDC    BUF2 
          STD    BA 
 FCE4     RJM    RRP         GET CATALOG BLOCK
 FCE5     RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    FCE2        IF INCORRECT POINTERS
          LDM    PBQN        CHECK FOR CURRENT CATALOG
          LMM    CBQN,BP
          LPN    77 
          NJN    FCE6        IF NOT CURRENT CATALOG 
          LDM    PBQN+1 
          LMM    CBQN+1,BP
          ZJN    FCE7        IF CURRENT CATALOG (TO FCE10)
 FCE6     LDA    CBQN,BP
          LMC    9999D
 FCE7     ZJN    FCE10       IF CATALOG CREATED BY *POSMF*
          LDM    CBNC,BP
          NJN    FCE8        IF NEXT CATALOG EXISTS 
          ERROR  MPE         *MULTI-FILE PROCESSING ERROR.* 
  
 FCE8     SHN    14          SET NEXT CATALOG POINTER 
          STD    CI 
          SHN    -14
          LMD    RI 
          NJN    FCE9        IF NOT IN CURRENT BLOCK
          LDM    CBNC+1,BP
          LMD    RI+1 
          ZJP    FCE5        IF CURRENT BLOCK 
 FCE9     LDM    CBNC,BP
          LPN    77 
          STD    RI 
          LDM    CBNC+1,BP
          STD    RI+1 
          LJM    FCE4        READ NEXT CATALOG ENTRY
  
 FCE10    UDTRD  CN,/MTX/UTCI,1  READ (FE - FE+1), (CB - CB+1)
          SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          LJM    FCEX        RETURN 
 SBS      SPACE  4,10 
**        SBS - SET BUSY STATUS.
* 
*         SET CATALOG BUSY ON THE CURRENT CATALOG ENTRY, AND CLEAR
*         CATALOG BUSY ON THE PREVIOUS CATALOG ENTRY. 
* 
*         ENTRY  (BA - RI+1) = CURRENT CATALOG ENTRY POINTERS.
*                (CB - CB+1) = LAST CATALOG ENTRY RANDOM INDEX. 
* 
*         EXIT   BUSY STATUS SET. 
*                CATALOG ENTRIES WRITTEN. 
* 
*         USES   CI, CB - CB+1, FE - FE+1, RI - RI+1. 
* 
*         CALLS  RRP, VSP, WRP. 
* 
*         MACROS ERROR, UDTWT.
  
  
 SBS      SUBR               ENTRY/EXIT 
          LDM    CBST,BP     SET BUSY STATUS
          SCN    1
          LMN    1
          STM    CBST,BP
          LDD    CB 
          LMD    RI 
          LPN    77 
          NJN    SBS1        IF DIFFERENT CATALOG BLOCKS
          LDD    CB+1 
          LMD    RI+1 
          NJN    SBS1        IF DIFFERENT CATALOG BLOCKS
          LDD    CB 
          SHN    -6 
          LMD    CI 
          ZJN    SBS4        IF SAME CATALOG ENTRY
          UJN    SBS2        CLEAR BUSY FLAG
  
 SBS1     RJM    WRP         WRITE RANDOM PRU (CATALOG) 
          LDD    CB+1 
          STM    RI+1 
          LDD    CB 
          LPN    77 
          STD    RI 
          RJM    RRP         GET INITIAL BLOCK (CATALOG)
 SBS2     LDD    CB 
          SHN    -6 
          STD    CI 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    SBS3        IF NO ERROR
          ERROR  MPE         *MULTI-FILE PROCESSING ERROR.* 
  
 SBS3     LDM    CBST,BP
          SCN    1
          STM    CBST,BP
 SBS4     RJM    WRP         WRITE RANDOM PRU 
          LDM    CPCB+2      SET NEW CATALOG INDEX
          SHN    6
          LMM    CPCB+3 
          STD    CB 
          LDM    CPCB+4 
          STD    CB+1 
          LDD    FE 
          LMD    CB 
          NJN    SBS5        IF *POSMF* NOT COMPLETE
          LDD    FE+1 
          LMD    CB+1 
          NJN    SBS5        IF *POSMF* NOT COMPLETE
          STD    FE 
          STD    FE+1 
 SBS5     UDTWT  CN,/MTX/UTCI,1  UPDATE CATALOG INDICIES IN UDT 
          LJM    SBSX        RETURN 
 UCT      SPACE  4,10 
**        UCT - UPDATE CATALOG ENTRY FROM TAPE LABEL. 
* 
*         ENTRY  (BA - RI+1) = CATALOG ENTRY POINTERS.
* 
*         EXIT   CATALOG UPDATED. 
* 
*         CALLS  SBS. 
* 
*         MACROS CMOVE, COMPARE, ERROR, RESTP.
  
  
 UCT      SUBR               ENTRY/EXIT 
          LDN    0           CLEAR DIFFERENCES CELL FOR *CMOVE* 
          STD    T3 
          LDM    UTMS+3      CHECK FOR FIRST *HDR1* OF VOLUME 
          LPC    WUFL 
          ZJN    UCT1        IF NOT FIRST LABEL OF VOLUME 
          LMM    UTMS+3      CLEAR FIRST *HDR1* FLAG
          STM    UTMS+3 
          LJM    UCT2        UPDATE CATALOG 
  
 UCT1     LDM    CBSN,BP     SET SEQUENCE NUMBER
          SCN    77 
          STM    CBSN,BP
          LDM    PBSN 
          LPN    77 
          RAM    CBSN,BP
          LDM    PBSN+1 
          STM    CBSN+1,BP
          CMOVE  PESN,,CBES,BP,VSKL/2  COMPARE/SET EXTERNAL VSN 
          CMOVE  PVSN,,CBVS,BP,VSKL/2  COMPARE/SET INTERNAL VSN 
 UCT2     CMOVE  POFI,,CBPI,BP,2*10D   COMPARE/SET FILE ID, SEQ. NUMBER 
          CMOVE  PFTD,,CBTD,BP,5       COMPARE/SET TAPE CHARACTERISTICS 
*         LDD    T3          CHECK TOTAL COMPARE MISMATCHES 
          ZJN    UCT3        IF NO CHANGE DETECTED
          LDM    CBST,BP     SET *ISSUE RECOVERY MESSAGE* FLAG
          LPC    7377 
          LMC    400
          STM    CBST,BP
 UCT3     LDM    CBFA,BP
          LPN    77 
          STM    CBFA,BP
          LDM    PBFA 
          SCN    77 
          RAM    CBFA,BP
          LDM    UTMS        CHECK FUNCTION 
          LMN    UCES 
          NJP    UCT5        IF NOT UPDATE CATALOG
          LIA    CBES,BP     FIND FIRST VSN 
          STD    KA 
          COMPARE  PESN,,,KA,VSKL 
          ZJN    UCT4        IF FIRST VSN 
          RJM    VIS
          NJN    UCT6        IF VSN NOT FOUND 
          LDM    VBRC,BP     CALCULATE REEL COUNT 
          SHN    -6 
          STD    T0 
          LDD    RC 
          SBD    T0 
 UCT4     ADN    1           FIRST REEL 
          STD    RC 
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
          LDD    RC 
          STM    CBRC,BP
 UCT5     RJM    SBS         SET CATALOG BUSY STATUS
          LJM    UCTX        RETURN 
  
 UCT6     ERROR  ECD         *ERROR IN CATALOG DATA.* 
 VCE      SPACE  4,10 
**        VCE - VERIFY CATALOG ENTRY. 
* 
*         ENTRY  PARAMETER BLOCK SET UP.
*                (BA) = CATALOG BUFFER POINTER. 
*                (BP) = CATALOG ENTRY POINTER.
* 
*         EXIT   CATALOG ENTRY VERIFIED.
* 
*         USES   KA.
* 
*         CALLS  VIS, WRP.
* 
*         MACROS COMPARE, ERROR.
  
  
 VCE      SUBR               ENTRY/EXIT 
          LDM    UTMS+3      CHECK FOR FIRST *HDR1* ON VOLUME 
          LPC    WUFL 
          ZJP    VCE3        IF NOT FIRST LABEL OF VOLUME 
          LMM    UTMS+3      CLEAR FIRST LABEL FLAG 
          STM    UTMS+3 
          LIA    CBES,BP     DETERMINE CORRECT SECTION NUMBER 
          STD    KA 
          LDI    KA 
          NJN    VCE2        IF EXTERNAL VSN FOUND
 VCE1     ERROR  ECD         ERROR IN CATALOG DATA
  
 VCE2     RJM    VIS         VSN INDEXED SEARCH 
          NJN    VCE1        IF VSN NOT FOUND 
          LDM    VBRC,BP     GET REEL COUNT FROM FIRST VOLUME OF FILE 
          SHN    -6 
          STD    T0 
          LDM    PBSN        ADJUST SECTION NUMBER
          LPN    7
          SHN    14 
          ADM    PBSN+1 
          SBD    RC          CURRENT REEL 
          ADD    T0          FIRST REEL 
          STM    PBSN+1 
          SHN    -14
          LPN    7
          STD    T0 
          LDM    PBSN 
          SCN    7
          LMD    T0 
          STM    PBSN 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          UJN    VCE4        COMPARE SECTION NUMBERS
  
 VCE3     COMPARE  PESN,,CBES,BP,VSKL 
          NJN    VCE5        IF NO MATCH
          COMPARE  PVSN,,CBVS,BP,VSKL 
          NJN    VCE7        IF NO MATCH
 VCE4     LDM    PBSN        COMPARE FILE SECTION NUMBERS 
          LMM    CBSN,BP
          LPN    7
 VCE5     NJN    VCE7        IF NO MATCH
          LDM    PBSN+1 
          LMM    CBSN+1,BP
          NJN    VCE7        IF NO MATCH
 VCE6     COMPARE  POFI,,CBPI,BP,4*10D
          ZJN    VCE8        IF CATALOG DATA MATCHES PHYSICAL DATA
 VCE7     LDM    CBST,BP     SET CATALOG ERROR
          SCN    2
          LMN    2
          STM    CBST,BP
          RJM    WRP         WRITE RANDOM PRU 
          ERROR  MPE         *MULTI-FILE PROCESSING ERROR.* 
  
 VCE8     RJM    SBS         SET BUSY STATUS
          LJM    VCEX        RETURN 
          SPACE  4,10 
***       COMMON DECKS
  
  
 BSE$     EQU    1           DEFINE BSE - BACK SPACE ONE ENTRY
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS LINK 
 ISK$     EQU    1           DEFINE ISK - INDEX SEARCH FOR KEY
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SIB$     EQU    1           DEFINE SIB - SEARCH IN BLOCK 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
  
*CALL     COMPTFM 
          SPACE  4,10 
***       BUFFERS.
          SPACE  4,10 
          ERRNG  BUF2-* 
          OVERLAY (ENTER CATALOG IMAGE.),OVL1 
          SPACE  4,10 
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 CN       EQU    S1 - S1+4   SCRATCH (5 LOCATIONS)
 CB       EQU    /PMF/CB     CATALOG BUFFER POINTER 
 ECIS     SPACE  4,10 
**        ECIS - ENTER CATALOG IMAGE. 
* 
*         *ECIS* IS A INTERNAL FUNCTION USED TO 
*         CREATE THE TAPE CATALOG AND THE USERNAME
*         INDEX (IF REQUIRED).
* 
*         ENTRY  NONE.
* 
*         EXIT   (CPCB - CPCB+4) = CATALOG POINTERS.
*                USERNAME INDEX CREATED IF REQUIRED.
*                CATALOG IMAGE CREATED. 
* 
*         USES   BA, CI, CM - CM+4, KA, PB, RI - RI+1,
*                T1.
* 
*         CALLS  ABC, ASR, CAC, CCT, CFM, EDT, IBC, PRS, RRP, SSP, WRP. 
* 
*         MACROS CLEAR, ERROR, EXOVL, LIA, LDA, MMOVE,
*                RESTP, SAVEP.
  
  
 ECI      ENTRY              ENTRY/EXIT 
          LDC    PBUN 
          STD    KA 
          RJM    UIS         USERNAME INDEXED SEARCH
          ZJP    ECI2        IF USERNAME FOUND
          LDC    BUFA 
 ECI1     STD    PB          CREATE/UPDATE USERNAME INDEX 
          LDC    BUF2 
          STD    BA 
          RJM    IBC         INITIALIZE BLOCK CHAIN 
          SAVEP  CPCB        SAVE CATALOG POINTERS
          RESTP  CPSI        RESTORE INDEX POINTERS 
          LDM    CPCB+3 
          STM    UBCI,PB
          LDM    CPCB+4 
          STM    UBCI+1,PB
          MMOVE  ,KA,,PB,UNKL 
          RJM    CIE         CREATE INDEXED ENTRY 
 ECIA     EQU    *-1         (RJM TO *WRP* IF UPDATE) 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          LJM    ECI7        ENTER CATALOG IMAGE
  
 ECI2     LDM    UBCI,BP     SET FIRST CATALOG BLOCK
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    UBCI+1,BP
          STD    RI+1 
          NJN    ECI3        IF CATALOG INDEX 
          LDC    WRP
          STM    ECIA 
          LDD    BP 
          LJM    ECI1        UPDATE USERNAME INDEX
  
 ECI3     LDM    PBTO+1      CHECK ACCESS TYPE
          LPN    4
          ZJN    ECI4        IF NOT SYMBOLIC ACCESS 
          LDC    POFI 
 ECI4     STD    KA          SET SEARCH TYPE
          LDC    BUF2        SET CATALOG BUFFER 
          STD    BA 
          RJM    SCB         SEARCH CATALOG BUFFER
          ZJN    ECI5        IF FILE NOT FOUND
          ERROR  FAR         *(FILENAME) ALREADY RESERVED.* 
  
 ECI5     LDM    CPHP        CHECK IF HOLE FOUND
          ZJN    ECI6        IF HOLE NOT FOUND
          RESTP  CPHP        RESTORE HOLE POINTERS
          RJM    RRP         READ RANDOM PRU
          UJN    ECI8        CREATE CATALOG IMAGE 
  
 ECI6     LDC    BUF2        DEFINE CATALOG BUFFER
          STD    BA 
          LDN    CWRI        EXTEND CATALOG FILE
          RJM    ABC         ADD BLOCK TO CHAIN 
 ECI7     LDC    RTCB*100    SET RECORD TYPE/LEVEL
          STM    CWRT,BA
          LDN    TCEL 
          STM    CWEL,BA
          MMOVE  PBUN,,CWUN,BA,UNKL 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDN    1
          STD    CI 
 ECI8     SAVEP  CPCB        SAVE CATALOG POINTERS
          LDM    CWUW,BA     CREATE CATALOG IMAGE 
          SBN    TCEL 
          STM    CWUW,BA
          AOM    CWNE,BA
          RJM    DCE         BUILD DEFAULT CATALOG ENTRY
          RJM    CAC         CHANGE ALTERNATE CATALOG LIST ATTRIBUTE
          RJM    CCT         CHANGE FILE CATEGORY 
          RJM    CFM         CHANGE FILE MODE 
          RJM    WRP         WRITE RANDOM PRU 
          LDM    UDTA 
          NJP    ECI9        IF MULTI-FILE
          LDN    ZERL        UPDATE FET 
          CRD    CM 
          LDD    CI 
          LPN    77 
          SHN    6
          LMD    RI 
          STD    CM+3 
          LDD    RI+1 
          STD    CM+4 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWM    CM,ON
          CWM    PESN,TR
          CWM    POFI,TR
          CLEAR  PVES,,TSVL*10D 
          LDM    CBTD,BP     DETERMINE TAPE TYPE
          SHN    -7 
          LPN    3
          RJM    SSP         SET SCRATCH POOL ADDRESS 
          EXOVL  ASR         ASSIGN SCRATCH VOLUME (NO RETURN)
  
 ECI9     LDD    CB          GET ASSIGNED CATALOG 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CB+1 
          ZJP    ECIX        IF NOT ASSIGNED
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    RRP         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          UDTRD  CN,/MTX/UTCI,1 
          LDM    CPCB+2      SET MULTI-FILE LINKAGE 
          SHN    6
          LMM    CPCB+3 
          STD    CN+1 
          STM    CBNC,BP
          LDM    CPCB+4 
          STD    CN+2 
          STM    CBNC+1,BP
          RJM    WRP         WRITE RANDOM PRU (CATALOG) 
          UDTWT  CN,/MTX/UTCI,1 
          LJM    ECIX        RETURN 
          TITLE  SUBROUTINES. 
 CAC      SPACE  4,10 
**        CAC - CHANGE ALTERNATE CATALOG LIST ATTRIBUTE 
* 
*         ENTRY  (PPWD+3) = ALTERNATE LIST ATTRIBUTE. 
* 
*         EXIT   LIST ATTRIBUTE CHANGED AS REQUIRED.
* 
*         USES   T1.
  
  
 CAC1     LDM    CBST,BP     CHANGE CATALOG LIST ATTRIBUTE
          SHN    0-13+22
          SCN    1
          LMD    T1 
          LMN    1
          SHN    13-0 
          STM    CBST,BP
  
 CAC      SUBR               ENTRY/EXIT 
          LDM    PBAC 
          LPN    77 
          ZJN    CACX        IF ATTRIBUTE NOT SPECIFIED 
          SBN    FAYS 
          STD    T1 
          SBN    FANO 
          MJN    CAC1        IF VALID ATTRIBUTE 
          UJN    CACX        RETURN 
 CCT      SPACE  4,10 
**        CCT - CHANGE CATEGORY TYPE. 
* 
*         ENTRY  (PBCT) = FILE CATEGORY.
* 
*         EXIT   FILE CATEGORY CHANGED AS REQUIRED. 
* 
*         USES   T1.
  
  
 CCT1     LDM    CBCT,BP     CHANGE FILE CATEGORY 
          LPN    77 
          LMD    T1 
          STM    CBCT,BP
  
 CCT      SUBR               ENTRY/EXIT 
          LDM    PBCT 
          SCN    77 
          ZJN    CCTX        IF CATEGORY NOT SPECIFIED
          STD    T1 
          SHN    -6 
          SBN    FCMX 
          MJN    CCT1        IF VALID CATEGORY TYPE 
          UJN    CCTX        RETURN 
 CFM      SPACE  4,10 
**        CFM - CHANGE FILE MODE. 
* 
*         ENTRY  (PBMD) = FILE ASSESS MODE. 
* 
*         EXIT   FILE MODE CHANGED AS REQUIRED. 
* 
*         USES   T1.
  
  
 CFM1     LDM    CBCT,BP     CHANGE FILE MODE 
          SCN    77 
          LMD    T1 
          STM    CBCT,BP
  
 CFM      SUBR               ENTRY/EXIT 
          LDM    PBMD 
          LPN    77 
          ZJN    CFMX        IF MODE NOT SPECIFIED
          STD    T1 
          SBN    FMMX 
          MJN    CFM1        IF VALID FILE MODE 
          UJN    CFMX        RETURN 
 DCE      SPACE  4,10 
**        DCE - BUILD DEFAULT CATALOG IMAGE.
* 
*         ENTRY  (BA) = BUFFER ADDRESS (CATALOG). 
*                (BP) = BUFFER POINTER (CATALOG). 
*                (UDTA) NON-ZERO IF MULTI-FILE. 
* 
*         EXIT   CATALOG ENTRY BUILT FROM THE FET 
*                PARAMETERS AND UDT IF MULTI-FILE.
* 
*         USES   CM - CM+4. 
* 
*         CALLS  EDT. 
* 
*         MACROS CLEAR, LDA, LIA, MMOVE, UDTRD, ZJM.
  
  
 DCE      SUBR               ENTRY/EXIT 
          CLEAR  ,BP,TCEL*10D 
          MMOVE  POFI,,CBLI,BP,FIKL 
          LDC    1401        SET CATALOG STATUS FLAGS 
          STM    CBST,BP
          LDM    PBTO+1      SET SYMBOLIC ACCESS IF REQUIRED
          LPN    4
          RAM    CBST,BP
          LDM    PFTD 
          SHN    21-12
          MJN    DCE1        IF LABEL TAPE FILE 
          CLEAR  POFI,,FIKL 
 DCE1     LDM    PBQN        CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LPN    77 
          ADM    PBQN+1 
          NJN    DCE2        IF SPECIFIED 
          LDN    1
          STM    PBQN+1 
          LDM    PBTO 
          SHN    21-2 
          PJN    DCE2        IF NOT SYMBOLIC ACCESS 
          LDC    9999D       SET MULTI-FILE EXTENSION 
          STM    PBQN+1 
          SHN    -14
          RAM    PBQN 
 DCE2     LDM    PBGN        SET GENERATION NUMBER
          LPN    7
          ADM    PBGN+1 
          NJN    DCE3        IF SPECIFIED 
          LDN    1
          STM    PBGN+1 
 DCE3     MMOVE  PBUF,,CBES,BP,6*10D
          LDN    0
          STM    CBTD+1,BP
          MMOVE  PBCR+2,,CBLD+2,BP,6  SET RETENTION DATE
          LDN    JDAL        GET CREATION DATE
          CRD    CM 
          LDD    CM+2        SET CREATION DATE
          SHN    6
          STM    CBLD+0,BP
          LDD    CM+3 
          SHN    -6 
          RAM    CBLD+0,BP
          LDD    CM+3 
          SHN    6
          STM    CBLD+1,BP
          LDD    CM+4 
          SHN    -6 
          RAM    CBLD+1,BP
          LDM    CBLD+2,BP
          LPN    77 
          SHN    14 
          ADD    CM+4 
          SHN    6
          STM    CBLD+2,BP
          MMOVE  PPWD,,CBPW,BP,10D
          LDC    FCPR*100+FMRE  FILE CATEGORY AND MODE DEFAULTS 
          STM    CBCT,BP
          LIA    CBCD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
          LIA    CBMD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
          LIA    CBAD,BP
          RJM    EDT         ENTER PACKED DATE/TIME 
          LDN    1
          STM    CBAC+1,BP   INITIALIZE ACCESS COUNT
          LDM    UDTA 
          ZJP    DCE4        IF NOT MULTI-FILE
          LDN    1           INITIALIZE REEL COUNT
          STM    CBRC,BP
 DCE4     LDN    2
          STD    T1 
          LIA    CBCN,BP
          STM    DCEB 
          LIA    CBPN,BP
          STM    DCEC 
          NFA    CHGN 
          CRM    **,ON
 DCEB     EQU    *-1
          NFA    PJ1N 
          CRM    **,T1
 DCEC     EQU    *-1
          LDM    PFTD+1      INSURE PO=W
          SCN    30 
          LMN    20 
          STM    PFTD+1 
          LDM    PFTD 
          SHN    21-12
          PJN    DCE5        IF UNLABELED FILE
          SCN    1           INSURE WRITE LABEL SET 
          LMN    1
          SHN    13-0 
          STM    PFTD 
 DCE5     LDM    CBST,BP
          SHN    21-2 
          MJN    DCE6        IF SYMBOLIC ACCESS 
          LDM    CBQN,BP     SET SEQUENCE NUMBER TO 1 
          SCN    77 
          STM    CBQN,BP
          LDN    1
          STM    CBQN+1,BP
 DCE6     LJM    DCEX        RETURN 
          SPACE  4,10 
**        LOCAL COMMON DECKS. 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 CIE$     EQU    1           DEFINE CIE - CREATE INDEXED ENTRY
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 SCB$     EQU    1           DEFINE SCB - SEARCH CATALOG BUFFER 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 SSP$     EQU    1           DEFINE SSP - SET SCRATCH POOL ADDRESS
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEXED SEARCH 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
**        BUFFERS.
  
  
 BUFA     BSS    TSVL*5 
 BUFB     BSS    TSVL*5 
          SPACE  4,10 
          ERRNG  BUF2-*      BYTES LEFT BEFORE OVERFLOW 
          OVERLAY (ASSIGN SCRATCH TAPE.),OVL1 
          SPACE  4,10 
***       COMMON SYMBOL DEFINITIONS.
  
  
          QUAL   RSX
*CALL     COMSRSX 
          QUAL   *
  
 .RJID    EQU    /RSX/RJID*5
          ERRPL  /RSX/RJID-100  MUST BE IN 1ST PRU OF DEMAND FILE ENTRY 
  
 .RREQ    EQU    /RSX/RREQ*5-500
          ERRNG  /RSX/RREQ-100  MUST BE IN 2ND PRU OF DEMAND FILE ENTRY 
  
 .RQPV    EQU    /RSX/RQPV*5-500
          ERRNG  /RSX/RQPV-100  MUST BE IN 2ND PRU OF DEMAND FILE ENTRY 
          SPACE  4,10 
***       DIRECT CELL LOCATIONS.
  
  
 CN       EQU    S1 - S1+4
 DE       EQU    S1+1        DEMAND FILE EQUIPMENT
 DT       EQU    S1+2        DEMAND FILE TRACK
 DS       EQU    S1+3        DEMAND FILE SECTOR 
 IL       EQU    S2+1        INTERLOCK FLAG 
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 ASRS     SPACE  4,10 
**        ASRS - ASSIGN SCRATCH REEL. 
* 
*         ENTRY  (CPCB - CPCB+4) = CATALOG POINTERS.
*                (CPAB - CPAB+4) = PREVIOUS VSN INDEX.
*                (SCRP) = ADDRESS IN *TMST* OF CORRECT SCRATCH POOL.
* 
*         EXIT   SCRATCH TAPE ASSIGNED TO THE JOB.
* 
*         USES   BA, EC, KA, PB, T3, CM - CM+4, FP - FP+4, RI - RI+1. 
* 
*         CALLS  ARF, CIE, DEE, DLB, EDT, ERR, MBP, RRP, SAC, VIS, WRP. 
* 
*         MACROS LDA, MMOVE, RESTP, SAVEP, UDTRD, UDTWT.
  
  
 ASR      ENTRY              ENTRY/EXIT 
          LDM    SCRP        SET SCRATCH POOL ADDRESS 
          STM    ASRB 
 ASR1     RESTP  CPSB        RESTORE TMST BUFFER POINTERS 
          LDM    CPCB        DEFINE TMST BUFFER = CATALOG BUFFER
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK (TMST) 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          SAVEP  CPSB        SAVE BUFFER POINTERS (TMST)
          LDM    SBSM,BP     CHECK SCRATCH POOL 
 ASRB     EQU    *-1         (ADDRESS IN *TMST* OF CORRECT SCRATCH POOL)
          LMC    7777 
          NJN    ASR4        IF SCRATCH AVAILABLE 
          LDM    SBST,BP
          LPN    FFTS/10000 
          NJN    ASR2        IF FOREIGN FAMILY
          EXOVL  GSP         SEARCH GLOBAL SCRATCH POOLS (NO RETURN)
  
 ASR2     ERROR  WSA         *WAIT SCRATCH ASSIGNMENT.* 
  
 ASR3     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 ASR4     LDC    PVNV        LOCATE SCRATCH 
          STD    KA 
          LDM    SCRP        GET ADDRESS OF CORRECT SCRATCH POOL
          ADD    BP 
          STD    T1 
          MMOVE  ,,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    ASR3        IF NOT FOUND 
          LDM    VBST,BP
          LPN    ASVS/10000 
          ZJN    ASR3        IF SCRATCH NOT FOUND 
          LDM    VBST,BP
          LPN    RTVS/10000 
          NJN    ASR3        IF TAPE RESERVED 
          LDM    VBST,BP
          LPN    HMVS/10000+UOVS/10000
          STM    ASRA 
          NJN    ASR5        IF NOT AVAILABLE 
          LDM    VBST+1,BP
          LPN    TVVS+MVVS+ERVS+VIVS
          STM    ASRA 
 ASR5     RESTP  CPSB        RESTORE TMST BUFFER POINTERS 
          LDM    SCRP        GET ADDRESS OF CORRECT SCRATCH POOL WORD 
          ADD    BP 
          STD    T3 
          MMOVE  VBNV,CPSI+1,,T3,VSKL  SET NEW VSN IN SCRATCH POOL WORD 
          LDA    3,T3        DECREMENT SCRATCH COUNT
          SBN    1
          STM    4,T3 
          SHN    -14
          STM    3,T3 
          RJM    WRP         WRITE RANDOM PRU (TMST)
          LDC    0
 ASRA     EQU    *-1
          ZJN    ASR7        IF THIS SCRATCH VSN ACCEPTABLE 
          RESTP  CPSI        RESTORE SECONDARY VSN POINTERS 
          LDM    VBST+1,BP
          LPN    VIVS 
          NJN    ASR6        IF VSN INTERLOCKED 
          CLEAR  VBNV,BP,VSKL  CLEAR NEXT VOLUME
          RJM    WRP
 ASR6     LJM    ASR1        GET NEXT SCRATCH TAPE
  
 ASR7     EXSUB  CSA         COMPLETE SCRATCH ASSIGNMENT
          LJM    ASRX        RETURN 
 AVSS     SPACE  4,10 
**        AVSS - ADVANCE VSN FILE.
* 
*         CALLED BY *MAGNET* TO SET THE NEXT VOLUME OF TAPE IN THE UDT. 
* 
*         EXIT   IF THERE IS A NEXT VOLUME, IT IS RETURNED. 
*                IF THERE IS NOT A NEXT VOLUME AND THIS IS A WRITE
*                   REQUEST, A SCRATCH VOLUME WILL BE ASSIGNED. 
* 
*         USES   BA, CI, CM - CM+4, KA, RI - RI+1.
* 
*         CALLS  ASR, PRS, SSP, VIS, VSP, WRP.
* 
*         MACROS ERROR, EXOVL, MMOVE, UDTRD, UDTWT. 
  
  
 AVS      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          ZJN    AVSX        IF NO CATALOG ENTRY
          RJM    RRP         GET CATALOG
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    AVSX        IF ERROR 
          SAVEP  CPCB 
          RESTP  CPSI        RESTORE VSN SECONDARY INDEX POINTERS 
          LDM    UTMS+3 
          LPN    WURF 
          NJP    AVS6        IF REWIND FILE 
          LDM    VBRC,BP     CHECK FOR LAST VOLUME
          SHN    -6 
          LMM    UTMS+2 
          NJN    AVS1        IF NOT LAST VOLUME 
          LDM    VBST,BP     CLEAR EOI VOLUME STATUS
          SCN    EOIV/1S12
          STM    VBST,BP
 AVS1     RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          MMOVE  VBNV,BP,,KA,VSKL 
          LDI    KA 
          ZJN    AVS4        IF END OF ASSIGNED VOLUMES 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    AVS3        IF VOLUME NOT FOUND
          LDM    VBRC,BP     CHECK FOR LAST VOLUME
          SHN    -6 
          STD    T0 
          LDM    UTMS+2 
          ZJN    AVS2        IF NOT WRITTEN TO
          SBD    T0 
          SBN    1
          NJN    AVS2        IF NOT LAST VOLUME 
          LDM    VBST,BP     SET EOI VOLUME STATUS
          SCN    EOIV/1S12
          LMN    EOIV/1S12
          STM    VBST,BP
 AVS2     RJM    IUC         INCREASE USAGE COUNTER 
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          LJM    AVS7        UPDATE UDT 
  
 AVS3     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 AVS4     LDM    UTMS+4      CHECK VOLUME EXTENSION 
          SHN    21-12
          MJP    AVS5        IF USER OWNED FILE 
          SAVEP  CPAB        SAVE BUFFER POINTERS (VSN INDEX) 
          MMOVE  VBFV,BP,PVFV,,VSKL 
          LDM    VBRC,BP
          SCN    77 
          STD    T0 
          LDM    PVRC 
          LPN    77 
          LMD    T0 
          STM    PVRC        SAVE REEL COUNT
          LDM    VBST+1,BP   DETERMINE TAPE TYPE
          SHN    -5 
          LPN    3
          RJM    SSP         SET SCRATCH POOL ADDRESS 
          EXSUB  ASR         ASSIGN SCRATCH REEL
          LJM    AVSX        RETURN 
  
 AVS5     ERROR  NEU         *NO EXTEND ON USER OWNED FILE.*
  
 AVS6     LMM    UTMS+3      CLEAR REWIND FLAG
          STM    UTMS+3 
          COMPARE CBES,CPCB+1,VBES,BP,VSKL
          ZJP    AVSX        IF REWIND CURRENT VOLUME 
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          LDC    PVES 
          STD    KA 
          MMOVE  CBES,CPCB+1,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          NJP    AVS3        IF VSN NOT FOUND 
          RJM    IUC         INCREASE USAGE COUNTER 
 AVS7     MMOVE  VBES,BP,,KA,VSKL 
          UDTRD  CM,/MTX/UESN,1 
          MMOVE  PVES,,CM,,VSKL  SET EXTERNAL VSN 
          UDTWT  CM,/MTX/UESN,1 
          UDTRD  CM,/MTX/UISN,1 
          MMOVE  VBVS,BP,CM,,VSKL  SET INTERNAL VSN 
          UDTWT  CM,/MTX/UISN,1 
          UDTRD  CM,/MTX/UVRI,1 
          LDM    VBRC,BP     SET REEL NUMBER
          SHN    -6 
          SBN    1
          STD    CM+3 
          UDTWT  CM,/MTX/UVRI,1 
          LJM    AVSX        RETURN 
 CSAS     SPACE  4,10 
**        CSAS - COMPLETE SCRATCH ASSIGNMENT. 
* 
*         ENTRY  (CPSI - CPSI+1) = VSN INDEX POINTERS.
*                (CPCB - CPCB+4) = CATALOG POINTERS.
* 
*         USES   CM - CM+4, KA, PB, T3. 
* 
*         CALLS  COB, CVS, RBB, RRP, SBP, SVB, WRP. 
* 
*         MACROS CLEAR, MMOVE, RESTP, UDTRD, UDTWT. 
  
  
 CSA      ENTRY              ENTRY/EXIT 
          RESTP  CPSI        RESTORE BUFFER POINTERS (VSN INDEX)
          MMOVE  VBES,BP,PVES,,VSKL 
          MMOVE  VBVS,BP,PVVS,,VSKL 
          MMOVE  VBES,BP,VBVS,BP,VSKL 
          MMOVE  PVES,,VBFV,BP,VSKL 
          CLEAR  VBNV,BP,VSKL 
          LDM    CPCB+2      SET CATALOG INDEX
          LPN    77 
          SHN    6
          LMM    CPCB+3 
          STM    VBCI,BP
          LDM    CPCB+4 
          STM    VBCI+1,BP
          RJM    SVB         SET VSN BUSY 
          LDM    VBST,BP     SET EOI VOLUME STATUS
          SCN    EOIV/1S12
          LMN    EOIV/1S12
          STM    VBST,BP
          LDC    100         INCREMENT REEL COUNT 
          RAM    PVRC 
          SCN    77 
          RAM    VBRC,BP
          SHN    -6 
          SBN    1
          ZJN    CSA1        IF FIRST VOLUME OF SET 
          MMOVE  PVFV,,VBFV,BP,VSKL 
 CSA1     LDD    FC 
          LMN    SSJF 
          NJP    CSA2        IF NOT CALLED BY TFSP
          LDA    IR+3,REL 
          RJM    SBP         SET BUFFER POINTERS
          RJM    COB         CHECK OUTPUT BUFFER
          LDN    TSVL 
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
          MMOVE  VBJS,PB,VBJS,BP,2  SET *EJTO*
 CSA2     RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPAB        RESTORE BUFFER POINTERS (VSN INDEX)
          LDD    BA 
          ZJN    CSA3        IF NOT FIRST REEL
          RJM    RRP         READ RANDOM PRU (VSN INDEX)
          MMOVE  PVES,,VBNV,BP,VSKL 
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
 CSA3     RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
          RJM    RRP         READ RANDOM PRU
          LDD    FC 
          LMN    RSXF 
          ZJN    CSA4        IF CALLED BY RESEX 
          LMN    SSJF&RSXF
          NJP    CSA5        IF NOT CALLED BY TFSP
          RJM    CVS         COMPLETE VSN SWITCH
          LJM    CSA7        RETURN 
  
 CSA4     MMOVE  PVES,,CBES,BP,VSKL 
          MMOVE  PVES,,CBVS,BP,VSKL 
          LDM    PVRC 
          SHN    -6 
          STM    CBSN+1,BP
          SBN    1
          STM    PVES+4      SET REEL NUMBER TO BE PASSED TO *MAGNET* 
          LDA    IR+3,REL    RESTORE *FA* AND *SN*
          ADN    TFVS 
          CRD    CM 
          LDD    CM+3 
          STM    PVVS+3 
          LDD    CM+4 
          STM    PVVS+4 
          LDM    PFLG        SET BLANK LABEL REQUIRED FLAG
          LPC    3777 
          LMC    4000 
          STM    PFLG 
          LDA    IR+3,REL    UPDATE FET 
          ADN    TFES 
          CWM    PVES,ON
          ADN    TFVS-TFES-1
          CWM    PVVS,ON
          LJM    CSA6        COMPLETE REQUEST 
  
 CSA5     UDTRD  CM,/MTX/UESN,1 
          MMOVE  PVES,,CM,,VSKL  SET EXTERNAL VSN 
          UDTWT  CM,/MTX/UESN,1 
          UDTRD  CM,/MTX/UISN,1 
          MMOVE  PVVS,,CM,,VSKL  SET INTERNAL VSN 
          UDTWT  CM,/MTX/UISN,1 
          UDTRD  CM,/MTX/UVRI,1 
          LDM    PVRC        SET REEL NUMBER
          SHN    -6 
          SBN    1
          STD    CM+3 
          UDTWT  CM,/MTX/UVRI,1 
          LDM    UTMS+3      SET AUTO-BLANK LABEL 
          SCN    WUBL 
          LMN    WUBL 
          STM    UTMS+3 
 CSA6     AOM    CBRC,BP     INCREMENT REEL COUNT 
 CSA7     RJM    WRP         WRITE RANDOM PRU 
          LJM    CSAX        RETURN 
 CVS      SPACE  4,20 
**        CVS - COMPLETE VSN SWITCH.
* 
*         CVS COMPLETES ASSIGNMENT OF NEXT VSN AND CLEARS 
*         ASSIGNMENT FIELDS IN CURRENT VSN, WHICH IS BEING
*         FLAGGED BY FUNCTION *GNSS*.  *CVS* IS CALLED BY 
*         *CSA* IF THE FUNCTION CALLED IS *SSJF*.  (TFSP) 
* 
*         ENTRY  (PVES) = NEW VSN.
*                (DA) = DEMAND FILE FST ADDRESS.
*                (DE) = DEMAND FILE EQUIPMENT.
*                (DT) = DEMAND FILE TRACK.
*                (DS) = DEMAND FILE SECTOR. 
*                IF FIRST REEL, *RSXDID* FILE ATTACHED
* 
*         EXIT   NEW VSN SET IN UDT OR RSXDID FILE. 
*                IF FIRST REEL, NEW VSN SET IN CATALOG. 
* 
*         USES   CM - CM+4, FS - FS+4, FN - FN+4, T1, T5, 
*                T6, T7.
* 
*         CALLS  RDS, WBB, WDS. 
* 
*         MACROS CLEAR, ENDMS, ERROR, MMOVE, MONITOR, 
*                SETMS, UDTRD, UDTWT. 
  
  
 CVS      SUBR               ENTRY/EXIT 
          LDN    0
          STM    VBCI,PB     CLEAR CATALOG INDEX
          STM    VBCI+1,PB
          LDM    VBRC,PB     CLEAR REEL COUNT 
          LPN    77 
          STM    VBRC,PB
          LDM    VBST+1,PB   CLEAR BUSY FLAG
          SCN    VIVS 
          STM    VBST+1,PB
          CLEAR  VBFV,PB,10D CLEAR FIRST VSN AND JSN
          LDN    TSVL        WRITE BUFFER TO FET
          STD    T1 
          LDC    BUFA 
          RJM    WBB         WRITE BINARY BUFFER
          LDM    UDTA 
          NJP    CVS3        IF REEL EXTENSION
          MMOVE  PVES,,CBES,BP,VSKL  UPDATE CATALOG 
          MMOVE  PVVS,,CBVS,BP,VSKL 
          LDD    DE          SET EQUIPMENT
          STD    T5 
          LDD    DT          SET TRACK
          STD    T6 
          LDD    DS          SET SECTOR 
          STD    T7 
          SETMS  IO,RW
          LDC    BUF0 
          RJM    RDS         READ SECTOR
          PJN    CVS2        IF NOT READ ERROR
 CVS1     ERROR  MSE         *EQXX, DNYY, MASS STORAGE ERROR* 
  
 CVS2     MMOVE  PVES,,BUF0+2+.RQPV+5*/RSX/PVSN,,VSKL  SET NEW VSN
          MMOVE  PVVS,,BUF0+2+.RQPV+5*/RSX/PVSI,,VSKL  SET NEW PRN
          LDC    BUF0 
          RJM    WDS         WRITE SECTOR 
          MJP    CVS1        IF WRITE ERROR 
          ENDMS              DROP CHANNEL 
          LDN    RDFO        SET DEMAND FILE ORDINAL
          STD    T1 
          LDN    /PFM/PTUP   SET MODE 
          STD    T2 
          LDN    RFAS        RETURN DEMAND FILE 
          RJM    ARF
*         LDN    0           SET DEMAND FILE NOT ATTACHED 
          STM    DFFO 
          LDN    ZERL        ISSUE RESOURCE EVENT 
          CRD    CM 
          LDM    VBVS,PB     HASH VSN 
          ADM    VBVS+1,PB
          ADM    VBVS+2,PB
          SHN    6
          SCN    77 
          SHN    14 
          ADC    ESVR        ENTER RESOURCE EVENT 
          STD    CM+4 
          SHN    -14
          STD    CM+3 
          MONITOR EATM
          LJM    CVSX        RETURN 
  
 CVS3     UDTRD  CM,/MTX/UESN,1  UPDATE VSN-S IN *UDT*
          MMOVE  PVES,,CM,,VSKL 
          UDTWT  CM,/MTX/UESN,1  WRITE *UDT*
          UDTRD  CM,/MTX/UISN,1 
          MMOVE  PVVS,,CM,,VSKL 
          UDTWT  CM,/MTX/UISN,1 
          LJM    CVSX        RETURN 
 GNSS     SPACE  4,15 
**        GNSS - GET NEXT SCRATCH.
* 
*         ENTRY  (IR+3 - IR+4) ADDRESS OF VSN ENTRY BUFFER. 
* 
*         EXIT   *VSN* ENTRY IN BUFFER UPDATED. 
*                NEXT SCRATCH *VSN* ASSIGNED TO THE JOB.
* 
*         CALLS  ASR, SFV, SSP. 
* 
*         MACROS EXSUB. 
  
  
 GNS      ENTRY 
          RJM    SFV         PRESET 
          LDC    BUF2        SET BUFFER POINTERS
          STD    BA 
          LDM    VBST+1,PB   DETERMINE TAPE TYPE
          SHN    -5 
          LPN    3
          RJM    SSP         SET SCRATCH POOL ADDRESS 
          LDM    VBCI,PB
          SHN    14 
          STD    CI          SET CATALOG INDEX
          SHN    -14
          STD    RI          SET RANDOM INDEX 
          LDM    VBCI+1,PB
          STD    RI+1 
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET POINTERS
          PJN    GNS1        IF VALID CATALOG POINTERS
          ERROR  EID         *ERROR IN INDEX DATA*
  
 GNS1     SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          EXSUB  ASR         ASSIGN SCRATCH REEL
          LJM    GNSX        RETURN 
          TITLE  SUBROUTINES. 
          SPACE  4
**        LOCAL COMMON DECKS. 
  
  
 BSE$     EQU    1           BSE - BACKSPACE ONE ENTRY
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT LINK 
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS LINK 
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 SSP$     EQU    1           DEFINE SSP - SET SCRATCH POOL ADDRESS
 SVB$     EQU    1           DEFINE SVB - SET VSN BUSY
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 UTR$     EQU    1           DEFINE UTR - UPDATE TRT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 IUC$     EQU    1           DEFINE IUC - INCREASE USAGE COUNTER
*CALL     COMPCOB 
*CALL     COMPRBB 
*CALL     COMPTFM 
*CALL     COMPWBB 
  
  
 BUFA     BSS    TSVL*5      VSN BUFFER 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        PRS - PRESET FOR FUNCTION AVSS. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (A) = 0 IF NO CATALOG INDEX. 
*                (CPCB - CPCB+4) = CATALOG POINTERS.
* 
*         USES   KA, (CN - CN+4). 
* 
*         CALLS  VIS. 
* 
*         MACROS ERROR, RESTP.
  
  
 PRS      SUBR               ENTRY/EXIT 
          UDTRD  CN,/MTX/UTCI,1 
          LDM    UTMS+3      SET FIRST *HDR1* LABEL FLAG
          LPC    -WUFL
          LMC    WUFL 
          STM    UTMS+3 
          LPN    WURF 
          ZJN    PRS1        IF NOT REWIND
          LDD    CN+1 
          ZJN    PRS1        IF NOT POSMF IN PROGRESS 
          LDD    CN+2 
          STM    CPCB+4 
          LDD    CN+1 
          UJN    PRS2        SET CATALOG POINTERS 
  
 PRS1     LDD    CN+4 
          STM    CPCB+4 
          LDD    CN+3        SET CATALOG POINTERS 
 PRS2     ZJN    PRSX        IF NO CATALOG POINTERS 
          SHN    14 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDC    BUF2 
          STM    CPCB 
          LDC    PESN        FIND CURRENT VSN 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    PRS3        IF VSN FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 PRS3     LDM    VBRC,BP     CHECK REEL COUNT 
          SHN    -6 
          SBN    2
          MJN    PRS3.1      IF FIRST REEL
          LDM    VBST+1,BP   CLEAR VOLUME BUSY
          SCN    VIVS 
          STM    VBST+1,BP
 PRS3.1   BSS    0
          RESTP  CPCB        RESTORE CATALOG BUFFER 
          LDD    RI 
          ADD    RI+1 
          LJM    PRSX        RETURN 
          SPACE  4
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  SUBROUTINES (OVERLAYED BY BUF2). 
 SFV      SPACE  4,20 
***       SFV - SEARCH FOR VSN. 
* 
*         *SFV* IS CALLED BY THE *GNSS* FUNCTION.  IT MAY BE
*         OVERLAYED BY BUF2.  *SFV* SEARCHES THE *UDT-S* AND
*         THE *RSXDID* FILE FOR THE VSN BEING REQUESTED.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (CPAB - CPAB+4) = CATALOG BUFFER POINTERS. 
*                IF FIRST REEL, (RESEX) 
*                   (DE) = DEMAND FILE EQUIPMENT. 
*                   (DT) = DEMAND FILE TRACK. 
*                   (DS) = DEMAND FILE SECTOR.
*                   (DA) = FST ADDRESS OF RSXDID FILE.
*                   (UDTA) = 0. 
*                   RSXD(ID) IS LEFT BUSY.
*                IF REEL EXTENSION, (MAGNET)
*                   (CPAB - CPAB+4) = BUFFER POINTERS TO
*                                     PREVIOUS VSN. 
*                   (PVFV) = FIRST VSN. 
*                   (UDTA) = *FWA* OF UDT ENTRY.
* 
*         USES   CM - CM+4, CN - CN+4, DE, DT, DS, KA, PB, T3, T5, T6,
*                T7.
* 
*         CALLS  COB, FAT, RBB, RND, SBP, VIS.
* 
*         MACROS COMPARE, ENDMS, ERROR, MONITOR, MMOVE, PAUSE, SAVEP, 
*                SETMS, UDTRD.
  
  
 SFV16    SAVEP  CPAB        SAVE BUFFER POINTERS 
          MMOVE  VBFV,PB,PVFV,,VSKL  SAVE FIRST VSN 
          LDM    VBRC,BP     SAVE REEL COUNT
          STM    PVRC 
          UJN    SFVX        RETURN 
  
 SFV17    ENDMS 
  
 SFV      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    COB         CHECK OUTPUT BUFFERS 
          PJN    SFV1        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR*
  
 SFV1     LDN    TSVL        PROCESS REQUEST
          STD    T3 
          LDC    BUFA        SET UP BUFFER POINTER
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
          LDC    PVES 
          STD    KA 
          MMOVE  VBES,PB,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          NJP    SFV8        IF VSN NOT FOUND 
          LDM    VBNV,BP     CHECK FOR NEXT VSN 
          NJP    SFV5        IF NEXT VSN
 SFV2     PAUSE              ALLOW MOVE / CHECK FOR ERROR 
          LDD    CM+1 
          LMN    ORET 
          ZJN    SFV2.1      IF OVERRIDE ERROR
          LDN    0           GET FIRST AND LAST ADDRESS OF *UDT-S*
          STD    CM+1 
          LDC    MTSI        SET *MAGNET* SUBSYSTEM ID
          STD    CM+2 
          LDC    /MTX/UBUF   SET BUFFER ADDRESS 
          STD    CM+4 
          SHN    -14
          ADC    100         SET WORD COUNT 
          STD    CM+3 
          MONITOR  TDAM 
          LDD    CM+1 
          ZJN    SFV3        IF COMPLETE
          SCN    3
          ZJN    SFV2        IF MAGNET BUSY, RETRY
 SFV2.1   ERROR  MNA         *MAGNET NOT ACTIVE*
  
 SFV3     LDD    MA          SET *FWA* OF UDT 
          CRD    CN 
          LDD    CN+4 
          SBN    /MTX/UNITL 
          STM    UDTA 
          LDD    CN+2        SET LWA+1 OF UDT 
          STD    T5 
 SFV4     LDN    /MTX/UNITL  SEARCH UDT FOR JOB 
          RAM    UDTA 
          SBD    T5 
          PJP    SFV9        IF END OF *UDT-S*
          UDTRD  CN,/MTX/UVRI,1  READ EJT ORDINAL AND FLAGS 
          COMPARE CN,,VBJS,PB,2 
          NJN    SFV4        IF NO MATCH
          UDTRD  CM,/MTX/UESN,1  READ *VSN* FROM *UDT*
          COMPARE CM,,VBES,PB,4 
          NJP    SFV4        IF NOT FOUND 
          LDD    CN+4 
          LPN    21 
          LMN    1
          ZJN    SFV6        IF MOUNT REQUEST FOR VSN 
 SFV5     ERROR  VBS         *VSN BUSY* 
  
 SFV6     LDC    PVES        SET FIRST VSN
          STD    KA 
          MMOVE  VBFV,PB,,KA,VSKL 
 SFV7     RJM    VIS         VSN INDEXED SEARCH 
          NJN    SFV8        IF NOT FOUND 
          COMPARE  VBES,PB,VBNV,BP,VSKL 
          ZJP    SFV16       IF NEXT VSN POINTS TO THIS VSN 
          MMOVE  VBNV,BP,,KA,VSKL 
          LDI    KA 
          NJN    SFV7        IF NO NEXT VSN 
 SFV8     ERROR  EID         ERROR IN INDEX DATA
  
 SFV9     LDN    RDFO        SET DEMAND FILE FNT ORDINAL
          STD    T1 
          STM    DFFO 
          LDN    /PFM/PTUP   SET MODE 
          STD    T2 
          LDN    /COMSCPS/AFAS  ATTACH DEMAND FILE
          RJM    ARF
          LDD    FN          COMPARE FILE NAMES 
          LMC    2RRS 
          LMD    FN+1 
          LMC    2RXD 
          LMD    FN+2 
          LMM    MFID 
          ZJN    SFV10       IF *RSXDID* FILE 
          ERROR  ILR         *TFM INCORRECT REQUEST*
  
 SFV10    STM    UDTA        CLEAR UDT ADDRESS
          LDD    FS          SET EQUIPMENT
          LPC    777
          STD    DE 
          STD    T5 
          LDD    FS+1        SET FIRST TRACK
          STD    T6 
          LDN    FSMS        SET FIRST SECTOR 
          STD    T7 
          SETMS  IO 
 SFV11    RJM    RND         READ FIRST SECTOR OF DEMAND FILE ENTRY 
          LDM    BUF0+2+.RJID+4  SAVE JOB EJT ORDINAL 
          STM    SFVB 
          LDD    T6          SAVE TRACK FOR SECOND SECTOR OF ENTRY
          STD    DT 
          LDD    T7          SAVE SECTOR FOR SECOND SECTOR OF ENTRY 
          STD    DS 
          RJM    RND         READ SECOND SECTOR OF DEMAND FILE ENTRY
          LDM    VBJS,PB     CHECK JOB EJT ORDINAL
          LMM    SFVB 
          NJN    SFV11       IF NOT THIS ENTRY
          LDM    BUF0+2+.RREQ 
          ADM    BUF0+2+.RREQ+1 
          ADM    BUF0+2+.RREQ+2 
          ADM    BUF0+2+.RREQ+3 
          ADM    BUF0+2+.RREQ+4 
          NJN    SFV11       IF NO REQUEST
          COMPARE  VBES,PB,BUF0+2+.RQPV+5*/RSX/PVSN,,VSKL  CHECK VSN
          NJN    SFV15.1     IF NOT THIS ENTRY
          LDN    SFVAL       GET LENGTH OF LIST 
          STD    T1 
 SFV15    LDM    SFVA,T1     CHECK FOR MATCHING RESOURCE
          LMM    BUF0+2+.RQPV+5*/RSX/PRES+3 
          ZJP    SFV17       IF FOUND 
          SOD    T1 
          PJN    SFV15       IF NOT END OF LIST 
 SFV15.1  LJM    SFV11       READ NEXT SECTOR 
  
  
 SFVA     BSS    0           RESOURCE TABLE 
          VFD    12/0RMT     7 TRACK TAPE 
          VFD    12/0RNT     9 TRACK TAPE 
          VFD    12/0RPE     1600 BPI 9 TRACK TAPE
          VFD    12/0RHD     800 BPI 9 TRACK TAPE 
          VFD    12/0RGE     6250 BPI 9 TRACK TAPE
          VFD    12/0RCT     CTS CARTRIDGE TAPE 
          VFD    12/0RAT     ACS CARTRIDGE TAPE 
 SFVAL    EQU    *-SFVA-1    LENGTH OF RESOURCE TABLE 
  
 SFVB     BSS    1           EJT ORDINAL FROM DEMAND FILE ENTRY 
 RND      SPACE  4,15 
**        RND - READ NEXT DEMAND FILE SECTOR. 
* 
*         ENTRY  (T5 - T7) = EST ORDINAL, TRACK AND SECTOR. 
* 
*         EXIT   SPECIFIED SECTOR READ. 
*                (T6 - T7) ADVANCED TO NEXT SECTOR. 
* 
*         ERROR  TO *ERR* IF MASS STORAGE ERROR, OR IF EOI ENCOUNTERED. 
* 
*         USES   T3, T6, T7.
* 
*         CALLS  RDS. 
* 
*         MACROS ENDMS, ERROR.
  
  
 RND      SUBR               ENTRY/EXIT 
          LDC    BUF0 
          STD    T3 
          RJM    RDS         READ SECTOR
          PJN    RND1        IF NOT READ ERROR
          ERROR  MSE         *EQXX, DNYY, MASS STORAGE ERROR* 
  
 RND1     LDI    T3          CHECK FIRST CONTROL BYTE 
          NJN    RND2        IF NOT EOF 
          LDM    1,T3        CHECK NEXT CONTROL BYTE
          NJN    RND2        IF NOT EOI 
          ENDMS 
          ERROR  VNF         *VSN NOT FOUND*
  
 RND2     STD    T7          SET NEXT SECTOR
          SHN    6
          PJN    RNDX        IF NOT NEW TRACK 
          SHN    -6 
          STD    T6 
          LDN    0           CLEAR SECTOR 
          STD    T7 
          UJN    RNDX        RETURN 
          SPACE  4,10 
          OVERFLOW  OVL1,BUF1 
          OVERLAY (SEARCH GLOBAL SCRATCH POOL.),OVL1
          SPACE  4,10 
**        LOCAL DIRECT CELLS. 
  
  
 FP       EQU    S3 - S3+4   FNT SEARCH POINTERS (5 LOCATIONS)
 GSPS     SPACE  4,10 
**        GSP - SEARCH GLOBAL SCRATCH POOL(S).
* 
*         CALLED TO LOCATE A SCRATCH TAPE IN ANOTHER FAMILY-S 
*         CATALOG. ONLY FAMILY-S DESIGNATED AS GLOBAL WILL BE 
*         SEARCHED. IF A SCRATCH TAPE IS FOUND, IT IS DELETED 
*         FROM THE FAMILY CATALOG AND RE-ENTERED INTO THE 
*         REQUESTING FAMILY CATALOG TO HONOR USER JOB SCRATCH 
*         REQUEST.
* 
*         ENTRY  (FO) = FAMILY TAPE CATALOG FNT ORDINAL.
*                (PFAM - PFAM+3) = FAMILY NAME. 
*                (SCRP) = ADDRESS IN TMST OF CORRECT SCRATCH POOL WORD. 
* 
*         EXIT   (FO) = RESET.
*                (PFAM - PFAM+3) =RESET.
*                TO CSA - COMPLETE SCRATCH ASSIGNMENT.
* 
*         USES   FP - FP+4, PB, T1, T2, KA. 
* 
*         CALLS  ARF, CIE, CSA, DDE, DLB, LSV, PRP, ROC, RRP, SAC,
*                VIS, WRP.
* 
*         MACROS ERROR, EXOVL, MMOVE, RESTP.
  
  
 GSP      ENTRY              ENTRY/EXIT 
          LDN    FNTP        INITIALIZE FNT POINTERS
          CRD    FP 
          MMOVE  PFAM,,GSPA,,PFKL 
          LDD    FO 
          STD    FP+3 
          STM    GSPA+4 
          LDN    0           PRESET FNT ORDINAL 
          STD    FP 
          UJP    GSP2        ENTER SEARCH LOOP
  
 GSP1     RJM    ROC         RESET ORIGINAL CATALOG 
          ERROR  WSA         *WAIT SCRATCH ASSIGNMENT.* 
  
 GSP2     LDD    FO          SET FNT ORDINAL
          STD    T1 
          LDN    /PFM/PTWR   SET MODE 
          STD    T2 
          LDN    RFAS        RETURN CATALOG 
          RJM    ARF
          RJM    SAC         SEARCH FOR ALTERNATE CATALOG 
          ZJP    GSP1        IF END OF SEARCH 
          RESTP  CPSB        SWAP TO SYSTEM BLOCK BUFFER
          RJM    RRP         READ RANDOM PRU (TMST) 
          LDM    SBST,BP
          LPN    GFTS/10000 
          ZJN    GSP2        IF NOT GLOBAL FAMILY 
          LDM    SBST+1,BP
          LPN    FETS+SATS+UITS 
          NJP    GSP2        IF ERROR, SUSPEND OR UTILITY ACTIVE
          RJM    LSV         LOCATE SCRATCH VOLUME
          NJP    GSP2        IF SCRATCH NOT FOUND OR ERROR
          MMOVE  ,BP,BUFA,,TSVL*10D 
          RJM    DDE         DELETE DATA ENTRY (SECONDARY INDEX)
          LDM    CWNE,BA
          NJN    GSP3        IF BLOCK NOT EMPTY 
          RJM    DLB         DELINK BLOCK (SECONDARY INDEX) 
          RESTP  CPPI        SWAP TO PRIMARY INDEX BUFFER 
          RJM    DDE         DELETE DATA ENTRY (PRIMARY INDEX)
          LDM    CWNE,BA
          ZJN    GSP3        IF BLOCK NOT EMPTY 
          RJM    DLB         DELINK BLOCK (PRIMARY INDEX) 
          UJN    GSP4        UPDATE SCRATCH VOLUME/COUNT
  
 GSP3     RJM    WRP         WRITE RANDOM PRU (PRIMARY VSN INDEX) 
 GSP4     RESTP  CPSB        SWAP TO SYSTEM BLOCK 
          LDM    SCRP        SET ADDRESS OF SCRATCH POOL WORD 
          ADD    BP 
          STD    T3 
          MMOVE  BUFA+VBNV,,,T3,VSKL
          LDA    3,T3        DECREMENT SCRATCH COUNT
          SBN    1
          STM    4,T3 
          SHN    -14
          STM    3,T3 
          RJM    WRP         WRITE RANDOM PRU 
          LDD    FO          SET FNT ORDINAL
          STD    T1 
          LDN    /PFM/PTWR   SET MODE 
          STD    T2 
          LDN    RFAS        RETURN CATALOG 
          RJM    ARF
          RJM    ROC         RESET ORIGINAL CATALOG 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          MMOVE  BUFA,,BUFC,,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJP    GSP2        IF VSN FOUND 
          RJM    CIE         CREATE INDEX ENTRY (VSN) 
          LDC    BUFC 
          STD    KA 
          RJM    VIS         FIND NEWLY CREATED VSN INDEX 
          NJN    GSP5        IF NOT FOUND 
          EXOVL  CSA         COMPLETE SCRATCH ASSIGNMENT (NO RETURN)
  
 GSP5     ERROR  EID         *ERROR IN INDEX DATA.* 
  
 GSPA     BSSZ   5           42/ FAMILY,6/ 0,12/ FNT ORDINAL
          TITLE  SUBROUTINES. 
 LSV      SPACE  4,10 
**        LSV - LOCATE SCRATCH VOLUME.
* 
*         ENTRY  (PESN - PESN+3) = EXTERNAL VSN.
*                (SCRP) = ADDRESS IN TMST OF CORRECT SCRATCH POOL WORD. 
* 
*         EXIT   (A) = 0 IF FOUND.
*                (A) = ERROR CODE IF NOT FOUND. 
* 
*         USES   KA, T2.
* 
*         CALLS  VIS. 
* 
*         MACROS MMOVE. 
  
  
 LSV3     LDN    0           INDICATE SCRATCH FOUND 
  
 LSV      SUBR               ENTRY/EXIT 
          LDC    PESN 
          STD    KA 
          LDM    SCRP        GET ADDRESS OF SCRATCH POOL WORD 
          ADD    BP 
          STD    T3 
          LDI    T3          CHECK SCRATCH POOL 
          LMC    7777 
          NJN    LSV1        IF SCRATCH AVAILABLE 
          LDN    /EMSG/WSA   *WAIT SCRATCH ASSIGNMENT.* 
          UJN    LSVX        RETURN 
  
 LSV1     MMOVE  ,T3,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    LSV2        IF NOT FOUND 
          LDM    VBST,BP
          LPN    ASVS/10000 
          NJN    LSV3        INDICATE SCRATCH FOUND 
 LSV2     LDN    /EMSG/EID   *ERROR IN INDEX DATA.* 
          UJN    LSVX        RETURN 
 PRP      SPACE  4,10 
**        PRP - PRESET RANDOM PROCESSORS. 
* 
*         EXIT   RANDOM PROCESSORS INITIALIZED
* 
*         USES   T5 - T5+4. 
* 
*         CALLS  IRA. 
  
  
 PRP      SUBR               ENTRY/EXIT 
          LDD    FO 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    T5 
          LDD    T5          ISOLATE EQUIPMENT
          LPC    777
          STD    T5 
          RJM    IRA         INITIALIZE RANDOM PROCESSORS 
          UJN    PRPX        RETURN 
 ROC      SPACE  4,10 
**        ROC - RESET ORIGINAL CATALOG. 
* 
*         ENTRY  (GSPA - GSPA+3) = ORIGINAL FAMILY NAME.
*                (GSPA+4 = ORIGINAL CATALOG FNT ORDINAL.
* 
*         EXIT   (PFAM - PFAM+3) = ORIGINAL FAMILY NAME.
*                (FO) = ORIGINAL FAMILY ORDINAL.
*                ORIGINAL CATALOG ATTACHED IN WRITE MODE AND RANDOM 
*                PROCESSORS PRESET. 
* 
*         USES   T1, T2.
* 
*         CALLS  ARF, PRP, UTR. 
* 
*         MACROS MMOVE. 
  
  
 ROC      SUBR               ENTRY/EXIT 
          MMOVE  GSPA,,PFAM,,PFKL  RESET FAMILY NAME
          LDM    GSPA+4      SET FNT ORDINAL
          STD    FO 
          STD    T1 
          LDN    /PFM/PTWR   SET WRITE MODE 
          STD    T2 
          LDN    /COMSCPS/AFAS  ATTACH CATALOG
          RJM    ARF
          RJM    UTR         UPDATE TRT 
          RJM    PRP         PRESET RANDOM PROCESSORS 
          UJN    ROCX        RETURN 
 SAC      SPACE  4,10 
**        SAC - SEARCH FOR ALTERNATE CATALOG. 
* 
*         ENTRY  (FP) = LAST FNT ORDINAL CHECKED. 
*                (FP+2) = MAXIMUM NUMBER OF FNT ENTRIES.
*                (FP+3) = FNT ORDINAL OF FAMILY ENTERED.
* 
*         EXIT   (A) .NE. 0 IF CATALOG FOUND. 
*                (A) = 0 IF CATALOG NOT FOUND.
*                (FN - FN+4) = FAMILY NAME. 
*                (FO) = FNT ORDINAL.
*                (FP) = FNT ORDINAL.
* 
*         USES   CM - CM+4, FN - FN+4, FO, FS - FS+4, T1, T2. 
* 
*         CALLS  AFA, ARF, UTR. 
* 
*         MACROS COMPARE. 
  
  
 SAC      SUBR               ENTRY/EXIT 
 SAC1     AOD    FP          ADVANCE POINTER
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          SBN    FSTG-FNTG
          CRD    FN          READ FNT ENTRY 
          LDD    FP 
          LMD    FP+2 
          ZJN    SACX        IF END OF FNT
          LDD    FN 
          ZJN    SAC1        IF EMPTY ENTRY 
          LDD    FN+4        CHECK FILE TYPE
          SHN    -6 
          LMN    FAFT 
          NJN    SAC1        IF NOT CORRECT FILE TYPE 
          COMPARE SACA,,FN,,PFKL
          NJN    SAC1        IF NOT CATALOG 
          LDD    FP 
          RJM    AFA         GET ABSOLUTE FST ADDRESS 
          CRD    FS          READ FST OF FAST ATTACH FILE 
          LDD    FP 
          LMD    FP+3 
          ZJN    SAC1        IF FAMILY ENTERED
          SFA    EST,FS 
          CRD    FS          READ EST ENTRY 
          LDD    FS 
          SHN    21-13
          PJP    SAC1        IF NOT MASS STORAGE DEVICE 
          SHN    21-6-21+13 
          MJP    SAC1        IF DEVICE UNAVAILABLE
          LDD    FS+3 
          SHN    21-13
          MJP    SAC1        IF ACCESS NOT ALLOWED
          LDD    FS+4 
          SHN    3
          ADN    PFGL 
          CRM    PFAM,ON
          ADN    STLL-PFGL-1
          CRD    CM          GET INITIALIZE REQUESTS
          LDD    CM          CHECK INITIALIZE AND UNLOAD REQUESTS 
          LPC    1030 
          NJP    SAC1        IF REQUESTS PENDING
          LDD    FP          SET CATALOG FNT ORDINAL
          STD    FO 
          STD    T1 
          LDN    /PFM/PTWR   SET MODE 
          STD    T2 
          LDN    /COMSCPS/AFAS  ATTACH CATALOG
          RJM    ARF
          RJM    UTR         UPDATE TRT 
          RJM    PRP         PRESET RANDOM PROCESSORS 
          LDN    1           SET CATALOG FOUND
          LJM    SACX        RETURN 
  
 SACA     VFD    48D/0L"TMFC"  TMS CATALOG NAME 
          SPACE  4,10 
**        LOCAL COMMON DECKS. 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 CIE$     EQU    1           DEFINE CIE - CREATE INDEXED ENTRY
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK DATA BLOCK 
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 UTR$     EQU    1           DEFUNE UTR - UPDATE TRT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
*CALL     COMPIRA 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4,10 
**        BUFFERS.
  
  
 BUFA     BSS    TSVL*5 
 BUFB     BSS    TSVL*5 
 BUFC     BSS    4
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (ADMIT ALTERNATE USERS.),OVL1 
 ADMS     SPACE  4,10 
***       ADMS - ADMIT ALTERNATE USERS. 
* 
*         THE ADMIT OVERLAY GRANTS PERMISSION FOR USERS OTHER 
*         THAN THE FILE CREATOR TO ACCESS A PRIVATE FILE. 
*         THE TWO CM WORD ADMIT ENTRIES SPECIFY THE ALTERNATE 
*         USERNAME AND THE MODE OF ACCESS ALLOWED FOR THAT USER.
* 
*         THERE IS NO LIMIT TO THE NUMBER OF ADMIT ENTRIES
*         THAT CAN BE ASSOCIATED WITH A FILE AS ADDITIONAL
*         DATA BLOCKS WILL BE APPENDED TO THE FILE AS NEEDED. 
* 
*         ENTRY  (IR - IR+3) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  60/ 0 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/ 0 
*T,  +14  60/ 0 
*T,  +15  60/ 0 
*T,  +16  42/ ALT. USERNAME,18/ 0 
* 
*         USES   T7, KA, PB, RI - RI+1. 
* 
*         CALLS  AUS, FTC, IBC, IIE, MBP, TBA, WRP. 
* 
*         MACROS CLEAR, ERROR, LDA, MMOVE, SAVEP, RESTP.
  
  
 ADM      ENTRY              ADMIT ALTERNATE USERS
          LDC    BUFA        BUILD ADMIT ENTRY
          STD    PB 
          LDN    PDTL 
          CRM    BUFA+5,ON
          CLEAR  ,PB,TAEL*10D-7 
          MMOVE  PAUN,,,PB,UNKL 
          LDM    PAUN 
          ZJP    ADM3        IF NO ALTERNATE USERNAME 
          LDM    PPWD+4 
          LPN    77 
          STM    ABAM,PB
          ZJP    ADM3        IF INCORRECT ACCESS MODE 
          SBN    FMMX 
          RJM    FTC         FIND TAPE CATALOG
          ZJN    ADM2        IF CATALOG FOUND 
 ADM1     ERROR 
  
 ADM2     LDM    PESN 
          ZJN    ADM5        IF SYMBOLIC FILE NAME
          RESTP  CPSI        RESTORE VSN INDEX POINTERS 
          LDM    VBRC,BP     CHECK FOR FIRST REEL 
          SHN    -6 
          ZJN    ADM4        IF NO REEL COUNT, ASSUME FIRST 
          SBN    1
          ZJN    ADM4        IF FIRST OF SET
 ADM3     LDN    /EMSG/ILR   *TFM INCORRECT REQUEST.* 
          UJN    ADM1        SET ERROR CODE 
  
 ADM4     RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
 ADM5     LDM    CBCT,BP     CHECK FILE CATEGORY
          SHN    -6 
          LMN    FCPU 
          ZJN    ADM3        IF PUBLIC FILE 
          LDC    PAUN 
          STD    KA 
          LDM    CBAE,BP
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBAE+1,BP
          STD    RI+1 
          ZJP    ADM8        IF ADMIT BLOCK NOT ASSIGNED
          RJM    AUS         ALTERNATE USERNAME SEARCH
          NJN    ADM6        IF ALTERNATE USERNAME NOT FOUND
          LDM    ABAN,BP     SAVE ACCESS COUNT
          STM    ABAN,PB
          LDM    ABAN+1,BP
          SCN    77 
          RAM    ABAN+1,PB
          MMOVE  ,PB,,BP,TAEL*10D 
          LDC    WRP         SET TO UPDATE
          STM    ADMA 
          UJN    ADM7        REWRITE PRU
  
 ADM6     LDC    BUFB        DEFINE OVERFLOW BUFFER 
          STD    T7 
 ADM7     RJM    IIE         INSERT INDEX ENTRY 
 ADMA     EQU    *-1         (RJM TO *WRP* IF INDEX FOUND)
          LJM    ADMX        RETURN 
  
 ADM8     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 
          RESTP  CPAB        RESTORE ADMIT BUFFER POINTERS
          LJM    ADM6        CREATE ADMIT INDEX 
          TITLE  SUBROUTINES. 
          SPACE  4
***       COMMON DECKS. 
  
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 IIE$     EQU    1           DEFINE IIE - INSERT INDEX ENTRY
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USER BLOCK 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
***       BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (AUDIT TAPE FILE CATALOG.),OVL1 
          SPACE  4,10 
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 CN       EQU    S1+0 - S1+4 SCRATCH WORD (5 LOCATIONS) 
 AF       EQU    S2+0        AUDIT FUNCTION CODE
 RC       EQU    AF          REEL COUNT (REDEFINES *AF*)
 WC       EQU    S2+1        WORD COUNT 
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 FA       EQU    S1+0        FNT ORDINAL
 CA       EQU    EC          CONTINUATION ADDRESS 
 AUDS     SPACE  4,10 
***       AUDS - AUDIT TAPE FILE CATALOG. 
* 
*         THE AUDIT OVERLAY ENABLES THE FILE CREATOR TO OBTAIN
*         INFORMATION ABOUT THE FILES THAT RESIDE IN THE
*         TAPE FILE CATALOG. IN ADDITION, ALTERNATE USERS 
*         CAN OBTAIN AUDIT INFORMATION ABOUT SPECIFIC 
*         FILES THAT THEY ARE PERMITTED TO ACCESS IN THE
*         FILE CREATORS CATALOG.
* 
*         THERE ARE FOUR MODES OF AUDIT ACCESS TO THE 
*         TAPE FILE CATALOG-
* 
*         1. A FULL CATALOG SEARCH. THE CATALOG IMAGE 
*            AND ALL ASSOCIATED VSNS ARE RETURNED TO
*            THE REQUESTER FOR ALL FILES IN HIS/HER 
*            CATALOG. 
* 
*         2. A SELECTIVE CATALOG SEARCH. THE CATALOG
*            IMAGE AND ALL ASSOCIATED VSNS ARE RETURNED 
*            FOR A SPECIFIED FILE.
* 
*         3. A FULL ADMIT SEARCH. THE ADMIT ENTRY IMAGE IS
*            RETURNED FOR ALL ADMITS ASSIGNED TO A
*            SPECIFIED FILE.
* 
*         4. A SELECTIVE ADMIT SEARCH. ONLY THE ADMIT ENTRY 
*            IMAGE FOR THE FILE AND USER SPECIFIED WILL BE
*            RETURNED TO THE REQUESTER. 
* 
*         ENTRY  (IR - IR+3) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/ 0.
*T,  +14  60/ 0 
*T,  +15  60/ 0 
*T,  +16  42/ ALT. USERNAME,18/ 0 
*T,  +17  42/ PASSWORD,12/ 0,6/ MD
* 
*         EXIT   TO MAIN LOOP IF NO ERROR.
* 
*         USES   AF, BA, CA, CI, CN - CN+4, CM - CM+4,
*                RI - RI+1, WC. 
* 
*         CALLS  GIB, PRS, VRR, VSP.
* 
*         MACROS ENTRY, ERROR, LDA, SAVEP.
  
 AUD      ENTRY              AUDIT TAPE FILE CATALOG
          RJM    PRS         PRESET 
          ADN    TFRR 
          CRD    CN 
          ADN    TFPW-TFRR
          CRD    CM 
          LDD    CM+4 
          ZJN    AUD1        IF INCORRECT SEARCH TYPE 
          STD    AF 
          SBN    MXST 
          MJN    AUD2        IF VALID SEARCH TYPE 
 AUD1     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 AUD2     LDD    CN          CHECK AUDIT CONTINUATION 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CN+1 
          NJN    AUD3        IF AUDIT CONTINUATION
          STD    CA          CLEAR CONTINUATION ADDRESS 
          LJM    AUD7        BUILD PARAMETER BLOCK
  
 AUD3     STD    RI+1        SET RANDOM ADDRESS (CATALOG) 
          SHN    -14
          STD    RI 
          LDC    BUF2        SET CATALOG BUFFER ADDRESS 
          STD    BA 
          RJM    VRR         VERIFY RANDOM REQUEST
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    AUD5        IF VALID CONTINUATION POINTERS 
 AUD4     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 AUD5     SAVEP  FCSA        SAVE CATALOG POINTERS
          LDD    AF          CHECK SEARCH TYPE
          LMN    FAST 
          NJN    AUD6        IF NOT CATALOG CONTINUATION
          LDC    60D/TAEL+1+SBNI
          STM    VSPA 
          LDC    LDNI+TAEL
          STM    VSPB 
 AUD6     LDD    CN+3        CHECK RANDOM REQUEST 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CN+4 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    VRR         VERIFY RANDOM REQUEST
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          STD    CA          SET CONTINUATION ADDRESS 
          MJP    AUD4        IF CONTINUATION POINTERS INCORRECT 
 AUD7     LDM    AUDB,AF     SET PROCESSOR ADDRESS
          STM    AUDA 
          RJM    **          PROCESS FUNCTION 
 AUDA     EQU    *-1         (PROCESSOR ADDRESS)
          LJM    AUDX        RETURN 
  
  
 AUDB     INDEX              TABLE OF AUDIT PROCESSORS
          INDEX  FCST,FCS    FULL CATALOG SEARCH
          INDEX  SCST,SCS    SELECTIVE CATALOG SEARCH 
          INDEX  FAST,FAS    FULL ADMIT SEARCH
          INDEX  SAST,SAS    SELECTIVE ADMIT SEARCH 
          INDEX  MXST 
 GVSS     SPACE  4,10 
***       GVSS - GET VOLUME SERIAL NUMBERS. 
* 
*         *GVS* RETURNS A SNAPSHOT CATALOG IMAGE FOR
*         A ASSIGNED FILE.
* 
*         ENTRY  (IR - IR+3) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/0. 
*T,  +14  60/ 0 
*T,  +15  60/ 0 
*T,  +16  42/ ALT. USERNAME,18/ 0 
*T,  +17  42/ PASSWORD,12/ 0,6/ MD
* 
*         EXIT   TO MAIN LOOP IF NO ERROR.
* 
*         USES   BA, CI, CM - CM+4, FN - FN+4,
*                RI - RI+1, T1 - T1+4, WC.
* 
*         CALLS  GIB, PRS, PTC, RRP, SAF, VSP.
* 
*         MACROS ENTRY, ERROR, LDA. 
  
  
 GVS      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          CRD    FN 
          LDN    0           NO INITIAL SEARCH ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          NJN    GVS1        IF FILE FOUND
          ERROR  LNF         *(LFN) NOT FOUND.* 
  
 GVS1     NFA    FA,R 
          ADN    FSTL 
          CRD    FS          GET FST/EST ENTRIES
          SFA    EST,FS 
          CRD    CM 
          LDD    CM+3        VALIDATE MT/NT EQUIPMENT 
          LMC    2RMT 
          ZJN    GVS2        IF 7 TRACK TAPE
          LMC    2RNT&2RMT
          ZJN    GVS2        IF 9 TRACK TAPE
          LMC    2RCT&2RNT
          ZJN    GVS2        IF CTS CARTRIDGE TAPE
          LMC    2RAT&2RCT
          ZJN    GVS2        IF ACS CARTRIDGE TAPE
          ERROR  NMT         *(LFN) NOT ON MAGNETIC TAPE.*
  
 GVS2     LDD    FS+1        SET UDT ADDRESS
          STM    UDTA 
          LDD    CP          VALIDATE JOB ASSIGNMENT
          ADN    TFSW 
          CRD    CN 
          UDTRD  CM,/MTX/UVRI,1 
          LDD    CM 
          LMD    CN 
          ZJN    GVS3        IF ASSIGNED
          UJN    GVS4        *TFM INCORRECT REQUEST.* 
  
 GVS3     UDTRD  CM,/MTX/UTMS,1 
          LDD    CM+4 
          SHN    21-13
          PJN    GVS4        IF NOT TMS CONTROLLED FILE 
          UDTRD  CM,/MTX/UTCI,1 
          LDD    CM+3        SET CATALOG ADDRESS
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CM+4 
          NJN    GVS5        IF CATALOG ADDRESS 
 GVS4     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 GVS5     STD    RI+1        SET RANDOM ADDRESS 
          SHN    -14
          STD    RI 
          LDC    BUF0 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK (CATALOG)
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    GVS4        IF POINTERS INCORRECT
          RJM    PTC         PROCESS TAPE CATALOG 
          LJM    GVSX        RETURN 
          TITLE  SUBROUTINES. 
 CCA      SPACE  4,15 
**        CCA - CHECK CATALOG ADMISSION.
* 
*         FILE ACCESS PERMISSION IS CHECKED GRANTED IF- 
* 
*         1. THE FILE BELONGS TO THE CREATOR. 
*         2. THE FILE IS LISTABLE BY AN ALTERNATE USER, AND THE FILE
*            COULD BE ACCESSED BY THE ALTERNATE USER IF THE CORRECT 
*            PASSWORD WAS SPECIFIED.
* 
*         ON ALL ALTERNATE USER REQUESTS THE PASSWORD 
*         IS CLEARED. 
* 
*         ENTRY  (BA) = ADDRESS OF BUFFER CONTAINING CATALOG. 
*                (BP) = ADDRESS OF CATALOG ENTRY. 
*                (CI) = CATALOG INDEX.
* 
*         EXIT   (A) = 0 IF USER ADMITTED TO FILE.
* 
*         USES   RI - RI+1, T1 - T1+3 
* 
*         CALLS  AUS. 
* 
*         MACROS CLEAR, RESTP.
  
  
 CCA7     LDN    1           USER NOT ADMITTED TO FILE
  
 CCA      SUBR               ENTRY/EXIT 
          LDM    PAUN 
          ZJN    CCAX        IF NOT ALTERNATE USER SEARCH 
          LDM    CBST,BP     CHECK ALTERNATE CATALOG LIST ATTRIBUTE 
          SHN    21-13
          PJN    CCA7        IF ALTERNATE USER AUDIT NOT ALLOWED
          LDM    CBCT,BP
          SHN    -6 
          LMN    FCPU 
          ZJP    CCA3        IF PUBLIC FILE 
          LDM    CBAE,BP     SET ADMIT INDEX
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBAE+1,BP
          STD    RI+1 
          ZJN    CCA1        IF NO PERMIT ENTRIES 
          LDC    PAUN 
          STD    KA 
          RJM    AUS         SEARCH FOR ADMIT ENTRY 
          ZJN    CCA2        IF ENTRY FOUND 
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
 CCA1     LDM    CBCT,BP     CHECK FOR SEMI-PRIVATE FILE
          SHN    -6 
          LMN    FCSP 
          ZJN    CCA3        IF SEMI-PRIVATE FILE 
          UJN    CCA4        RETURN 
  
 CCA2     LDM    ABAM,BP     GET ADMIT PERMISSION MODE
          LPN    77 
          STD    T1 
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
          LDD    T1 
*         LMN    FMIU 
          ERRNZ  FMIU 
          ZJN    CCA3        IF IMPLICIT ACCESS 
          LDM    CBAM,BP     INSERT ADMIT PERMISSION
          SCN    77 
          ADD    T1 
          STM    CBAM,BP
 CCA3     LDM    CBAM,BP     CHECK FOR *NO ACCESS*
          LPN    77 
          LMN    FMNA 
          NJN    CCA5        IF ACCESS ALLOWED
 CCA4     LDN    1
          UJN    CCA6        RETURN 
  
 CCA5     CLEAR  CBPW,BP,PWKL CLEAR PASSWORD
 CCA6     LJM    CCAX        RETURN 
 FAS      SPACE  4,10 
**        FAS - FULL ADMIT SEARCH.
* 
*         RETURNS A BUFFER OF ADMIT ENTRIES.
* 
*         ENTRY  (MD) = FAST. 
*                (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
* 
*         EXIT   TO MAIN LOOP IF NO ERROR.
*                FET+2 UPDATED. 
*                FET+TFRR UPDATED.
* 
*         USES   CI, CM - CM+4, CN - CN+4, EC, RI - RI+1. 
* 
*         CALLS  CIB, EOI, ERR, FTC, GIB, GNB, GNL, 
*                MBP, SCA, TBA, WDB.
* 
*         MACROS ERROR, LDA.
  
  
 FAS      SUBR               ENTRY/EXIT 
          LDD    CA 
          ZJN    FAS1        IF NOT AUDIT CONTINUATION
          RJM    VUB         VERIFY USERS ADMIT BLOCK 
          ZJP    FAS7        IF CORRECT USER
          LDN    /EMSG/EID   ERROR IN INDEX DATA
          UJN    FAS2        ABORT WITH ERROR 
  
 FAS1     RJM    FTC         FIND TAPE CATALOG
          ZJN    FAS3        IF CATALOG FOUND 
 FAS2     ERROR              CALL ERROR PROCESSING (NO RETURN)
  
 FAS3     LDD    CI          SET CATALOG POSITION 
          SHN    6
          LMD    RI 
          STM    SCAA 
          LDD    RI+1 
          STM    SCAA+1 
          LDM    CBAE,BP     SET FIRST ADMIT BLOCK ADDRESS
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBAE+1,BP
          STD    RI+1 
          NJN    FAS4        IF ADMIT BLOCK ASSIGNED
          ERROR  NAE         *NO ADMITS.* 
  
 FAS4     RJM    TBA         TOGGLE BUFFER ASSIGNMENT 
          RJM    GIB         GET INITIAL BLOCK
 FAS5     LDN    0           SET FIRST ADMIT ENTRY
          STD    CI 
          LDM    CWFE,BA
 FAS6     RJM    MBP         MOVE BUFFER POINTER
          MJN    FAS8        IF MOVE OUTSIDE OF BUFFER
          LDI    BP 
          ZJN    FAS8        IF END OF ADMIT BLOCK
          AOD    CI 
 FAS7     RJM    CIB         CHECK INPUT BUFFER 
          SBN    TAEL 
          MJN    FAS10       IF NO ROOM IN BUFFER 
          RJM    WDB         WRITE DATA TO BUFFER 
          LDM    CWEL,BA
          UJN    FAS6        ADVANCE TO NEXT ADMIT ENTRY
  
 FAS8     RJM    GNL         GET NEXT LINK
          ZJN    FAS9        IF BLOCK NOT LINKED
          RJM    GNB         GET NEXT BLOCK 
          UJN    FAS5        PROCESS ADMIT BLOCK
  
 FAS9     RJM    EOI         SET END OF INFORMATION 
          LDN    ZERL        CLEAR CONTINUATION ADDRESS 
          CRD    BA 
          CRM    SCAA,ON
 FAS10    RJM    SCA         SET CONTINUATION ADDRESS IN FET
          LDN    ZERL 
          CRD    CM 
          LDD    IN          CURRENT POSITION OF IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    2
          CWD    CM 
          LJM    FASX        RETURN 
 FCS      SPACE  4,10 
**        FCS - FULL CATALOG SEARCH.
* 
*         RETURNS THE CATALOG IMAGE FOLLOWED BY THE 
*         IMAGE OF THE VSN INDICIES ASSIGNED TO THE 
*         FILE. THE BUFFER SIZE MUST BE AT LEAST AS 
*         LARGE AS ONE CATALOG PLUS 60D VSN(S). 
* 
*         ENTRY  (MD) = FCST. 
*                (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
*                (CA) = 0 IF NOT CONTINUATION OF A
*                         PREVIOUS REQUEST. 
* 
*         EXIT   BUFFER FULL. 
*                FET UPDATED. 
* 
*         USES   CA, CI, CM - CM+4, RI - RI+1.
* 
*         CALLS  EOI, GIB, GNL, MBP, PTC, UIS, RRP, VIS 
*                VUB, VSP.
* 
*         MACROS ERROR, RESTP, SAVEP. 
  
  
 FCS      SUBR               ENTRY/EXIT 
          LDD    CA 
          ZJP    FCS5        IF NOT AUDIT CONTINUATION
          RJM    VUB         VERIFY USERS CATALOG BLOCK 
          ZJN    FCS2        IF CORRECT USER
 FCS1     ERROR  EID         *ERROR IN INDEX DATA.* 
  
*         IF THIS IS A CONTINUATION FROM THE MIDDLE OF A MULTI-FILE 
*         SET, FIND THE CATALOG POINTERS FOR THE FIRST CATALOG OF 
*         THE SET, SO THAT THE NEXT CATALOG RETURNED WHEN THE MULTI 
*         FILE SET IS COMPLETE IS THE ONE FOLLOWING THE FIRST CATALOG 
*         OF THE MULTI-FILE SET.
  
 FCS2     LDA    CBQN,BP
          SBN    2
          MJP    FCS14       IF FIRST FILE OF SET 
          LIA    CBVS,BP     READ FIRST VSN OF FILE 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    FCS3        IF VSN FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 FCS3     COMPARE  VBES,BP,VBFV,BP,VSKL 
          ZJN    FCS4        IF FIRST VOLUME
          LDN    CN 
          STD    KA 
          MMOVE  VBFV,BP,,KA,VSKL 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    FCS4        IF VSN FOUND 
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 FCS4     LDM    VBCI,BP     SET INDEX OF FIRST CATALOG 
          SHN    14 
          STM    FCSA+2      *FIRST CATALOG IN SET* CATALOG INDEX 
          SHN    -14
          STM    FCSA+3      *FIRST CATALOG IN SET* RANDOM INDEX
          LDM    VBCI+1,BP
          STM    FCSA+4 
          LDM    FCSA        RESTORE CATALOG BUFFER POINTERS
          STD    BA 
          LDM    FCSA+1 
          STD    BP 
          LJM    FCS16       PROCESS TAPE CATALOG 
  
  
 FCS5     LDC    PBUN 
          STD    KA 
          RJM    UIS         USERNAME INDEX SEARCH
          NJN    FCS7        IF USERNAME NOT FOUND
          LDM    3,BP        SET CATALOG INDEX
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    4,BP 
          STD    RI+1 
          NJN    FCS6        IF CATALOG ADDRESS 
          UJN    FCS7        *EMPTY CATALOG.* 
  
 FCS6     LDC    BUF2        SET CATALOG BUFFER 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK
          LDM    CWNE,BA
          NJN    FCS9        IF NOT EMPTY CATALOG 
 FCS7     ERROR  ECF         *EMPTY CATALOG.* 
  
 FCS8     RJM    GIB         GET INITIAL BLOCK
 FCS9     RJM    VUB         VERIFY USERS CATALOG BLOCK 
          NJP    FCS1        IF NOT CORRECT USER
          LDM    CWFE,BA     BYPASS HEADER
          RJM    MBP         MOVE BUFFER POINTER
          LDN    0
          STD    CI 
 FCS10    AOD    CI          CHECK CATALOG
          LDI    BP 
          NJN    FCS12       IF NOT HOLE
 FCS11    LDN    TCEL        ADVANCE TO NEXT CATALOG
          RJM    MBP         MOVE BUFFER POINTER
          PJN    FCS10       IF WITHIN CURRENT BUFFER 
          RJM    GNL         GET NEXT LINK
          NJN    FCS8        IF BLOCK LINKED
          RJM    EOI         SET BUFFER STATUS
          LDN    ZERL        CLEAR CONTINUATION WORD
          CRD    CM 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWD    CM 
          LJM    FCSX        RETURN 
  
 FCS12    LDA    CBQN,BP     CHECK FOR FIRST FILE OF SET
          SBN    1
 FCS13    NJN    FCS11       IF NOT FIRST FILE
          SAVEP  FCSA        SAVE CATALOG POINTERS
 FCS14    LDD    FC          CHECK FOR *TFSP* CALL
          LMN    SSJF 
          ZJN    FCS16       IF *TFSP* CALL 
          LDM    CBRC,BP     CHECK END OF LIST
          ZJN    FCS16       IF END OF LIST 
          LIA    CBES,BP
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    FCS15       IF VSN FOUND 
          ERROR  ECD         * ERROR IN CATALOG DATA *
  
 FCS15    LDD    BP 
          STD    CM 
          RESTP  FCSA        RESTORE CATALOG POINTERS 
          LDM    VBRD+1,CM   CHECK RELEASE DATE 
          NJN    FCS13       IF CONDITIONAL RELEASE 
 FCS16    RJM    PTC         PROCESS TAPE CATALOG 
          PJN    FCS17       IF BUFFER NOT FULL 
          LJM    FCSX        RETURN (BUFFER FULL) 
  
 FCS17    LDM    CBNC,BP     CHECK FOR MULTI-FILE 
          NJN    FCS19       IF MULTI-FILE
          RESTP  FCSA        RESTORE CATALOG POINTERS 
          LDM    CPRI 
          LMD    RI 
          LMM    CPRI+1 
          LMD    RI+1 
          ZJN    FCS18       IF BUFFER LOADED 
          RJM    GIB         GET INITIAL BLOCK (CATALOG)
          RJM    VUB         VERIFY USERS CATALOG BLOCK 
          NJP    FCS1        IF NOT CORRECT USER
          RJM    VSP         VERIFY/SET CATALOG POINTERS
 FCS18    LJM    FCS11       ADVANCE TO NEXT CATALOG
  
 FCS19    SHN    14          PROCESS MULTI-FILE 
          STD    CI 
          SCN    77 
          LMM    CBNC+1,BP
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          LJM    FCS16       PROCESS TAPE CATALOG 
  
 FCSA     BSS    5           CATALOG POINTERS (FIRST OF SET)
          SPACE  4
  
 PTC      SPACE  4,10 
**        PTC - PROCESS TAPE CATALOG. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS CONTAINING CATALOG.
*                (BP) = BUFFER POINTER TO CATALOG.
* 
*         EXIT   (A) = 0 IF COMPLETE. 
*                (A) = 1 IF USER NOT ADMITTED TO FILE.
*                (A) = -0 IF BUFFER FULL ON WRITE.
*                (BA) = BUFFER ADDRESS (CATALOG). 
*                (BA) = BUFFER POINTER (CATALOG). 
*                (CI) = CATALOG INDEX.
* 
*         USES   CM - CM+4, KA, RC, SCAA - SCAA+1, T1, WC.
* 
*         CALLS  CCA, CIB, VIS, WBB, WDB. 
* 
*         MACROS ERROR, LDA, MMOVE, MULT4, RESTP, SAVEP.
  
  
 PTC      SUBR               ENTRY/EXIT 
          LDD    CI          SET CATALOG INDEX FOR CONTINUATION 
          SHN    6
          LMD    RI 
          STM    SCAA 
          LDD    RI+1 
          STM    SCAA+1 
 PTC1     LDM    CBRC,BP
          STD    RC 
          MULT4              MULTIPLY BY 4
          ADN    TCEL+2 
          STD    WC 
          RJM    CIB         CHECK INPUT BUFFER 
          SBD    WC 
          PJN    PTC3        IF ROOM IN BUFFER
          RJM    SCA         SET CONTINUATION ADDRESS 
          LCN    0
 PTC2     UJP    PTCX        RETURN 
  
 PTC3     SAVEP  CPCB        SAVE CATALOG POINTERS
          LDD    FC 
          LMN    SSJF 
          ZJN    PTC5        IF CALLED BY *TFSP*
          RJM    CCA         CHECK CATALOG ADMISSION
          ZJN    PTC5        IF USER ADMITTED TO FILE 
 PTC4     RESTP  CPCB        RESTORE CATALOG POINTERS 
          UJP    PTC2        RETURN 
  
 PTC5     RJM    WDB         WRITE DATA TO BUFFER 
          LDN    CBES        SET FIRST VSN OF SET 
          ADD    BP 
          STD    T1 
 PTC6     LDD    RC          CHECK END OF LIST
          ZJN    PTC8        IF END OF LIST 
          SOD    RC 
          LDI    T1 
          ZJN    PTC8        IF END OF VSN LIST 
          MMOVE  ,,PESN,,VSKL 
          LDC    PESN        LOCATE VSN 
          STD    KA 
          RJM    VIS         VSN INDEX SEARCH 
          ZJN    PTC7        IF VSN FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 PTC7     RJM    WDB         WRITE DATA TO BUFFER 
          LDN    3*5         GET NEXT VSN 
          ADD    BP 
          STD    T1 
          UJP    PTC6        PROCESS NEXT VSN 
  
 PTC8     LDM    CPCB+2      TERMINATE CATALOG
          SHN    6
          LMM    CPCB+3 
          STM    PTCA+3 
          LDM    CPCB+4 
          STM    PTCA+4 
          LDN    1
          STD    T1 
          LDC    PTCA 
          RJM    WBB         WRITE BINARY BUFFER
          LDN    ZERL 
          CRD    CM 
          LDD    IN          CURRENT POSITION OF IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    2
          CWD    CM 
          LDN    0           SET CATALOG COMPLETE 
          LJM    PTC4        RESTORE POINTERS AND RETURN
  
 PTCA     VFD    60D/77777777777777777777B
 SCA      SPACE  4,10 
**        SCA - SET CONTINUATION ADDRESS. 
* 
*         ENTRY  (CI) = CATALOG INDEX.
*                (RI - RI+1) = CATALOG RANDOM ADDRESS.
* 
*         EXIT   FET WORD TFRR UPDATED. 
* 
*         USES   SCAA+3 - SCAA+4. 
* 
*         MACROS LDA. 
  
  
 SCA      SUBR               ENTRY/EXIT 
          LDD    CI          SET CURRENT POSITION 
          SHN    6
          LMD    RI 
          STM    SCAA+3 
          LDD    RI+1 
          STM    SCAA+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    TFRR 
          CWM    SCAA,ON
          UJN    SCAX        RETURN 
  
 SCAA     VFD    60/0        CONTINUATION POINTERS
 SAS      SPACE  4,10 
**        SAS - SELECTIVE ADMIT SEARCH. 
* 
*         ENTRY  (MD) = SAST. 
*                (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
* 
*         EXIT   ADMIT ENTRY WRITTEN TO BUFFER. 
* 
*         USES   CM - CM+4, EC, KA, RI - RI+1.
* 
*         CALLS  AUS, EOI, ERR, WDB.
* 
*         MACROS ERROR, LDA, MMOVE. 
  
  
 SAS      SUBR               ENTRY/EXIT 
          LDM    PAUN 
          ZJN    SAS1        IF USER = ALTERNATE USER 
          LDD    MA          SWAP USERNAMES 
          CWM    PBUN,ON
          CWM    PAUN,ON
          LDD    MA 
          CRM    PAUN,ON
          CRM    PBUN,ON
 SAS1     RJM    FTC         FIND TAPE CATALOG
          ZJN    SAS2        IF CATALOG FOUND 
          ERROR              CALL ERROR PROCESSING (NO RETURN)
  
 SAS2     LDM    CBAE,BP     SET FIRST ADMIT BLOCK ADDRESS
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    CBAE+1,BP
          STD    RI+1 
          NJN    SAS4        IF ADMIT BLOCK ASSIGNED
 SAS3     MMOVE  PAUN,,PBUN,,UNKL 
          ERROR  UNF         *(USERNAME) NOT FOUND.*
  
 SAS4     LDC    PAUN        SET SEARCH KEY 
          STD    KA 
          RJM    AUS         ALTERNATE USERNAME SEARCH
          NJN    SAS3        IF ALTERNATE USER NOT FOUND
          RJM    WDB         WRITE DATA TO BUFFER 
          RJM    EOI         SET END OF INFORMATION 
          LDN    ZERL 
          CRD    CM 
          LDD    IN          CURRENT POSITION OF IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    2
          CWD    CM 
          LJM    SASX        RETURN 
 SCS      SPACE  4,10 
**        SCS - SELECTIVE CATALOG SEARCH. 
* 
*         ENTRY  (MD) = SCST. 
*                (FT - FT+1) = FIRST. 
*                (IN - IN+1) = IN.
*                (OT - OT+1) = OUT. 
*                (LM - LM+1) = LIMIT. 
* 
*         USES   BA, CI, CM - CM+4, KA, RI - RI+1.
* 
*         CALLS  EOI, GIB, PTC, SCB, UIS, VIS, VUB. 
* 
*         MACROS ERROR, LDA.
  
  
 SCS      SUBR               ENTRY/EXIT 
          LDC    PESN 
          STD    KA 
          LDI    KA 
          NJN    SCS2        IF VSN SEARCH
          LJM    SCS9        SEARCH BY USERNAME/FILE NAME 
  
 SCS1     ERROR  VNF         *(VSN) NOT FOUND.* 
  
 SCS2     LDD    CA          CHECK AUDIT CONTINUATION 
          NJP    SCS6        IF AUDIT CONTINUATION
 SCS2.1   RJM    VIS         VSN INDEX SEARCH 
          NJN    SCS1        IF VSN NOT FOUND 
          LDD    FC 
          LMN    SSJF 
          ZJN    SCS4        IF *TFSP* CALL 
          LDM    VBRD+1,BP
 SCS3     NJN    SCS1        IF CONDITIONALLY RELEASED
 SCS4     LDM    VBRC,BP     CHECK REEL COUNT 
          SHN    -6 
          SBN    1
          ZJN    SCS4.1      IF FIRST REEL
          MMOVE  VBFV,BP,SCSA,,6  SET FIRST VSN FOR SEARCH
          LDC    SCSA 
          STD    KA 
          UJN    SCS2.1      VSN INDEX SEARCH 
  
 SCS4.1   LDM    VBCI,BP     SET CATALOG ADDRESS
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    VBCI+1,BP
          ZJP    SCS1        IF NOT ASSIGNED
 SCS5     STD    RI+1        SET RANDOM ADDRESS 
          SHN    -14
          STD    RI 
          LDC    BUF2        SET CATALOG BUFFER 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK
          RJM    VUB         VERIFY USERS DATA BLOCK
          NJP    SCS3        IF NOT USERS DATA BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTERS
 SCS6     RJM    PTC         PROCESS TAPE CATALOG 
          MJN    SCS8        IF BUFFER FULL 
          LDM    CBNC,BP     CHECK FOR MULTI-FILE 
          ZJN    SCS7        IF NOT MULTI-FILE
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    CBNC+1,BP
          NJN    SCS5        IF NOT END OF SET
 SCS7     RJM    EOI         SET END OF INFORMATION 
          LDN    ZERL        CLEAR CONTINUATION WORD
          CRD    CM 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWD    CM 
 SCS8     LJM    SCSX        RETURN 
  
 SCS9     LDC    PBUN        FILE IDENTIFIER SEARCH 
          STD    KA 
          RJM    UIS         USERNAME INDEX SEARCH
          ZJN    SCS11       IF USERNAME FOUND
 SCS10    ERROR  FNF         *(FILENAME) NOT FOUND.*
  
 SCS11    LDC    BUF2        SET CATALOG BUFFER 
          STD    BA 
          LDM    UBCI,BP     SET CATALOG RANDOM INDEX 
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    UBCI+1,BP
          STD    RI+1 
          ZJN    SCS10       IF NO RANDOM ADDRESS 
          LDC    POFI        SET SEARCH KEY ADDRESS 
          STD    KA 
          RJM    SCB         SEARCH CATALOG BUFFER
          ZJN    SCS10       IF FILE NOT FOUND
          MJN    SCS10       IF FILE NOT FOUND
          RJM    VUB         VALIDATE USERS CATALOG BLOCK 
          ZJN    SCS12       IF CORRECT USER
          ERROR  EID         *ERROR IN INDEX DATA.* 
  
 SCS12    RJM    PTC         PROCESS TAPE CATALOG 
          LJM    SCS7        SET END OF INFORMATION 
  
 SCSA     BSSZ   5           FIRST VSN
 WDB      SPACE  4,10 
**        WDB - WRITE DATA TO BUFFER. 
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
*                (BP) = BUFFER POINTER. 
*                (CWEL+(BA)) = ENTRY LENGTH.
*                (IN - IN+1) = CURRENT BUFFER POSITION. 
* 
*         EXIT   (IN - IN+1) ADVANCED.
*                DATA WRITTEN TO CIRCULAR BUFFER AND
*                FET UPDATED. 
* 
*         USES   T1.
* 
*         CALLS  WBB. 
  
  
 WDB      SUBR               ENTRY/EXIT 
          LDM    CWEL,BA     WRITE DATA TO BUFFER 
          STD    T1 
          LDD    BP 
          RJM    WBB         WRITE BINARY BUFFER
          UJN    WDBX        RETURN 
  
          SPACE  4
***       COMMON DECKS. 
  
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 EOI$     EQU    1           DEFINE EOI - SET END OF INFORMATION
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 VRR$     EQU    1           DEFINE VRR - VERIFY RANDOM REQUEST 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USERS CATALOG/ADMIT BLO
*CALL     COMPCIB 
*CALL     COMPSAF 
*CALL     COMPTFM 
*CALL     COMPWBB 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,15 
**        PRS - PRESET FOR *AUD* AND *GVS*. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (A) = ABSOLUTE FET ADDRESS.
*                (WC) = WORD COUNT. 
* 
*         USES   WC.
* 
*         CALLS  CIB, SBP.
* 
*         MACROS LDA, ERROR.
  
  
 PRS1     LDA    IR+3,REL    LOAD ABSOLUTE FET ADDRESS
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    CIB         CHECK INPUT BUFFER 
          STD    WC 
          LDC    TSVL*60D+TCEL+1
          SBD    WC 
          MJN    PRS1        IF BUFFER SIZE VALID 
          ZJN    PRS1        IF BUFFER SIZE VALID 
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
          SPACE  4
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (AMEND CATALOG ENTRY / RESERVE TAPE FILES.),OVL1
          SPACE  4
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 JS       EQU    S2 - S2+4   JOB SEQUENCE WORD *UJID* (5 LOCATIONS) 
 FA       EQU    S3          FNT ORDINAL
 AMDS     SPACE  4,10 
***       AMDS - AMEND TAPE CATALOG ENTRY.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  60/ 0 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ OLD FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/0. 
*T,  +14  60/ NEW FILE IDENTIFIER 
*T,  +15  42/ NFI (CONT.),6/ 0,6/ CE,6/ AN
*T,  +16  42/ ALT. USERNAME,18/ 0 
*T,  +17  42/ PASSWORD,6/ AC,6/ CT,6/ MD
* 
*         USES   EC.
* 
*         CALLS  CAC, CCT, CFM, CPN, ERR, FTC, IRM, 
*                NFI, PWD, UCW, VUB, WRP. 
* 
*         MACROS MMOVE, RESTP.
  
  
 AMD      ENTRY              AMEND TAPE CATALOG ENTRY 
          RJM    FTC         FIND TAPE CATALOG
          ZJN    AMD2        IF FILE FOUND
 AMD1     ERROR 
  
 AMD2     LDM    PESN 
          ZJN    AMD4        IF SYMBOLIC FILE 
          RESTP  CPSI        CHECK FOR FIRST VSN
          LDM    VBRC,BP     CHECK FOR FIRST REEL 
          SHN    -6 
          ZJN    AMD3        IF NO REEL COUNT, ASSUME FIRST 
          SBN    1
          ZJN    AMD3        IF FIRST OF SET
          LDN    /EMSG/ILR   *TFM INCORRECT REQUEST.* 
          UJN    AMD1        SET ERROR CODE 
  
 AMD3     RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
 AMD4     RJM    CPN         CHANGE CHARGE AND PROJECT
          RJM    NFI         CHANGE NEW FILENAME
          RJM    CAC         CHANGE ALTERNATE CATALOG LIST ATTRIBUTE
          RJM    PWD         CHANGE PASSWORD
          RJM    CCT         CHANGE CATEGORY TYPE 
          RJM    CFM         CHANGE FILE MODE 
          RJM    UCW         CHANGE USER CONTROL WORD 
          RJM    CEF         CLEAR ERROR FLAG 
          RJM    WRP         WRITE RANDOM PRU 
          LDM    CBST,BP
          SHN    21-10
          MJN    AMD5        IF *TMS* RECOVERY MESSAGES ALREADY SET 
          MMOVE  CBES,BP,PESN,,VSKL 
          RJM    IRM         ISSUE RECOVERY MESSAGES
 AMD5     BSS    0
          LJM    AMDX        RETURN 
 RSVS     SPACE  4,10 
***       RSVS - RESERVE TAPE FILES.
* 
*         THIS FUNCTION IS CALLED AS A RA+1 REQUEST 
*         FROM *TFILES* OR BY A USER MACRO CALL. IT 
*         SETS THE RESERVE FILES FLAG IN THE UDT
*         ENTRY IN MAGNETS FL, AND CAN MODIFY 
*         SOME CATALOG PARAMETERS AS OPTIONS SPECIFY
*         FROM THE FET. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  60/ 0 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/0. 
*T,  +14  60/ 0 
*T,  +15  42/ 0,6/ 0,6/ CE,6/AN 
*T,  +16  42/ ALT. USERNAME,18/ 0 
*T,  +17  42/ PASSWORD,6/ AC,6/ CT,6/ MD
* 
* 
*         EXIT   TAPE CATALOG UPDATED.
* 
*         USES   BA, BP, CI, FN - FN+4, JS - JS+4,
*                RB, RI - RI+1, RO, RP. 
* 
*         CALLS  CAC, CCT, CFM, PWD, RRP, 
*                UCW, VSP, VUB, WRP.
* 
*         MACROS ERROR, LDA.
  
  
 RSV      ENTRY              RESERVE FUNCTION 
          LDA    IR+3,REL    SET FILE NAME
          CRD    FN 
          LDN    0           NO INITIAL SEARCH ADDRESS
          RJM    SAF         SEARCH FOR ASSIGNED FILE 
          NJN    RSV1        IF FILE FOUND
          ERROR  LNF         *(LFN) NOT FOUND.* 
  
 RSV1     NFA    FA,R 
          ADN    FSTL 
          CRD    FS          GET FST/EST ENTRIES
          SFA    EST,FS 
          CRD    CM 
          LDD    CM+3        VALIDATE MT/NT EQUIPMENT 
          LMC    2RMT 
          ZJN    RSV2        IF 7 TRACK TAPE
          LMC    2RNT&2RMT
          ZJN    RSV2        IF 9 TRACK TAPE
          LMC    2RCT&2RNT
          ZJN    RSV2        IF CTS CARTRIDGE TAPE
          LMC    2RAT&2RCT
          ZJN    RSV2        IF ACS CARTRIDGE TAPE
          ERROR  NMT         *(LFN) NOT ON MAGNETIC TAPE.*
  
 RSV2     LDD    FS+1        SET UDT ADDRESS
          STM    UDTA 
          LDD    CP          VALIDATE JOB ASSIGNMENT
          ADN    TFSW 
          CRD    JS 
          UDTRD  CM,/MTX/UVRI,1 
          LDD    CM 
          LMD    JS 
          NJP    RSV3        IF NOT ASSIGNED
          UDTRD  CM,/MTX/UTMS,1 
          LDD    CM+4 
          SHN    21-13
          PJN    RSV3        IF NOT TMS CONTROLLED FILE 
          LDD    CM+4        SET RESERVE SCRATCH STATUS 
          LPC    -RSRS
          LMC    RSRS 
          STD    CM+4 
          UDTWT  CM,/MTX/UTMS,1 
          UDTRD  CM,/MTX/UTCI,1 
          LDD    CM+3        SET CATALOG ADDRESS
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CM+4 
          NJN    RSV4        IF CATALOG ADDRESS 
 RSV3     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 RSV4     STD    RI+1        SET RANDOM ADDRESS 
          SHN    -14
          STD    RI 
          LDC    BUF0 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK (CATALOG)
          RJM    VUB         VERIFY USERS CATALOG BLOCK 
          NJN    RSV3        IF NOT USERS BLOCK 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    RSV3        IF POINTERS INCORRECT
          RJM    CAC         CHANGE ALTERNATE CATALOG LIST ATTRIBUTE
          RJM    PWD         CHANGE PASSWORD
          RJM    CCT         CHANGE CATEGORY TYPE 
          RJM    CFM         CHANGE FILE MODE 
          RJM    UCW         CHANGE USER CONTROL WORD 
          RJM    WRP         WRITE RANDOM PRU 
          LJM    RSVX        RETURN 
          TITLE  SUBROUTINES. 
 CAC      SPACE  4,10 
**        CAC - CHANGE ALTERNATE CATALOG LIST ATTRIBUTE 
* 
*         ENTRY  (PBAC) = ALTERNATE LIST ATTRIBUTE. 
* 
*         EXIT   LIST ATTRIBUTE CHANGED.
*                TO ERROR PROCESSING IF INCORRECT OPTION. 
* 
*         USES   T1.
* 
*         MACROS ERROR. 
  
  
 CAC1     LDM    CBST,BP     CHANGE CATALOG LIST ATTRIBUTE
          SHN    0-13+22
          SCN    1
          LMD    T1 
          LMN    1
          SHN    13-0 
          STM    CBST,BP
  
 CAC      SUBR               ENTRY/EXIT 
          LDM    PBAC 
          LPN    77 
          ZJN    CACX        IF ATTRIBUTE NOT SPECIFIED 
          SBN    FAYS 
          STD    T1 
          SBN    FANO 
          MJN    CAC1        IF VALID ATTRIBUTE 
          ERROR  ILR         *TFM INCORRECT REQUEST.* 
 CCT      SPACE  4,10 
**        CCT - CHANGE CATEGORY TYPE. 
* 
*         ENTRY  (PBCT) = FILE CATEGORY.
* 
*         EXIT   FILE CATEGORY CHANGED AS REQUIRED. 
*                TO ERROR PROCESSING IF INCORRECT OPTION. 
* 
*         USES   T1.
* 
*         MACROS ERROR. 
  
  
 CCT1     LDM    CBCT,BP     CHANGE FILE CATEGORY 
          LPN    77 
          LMD    T1 
          STM    CBCT,BP
  
 CCT      SUBR               ENTRY/EXIT 
          LDM    PBCT 
          SCN    77 
          ZJN    CCTX        IF CATEGORY NOT SPECIFIED
          STD    T1 
          SHN    -6 
          SBN    FCMX 
          MJN    CCT1        IF VALID CATEGORY TYPE 
          ERROR  ILR         *TFM INCORRECT REQUEST.* 
 CEF      SPACE  4,10 
**        CEF - CLEAR ERROR FLAG. 
* 
*         ENTRY  (PBCE) = CLEAR ERROR FLAG. 
* 
*         EXIT   IF (PBCE) IS NON-ZERO, THE ERROR FLAG
*                IS CLEARED IN THE CATALOG STATUS WORD. 
  
 CEF      SUBR               ENTRY/EXIT 
          LDM    PBCE 
          SHN    -6 
          ZJN    CEFX        IF NOT CLEAR ERROR 
          LDM    CBST,BP
          SCN    2
          STM    CBST,BP
          UJN    CEFX        RETURN 
 CFM      SPACE  4,10 
**        CFM - CHANGE FILE MODE. 
* 
*         ENTRY  (PBMD) = ALTERNATE ACCESS MODE.
* 
*         EXIT   ACCESS MODE CHANGED AS REQUIRED. 
*                TO ERROR PROCESSING IF INCORRECT OPTION. 
* 
*         USES   T1.
* 
*         MACROS ERROR. 
  
  
 CFM1     LDM    CBCT,BP     CHANGE FILE MODE 
          SCN    77 
          LMD    T1 
          STM    CBCT,BP
  
 CFM      SUBR               ENTRY/EXIT 
          LDM    PBMD 
          LPN    77 
          ZJN    CFMX        IF MODE NOT SPECIFIED
          STD    T1 
          SBN    FMMX 
          MJN    CFM1        IF VALID FILE MODE 
          ERROR  ILR         *TFM INCORRECT REQUEST.* 
 CPN      SPACE  4,10 
**        CPN - CHANGE CHARGE AND PROJECT.
* 
*         ENTRY  (PBAN) = ACCOUNT NUMBER CHANGE.
* 
*         EXIT   CHARGE AND PROJECT NUMBERS CHANGED.
* 
*         MACROS MMOVE. 
  
  
 CPN      SUBR               ENTRY/EXIT 
          LDM    PBAN 
          LPN    77 
          ZJN    CPNX        IF NOT ACCOUNT NUMBER CHANGE 
          LDN    2
          STD    T1 
          LIA    CBCN,BP
          STM    CPNA 
          LIA    CBPN,BP
          STM    CPNB 
          NFA    CHGN 
          CRM    **,ON
 CPNA     EQU    *-1
          NFA    PJ1N 
          CRM    **,T1
 CPNB     EQU    *-1
          UJN    CPNX        RETURN 
 NFI      SPACE  4,10 
**        NFI - CHANGE NEW FILE NAME. 
* 
*         ENTRY  (PNFI - PNFI+10B) = NEW FILE NAME. 
* 
*         EXIT   LOGICAL FILE NAME CHANGED. 
* 
*         USES   T1.
* 
*         MACROS MMOVE. 
  
  
 NFI      SUBR               ENTRY/EXIT 
          LDC    PNFI 
          STD    T1 
          LDI    T1 
          ZJN    NFIX        IF NEW FILENAME NOT SPECIFIED
          MMOVE  ,,CBLI,BP,FIKL 
          UJN    NFIX        RETURN 
 PWD      SPACE  4,10 
**        PWD - CHANGE PASSWORD.
* 
*         ENTRY  (PPWD - PPWD+3) = FILE PASSWORD. 
* 
*         EXIT   FILE PASSWORD CHANGED. 
* 
*         USES   T1.
* 
*         MACROS CLEAR, MMOVE.
  
  
 PWD      SUBR               ENTRY/EXIT 
          LDC    PPWD 
          STD    T1 
          LDI    T1 
          ZJN    PWDX        IF PASSWORD NOT SPECIFIED
          LMC    7777 
          NJN    PWD1        IF NOT CLEAR PASSWORD
          CLEAR  ,,PWKL 
 PWD1     MMOVE  PPWD,,CBPW,BP,PWKL 
          UJN    PWDX        RETURN 
 UCW      SPACE  4,10 
**        UCW - CHANGE USER CONTROL WORD .
* 
*         ENTRY  (PUCW - PUCW+4) = USER CONTROL WORD. 
* 
*         EXIT   USER CONTROL WORD UPDATED. 
* 
*         USES   T1.
* 
*         MACROS CLEAR, MMOVE.
  
  
 UCW      SUBR               ENTRY/EXIT 
          LDC    PUCW 
          STD    T1 
          LDI    T1 
          ZJN    UCWX        IF CONTROL WORD NOT SPECIFIED
          LMC    7777 
          NJN    UCW1        IF NOT CLEAR CONTROL WORD
          CLEAR  ,,UCKL 
 UCW1     MMOVE  PUCW,,CBUC,BP,UCKL 
          UJN    UCWX        RETURN 
          SPACE  4
***       COMMON DECKS. 
  
  
 AMD$     EQU    1           DEFINE AMD - AMEND PROCESSING
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 IRM$     EQU    1           DEFINE IRM - ISSUE RECOVERY MESSAGES.
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTER
 VUB$     EQU    1           DEFINE VUB - VALIDATE USERS BLOCK
*CALL     COMPC2D 
*CALL     COMPSAF 
*CALL     COMPTFM 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (*RESEX* ABORT PROCESSING / RELEASE TAPE FILE.),OVL1
          SPACE  4,10 
***       LOCAL DIRECT CELL LOCATIONS 
  
  
 CN       EQU    S2 - S2+4   SCRATCH
 RAPS     SPACE  4,10 
**        RAPS - *RESEX* ABORT PROCESSING.
* 
*         IF *RESEX* ABORTS AFTER *TFM* HAS ASSIGNED A
*         VSN, BUT BEFORE THE REQUEST IS SENT TO *MAGNET* 
*         TO ASSIGN A TAPE UNIT, THE TAPE CATALOG MUST
*         BE CLEANED UP BY THIS SUBFUNCTION.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST 
*T,   +1  15/0,1/ EP,27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  36/ 0,24/ RANDOM REQUEST
* 
*         EXIT   1. IF THE ABORTING REQUEST WAS FOR A 
*                   EXISTING FILE, THE JOB ASSIGNMENT 
*                   AND BUSY FLAGS ARE CLEARED. 
*                2. IF THE ABORTING REQUEST WAS FOR A 
*                   SCRATCH TAPE, THE CATALOG ENTRY 
*                   IS PURGED.
* 
*         USES   CM - CM+4, KA, RI - RI+1.
* 
*         CALLS  CVA, GIB, PCE, PRS, RSP, VIS, VSP, WRP.
* 
*         MACROS ERROR, MMOVE, RESTP. 
  
  
 RAP      ENTRY              ENTRY/EXIT 
          RJM    PRS         PRESET 
          ZJN    RAPX        IF NO CATALOG ENTRY
          RJM    GIB         GET INITIAL BLOCK
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          MJN    RAPX        IF INCORRECT POINTERS
          SAVEP  CPCB        SAVE BUFFER POINTERS (CATALOG) 
          LDC    PESN 
          STD    KA 
          MMOVE  CBES,BP,,KA,VSKL 
          LDI    KA 
          ZJN    RAP2        IF VOLUME NOT ASSIGNED 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    RAP1        IF VSN FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 RAP1     RESTP  CPCB        RESTORE BUFFER POINTERS (CATALOG)
          LDM    CBST,BP
          SHN    21-11
          PJN    RAP3        IF NOT INITIAL ASSIGNMENT
          RJM    RSP         RELEASE VSN(S) TO SCRATCH POOL 
 RAP2     RJM    PCE         PURGE CATALOG ENTRY
          LJM    RAPX        RETURN 
  
 RAP3     RESTP  CPSI        RESTORE BUFFER POINTERS (VSN INDEX)
          LDM    VBRC,BP     CHECK REEL NUMBER
          SHN    -6 
          SBN    2
          MJN    RAP4        IF FIRST REEL
          LDC    PESN        GET FIRST REEL 
          STD    KA 
          MMOVE  VBFV,BP,,KA,VSKL 
          RJM    VIS         VSN INDEX SEARCH 
 RAP4     BSS    0
          RJM    CVA         CLEAR VOLUME ASSIGNMENT
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          LJM    RAPX        RETURN 
 RLSS     SPACE  4,10 
***       RLSS - RELEASE TAPE FILE. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ 0
*T,   +2  60/ 0 
*T,   +3  60/ 0 
*T,   +4  12/ FNT,30/ 0,18/ 0 
*T,   +5  42/ 0,18/ EADD
*T,   +6  60/ 0 
*T,   +7  36/ VSN,24/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ FILE IDENTIFIER 
*T,  +13  42/ FID (CONT.),18/0. 
* 
*         USES   EC.
* 
*         CALLS  ERR, FTC, PCE, RSP, VIS. 
* 
*         MACROS ERROR, LIA, MMOVE, RESTP.
  
  
 RLS      ENTRY              RELEASE TAPE FILE
          RJM    ISP         INITIALIZE SCRATCH PROCESSOR 
          RJM    FTC         FIND TAPE CATALOG
          ZJN    RLS1        IF CATALOG FOUND 
          RJM    ERR         CALL ERROR PROCESSING (NO RETURN)
  
 RLS1     LDM    PESN 
          ZJN    RLS2        IF SYMBOLIC ACCESS 
          RESTP  CPSI        RESTORE VSN INDEX POINTERS 
          LJM    RLS3        CHECK FOR FIRST REEL 
  
 RLS2     LIA    CBES,BP     SET FIRST VSN
          STD    KA 
          MMOVE  ,KA,PESN,,VSKL 
          LDA    CBQN,BP     CHECK FOR FIRST FILE IN SET
          SBN    2
          PJP    RLS5        IF NOT FIRST FILE IN SET 
          LDI    KA 
          ZJP    RLS17       IF NO VSN
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    RLS3        IF VSN FOUND 
          ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
 RLS3     LDM    VBJS,BP     CHECK VOLUME BUSY
          NJN    RLS5        IF ASSIGNED TO A JOB 
          LDA    VBST,BP
          LPC    UOVS+TVVS
          ZJN    RLS4        IF ON SITE AND NOT USER-OWNED TAPE 
          LDD    FC          CHECK FOR TFSP CALL
          LMN    SSJF 
          NJN    RLS5        IF NOT *TFSP* CALL 
 RLS4     LDM    VBRC,BP     CHECK FOR FIRST REEL 
          SHN    -6 
          SBN    2
          MJN    RLS6        IF FIRST REEL
          STD    S1          SAVE ADJUSTED REEL COUNT 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          NJN    RLS5        IF NOT LOCAL FILE MODE 
          LJM    RLS19       CLEAR VSN POINTER AND RELEASE VSNS 
  
 RLS5     ERROR  ILR         *TFM INCORRECT REQUEST.* 
  
 RLS6     LDA    PBQN,ABS    CHECK FILE SEQUENCE NUMBER 
          SBN    2
          MJP    RLS11       IF FIRST CATALOG REQUESTED 
          STD    S1+1        SAVE ADJUSTED SEQUENCE NUMBER
          SHN    -14
          STD    S1 
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          NJN    RLS5        IF NOT LOCAL FILE MODE 
          RESTP  CPCB 
  
*         *TFSP* CAN SPECIFY A FILE SEQUENCE NUMBER IN LOCAL FILE MODE
*         SO THAT PURGED CATALOG ENTRIES CAN BE DELETED WHEN RECOVERING 
*         THE FILE CATALOG FROM THE ACCOUNT FILE.  SKIP CATALOG ENTRIES 
*         FOR THIS VSN UNTIL THE ONE JUST BEFORE THE CATALOG ENTRY TO 
*         BE RELEASED.  NO VSN-S ARE RELEASED WHEN PURGING CATALOG
*         ENTRIES WHICH ARE NOT THE FIRST FOR A VSN.
  
 RLS7     LDA    S1,ABS      CHECK SKIP COUNT 
          ZJN    RLS10       IF LAST CATALOG ENTRY
          SBN    1           DECREMENT SKIP COUNT 
          STD    S1+1 
          SHN    -14
          STD    S1 
          LDM    CBNC,BP     LOAD NEXT CATALOG INDEX
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    CBNC+1,BP
 RLS8     ZJP    RLS5        IF SEQUENCE NUMBER OUT OF RANGE
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    RRP         GET NEXT CATALOG ENTRY 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          PJN    RLS7        IF NO ERROR
 RLS9     ERROR  ECD         ERROR IN CATALOG DATA
  
 RLS10    LDM    CBNC,BP     STORE NEXT CATALOG POINTER 
          STD    S1 
          LDM    CBNC+1,BP
          STD    S1+1 
          ADD    S1 
          ZJN    RLS8        IF SEQUENCE NUMBER OUT OF RANGE
          LDN    0           CLEAR NEXT CATALOG POINTER 
          STM    CBNC,BP
          STM    CBNC+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          LDD    S1 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    S1+1 
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    RRP         GET CATALOG ENTRY TO BE RELEASED 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJN    RLS9        IF ERROR IN CATALOG
          SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          LJM    RLS17       PURGE CATALOG ENTRIES
  
 RLS11    LDN    1           DEFAULT SEQUENCE NUMBER
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDM    TFMC 
          LPN    77 
          LMN    /PFM/PTLM
          ZJP    RLS16       IF LOCAL FILE MODE 
          LDD    FC          CHECK FOR *TFSP* CALL
          LMN    SSJF 
          ZJN    RLS12       IF *TFSP* CALL 
          LDN    CRDP 
 RLS12    ZJP    RLS15       IF ZERO CONDITIONAL RELEASE PERIOD 
          LDM    VBRD,BP     CLEAR RELEASE YEAR 
          SCN    77 
          STM    VBRD,BP
          LDN    /COMSCPS/RIDS  INCREMENT CURRENT DATE BY CRDP
          STD    CM+1 
          LDN    CRDP 
          STD    CM+4 
          MONITOR  RDCM      REQUEST DATA CONVERSION
          LDD    MA          GET PACKED DATE
          CRD    CM 
          LDD    CM+3 
          LPN    77 
          RAM    VBRD,BP     SET YEAR 
          LDD    CM+4 
          STM    VBRD+1,BP   SET MONTH/DAY
          LDC    RDVS        SET RELEASE DATE NEW FORMAT FLAG 
          RAM    VBST+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPCB 
 RLS13    LDM    CBST,BP     CLEAR SYMBOLIC ACCESS FLAG 
          SCN    4
          STM    CBST,BP
          RJM    WRP         WRITE RANDOM PRU 
          LDM    CBNC,BP
          ZJN    RLS14       IF END OF MULTI-FILE SET 
          SHN    14          RESET RANDOM ADDRESS 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDM    CBNC+1,BP
          STM    CPCB+4 
          RESTP  CPCB 
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET POINTERS
          UJN    RLS13       CLEAR SYMBOLIC ACCESS
  
 RLS14    LDN    DTEL        READ CURRENT DATE
          CRD    CM 
          LDN    1           SET RELEASE
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
          UJN    RLS18       RETURN 
  
 RLS15    LDN    ZERL        FLAG UNCONDITIONAL RELEASE 
          CRD    CM 
          LDN    1           FLAG RELEASE 
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 RLS16    RJM    RSP         RELEASE VSNS TO SCRATCH POOL 
 RLS17    RJM    PCE         PURGE CATALOG ENTRIES
 RLS18    LJM    RLSX        RETURN 
  
*         IN LOCAL FILE MODE, *TFSP* CAN RELEASE A VSN THAT IS NOT
*         THE FIRST VSN OF A SET SO RECOVERY FROM THE ACCOUNT FILE
*         CAN RELEASE EXCESS VSN-S.  NOTE - IT DOES NOT CHECK TO
*         SEE IF ANY CATALOG ENTRIES EXIST THAT POINT TO THIS OR
*         FOLLOWING VSN ENTRIES.  NO CATALOG ENTRIES ARE RELEASED 
*         WHEN RELEASING VSN-S WHICH ARE NOT THE FIRST VSN. 
  
 RLS19    LDC    PVSN        SET VSN SAVE 
          STD    KA 
          MMOVE  VBFV,BP,,KA,VSKL  START AT FIRST VSN 
 RLS20    RJM    VIS         FIND NEXT VSN
          NJN    RLS21       IF NOT FOUND 
          MMOVE  VBNV,BP,,KA,VSKL  SET NEXT VSN 
          LDD    S1 
          ZJN    RLS22       IF AT LAST VSN 
          SOD    S1 
          LDI    KA          CHECK LINKAGE
          NJN    RLS20       IF LINKAGE CORRECT 
 RLS21    ERROR  EID         *ERROR IN INDEX DATA*
  
 RLS22    COMPARE  ,KA,PESN,,VSKL  VERIFY LINKAGE 
          NJN    RLS21       IF ERROR IN LINKAGE
          CLEAR  VBNV,BP,VSKL 
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          RJM    VIS         POSITION TO VSN TO RELEASE 
          RJM    RSP         RELEASE VSN(S) TO SCRATCH POOL 
          LJM    RLSX        RETURN 
          TITLE  SUBROUTINES. 
          SPACE  4
***       COMMON DECKS. 
  
  
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK DATA BLOCK 
 CVA$     EQU    1           DEFINE CVA - CLEAR VOLUME ASSIGNMENT 
 FTC$     EQU    1           DEFINE FTC - FIND TAPE CATALOG 
 IAM$     EQU    1           DEFINE IAM - ISSUE ACCOUNT FILE MESSAGE
 PCE$     EQU    1           DEFINE PCE - PURGE CATALOG ENTRIES 
 RSP$     EQU    1           DEFINE RSP - RETURN VSN(S) TO SCRATCH POOL 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
 VUB$     EQU    1           DEFINE VUB - VERIFY USERS BLOCK
*CALL     COMPC2D 
*CALL     COMPTFM 
          SPACE  4
***       BUFFER AREA.
  
  
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,15 
**        PRS - PRESET FOR FUNCTION RAPS. 
* 
*         EXIT   (A) = 0 IF NO CATALOG ASSIGNED.
*                (RI - RI+1) = CATALOG RANDOM INDEX.
*                (CI) = CATALOG INDEX.
*                (CN) = 0 IF CURRENT VSN = FIRST VSN
*                (CN +3 - CN+4) = CATALOG ENTRY RANDOM INDEX POINTERS.
* 
*         CALLS  ISP. 
* 
*         USES   CN - CN+4. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    ISP         INITIALIZE SCRATCH PROCESSOR 
          LDC    BUF2        PRESET CATALOG ADDRESS 
          STD    BA 
          LDA    IR+3,REL    READ CATALOG ADDRESS 
          ADN    TFRR 
          CRD    CN 
          LDD    CN+3 
          SHN    14 
          STD    CI 
          SCN    77 
          LMD    CN+4 
          STD    RI+1        SET RANDOM INDEX 
          SHN    -14
          STD    RI 
          ADD    RI+1        (A) .EQ. 0 IF NO INDEX 
          UJN    PRSX        RETURN 
  
  
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (RETURN TAPE FILES.),OVL1 
          SPACE  4,10 
***       LOCAL  DIRECT CELL LOCATIONS
  
  
 QN       EQU    S1+2 - S1+3 CURRENT FILE SEQUENCE NUMBER 
 IA       EQU    S1+4        INITIAL ASSIGNMENT FLAG
 NC       EQU    S2 - S2+1   NEXT CATALOG POINTER 
 RC       EQU    S2+2        REEL COUNT 
 RTFS     SPACE  4,20 
***       RTFS - RETURN TAPE FILES. 
* 
*         RTFS ISSUES ACCOUNT FILE MESSAGES FOR ANY SYMBOLIC TAPE 
*         FILES CREATED ON THIS TAPE SINCE IT WAS MOUNTED.  FOR ANY 
*         NON-USER OWNED TAPE, RTFS WILL AUTOMATICALLY RESERVE ANY
*         REEL EXTENSIONS AND AUTOMATICALLY RELEASE ANY RESERVED VSN-S
*         WHICH ARE PAST THE LAST REEL WRITTEN ON.
* 
*         ENTRY  NONE.
* 
*         EXIT   TAPE RELEASED. 
* 
*         USES   IA, NC - NC+1, QN - QN+1, RI - RI+1
* 
*         CALLS  CSN, IAM, IRM, PCE, PRS, RRP, RSP, RVU, SES, 
*                SFV, VSP, WRP. 
* 
*         MACROS CLEAR, ERROR, MMOVE, RESTP, SAVEP, UDTRD, UDTWT. 
  
  
 RTF27    CLEAR  PESN,,5*10D CLEAR TMS WORDS FROM UDT 
          UDTWT  PESN,/MTX/UTCI,5 
          CLEAR  UTMS,,10D   CLEAR UTMS WORD
  
 RTF      ENTRY              RETURN TAPE FILES
          RJM    PRS         PRESET 
          ZJP    RTF27       IF CATALOG ENTRY PRESENT 
          RJM    RRP         READ RANDOM PRU (CATALOG)
          MMOVE  CWUN,BA,PBUN,,UNKL 
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    RTF27       IF CATALOG ENTRY NOT FOUND 
          SAVEP  CPCB 
          LDM    UTMS+3      CHECK BLANK LABEL FLAG 
          LPN    WUBL 
          ZJN    RTF0.1      IF BLANK LABEL WRITTEN 
          LDM    UTMS+4      CHECK RESERVE FILE FLAG
          LPC    RSRS 
          ZJN    RTF1        IF NOT RESERVING FILES 
          LDM    CBST,BP     CHECK IF INITIAL ASSIGNMENT
          SHN    21-11
          MJN    RTF1        IF INITIAL ASSIGNMENT
  
*         LAST VSN NOT BLANK LABELED. 
*         VSN MUST BE RELEASED. 
          LDM    UTMS+2      CHECK REEL NUMBER
          SBN    1
          ZJN    RTF1        IF FIRST VOLUME
          STM    UTMS+2      SET LAST REEL WRITTEN ON 
  
 RTF0.1   LDM    UTMS+4      CHECK RESERVED FILE FLAG 
          LPC    RSRS 
          NJN    RTF2        IF RESERVING FILES 
          LDM    CBST,BP     CHECK FOR INITIAL ASSIGNMENT 
          SHN    21-11
          PJN    RTF2        IF NOT INITIAL ASSIGNMENT
 RTF1     RJM    RSP         RELEASE VSNS TO SCRATCH POOL 
          RJM    PCE         PURGE CATALOG ENTRIES
          LJM    RTF27       COMPLETE REQUEST 
  
*         RESERVE TAPE CATALOG ENTRIES AND VSN-S. 
  
 RTF2     SAVEP  RTFB        SAVE CATALOG BUFFER POINTERS 
          LDN    0           CLEAR *IRM* FLAG 
          STM    RTFC 
          AOD    QN+1        CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          SHN    -14
          RAD    QN 
          SHN    14 
          ADD    QN+1 
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDM    CBST,BP     CHECK SCRATCH STATUS 
          SHN    0-11 
          LPN    1
          LMN    1
          STD    IA          SET INITIAL ASSIGNMENT FLAG
          NJN    RTF3        IF NOT INITIAL ASSIGNMENT
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
          LDM    CBST,BP
          SHN    -10
          LPN    1
          STM    RTFC 
          RESTP  CPSI        RESTORE SECONDARY INDEX POINTERS 
          RJM    SES         SET EOI VOLUME STATUS
          RJM    RVU         RESERVE VSN TO USER
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
 RTF3     LDM    CBST,BP     CHECK IF PHYSICAL CHARACTERISTIC UPDATE
          SHN    21-12
          MJN    RTF4        IF RECOVERED FILE
          LDM    UTMS+2 
          ZJN    RTF7        IF NO WRITE
 RTF4     LDM    PFTD        COPY TAPE DESCRIPTORS FROM UDT 
          LMM    CBTD,BP
          ZJN    RTF5        IF NO CHANGES MADE TO TAPE DESCRIPTORS 
          AOM    RTFC        FLAG CHANGES MADE
 RTF5     LDM    PFTD+2 
          LMM    CBTD+2,BP
          ZJN    RTF6        IF NO CHANGES MADE TO TAPE DESCRIPTORS 
          AOM    RTFC        FLAG CHANGES MADE
 RTF6     LDM    PFTD 
          STM    CBTD,BP
          LDM    PFTD+2 
          STM    CBTD+2,BP
 RTF7     LDM    CBST,BP     CLEAR FILE BUSY
          LPC    -3001
          STM    CBST,BP
          LDC    ** 
 RTFC     EQU    *-1
          ZJN    RTF8        IF *TMS* RECOVERY MESSAGES NOT NEEDED
          RJM    IRM         ISSUE RECOVERY MESSAGES
 RTF8     LDM    CBNC,BP     SAVE NEXT CATALOG POINTER
          STD    NC 
          LDM    CBNC+1,BP
          STD    NC+1 
          LDM    UTMS+2 
          ZJN    RTF9        IF NO WRITE
          LDM    PBQN 
          LPN    77 
          LMD    QN 
          NJN    RTF9        IF NOT LAST CATALOG
          LDM    PBQN+1 
          LMD    QN+1 
          NJN    RTF9        IF NOT LAST CATALOG
          STM    CBNC,BP
          STM    CBNC+1,BP
 RTF9     LDM    CBNC,BP     CHECK IF WRITE REQUIRED
          LMD    RI 
          LPN    77 
          NJN    RTF10       IF WRITE REQUIRED
          LDM    CBNC+1,BP
          LMD    RI+1 
          NJN    RTF10       IF WRITE REQUIRED
          STM    RTFA        FLAG NO READ REQUIRED
          UJN    RTF11       LOAD POINTERS FOR NEXT CATALOG 
  
 RTF10    STM    RTFA        FLAG READ REQUIRED 
          RJM    WRP         WRITE RANDOM PRU 
 RTF11    LDD    NC          LOAD POINTERS TO NEXT CATALOG
          SHN    14 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDD    NC+1 
          STM    CPCB+4 
          LDM    CBNC,BP     CHECK FOR END OF SET 
          ZJP    RTF19       IF LAST FILE IN SET
          RESTP  CPCB 
          LDC    0           NO READ REQUIRED 
*         LDC    (RI)        READ REQUIRED
 RTFA     EQU    *-1
          ZJN    RTF12       IF NO READ REQUIRED
          RJM    RRP         READ CATALOG ENTRY 
 RTF12    RJM    VSP         VERIFY/SET CATALOG POINTER 
          PJN    RTF14       IF NO ERROR
 RTF13    ERROR  ECD         *ERROR IN CATALOG DATA.* 
  
*         RESERVE VOLUME TO USER. 
  
 RTF14    SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          LDM    CBES,BP
          ZJN    RTF13       IF NO FIRST VOLUME 
 RTF15    COMPARE  ,KA,CBES,BP,VSKL 
          ZJP    RTF2        IF SAME VSN
          RESTP  CPSI        RESTORE SECONDARY VSN INDEX POINTERS 
          MMOVE  VBNV,BP,,KA,VSKL 
          LDD    IA          CHECK FOR INITIAL ASSIGNMENT 
          ZJN    RTF16       IF INITIAL ASSIGNMENT
          LDM    VBST,BP
          LPN    RTVS/1S12
          NJN    RTF17       IF ALREADY RESERVED
 RTF16    LDD    QN          ENSURE SEQUENCE NUMBER PRESENCE
          SHN    14 
          ADD    QN+1 
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY 
          LDN    0           ISSUE RESERVE MESSAGE
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
          RJM    SES         SET EOI VOLUME STATUS
 RTF17    RJM    RVU         RESERVE/RELEASE VOLUME TO USER 
          LDI    KA 
          ZJN    RTF18       IF VSN NOT FOUND 
          RJM    SFV         SEARCH FOR VSN 
          NJN    RTF18       IF VSN NOT FOUND 
          RESTP  CPCB        RESTORE CATALOG BUFFER POINTERS
          LJM    RTF15       RESERVE FURTHER VOLUMES
  
 RTF18    ERROR  EID         ERROR IN INDEX DATA
  
*         RESERVE VSNS AT LAST CATALOG ENTRY. 
  
 RTF19    RESTP  CPSI 
          LDN    0           RESET REEL COUNT 
          STD    RC 
 RTF20    AOD    RC          INCREMENT REEL COUNT 
          LDM    VBST,BP
          LPN    RTVS/1S12
          NJN    RTF21       IF ALREADY RESERVED
          LDD    QN          ENSURE SEQUENCE NUMBER PRESENCE
          SHN    14 
          ADD    QN+1 
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY 
          LDN    0           ISSUE RESERVE MESSAGE
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 RTF21    RJM    SES         SET EOI STATUS 
          MMOVE  VBNV,BP,,KA,VSKL 
          LDM    VBST,BP
          SHN    21-0 
          MJN    RTF22       IF USER OWNED TAPE 
          SHN    21-2-21+0+22 
          PJN    RTF22       IF NOT EOI VOLUME
          CLEAR  VBNV,BP,VSKL 
 RTF22    RJM    RVU         RESERVE/RELEASE VOLUME TO USER 
          LDM    VBNV,BP
          ZJN    RTF23       IF END OF VSNS 
          RJM    SFV         SEARCH FOR VSN 
          ZJP    RTF20       IF VSN FOUND 
          LJM    RTF18       ERROR IN CATALOG DATA
  
*         RELEASE EXCESS CATALOGS 
  
 RTF23    RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          RESTP  RTFB        RESTORE CATALOG BUFFER POINTERS
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    RTF13       IF INCORRECT POINTERS
          LDD    RC          SET REEL COUNT IN CATALOG ENTRY
          STM    CBRC,BP
          RJM    WRP         WRITE RANDOM PRU 
          LDD    NC 
          ZJN    RTF24       IF LAST CATALOG
          SHN    14 
          STM    CPCB+2 
          SHN    -14
          STM    CPCB+3 
          LDD    NC+1 
          STM    CPCB+4 
          RESTP  CPCB 
          RJM    RRP         READ RANDOM PRU
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    RTF13       IF ERROR IN CATALOG DATA 
          SAVEP  CPCB        SAVE CATALOG POINTERS
          RJM    PCE         PURGE CATALOG ENTRIES
 RTF24    LDI    KA 
          ZJP    RTF26       IF NO VSNS TO RELEASE
          RESTP  CPSI        RESTORE SECONDARY POINTERS 
          RJM    SFV         SEARCH FOR VSN 
          NJP    RTF18       IF NOT FOUND 
          MMOVE  ,KA,PESN,,VSKL 
          LDM    VBST,BP     CHECK VSN RESERVATION STATUS 
          LPN    RTVS/1S12
          ZJN    RTF25       IF VSN NOT RESERVED
          LDN    1           CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDN    ZERL 
          CRD    CM 
          LDN    1           ISSUE RELEASE MESSAGE
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 RTF25    RJM    RSP         RELEASE VSNS TO SCRATCH POOL 
 RTF26    LJM    RTF27       COMPLETE REQUEST 
  
 RTFB     BSS    5           CATALOG BUFFER POINTERS
          TITLE  SUBROUTINES. 
 RVU      SPACE  4,10 
**        RVU - RESERVE VOLUME TO USER
* 
*         ENTRY  (BP) = BUFFER POINTER. 
* 
*         EXIT   VSN BUSY STATUS CLEARED. 
* 
*         CALLS  CVA. 
  
  
 RVU      SUBR               ENTRY/EXIT 
          LDM    VBJS,BP
          ZJN    RVUX        IF ALREADY RESERVED AND RELEASED 
          LDM    VBST,BP     SET RESERVED STATUS
          SCN    RTVS/1S12+ASVS/1S12
          LMN    RTVS/1S12
          STM    VBST,BP
          RJM    CVA         CLEAR VSN ASSIGNMENT 
          UJN    RVUX        RETURN 
 SES      SPACE  4,10 
**        SES - SET EOI STATUS. 
* 
*         ENTRY  (BP) = VSN BUFFER POINTER. 
*                (UTMS+2) = WRITE OCCURRED ON REEL. 
* 
*         EXIT   VSN EOI STATUS SET.
  
  
 SES      SUBR               ENTRY/EXIT 
          LDM    UTMS+2      CHECK FOR WRITE
          ZJN    SESX        IF NO WRITE OCCURRED 
          LDM    VBST,BP     CLEAR EOI STATUS 
          SCN    EOIV/1S12
          STM    VBST,BP
          LDM    VBRC,BP     COMPARE THIS REEL WITH LAST REEL WRITTEN 
          SHN    -6 
          SBM    UTMS+2 
          NJN    SESX        IF NOT EOI VOLUME
          LDN    EOIV/1S12
          RAM    VBST,BP
          UJN    SESX        RETURN 
 SFV      SPACE  4,10 
**        SFV - SEARCH FOR VSN
* 
*         ENTRY  (BA) = BUFFER ADDRESS. 
* 
*         EXIT   (A) = 0 IF VSN FOUND.
* 
*         USES   BP.
* 
*         CALLS  SIB, VIS, WRP. 
* 
*         MACROS SAVEP. 
  
  
 SFV1     SAVEP  CPSI        SAVE SECONDARY VSN INDEX POINTERS
          LDN    0           EXIT *VSN FOUND* 
  
 SFV      SUBR               ENTRY/EXIT 
          LDD    BA 
          ADN    2
          STD    BP 
          RJM    SIB         SEARCH INDEXED BUFFER (VSN)
          ZJN    SFV1        IF FOUND IN THIS BUFFER
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    SFV1        IF VSN FOUND 
          UJN    SFVX        RETURN 
          SPACE  4,10 
***       COMMON DECKS. 
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 CVA$     EQU    1           DEFINE CVA - CLEAR VSN ASSIGNMENT
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK DATA BLOCK 
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 GNL$     EQU    1           DEFINE GNL - GET NEXT BLOCK
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS BLOCK
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH WITH KEY 
 IAM$     EQU    1           DEFINE IAM - ISSUE ACCOUNT FILE MESSAGE
 IRM$     EQU    1           DEFINE IRM - ISSUE RECOVERY MESSAGES.
 PCE$     EQU    1           DEFINE PCE - PURGE CATALOG ENTRIES 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST ENTRY
 RSP$     EQU    1           DEFINE RSP - RELEASE VSNS TO SCRATCH POOL
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTER
*CALL     COMPC2D 
*CALL     COMPTFM 
          SPACE  4,10 
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          TITLE  PRESET.
 PRS      SPACE  4,15 
**        PRS - PRESET FOR FUNCTION RTFS. 
* 
*         EXIT   (A) = 0 IF NO CATALOG ENTRY. 
*                (PESN - PESN+3) = FIRST VSN. 
*                (PBQN - PBQN+1) = LAST FILE SEQUENCE NUMBER. 
*                (RI - RI+1) = FIRST CATALOG RANDOM INDEX.
*                (CI) = CATALOG ENTRY INDEX.
* 
*         USES   BA, CI, EC, KA, CM - CM+4, QN - QN+1, RI - RI+1. 
* 
*         CALLS  RRP, IAM, ISP, SIB, CSN, VIS, VSP. 
* 
*         MACROS LDA, MMOVE, UDTRD. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          RJM    ISP         INITIALIZE SCRATCH PROCESSOR 
          LDN    0           PRESET SEQUENCE NUMBER 
          STD    QN 
          STD    QN+1 
          LDC    PESN        READ FIRST VSN 
          STD    KA 
          RJM    VIS         VSN INDEXED SEARCH 
          NJN    PRS1        IF VSN NOT FOUND 
          LDM    VBRC,BP
          SHN    -6 
          SBN    2
          MJN    PRS2        IF FIRST VSN 
          MMOVE  VBFV,BP,,KA,VSKL 
          LDD    BA 
          ADN    2
          STD    BP 
          RJM    SIB         SEARCH FOR VSN IN BUFFER 
          ZJN    PRS2        IF FIRST VSN IN BUFFER 
          RJM    VIS         VSN INDEXED SEARCH 
          ZJN    PRS2        IF VSN FOUND 
 PRS1     LDN    0           NO CATALOG FOUND 
          LJM    PRSX        RETURN 
  
 PRS2     SAVEP  CPSI        SAVE SECONDARY VSN INDEX POINTERS
          RJM    TBA         TOGGLE BUFFER ALLOCATION 
          UDTRD  CM,/MTX/UTCI,1  READ CATALOG ENTRY 
          LDD    CM+3 
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          LDD    CM+4 
          STD    RI+1 
          RJM    RRP         GET INITIAL BLOCK (CATALOG)
          RJM    VSP         VERIFY/SET CATALOG POINTERS
          MJP    PRS1        IF ERROR IN CATALOG INDEX
          SAVEP  CPCB        SAVE CATALOG BUFFER POINTERS 
          LDM    PBQN        SET SEQUENCE NUMBER
          SCN    77 
          STM    PBQN 
          LDM    CBQN,BP
          LPN    77 
          RAM    PBQN 
          LDM    CBQN+1,BP
          STM    PBQN+1 
          LDM    UTMS+2 
          ZJN    PRS3        IF TAPE NOT WRITTEN TO 
          LDM    CBNC,BP
 PRS3     ZJP    PRS5        IF NO CATALOGS TO DELETE 
          SHN    14          POSITION TO NEXT CATALOG 
          STD    CI 
          SHN    -14
          LMD    RI 
          SHN    14 
          LMD    RI+1 
          LMM    CBNC+1,BP
          ZJN    PRS4        IF IN SAME PRU 
          LMD    RI+1 
          STD    RI+1 
          SHN    -14
          LMD    RI 
          STD    RI 
          RJM    RRP         READ RANDOM PRU
 PRS4     RJM    VSP         VERIFY/SET CATALOG POINTER 
          LDM    CBST,BP
          SHN    21-11
          MJN    PRS5        IF INITIAL CATALOG 
          LDA    CBQN,BP
          RJM    CSN         CONVERT SEQUENCE NUMBER TO DISPLAY CODE
          LDN    ZERL 
          CRD    CM 
          LDN    1
          RJM    IAM         ISSUE ACCOUNT FILE MESSAGE 
 PRS5     RESTP  CPSI        RESTORE SECONDARY VSN INDEX POINTERS 
          MMOVE  ,KA,PVSN,,VSKL  SET FIRST VSN
          LDC    PVSN 
          STD    KA 
          LDC    BUF2        SET CATALOG BUFFER ADDRESS 
          STD    BA 
          LDM    VBCI,BP     LOAD CATALOG INDEX 
          SHN    14 
          STD    CI 
          SCN    77 
          LMM    VBCI+1,BP
          STD    RI+1 
          SHN    -14
          STD    RI 
          ADD    RI+1 
          LJM    PRSX        RETURN 
          SPACE  4,10 
          ERRNG  BUF1-* 
          OVERLAY (DELETE/REPLACE/LIST VSN, INSERT USERNAME ENTRY.),OVL1
          SPACE  4
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 IL       EQU    S2+1        INTERLOCK FLAG 
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 DVES     SPACE  4,10 
***       DVES - DELETE VSN ENTRY(S). 
* 
*         THIS FUNCTION IS CALLED ONLY BY A SSJ= JOB
*         TO DELETE VSN ENTRIES FROM THE TAPE CATALOG.
*         ONLY UNASSIGNED VSN(S) CAN BE DELETED.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         ENTRY  (CO) = CATALOG FST ADDRESS.
* 
*         USES   KA, PB, T3.
* 
*         CALLS  COB, DDE, DLB, RBB, SBP, UOP, VIS, WRP.
* 
*         MACROS ERROR. 
  
  
 DVE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
 DVE1     RJM    COB         CHECK OUTPUT BUFFER
          PJN    DVE2        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 DVE2     ZJN    DVEX        IF BUFFER EMPTY
          LDN    1
          STD    T3 
          LDC    PESN 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
          RJM    VIS         VSN INDEX SEARCH 
          ZJN    DVE3        IF VSN FOUND 
          ERROR  VNF         *(VSN) NOT FOUND.* 
  
 DVE3     LDA    VBCI,BP     CHECK FOR ASSIGNED VSN 
          ZJN    DVE4        IF VSN NOT ASSIGNED
          ERROR  VSR         *(VSN) RESERVED.*
  
 DVE4     RJM    DDE         DELETE DATA ENTRY
          LDM    CWNE,BA
          NJN    DVE5        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    DVE5        IF PRIMARY INDEX NOT EMPTY 
          RJM    DLB         DELINK DATA BLOCK
          UJN    DVE6        UPDATE OUTPUT POINTER
  
 DVE5     RJM    WRP         WRITE RANDOM PRU 
 DVE6     RJM    UOP         UPDATE OUT POINTER 
          LJM    DVE1        PROCESS NEXT ENTRY 
 IUES     SPACE  4,10 
***       IUES - INSERT USERNAME ENTRY(S).
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   KA, PB, T3.
* 
*         CALLS  CCB, CIE, COB, RBB, RWI, SCP,
*                UIS, UOP.
* 
*         MARCOS ERROR. 
  
  
 IUE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
 IUE1     RJM    COB         CHECK OUTPUT BUFFER
          PJN    IUE2        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 IUE2     ZJN    IUEX        IF BUFFER EMPTY
          SBN    TSUL 
          MJN    IUEX        IF NOT ENTRY LENGTH
          LDN    TSUL 
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
 IUEA     UJN    IUE4        IF INITIAL CALL
          RJM    CCB         CHECK CURRENT BUFFER 
          ZJN    IUE6        IF INDEX FOUND 
          PJN    IUE3        IF BUFFERS LOADED
          UJN    IUE5        INITIATE INDEXED SEARCH
  
 IUE3     RJM    CIE         CREATE INDEX ENTRY 
          RJM    UOP         UPDATE OUT POINTER 
          LJM    IUE1        PROCESS NEXT ENTRY 
  
 IUE4     LDC    PSNI 
          STM    IUEA 
 IUE5     RJM    UIS         USERNAME INDEX SEARCH
          NJN    IUE3        IF USERNAME NOT FOUND
 IUE6     LJM    IUE1        PROCESS NEXT ENTRY 
 LVES     SPACE  4,10 
***       LVES - LIST VSN ENTRY(S). 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   CM - CM+4, IL, KA, PB. 
* 
*         CALLS  CCB, COB, RBB, RWI, SBP, UOP, VIS. 
* 
*         MACROS ERROR, LDA, MMOVE. 
  
  
 LVE11    LDD    IL          CHECK INTERLOCK FLAG 
          ZJN    LVE12       IF NOT INTERLOCK FUNCTION
          RJM    WRP         WRITE RANDOM PRU (VSN INDEX) 
 LVE12    LDN    ZERL        RESET IN POINTER 
          CRD    CM 
          LDD    FT 
          STD    CM+3 
          LDD    FT+1 
          STD    CM+4 
          LDA    IR+3,REL 
          ADN    2
          CWD    CM 
  
 LVE      ENTRY              ENTRY/EXIT 
          LDA    IR+3,REL    GET INTERLOCK FLAG 
          CRD    CM 
          LDD    CM+4 
          LPN    4
          STD    IL 
          RJM    SBP         SET FET BUFFER POINTERS
 LVE1     RJM    COB         CHECK OUTPUT BUFFER
          PJN    LVE2        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 LVE2     ZJN    LVE3        IF BUFFER EMPTY
          SBN    TSVL 
          PJN    LVE4        IF .GE. ENTRY LENGTH 
 LVE3     LJM    LVE11       FUNCTION COMPLETE
  
 LVE4     LDN    TSVL        PROCESS REQUEST
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
 LVEA     UJN    LVE5        IF INITIAL CALL
          RJM    CCB         CHECK CURRENT BUFFER 
          ZJN    LVE9        IF INDEX FOUND 
          PJN    LVE7        IF BUFFERS LOADED
          LDD    IL          CHECK INTERLOCK FLAG 
          ZJN    LVE6        IF NOT INTERLOCK FUNCTION
          RJM    WRP         WRITE RANDOM PRU (SECONDARY) 
          UJN    LVE6        INITIATE INDEXED SEARCH
  
 LVE5     LDC    PSNI 
          STM    LVEA 
 LVE6     RJM    VIS         VSN INDEX SEARCH 
          ZJN    LVE9        IF VSN FOUND 
 LVE7     MMOVE  ,KA,PESN,,VSKL 
          LDD    IL 
          ZJN    LVE8        IF NOT INTERLOCK FUNCTION
          RJM    WRP         WRITE RANDOM PRU (SECONDARY) 
 LVE8     ERROR  VNF         *(VSN) NOT FOUND.* 
  
 LVE9     MMOVE  ,BP,BUFA,,TSVL*10D 
          LDD    IL          CHECK INTERLOCK FLAG 
          ZJN    LVE10       IF NOT INTERLOCK FUNCTION
          LDM    VBST+1,BP   SET VSN INTERLOCK
          SCN    VIVS 
          LMN    VIVS 
          STM    VBST+1,BP
          LDM    VBMX,BP     SET INTERLOCK MACHINE INDEX-1
          SCN    17 
          LMM    CDMX 
          STM    VBMX,BP
 LVE10    LDN    TSVL        RETURN VSN ENTRY TO BUFFER 
          STD    T1 
          LDA    IR+3,REL 
          ADN    3
          CRD    CM 
          LDA    CM+3,REL 
          CWM    BUFA,T1
          RJM    UOP         UPDATE OUT POINTER 
          LJM    LVE1        PROCESS NEXT ENTRY 
 RAVS     SPACE  4,10 
***       RAVS - REPLACE/ADD VSN. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   IL, KA, PB, T3.
* 
*         CALLS  CCB, CIE, COB, RBB, RWI, SBP,
*                UOP, VIS.
* 
*         MACROS ERROR, LDA, MMOVE. 
  
  
 RAV      ENTRY              ENTRY/EXIT 
          LDN    1
          STD    IL 
          RJM    SBP         SET FET BUFFER POINTERS
 RAV1     RJM    COB         CHECK OUTPUT BUFFER
          PJN    RAV2        IF NO ERROR
          ERROR  BAE         BUFFER ARGUMENT ERROR
  
 RAV2     ZJN    RAVX        IF BUFFER EMPTY
          SBN    TSVL 
          MJN    RAVX        IF NOT ENTRY LENGTH
          LDN    TSVL 
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
 RAVA     UJN    RAV4        IF INITIAL PASS
          RJM    CCB         CHECK CURRENT BUFFER 
          ZJN    RAV3        IF VSN FOUND 
          PJN    RAV6        IF BUFFERS LOADED
          UJN    RAV5        INITIATE INDEXED SEARCH
  
 RAV3     MMOVE  BUFA,,,BP,TSVL*10D 
          LDC    WRP         SET TO UPDATE EXISTING ENTRY 
          UJN    RAV7        REWRITE INDEX
  
 RAV4     LDC    PSNI 
          STM    RAVA 
 RAV5     RJM    VIS         VSN INDEX SEARCH 
          ZJN    RAV3        IF VSN FOUND 
 RAV6     LDC    CIE         SET TO CREATE NEW INDEX
 RAV7     STM    RAVB        UPDATE/CREATE VSN INDEX
          RJM    **          (TO *WRP* IF UPDATING EXISTING INDEX)
 RAVB     EQU    *-1         (TO CIE IF CREATING NEW INDEX) 
          RJM    UOP         UPDATE OUT POINTER 
          LJM    RAV1        PROCESS NEXT ENTRY 
          TITLE  SUBROUTINES. 
          SPACE  4,10 
***       COMMON DECKS. 
  
  
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 CCB$     EQU    1           DEFINE CCB - CHECK CURRENT BUFFER
 CIE$     EQU    1           DEFINE CIE - CREATE INDEX ENTRY
 DDE$     EQU    1           DEFINE DDE - DELETE DATA ENTRY 
 DLB$     EQU    1           DEFINE DLB - DELINK DATA BLOCK 
 GNB$     EQU    1           DEFINE GNB - GET NEXT BLOCK
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 TBA$     EQU    1           DEFINE TBA - TOGGLE BUFFER ASSIGNMENT
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEXED SEARCH 
 UOP$     EQU    1           DEFINE UOP - UPDATE OUTPUT POINTER 
 VIS$     EQU    1           DEFINE VIS - VSN INDEXED SEARCH
*CALL     COMPCOB 
*CALL     COMPRBB 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
***       BUFFERS.
  
  
 BUFA     BSS    TSVL*5 
 BUFB     BSS    TSVL*5 
          SPACE  4
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
  
          OVERLAY (INSERT/REPLACE CATALOG ENTRY.),OVL1
          SPACE  4
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 ICES     SPACE  4,10 
***       ICES - INSERT CATALOG ENTRY.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
*T,   +7  60/ 0 
*T,  +10  60/ 0 
*T,  +11  60/ 0 
*T,  +12  60/ 0 
*T,  +13  60/ 0 
*T,  +14  60/ 0 
*T,  +15  60/ 0 
*T,  +16  60/ 0 
*T,  +17  42/ ALT. USERNAME,18/ 0 
* 
*         USES   BA, BP, CI, CM - CM+4, KA, PB, 
*                RI - RI+1, T3. 
* 
*         CALLS  ABC, COB, EDT, IBC, IRM, MBP, RBB, 
*                RRP, SBP, SCB, UIS, UOP, WRP.
* 
*         MACROS ERROR, LDA, MMOVE, SAVEP, RESTP. 
  
  
 ICE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    COB         CHECK OUTPUT BUFFER
          PJN    ICE1        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 ICE1     ZJN    ICEX        IF BUFFER EMPTY
          SBN    TCEL 
          MJN    ICEX        IF NOT ENTRY LENGTH
          LDA    IR+3,REL 
          ADN    TFUN 
          CRM    PBUN,ON
          LDC    PBUN 
          STD    KA 
          RJM    UIS         USERNAME INDEX SEARCH
          ZJN    ICE2        IF USER NAME FOUND 
          ERROR  UNF         *(USERNAME) NOT FOUND.*
  
 ICE2     LDN    TCEL        GET CATALOG IMAGE
          STD    T3 
          LDC    BUFA 
          STD    PB 
          RJM    RBB         READ BINARY BUFFER 
          LDC    BUF2        SET CATALOG BUFFER 
          STD    BA 
          LDM    UBCI,BP    SET FIRST CATALOG BLOCK 
          LPN    77 
          STD    RI 
          SHN    14 
          LMM    UBCI+1,BP
          STD    RI+1 
          ZJN    ICE4        IF NOT INDEX 
          LDM    BUFA+CBST
          LPN    4
          ZJN    ICE3        IF NOT SYMBOLIC
          MMOVE  BUFA+CBLI,,POFI,,FIKL
          LDC    POFI 
 ICE3     STD    KA          SET SEARCH TYPE
          RJM    SCB         SEARCH CATALOG BUFFER
          ZJP    ICE5        IF FILE NOT FOUND
          ERROR  FAR         *(FILENAME) ALREADY RESERVED.* 
  
 ICE4     LDC    BUF2        GENERATE USER CATALOG BLOCK
          STD    BA 
          RJM    IBC         INITIALIZE BLOCK CHAIN 
          SAVEP  CPCB        SAVE CATALOG POINTERS
          RESTP  CPSI        RESTORE INDEX POINTERS 
          LDM    UBCI,BP     SET USER CATALOG POINTER 
          SCN    77 
          LMM    CPCB+3 
          STM    UBCI,BP
          LDM    CPCB+4 
          STM    UBCI+1,BP
          RJM    WRP         WRITE RANDOM PRU 
          RESTP  CPCB        RESTORE CATALOG POINTERS 
          UJN    ICE7        ENTER CATALOG IMAGE
  
  
 ICE5     LDM    CPHP        CHECK IF HOLE FOUND
          ZJN    ICE6        IF HOLE NOT FOUND
          RESTP  CPHP        RESTORE HOLE POINTERS
          RJM    RRP         READ RANDOM PRU
          UJN    ICE8        MOVE CATALOG IMAGE 
  
 ICE6     LDN    CWRI        EXTEND CATALOG FILE
          RJM    ABC         ADD BLOCK TO CHAIN 
 ICE7     LDC    RTCB*100    SET RECORD TYPE/LEVEL
          STM    CWRT,BA
          LDN    TCEL 
          STM    CWEL,BA
          MMOVE  PBUN,,CWUN,BA,UNKL 
          LDM    CWFE,BA
          RJM    MBP         MOVE BUFFER POINTER
          LDN    1
          STD    CI 
 ICE8     MMOVE  BUFA,,,BP,TCEL*10D 
          LDM    CWUW,BA
          SBN    TCEL 
          STM    CWUW,BA
          AOM    CWNE,BA
          MMOVE  CBES,BP,PESN,,VSKL 
          RJM    IRM         ISSUE RECOVERY MESSAGES
          RJM    WRP         WRITE RANDOM PRU 
          RJM    UOP         UPDATE OUT POINTER 
          LDN    ZERL 
          CRD    CM 
          LDD    CI 
          SHN    6
          LMD    RI 
          STD    CM 
          LDD    RI+1 
          STD    CM+1 
          LDA    IR+3,REL 
          ADN    TFRR 
          CWD    CM 
          LJM    ICEX        RETURN 
 RCES     SPACE  4,10 
***       RCES - REPLACE CATALOG ENTRY. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   BA - BA+4, CI, RI - RI+1, T1, T3.
* 
*         CALLS  COB, EDT, IRM, RBB, RRP, SBP, UOP, 
*                VRR, VSP, WRP. 
* 
*         MACROS COMPARE, ERROR, LDA, MMOVE.
  
  
 NUMBYT   EQU    CBPN-CBUC+10D  BYTES BETWEEN *CEUC* AND END OF *CEPN*
  
 RCE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    COB         CHECK OUTPUT BUFFER
          PJN    RCE2        IF NO ERROR
 RCE1     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 RCE2     ZJN    RCEX        IF BUFFER EMPTY
          SBN    TCEL 
          MJN    RCEX        IF NOT ENTRY LENGTH
          LDA    IR+3,REL    GET RANDOM REQUEST 
          ADN    TFRR 
          CRD    BA 
          LDD    RI 
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          RJM    VRR         VERIFY RANDOM REQUEST
          LDC    BUF2 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK (CATALOG)
          MMOVE  ,BA,BUF1,,502B*2  SAVE COPY OF ORIGINAL BUFFER 
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          MJP    RCE1        IF INCORRECT RANDOM REQUEST
          LDN    TCEL        REPLACE CATALOG IMAGE
          STD    T3 
          LDD    BP 
          STD    T1 
          RJM    RBB         READ BINARY BUFFER 
          RJM    WRP         WRITE RANDOM PRU 
          LDD    BP          CALCULATE BUFFER OFFSET
          SBK    BUF2 
          STD    T3 
          COMPARE  ,BP,BUF1,T3,CBAM*2 
          NJN    RCE3        IF CHANGE FOUND
          COMPARE  CBUC,BP,BUF1+CBUC,T3,NUMBYT*2
          ZJN    RCE4        IF NO CHANGE FOUND 
 RCE3     MMOVE  CBES,BP,PESN,,VSKL 
          RJM    IRM         ISSUE RECOVERY MESSAGES
 RCE4     BSS    0
          RJM    UOP         UPDATE OUTPUT POINTER
          LJM    RCEX        RETURN 
          TITLE  SUBROUTINES. 
          SPACE  4,10 
 ABC$     EQU    1           DEFINE ABC - ADD BLOCK TO CHAIN
 BSE$     EQU    1           DEFINE BSE - BACKSPACE ONE ENTRY 
 GEP$     EQU    1           DEFINE GEP - GENERATE EMPTY PRU
 GPL$     EQU    1           DEFINE GPL - GET PREVIOUS BLOCK LINK 
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 IRM$     EQU    1           DEFINE IRM - ISSUE RECOVERY MESSAGES.
 ISK$     EQU    1           DEFINE ISK - INDEXED SEARCH FOR KEY
 LNB$     EQU    1           DEFINE LNB - LINK NEXT BLOCK 
 PLI$     EQU    1           DEFINE PLI - POSITION TO LAST INDEX
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 SIB$     EQU    1           DEFINE SIB - SEARCH INDEX BUFFER 
 SCB$     EQU    1           DEFINE SCB - SEARCH CATALOG BUFFER 
 UIS$     EQU    1           DEFINE UIS - USERNAME INDEXED SEARCH 
 UOP$     EQU    1           DEFINE UOP - UPDATE OUTPUT POINTER 
 VRR$     EQU    1           DEFINE VRR - VERIFY RANDOM REQUEST 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTER
 WES$     EQU    1           DEFINE WES - WRITE EOR/EOI SEQUENCE
*CALL     COMPCOB 
*CALL     COMPC2D 
*CALL     COMPRBB 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
***       BUFFERS.
  
  
 BUFA     BSS    TSVL*5 
 BUFB     BSS    TSVL*5 
          SPACE  4
          ERRNG  BUF2-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (LIST/REPLACE ADMIT ENTRY.),OVL1
          SPACE  4
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 LAES     SPACE  4,10 
***       LAES - LIST ADMIT ENTRY(S). 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   CM - CM+4, KA, PB, T1. 
* 
*         CALLS  AUS, COB, FCB, RBB, SBP, UOP.
* 
*         MACROS ERROR, LDA, MMOVE. 
  
  
 LAE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    FCB         FILL CATALOG BUFFER
          STM    LAEB+1 
          SHN    -14
          LMC    LDCI 
          STM    LAEB 
 LAE1     RJM    COB         CHECK OUTPUT BUFFER
          PJN    LAE2        IF NO ERROR
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 LAE2     ZJN    LAE3        IF BUFFER EMPTY
          SBN    TAEL 
          PJN    LAE4        IF .GE. ENTRY LENGTH 
 LAE3     LDN    ZERL        RESET IN POINTER 
          CRD    CM 
          LDD    FT 
          STD    CM+3 
          LDD    FT+1 
          STD    CM+4 
          LDA    IR+3,REL 
          ADN    2
          CWD    CM 
          LJM    LAEX        RETURN 
  
 LAE4     LDN    TAEL        PROCESS REQUEST
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
          LDC    **          SET ADMIT BLOCK ADDRESS
 LAEB     EQU    *-2         (FIRST ADMIT BLOCK)
          ZJN    LAE5        IF NO ALTERNATE USERS
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    AUS         ADMIT USER SEARCH
          ZJN    LAE6        IF ADMIT FOUND 
 LAE5     MMOVE  ,KA,PBUN,,UNKL 
          ERROR  UNF         *(USERNAME) NOT FOUND.*
  
 LAE6     MMOVE  ,BP,BUFA,,TAEL*10D 
          LDN    TAEL        RETURN ADMIT ENTRY TO BUFFER 
          STD    T1 
          LDA    IR+3,REL 
          ADN    3
          CRD    CM 
          LDA    CM+3,REL 
          CWM    BUFA,T1
          RJM    UOP         UPDATE OUT POINTER 
          LJM    LAE1        PROCESS NEXT ENTRY 
 RAES     SPACE  4,10 
***       RAES - REPLACE/ADD ADMIT ENTRY. 
* 
*         ENTRY  (IR - IR+3) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   BA, KA, PB, RI - RI+1, T3. 
* 
*         CALLS  AUS, CAE, COB, FCB, IBC, SBP,
*                UOP, WRP.
* 
*         MACROS ERROR, LDA, MMOVE, SAVEP.
  
  
 RAE      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    FCB         FILL CATALOG BUFFER
          ZJN    RAE1        IF ADMIT BLOCK NOT ASSIGNED
          LJM    RAE2        SAVE FIRST BLOCK ADDRESS 
  
 RAE1     SAVEP  CPCB        SAVE CATALOG POINTERS
          LDC    BUF1 
          STD    BA 
          RJM    IBC         INITIALIZE BLOCK CHAIN 
          LDC    RTAB*100 
          STM    CWRT,BA
          LDN    TAEL 
          STM    CWEL,BA
          MMOVE  PBUN,,CWUN,BA,UNKL 
          SAVEP  CPAB        SAVE FIRST ADMIT POINTERS
          RJM    WRP         WRITE RANDOM PRU 
          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 
          RESTP  CPAB        RESTORE ADMIT BUFFER POINTERS
          LDA    RI,ABS 
 RAE2     STM    RAEB+1      SAVE FIRST BLOCK ADDRESS 
          SHN    -14
          LMC    LDCI 
          STM    RAEB 
 RAE3     RJM    COB         CHECK OUTPUT BUFFER
          MJN    RAE5        IF ARGUMENT ERROR
          ZJN    RAE4        IF BUFFER EMPTY
          SBN    TAEL 
          PJN    RAE6        IF .GE. ENTRY LENGTH 
 RAE4     LJM    RAEX        RETURN 
  
 RAE5     ERROR  BAE         *BUFFER ARGUMENT ERROR*
  
 RAE6     LDN    TAEL        GET ADMIT ENTRY IMAGE
          STD    T3 
          LDC    BUFA 
          STD    PB 
          STD    KA 
          RJM    RBB         READ BINARY BUFFER 
          LDC    **          SET ADMIT BLOCK ADDRESS
 RAEB     EQU    *-2         (FIRST ADMIT BLOCK)
          STD    RI+1 
          SHN    -14
          STD    RI 
          RJM    AUS         ALTERNATE USER SEARCH
          NJN    RAE7        IF ALTERNATE USER NOT FOUND
          MMOVE  ,PB,,BP,TAEL*10D 
          LDC    WRP         SET TO UPDATE INDEX
          UJN    RAE8        UPDATE INDEX 
  
 RAE7     LDC    BUFB        ENTER INDEX
          STD    T7 
          LDC    IIE         SET TO INSERT INDEX
 RAE8     STM    RAEA        UPDATE OR INSERT INDEX 
          RJM    **          (TO *IIE* IF CREATING NEW INDEX) 
 RAEA     EQU    *-1         (TO *WRP* IF UPDATING INDEX) 
          RJM    UOP         UPDATE OUT POINTER 
          LJM    RAE3        PROCESS NEXT ENTRY 
          TITLE  SUBROUTINES. 
 FCB      SPACE  4,10 
**        FCB - FILL CATALOG BUFFER.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (A) = INDEX TO ADMIT BLOCK.
* 
*         USES   BA - BA+4, CI, RI - RI+1.
* 
*         CALLS  RRP, VRR, VSP. 
* 
*         MACROS ERROR, LDA.
  
  
 FCB      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL    GET RANDOM REQUEST 
          ADN    TFRR 
          CRD    BA 
          LDD    RI 
          SHN    14 
          STD    CI 
          SHN    -14
          STD    RI 
          RJM    VRR         VERIFY RANDOM REQUEST
          LDC    BUF0 
          STD    BA 
          RJM    GIB         GET INITIAL BLOCK (CATALOG)
          RJM    VSP         VERIFY/SET CATALOG POINTER 
          PJN    FCB1        IF VALID RANDOM REQUEST
          ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 FCB1     MMOVE  CWUN,BA,PBUN,,UNKL 
          LDA    CBAE,BP
          LJM    FCBX        RETURN 
          SPACE  4
***       COMMON DECKS. 
  
  
 AUS$     EQU    1           DEFINE AUS - ALTERNATE USERNAME SEARCH 
 IBC$     EQU    1           DEFINE IBC - INITIALIZE BLOCK CHAIN
 IIE$     EQU    1           DEFINE IIE - INSERT INDEX ENTRY
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 UOP$     EQU    1           DEFINE UOP - UPDATE OUTPUT POINTER 
 VRR$     EQU    1           DEFINE VRR - VERIFY RANDOM REQUEST 
 VSP$     EQU    1           DEFINE VSP - VERIFY/SET CATALOG POINTERS 
*CALL     COMPCOB 
*CALL     COMPRBB 
*CALL     COMPTFM 
*CALL     COMPWEI 
          SPACE  4
***       BUFFERS.
  
  
 BUFA     BSS    TAEL*5 
 BUFB     BSS    TAEL*5 
          SPACE  4
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
          OVERLAY (READ/WRITE BLOCK.),OVL1
          SPACE  4
**        LOCAL DIRECT CELL LOCATIONS.
  
  
 CW       EQU    S1+0 - S1+4 SCRATCH WORD (5 LOCATIONS) 
 FT       EQU    S2+2 - S2+3 FET FIRST POINTER
 IN       EQU    S2+4 - S3+0 FET IN POINTER 
 OT       EQU    S3+1 - S3+2 FET OUT POINTER
 LM       EQU    S3+3 - S3+4 FET LIMIT POINTER
 CN       EQU    FN+0 - FN+4
 WC       EQU    67          WORD COUNT 
 RDRS     SPACE  4,10 
***       RDRS - BLOCK READ REQUEST.
* 
*         ENTRY  (IR+3 - IR+4) = FDET ADDRESS - 
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   BA, BP, T1.
* 
*         CALLS  CIB, EOI, FPB, SBP, UIP, WBB.
* 
*         MACROS ERROR. 
  
  
 RDR      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    CIB         CHECK INPUT BUFFER 
          PJN    RDR2        IF NO ERROR
 RDR1     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 RDR2     LDC    BUF0        SET BUFFER ADDRESS 
          STD    BA 
          ADN    2
          STD    BP 
          ADC    -100 
          MJN    RDR1        IF NO ROOM IN BUFFER 
          RJM    FPB         FILL PP BUFFER 
          ZJN    RDRX        IF INCORRECT RANDOM REQUEST
          LDD    HN 
          STD    T1 
          LDD    BP 
          RJM    WBB         WRITE BINARY BUFFER
          RJM    UIP         UPDATE IN POINTER
          LDM    CWRI,BA
          ADM    CWRI+1,BA
          NJN    RDR3        IF LINKED BLOCK
          RJM    EOI         SET END OF INFORMATION 
 RDR3     LJM    RDRX        RETURN 
 WRRS     SPACE  4,10 
***       WRRS - BLOCK WRITE REQUEST. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS -
* 
*T FET+0  42/ FILE NAME,1/ R,8/ AT,6/ CODE,3/ ST
*T,   +1  15/ 0,1/ EP, 27/ 0,18/ FIRST
*T,   +2  42/ 0,18/ IN
*T,   +3  42/ 0,18/ OUT 
*T,   +4  12/ FNT,30/ 0,18/ LIMIT 
*T,   +5  42/ 0,18/ EADD
*T,   +6  30/ CURRENT R.I.,30/ RANDOM REQUEST 
* 
*         USES   BA, BP, T3.
* 
*         CALLS  COB, EOI, EPB, RBB, SBP, UOP.
* 
*         MACROS ERROR. 
  
  
 WRR      ENTRY              ENTRY/EXIT 
          RJM    SBP         SET FET BUFFER POINTERS
          RJM    COB         CHECK OUTPUT BUFFER
          PJN    WRR2        IF NO ERROR
 WRR1     ERROR  BAE         *BUFFER ARGUMENT ERROR.* 
  
 WRR2     LDC    BUF0        SET BUFFER ADDRESS 
          STD    BA 
          ADN    2
          STD    BP 
          ADC    -100 
          MJN    WRR1        IF NO ROOM IN BUFFER 
          LDD    HN 
          STD    T3 
          LDD    BP 
          RJM    RBB         READ BINARY BUFFER 
          RJM    EPB         EMPTY PP BUFFER
          ZJN    WRRX        IF NO RANDOM REQUEST 
          RJM    UOP         UPDATE OUT POINTER 
          LDM    CWRI,BA
          ADM    CWRI+1,BA
          NJN    WRR3        IF LINKED BLOCK
          RJM    EOI         SET END OF INFORMATION 
 WRR3     LJM    WRRX        RETURN 
          TITLE  SUBROUTINES. 
 EPB      SPACE  4,10 
**        EPB - EMPTY PP BUFFER.
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (A) = 0 IF NO RANDOM REQUEST.
*                (A) .NE. 0 IF BUFFER EMPTIED.
* 
*         USES   CM - CM+4, RI - RI+1.
* 
*         CALLS  WRP. 
* 
*         MACROS LDA. 
  
  
 EPB      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL 
          ADN    TFRR 
          CRD    CM 
          LDD    CM+3        GET RANDOM REQUEST 
          LPN    77 
          STD    RI 
          SHN    14 
          LMD    CM+4 
          STD    RI+1 
          ZJN    EPBX        IF NO RANDOM REQUEST 
          RJM    WRP         WRITE RANDOM PRU 
          LDN    ZERL 
          CRD    CM 
          LDD    RI          SET CURRENT R.I. 
          STD    CM 
          LDD    RI+1 
          STD    CM+1 
          LDM    CWRI,BA     SET NEXT R.I.
          STD    CM+3 
          LDM    CWRI+1,BA
          STD    CM+4 
          LDA    IR+3,REL    REWRITE FET RANDOM REQUEST WORD
          ADN    TFRR 
          CWD    CM 
          LJM    EPBX        RETURN 
 FPB      SPACE  4,10 
**        FPB - FILL PP BUFFER. 
* 
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   (A) = 0 IF NO RANDOM REQUEST.
* 
*         USES   CM - CM+4, RI - RI+1.
* 
*         CALLS  RRP. 
* 
*         MACROS LDA. 
*                (A) .NE. 0 IF BUFFER FILLED. 
  
  
 FPB      SUBR               ENTRY/EXIT 
          LDA    IR+3,REL 
          ADN    TFRR 
          CRD    CM 
          LDD    CM+3        GET RANDOM REQUEST 
          LPN    77 
          STD    RI 
          SHN    14 
          LMD    CM+4 
          STD    RI+1 
          ZJN    FPBX        IF NO RANDOM REQUEST 
          RJM    GIB         GET INITIAL BLOCK
          LDN    ZERL 
          CRD    CM 
          LDD    RI          SET CURRENT R.I. 
          STD    CM 
          LDD    RI+1 
          STD    CM+1 
          LDM    CWRI,BA     SET NEXT R.I.
          STD    CM+3 
          LDM    CWRI+1,BA
          STD    CM+4 
          LDA    IR+3,REL    REWRITE FET RANDOM REQUEST WORD
          ADN    TFRR 
          CWD    CM 
          LJM    FPBX        RETURN 
 UIP      SPACE  4,10 
**        UIP - UPDATE IN POINTER.
*         ENTRY  (IN - IN+1) = IN POINTER.
*                (IR+3 - IR+4) = FET ADDRESS. 
* 
*         EXIT   FET+2 UPDATED. 
* 
*         USES   CM - CM+4. 
* 
  
  
 UIP      SUBR               ENTRY/EXIT 
          LDN    ZERL 
          CRD    CM 
          LDD    IN          CURRENT POSITION OF IN 
          STD    CM+3 
          LDD    IN+1 
          STD    CM+4 
          LDA    IR+3,REL    UPDATE FET 
          ADN    2
          CWD    CM 
          UJN    UIPX        RETURN 
          SPACE  4,10 
***       COMMON DECKS. 
  
  
 EOI$     EQU    1           DEFINE EOI - SET END OF INFORMATION
 SBP$     EQU    1           DEFINE SBP - SET FET BUFFER POINTERS 
 UOP$     EQU    1           DEFINE UOP - UPDATE OUTPUT POINTER 
*CALL     COMPCIB 
*CALL     COMPCOB 
*CALL     COMPRBB 
*CALL     COMPTFM 
*CALL     COMPWBB 
          SPACE  4
          ERRNG  BUF1-*      BYTES LEFT BEFORE BUFFER OVERFLOW
  
          SPACE  4,10 
          TTL    TFM - TAPE FILE MANAGER. 
          END 
