Retro1.org codex

          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