Retro1.org codex

MAGNET

[00009] MAGNET - MAGNETIC TAPE EXECUTIVE.
[00011] MAGNETIC TAPE EXECUTIVE.
[00103] MACRO DEFINITIONS.
[00105] INMOD - THIS MACRO IN CONJUNCTION WITH THE FOLLOWING OPDEF,S
[00408] PROCESSOR STRING DEFINITIONS.
[00411] PROC - PROCESSOR MACRO.
[00482] TPRO - TABLE OF PROCESSOR STRINGS.
[00870] MAIN PROGRAM.
[00872] MAIN PROGRAM.
[00977] MRT - ACS MOUNT REQUEST TABLE.
[00990] ACTIVATE PROCESSORS.
[00992] PPU - ACTIVATE PPU PROCESSORS.
[01094] INTER CONTROL POINT REQUEST PROCESSING.
[01096] CPR - PROCESS INTER-CONTROL POINT REQUEST.
[01133] TCPR - TABLE OF INTER CONTROL POINT REQUEST PROCESSORS.
[01156] ASU - ASSIGN UNIT.
[01267] CSA - CHECK TAPE ALTERNATE STORAGE ACTIVE.
[01275] RAR - RECEIVE ATF RESPONSE.
[01390] TARS - TABLE OF ATF RESPONSE CODES.
[01433] RDP - REQUEST PREVIEW DISPLAY PROMPT.
[01454] TMR - TRANSFER ACS MOUNT REQUESTS.
[01477] XUD - EXTERNAL UDT UPDATE.
[01515] ICR - PROCESS INCORRECT INTER-CONTROL POINT REQUEST.
[01535] SEND ATF REQUEST.
[01537] SAR - SEND ATF REQUEST.
[01625] EXTERNAL PP REQUEST PROCESSING.
[01627] PXR - PROCESS EXTERNAL PP REQUEST.
[01687] TXRP - TABLE OF EXTERNAL REQUEST PROCESSORS.
[01712] AMU - ACS VSN MOUNT ON SPECIFIED UNIT.
[01739] ESV - ENTER SCRATCH VSN.
[01760] EVS - ENTER VSN.
[01790] NVS - SPECIFY NEXT VSN.
[01823] SRT - SET *RETRY* FLAG.
[01837] STR - SET *TERMINATE* FLAG.
[01851] UGO - CLEAR TMS UNIT GO FLAG.
[01865] UST - SET TMS UNIT UNLOAD FLAG.
[01879] UNL - UNLOAD UNIT.
[01896] CUG - CLEAR TMS WAIT UNIT GO FLAG.
[01920] IXP - PROCESS INCORRECT EXTERNAL PP REQUEST.
[01941] CLS - CHECK LABELS READ STATUS.
[01960] MQX - MAKE QUEUE ENTRY FOR EXTERNAL REQUEST.
[01976] SFL - SET FLAG IN *UFLA*.
[01991] PERIODIC PROCESSING.
[01993] CAR - CHECK ACS MOUNT REQUESTS.
[02016] CAU - CHECK ACS UNITS.
[02056] COR - CHECK OPERATOR REQUESTS.
[02120] CUA - CHECK UNIT ACTIVITY.
[02228] REQUEST PROCESSING.
[02230] CUT - CHECK UNIT DESCRIPTOR TABLE.
[02389] EXI - COMMON EXIT POINTS.
[02450] REQUEST PROCESSORS.
[02461] CAT - CHECK STATISTICAL ACCUMULATOR THESHOLDS.
[02480] CCR - CHECK IF CLOSER/RETURN.
[02494] CCS - CHECK IF LABEL CHECKING COMPLETE.
[02506] CEF - CHECK ERROR FLAG.
[02537] CER - CLEAR END OF REEL FLAGS AND ADVANCE SECTION.
[02555] CET - CHECK END OF TAPE TYPE AND DETERMINE TYPE OF BACKSPACE
[02573] CEV - CHECK END OF VOLUME.
[02584] CFP - CHECK FILE POSITION.
[02610] CIL - COMPLETE INITIAL LABEL CHECK.
[02641] CLR - CHECK IF LABEL READ.
[02654] CLM - CHECK LABEL MATCH.
[02668] CLO - *CLOSE*TAPE ALTERNATE STORAGE ROUTINES.
[05302] CRJ - CHECK FOR REQUEST FROM STAGING JOB.
[05491] FJE - FIND JOB ENTRY IN ACTIVE STAGING JOB TABLE.
[05516] IRE - ISSUE ROLLIN EVENT AND/OR INITIATE STAGE JOB.
[05553] ISJ - INITIATE STAGING JOB.
[05684] ISM - ISSUE STATISTICAL MESSAGE.
[05771] QPR - QUEUE *PFM* REQUEST.
[05899] BUFFER AREA.
[05908] PRS - PRESET PROGRAM.
[06072] PRESET SUBROUTINES.
[06077] CLC - CLEAR MEMORY.
[06140] REL - RELOCATE INSTRUCTIONS.
[06189] PEQ - PROCESS EQUIPMENT ENTRIES.
[06225] AUD - ASSIGN UDT ENTRIES.
[06367] TER - TERMINATION PROCESSOR.
[06425] CPU - CPU UTILIZATION.
[06472] REC - LEVEL 3 RECOVERY.
[06585] RES - RESET TAPE ALTERNATE STORAGE.
[06626] SDF - SCAN DEMAND FILE.
[06732] ABT - ABORT ROUTINE.
[06767] END - ENDING ROUTINE.
[06783] ERX - ERROR EXIT PROCESSOR.
Source Code

          IDENT  MAGNET,TPRO,MAGNET
          ABS
          ENTRY  MAGNET
          ENTRY  RFL=
          SST
          SYSCOM B1
*COMMENT  MAGNET - TAPE EXECUTIVE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  MAGNET - MAGNETIC TAPE EXECUTIVE.
          SPACE  4,10
***       MAGNET - MAGNETIC TAPE EXECUTIVE.
*         R. E. TATE.        73/12/10.
*         R. J. PRIEVE.      77/07/15.
*         G. S. YODER.       93/02/11.
 MAGNET   SPACE  4,10
***       COMMAND PARAMETERS.
*
*         MAGNET(SJ=N1,SV=N2)
*
*         SJ = NUMBER OF STAGING JOBS (FOR TAPE ALTERNATE STORAGE).
*              IF *SJ*=0, STAGING OF FILES FROM TAPE IS DISABLED.
*              THE DEFAULT VALUE IS DEFINED BY *SJDF* IN *COMSMTX*.
*
*         SV = NUMBER OF STAGING TAPE VSN-S (FOR TAPE ALTERNATE
*              STORAGE) TO DISPLAY ON THE *E,P* DISPLAY.
*              THE DEFAULT VALUE IS DEFINED BY *SVDF* IN *COMSMTX*.
 MAGNET   SPACE  4,10
***       *MAGNET* CONTROLS PROCESSING FOR ALL USER TAPES IN THE
*         SYSTEM.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*         * ERROR IN ARGUMENTS.* - AN INCORRECT PARAMETER OR
*         VALUE WAS SPECIFIED ON THE *MAGNET* COMMAND.
*
*         * INCORRECT COMMAND.* - *MAGNET* WAS CALLED FROM
*         NON-SYSTEM ORIGIN JOB.
          SPACE  4,10
***       ACCOUNT FILE MESSAGES.
*
*         *SOBS, FILENAM, USERIN, FAMPACK, VSNVSN, VERS,R.*
*         STATISTICAL MESSAGE ISSUED ON RECEIPT OF A STAGE REQUEST
*         FROM *PFM* OR *PFROD* FOR A FILE ARCHIVED ON OPTICAL DISK.
*
*         *STBS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
*         STATISTICAL MESSAGE ISSUED ON RECEIPT OF A STAGE REQUEST
*         FROM *PFM* OR *PFRES* FOR A FILE ARCHIVED ON TAPE.
          SPACE  4,10
***       *MAGNET* CONTROL POINT AREA MESSAGES.
*
*
*         * MAGNET* - PRESENT AT *MAGNET* CONTROL POINT,
*         UNLESS ERROR CONDITION OR REQUEST FOR OPERATOR
*         ACTION OCCURS.
*
*         *CHECK E,P DISPLAY* - AN ERROR CONDITION OR REQUEST
*         FOR OPERATOR ACTION IS CURRENTLY BEING DISPLAYED
*         ON THE *E,P* DISPLAY.
 MAGNET   SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 EX       EQU    4000B       *PROC* MACRO *BEI* ERROR EXIT FLAG
 MEMI     EQU    1000B       INCREMENT FOR CM FL INCREASE REQUESTS
 QUAL$    EQU    1           DEFINE UNQUALIFIED COMMON DECKS
 
 
****
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMCDCM
          QUAL   ATF
          LIST   X
*CALL     COMSATF
          LIST   *
          QUAL   *
*CALL     COMSPFM
          QUAL   EVENT
*CALL     COMSEVT
          QUAL   *
*CALL     COMSSSD
          LIST   X
*CALL     COMSMTX
          LIST   *
*CALL     COMSSFM
          QUAL   CIO
          LIST   X
*CALL     COMSCIO
          LIST   *
          QUAL   *
          QUAL   RSX
*CALL     COMSRSX
          QUAL   *
          QUAL   TFM
*CALL     COMSTFM
          QUAL   *
 
 
          TITLE  MACRO DEFINITIONS.
 INMOD    SPACE  4,10
**        INMOD - THIS MACRO IN CONJUNCTION WITH THE FOLLOWING OPDEF,S
*         MAKES IT POSSIBLE TO SPECIFY A MODIFIER ON ALL 30 BIT
*         INCREMENT INSTRUCTIONS.  THIS MODIFER MUST BE IN THE FORM
*         OF A POINTER TO ONE OF THE TABLE POINTERS THAT IS SET
*         DYNAMICALLY AT INITILIZATION TIME.  THE INSTRUCTION WILL
*         BE MODIFIED DURING INITILIZATION.
*         THIS IS USEFUL FOR ACCESSING THE POINTERS THAT ARE
*         DYNAMICALLY SET AT INITILIZATION TIME SUCH AS THE FIRST
*         WORD ADDRESS OF THE QUEUE TABLE.
*
*         DEFINITIONS.
*
*         PTRA = POINTER DESIRED.
*         LWAF = IF DEFINED TAKE LWA INSTEAD OF FWA.
*
*         EXAMPLE-
*         TA1    B5,VTTP
*         THIS WILL GENERATE A 30 BIT INSTRUCTION OF THE FOLLOWING FORM
*         SA1    B5+K
*         WHERE K = THE FIRST WORD ADDRESS OF THE QUEUE TABLE.
*
*         TB3    0,UBUF,-LWA
*         THIS WILL SET B3 TO THE COMPLEMENT OF THE LAST WORD ADDRESS
*         OF UBUF.
 
 
 INMOD    MACRO  PTRA,LWAF
          LOCAL  INM1,INM2,INM3
          QUAL
 INM1     SET    *P
 INM2     SET    *
          IFEQ   INM1,60,2
 INM1     SET    0
 INM2     SET    *-1
 INM3     SET    PTRA
          QUAL   *
 TINST    RMT
          VFD    12/2000B+INM1
          IFC    EQ,*LWAF**
          VFD    12/0
          ELSE   1
          VFD    12/4000B
          VFD    18/INM3
          VFD    18/INM2
 TINST    RMT
          ENDM
 OPDEFS   SPACE  4,10
**        OPDEF-S USED WITH INMOD.
          CTEXT
 
 
 TAAQ,Q   OPDEF  P1,P2,P3,P4
          SA.P1  A.P2+P3
          INMOD  P4
          ENDM
 
 
 TAA,Q    OPDEF  P1,P2,P4
          SA.P1  A.P2+0
          INMOD  P4
          ENDM
 
 
 TAAQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SA.P1  A.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TAA,Q,Q  OPDEF  P1,P2,P4,P5
          SA.P1  A.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TABQ,Q   OPDEF  P1,P2,P3,P4
          SA.P1  B.P2+P3
          INMOD  P4
          ENDM
 
 
 TAB,Q    OPDEF  P1,P2,P4
          SA.P1  B.P2+0
          INMOD  P4
          ENDM
 
 
 TABQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SA.P1  B.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TAB,Q,Q  OPDEF  P1,P2,P4,P5
          SA.P1  B.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TAXQ,Q   OPDEF  P1,P2,P3,P4
          SA.P1  X.P2+P3
          INMOD  P4
          ENDM
 
 
 TAX,Q    OPDEF  P1,P2,P4
          SA.P1  X.P2+0
          INMOD  P4
          ENDM
 
 
 TAXQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SA.P1  X.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TAX,Q,Q  OPDEF  P1,P2,P4,P5
          SA.P1  X.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TAQ,Q    OPDEF  P1,P3,P4
          SA.P1  B0+P3
          INMOD  P4
          ENDM
 
 
 TAQ,Q,Q  OPDEF  P1,P3,P4,P5
          SA.P1  B0+P3
          INMOD  P4,P5
          ENDM
 
 
 TBAQ,Q   OPDEF  P1,P2,P3,P4
          SB.P1  A.P2+P3
          INMOD  P4
          ENDM
 
 
 TBA,Q    OPDEF  P1,P2,P4
          SB.P1  A.P2+0
          INMOD  P4
          ENDM
 
 
 TBAQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SB.P1  A.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TBA,Q,Q  OPDEF  P1,P2,P4,P5
          SB.P1  A.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TBBQ,Q   OPDEF  P1,P2,P3,P4
          SB.P1  B.P2+P3
          INMOD  P4
          ENDM
 
 
 TBB,Q    OPDEF  P1,P2,P4
          SB.P1  B.P2+0
          INMOD  P4
          ENDM
 
 
 TBBQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SB.P1  B.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TBB,Q,Q  OPDEF  P1,P2,P4,P5
          SB.P1  B.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TBXQ,Q   OPDEF  P1,P2,P3,P4
          SB.P1  X.P2+P3
          INMOD  P4
          ENDM
 
 
 TBX,Q    OPDEF  P1,P2,P4
          SB.P1  X.P2+0
          INMOD  P4
          ENDM
 
 
 TBXQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SB.P1  X.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TBX,Q,Q  OPDEF  P1,P2,P4,P5
          SB.P1  X.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TBQ,Q    OPDEF  P1,P3,P4
          SB.P1  B0+P3
          INMOD  P4
          ENDM
 
 
 TBQ,Q,Q  OPDEF  P1,P3,P4,P5
          SB.P1  B0+P3
          INMOD  P4,P5
          ENDM
 
 
 TXAQ,Q   OPDEF  P1,P2,P3,P4
          SX.P1  A.P2+P3
          INMOD  P4
          ENDM
 
 
 TXA,Q    OPDEF  P1,P2,P4
          SX.P1  A.P2+0
          INMOD  P4
          ENDM
 
 
 TXAQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SX.P1  A.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TXA,Q,Q  OPDEF  P1,P2,P4,P5
          SX.P1  A.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TXBQ,Q   OPDEF  P1,P2,P3,P4
          SX.P1  B.P2+P3
          INMOD  P4
          ENDM
 
 
 TXB,Q    OPDEF  P1,P2,P4
          SX.P1  B.P2+0
          INMOD  P4
          ENDM
 
 
 TXBQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SX.P1  B.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TXB,Q,Q  OPDEF  P1,P2,P4,P5
          SX.P1  B.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TXXQ,Q   OPDEF  P1,P2,P3,P4
          SX.P1  X.P2+P3
          INMOD  P4
          ENDM
 
 
 TXX,Q    OPDEF  P1,P2,P4
          SX.P1  X.P2+0
          INMOD  P4
          ENDM
 
 
 TXXQ,Q,Q OPDEF  P1,P2,P3,P4,P5
          SX.P1  X.P2+P3
          INMOD  P4,P5
          ENDM
 
 
 TXX,Q,Q  OPDEF  P1,P2,P4,P5
          SX.P1  X.P2+0
          INMOD  P4,P5
          ENDM
 
 
 TXQ,Q    OPDEF  P1,P3,P4
          SX.P1  B0+P3
          INMOD  P4
          ENDM
 
 
 TXQ,Q,Q  OPDEF  P1,P3,P4,P5
          SX.P1  B0+P3
          INMOD  P4,P5
          ENDM
          ENDX
 DATA     SPACE  4,10
          TITLE  PROCESSOR STRING DEFINITIONS.
          ORG    TPRO
 PROC     SPACE  4,30
**        PROC - PROCESSOR MACRO.
*         THIS MACRO DEFINES A STRING OF PROCESSORS, ROUTINES, AND/OR
*         FUNCTIONS TO BE PROCESSED FOR A PARTICULAR REQUEST.
*
*
*         PROC   (P1,P2,.....PN)
*         P1 - PN = PROCESSORS, FUNCTIONS, ETC.
*
*         IF PN .LT. TPRO, IT IS A FUNCTION TO BE ISSUED.
*         IF ((PN .GE. TPRO) .AND. (P1 .LE. (TPRO+TPROL))), THEN IT
*                DEFINES ANOTHER STRING TO CALL.
*         IF PN .GT. (TPRO+TPROL), IT IS A SUBROUTINE ADDRESS.
*         IF NEXT PN(S) AFTER A FUNCTION ISSUE HAVE BIT 11 SET, THEY
*                ARE PARAMETERS FOR THE FUNCTION.  BIT 11 IS CLEARED
*                AND THE PN(S) ARE TAKEN IN ORDER AS PARAMETERS *MD*,
*                *PB*, AND *PA*.  IF LESS THAN THREE ARE GIVEN, THE
*                REST WILL BE ASSUMED TO BE ZERO.  IF NO PARAMETERS
*                ARE SPECIFIED, THEN (MD) = (X5).  IF BIT 11 IS SET
*                WHERE IT IS NOT A PARAMETER THIS INDICATES A PARAMETER
*                TO PROCESS ONLY IF A *BEI* ERROR IS RETURNED.
*                OTHERWISE, THE PARAMETER IS SKIPPED.  IF A *BEI* ERROR
*                PARAMETER IS PROCESSED, THE REST OF THE CURRENT STRING
*                IS SKIPPED.  ONE MUST REMEMBER THAT FUNCTIONS FOR
*                *1MT* MUST HAVE ALL 3 PARAMETERS SPECIFIED IF THE NEXT
*                PARAMETER IS AN ERROR EXIT CASE AS AN ERROR EXIT AND A
*                PARAMETER WILL BOTH HAVE THE UPPER BIT SET.
*
*         NOTE - ANY PARAMETER OF GREATER THAN THREE CHARACTERS THAT
*         BEGINS WITH *FN*, *RL*, *WL*, OR *AF* IS ASSUMED TO BE A
*         FUNCTION PARAMETER AND 4000B WILL BE ADDED TO IT.
 
 
 PROC     MACRO  P
          NOREF  1.,.2,.3
 .1       SET    0
          IRP    P
 .1       SET    .1+1
 PM       MICRO  1,,$P$
 .2       MICCNT PM
 .3       SET    0
          IFGT   .2,3,9
 CH       MICRO  1,2,$P$
          IFC    EQ,$"CH"$FN$,1
 .3       SET    4000B
          IFC    EQ,$"CH"$RL$,1
 .3       SET    4000B
          IFC    EQ,$"CH"$WL$,1
 .3       SET    4000B
          IFC    EQ,$"CH"$AF$,1
 .3       SET    4000B
          VFD    12/P+.3
          IFEQ   .1,5,1
 .1       SET    0
          IRP
          IFEQ   .1,0,2
          VFD    60/0
          SKIP
          IFEQ   .1,1,2
          VFD    48/0
          SKIP
          IFEQ   .1,2,2
          VFD    36/0
          SKIP
          IFEQ   .1,3,2
          VFD    24/0
          SKIP
          IFEQ   .1,4,2
          VFD    12/0
          ENDIF
          ENDM
 TPRO     SPACE  4,10
**        TPRO - TABLE OF PROCESSOR STRINGS.
 
 
 TPRO     BSS    0
 
*         BECAUSE IT IS INDEXED BY A PORTION OF THE INTERNAL
*         *CIO* FUNCTION CODE, THE FIRST ENTRY GROUP OF THIS
*         TABLE IS CONSTRAINED TO NO MORE THAN FOUR PROCESSORS
*         PER STRING.  ANY CHANGE TO *COMSCIO* MAY REQUIRE
*         CHANGES IN THIS TABLE.
 
*         FIRST ENTRY GROUP.
 
          ERRNZ  /CIO/RDF    TABLE POSITION DEPENDS ON VALUE
          ERRNZ  /CIO/WTF-1  TABLE POSITION DEPENDS ON VALUE
          ERRNZ  /CIO/SKP-2  TABLE POSITION DEPENDS ON VALUE
          ERRNZ  /CIO/OPE-3  TABLE POSITION DEPENDS ON VALUE
          ERRNZ  /CIO/CLO-4  TABLE POSITION DEPENDS ON VALUE
          ERRNZ  /CIO/REW-5  TABLE POSITION DEPENDS ON VALUE
 
 PRDA     PROC   (LAB,RDA,(EX+CRK))           READ
 PWDA     PROC   (LAB1,WDA,(EX+CWC),WDA1)     WRITE
          PROC   (PSKP)                       SKIP
          PROC   (OPE,POLA)                   OPEN
          PROC   (CLO)                        CLOSE
          PROC   (PRRQ)                       REWIND
          ERRNZ  FNRW
 TPROL1   EQU    *-TPRO      LENGTH OF FIRST TABLE SECTION
 
*         SECOND ENTRY GROUP.
 
*         ASSIGN REEL.
 
 PASN     PROC   (FNH,ATM,AFN,4000B,AFRA,SRA)
          ERRNZ  FNRW
 
*         ADVANCE VSN FILE.
 
 PAVS     PROC   (AVS,CNV,RRM)
 
*         CHECK ERROR FLAG.
 
 PCEF     PROC   (CEF,CJE,CEF1)
 
*         VALIDATE HEADER LABEL WITH UDT.
 
 PCFL     PROC   (PTM,RLA,4100B,RLVH,4000B,(EX+CLR),CRW,VTL)
 
*         CHECK REEL TO MATCH REQUEST.
 
 PCHR     PROC   (PREW,PDEN,SVC,RLA,4100B,RLCR,4000B,(EX+RRP),CRC,PASN)
 
*         COMPLETE INITIAL LABEL CHECK.
 
 PCIL     PROC   (CIL,PVSE)
 
*         PERFORM INITIAL LABEL CHECK.
 
 PCLA     PROC   (SED,FRE,PILA,PCIL)
 
*         RETURN EXTENDED LABELS ON *CLOSE* AFTER READ.
 
 PCLL     PROC   (RLA,4100B,RLCF,4000B,(EX+PCLO),PSBT,PCLO)
 
*         *CLOSE* AFTER READ.
 
 PCLO     PROC   (FET1,CLO3)
 
*         WRITE *EOV1* AND ADVANCE REEL FOR *CLOSER* AFTER WRITE.
 
 PCLR     PROC   (PWEV,CCR,PRME,LAB4,CUF)
 
*         CHECK AND ASSIGN NEXT REEL.
 
 PCNR     PROC   (PCEF,CNR)
 
*         CALL TAPE MANAGER.
 
 PCTM     PROC   (CTM,TCP)
 
*         CLEAR VSN.
 
 PCVS     PROC   (CVS)
 
*         CHECK WRITE FROM LOAD POINT.
 
 PCWL     PROC   (CWL)
 
*         WRITE *EOF1* AND COMPLETE FET FOR *CLOSE* AFTER WRITE.
 
 PCWT     PROC   (PWTL,CUF,CLO3)
 
*         REISSUE PP REQUEST AFTER DELAY.
 
 PDEL     PROC   (DRT,RPR)
 
*         SET DENSITY.
 
 PDEN     PROC   (FNH,4000B,FNSD)
 
*         DETERMINE TYPE OF *POSMF*.
 
 PDRW     PROC   (VMF,OPF,4000B,4001B,4000B,(EX+OPE2),OPE5)
 
*         PROCESS EOF.
 
 PEOF     PROC   (FET,PSBO,PSFO)
 
*         PROCESS EOI.
 
 PEOI     PROC   (EOI,FET,CET)
 
*         PROCESS END OF TAPE.
 
 PEOT     PROC   (RLA,4100B,RLCE,4000B,(EX+PEOI),PRER,PRDA)
 
*         PROCESS END OF REEL FOR *CLOSER* AFTER READ.
 
 PERP     PROC   (CCR,URN,PAVS,SVR,PRME,CUF)
 
*         RETURN EXTENDED LABELS FOR *CLOSER* AFTER READ.
 
 PERT     PROC   (RLA,4100B,RLCF,4000B,(EX+PERP),PSBT,PERP)
 
*         NEXT VSN, REWIND.
 
 PERW     PROC   (RFV,PAVS,REW6,CRA,PCNR)
 
*         END OF REEL SKIP.
 
 PEST     PROC   (SSC,RLA,4100B,RLCE,4000B,(EX+PPEO),PRER,PSKP)
 
*         COMPLETE USER FET.
 
 PFET     PROC   (FET2)
 
*         HANG UNIT ON SYSTEM ERROR.
 
 PHNG     PROC   (HNG)
 
*         INITIAL LABEL CHECK.
 
 PILA     PROC   (PDEN,RLA,4100B,FNH,CCS)
          ERRNZ  RLCL
          ERRNZ  FNRW
 
*         WAIT FOR ROLLIN.
 
 PJOB     PROC   (JOB)
 
*         LOG STATISTICAL ACCUMULATORS.
 
 PLAC     PROC   (AFN,4000B,AFLA)
 
*         PROCESS LOAD POINT ERRORS.
 
 PLPD     PROC   (LPD)
 
*         PROCESS FATAL ERRORS.
 
 PMAB     PROC   (CRS)
 
*         WRITE MULTI FILE LABEL *EOF1*HDR1*.
 
 PMFL     PROC   (WLA,4100B,WLME,USN,OPF,4000B,4000B,4000B,PWHL)
 
*         REWIND MULTI-VOLUME, MULTI-FILE.
 
 PMFR     PROC   (PERW,PCFL)
 
*         PROCESS MULTI-FILE REEL SWAP FOR *POSMF*.
 
 PMFS     PROC   (PERW,PCFL,PPEI)
 
*         PROCESS MULTI FILE REEL SWAP.
 
 PMFV     PROC   (PRER,PPEI)
 
*         COMPLETE OPEN.
 
 PNLB     PROC   (OPE4,FET1)
 
*         OPEN.
 
 POLA     PROC   (OPF,4000B,4000B,4000B,(EX+CLM),FNH,RLA,4100B,RLOF,OPE4
,,FET1)
          ERRNZ  FNRW
 
*         POSITION TO CORRECT FILE SET.
 
 PPEI     PROC   (LAB,SKP,4014B,4001B,4000B,(EX+PPMF),PCEF,PPEI)
 
*         PROCESS POSSIBLE EOI FOR SKIP OPERATIONS.
 
 PPEO     PROC   (PEO,FET,CET)
 
*         READ MULTI FILE LABELS.
 
 PPMF     PROC   (RLA,4100B,RLCM,4000B,(EX+CFP),CEV,PTM,VTL,CPT,OPF,4000
,B,4000B,4000B,(EX+CLM),RXL,FET1)
 
*         SKIP TO NEXT LABEL BLOCK.
 
 PPNB     PROC   (SKP,4014B,4001B,4000B,(EX+PSKT),PCEF,PPNB)
 
*         END OF REEL FOR READ/SKIP.
 
 PRER     PROC   (CET,CUP,URN,PAVS,SVR,PRME)
 
*         REPOSITION PRIOR TO END OF SET AND ISSUE MULTI-FILE
*         NOT FOUND ERROR.
 
 PRES     PROC   (RLA,6100B,RLSM,4003B,MAB,4000B,(4000B+MFM))
 
*         CHECK WRITE STATUS, REWIND, AND CHECK ACCUMULATORS.
 
 PREW     PROC   (CWR,FNH,CAT)
          ERRNZ  FNRW
 
*         END OF REEL MESSAGE AND REEL SWAP.
 
 PRME     PROC   (MAB,4000B,(4000B+ERM),RSP,CER,CRA,PCNR)
 
*         ABORT REQUEST AND UNLOAD UNIT ON REEL REJECT.
 
 PRRA     PROC   (MAB,PUNL)
 
*         PROCESS *REWIND* REQUEST.
 
 PRRQ     PROC   (CWR,FET1,FNH,SRF,CAT)
 
*         RETURN UNIT FIRST SEQUENCE.
 
 PRTA     PROC   (CWR)
 
*         RETURN UNIT SECOND SEQUENCE.
 
 PRTB     PROC   (RRF,CUR)
 
*         RETURN UNIT THIRD SEQUENCE.
 
 PRTC     PROC   (CRA,AFN,4000B,AFCJ,CVS,DUC)
 
*         UNLOAD AND RESTART CHECK FOR NEXT REEL.
 
 PRUL     PROC   (PUNL,PCNR)
 
*         REWIND REEL AND SET REWIND FLAG AFTER *CLOSE*.
 
 PRWC     PROC   (FNH,SRF)
          ERRNZ  FNRW
 
*         REWIND FILE PRIOR TO *CIO* FUNCTION.
 
 PRWF     PROC   (REW,CRF)
 
*         REWIND CURRENT REEL FOR *OPEN*.
 
 PRWO     PROC   (PREW,REW5)
 
*         REWIND AND REPOSITION TAPE FOR *POSMF* TO EXISTING FILE SET.
 
 PRWP     PROC   (PREW,REW)
 
*         RETURN LABELS ON *POSMF*.
 
 PRXL     PROC   (PSBT,PSFO,RLA,4100B,RLOF)
 
*         SKIP BACK 1 TAPE MARK.
 
 PSBO     PROC   (RLA,6100B,RLSM,4001B)
 
*         SKIP BACK 2 TAPE MARKS.
 
 PSBT     PROC   (RLA,6100B,RLSM,4002B)
 
*         CHECK ERROR FLAG DURING SKIP.
 
 PSEF     PROC   (SSC,PCEF,PSKK)
 
*         SKIP FORWARD 1 TAPE MARK.
 
 PSFO     PROC   (RLA,4100B,RLSM,4001B)
 
*         SKIP DATA.
 
 PSKK     PROC   (SKR,(EX+PEST),SEF)
 
*         CHECK WRITE, CHECK ACCUMULATORS, SKIP LABELS AND SKIP DATA.
 
 PSKP     PROC   (CWR,CAT,LAB,PSKK)
 
*         SKIP TO TAPE MARK.
 
 PSKT     PROC   (SKP,4014B,4001B,4000B,(EX+PCFL),PCEF,PSKT)
 
*         SKIP OVER *VOL1* AND *HDR1*.
 
 PSLA     PROC   (RLA,4100B,RLSL)
 
*         UNLOAD UNASSIGNED UNIT AND CLEAR VSN.
 
 PULR     PROC   (FNH,4000B,FNUL,DMA,CVS)
 
*         CHECK WRITE, UNLOAD, AND CHECK ACCUMULATORS.
 
 PUNL     PROC   (CWR,FNH,4000B,FNUL,DMA,CAT)
 
*         INITIATE UNIT SWAP.
 
 PUSP     PROC   (USP,EX+USF,USC,PCHR)
 
*         ISSUE EVENT AFTER ACS VSN MOUNT ERROR.
 
 PVME     PROC   (VME)
 
*         ISSUE VSN EVENT.
 
 PVSE     PROC   (AFN,4000B,AFVE)
 
*         WAIT UNIT ACCESSIBLE.
 
 PWAC     PROC   (PCEF,WAC)
 
*         WRITE MULTI-FILE LABELS AT BEGINNING OF TAPE.
 
 PWBL     PROC   (FNH,OPF,4000B,4000B,4000B,PWHL)
          ERRNZ  FNRW
 
*         EOT ON WRITE PROCESSOR.
 
 PWET     PROC   (PWEV,PRME)
 
*         ADVANCE VSN FILE AND WRITE END OF VOLUME.
 
 PWEV     PROC   (URN,PAVS,SVR,WLA,4100B,WLEV)
 
*         WRITE *HDR1* AND POSITION BEFORE MULTI FILE LABEL.
 
 PWFL     PROC   (PSBO,OPF,4000B,4000B,4000B,PWHL)
 
*         WRITE *VOL1* AND/OR *HDR1*.
 
 PWHD     PROC   (CWL,WLA,4100B,WLVH,VTL1)
 
*         WRITE MULTI-FILE HDR1 AND COMPLETE FET.
 
 PWHL     PROC   (PTM,PWHD,FET1)
 
*         WRITE *VOL1* AND *HDR1* AFTER REEL SWAP.
 
 PWHR     PROC   (WLA,4100B,WLVR,VTL1)
 
*         WAIT FOR NOT BUSY.
 
 PWNB     PROC   (PCEF,WNB)
 
*         WAIT FOR OPERATOR SPECIFICATION OF NEXT VSN.
 
 PWNV     PROC   (PCEF,WNV)
 
*         WAIT FOR OPERATOR ACTION.
 
 PWOP     PROC   (PCEF,LPD2)
 
*         WRITE COMPLETE ON EOT.
 
 PWTC     PROC   (CUP,PWET,CUF,LAB4)
 
*         WAIT FOR TIME DELAY.
 
 PWTD     PROC   (PCEF,WTD)
 
*         WRITE NOT COMPLETE ON EOT.
 
 PWTI     PROC   (CUP,PWET,PWDA)
 
*         WRITE *EOF1* LABEL.
 
 PWTL     PROC   (WLA,4100B,WLTR,RLA,6100B,RLSM,4004B)
 
*         WAIT GO OR UNLOAD ON UNIT.
 
 PWUG     PROC   (PCEF,WUG)
 
          IFLT   *,TPRO+TPROL,1
          BSSZ   TPRO+TPROL-*
          ERRNG  TPRO+TPROL-*  INCREASE *TPROL* IN *COMSMTX*
          TITLE  MAIN PROGRAM.
 MAGNET   SPACE  4,10
**        MAGNET - MAIN PROGRAM.
 
 
 MAG      RJ     RFL         REDUCE MEMORY
 MAG1     RECALL
          SA3    RTIM
          RTIME  RTIM
          SA1    RTIM
          SA2    INTC
          AX3    36
          AX1    36
          BX7    X2
          IX6    X3-X1
          PL     X6,MAG2     IF NOT 1 SECOND ELAPSED
          SX6    B1
          IX7    X7+X6       ADVANCE INTERVAL COUNTER
 MAG2     BX6    X2-X7       SET INTERVAL TIMER MASK
          SA7    A2          UPDATE INTERVAL COUNTER
          SA6    ITIM        UPDATE INTERVAL TIMER MASK
          RJ     CUT         CHECK UNIT TABLES
          RJ     PPU         PROCESS PPU REQUESTS
          SA5    XREQ
          ZR     X5,MAG3     IF NO EXTERNAL PP REQUEST
          RJ     PXR         PROCESS EXTERNAL PP REQUEST
 MAG3     SA5    RCAL
          ZR     X5,MAG4     IF NO INTER-CONTROL POINT REQUEST
          RJ     CPR         PROCEESS INTER-CONTROL POINT REQUEST
 MAG4     SA1    TAJP
          ZR     X1,MAG7     IF TAPE ALTERNATE STORAGE NOT ACTIVE
          SA5    PFTB
          ZR     X5,MAG7     IF NO *PFM* REQUEST
          RJ     /STAGE/QPR  QUEUE *PFM* REQUEST
 MAG7     SA1    ATFS
          ZR     X1,MAG8     IF NO REQUESTS TO BE SENT TO ATF
          RJ     SAR         SEND ATF REQUEST
 MAG8     SA5    ITIM
          SA1    CUAF
          LX5    59-1        CHECK 2 SECOND INTERVAL
          BX2    X5+X1
          PL     X2,MAG9     IF NOT TO CHECK UNIT ACTIVITY
          RJ     CUA         CHECK UNIT ACTIVITY
 MAG9     SA1    OPRF
          BX2    X1+X5
          PL     X2,MAG10    IF NOT TO CHECK OPERATOR REQUESTS
          RJ     COR         CHECK OPERATOR REQUESTS
 MAG10    SA1    ACRF
          BX2    X5+X1
          PL     X2,MAG11    IF NOT TO CHECK ACS MOUNT REQUESTS
          RJ     CAR         CHECK ACS MOUNT REQUESTS
 MAG11    PL     X5,MAG13    IF NOT 2 SECOND INTERVAL
          SA1    TAJP
          ZR     X1,MAG12    IF TAPE ALTERNATE STORAGE NOT ACTIVE
          RJ     /STAGE/IRE  CHECK STAGE JOB ROLLIN
 MAG12    LX5    59-5-59+1
          PL     X5,MAG13    IF NOT 32 SECOND INTERVAL
          RJ     RFL         REDUCE MEMORY
          LX5    59-7-59+5
          PL     X5,MAG13    IF NOT 128 SECOND INTERVAL
          RJ     CAU         CHECK ACS UNITS
 MAG13    SA1    B0          CHECK IF IDLEDOWN REQUESTED
          LX1    59-15
          PL     X1,MAG1     IF IDLEDOWN NOT REQUESTED
          SA4    NTAS
          NZ     X4,MAG1     IF TAPES STILL ASSIGNED
          MX7    1           FLAG IDLEDOWN FOR *MAGNET1*
          SA7    A4
          ENDRUN             END *MAGNET*
          SPACE  4,10
**        GLOBAL DATA.
 
 
 RTIM     CON    0           REAL TIME CLOCK
 
*         INTERVAL TIME WORDS.
*         *INTC* IS INCREMENTED AT APPROXIMATELY 1 SECOND INTERVALS.
*         *ITIM* IS A MASK OF BITS SET FOR ONE PASS THROUGH *MAGNET*
*         WHEN *INTC* IS INCREMENTED.  BIT N WILL BE SET EVERY 2**N
*         SECONDS.  I.E. TO PERFORM SOME OPERATION EVERY 8 SECONDS, BIT
*         3 SOULD BE CHECKED.  *ITIM* WILL BE ALL ZERO ON PASSES IN
*         WHICH *INTC* WAS NOT ICREMENTED.
 
 INTC     CON    0           1 SECOND INTERVAL COUNTER
 ITIM     CON    0           INTERVAL TIMER MASK
 
 CTIM     CON    0           CPU TIME AT START UP
 STAR     CON    0           REAL TIME AT START UP
 
 PPIW     CON    0           PPU REQUEST WORD
 
 PBFL     CON    0           LENGTH OF ENTRIES IN PREVIEW BUFFER
 
 FLST     CON    0           FIELD LENGTH STATUS
 
 NTAS     CON    0           NUMBER OF TAPES ASSIGNED
 
 NXAU     CON    0           NEXT ACS UNIT FOR MOUNT
 
 OPRF     CON    0           NEW OPERATOR REQUEST FLAG (BIT 59 SET)
 ACRF     CON    0           NEW ACS MOUNT REQUEST FLAG (BIT 59 SET)
 
 ATFS     CON    0           REQUESTS TO BE SENT TO ATF FLAG
 ACRT     CON    0           ATF NO RESPONSE TIME OUT
 ANRC     CON    0           ATF RESPONSES WITH NO REQUEST
 ATRC     CON    0           ATF TIMED OUT RESPONSES
 MRT      SPACE  4,15
**        MRT - ACS MOUNT REQUEST TABLE.
*
*         ENTRY FORMAT -
*
*T        36/ VSN,24/ 0
*
*                VSN = VSN TO MOUNT.
*
*         ENTRIES ARE ORDERED BY PRIORITY AND TERMINATED BY A ZERO
*         WORD.
 
 
 MRT      BSSZ   MXRM+1      ACS MOUNT REQUEST TABLE
          TITLE  ACTIVATE PROCESSORS.
 PPU      SPACE  4,10
**        PPU - ACTIVATE PPU PROCESSORS.
*
*         EXIT   REQUIRED COPIES OF *1MT* ACTIVATED.
*
*         CALLS  SYS=.
 
 
 PPU      SUBR               ENTRY/EXIT
 
*         INITIALIZE UNIT MASKS AND REQUEST COUNT.  UNIT CHECK IS
*         PERFORMED EVERY 2 SECONDS.
 
          TA1    -UNITL,UBUF
          SA2    ITIM
          SA3    APRQ
          SX5    B0          INITIALIZE *1MT* UNIT REQUEST MASK
          SX4    B0          INITIALIZE *1MT* UNIT CHECK MASK
          SB7    B0          INITIALIZE *1MT* REQUEST COUNT
          SX6    B1
          MX7    12
          LX2    59-1
          SB6    X3+         INITIALIZE *1MU* REQUEST FLAG
          PL     X2,PPU1     IF NOT 2 SECOND INTERVAL
          SB7    2           INDICATE 2 SECOND INTERVAL *1MT* CALL
          MX4    MUNIT       SET TO CHECK ALL UNITS
          SB6    B1          SET TO CALL *1MU*
 
*         CHECK UDT FOR REQUESTS.
 
 PPU1     SA1    A1+UNITL+UXRQ  CHECK FOR REQUEST
          LX6    -1          ADVANCE REQUEST MASK
          BX2    X7*X1
          ZR     X1,PPU1     IF NO REQUEST
          NG     X1,PPU3     IF END OF UDT
          LX1    18
          NZ     X2,PPU1     IF REQUEST IN PROGRESS OR COMPLETE
          AX1    54          FUNCTION CODE
          SX1    X1-MDFN
          PL     X1,PPU2     IF *1MU* REQUEST
          SB7    B7+B1       COUNT *1MT* REQUEST
          BX5    X5+X6       UPDATE UNIT REQUEST MASK
          EQ     PPU1        CHECK NEXT UNIT
 
 PPU2     SB6    B1          INDICATE *1MU* REQUEST
          EQ     PPU1        CHECK NEXT UNIT
 
*         BUILD SPECIAL PP CALL.
 
 PPU3     SX6    3RSPC
          SX2    PPIW
          LX6    42
          SX3    3R1MT
          BX6    X6+X2       BUILD *SPC* CALL
          LX3    42
          MX0    1
 
*         ACTIVATE *1MT* PROCESSORS.
 
          SA2    CST+CPST-CSTE
 PPU4     SA2    A2+CSTE     CHECK  *1MT* STATUS
          SA1    A2+CUAC-CPST
          ZR     X2,PPU5     IF ALL CHANNELS CHECKED
          NG     X2,PPU4     IF *1MT* ALREADY ACTIVE
          BX7    X4+X5
          BX7    X7*X1
          ZR     X7,PPU4     IF NO PROCESSING FOR THIS CHANNEL
          BX4    -X1*X4      CLEAR UNITS TO BE CHECKED ON CHANNEL
          SX1    370000B
          SX7    A2          CST ADDRESS
          BX1    X1*X2       CHANNEL NUMBER
          BX7    X3+X7       BUILD *1MT* CALL
          BX7    X7+X1
          SA7    PPIW        SET PP REQUEST WORD
          BX7    X2+X0       SET *1MT* ACTIVE
          SA7    A2
          RJ     SYS=        CALL *1MT*
          SA1    PPIW
          NZ     X1,PPU6     IF PP NOT ASSIGNED
          GT     B7,B1,PPU4  IF MULTIPLE REQUESTS OR 2 SECOND INTERVAL
 
*         ACTIVATE *1MU*.
 
 PPU5     ZR     B6,PPUX     IF NO *1MU* REQUEST
          SA2    APS
          NG     X2,PPUX     IF *1MU* ALREADY ACTIVE
          SX7    3R1MU
          LX7    42
          SA7    PPIW
          BX7    X2+X0       SET *1MU* ACTIVE
          SA7    A2
          RJ     SYS=        CALL *1MU*
          SA1    PPIW
          NZ     X1,PPU6     IF PP NOT ASSIGNED
          SX6    B0+
          SA6    APRQ        CLEAR *1MU* REQUEST FLAG
          EQ     PPUX        RETURN
 
*         PROCESS PP NOT ASSIGNED.
 
 PPU6     BX7    -X0*X7      CLEAR PROCESSOR ACTIVE
          SA7    A7
          EQ     PPUX        RETURN
          TITLE  INTER CONTROL POINT REQUEST PROCESSING.
 CPR      SPACE  4,10
**        CPR - PROCESS INTER-CONTROL POINT REQUEST.
*
*         ENTRY  (X5) = 12/ CODE,48/ PARAMETERS.
*                (A5) = *RCAL*.
 
 
 CPRX     SX6    B0+         SET REQUEST COMPLETE
          SA6    RCAL
 
 CPR      PS                 ENTRY/EXIT
          BX1    X5
          SX2    X5+         WORD COUNT OF REQUEST
          AX1    48          REQUEST CODE
          SX6    X1-CRMX
          SX3    X1-RUU
          ZR     X1,ICR      IF INCORRECT REQUEST
          PL     X6,ICR      IF INCORRECT REQUEST
          SA1    TCPR+X1
          ZR     X3,XUD      IF *RUU* REQUEST
          MX0    -12
          SB3    X1+         SET PROCESSOR ADDRESS
          LX1    -24
          BX3    -X0*X1      MINIMUM WORD COUNT
          LX1    -12
          IX3    X2-X3
          BX4    -X0*X1      MAXIMUM WORD COUNT
          NG     X3,ICR      IF WORD COUNT .LT. MINIMUM
          IX4    X4-X2
          NG     X4,ICR      IF WORD COUNT .GT. MAXIMUM
 
*         EXIT TO PROCESSOR WITH -
*
*         (X5) = (RCAL).
*         (A5) = *RCAL*.
 
          JP     B3          EXIT TO REQUEST PROCESSOR
 TCPR     SPACE  4,10
**        TCPR - TABLE OF INTER CONTROL POINT REQUEST PROCESSORS.
*
*         ONE WORD PER ENTRY -
*
*T        12/0,12/ MAXL,12/ MINL,6/0,18/ PADD
*
*         MAXL   MAXIMUM LENGTH OF REQUEST.
*         MINL   MINIMUM LENGTH OF REQUEST.
*         PADD   REQUEST PROCESSOR ADDRESS.
 
 
 TCPR     IVFD
          IVFD   RMA,(12/0,12/13B,12/13B,6/0,18/ASU)
          IVFD   SEV,(12/0,12/RCALL,12/1,6/0,18/CSA)
          IVFD   RER,(12/0,12/1,12/1,6/0,18/CSA)
          IVFD   TJE,(12/0,12/1,12/1,6/0,18/CSA)
          IVFD   QSR,(12/0,12/PFTBL,12/PFTBL,6/0,18/CSA)
          IVFD   AIB,(12/0,12/2,12/1,6/0,18/CSA)
          IVFD   ACR,(12/0,12/3,12/3,6/0,18/RAR)
          IVFD   AMR,(12/0,12/MXRM+1,12/1,6/0,18/TMR)
          IVFD   PDU,(12/0,12/1,12/1,6/0,18/RDP)
          IVFD   CRMX
 ASU      SPACE  4,30
**        ASU - ASSIGN UNIT.
*
*         ENTRY
*
*T RCAL   12/ FC,12/ UDTO,18/,18/ WC
*T,       60/ *UVSN* FOR VERIFICATION
*T,       60/ *UMST* FOR VERIFICATION
*T,       60/ *UST4*
*T,       60/ *UVRI*
*T,       60/ *UTMS*
*T,       60/ *UTCI*
*T,       60/ *UESN*
*T,       60/ *UISN*
*T,       60/ *UUFN*
*T,       24/ JSN,12/0,12/ VP,12/ VS
*
*         FC     FUNCTION CODE = *RMA*.
*         UDTO   UDT ORDINAL.
*         WC     WORD COUNT OF REQUEST = 13B.
*         JSN    JOB SEQUENCE NAME (STAGING REQUEST ONLY).
*         VP     STAGING TAPE TWO-CHARACTER VSN PREFIX.
*         VS     STAGING TAPE NUMERIC VSN SUFFIX (0000 TO 4095).
*
*         CALLS  SUA, /STAGE/FJE.
*
*         MACROS MOVE.
 
 
 ASU      BSS    0           ENTRY
 
*         SET UDT ADDRESSS AND UDT ORDINAL.
 
          AX5    36
          RJ     SUA         SET UDT ADDRESS
          PL     X6,ICR      IF INCORRECT UDT ORDINAL
 
*         VERIFY NO CHANGE IN UDT AND CHECK UNIT ACTIVITY.
 
          SA1    A0+UVSN
          SA2    RCAL+1
          SA3    A0+UMST
          SA4    A2+B1
          BX2    X1-X2       VERIFY *UVSN*
          BX4    X3-X4       VERIFY *UMST*
          BX0    X2+X4
          SA1    A0+UVRI
          SA3    A0+UREQ
          NZ     X2,CPRX     IF NO MATCH
          NZ     X4,CPRX     IF NO MATCH
          NG     X0,CPRX     IF NO MATCH
          NZ     X1,CPRX     IF UNIT ALREADY ASSIGNED OR UNIT SWAP
          NZ     X3,CPRX     IF PROCESSOR ACTIVE
 
*         SET TAPE DESCRIPTORS AND CHECK CONVERSION MODE AND DENSITY.
 
          SA2    RCAL+3      GET TAPE DESCRIPTORS
          SA1    A0+UST5
          MX0    -3
          BX6    X2
          LX0    48
          SA6    A0+UST4     INITIALIZE *UST4*
          BX7    -X0*X1      CURRENT CONVERSION MODE
          NZ     X7,ASU1     IF CONVERSION MODE DETERMINED
          BX7    -X0*X2      REQUESTED CONVERSION MODE
          BX1    X1+X7       SET CURRENT CONVERSION MODE TO REQUESTED
 ASU1     LX0    3
          BX7    -X0*X1      CURRENT DENSITY
          NZ     X7,ASU2     IF DENSITY DETERMINED
          BX7    -X0*X2      REQUESTED DENSITY
          BX1    X1+X7       SET CURRENT DENSITY TO REQUESTED
 ASU2     BX7    X1
          SA7    A1          UPDATE DENSITY AND CONVERSION
 
*         SET JOB ASSIGNMENT INFORMATION.
 
          MOVE   UUFN-UVRI+1,RCAL+4,A0+UVRI
 
*         INCREMENT ASSIGNED UNIT COUNT AND ENABLE FILE REQUESTS.
 
          SA1    NTAS
          SX7    B0+
          SA7    A0+UFRQ     ENABLE FILE REQUESTS
          SX6    X1+B1       INCREMENT ASSIGNED UNIT COUNT
          SA6    A1
 
*         PROCESS STAGING TAPE PARAMETERS.
 
          SA1    TAJP
          ZR     X1,CPRX     IF TAPE ALTERNATE STORAGE NOT ACTIVE
          SA3    RCAL+12B    CHECK FOR PACKED VSN
          MX4    -24
          BX4    -X4*X3
          ZR     X4,CPRX     IF NOT ASSIGNMENT OF STAGING TAPE
          MX6    24
          BX5    X6*X3
          ZR     X5,ICR      IF NO JSN PRESENT
          RJ     /STAGE/FJE  FIND JOB ENTRY IN ACTIVE JOB TABLE
          NZ     X7,ICR      IF NO CORRESPONDING JOB ENTRY
          MX6    -24
          BX3    -X6*X1      CHECK FOR EXISTING VSN
          NZ     X3,ICR      IF JOB ALREADY HAS VSN ASSIGNED
          SA2    /STAGE/MVSN
          BX6    X1+X4       SET VSN INTO JOB ENTRY
          SA6    A1
          ZR     X2,CPRX     IF NO MORE VSN-S WAITING FOR PROCESSING
          SA1    /STAGE/SJIF CHECK STAGING JOB INITIATION FLAG
          NZ     X1,CPRX     IF INITIATION FLAG ALREADY SET
          MX6    59          FORCE STAGING JOB INITIATION
          SA6    A1
          EQ     CPRX        RETURN
 CSA      SPACE  4,10
**        CSA - CHECK TAPE ALTERNATE STORAGE ACTIVE.
 
 
 CSA      BSS    0           ENTRY
          SA1    TAJP
          NZ     X1,/STAGE/CRJ  IF TAPE ALTERNATE STORAGE ACTIVE
          EQ     ICR         PROCESS INCORRECT REQUEST
 RAR      SPACE  4,15
**        RAR - RECEIVE ATF RESPONSE.
*
*         ENTRY
*
*T RCAL   12/ FC,30/,18/ WC
*T,       60/ *RQHD* RESPONSE WORD
*T,       60/ *RQP1* RESPONSE WORD
*
*         FC     FUNCTION CODE = *ACR*.
*         WC     WORD COUNT OF REQUEST = 3.
*
*         CALLS  DAU, PVD, PVE.
 
 
 RAR      BSS    0           ENTRY
 
*         FIND UNIT FOR RESPONSE.
 
          SA1    RCAL+1+/ATF/RQHD  GET RESPONSE HEADER
          SB2    -1
          TB3    -UNITL,UBUF
          TB4    0,UBUF,LWA
          SX0    11B
          MX7    22
          LX7    -2
 RAR1     SB3    B3+UNITL    ADVANCE UDT ADDRESS
          EQ     B3,B4,RAR8  IF END OF UDT ENTRIES
          SA3    B3+UMST
          SB2    B2+B1       ADVANCE UDT ORDINAL
          BX2    X0*X3
          SX2    X2-1
          NZ     X2,RAR1     IF NOT WAITING FOR RESPONSE
          SA4    B3+UARP
          BX2    X4-X1       COMPARE REQUEST ID AND CODE
          BX2    X7*X2
          NZ     X2,RAR1     IF RESPONSE NOT FOR THIS UNIT
          SA0    B3+         SET UDT ADDRESS
 
*         CONVERT RESPONSE CODE TO INTERNAL FORMAT.
 
          SA2    TARS-1
          MX6    -12
          LX1    -24         POSITION RESPONSE CODE
 RAR2     SA2    A2+1
          ZR     X2,RAR3     IF RESPONSE CODE NOT FOUND
          BX7    X1-X2
          BX7    -X6*X7
          NZ     X7,RAR2     IF NO MATCH
 RAR3     SB3    A2-TARS     INTERNAL RESPONSE CODE
          SX2    B3
          BX6    X3
          LX2    30
          SA6    RARA        SAVE ENTRY *UMST*
          BX7    X4+X2       SET RESPONSE CODE IN *UARP*
          LX6    59-1
          SA7    A4
          NG     X6,RAR6     IF DISMOUNT OPERATION
 
*         CHECK STATUS OF MOUNT OPERATION.
 
          ZR     B3,RAR5     IF NORMAL COMPLETION
          MX6    -22
          LX6    2
          BX6    -X6*X3      CLEAR VSN AND STATUS
          SB4    B3-/ATF/MXVE
          SX0    B1
          NG     B4,RAR4     IF VSN ERROR
          LX0    2
          BX6    X6+X0       SET CONTROL PATH ERROR
 RAR4     SA6    A3+         UPDATE *UMST*
          SA1    RARA        GET VSN
          RJ     PVE         PROCESS VSN ERROR
          RJ     PVD         PROCESS VOLUME IN DRIVE ERROR
          EQ     CPRX        SET REQUEST COMPLETE
 
 RAR5     SA2    RCAL+1+/ATF/RQP1
          TX1    0,UACI
          LX1    3
          MX6    48
          MX7    57
          BX6    X6*X3
          BX7    X7*X2       VSN AND DRIVE IDENTIFICATION FROM RESPONSE
          BX6    X6+X1       VSN AND DRIVE IDENTIFICATION FROM REQUEST
          BX6    X6-X7
          SX0    B1+B1
          NZ     X6,RAR8     IF INCORRECT VSN AND DRIVE IN RESPONSE
          MX6    58
          BX3    X6*X3
          BX6    X3+X0       SET MOUNTED STATUS
          SA6    A3          UPDATE *UMST*
          EQ     CPRX        SET REQUEST COMPLETE
 
*         CHECK STATUS OF DISMOUNT OPERATION.
 
 RAR6     MX6    -22
          LX6    2
          BX6    -X6*X3      CLEAR VSN AND MOUNT STATUS
          SX0    B1
          ZR     B3,RAR7     IF NORMAL COMPLETION
          LX0    2
          BX6    X6+X0       SET CONTROL PATH ERROR
 RAR7     SA6    A3          UPDATE *UMST*
          EQ     CPRX        SET REQUEST COMPLETE
 
*         UPDATE NO REQUEST OUTSTANDING COUNT.
 
 RAR8     SA1    ANRC        COUNT NO REQUEST OUTSTANDING
          SX6    B1
          IX6    X1+X6       UPDATE COUNT
          SA6    A1
          EQ     CPRX        SET REQUEST COMPLETE
 
 
 RARA     CON    0           *UMST* ENTRY VALUE
 TARS     SPACE  4,10
**        TARS - TABLE OF ATF RESPONSE CODES.
*
*         INDEXED BY *COMSATF* FORMAT RESPONSE CODE.
*
*         ENTRY FORMAT -
*
*         18/ MNEM,30/0,12/ SRC
*
*         MNEM   3 CHARACTER MNEMONIC.
*         SRC    SERVER FORMAT RESPONSE CODE.
 
 
 TARS     IVFD
 
          IVFD   /ATF/SUC,(18/3RSUC,30/0,12/0)    SUCCESS
          IVFD   /ATF/NSA,(18/3RNSA,30/0,12/69)   NOT IN SAME ACS
          IVFD   /ATF/URL,(18/3RURL,30/0,12/95)   UNREADABLE LABEL
          IVFD   /ATF/VNL,(18/3RVNL,30/0,12/94)   VOLUME NOT IN LIBRARY
          IVFD   /ATF/MTP,(18/3RMTP,30/0,12/65)   MISPLACED TAPE
          IVFD   /ATF/VID,(18/3RVID,30/0,12/91)   VOLUME IN DRIVE
          IVFD   /ATF/VIT,(18/3RVIT,30/0,12/99)   VOLUME IN TRANSIT
          IVFD   /ATF/VIU,(18/3RVIU,30/0,12/99)   VOLUME IN USE
          IVFD   /ATF/AFL,(18/3RAFL,30/0,12/1)    ACS FULL
          IVFD   /ATF/ANL,(18/3RANL,30/0,12/2)    ACS NOT IN LIBRARY
          IVFD   /ATF/AUD,(18/3RAUD,30/0,12/8)    AUDIT IN PROGRESS
          IVFD   /ATF/CAN,(18/3RCAN,30/0,12/9)    CANCELLED
          IVFD   /ATF/DBE,(18/3RDBE,30/0,12/23)   DATA BASE ERROR
          IVFD   /ATF/DAV,(18/3RDAV,30/0,12/28)   DRIVE AVAILABLE
          IVFD   /ATF/DNL,(18/3RDNL,30/0,12/30)   DRIVE NOT IN LIBRARY
          IVFD   /ATF/DOF,(18/3RDOF,30/0,12/31)   DRIVE OFFLINE
          IVFD   /ATF/DIU,(18/3RDIU,30/0,12/29)   DRIVE IN USE
          IVFD   /ATF/LBS,(18/3RLBS,30/0,12/55)   LIBRARY BUSY
          IVFD   /ATF/LFA,(18/3RLFA,30/0,12/56)   LIBRARY FAILURE
          IVFD   /ATF/LNA,(18/3RLNA,30/0,12/57)   LIBRARY NOT AVAILABLE
          IVFD   /ATF/LNL,(18/3RLNL,30/0,12/60)   LSM NOT IN LIBRARY
          IVFD   /ATF/LOF,(18/3RLOF,30/0,12/61)   LSM OFFLINE
          IVFD   /ATF/PFA,(18/3RPFA,30/0,12/74)   PROCESS FAILURE
 
          IVFD   /ATF/MXRS-1
          ERRNZ  /ATF/MXRS-1-/ATF/RQE
 
          CON    0           TABLE TERMINATOR
 RDP      SPACE  4,10
**        RDP - REQUEST PREVIEW DISPLAY PROMPT.
*
*         ENTRY
*
*T RCAL   12/ FC,12/0,18/ PBL,18/ WC
*
*         FC     FUNCTION CODE = *PDU*.
*         PBL    LENGTH OF ENTRIES IN PREVIEW BUFFER.
*         WC     WORD COUNT OF REQUEST = 1.
 
 
 RDP      BSS    0           ENTRY
          SA1    PBFL        GET PREVIOUS PREVIEW BUFFER LENGTH
          LX5    -18
          SX6    X5          NEW PREVIEW BUFFER LENGTH
          SA6    A1          PREVIEW BUFFER LENGTH
          IX6    X1-X6
          PL     X6,CPRX     IF NOT NEW REQUEST
          SA6    OPRF        SET NEW REQUEST FLAG
          EQ     CPRX        RETURN
 TMR      SPACE  4,15
**        TMR - TRANSFER ACS MOUNT REQUESTS.
*
*         ENTRY
*
*T RCAL   12/ FC,42/0,18/ WC
*
*         FC     FUNCTION CODE = *AMR*.
*         WC     WORD COUNT OF REQUESTS + 1.
*
*         MACROS MOVE.
 
 
 TMR      BSS    0           ENTRY
          SX1    X5-1        SET LENGTH OF ENTRIES
          SX2    RCAL+1      SET SOURCE ADDRESS
          SX3    MRT         SET DESTINATION ADDRESS
          MOVE   X1,X2,X3    UPDATE MRT
          SX6    B0
          MX7    1
          SA6    MRT-1+X5    TERMINATE ENTRIES
          SA7    ACRF        SET MOUNT REQUEST FLAG
          EQ     CPRX        RETURN
 XUD      SPACE  4,15
**        XUD - EXTERNAL UDT UPDATE.
*
*         ENTRY
*
*T  RCAL  12/ FC,18/ 0,6/ FW,6/ WC,18/ UDTA
*T,       60/ UPDATE WORD 1
*T,       60/ UPDATE WORD 2
*T,       60/ UPDATE WORD 3
*T,       60/ UPDATE WORD 4
*T,       60/ UPDATE WORD 5
*
*         FC     FUNCTION CODE = *RUU*.
*         FW     INDEX INTO ENTRY OF FIRST WORD TO UPDATE.
*         WC     NUMBER OF WORDS TO UPDATE (1 - 5).
*         UDTA   ADDRESS OF UDT ENTRY TO UPDATE.
 
 
 XUD      BSS    0           ENTRY
          TX7    X5,-UBUF
          TX3    X5,-UBUF,LWA
          BX2    -X3-X7
          NG     X2,ICR      IF INCORRECT UDT ADDRESS
          SA0    X5          (A0) = UDT ADDRESS
          MX0    -6
          AX5    18
          BX6    -X0*X5
          AX5    6
          BX7    -X0*X5
          SB2    X6          (B2) = WORD COUNT
          SB3    X7          (B3) = UDT OFF-SET
 XUD1     LE     B2,CPRX     IF LAST UPDATE WORD
          SA5    A5+B1
          BX7    X5
          SA7    A0+B3
          SB2    B2-B1
          SB3    B3+B1
          EQ     XUD1        GET NEXT UPDATE WORD
 ICR      SPACE  4,10
**        ICR - PROCESS INCORRECT INTER-CONTROL POINT REQUEST.
*
*         ENTRY  (RCAL) = REQUEST.
*
*         EXIT   TO *CPRX*.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*
*         CALLS  IXR.
 
 
 ICR      BSS    0           ENTRY
          SA1    RCAL        GET REQUEST
          SA2    ICRA        SET MESSAGE TEXT
          RJ     IXR
          EQ     CPRX        EXIT
 
 
 ICRA     DATA   5L CPR.
          TITLE  SEND ATF REQUEST.
 SAR      SPACE  4,15
**        SAR - SEND ATF REQUEST.
*
*         EXIT   REQUEST SENT TO ATF IF FOUND.
*                (ATFS) = 0 IF NO REQUESTS REMAINING TO BE SENT.
*                (ATFS) .NE. 0 IF REMAINING REQUESTS TO SEND.
*                (ACRT) = TIME OF FIRST REJECT IF ATF REQUEST REJECTED.
*
*         CALLS  SYS=.
 
 
 SAR6     SX6    B0+         SET NO REQUESTS WAITING
          SA6    ATFS
 
 SAR      SUBR               ENTRY/EXIT
          SA1    SARD
          ZR     X1,SAR1     IF NO REJECT OF PREVIOUS REQUEST
          SB3    X1          SET UDT ADDRESS
          SX0    B0          INDICATE RETRY OF PREVIOUS REQUEST
          SA3    B3+UMST     GET *UMST*
          SA4    B3+UARP     GET *UARP*
          EQ     SAR3        RETRY LAST REQUEST
 
*         SEARCH FOR REQUEST TO BE SENT.
 
 SAR1     TB3    -UNITL,UBUF
          TB4    0,UBUF,LWA
          SX0    10B
 SAR2     SB3    B3+UNITL
          EQ     B3,B4,SAR6  IF END OF UDT ENTRIES
          SA3    B3+UMST
          BX1    X0*X3       SEND REQUEST FLAG
          ZR     X1,SAR2     IF NOT SEND REQUEST
 
*         BUILD ATF REQUEST.
 
          MX6    48
          SA4    B3+UARP
          TX1    0,UACI
          MX7    22
          LX1    3
          LX7    -2
          BX6    X6*X3       VSN AND DRIVE IDENTIFIER
          BX7    X7*X4       REQUEST CODE AND REQUEST IDENTIFIER
          BX6    X6+X1       MERGE ACS IDENTIFIER
          SA7    SARB+1+/ATF/RQHD  SET REQUEST HEADER
          SA6    SARB+1+/ATF/RQP1  SET PARAMETERS
 
*         SEND REQUEST TO ATF.
 
 SAR3     SA1    SARA
          SX7    ATSI
          LX7    30
          SA7    SARC        SET BUFFER NUMBER AND SUBSYSTEM ID
          BX6    X1          SET *SIC* CALL
          RJ     SYS=        SEND REQUEST TO ATF
          SA1    SARC
          SA2    RTIM
          SB4    X1
          AX2    36          REAL TIME SECONDS
          NE     B4,B1,SAR4  IF REQUEST NOT ACCEPTED
          SX6    10B
          SX7    /ATF/RSTO   RESPONSE TIME OUT DELAY
          BX6    -X6*X3      CLEAR SEND REQUEST FLAG
          IX7    X2+X7       RESPONSE TIME OUT
          SA6    A3          UPDATE STATUS
          BX7    X4+X7       SET RESPONSE TIME OUT
          SX6    B0
          SA7    A4          UPDATE REQUEST PARAMETERS
          SA6    SARD        INDICATE REQUEST ACCEPTED
          EQ     SAR5        CLEAR NO RESPONSE FLAG
 
 SAR4     ZR     X0,SARX     IF NOT FIRST REJECT OF REQUEST
          SX6    /ATF/ICTO   SET ATF REJECT TIME OUT
          SX7    B3
          IX6    X2+X6       ATF NO RESPONSE TIME
          SA7    SARD        SET UDT ADDRESS OF REJECTED REQUEST
 SAR5     SA6    ACRT        UPDATE ACS NO RESPONSE FLAG
          EQ     SARX        RETURN
 
 
 SARA     VFD    18/3RSIC,6/0,18/SARB,18/SARC
 
 SARB     CON    3           REQUEST BLOCK LENGTH
          BSSZ   2           ATF REQUEST
 
 SARC     VFD    18/0,12/ATSI,30/0  STATUS WORD
 
 SARD     CON    0           UDT ADDRESS IF REQUEST PREVIOUSLY REJECTED
          TITLE  EXTERNAL PP REQUEST PROCESSING.
 PXR      SPACE  4,15
**        PXR - PROCESS EXTERNAL PP REQUEST.
*
*         ENTRY  (X5) = REQUEST.
*                (A5) = *XREQ*
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/ PARAM
*
*         FC     FUNCTION CODE.
*         UDTO   UDT ORDINAL.
*         PARAM  VALUE DEPENDS ON FUNCTION CODE.
*
*         CALLS  SUA.
 
 
 PXRX     SX6    B0+         SET REQUEST PROCESSED
          SA6    XREQ
 
 PXR      PS                 ENTRY/EXIT
 
*         CHECK REQUEST TYPE.
 
          BX6    X5
          AX6    48          REQUEST CODE
          SB3    X6-XRMX
          ZR     X6,IXP      IF NOT VALID REQUEST CODE
          PL     B3,IXP      IF NOT VALID REQUEST CODE
          SA1    TXRP+X6     GET PROCESSOR ADDRESS AND FUNCTION FLAGS
          LX5    -36
          RJ     SUA         SET UDT ADDRESS
          PL     X6,IXP      IF INCORRECT UDT ORDINAL
 
*         DETERMINE IF REQUEST CAN BE PROCESSED.
 
          SA2    A0+UST1
          SB3    X1          SET PROCESSOR ADDRESS
          BX6    X1
          LX1    59-20
          LX2    59-49
          LX6    59-18
          PL     X2,PXR1     IF NOT ACS UNIT
          LX6    59-19-59+18
 PXR1     PL     X6,IXP      IF REQUEST NOT VALID FOR UNIT TYPE
          PL     X1,PXR2     IF NO ACTIVITY CHECK REQUIRED
          SA1    A0+UREQ
          SA2    A0+UVRI
          NZ     X1,PXRX     IF PROCESSOR ACTIVE
          NZ     X2,PXRX     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
 PXR2     MX0    36
          BX1    X0*X5       SET PARAMETER
 
*         EXIT TO PROCESSOR WITH -
*
*         (X0) = 36 BIT MASK LEFT JUSTIFIED.
*         (X1) = BITS 0 - 35 OF REQUEST LEFT JUSTIFIED.
*         (X5) = REQUEST SHIFTED LEFT CIRCULAR 24 BITS.
*         (A0) = UDT ADDRESS.
*         (B2) = UDT ORDINAL.
 
          JP     B3          EXIT TO REQUEST PROCESSOR
 TXRP     SPACE  4,15
**        TXRP - TABLE OF EXTERNAL REQUEST PROCESSORS.
*
*         ONE WORD PER ENTRY -
*
*T        39/0,1/R,1/A,1/N,18/ PADD
*
*         R      REJECT REQUEST IF UNIT ASSIGNED TO JOB OR REQUEST
*                  ACTIVE ON UNIT.
*         A      REQUEST ALLOWED ON ACS UNITS.
*         N      REQUEST ALLOWED ON NON-ACS UNITS.
*         PADD   REQUEST PROCESSOR ADDRESS.
 
 
 TXRP     IVFD
          IVFD   XEV,(39/0,1/1,1/0,1/1,18/EVS)  ENTER VSN
          IVFD   XUU,(39/0,1/1,1/1,1/1,18/UNL)  UNLOAD UNIT
          IVFD   XSV,(39/0,1/1,1/0,1/1,18/ESV)  ENTER SCRATCH VSN
          IVFD   XRT,(39/0,1/0,1/1,1/1,18/SRT)  SET *RETRY* FLAG
          IVFD   XUG,(39/0,1/0,1/1,1/1,18/UGO)  UNIT GO (TMS)
          IVFD   XUS,(39/0,1/0,1/1,1/1,18/UST)  UNIT STOP (TMS)
          IVFD   XTR,(39/0,1/0,1/1,1/1,18/STR)  SET *TERMINATE* FLAG
          IVFD   XMU,(39/0,1/1,1/1,1/0,18/AMU)  ACS UNIT MOUNT
          IVFD   XNV,(39/0,1/0,1/0,1/1,18/NVS)  SPECIFY NEXT VSN
          IVFD   XRMX
 AMU      SPACE  4,15
**        AMU - ACS VSN MOUNT ON SPECIFIED UNIT.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/ VSN
*
*         FC     FUNCTION CODE = *XMU*.
*         UDTO   UDT ORDINAL.
*         VSN    VSN TO MOUNT.
*
*         CALLS  FAV, MAV.
 
 
 AMU      BSS    0           ENTRY
          SA2    ACCU
          SA3    A0+UMST
          MX7    -3
          LX2    B2
          BX3    -X7*X3
          PL     X2,PXRX     IF UNIT NOT ACCESSIBLE
          NZ     X3,PXRX     IF MOUNT OR DISMOUNT OR CONTROL PATH ERROR
          RJ     FAV         FIND ACS VSN
          NZ     B3,PXRX     IF ACTIVITY OR ERROR ON VSN
          SB6    A0+         SET UNIT FOR MOUNT
          RJ     MAV         MOUNT VSN
          EQ     PXRX        EXIT
 ESV      SPACE  4,10
**        ESV - ENTER SCRATCH VSN.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XSV*.
*         UDTO   UDT ORDINAL.
*
*         CALLS  CLS.
 
 
 ESV      BSS    0           ENTRY
          RJ     CLS         CHECK LABELS READ STATUS
          SX3    B1
          LX3    22-0
          BX6    X3+X2       SET SCRATCH FLAG
          SA6    A2
          SX7    PVSE        ISSUE VSN EVENT
          EQ     MQX         MAKE REQUEST AND EXIT
 EVS      SPACE  4,15
**        EVS - ENTER VSN.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/ VSN
*
*         FC     FUNCTION CODE = *XEV*.
*         UDTO   UDT ORDINAL.
*         VSN    VSN TO ENTER ON UNIT.
*
*         CALLS  CLS.
 
 
 EVS      BSS    0           ENTRY
          RJ     CLS         CHECK LABELS READ STATUS
          ZR     X1,EVS1     IF CLEARING VSN
          SX3    B1
          BX2    -X0*X2      PRESERVE *UVSN* FLAGS
          LX3    14-0
          BX2    X1+X2       MERGE VSN
          BX6    -X3*X2      CLEAR DEFAULT VSN FLAG
          BX3    X3*X2       EXTRACT DEFAULT VSN FLAG
          ZR     X3,PXRX     IF NOT DEFAULT VSN
          SA6    A2+
          SX7    PVSE        ISSUE VSN EVENT
          EQ     MQX         MAKE REQUEST AND EXIT
 
 EVS1     SX7    PCVS        CLEAR VSN
          EQ     MQX         EXIT
 NVS      SPACE  4,15
**        NVS - SPECIFY NEXT VSN.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/ VSN
*
*         FC     FUNCTION CODE = *XNV*.
*         UDTO   UDT ORDINAL.
*         VSN    NEXT VSN TO REQUEST.
*
*         CALLS  CLS.
 
 
 NVS      BSS    0           ENTRY
          SA2    A0+UVRI
          SA4    A0+UISN
          SA3    A0+UESN
          MX6    -6
          LX2    59-0
          LX4    -12
          PL     X2,PXRX     IF NO OPERATOR PROMPT
          BX6    -X6*X4      PREVIEW DISPLAY MESSAGE CODE
          LX4    12
          SX6    X6-/RSX/NTV
          BX3    -X0*X3
          NZ     X6,PXRX     IF NO REQUEST FOR NEXT VSN
          BX4    -X0*X4
          BX6    X3+X1       SET EXTERNAL VSN
          BX7    X4+X1       SET INTERNAL VSN
          SA6    A3
          SA7    A4+
          EQ     PXRX        EXIT
 SRT      SPACE  4,10
**        SRT - SET *RETRY* FLAG.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XRT*.
*         UDTO   UDT ORDINAL.
 
 
 SRT      BSS    0           ENTRY
          SB3    51
          EQ     SFL         SET *RETRY* FLAG
 STR      SPACE  4,10
**        STR - SET *TERMINATE* FLAG.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XTR*.
*         UDTO   UDT ORDINAL.
 
 
 STR      BSS    0           ENTRY
          SB3    52
          EQ     SFL         SET *TERMINATE* FLAG
 UGO      SPACE  4,10
**        UGO - CLEAR TMS UNIT GO FLAG.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XUG*.
*         UDTO   UDT ORDINAL.
 
 
 UGO      BSS    0           ENTRY
          SX6    B0+         DO NOT SET UNLOAD FLAG
          EQ     CUG         CLEAR UNIT GO FLAG
 UST      SPACE  4,10
**        UST - SET TMS UNIT UNLOAD FLAG.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XUS*.
*         UDTO   UDT ORDINAL.
 
 
 UST      BSS    0           ENTRY
          SX6    40000B      SET UNLOAD FLAG
          EQ     CUG         CLEAR UNIT GO FLAG
 UNL      SPACE  4,10
**        UNL - UNLOAD UNIT.
*
*         ENTRY
*
*T XREQ   6/0, 6/ FC, 12/ UDTO, 36/
*
*         FC     FUNCTION CODE = *XUU*.
*         UDTO   UDT ORDINAL.
*
*         CALLS  CLS.
 
 
 UNL      BSS    0           ENTRY
          RJ     CLS         CHECK LABELS READ STATUS
          SX7    PULR        UNLOAD UNIT AND CLEAR VSN
          EQ     MQX         MAKE REQUEST AND EXIT
 CUG      SPACE  4,10
**        CUG - CLEAR TMS WAIT UNIT GO FLAG.
*
*         ENTRY  (X6) = 0 IF CLEAR UNIT GO FLAG ONLY.
*                (X6) = 40000B IF CLEAR UNIT GO FLAG AND SET UNLOAD
*                       FLAG.
*
*         EXIT   WAIT UNIT GO FLAG CLEARED.
*                UNLOAD FLAG SET IF REQUESTED.
 
 
 CUG      BSS    0           ENTRY
          SA1    A0+UTMS
          SA2    A0+UVRI
          LX1    59-23
          AX2    48
          ZR     X2,PXRX     IF UNIT NOT ASSIGNED
          MX7    -59
          PL     X1,PXRX     IF NOT WAITING FOR UNIT GO
          BX7    -X7*X1      CLEAR UNIT GO  FLAG
          LX7    23-23-59+23
          BX7    X7+X6       MERGE UNLOAD STATUS
          SA7    A1+
          EQ     PXRX        EXIT
 IXP      SPACE  4,10
**        IXP - PROCESS INCORRECT EXTERNAL PP REQUEST.
*
*         ENTRY  (XREQ) = REQUEST.
*
*         EXIT   TO *PXRX*.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*
*         CALLS  IXR.
 
 
 IXP      BSS    0           ENTRY
          SA1    XREQ        GET REQUEST
          SA2    IXPA        SET EXTERNAL PP REQUEST
          RJ     IXR         ISSUE EXTERNAL REQUEST ERROR MESSAGE
          EQ     PXRX        RETURN
 
 
 IXPA     DATA   5L PXR.
 CLS      SPACE  4,10
**        CLS - CHECK LABELS READ STATUS.
*
*         EXIT   (X2) = *UVSN*.
*                (A2) = ADDRESS OF *UVSN*.
*                TO CALLER IF INITIAL LABEL CHECK COMPLETE.
*                TO *PXRX* IF LABEL CHECK NOT PERFORMED OR IN PROGRESS.
*
*         USES   X - 2, 6.
*                A - 2.
 
 
 CLS      SUBR               ENTRY/EXIT
          SA2    A0+UVSN
          ZR     X2,PXRX     IF LABEL CHECK NOT PERFORMED
          BX6    X2
          LX6    59-23
          NG     X6,PXRX     IF LABEL CHECK IN PROGRESS
          EQ     CLSX        RETURN
 MQX      SPACE  4,10
**        MQX - MAKE QUEUE ENTRY FOR EXTERNAL REQUEST.
*
*         ENTRY  (X7) = REQUEST.
*
*         EXIT   TO *PXRX*.
*
*         USES   X - 5.
*
*         CALLS  MQE.
 
 
 MQX      BSS    0           ENTRY
          SX5    B0
          RJ     MQE         MAKE QUEUE ENTRY
          EQ     PXRX        EXIT
 SFL      SPACE  4,10
**        SFL - SET FLAG IN *UFLA*.
*
*         ENTRY  (B3) = BIT LOCATION OF FLAG.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 SFL      BSS    0           ENTRY
          SA1    A0+UFLA
          SX6    B1
          LX6    B3
          BX6    X1+X6
          SA6    A1
          EQ     PXRX        EXIT
          TITLE  PERIODIC PROCESSING.
 CAR      SPACE  4,10
**        CAR - CHECK ACS MOUNT REQUESTS.
*
*         ENTRY  (X1) = (ACRF).
*                (A1) = ADDRESS OF *ACRF*.
*
*         EXIT   MOUNT REQUEST MADE IF NECESSARY.
*
*         CALLS  FAV, MAV.
 
 
 CAR      SUBR               ENTRY/EXIT
          SX6    B0
          SB7    MRT
          SA6    A1
 CAR1     SA1    B7
          SB7    B7+B1       ADVANCE MRT POINTER
          ZR     X1,CARX     IF END OF MOUNT REQUESTS
          RJ     FAV         FIND VSN
          NZ     B3,CAR1     IF ACTIVITY OR ERROR ON VSN
          ZR     B6,CARX     IF NO UNIT AVAILABLE FOR MOUNT
          RJ     MAV         MOUNT VSN
          EQ     CAR1        CHECK NEXT ENTRY
 CAU      SPACE  4,10
**        CAU - CHECK ACS UNITS.
*
*         EXIT   VSN ERROR TABLE CLEARED.
*                MOUNT OR DISMOUNT OPERATION TERMINATED IF ACS SERVER
*                  REQUEST TIMED OUT.
*                CONTROL PATH ERROR CLEARED IN ACS UNIT UDT ENTRIES.
 
 
 CAU      SUBR               ENTRY/EXIT
          SX6    B0+         CLEAR VSN ERROR TABLE
          SA6    VET
          TB3    -UNITL,UBUF
          TB4    0,UBUF,LWA
          SX0    11B
          SX7    4
 CAU1     SB3    B3+UNITL
          EQ     B3,B4,CAUX  IF ALL UNITS CHECKED
          SA3    B3+UMST
          BX1    X0*X3
          BX6    X7*X3
          SX1    X1-1
          NZ     X6,CAU2     IF CONTROL PATH ERROR
          NZ     X1,CAU1     IF NOT WAITING FOR RESPONSE FROM SERVER
          SA2    RTIM
          SA4    B3+UARP
          MX6    -24
          AX2    36          REAL TIME SECONDS
          BX1    -X6*X4      RESPONSE TIME OUT
          IX1    X2-X1
          NG     X1,CAU1     IF NOT TIMED OUT
          SA1    ATRC        COUNT RESPONSE TIME OUT
          SX6    B1
          IX6    X1+X6
          SA6    A1+
 CAU2     MX6    -20
          LX6    4
          BX6    -X6*X3      CLEAR VSN AND STATUS FLAGS
          SA6    A3          SET DISMOUNTED STATUS
          EQ     CAU1        CHECK NEXT UNIT
 COR      SPACE  4,15
**        COR - CHECK OPERATOR REQUESTS.
*
*         ENTRY  (X1) = (OPRF) .LT. 0 IF NEW OPERATOR REQUEST.
*                (X1) = (OPRF) .GE. 0 IF NOT NEW OPERATOR REQUEST.
*                (A1) = ADDRESS OF *OPRF*.
*                (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*
*         EXIT   PREVIEW DISPLAY PROMPT ISSUED IF NEW OPERATOR REQUEST
*                  OR IF OLD OPERATOR REQUESTS AND DELAY EXPIRED.
*                PREVIEW DISPLAY PROMPT CLEARED IF NO OPERATOR
*                  REQUESTS.
*                (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*                (OPRF) = 0.
*
*         MACROS MESSAGE.
 
 
 COR      SUBR               ENTRY/EXIT
          SA4    RTIM
          SX6    B0+
          SA6    A1          CLEAR NEW REQUEST FLAG
          AX4    36          REAL TIME SECONDS
          NG     X1,COR3     IF NEW REQUEST
 
*         CHECK FOR OLD OPERATOR REQUESTS.
 
          SA3    PBFL
          TB3    B0,UBUF     SET UDT FWA
          TB4    B0,UBUF,LWA SET UDT LWA+1
          NZ     X3,COR2     IF PREVIEW REQUESTS PRESENT
 COR1     EQ     B3,B4,COR4  IF ALL UNITS CHECKED
          SA3    B3+UVRI
          SB3    B3+UNITL    ADVANCE UDT ADDRESS
          LX3    59-0
          PL     X3,COR1     IF NO PREVIEW DISPLAY MESSAGE
 
*         CHECK TIME DELAY.
 
 COR2     SA1    CORA
          ZR     X1,COR3     IF NO TIME DELAY
          IX1    X4-X1
          NG     X1,CORX     IF NOT TIME TO REISSUE MESSAGE
 
*         ISSUE MESSAGE.
 
 COR3     MESSAGE  CORB,2    * CHECK E,P DISPLAY*
          SX6    NTIM
          IX6    X4+X6       SET TIME FOR NEXT MESSAGE ISSUE
          SA6    CORA
          EQ     CORX        RETURN
 
*         INSURE MESSAGE CLEARED WHEN NO REQUESTS PRESENT.
 
 COR4     SA1    CORA
          ZR     X1,CORX     IF NO MESSAGE ISSUED
          SX6    B0          SET NO MESSAGE
          SA6    A1
          MESSAGE  =0,2      CLEAR MESSAGE
          EQ     CORX        RETURN
 
 
 CORA     CON    0           TIME FOR DELAYED MESSAGE REISSUE
 CORB     DATA   C*$CHECK E,P DISPLAY*
 CUA      SPACE  4,15
**        CUA - CHECK UNIT ACTIVITY.
*
*         ENTRY  (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*                (X1) = (CUAF).
*                (A1) = ADDRESS OF *CUAF*.
*
*         EXIT   (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*                LABEL CHECK INITIATED ON READY UNASSIGNED UNITS.
*                UNLOAD INITIATED ON ACS UNITS IF ASSIGNMENT TIMEOUT
*                  EXPIRED.
*                CLEAR OF LABEL INFORMATION INITIATED IF READY DROP
*                  DETECTED ON UNASSIGNED UNIT.
*
*         CALLS  MQE.
 
 
 CUA      SUBR               ENTRY/EXIT
 
*         INITIALIZE UNIT SCAN.
 
          SX6    B0+
          TA0    -UNITL,UBUF
          SB2    -1
          SA6    CUAF        CLEAR CHECK UNIT FLAG
 
*         CHECK FOR UNASSIGNED UNIT WITH NO ACTIVITY.
 
 CUA1     SA0    A0+UNITL    ADVANCE UDT ADDRESS
          TB3    A0,-UBUF,LWA
          ZR     B3,CUAX     IF ALL UNITS CHECKED
          SA1    A0+UVRI
          SB2    B2+1        ADVANCE UDT ORDINAL
          NZ     X1,CUA1     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
          SA1    ACCU
          SA2    A0+UST1
          SA3    A0+UREQ
          MX0    -2
          LX6    X1,B2
          SA1    A0+UVSN
          NZ     X3,CUA1     IF PROCESSOR ACTIVE
          BX0    -X0*X2      BUSY AND READY STATUS
          LX2    59-49       SET FOR ACS UNIT CHECK
          ZR     X1,CUA4     IF VSN NOT DEFINED
          ZR     X0,CUA3     IF UNIT NOT READY AND NOT BUSY
          PL     X6,CUA3     IF UNIT NOT ACCESSIBLE
 
*         CHECK FOR INCOMPLETE INITIAL LABEL CHECK.
*         THIS CAN OCCUR IF *1MT* RETURNED AN ERROR THAT TERMINATED THE
*         *PCLA* REQUEST PROCESSOR.
 
          LX1    59-23
          PL     X1,CUA2     IF NOT LABEL CHECK IN PROGRESS
          MX6    -59
          BX6    -X6*X1      CLEAR LABEL CHECK IN PROGRESS
          LX6    23-23-59+23
          SA6    A1+
          SX7    PCIL        COMPLETE LABEL CHECK
          EQ     CUA5        QUEUE REQUEST
 
*         CHECK TIME TO UNLOAD ACS UNIT.
 
 CUA2     PL     X2,CUA1     IF NOT ACS UNIT
          SA1    A0+UTIM
          SA2    RTIM
          SX6    ULTO        INACTIVE ACS UNIT UNLOAD TIMEOUT
          AX1    36          LABELS READ TIME
          AX2    36          CURRENT TIME
          IX1    X1+X6       TIME TO UNLOAD UNASSIGNED UNIT
          IX2    X2-X1
          NG     X2,CUA1     IF NOT TIME TO UNLOAD UNIT
          SX7    PULR        UNLOAD UNIT
          EQ     CUA5        QUEUE REQUEST
 
*         CLEAR LABEL INFORMATION ON UNLOADED OR INACCESSIBLE UNIT.
*         IF AN ACS UNIT, DISMOUNTED STATUS WILL BE SET ON THE
*         ASSUMPTION THAT A FORCED DISMOUNT WAS INITIATED FROM THE
*         LIBRARY SERVER CONSOLE.
 
 CUA3     SX7    PCVS
          PL     X2,CUA5     IF NOT ACS UNIT
          SA3    A0+UMST
          MX6    -20
          LX6    4
          BX6    -X6*X3      CLEAR VSN AND STATUS FLAGS
          SA6    A3          SET DISMOUNTED STATUS
          EQ     CUA5        QUEUE REQUEST
 
*         INITIATE LABEL READ OR UNIT CHECK.
*         *PCLA* WILL BE CALLED IMMEDIATELY WHEN AN ATS OR MTS UNIT
*         FIRST BECOMES ACCESSIBLE TO CHECK THE UNIT HARDWARE.
 
 CUA4     SA3    A0+UDS4
          LX0    59-1
          LX2    59-43-59+49
          NG     X0,CUA1     IF UNIT BUSY
          PL     X6,CUA1     IF UNIT NOT ACCESSIBLE
          SX7    PCLA        INITIATE LABEL CHECK
          NZ     X0,CUA5     IF UNIT READY
          NG     X2,CUA1     IF CTS UNIT
          NZ     X3,CUA1     IF INITIAL UNIT CHECK COMPLETE
 
*         ENTER QUEUED REQUEST.
 
 CUA5     SX5    B0
          RJ     MQE         MAKE QUEUE ENTRY
          SA5    ITIM        RESTORE INTERVAL TIMER
          LX5    59-1
          EQ     CUA1        CHECK NEXT UNIT
          TITLE  REQUEST PROCESSING.
 CUT      SPACE  4,10
**        CUT - CHECK UNIT DESCRIPTOR TABLE.
*
*         CALLS  GNR, GNS, GPI, MQE, PCR, PUR, SPR.
 
 
 CUT      SUBR               ENTRY/EXIT
          TA0    0,UBUF      SET FIRST UDT ADDRESS
          SB2    B0+         SET FIRST UDT ORDINAL
          EQ     CUT11       ENTER LOOP
 
*         PROCESS FILE REQUEST.
 
 CUT1     BX6    X3
          AX3    48
          SX1    X3-CIO
          ZR     X1,CUT2     IF *CIO* REQUEST
          SX1    X3-RTF
          NZ     X1,CUT10    IF NOT RETURN FILE REQUEST
          RJ     PUR         PRE-PROCESS UNIT RETURN
          EQ     CUT3        MAKE QUEUE ENTRY
 
 CUT2     SA3    A0+UCIA
          RJ     PCR         PRE-PROCESS *CIO* REQUEST
 
*         MAKE QUEUE ENTRY.
 
 CUT3     LX7    36
          SX3    12
          BX5    X5+X7
          LX3    48
          BX6    X5+X3
          IX4    X5+X3
          SA6    A4
 
*         PROCESS STRING CALL.
 
 CUT4     SA6    CUTB        SAVE REQUEST
          RJ     GNS         GET NEXT STRING ITEM
 CUT5     ZR     X7,CUT8     IF END OF STRING
          MX0    -36
          BX5    -X0*X4
          SB4    X7-TPRO
          SB5    X7-TPRO-TPROL
          PL     B4,CUT6     IF NOT FUNCTION ISSUE
 
*         FUNCTION ISSUE.
 
          LX7    36          POSITION FUNCTION
          BX5    X7
          RJ     GPI         GET PARAMETER
          LX7    24          MERGE MODE
          BX5    X5+X7
          RJ     GPI         GET PARAMETER
          BX5    X5+X7       MERGE PARAMETER
          RJ     GPI         GET PARAMETER
          LX7    12          MERGE PARAMETER
          BX6    X5+X7       MAKE *1MT* REQUEST
          SA6    A0+UXRQ
          NZ     X4,CUT10    IF PROCESSOR NOT COMPLETE
          RJ     GNR         GET NEXT REQUEST
          EQ     CUT10       PROCESS NEXT UNIT
 
*         CHECK FOR ROUTINE CALL.
 
 CUT6     NG     B5,CUT7     IF ANOTHER STRING CALLED
          JP     B5+TPRO+TPROL
 
 CUT7     RJ     MQE         MAKE QUEUE ENTRY
 
*         CHECK NEXT REQUEST
 
 CUT8     RJ     GNR         GET NEXT REQUEST
 CUT9     BX6    X4
          NZ     X4,CUT4     IF REQUEST
          EQ     CUT11       CHECK FOR FILE REQUEST
 
*         PROCESS NEXT UNIT.
 
 CUT10    SA0    A0+UNITL    ADVANCE UDT ADDRESS
          SB2    B2+1        ADVANCE UDT ORDINAL
 CUT11    SA1    A0+UXRQ
          SA4    A0+UREQ
          SA3    A0+UFRQ
          NG     X1,CUTX     IF END OF UDT
          NZ     X4,CUT12    IF REQUEST PROCESSOR ACTIVE
          ZR     X3,CUT10    IF NO FILE REQUEST
          EQ     CUT1        PROCESS FILE REQUEST
 
 CUT12    ZR     X1,CUT9     IF NO PP REQUEST
          BX7    X1
          AX1    48
          SB7    X1-NCP
          NG     B7,CUT10    IF IN PROGRESS
          ERRNZ  NCP-RIP-1
          SA7    A0+ULRQ     SAVE COMPLETED REQUEST
          BX6    X6-X6       CLEAR REQUEST WORD
          SA6    A1
          ZR     B7,CUT8     IF NORMAL COMPLETION
          SB7    X1-ERR
          ZR     B7,CUT13    IF ERROR RETURN
          SX7    PDEL        SET REQUEUE WITH DELAY
          SX5    B0
          EQ     EXI4        ENTER REQUEST
 
*         PROCESS ERROR RETURN.
 
 CUT13    SA1    A0+UVRI
          SA5    A0+UST3
          SA2    A0+UST1
          SX7    B0+
          AX1    48
          LX5    48
          ZR     X1,EXI3     IF UNIT NOT ASSIGNED TO JOB
          LX2    59-49
          AX5    48          ERROR CODE
          NG     X2,CUT14    IF ACS UNIT
          SX2    X5-TCF
          SX3    /RSX/TCF
          ZR     X2,CUT16    IF *TCF* ERROR
          SX2    X5-BFR
          SX3    /RSX/BFR
          ZR     X2,CUT16    IF *BFR* ERROR
          SX2    X5-BFW
          SX3    /RSX/BFW
          ZR     X2,CUT16    IF *BFW* ERROR
 CUT14    SX2    X5-BEI
          ZR     X2,CUT15    IF *BEI* ERROR
          SX2    X5-RRJ
          NZ     X2,CUT17    IF NOT *RRJ* ERROR
 CUT15    RJ     GPI         CHECK FOR ERROR PROCESSOR
          ZR     X2,CUT17    IF NO ERROR PROCESSOR
          BX6    X6-X6       CLEAR CURRENT STRING
          SA6    A4
          EQ     CUT5        CALL ERROR PROCESSOR
 
 CUT16    RJ     SPR         SET PREVIEW DISPLAY REQUEST
          SX7    PLPD        PROCESS LOAD POINT RECOVERY
          EQ     EXI4        ENTER NEW REQUEST
 
 CUT17    SA1    A0+UTMS
          SA2    A0+ULRQ
          SX5    B0+         USE UDT ERROR CODE IN ABORT REQUEST
          LX1    59-11
          LX2    12
          PL     X1,ABR      IF NOT TMS CONTROLLED FILE
          AX2    48          LAST PP REQUEST
          LX1    11-11-59+11
          SX3    X2-WTF
          ZR     X3,CUT18    IF WRITE DATA
          SX3    X2-WLA
          NZ     X3,ABR      IF NOT WRITE LABELS
 CUT18    SX0    200B
          BX6    X0+X1       SET UNRECOVERED WRITE ERROR
          SA6    A1
          EQ     ABR         ABORT REQUEST
 
 
 CUTB     CON    0
 EXI      SPACE  4,10
**        EXI - COMMON EXIT POINTS.
 
 
*         EXIX - EXIT TO PROCESS NEXT UNIT.
*         EXIT - EXIT AND PROCESS NEXT OPERATION FOR THIS UNIT.
 
 EXIX     EQU    CUT10       PROCESS NEXT UNIT
 EXIT     EQU    CUT8        PROCESS NEXT REQUEST
 
*         EXI1 - CLEAR CURRENT REQUEST AND ENTER NEW REQUEST.
*
*         ENTRY  (X5) = PARAMETERS.
*                (X7) = REQUEST.
 
 EXI1     BSS    0           ENTRY
          SX6    B0+         CLEAR CURRENT REQUEST
          SA6    A0+UREQ
          NZ     X7,EXI4     IF NEW REQUEST
          RJ     GNR         GET NEXT REQUEST
          EQ     EXIX        PROCESS NEXT UNIT
 
*         EXI2 - MAKE REQUEST TO *1MT* OR *1MU*.
*
*         ENTRY  (X5) = MD, PA, PB PARAMETERS.
*                (X7) = FUNCTION.
 
 EXI2     BSS    0           ENTRY
          LX7    36
          BX6    X5+X7
          SA6    A0+UXRQ
          EQ     EXIX        PROCESS NEXT UNIT
 
*         EXI3 - EMPTY REQUEST QUEUE AND QUEUE NEW REQUEST.
*
*         ENTRY  (X5) = PARAMETER.
*                (X7) = REQUEST.
 
 EXI3     BSS    0           ENTRY
          RJ     GNR         GET NEXT REQUEST
          BX6    X6-X6       CLEAR REQUEST
          SA6    A4
          NZ     X4,EXI3     IF REQUEST QUEUE NOT EMPTY
*         EQ     EXI4        QUEUE NEW REQUEST
 
*         EXI4 - QUEUE NEW REQUEST.
*
*         ENTRY  (X5) = PARAMETERS.
*                (X7) = REQUEST.
 
 EXI4     BSS    0           ENTRY
          ZR     X7,EXIX     IF NO REQUEST
          RJ     MQE
          EQ     EXIT        PROCESS NEXT REQUEST
 
*         EXI5 - REQUEUE OPERATION.
 
 EXI5     BSS    0           ENTRY
          SA1    CUTB
          BX6    X1
          SA6    A0+UREQ
          EQ     EXIX        PROCESS NEXT UNIT
          TITLE  REQUEST PROCESSORS.
          SPACE  4,10
**        REQUEST PROCESSOR REGISTER CONVENTIONS.
*         UNLESS OTHERWISE DOCUMENTED ALL ROUTINES EXPECT THE FOLLOWING
*         ENTRY CONDITIONS AND WILL EXIT WITH THESE REGISTERS
*         UNCHANGED.
*
*         ENTRY  (A0) = FWA OF UDT.
*                (B2) = UDT ORDINAL.
*                (X5) = CIO INTERNAL REQUEST IF FIRST STRING PROCESSOR.
 CAT      SPACE  4,10
**        CAT - CHECK STATISTICAL ACCUMULATOR THESHOLDS.
 
 
 CAT      BSS    0           ENTRY
          SA1    A0+UERC     GET RECOVERED ERROR COUNTS
          SA2    CATA
          SA3    A0+UBLC     GET BLOCKS TRANSFERRED COUNTS
          SA4    CATB
          BX1    X2*X1
          BX3    X4*X3
          IX1    X1+X3
          ZR     X1,EXIT     IF NO ACCUMULATOR THRESHOLDS REACHED
          SX7    PLAC        LOG ACCUMULATORS
          EQ     EXI4        QUEUE NEW REQUEST
 
 
 CATA     CON    77700077700000777000B  *UERC* THRESHOLDS MASK
 CATB     CON    77770000777700000000B  *UBLC* THRESHOLDS MASK
 CCR      SPACE  4,10
**        CCR - CHECK IF CLOSER/RETURN.
 
 
 CCR      BSS    0           ENTRY
          SA1    A0+UCIB     CHECK EXTERNAL *CIO* REQUEST
          SX2    774B
          LX1    12
          BX2    X2*X1
          SX2    X2-374B
          NZ     X2,EXIT     IF NOT CLOSER/RETURN
          SX5    1           SET FET COMPLETION CODE
          SX7    PFET
          EQ     EXI3        CLEAR QUEUE AND MAKE NEW REQUEST
 CCS      SPACE  4,10
**        CCS - CHECK IF LABEL CHECKING COMPLETE.
 
 
 CCS      BSS    0           ENTRY
          SA1    A0+UVSN
          BX5    X5-X5
          LX1    59-23
          ZR     X1,CCS1     IF NO LABEL READ
          PL     X1,EXIX     IF LABEL CHECK COMPLETE
 CCS1     SX7    PILA
          EQ     EXI1        RESTART INITIAL LABEL CHECK
 CEF      SPACE  4,10
**        CEF - CHECK ERROR FLAG.
*
*         THE REQUEST QUEUE WILL BE CLEARED IF AN APPROPRIATE ERROR
*         FLAG IS SET AND A *CIO* REQUEST IS IN PROGRESS.
 
 
 CEF      BSS    0           ENTRY
          SA1    A0+UFRQ
          AX1    48
          SX7    B0          SET NO NEW REQUEST
          SX1    X1-CIO
          ZR     X1,EXIT     IF *CIO* REQUEST
          EQ     EXI1        CLEAR CURRENT REQUEST
 
*         REENTRY TO CHECK REQUEST STATUS.
*         THE PREVIEW DISPLAY MESSAGE FLAG IS CLEARED TO INSURE THAT
*         OPERATOR COMMANDS WHICH COULD MODIFY THE UDT ARE NOT
*         PROCESSED WHILE THE *1MU* *MAB* FUNCTION IS EXECUTING.
 
 CEF1     BSS    0           ENTRY
          SA1    A0+ULRQ
          SA2    A0+UVRI
          MX6    -12
          MX7    59
          BX6    -X6*X1
          BX7    X7*X2
          ZR     X6,EXIX     IF NOT TO ABORT REQUEST
          SA7    A2+         CLEAR MESSAGE FLAG
          SX5    EFT         SET ERROR FLAG TERMINATION
          EQ     ABR         ABORT REQUEST
 CER      SPACE  4,10
**        CER - CLEAR END OF REEL FLAGS AND ADVANCE SECTION.
*
*         THE SECTION NUMBER MUST BE ADVANCED WHEN THE END OF REEL
*         FLAGS ARE CLEARED SO THAT REQUEST ABORT PROCESSING WILL WORK
*         PROPERLY.  SEE *1MU* *MAB* FUNCTION.
 
 
 CER      BSS    0
          SA1    A0+UVRI
          SA2    A0+UFSN
          SX6    16B
          SX7    1
          BX6    -X6*X1      CLEAR END OF REEL FLAGS
          IX7    X2+X7       INCREMENT SECTION NUMBER
          SA6    A1
          SA7    A2
          EQ     EXIT        PROCESS NEXT REQUEST
 CET      SPACE  4,10
**        CET - CHECK END OF TAPE TYPE AND DETERMINE TYPE OF BACKSPACE
*         TO DO.
 
 
 CET      BSS    0           ENTRY
          SA1    A0+UST4
          SX2    3
          SX7    RLA
          SA5    =210000010300B
          LX1    -46
          BX3    X2*X1
          SB3    X3
          SX6    B1
          ZR     B3,EXI2     IF READ TO TAPE MARK
          LX6    12
          BX5    -X6*X5
          EQ     EXI2        ENTER *1MT* REQUEST
 CEV      SPACE  4,10
**        CEV - CHECK END OF VOLUME.
*         (PA) FROM LAST REQUEST = 4XXX IF *EOV1* ENCOUNTERED.
 
 
 CEV      BSS    0           ENTRY
          SA1    A0+ULRQ     CHECK IF *EOV1* ENCOUNTERED
          LX1    59-23
          PL     X1,EXIT     IF NOT REEL SWAP
          SX7    PMFV
          EQ     EXI3        CLEAR REQUEST QUEUE AND ENTER NEW REQUEST
 CFP      SPACE  4,10
**        CFP - CHECK FILE POSITION.
*         IF POSITIONED AT END OF SET AND POSMF *9999* FUNCTION,
*         THEN WRITE MULTI FILE LABEL.
 
 
 CFP      BSS    0           ENTRY
          SA1    A0+ULRQ     CHECK IF EOI
          SX7    PWFL        SET TO WRITE MULTI-FILE LABEL
          SA3    A0+UST2     CHECK FOR MULTI-FILE MISSING
          SX2    7000B
          LX3    59-6
          BX4    X2*X1
          NG     X3,CFP2     IF MULTI-FILE NOT FOUND
          NZ     X4,CFP1     IF END OF TAPE AND USER PROCESSING SET
          LX1    36
          AX1    48
          ZR     X1,EXI4     IF END OF SET AND POSMF *9999*
          SX7    PPEI        CONTINUE SKIP
          EQ     EXI4        QUEUE NEW REQUEST
 
 CFP1     SX7    PEOI        SET TO COMPLETE FET
          EQ     EXI3        CLEAR REQUEST QUEUE AND ENTER NEW REQUEST
 
 CFP2     SX7    PRES        SET TO REPOSITION PRIOR TO END OF SET
          EQ     EXI3        CLEAR REQUEST QUEUE AND QUEUE NEW REQUEST
 CIL      SPACE  4,10
**        CIL - COMPLETE INITIAL LABEL CHECK.
 
 
 CIL      BSS    0           ENTRY
          SA1    A0+UST1
          SA3    A0+UMST
          MX6    -2
          LX1    59-49
          PL     X1,CIL1     IF NOT ACS UNIT
          BX6    -X6*X3      MOUNT STATUS FLAGS
          SX7    X6-2
          ZR     X7,CIL1     IF MOUNT COMPLETE
          NZ     X6,EXI5     IF MOUNT OR DISMOUNT OPERATION IN PROGRESS
          MX6    57
          SX2    2
          BX3    X6*X3       CLEAR STATUS FLAGS
          BX6    X3+X2       SET MOUNTED STATUS
          SX5    B0
          SA6    A3
          SX7    PULR        UNLOAD UNIT NOT MOUNTED FROM THIS SYSTEM
          EQ     EXI3        CLEAR QUEUE AND MAKE NEW REQUEST
 
 CIL1     SA1    RTIM
          SA2    A0+UTIM
          MX6    24
          BX1    X6*X1
          BX2    -X6*X2
          BX6    X1+X2       SET LABELS READ TIME
          SA6    A2
          EQ     EXIT        EXIT
 CLR      SPACE  4,10
**        CLR - CHECK IF LABEL READ.
*         (PA) FROM LAST REQUEST = 74 IF LABEL NOT READ.
 
 
 CLR      BSS    0           ENTRY
          SA1    A0+ULRQ
          SX7    PPNB        SET TO SKIP TO END OF LABEL BLOCK
          LX1    36
          AX1    48
          ZR     X1,EXI4     IF LABELS READ
          SX7    PSKT        CONTINUE TO SKIP DATA
          EQ     EXI4        QUEUE NEW REQUEST
 CLM      SPACE  4,10
**        CLM - CHECK LABEL MATCH.
 
 
 CLM      BSS    0           ENTRY
          SX7    PPEI        SEARCH FOR CORRECT FILE SET
          SA2    A0+UCIB     CHECK IF POSMF
          AX2    50
          MX3    -8
          BX2    -X3*X2
          SX2    X2-22B
          ZR     X2,EXI4     IF POSMF
          SX7    PNLB        PROCESS NORMAL ERROR
          EQ     EXI4        QUEUE NEW REQUEST
 CLO      SPACE  4,10
**        CLO - *CLOSE*/*CLOSER* PROCESSOR.
 
 
 CLO      BSS    0           ENTRY
          SA1    A0+UST2
          SA2    A0+UCIB
          LX1    59-4
          LX2    59-55
          PL     X1,CLO1     IF LAST OPERATION NOT WRITE
          SX7    PCWT        WRITE EOF1 LABEL
          PL     X2,EXI4     IF NOT CLOSE REEL
          SX7    PCLR        WRITE EOV1
          EQ     EXI4        QUEUE NEW REQUEST
 
 CLO1     SA1    A0+UST4
          BX3    X2
          LX1    59-58
          LX2    55-41
          BX2    X1*X2
          NG     X2,CLO2     IF LABELED TAPE AND XL BIT SET
          SX7    PCLO        SET TO CLOSE FILE
          PL     X3,EXI4     IF NOT CLOSE REEL
          SX7    PERP        PROCESS END OF TAPE
          EQ     EXI4        QUEUE NEW REQUEST
 
 CLO2     SX7    PCLL        SET TO PROCESS CLOSE AND RETURN LABELS
          PL     X3,EXI4     IF NOT CLOSE REEL
          SX7    PERT        PROCESS END OF TAPE AND RETURN LABELS
          EQ     EXI4        QUEUE NEW REQUEST
 
*         CHECK FOR REWIND AFTER CLOSE OPERATION.
 
 CLO3     BSS    0           ENTRY
          LX5    59-35
          PL     X5,EXIT     IF NOT REWIND
          BX5    X5-X5
          SX7    PRWC        REWIND CURRENT REEL AND SET REWIND FLAG
          EQ     EXI4        QUEUE NEW REQUEST
 CNR      SPACE  4,10
**        CNR - CHECK NEXT REEL.
 
 
 CNR      BSS    0           ENTRY
          SA1    A0+UST1
          LX1    59-49
          PL     X1,CNR6     IF NOT ACS UNIT
 
*         LOCATE ACS VSN.
 
          SA1    A0+UESN     REQUIRED VSN
          RJ     FAV         FIND ACS VSN
          SA4    A0+UMST     GET CURRENT UNIT MOUNT STATUS
          MX6    -2
          BX6    -X6*X4
          SB5    X6-1        CURRENT UNIT MOUNT STATUS - 1
          ZR     B3,CNR3     IF VSN NOT FOUND
          NG     B3,CNR2     IF ERROR ON VSN
          SX6    A0-B3
          SB4    X7-1
          EQ     B4,B1,CNR1  IF VSN MOUNTED
          GT     B4,B1,CNR10 IF DISMOUNT IN PROGRESS
          ZR     X6,CNR10    IF MOUNT IN PROGRESS ON CURRENT UNIT
          NZ     X3,CNR5     IF MOUNT IN PROGRESS ON ASSIGNED UNIT
          EQ     CNR10       WAIT FOR MOUNT COMPLETE
 
*         VSN MOUNTED.
 
 CNR1     ZR     X6,CNR7     IF MOUNTED ON CURRENT UNIT
          NZ     X3,CNR5     IF MOUNTED ON ASSIGNED UNIT
          EQ     B5,B1,CNR5  IF CURRENT UNIT MOUNTED
          SA1    B3+UVSN
          SA2    B3+UREQ
          ZR     X1,CNR10    IF INITIAL LABEL CHECK NOT PERFORMED
          LX1    59-23
          NZ     X2,CNR10    IF PROCESSOR ACTIVE
          NG     X1,CNR10    IF LABEL CHECK IN PROGRESS
          EQ     CNR8        INITIATE UNIT SWAP
 
*         VSN FOUND IN ERROR TABLE.
 
 CNR2     ZR     X3,CNR5     IF TRANSIENT ERROR
          RJ     SPR         SET PREVIEW DISPLAY REQUEST
          EQ     CNR5        DELAY FOR RETRY OF MOUNT
 
*         VSN NOT FOUND.
 
 CNR3     ZR     B6,CNR4     IF ALTERNATE UNIT NOT AVAILABLE
          RJ     MAV         MOUNT ON ALTERNATE UNIT
          EQ     CNR10       WAIT FOR MOUNT COMPLETE
 
 CNR4     PL     B5,CNR5     IF CURRENT UNIT NOT DISMOUNTED
          LX4    59-2
          SB6    A0          SET CURRENT UNIT
          NG     X4,CNR10    IF CONTROL PATH ERROR ON CURRENT UNIT
          RJ     MAV         MOUNT ON CURRENT UNIT
          EQ     CNR10       WAIT FOR MOUNT COMPLETE
 
*         UNLOAD AND DISMOUNT CURRENT UNIT.
 
 CNR5     NE     B5,B1,CNR10 IF CURRENT UNIT NOT MOUNTED
          SX7    PRUL        UNLOAD UNIT
          EQ     EXI1        CLEAR CURRENT REQUEST AND ENTER NEW
 
*         PROCESS NON-ACS UNIT.
 
 CNR6     RJ     FNR         FIND NEXT REEL
          NE     B3,B4,CNR8  IF UNIT SWAP POSSIBLE
 
*         CHECK LABELS ON CURRENT UNIT IF READY.
 
 CNR7     SA1    A0+UST1
          LX1    59-0
          SX5    B0
          PL     X1,CNR10    IF UNIT NOT READY
          SX7    PCHR        SET TO CHECK NEXT REEL
          EQ     EXI1        CLEAR CURRENT AND MAKE NEW REQUEST
 
*         PERFORM UNIT SWAP IF JOB IS AT A CONTROL POINT.
 
 CNR8     SA1    ACCU        GET UNIT ACCESSIBILITY
          SA2    JBRO        GET *1MU* JOB STATUS
          SA3    A0+UST1     GET *1MT* JOB STATUS
          LX1    B2
          LX2    B2
          PL     X1,CNR9     IF CURRENT UNIT NOT ACCESSIBLE
          LX3    59-48
          BX2    X2*X3       COMBINE *1MT* AND *1MU* JOB STATUS
 CNR9     NG     X2,CNR10    IF JOB ROLLED OUT
          SA1    B3+UVRI
          SX6    B1
          LX6    47-0
          SX5    B3          NEW UDT ADDRESS
          BX6    X1+X6       SET UNIT SWAP FLAG IN NEW UDT
          SX7    PUSP        INITIATE UNIT SWAP
          SA6    A1+
          EQ     EXI1        CLEAR CURRENT AND ENTER NEW REQUEST
 
*         CHECK ERROR FLAG AND RESTART PROCESSING IF NOT 8 SECONDS
*         ELAPSED.
 
 CNR10    SA2    ITIM
          SX5    B0
          LX2    59-3
          PL     X2,EXI5     IF NOT 8 SECONDS, REENTER
          SX7    PCNR        START OVER AND CHECK ERROR FLAG
          EQ     EXI1        CLEAR CURRENT REQUEST, QUEUE NEW REQUEST
 CNV      SPACE  4,10
**        CNV - CHECK NEXT VSN SPECIFIED.
 
 
 CNV      BSS    0           ENTRY
          SA1    A0+UESN
          MX6    36
          BX6    X6*X1
          NZ     X6,EXIT     IF NEXT VSN SPECIFIED
          SX3    /RSX/NTV    SET NEXT VSN PROMPT
          RJ     SPR         SET PREVIEW DISPLAY REQUEST
          SX7    PWNV        REQUEST OPERATOR SPECIFICATION OF VSN
          SX5    B0+
          EQ     EXI4        MAKE REQUEST
 CPT      SPACE  4,10
**        CPT - CHECK *POSMF* TYPE.
 
 
 CPT      BSS    0           ENTRY
          SA1    A0+UST2
          LX1    59-1
          PL     X1,EXIT     IF NOT *POSMF 9999*
          SX7    PPEI        CONTINUE POSITIONING
          EQ     EXI3        CLEAR QUEUE AND ENTER NEW REQUEST
 CRA      SPACE  4,10
**        CRA - CHECK REEL ASSIGNED.
 
 
 CRA      BSS    0           ENTRY
          SA1    A0+UVRI
          SX6    B1
          LX6    4-0
          BX2    X6*X1
          ZR     X2,EXIT     IF REEL NOT ASSIGNED
          BX6    -X6*X1      CLEAR REEL ASSIGNED
          SX7    AFN         SET REQUEST CODE
          SA6    A1+
          SX5    AFRR        SET FUNCTION CODE
          EQ     EXI2        CALL *1MU* TO ISSUE REEL RETURN MESSAGES
 CRC      SPACE  4,10
**        CRC - CHECK IF REEL CHECK COMPLETE.
 
 
 CRC      BSS    0           ENTRY
          SA1    A0+UVSN
          SX5    B0
          LX1    59-23
          PL     X1,EXIT     IF REEL CHECK COMPLETE
          SX7    PCHR
          EQ     EXI1        RESTART REEL CHECK
 CRF      SPACE  4,10
**        CRF - CLEAR REWIND BEFORE OPERATION FLAG.
 
 
 CRF      BSS    0           ENTRY
          SA1    A0+UST2
          SX6    4000B
          BX6    -X6*X1      CLEAR REWIND FLAG
          SA6    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 CRK      SPACE  4,10
**        CRK - CHECK IF SKIP REQUIRED FOR *READSKP*.
*
*         ENTRY  (ULRQ, 12-0) = 0 IF TAPE MARK OR END OF TAPE.
*                (ULRQ, 12-0) = 4 IF RECORD SKIP REQUIRED.
*                (ULRQ, 12-0) = 10 IF FILE SKIP REQUIRED.
 
 
 CRK      BSS    0           ENTRY
          SA1    A0+ULRQ     CHECK RESPONSE TO LAST REQUEST
          MX0    -12
          BX2    -X0*X1
          SX7    PEOT        SET TO CHECK END OF TAPE
          ZR     X2,EXI4     IF CHECK END OF TAPE
          BX5    X2          SET TO SKIP RECORD/FILE
          SX7    PSKK        PERFORM SKIP
          LX5    24          POSITION RECORD/FILE FLAG
          EQ     EXI4        QUEUE NEW REQUEST
 CRS      SPACE  4,10
**        CRS - CHECK REQUEST STATUS.
*
*         IF AN ERROR CONDITION IS ENCOUNTERED WHEN NO *CIO* REQUEST IS
*         IN PROGRESS, THE MESSAGE WILL BE HELD AND ISSUED ON THE NEXT
*         *CIO* CALL.
 
 
 CRS      BSS    0           ENTRY
          SA1    A0+UFRQ     CHECK IF CIO REQUEST IN PROGRESS
          AX1    48
          SX6    X1-CIO
          NZ     X6,CRS1     IF NO *CIO* REQUEST IN PROGRESS
          SX7    MAB         ISSUE MESSAGE
          EQ     EXI2        MAKE *1MU* REQUEST
 
 CRS1     SX6    X1-RTF
          NZ     X6,EXI5     IF NO FILE RETURN REQUEST
          EQ     EXIT        SKIP ISSUE OF MESSAGE
 CRW      SPACE  4,10
**        CRW - CHECK IF REWIND AFTER *POSMF*.
*         PERFORMED IF AT FIRST LABEL GROUP OF CURRENT REEL.
*         (PA) FROM LAST REQUEST = 4XXX IF REWIND REQUIRED.
 
 
 CRW      BSS    0           ENTRY
          SA1    A0+ULRQ
          BX5    X5-X5
          ERRNZ  FNRW
          LX1    59-23
          PL     X1,EXIT     IF NOT AT FIRST LABEL GROUP
          SX7    FNH         REWIND TO BOI
          EQ     EXI2        ENTER *1MT* REQUEST
 CUR      SPACE  4,10
**        CUR - CHECK UNLOAD REQUIRED ON UNIT RETURN.
 
 
 CUR      BSS    0           ENTRY
          SA1    A0+UST1
          SA2    A0+UST2
          SA4    A0+UST4
          LX1    59-49
          LX2    59-5
          LX4    59-41
          BX1    X1+X2
          SX5    B0+
          SX7    PUNL        SET UNLOAD
          NG     X1,EXI4     IF ACS UNIT OR FILE POSITION INDETERMINATE
          PL     X4,EXI4     IF NOT INHIBIT UNLOAD
          SX7    PREW        SET REWIND
          EQ     EXI4        ENTER REQUEST
 CVS      SPACE  4,10
**        CVS - CLEAR VSN.
 
 
 CVS      BSS    0           ENTRY
          SX6    B0+
          SA6    A0+UVSN
          EQ     EXIT        PROCESS NEXT REQUEST
 CWC      SPACE  4,10
**        CWC - CHECK IF WRITE WAS COMPLETE.
 
 
 CWC      BSS    0           ENTRY
          SA1    A0+ULRQ
          SX2    14B
          LX2    24
          BX3    X2*X1
          SX7    PWTI        SET WRITE INCOMPLETE
          ZR     X3,EXI3     IF NOT EOR/EOF WRITE REQUEST
          LX1    59-32       CHECK BIT 8 OF *MD*
          PL     X1,EXI3     IF NOT EOR/EOF WRITTEN THIS OPERATION
          SX7    PWTC        WRITE COMPLETE
          EQ     EXI3        CLEAR REQUEST QUEUE AND ENTER NEW REQUEST
 CWL      SPACE  4,10
**        CWL - CHECK WRITE FROM LOAD POINT.
*
*         IF WRITE FROM LOAD POINT ON THE FIRST REEL, SET THE DENSITY
*         AND CONVERSION MODE FROM THE TAPE REQUEST PARAMETERS.
 
 
 CWL      BSS    0           ENTRY
          SA1    A0+UST1
          SA2    A0+UVRI
          MX0    -12
          LX1    59-1
          LX0    12
          NG     X1,EXI5     IF UNIT BUSY
          BX2    -X0*X2
          LX1    59-2-59+1
          PL     X1,EXIT     IF NOT AT LOAD POINT
          NZ     X2,EXIT     IF NOT FIRST REEL
          SA1    A0+UST4
          SA2    A0+UST5
          MX0    -6
          LX0    48
          BX1    -X0*X1      REQUESTED DENSITY AND CONVERSION MODE
          BX2    X0*X2
          BX6    X2+X1       UPDATE DENSITY AND CONVERSION MODE
          SA6    A2
          SX7    PDEN        SET DENSITY REQUEST
          EQ     EXI4        QUEUE REQUEST
 CWR      SPACE  4,10
**        CWR - CHECK WRITE.
*         IF LAST OPERATION ON THE TAPE WAS A WRITE, A TRAILER LABEL
*         SEQUENCE WILL BE PERFORMED.
 
 
 CWR      BSS    0           ENTRY
          SA1    A0+UST2
          LX1    59-4
          PL     X1,EXIT     IF NOT WRITE
          SX7    PWTL        WRITE TRAILER LABEL
          EQ     EXI4        QUEUE NEW REQUEST
 CUP      SPACE  4,10
**        CUP - CHECK IF UP SELECTED ON END OF REEL.
 
 
 CUP      BSS    0           ENTRY
          SA1    A0+UCIB
          SX2    774B
          LX1    59-45
          PL     X1,EXIT     IF NOT USER PROCESSING
          LX1    60+45-47
          BX2    X2*X1
          SX5    X2+2000B    MERGE END OF REEL STATUS
          SX7    PFET
          EQ     EXI3        CLEAR QUEUE AND MAKE NEW REQUEST
 DRT      SPACE  4,10
**        DRT - DETERMINE REQUEUE TYPE.
 
 
 DRT      BSS    0           ENTRY
          SA1    A0+ULRQ
          SA2    A0+UFLA
          MX6    -48
          BX3    -X6*X1
          BX6    X6*X2
          AX1    48
          BX6    X3+X6
          SX4    X1-RJB
          SA6    A2          SAVE LAST PP REQUEST
          SX5    B0+
          SX7    PJOB
          ZR     X4,EXI4     IF WAIT FOR JOB ROLLIN
          SX4    X1-RBS
          SX7    PWNB
          ZR     X4,EXI4     IF WAIT FOR NOT BUSY
          SX4    X1-RAC
          SX7    PWAC
          ZR     X4,EXI4     IF WAIT FOR UNIT ACCESSIBLE
          ERRNZ  RDL-6
          SX7    PWTD
          EQ     EXI4        WAIT FOR TIME DELAY
 DMA      SPACE  4,10
**        DMA - DISMOUNT ACS UNIT.
 
 
 DMA      BSS    0           ENTRY
          SA1    A0+UST1
          LX1    59-49
          PL     X1,EXIT     IF NOT ACS UNIT
          RJ     DAU         DISMOUNT ACS UNIT
          EQ     EXIT        EXIT
 DUC      SPACE  4,10
**        DUC - DECREMENT ASSIGNED UNIT COUNT.
 
 
 DUC      BSS    0           ENTRY
          SA1    NTAS        DECREMENT UNITS ASSIGNED
          SX6    X1-1
          SA6    A1
          EQ     EXIT        EXIT
 EOI      SPACE  4,10
**        EOI - CHECK IF EOF OR EOI RETURNED ON LABEL CHECK.
*         THE TAPE FORMAT DETERMINES EOF OR EOI.  WHENEVER AN EOI
*         IS ENCOUNTERED, THE TAPE WILL BE REPOSITIONED PRIOR TO
*         THE EOI SO THAT ADDITIONAL READS WILL CONTINUE TO RETURN EOI.
 
 
 EOI      BSS    0           ENTRY
          SA1    A0+ULRQ
          SX2    7000B
          BX3    X2*X1
          NZ     X3,EXIT     IF EOI OR END OF REEL RETURNED
          SX7    PEOF
          EQ     EXI1        CLEAR CURRENT REQUEST, QUEUE NEW REQUEST
 FET      SPACE  4,10
**        FET - SET FET COMPLETE.
 
 
*         SET FET COMPLETION STATUS FROM LAST REQUEST.
 
 FET      BSS    0           ENTRY
          SA1    A0+ULRQ     GET RETURNED STATUS
          MX2    -24
          BX5    -X2*X1
          EQ     FET2        CHECK ERROR FLAG
 
*         COMPLETE USER-S FET.
 
 FET1     BSS    0           ENTRY
          SX5    1
*         EQ     FET2        CHECK ERROR FLAG
 
*         SET FET COMPLETION STATUS FROM (X5).
 
 FET2     BSS    0           ENTRY
          SA1    A0+UFRQ
          AX1    48
          SX1    X1-CIO
          SX7    CUF
          NZ     X1,EXIT     IF NO *CIO* REQUEST
          EQ     EXI2        ENTER *1MU* REQUEST
 FRE      SPACE  4,10
**        FRE - FLAG ROLLIN EVENT IF UNIT NOT ASSIGNED.
*
*         EXIT   (ROLF) NONZERO IF ALTERNATE STORAGE ACTIVE.
*                TO *EXIT*.
 
 
 FRE      BSS    0           ENTRY
          SA1    TAJP
          ZR     X1,EXIT     IF TAPE ALTERNATE STORAGE NOT ACTIVE
          SX6    B1+
          SA6    /STAGE/ROLF
          EQ     EXIT        EXIT
 HNG      SPACE  4,10
**        HNG - HANG UNIT.
 
 
 HNG      BSS    0           ENTRY
          EQ     EXIX        PROCESS NEXT UNIT
 IOR      SPACE  4,10
**        IOR - I/O REQUEST PROCESSOR.
*         SETS MODE FROM CODED BIT IN REQUEST OR FROM THE INTERNAL
*         MODE DEPENDING ON THE FORMAT.
*
*         ENTRY  (X7) = FUNCTION CODE.
 
 
 IOR      BSS    0           ENTRY
          SA2    A0+UST4
          SA1    A0+UST2
          LX2    24
          AX2    54
          SB5    TFSI
          SB7    X2+         FORMAT
          SB6    B7-TFS
          EQ     B5,B7,IOR1  IF SI FORMAT
          NG     B6,IOR2     IF NOT S FORMAT
          GT     B6,B1,IOR2  IF NOT S OR L FORMAT
 IOR1     SA2    A0+UCIB     POSITION CODED BIT
          LX2    59-49+1
          BX1    -X2
 IOR2     SX2    B1          EXTRACT CODED BIT
          BX3    X2*X1
          LX3    30
          BX5    X5+X3       MERGE CODED BIT
          EQ     EXI2        ENTER *1MT* REQUEST
 JOB      SPACE  4,10
**        JOB - JOB ROLLED OUT PROCESSOR.
 
 
 JOB      BSS    0           ENTRY
          SA1    ACCU        GET UNIT ACCESSIBILITY
          SA2    JBRO        GET *1MU* JOB STATUS
          SA3    A0+UST1     GET *1MT* JOB STATUS
          LX1    B2
          LX2    B2
          PL     X1,JOB1     IF UNIT NOT ACCESSIBLE
          LX3    59-48
          BX2    X2*X3       COMBINE *1MT* AND *1MU* JOB STATUS
 JOB1     NG     X2,EXI5     IF JOB ROLLED OUT
          EQ     EXIT        PROCESS NEXT REQUEST
 LAB      SPACE  4,10
**        LAB - SKIP OVER LABEL.
 
 
 LAB      BSS    0           ENTRY
          SX7    PSLA        SET TO SKIP LABELS
          EQ     LAB3        CHECK LABELS TO BE UPDATED
 
 LAB1     BSS    0           ENTRY
          SX7    PWHD        WRITE VOLUME LABEL
 LAB2     SA1    A0+UST1
          SA2    A0+UGNU
          MX6    48
          LX6    36
          LX1    12
          BX2    X6*X2
          BX6    -X6*X1      EST ORDINAL
          BX6    X2+X6       SET EST ORDINAL WRITTEN ON
          SA6    A2+
 LAB3     SA1    A0+UST2
          MX2    24
          LX2    -24
          BX5    X2*X1
          NZ     X5,EXIT     IF NONZERO BLOCK COUNT
          SA2    A0+UST1
          SA1    A0+UST4
          LX2    59-1
          LX1    59-58
          NG     X2,EXI5     IF BUSY
          LX2    59-2-59+1+60
          PL     X2,EXIT     IF NOT AT LOAD POINT
          NG     X1,EXI4     IF LABELED AND LOAD POINT
          SX7    X7-PSLA
          ZR     X7,EXIT     IF A READ OPERATION
          SX7    PCWL        CHECK UNLABELED WRITE FROM LOAD POINT
          EQ     EXI4        QUEUE REQUEST
 
 LAB4     BSS    0           ENTRY
          SX7    PWHR        WRITE *VOL1* AND *HDR1* AFTER REEL SWAP
          EQ     LAB2        CHECK LABELS TO BE UPDATED
 LPD      SPACE  4,10
**        LPD - DELAY UNTIL JOB DROPPED OR *RETRY* COMMAND ENTERED.
*
*         THIS ROUTINE IS EXECUTED IN RESPONSE TO A LOAD POINT ERROR.
*         THE REQUEST THAT WAS ISSUED WHEN THE ERROR OCCURRED IS
*         SAVED.  THE OPERATOR MUST TRY TO FIX THE LOAD POINT PROBLEM
*         AND ENTER THE *RETRY* COMMAND (MEANING THAT THE
*         REQUEST SHOULD BE RETRIED) OR ENTER THE *TERMINATE*
*         COMMAND (MEANING THAT THE PROBLEM CANNOT BE FIXED
*         AT THIS TIME).
 
 
 LPD      BSS    0           ENTRY
          SA1    A0+ULRQ     SAVE LAST 1MT REQUEST
          SA2    A0+UFLA
          MX3    -48
          BX4    -X3*X1
          BX6    X3*X2
          BX7    X4+X6
          SA7    A2+
 LPD1     SX7    PWOP        WAIT FOR OPERATOR ACTION
          EQ     EXI1        CLEAR CURRENT REQUEST, QUEUE NEW REQUEST
 
*         RETURN HERE TO CHECK STATUS OF OPERATOR ACTION.
 
 LPD2     BSS    0           ENTRY
          SA1    A0+ULRQ
          SX2    X1
          NZ     X2,EXIX     IF DROP CONTROL POINT
          SA1    A0+UFLA
          LX1    59-51
          NG     X1,LPD4     IF OPERATOR HAS TYPED THE *RETRY* COMMAND
          LX1    59-52-59+51
          NG     X1,LPD5     IF OPERATOR HAS TYPED *TERMINATE*
          SA4    ITIM
          LX4    59-3
          NG     X4,LPD1     IF 8 SECONDS
          EQ     EXI5        REQUEUE REQUEST
 
 LPD4     SA1    A0+UVRI     CLEAR PREVIEW DISPLAY MESSAGE
          MX6    59
          BX6    X6*X1
          SA6    A1
          SA1    A0+UFLA
          MX2    1
          LX2    51-59
          BX6    -X2*X1      CLEAR *RETRY* FLAG
          SA6    A1
          BX7    X7-X7
          MX2    -48
          SA7    A0+UREQ     PREVENT THIS REQUEST FROM BEING STACKED
          BX6    -X2*X1
          SA6    A0+UXRQ
          RJ     GNR         GET NEXT REQUEST
          EQ     EXIX        PROCESS NEXT UNIT
 
 LPD5     SA1    A0+UFLA
          MX2    1
          LX2    52-59
          BX6    -X2*X1
          SA6    A1          CLEAR *TERMINATE* FLAG
          SA1    A0+UISN
          MX6    -6
          LX1    -12
          BX1    -X6*X1      PREVIEW DISPLAY CODE
          SX6    X1-/RSX/TCF
          SX5    TCF
          ZR     X6,ABR      IF *TCF* ERROR
          SX6    X1-/RSX/BFR
          SX5    BFR
          ZR     X6,ABR      IF *BFR* ERROR
          SX5    BFW         SET *BFW* ERROR
          EQ     ABR         CLEAR REQUEST QUEUE AND ABORT JOB
 OPE      SPACE  4,10
**        OPE - OPEN.
*         REWINDS TAPE IF SELECTED.
 
 
 OPE7     PL     X5,EXIT     IF NOT REWIND
          SX7    PRWO        REWIND CURRENT REEL
          BX5    X5-X5
          EQ     EXI4        QUEUE NEW REQUEST
 
 OPE      BSS    0           ENTRY
          SA1    A0+UCIB     CHECK IF *POSMF*
          LX5    59-35
          AX1    50
          MX3    -8
          BX1    -X3*X1
          SX1    X1-110B/4
          NZ     X1,OPE7     IF NOT *POSMF*
          SA2    A0+UST4
          LX2    59-58
          PL     X2,OPE1     IF NOT LABELED TAPE
          LX2    59-57-59+58
          NG     X2,OPE1     IF NON-STANDARD LABEL
          SX7    PDRW        DETERMINE TYPE OF *POSMF*
          EQ     EXI4        QUEUE NEW REQUEST
 
 OPE1     SX7    PNLB        COMPLETE FET
          EQ     EXI3        CLEAR QUEUE AND ENTER NEW REQUEST
 
*         RETURN HERE IF *POSMF 9999*.
 
 OPE2     BSS    0           ENTRY
          SA2    A0+UST2
          MX0    36
          LX2    59-4
          NG     X2,OPE3     IF LAST OPERATION WRITE
          SA2    A0+USID     CHECK IF SETID SPECIFIED
          SA1    OPEA
          BX3    X0*X2
          BX1    X1-X3
          NZ     X1,OPE6     IF SETID SPECIFIED
          MX0    -18         CHECK SEQUENCE NUMBER
          SX3    B1
          BX2    -X0*X2
          BX1    X2-X3
          NZ     X1,OPE6     IF NOT POSITIONED AT FIRST FILE
          SX7    PWBL        WRITE MULTI-FILE LABELS
          EQ     EXI3        CLEAR REQUEST QUEUE AND ENTER NEW REQUEST
 
 OPE3     SX7    PMFL        WRITE MULTI-FILE LABEL
          EQ     EXI3        CLEAR REQUEST QUEUE AND ENTER NEW REQUEST
 
*         PROCESS OPEN WRITE.
 
 OPE4     BSS    0           ENTRY
          SA2    A0+UCIB     CHECK IF OPEN WRITE
          LX2    59-50
          PL     X2,EXIT     IF NOT WRITE
          EQ     LAB1        WRITE LABEL
 
*         RETURN HERE IF NOT *POSMF 9999*.
 
 OPE5     BSS    0           ENTRY
          MX0    12
          SA2    A0+ULRQ     CHECK IF REWIND NEEDED
          LX0    24
          BX3    X0*X2
          SX7    PRWP        REWIND AND REPOSITION TO CORRECT FILE SET
          ZR     X3,EXI4     IF REWIND NEEDED
 OPE6     SA2    A0+UTMS     CHECK FOR LAST CATALOG ON ANOTHER VOLUME
          SX7    PMFS        PROCESS MULTI-FILE REEL SWAP ON POSMF
          LX2    59-17
          NG     X2,EXI3     IF REWIND NEEDED
          SX7    PPEI        POSITION TO CORRECT FILE SET
          EQ     EXI3        CLEAR QUEUE AND ENTER NEW REQUEST
 
 OPEA     DATA   6L
 PEO      SPACE  4,10
**        PEO - CHECK IF EOI RETURNED ON SKIP OPERATION.
*         IF EOI IS NOT RETURNED, DETERMINE IF SKIP IS COMPLETE
*         AND CONTINUE SKIP IF NOT COMPLETE. THIS IS TO HANDLE
*         S/L LABELED TAPES WITH TAPE MARKS EMBEDDED IN THE DATA.
 
 
 PEO      BSS    0           ENTRY
          SA1    A0+ULRQ
          SX2    7000B
          BX3    X2*X1
          MX0    -18
          NZ     X3,EXIT     IF EOI OR END OF REEL RETURNED
          SA1    A0+UCIA     DETERMINE IF SKIP COMPLETE
          MX2    -2
          AX1    24
          BX3    -X0*X1
          AX1    26
          BX4    -X2*X1
          BX2    -X2-X4
          SX7    PSKK        SET TO CONTINUE SKIP
          ZR     X2,EXI1     IF SKIPEI
          NZ     X3,EXI1     IF SKIP COUNT NOT ZERO
          SX7    PEOF        PROCESS EOF
          EQ     EXI1        CLEAR CURRENT REQUEST, QUEUE NEW REQUEST
 PTM      SPACE  4,10
**        PTM - RESET BLOCK COUNT TO ZERO.
 
 
 PTM      BSS    0           ENTRY
          SA1    A0+UST2     RESET BLOCK COUNTER
          MX3    -24
          LX3    12
          BX6    X3*X1
          SA6    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 RDA      SPACE  4,10
**        RDA - READ DATA.
*         CHECKS FOR READ AFTER WRITE.
 
 
 RDA      BSS    0           ENTRY
          SA1    A0+UST2
          SX7    RDF         SET READ FUNCTION
          LX1    59-4
          PL     X1,IOR      IF LAST OPERATION NOT WRITE
          SX5    RAF         READ AFTER WRITE
          EQ     ABR         CLEAR REQUEST QUEUE AND ABORT
 REW      SPACE  4,10
**        REW - REWIND.
*
*         DETERMINES IF NOT ON FIRST REEL OF THE FILE.  IF NOT FIRST
*         REEL, THEN REEL SWAP PROCEDURES ARE STARTED.  THE CURRENT
*         REEL WILL BE UNLOADED IF THE FIRST REEL IS NOT READY AND
*         UNASSIGNED ON A DRIVE AND INHIBIT UNLOAD WAS SELECTED.
 
 
 REW      BSS    0           ENTRY
          SA1    A0+UVRI
          SA2    A0+USID
          SA3    A0+UFSN
          SA5    A0+UST2
          MX0    -12
          LX1    -12
          BX4    -X0*X1      CURRENT REEL NUMBER
          SB3    X2          FILE SEQUENCE NUMBER
          BX0    X5
          SX7    X4          PRESET NUMBER OF REELS TO BACK UP
          LX5    59-5
          LX0    59-11
          NG     X5,REW0     IF FILE POSITION INDETERMINATE
          ZR     X4,REW5     IF FIRST REEL
 REW0     LE     B3,B1,REW2  IF NOT MULTI-FILE
          NG     X0,REW1     IF REWIND BEFORE OPERATION
          SA2    A0+UCIB     CHECK IF *POSMF*
          AX2    50
          MX0    -8
          BX2    -X0*X2
          SX2    X2-22B
          ZR     X2,REW2     IF *POSMF* BACK UP MAXIMUM REELS
 REW1     SX7    X3-1
          NG     X5,REW2     IF POSITION INDETERMINATE
          ZR     X7,REW5     IF CURRENT REEL REWIND
 REW2     IX4    X4-X7
          PL     X4,REW3     IF POSSIBLE TO BACK UP MAXIMUM REELS
          IX7    X4+X7
 REW3     IX6    X1-X7       RESET REEL NUMBER
          SB4    X7          SAVE REEL OFFSET
          LX6    12
          MX0    42          UPDATE FILE SECTION NUMBER
          SA6    A1          UPDATE REEL NUMBER
          BX3    X0*X3
          SX1    B1
          BX7    X3+X1
          SA1    A0+UST4
          SA7    A3+
          LE     B3,B1,REW4  IF NOT MULTI-FILE
          LX1    59-58
          SX7    PMFR        REPOSITION MULTI-VOLUME, MULTI-FILE
          PL     X1,REW4     IF NOT LABELED TAPE
          LX1    59-57-59+58
          NG     X1,REW4     IF NON-STANDARD LABEL
          NG     X5,EXI4     IF POSITION INDETERMINATE
          SA2    A0+UTMS     CHECK FOR SYMBOLIC ACCESS TAPE
          LX2    59-8
          PL     X2,EXI4     IF NON-SYMBOLIC ACCESS
          SA3    A0+UTCI     CHECK FOR *POSMF*
          AX3    24
          MX0    -24
          BX3    -X0*X3
          LX2    59-17-59+8
          ZR     X3,EXI4     IF NOT *POSMF*
          NG     X2,EXI4     IF REEL SWAP NECESSARY
          SX3    B4          RESET REEL NUMBER
          IX6    X6+X3
          SA6    A6+
          EQ     REW5        REWIND REEL
 
 REW4     SX7    PERW
          EQ     EXI4        QUEUE NEW REQUEST
 
 REW5     BSS    0           ENTRY
          SA2    A0+USID     CHECK IF MULTI-FILE
          SA1    A0+UST4
          SB3    X2
          LE     B3,B1,REW7  IF NOT MULTI-FILE SET TAPE
          LX1    59-58
          PL     X1,EXIT     IF NOT LABELED TAPE
          LX1    59-57-59+58
          NG     X1,EXIT     IF NON-STANDARD LABEL
          SX7    PCFL        REWIND SINGLE-VOLUME MULTI-FILE SET TAPE
          MX0    1           CHECK FOR SYMBOLIC ACCESS TAPE FILE
          SA2    A0+UTMS     CHECK FOR *TFM* FORCED REEL SWAP
          LX2    59-8
          PL     X2,EXI4     IF NON-SYMBOLIC ACCESS FILE
          LX2    59-18-59+8
          BX6    X0+X2       SET FIRST *HDR1* ON VOLUME FLAG
          LX6    -59+18
          SA6    A2+
          EQ     EXI4        QUEUE NEW REQUEST
 
*         REENTER HERE TO DETERMINE IF UNLOAD NEEDED.
 
 REW6     BSS    0           ENTRY
          SA1    A0+UST2
          LX1    59-5
          NG     X1,REW6.1   IF FILE POSITION INDETERMINATE
          RJ     CUL         CHECK UNLOAD REQUIRED
          NZ     B3,EXIT     IF UNIT NOT TO BE UNLOADED
 REW6.1   SX7    PUNL        UNLOAD LAST REEL
          EQ     EXI4        QUEUE NEW REQUEST
 
 REW7     SA1    A0+UTCI     CHECK FOR *POSMF* IN PROGRESS
          MX2    24
          LX1    59-47
          BX1    X2*X1
          ZR     X1,EXIT     IF NOT *POSMF* IN PROGRESS
          SX7    PCFL
          EQ     EXI4        QUEUE NEW REQUEST
 RPR      SPACE  4,10
**        RPR - REISSUE PP REQUEST AFTER DELAY.
 
 
 RPR      BSS    0           ENTRY
          SA1    A0+UFLA
          SX7    B0+
          MX2    -48
          SA7    A0+UREQ     PREVENT THIS REQUEST FROM BEING STACKED
          BX6    -X2*X1
          SA6    A0+UXRQ
          RJ     GNR         GET NEXT REQUEST
          EQ     EXIX        PROCESS NEXT UNIT
 RRM      SPACE  4,10
**        RRM - REQUEST REEL MOUNT.
 
 
 RRM      BSS    0           ENTRY
          SA1    A0+UST1
          SX3    B0          SET NO ERROR MESSAGE
          LX1    59-49
          NG     X1,EXIT     IF ACS UNIT
          RJ     SPR         SET PREVIEW DISPLAY REQUEST
          EQ     EXIT        PROCESS NEXT REQUEST
 RRP      SPACE  4,10
**        RRP - REEL REJECT EXIT PROCESSOR.
 
 
 RRP      BSS    0           ENTRY
 
*         CHECK ERROR STATUS.
 
          SA1    A0+UST1
          SA2    A0+UTMS
          SA3    A0+UST5
          SA4    A0+UST2
          SX5    B0
          LX1    59-49
          LX2    59-12
          LX3    12
          LX4    59-10
          AX3    48          *RRJ* ERROR SUB-CODE
          NG     X1,RRP1     IF ACS UNIT
          SX6    X3-WRD
          ZR     X6,RRP2     IF WRITE DISABLED ERROR
          NG     X2,RRP3     IF TO WRITE TMS SECURITY LABELS
          SX6    X3-CAD
          NZ     X6,RRP2     IF NOT ACCESS ERROR
          NG     X4,RRP2     IF NOT INITIAL REEL ASSIGNMENT
 
*         ABORT REQUEST.
 
 RRP1     SX7    PRRA
          EQ     EXI3        CLEAR QUEUE AND ABORT REQUEST
 
*         REQUEST REMOUNT OF REEL.
 
 RRP2     SA3    RRPA+X3     GET PREVIEW DISPLAY MESSAGE CODE
          SX7    PRUL
          EQ     RRP4        REQUEST PREVIEW DISPLAY
 
*         WAIT FOR OPERATOR GO.
 
 RRP3     SA3    RRPB+X3     GET PREVIEW DISPLAY MESSAGE CODE
          SX6    B1
          LX2    12-12-59+12
          LX6    23-0
          BX6    X2+X6       SET WAIT GO FLAG
          SX7    PWUG        WAIT FOR UNIT GO
          SA6    A2+
 
*         SET PREVIEW DISPLAY REQUEST.
 
 RRP4     RJ     SPR         SET PREVIEW DISPLAY REQUEST
          EQ     EXI1        CLEAR CURRENT REQUEST AND ENTER NEW
 
 
 RRPA     IVFD
          IVFD   WRD,(54/0,6//RSX/NWE)  WRITE DISABLED
          IVFD   NLB,(54/0,6//RSX/NLB)  NEEDS LABEL
          IVFD   CAD,(54/0,6//RSX/CAD)  CANNOT ACCESS DATA
          IVFD   WVS,(54/0,6//RSX/WVS)  WRONG VSN
          IVFD   MRSC
 
 RRPB     IVFD
          IVFD   NLB,(54/0,6//RSX/NLG)  NEEDS LABEL
          IVFD   CAD,(54/0,6//RSX/CAG)  CANNOT ACCESS DATA
          IVFD   WVS,(54/0,6//RSX/WVG)  WRONG VSN
          IVFD   MRSC
 RSP      SPACE  4,10
**        RSP - REWIND OR UNLOAD UNIT PRIOR TO REEL SWAP.
*
*         FOR CTS UNITS, THE REWIND OR UNLOAD OPERATION ALSO UPDATES
*         THE RECOVERED ERROR COUNTS IN *UERC* FOR LOGGING BY REEL
*         RETURN PROCESSING.
 
 
 RSP      BSS    0           ENTRY
          RJ     CUL         CHECK UNLOAD REQUIRED
          SX7    PREW        REWIND REEL
          SX5    B0+
          NZ     B3,EXI4     IF NOT TO UNLOAD UNIT
          SX7    PUNL        UNLOAD UNIT
          EQ     EXI4        QUEUE NEW REQUEST
 RXL      SPACE  4,10
**        RXL - RETURN LABELS TO EXTENDED LABEL BUFFER.
 
 
 RXL      BSS    0           ENTRY
          SA1    A0+UCIB     CHECK XL BIT
          LX1    59-41
          PL     X1,EXIT     IF NO EXTENDED LABELS
          SX7    PRXL        RETURN HEADER LABELS TO XL BUFFER
          EQ     EXI4        QUEUE NEW REQUEST
 SEF      SPACE  4,10
**        SEF - CHECK ERROR FLAG DURING SKIP.
*
*         ENTRY  (ULRQ, 21) = 1 IF CHECK ERROR FLAG.
 
 
 SEF      BSS    0           ENTRY
          SA1    A0+ULRQ     OBTAIN LAST STATUS
          LX1    59-21
          PL     X1,FET      IF SKIP OPERATION COMPLETE
          LX1    59-35-59+21
          MX0    -18
          PL     X1,SEF2     IF SKIP FORWARD
 
*         CHECK FOR END OF RECORD.  IF NOT AT END OF RECORD, DO NOT
*         DECREMENT THE SKIP COUNT SINCE THE TAPE IS STILL POSITIONED
*         ON THE SAME RECORD.
 
          LX1    59-24-59+35
          PL     X1,SEF1     IF END OF RECORD
          MX0    -59         CLEAR THE NOT END OF RECORD FLAG
          BX7    -X0*X1
          LX7    24-59
          SA7    A1
          EQ     SEF2        DO NOT DECREMENT SKIP COUNT
 
*         DECREMENT THE SKIP COUNT BY ONE.  THIS IS NEEDED TO MAKE
*         THE TOTAL NUMBER OF RECORDS SKIPPED COME OUT RIGHT ON A
*         SKIP REVERSE OPERATION.
 
 SEF1     LX1    24-59
          BX2    -X0*X1
          SX2    X2-1        DECREMENT SKIP COUNT
          ZR     X2,FET      IF SKIP REVERSE OPERATION COMPLETE
          BX1    X0*X1
          BX6    X1+X2
          SA6    A1+
 SEF2     SX7    PSEF        CHECK ERROR FLAG
          EQ     EXI1        QUEUE NEW REQUEST
 SKR      SPACE  4,10
**        SKR - SKIP RECORDS/FILES.
 
 
 SKR      BSS    0           ENTRY
          SA1    A0+UCIA     SET SKIP COUNT
          SX7    SKP
          MX2    -18
          LX1    -24
          BX3    -X2*X1
          BX5    X5+X3
          EQ     IOR         BUILD I/O REQUEST
 SRA      SPACE  4,10
**        SRA - SET REEL ASSIGNED.
 
 
 SRA      BSS    0           ENTRY
          SA1    A0+UST2
          SA2    A0+UVRI
          SX6    40B
          SX7    1
          BX1    -X6*X1      CLEAR FILE POSITION INDETERMINATE
          BX2    -X7*X2      CLEAR MESSAGE FLAG
          SX6    2000B
          SX7    20B
          BX6    X1+X6       SET INITIAL REEL ASSIGNED
          BX7    X2+X7       SET REEL ASSIGNED
          SA6    A1
          SA7    A2
          EQ     EXIT        PROCESS NEXT REQUEST
 SRF      SPACE  4,10
**        SRF - SET REWIND BEFORE OPERATION FLAG.
 
 
 SRF      BSS    0           ENTRY
          SA1    A0+UST2
          SX6    4000B
          BX6    X1+X6       SET REWIND BEFORE OPERATION
          SA6    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 SSC      SPACE  4,10
**        SSC - SAVE REMAINING SKIP COUNT
 
 
 SSC      BSS    0           ENTRY
          SA1    A0+ULRQ
          MX2    -18
          BX6    -X2*X1      GET REMAINING SKIP COUNT (PA AND PB)
          LX6    24
          SA1    A0+UCIA
          LX2    24
          BX1    X2*X1       CLEAR OUT ORIGINAL SKIP COUNT
          BX6    X1+X6       USE REMAINING SKIP COUNT
          SA6    A1+
          EQ     EXIT        PROCESS NEXT REQUEST
 SVC      SPACE  4,10
**        SVC - SET VSN FOR REEL CHECK.
 
 
 SVC      BSS    0           ENTRY
          SA1    A0+UVSN
          SA2    A0+UISN
          MX0    -24
          BX1    -X0*X1
          BX2    X0*X2
          BX6    X1+X2       SET VSN
          SA6    A1          UPDATE *UVSN*
          EQ     EXIT        PROCESS NEXT REQUEST
 SVR      SPACE  4,10
**        SVR - SET NEXT VSN RETURNED.
 
 
 SVR      BSS    0           ENTRY
          SA1    A0+UVRI
          SX6    2
          BX6    X1+X6       SET NEXT VSN RETURNED
          SA6    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 URN      SPACE  4,10
**        URN - UPDATE REEL NUMBER.
 
 
 URN      BSS    0           ENTRY
          SA1    A0+UVRI
          SX6    10000B
          SX7    4
          IX6    X1+X6       ADVANCE REEL NUMBER
          BX6    X6+X7       SET REEL NUMBER ADVANCED FLAG
          SA6    A1+
          EQ     EXIT        PROCESS NEXT REQUEST
 USC      SPACE  4,10
**        USC - COMPLETE UNIT SWAP.
*
*         ENTRY  (X5) = NEW UDT ADDRESS.
 
 
 USC      BSS    0           ENTRY
 
*         SET NEW UDT ADDRESS.
 
          SA1    X5+UVRI
          SA2    X5+UREQ
          LX1    59-47
          PL     X1,HGU      IF UNIT SWAP NOT SET
          NZ     X2,HGU      IF PROCESSOR ACTIVE ON NEW UNIT
 
*         MOVE PARAMETERS TO NEW UDT ENTRY.
 
          MOVE   UCIC+1-UFRQ,A0+UFRQ,X5+UFRQ  MOVE FILE REQUEST
          MOVE   UST5+1-UST2,A0+UST2,X5+UST2  MOVE STATUS FLAGS
          MOVE   UDAT+1-UBLC,A0+UBLC,X5+UBLC  MOVE FLAGS AND LABEL DATA
          SX6    B0+
          SA6    A0+UFRQ     CLEAR FILE REQUEST
          SA6    A0+UVRI     CLEAR JOB ASSIGNMENT
 
*         SET NEW UDT ORDINAL IN QUEUE ENTRIES.
 
          TA1    -1,UQUE
          MX0    6
          SX2    B2          OLD UDT ORDINAL
          LX2    -6
          TX3    X5,-UBUF    NEW UDT OFFSET
          SX4    UNITL
          IX3    X3/X4       NEW UDT ORDINAL
          LX3    -6
 USC1     SA1    A1+1        GET NEXT ENTRY
          NG     X1,USC2     IF END OF ENTRIES
          ZR     X1,USC1     IF NO ENTRY
          BX1    X1-X2
          BX7    X0*X1
          NZ     X7,USC1     IF NO MATCH ON UDT ORDINAL
          BX6    X1+X3       SET NEW UDT ORDINAL
          SA6    A1
          EQ     USC1        CHECK NEXT ENTRY
 
 USC2     SX5    B0+
          SX7    PCVS        CLEAR VSN ON OLD UNIT
          EQ     EXI3        CLEAR QUEUE AND MAKE REQUEST
 USF      SPACE  4,10
**        USF - PROCESS UNIT SWAP FAILURE.
*
*         ENTRY  (X5) = NEW UDT ADDRESS.
 
 
 USF      BSS    0           ENTRY
          SA1    X5+UVRI
          SX6    B1
          LX6    47-0
          BX2    X6*X1
          BX6    -X6*X1      CLEAR UNIT SWAP FLAG
          ZR     X2,HGU      IF UNIT SWAP NOT SET
          SA6    A1
          SX5    B0
          SX7    PCNR        RESTART REEL CHECK PROCESSOR
          EQ     EXI1        CLEAR CURRENT AND ENTER NEW REQUEST
 USN      SPACE  4,10
**        USN - UPDATE SEQUENCE AND SECTION NUMBER.
 
 
 USN      BSS    0           ENTRY
          SA1    A0+USID     INCREMENT SEQUENCE NUMBER
          SX2    B1
          MX0    42
          SA3    A0+UFSN     SET SECTION NUMBER TO 1
          IX6    X1+X2
          BX4    X0*X3
          SA6    A1
          BX6    X4+X2
          SA6    A3+
          EQ     EXIT        PROCESS NEXT REQUEST
 USP      SPACE  4,10
**        USP - INITIATE UNIT SWAP.
*
*         ENTRY  (X5) = NEW UDT ADDRESS.
 
 
 USP      BSS    0           ENTRY
          LX5    12
          SX6    AFUS
          BX5    X5+X6       SET UDT ADDRESS AND SUBFUNCTION
          SX7    AFN
          EQ     EXI2        MAKE *1MU* REQUEST
 VME      SPACE  4,10
**        VME - ISSUE EVENT AFTER ACS VSN MOUNT ERROR.
*
*         ENTRY  (X5) = VSN ERROR TABLE ORDINAL.
 
 
 VME      BSS    0           ENTRY
          LX5    12
          SX6    AFME
          BX5    X5+X6       SET TABLE ORDINAL AND SUBFUNCTION
          SX7    AFN
          EQ     EXI2        MAKE *1MU* REQUEST
 WAC      SPACE  4,10
**        WAC - WAIT FOR UNIT ACCESSIBLE.
 
 
 WAC      BSS    0
          SA1    ACCU
          SA2    ITIM
          LX1    B2
          LX2    59-3
          NG     X1,EXIT     IF UNIT ACCESSIBLE
          PL     X2,EXI5     IF NOT 8 SECOND INTERVAL
          SX5    B0+
          SX7    PWAC
          EQ     EXI1        CHECK ERROR FLAG AND REENTER
 WDA      SPACE  4,10
**        WDA - WRITE DATA.
*         EOF WRITES ON TAPES WHERE THIS IS A TAPE MARK ARE HANDLED
*         BY THE WRITE LABEL CODE IN *1MT*.  THUS, THEY ARE HANDLED
*         BY THE POST WRITE CHECKING.
 
 
 WDA      BSS    0           ENTRY
          SX7    WTF         SET WRITE FUNCTION
          EQ     IOR         BUILD I/O REQUEST
 
*         POST PROCESS WRITE.
 
 WDA1     BSS    0           ENTRY
          SA1    A0+ULRQ     CHECK IF EOF NEEDED
          SX2    14B
          LX2    24
          BX3    X2*X1
          BX5    X3-X2
          NZ     X5,EXIT     IF NO EOF
          SX7    WLA         WRITE EOF
          ERRNZ  WLTM
          EQ     EXI2        ENTER *1MT* REQUEST
 WNB      SPACE  4,10
**        WNB - WAIT FOR UNIT NOT BUSY.
 
 
 WNB      BSS    0
          SA1    A0+UST1
          SA2    ITIM
          LX1    59-1
          LX2    59-3
          PL     X1,EXIT     IF UNIT NOT BUSY
          PL     X2,EXI5     IF NOT 8 SECOND INTERVAL
          SX5    B0+
          SX7    PWNB
          EQ     EXI1        CHECK ERROR FLAG AND REENTER
 WNV      SPACE  4,10
**        WNV - WAIT FOR OPERATOR TO SPECIFY NEXT VSN.
 
 
 WNV      BSS    0
          SA1    A0+UESN
          SA2    ITIM
          MX6    36
          SX5    B0
          BX1    X6*X1
          LX2    59-3
          NZ     X1,EXIT     IF NEXT VSN SPECIFIED
          PL     X2,EXI5     IF NOT 8 SECONDS, REENTER
          SX7    PWNV
          EQ     EXI1        CHECK ERROR FLAG AND REENTER
 WTD      SPACE  4,10
**        WTD - WAIT FOR TIME DELAY.
 
 
 WTD      BSS    0           ENTRY
          SA1    ITIM
          SX5    B0+
          LX1    59-6
          NG     X1,EXIT     IF 64 SECOND INTERVAL
          LX1    59-3-59+6
          PL     X1,EXI5     IF NOT 8 SECOND INTERVAL
          SX7    PWTD
          EQ     EXI1        CHECK ERROR FLAG AND REENTER
          TITLE  TAPE MANAGEMENT SYSTEM.
 ATM      SPACE  4,10
**        ATM - CHECK ASSIGNMENT OF TMS TAPE.
*
*         IF A SCRATCH REEL HAS BEEN ASSIGNED, INITIALIZE UDT FIELDS
*         FOR *VOL1* AND *HDR1* LABEL WRITE.
 
 
 ATM      BSS    0           ENTRY
          SA1    A0+UTMS
          SX0    /TFM/WUBL
          MX2    1
          LX0    23-11
          BX5    X0*X1
          LX2    6+12-59     SET FIRST LABEL ON VOLUME
          BX6    X1+X2
          SA6    A1
          ZR     X5,ATM1     IF NOT TMS SCRATCH TAPE ASSIGNMENT
          BX6    -X0*X1      CLEAR SCRATCH TAPE FLAG
          SA6    A1+
          MX0    6*6         SET INTERNAL = EXTERNAL VSN
          SA1    A0+UESN
          SA2    A0+UVSN
          SA3    A0+UISN
          BX1    X0*X1
          BX2    -X0*X2
          BX3    -X0*X3
          BX6    X1+X2
          BX7    X1+X3
          SX5    B0
          SA6    A2
          SA7    A3
          SA1    A0+UST2
          MX7    54
          LX1    59-10
          NG     X1,EXIT     IF NOT INITIAL REEL ASSIGNMENT
          SA1    A0+UGNU
          SX0    20000B
          SX3    55B
          LX7    30
          LX3    30
          BX6    X6+X0       SET LABEL EXPIRED
          BX1    X7*X1
          SA6    A6
          BX7    X1+X3       SET BLANK VOLUME ACCESSIBILITY
          SA7    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 
 ATM1     SA1    A0+UCIA     CHECK FOR *CIO* READ REQUEST
          AX1    48
          SX2    1702B
          BX1    X2*X1
          ZR     X1,VTL      IF READ REQUEST
          EQ     EXIT        PROCESS NEXT REQUEST
 AVS      SPACE  4,10
**        AVS - ADVANCE VSN FILE.
*
*         IF NOT A TMS CONTROLLED FILE, A REQUEST TO *1MU* IS MADE TO
*         ADVANCE THE VSN FILE.  IF A TMS CONTROLLED FILE, THE CURRENT
*         STRING IS CLEARED AND A REQUEST TO *TFM* IS MADE TO ADVANCE
*         THE VSN FILE.
 
 
 AVS      BSS    0           ENTRY
          SA1    A0+UTMS     ADVANCE VSN FILE
          SX0    /TFM/RSTC
          BX5    X0*X1
          NZ     X5,AVS1     IF TMS CONTROLLED FILE
          SX7    AFN         SET FUNCTION
          SX5    AFNV        SET SUBFUNCTION
          EQ     EXI2        MAKE *1MU* REQUEST
 
 AVS1     SX2    /TFM/WURF
          LX2    23-11
          BX3    X2*X1
          SX2    /TFM/AVSS
          ZR     X3,AVS2     IF NOT REWIND
          SX2    /TFM/RFVS
 AVS2     RJ     STF         SET TMS FUNCTION
          SX5    B0+
          SX7    PCTM        CALL TAPE MANAGER
          EQ     EXI4        QUEUE NEW REQUEST
 CTM      SPACE  4,10
**        CTM - CALL TAPE MANAGER.
*
*         SET THE REQUEST IN PROCESS FLAG IN *UXRQ*
*         TO MAKE *MAGNET* SKIP PROCESSING OF THIS
*         UNIT AND SET THE REQUEST PENDING FLAG FOR
*         *TFM*. CALL *TFM*.
 
 
 CTM      BSS    0           ENTRY
          SX7    RIP         CALL TAPE MANAGER
          SA1    A0+UTMS     INSURE REQUEST PENDING SET
          LX7    48
          MX0    -6
          SX5    /TFM/RSIL
          SA7    A0+UXRQ     SET REQUEST IN PROCESS
          BX2    X0*X1
          BX7    X5+X2
          MX0    -18         BUILD TFM REQUEST
          SA7    A1+
          SA1    CTMA
          SX2    A0
          BX7    X0*X1
          BX6    X2+X7
          RJ     SYS=        PROCESS SYSTEM REQUEST
          EQ     EXIX        PROCESS NEXT UNIT
 
 CTMA     VFD    18/0LTFM,6/0,18//TFM/MAGF*100B,18/0
 RFV      SPACE  4,10
**        RFV - REWIND FILE TO FIRST VOLUME.
*
*         IF THIS IS A TMS CONTROLLED FILE, SET THE
*         REWIND FILE FLAG IN UTMS.
 
 
 RFV      BSS    0           ENTRY
          SA1    A0+UTMS     REWIND FILE
          SX0    /TFM/RSTC
          BX5    X0*X1
          ZR     X5,EXIT     IF NOT TMS FILE
          SX2    /TFM/WURF   SET REWIND FLAG
          LX2    23-11
          BX6    X1+X2
          SA6    A1
          EQ     EXIT        PROCESS NEXT REQUEST
 RRF      SPACE  4,10
**        RRF - RETURN/RESERVE TAPE FILE.
*
*         IF THIS IS A TMS CONTROLLED FILE, REQUEST
*         *TFM* TO RETURN/RESERVE THE FILE.
 
 
 RRF      BSS    0           ENTRY
          SA1    A0+UTMS     RETURN/RESERVE TAPE FILE
          SX0    /TFM/RSTC
          BX5    X0*X1
          ZR     X5,EXIT     IF NOT TMS FILE
          SX2    /TFM/RTFS
          RJ     STF         SET TMS FUNCTION
          SX5    B0+
          SX7    PCTM        CALL TAPE MANAGER
          EQ     EXI4        QUEUE NEW REQUEST
 STF      SPACE  4,10
**        STF - SET TMS FUNCTION CODE.
*
*         SET THE *TFM* FUNCTION CODE IN *UTMS*
*         BYTE 0.
*
*         ENTRY  (X2) = FUNCTION CODE.
*
*         USES   X - 0, 1, 6, 7.
*                A - 1, 7.
 
 
 STF      SUBR               ENTRY/EXIT
          SA1    A0+UTMS
          MX0    12
          BX6    -X0*X1
          LX2    59-11
          BX7    X2+X6
          SA7    A1+
          EQ     STFX        RETURN
 TCP      SPACE  4,15
**        TCP - TMS COMPLETION PROCESSING.
*
*         CHECK THE RETURN STATUS FLAGS AFTER *TFM*
*         HAS COMPLETED.
 
 
 TCP      BSS    0           ENTRY
          SA1    A0+UTMS     TMS COMPLETION PROCESSING
          LX1    59-0
          NG     X1,EXI5     IF REQUEST PENDING
          LX1    59-2-59+0
          NG     X1,TCP1     IF ABORT USER JOB
          LX1    59-1-59+2
          MX0    1
          PL     X1,EXIT     IF NOT RE-ISSUE REQUEST
          BX6    X0-X1       CLEAR RE-ISSUE REQUEST
          SX5    B0          NO PARAMETERS
          LX6    -59+1
          SX7    PCTM        CALL TAPE MANAGER
          SA6    A1
          EQ     EXI1        CLEAR CURRENT REQUEST AND REISSUE
 
 TCP1     SX5    TPE         SET *TAPE MANAGER ERROR*
          EQ     ABR         CLEAR REQUEST QUEUE AND ABORT JOB
 VMF      SPACE  4,10
**        VMF - VALIDATE MULTI-FILE REQUEST.
*
*         IF THE TAPE CONTAINS SYMBOLIC ACCESS FILES, CALL *TFM* TO
*         VERIFY THAT THE USER MAY ACCESS THE TAPE.
 
 
 VMF      BSS    0           ENTRY
          SA1    A0+UTMS     CHECK FOR TMS TAPE, SYMBOLIC ACCESS FILES
          SX0    /TFM/RSSA
          BX0    X0*X1
          ZR     X0,EXIT     IF NON-SYMBOLIC ACCESS FILE
          SX2    /TFM/VMFS   VALIDATE MULTI-FILE
          RJ     STF         SET TMS FUNCTION
          SX5    B0+
          SX7    PCTM        CALL TAPE MANAGER
          EQ     EXI4        QUEUE NEXT REQUEST
 VTL      SPACE  4,10
**        VTL - VERIFY TAPE LABELS.
*
*         IF THIS IS A TMS CONTROLLED FILE WITH SYMBOLIC ACCESS SET,
*         CALL *TFM* TO VERIFY THAT THE LABELS MATCH THE CATALOG
*         ENTRIES.  IF THE LABEL WAS JUST WRITTEN, *TFM* WILL UPDATE
*         THE CATALOG ENTRY TO MATCH THE LABEL.
 
 
 VTL      BSS    0           ENTRY
          SX2    /TFM/VTLS   VERIFY TAPE LABELS
          EQ     VTL2        VERIFY SYMBOLIC ACCESS TAPE
 
 VTL1     BSS    0           ENTRY
          SX2    /TFM/UCES   UPDATE CATALOG ENTRY
 VTL2     SA1    A0+UTMS     CHECK FOR TMS TAPE, SYMBOLIC ACCESS FILES
          SX0    /TFM/RSSA
          BX0    X0*X1
          ZR     X0,EXIT     IF NON-SYMBOLIC ACCESS FILE
          SA1    A0+UST4
          LX1    59-58
          PL     X1,EXIT     IF NOT LABELED TAPE
          LX1    59-57-59+58
          NG     X1,EXIT     IF NON-STANDARD LABELS
          RJ     STF         SET TMS FUNCTION
          SX5    B0+
          SX7    PCTM        CALL TAPE MANAGER
          EQ     EXI4        QUEUE NEXT REQUEST
 WUG      SPACE  4,15
**        WUG - WAIT UNIT GO.
 
 
 WUG      BSS    0           ENTRY
          SA1    A0+UTMS     WAIT UNIT GO
          SA2    ITIM
          SX5    B0
          BX3    X1
          LX1    59-23
          LX2    59-3
          PL     X1,WUG1     IF GO OR STOP PROCESSED
          PL     X2,EXI5     IF NOT 8 SECOND INTERVAL
          SX7    PWUG        CHECK ERROR AND CONTINUE WAIT
          EQ     EXI1        ENTER REQUEST
 
 WUG1     SX6    40000B
          BX6    -X6*X3      CLEAR UNLOAD FLAG
          LX1    59-14-59+23
          SA6    A1+
          SX7    PRUL        SET TO REMOUNT REEL
          NG     X1,EXI1     IF TO UNLOAD UNIT
          SA1    A0+UVRI
          SX7    PASN        SET TO ASSIGN REEL
          MX6    59
          BX6    X6*X1       CLEAR PREVIEW DISPLAY MESSAGE FLAG
          SA6    A1
          EQ     EXI1        CLEAR CURRENT REQUEST AND ENTER NEW
          TITLE  REQUEST PROCESSOR SUBROUTINES.
          SPACE  4,10
**        SUBROUTINE REGISTER CONVENTIONS.
*
*         UNLESS OTHERWISE DOCUMENTED ALL ROUTINES EXPECT THE FOLLOWING
*         ENTRY CONDITIONS AND WILL EXIT WITH THESE REGISTERS
*         UNCHANGED.
*
*         ENTRY  (A0) = FWA OF UDT.
*                (B2) = UNIT NUMBER (SOFTWARE).
 ABR      SPACE  4,10
**        ABR - ABORT REQUEST.
*
*         ENTRY  (X5) = PARAMETERS FOR *MAB* FUNCTION.
*
*         EXIT   TO *EXI3*.
*
*         USES   X - 7.
 
 
 ABR      BSS    0           ENTRY
          SX7    PMAB        SET ABORT REQUEST
          EQ     EXI3        CLEAR REQUEST QUEUE AND MAKE ABORT REQUEST
 CUL      SPACE  4,10
**        CUL - CHECK UNLOAD REQUIRED BEFORE REEL SWAP.
*
*         EXIT   (B3) = 0 IF TO UNLOAD UNIT.
*                (B3) .NE. 0 IF NOT TO UNLOAD UNIT.
*
*         USES   X - 1, 2.
*                A - 1, 2.
*                B - 3.
*
*         CALLS  FNR.
 
 
 CUL      SUBR               ENTRY/EXIT
          SA1    A0+UST1
          SA2    A0+UST4
          SB3    1           SET NO UNLOAD
          LX1    59-49
          LX2    59-41
          NG     X1,CULX     IF ACS UNIT
          PL     X2,CUL1     IF NOT INHIBIT UNLOAD
          RJ     FNR         FIND NEXT REEL
          NE     B3,B4,CULX  IF REEL FOUND
 CUL1     SB3    B0          SET UNLOAD UNIT
          EQ     CULX        RETURN
 DAU      SPACE  4,10
**        DAU - DISMOUNT ACS UNIT.
*
*         ENTRY  (A0) = UDT ADDRESS OF UNIT TO DISMOUNT.
*
*         EXIT   DISMOUNT INITIATED.
*
*         USES   X - 3, 6, 7.
*                A - 3.
*
*         CALLS  IAR.
 
 
 DAU      SUBR               ENTRY/EXIT
          SA3    A0+UMST
          MX7    -2
          MX6    57
          BX3    X6*X3       CLEAR STATUS FLAGS
          BX3    -X7+X3      SET DISMOUNT IN PROGRESS
          SX6    /ATF/DMT    SET DISMOUNT REQUEST
          RJ     IAR         INITIATE ATF REQUEST
          EQ     DAUX        RETURN
 FAV      SPACE  4,20
**        FAV - FIND ACS VSN.
*
*         ENTRY  (X1) = EXTERNAL VSN LEFT JUSTIFIED.
*
*         EXIT   (B3) = 0 IF VSN NOT FOUND.
*                (B3) = UDT ADDRESS IF VSN FOUND IN UDT.
*                (B3) .LT. 0 IF VSN FOUND IN VET.
*                (X3) = 0 IF VSN FOUND IN UDT ON UNASSIGNED UNIT.
*                (X3) .NE. 0 IF VSN FOUND IN UDT ON ASSIGNED UNIT.
*                (X7) = MOUNT STATUS IF VSN FOUND IN UDT.
*                (X3) = *COMSRSX* MESSAGE CODE IF VSN FOUND IN VET AND
*                       NOT TRANSIENT ERROR.
*                (X3) = 0 IF VSN FOUND IN VET AND TRANSIENT ERROR.
*                (B6) = UDT ADDRESS OF AVAILABLE UNIT IF VSN NOT FOUND.
*                (B6) = 0 IF VSN NOT FOUND AND NO AVAILABLE UNIT FOUND.
*
*         USES   X - 0, 2, 3, 4, 6, 7.
*                A - 2, 3, 4.
*                B - 3, 4, 5, 6.
 
 
 FAV      SUBR               ENTRY/EXIT
          SA2    NXAU
          SA4    ASGU
          TB3    -UNITL,UBUF
          TB4    0,UBUF,LWA
          MX0    36
          MX6    -3
          SB6    B0+         INITIALIZE AVAILABLE UNIT POINTER
          SB5    X2+         SET NEXT ACS MOUNT POINTER
          LX4    -1          INITIALIZE ACCESSIBILITY MASK
 
*         CHECK VSN ON UNIT.
 
 FAV1     SB3    B3+UNITL    ADVANCE UDT ADDRESS
          EQ     B3,B4,FAV2  IF ALL UNITS CHECKED
          SA2    B3+UST1
          LX4    1           ADVANCE AVAILABLE UNIT MASK
          LX2    59-49
          PL     X2,FAV1     IF NOT ACS UNIT
          SA2    B3+UMST
          SA3    B3+UVRI
          BX7    -X6*X2      MOUNT STATUS AND CONTROL PATH ERROR
          BX2    X2-X1
          BX2    X0*X2
          ZR     X2,FAVX     IF VSN FOUND
 
*         CHECK UNIT AVAILABILITY.
 
          GE     B6,B5,FAV1  IF BEST UNIT ALREADY FOUND
          NZ     X3,FAV1     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
          SA2    B3+UREQ
          PL     X4,FAV1     IF UNIT NOT AVAILABLE FOR ASSIGNMENT
          NZ     X7,FAV1     IF MOUNT OR DISMOUNT OR CONTROL PATH ERROR
          NZ     X2,FAV1     IF PROCESSOR ACTIVE
          SB6    B3          UPDATE AVAILABLE UNIT POINTER
          EQ     FAV1        CHECK NEXT UNIT
 
*         CHECK FOR PREVIOUS MOUNT ERROR ON VSN.
 
 FAV2     SA2    VET-1
          SB3    B0+         SET VSN NOT FOUND
 FAV3     SA2    A2+1        GET VET ENTRY
          BX3    X2-X1
          BX3    X0*X3
          ZR     X3,FAV4     IF PREVIOUS MOUNT ERROR ON VSN
          NZ     X2,FAV3     IF MORE ENTRIES TO CHECK
          SX3    A2-VET-VETL
          NZ     X3,FAVX     IF ERROR TABLE NOT FULL
          SB6    B0          INDICATE NO AVAILABLE UNIT
          EQ     FAVX        RETURN
 
 FAV4     MX7    -6
          SB3    -1          SET ERROR ON VSN
          BX3    -X7*X2      SET ERROR CODE
          EQ     FAVX        RETURN
 FNR      SPACE  4,10
**        FNR - FIND NEXT REEL.
*
*         EXIT   (B3) .NE. (B4) IF VSN FOUND.
*                (B3) = UDT ADDRESS IF VSN FOUND.
*
*         USES   A - 1, 2, 3, 4, 5.
*                X - 1, 2, 3, 4, 5, 6, 7.
*                B - 3, 4.
 
 
 FNR      SUBR               ENTRY/EXIT
 
*         INITIALIZE FOR REEL SEARCH.
 
          SA1    A0+UISN
          SA2    ASGU
          TB3    -UNITL,UBUF SET UDT FWA
          MX7    36
          MX6    37
          LX2    -1          INITIALIZE ASSIGNABLE UNIT MASK
          BX7    X7*X1       REQUESTED VSN
          SA1    A0+UESN
          LX1    59-5        POSITION SCRATCH REQUEST FLAG
          SB4    B3          SET EXIT CONDITION FOR NO VSN
          ZR     X7,FNRX     IF VSN UNKNOWN
          TB4    0,UBUF,LWA  SET UDT LWA+1
 
*         SEARCH FOR REQUESTED REEL.
 
 FNR1     SB3    B3+UNITL    ADVANCE UDT ADDRESS
          EQ     B3,B4,FNRX  IF ALL UNITS CHECKED
          SA3    B3+UVSN
          SA4    B3+UVRI
          LX2    1
          PL     X2,FNR1     IF UNIT NOT AVAILABLE FOR ASSIGNMENT
          BX5    X6*X3       VSN AND LABEL CHECK FLAG
          NZ     X4,FNR1     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
          BX5    X5-X7
          LX3    59-22
          ZR     X5,FNR2     IF MATCHING VSN AND NO LABEL CHECK
          PL     X1,FNR1     IF NOT SCRATCH REQUEST
          PL     X3,FNR1     IF SCRATCH NOT MOUNTED
 FNR2     SA3    A0+UST1
          SA4    B3+UST1
          SA5    =77020263000000000000B  GET UNIT TYPE MASK
          BX3    X3-X4       COMPARE UNIT TYPE
          BX3    X5*X3
          NZ     X3,FNR1     IF NOT SAME UNIT TYPE
          SA3    B3+UREQ
          NZ     X3,FNR1     IF PROCESSOR ACTIVE
          EQ     FNRX        RETURN
 GNS      SPACE  4,15
**        GNS - GET NEXT STRING ITEM.
*         ALL ITEMS WITH BIT 11 SET (PARAMETERS) ARE SKIPPED OVER.
*
*         ENTRY  (X4) = REQUEST POINTER.
*                (A4) = A0+UREQ.
*
*         EXIT   (X4) = UPDATED.
*                (X7) = PROCESSOR OR 0, IF NONE.
*                (A0+UREQ) = (X6) = UPDATED REQUEST POINTER.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 6, 7.
*                B - 5, 6.
 
 
 GNS3     BX4    X4-X4
          SA7    A4          CLEAR REQUEST WORD
 
 GNS      SUBR               ENTRY/EXIT
 GNS1     MX3    -12         EXTRACT ADDRESS
          LX4    -36
          BX7    -X3*X4
          LX4    -12         EXTRACT BYTE POINTER
          BX6    -X3*X4
          SA1    X7          READ PROCESSOR TABLE
          SB6    X6
          LX2    X1,B6       EXTRACT NEXT OPERATION
          BX7    -X3*X2
          LX2    59-11
          ZR     X7,GNS3     IF END OF STRING
          SB5    B6-60       ADVANCE STRING POINTER
          NZ     B5,GNS2     IF NOT AT END OF WORD
          SX6    B1          ADVANCE WORD
          BX4    X3*X4       CLEAR BYTE INDEX
          LX6    48
          IX4    X4+X6
 GNS2     SX3    12
          IX4    X4+X3
          LX4    48
          NG     X2,GNS1     IF PARAMETER SKIP IT
          BX6    X4
          SA6    A4
          EQ     GNSX        RETURN
 GPI      SPACE  4,15
**        GPI - GET PARAMETER ITEM IF NEXT IN STRING.
*
*         ONLY AN ITEM WITH BIT 11 SET (PARAMETERS) IS RETURNED.
*
*         ENTRY  (X4) = REQUEST POINTER.
*                (A4) = A0+UREQ.
*
*         EXIT   (X2) = 0, IF NO PARAMETER RETURNED.
*                (X4) = UPDATED IF PARAMETER FOUND.
*                (X7) = PROCESSOR OR 0, IF NONE.
*                (A0+UREQ) = (X6) = UPDATED REQUEST POINTER.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 6.
*                B - 5, 6.
 
 
 GPI2     SX7    B0+
          BX2    X2-X2
          LX4    48
 
 GPI      SUBR               ENTRY/EXIT
          MX3    -12         EXTRACT ADDRESS
          LX4    -36
          BX7    -X3*X4
          LX4    -12         EXTRACT BYTE POINTER
          BX6    -X3*X4
          SA1    X7          READ PROCESSOR TABLE
          SB6    X6
          LX2    X1,B6       EXTRACT NEXT OPERATION
          BX7    -X3*X2
          LX2    59-11
          PL     X2,GPI2     IF NOT PARAMETER
          SB5    B6-60       ADVANCE STRING POINTER
          NZ     B5,GPI1     IF NOT AT END OF WORD
          SX2    B1          ADVANCE WORD
          BX4    X3*X4       CLEAR BYTE INDEX
          LX2    48
          IX4    X4+X2
 GPI1     SX3    12          ADVANCE BYTE INDEX
          IX6    X4+X3
          SX2    B1
          LX6    48
          BX4    X6
          SA6    A4
          LX2    11
          BX7    -X2*X7
          EQ     GPIX        RETURN
 GNR      SPACE  4,10
**        GNR - GET NEXT REQUEST.
*
*         EXIT   (X4) = 0, OR REQUEST IF ONE FOUND.
*                (A4) = A0+UREQ.
*                STACKED REQUEST FLAG CLEARED IF NO STACKED REQUESTS.
*                REQUEST STORED AT (A0+UREQ) IF EXTRACTED FROM UNIT
*                  REQUEST QUEUE.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 1, 3, 4, 6.
 
 
 GNR2     MX2    -59         CLEAR STACKED REQUEST FLAG
          BX6    -X2*X3
          SX4    B0
          SA6    A3
 
 GNR      SUBR               ENTRY/EXIT
          SA4    A0+UREQ
          NZ     X4,GNRX     IF REQUEST FOUND
          SA3    A0+UFLA
          PL     X3,GNRX     IF NOT STACKED REQUESTS
          TA1    -1,UQUE     UNIT REQUEST BUFFER
          SX2    B2
          LX2    54
 GNR1     SA1    A1+1        READ NEXT ENTRY
          NG     X1,GNR2     IF END OF TABLE
          BX6    X1-X2
          ZR     X1,GNR1     IF EMPTY ENTRY
          AX6    54
          NZ     X6,GNR1     IF NOT THIS UNIT
          SA6    A1          CLEAR REQUEST
          BX6    X1-X2
          SA6    A4          STORE REQUEST
          BX4    X1-X2
          EQ     GNRX        RETURN
 HGU      SPACE  4,10
**        HGU - HANG UNIT ON SYSTEM ERROR.
*
*         USES   X - 7.
 
 
 HGU      BSS    0           ENTRY
          SX7    PHNG        HANG UNIT
          EQ     EXI4        MAKE REQUEST
 IAR      SPACE  4,15
**        IAR - INITIATE ATF REQUEST.
*
*         ENTRY  (A3) = *UMST* ADDRESS.
*                (X3) = *UMST*.
*                (X6) = ATF REQUEST CODE.
*
*         EXIT   *UARP* SET WITH REQUEST CODE AND SEQUENCE NUMBER.
*                *UARP* TIME FIELD = 0.
*                SEND REQUEST FLAG SET IN *UMST*.
*                (ATFS) .NE. 0.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 6, 7.
 
 
 IAR      SUBR               ENTRY/EXIT
          SA1    IARA        GET NEXT REQUEST SEQUENCE NUMBER
          LX6    36
          MX7    -16
          SX2    X1+B1       ADVANCE SEQUENCE NUMBER
          BX7    -X7*X2
          SA7    A1          SET NEXT SEQUENCE NUMBER
          LX1    42
          SX7    B1
          BX6    X6+X1       SET REQUEST ID AND REQUEST CODE
          SA7    ATFS        SET ATF REQUEST FLAG
          SA6    A3+UARP-UMST  SET REQUEST PARAMETERS
          LX7    3-0
          BX7    X3+X7       SET SEND REQUEST FLAG
          SA7    A3          UPDATE MOUNT STATUS
          EQ     IARX        RETURN
 
 
 IARA     CON    0           ATF REQUEST SEQUENCE NUMBER
 IXR      SPACE  4,15
**        IXR - ISSUE INCORRECT EXTERNAL REQUEST MESSAGE.
*
*         ENTRY  (X1) = REQUEST WORD IN ERROR.
*                (X2) = MESSAGE TERMINATION TEXT.
*
*         EXIT   ERROR MESSAGE ISSUED.
*
*         USES   X - 6, 7.
*                A - 6, 7.
*
*         CALLS  WOD.
*
*         MACROS MESSAGE.
 
 
 IXR      SUBR               ENTRY/EXIT
          BX6    X2          TERMINATE MESSAGE
          SA6    IXRA+5
          RJ     WOD         CONVERT BAD REQUEST
          SA6    IXRA+3
          SA7    IXRA+4
          MESSAGE IXRA       ISSUE ERROR MESSAGE
          EQ     IXRX        RETURN
 
 
 IXRA     DATA   30H INCORRECT EXTERNAL REQUEST -
          BSSZ   3
 MAV      SPACE  4,15
**        MAV - MOUNT ACS VSN.
*
*         ENTRY  (X1) = VSN TO MOUNT LEFT JUSTIFIED.
*                (B6) = UDT ADDRESS OF UNIT FOR MOUNT.
*                UNIT DISMOUNTED.
*
*         EXIT   (B6) = UDT ADDRESS OF UNIT FOR MOUNT.
*                MOUNT INITIATED ON ACS UNIT.
*
*         USES   X - 2, 3, 6, 7.
*                A - 3, 6.
*
*         CALLS  IAR.
 
 
 MAV      SUBR               ENTRY/EXIT
          SA3    B6+UMST
          MX6    36
          BX6    X6*X1       VSN
          SX7    1
          BX6    X6+X7       VSN AND MOUNT IN PROGRESS STATUS
          MX7    57
          BX3    X7*X3       CLEAR ERROR AND STATUS FLAGS
          BX3    X3+X6       SET VSN AND MOUNT IN PROGRESS
          SX6    /ATF/MNT    SET MOUNT REQUEST
          RJ     IAR         INITIATE ATF REQUEST
          SX6    B6+UNITL    ADVANCE NEXT UNIT POINTER
          TX2    X6,-UBUF,LWA
          NG     X2,MAV1     IF NOT END OF UDT
          TX6    0,UBUF      SET FIRST UNIT
 MAV1     SA6    NXAU        SET NEXT UNIT TO ASSIGN
          EQ     MAVX        RETURN
 MQE      SPACE  4,15
**        MQE - MAKE QUEUED ENTRY.
*
*         ENTRY  (A0) = UDT ADDRESS.
*                (B2) = UDT ORDINAL.
*                (X5) = PROCESSOR STRING VALUE TO BE SAVED (BITS 0-29).
*                (X7) = FWA PROCESSOR STRING.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 4, 6, 7.
*                B - 2, 7.
*
*         MACROS MEMORY.
 
 
 MQE10    MX7    60          SET NEW END OF TABLE
          SA7    A2+B7
          EQ     MQE3        CHECK FL REQUIREMENTS
 
 MQE11    SA1    A0+UFLA     SET STACKED REQUEST FLAG
          SA6    A2+
          BX7    X3+X1
          SA7    A1
          NG     X2,MQE10    IF STORED AT END OF STACK
 
 MQE      SUBR               ENTRY/EXIT
          TA2    0,UQUE
          MX3    24
          LX7    36
          SX1    12          BUILD PROCESSOR STRING QUEUED ENTRY
          SA4    A0+UREQ
          BX5    -X3*X5
          LX1    48
          BX3    X7+X5
          IX6    X3+X1
          MX7    6
          SA6    A4
          ZR     X4,MQEX     IF NO QUEUED REQUESTS
          SX5    B2          SET UDT ORDINAL IN ENTRY
          LX5    54
          BX6    X4+X5
          MX3    1
          SB7    2
 MQE1     BX4    X2-X5
          ZR     X2,MQE11    IF EMPTY SLOT OR END OF TABLE
          SA2    A2+B1
          BX4    X7*X4
          NZ     X4,MQE1     IF NOT ENTRY FOR THIS UNIT
          SA1    A2-B1       REREAD ENTRY HIT MADE ON
          SA6    A2-1        STORE NEW ENTRY
 
*         MOVE TABLE DOWN.
 
 MQE2     BX6    X1
          LX7    X2
          SA1    A1+B7
          SA2    A2+B7
          SA6    A1-B1
          SA7    A2-B1
          PL     X7,MQE2     IF NOT END OF TABLE
          BX6    X1
          LX7    X2
          SA6    A6+B7
          SA7    A7+B7
 
*         CHECK IF MORE STORAGE NEEDED.
 
 MQE3     SA1    TSRP        CHECK SPACE LEFT BETWEEN *UQUE* AND *TSRP*
          SX7    A7+6
          IX2    X7-X1
          NG     X2,MQEX     IF ENOUGH INTERTABLE SPACE
          SA4    A1-B1       LENGTH OF STAGE REQUEST TABLE
          IX3    X4+X1       LWA+1 OF STAGE REQUEST TABLE
          IX6    X2+X3       ADD IN NEEDED WORDS
          SA2    FLST        CHECK AVAILABLE FL
          SX7    X6+PFTBL*2+6
          AX2    30
          IX6    X2-X7
          PL     X6,MQE3.1   IF ENOUGH MEMORY FOR MOVE
          MEMORY CM,A2,R,X7+MEMI  REQUEST MEMORY
          EQ     MQE3        RECHECK FIELD LENGTH
 
*         MOVE FIRST ENTRY OF *PFM* REQUEST TABLE TO END OF TABLE
*         TO ALLOW SPACE FOR ADDITIONS TO *UQUE* QUEUE.
 
 MQE3.1   ZR     X4,MQE3.2   IF NO WORDS IN TABLE
          SA4    X1          MOVE WORDS 0 AND 1
          SA2    A4+B1
          BX6    X4
          LX7    X2
          SA4    A2+B1       MOVE WORDS 2 AND 3
          SA2    A4+B1
          SA6    X3
          SA7    A6+B1
          BX6    X4
          LX7    X2
          SA4    A2+B1       MOVE WORDS 4 AND 5
          SA2    A4+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X4
          LX7    X2
          SA4    A2+B1       MOVE WORDS 6 AND 7
          SA2    A4+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X4
          LX7    X2
          SA6    A7+B1
          SA7    A6+B1
          ERRNZ  PFTBL-8     CODE ASSUMES 8 WORD ENTRY
 MQE3.2   SA4    TSRM
          SX7    X1+PFTBL    SET NEW TABLE FWA
          SX6    X4+B1       INCREMENT MODIFICATION COUNT
          SA7    A4-B1
          SA6    A4
          EQ     MQEX        RETURN
 PCR      SPACE  4,20
**        PCR - PRE-PROCESS *CIO* REQUEST.
*
*         ENTRY  (A0) = UDT ADDRESS.
*                (X3) = *UCIA*.
*                (A3) = ADDRESS OF *UCIA*.
*                (A4) = ADDRESS OF *UREQ*.
*
*         EXIT   (A0) = UDT ADDRESS.
*                (A4) = ADDRESS OF *UREQ*.
*                (X7) = REQUEST.
*                (X5) = REQUEST PARAMETERS.
*                TO *ABR* IF ERROR IN *CIO* REQUEST.
*
*         USES   X - ALL.
*                A - 1, 2, 6.
*                B - 3, 4, 5, 6, 7.
*
*         CALLS  SBS.
 
 
*         PROCESS REQUEST ON *S* OR *L* FORMAT TAPE.
 
 PCR4     AX1    1
          MX0    4
          ZR     X1,PCR3     IF FET LENGTH .LE. 6
          LX0    35-59
          BX6    X0*X2       GET LEVEL NUMBER
          ZR     X6,PCR5     IF LEVEL 0
          BX6    X0+X2       SET LEVEL 17B
          SA6    A2
 PCR5     SX0    1000B       SET DEFAULT BLOCK SIZE
          RJ     SBS         SET BLOCK SIZE FOR S/L FORMAT
 
*         BUILD REQUEST AND CHECK END OF SET AND POSITION LOST.
 
 PCR6     SA1    A0+UST2
          SX7    4074B
          LX3    12
          SX6    B4-/CIO/SKP
          LX1    59-6
          ZR     X6,PCR7     IF SKIP FUNCTION
          SX7    4060B       CLEAR TERMINATION CONDITION
 PCR7     BX5    X7*X3       EXTRACT FUNCTION FLAGS
          MX6    2
          SX7    TPRO+B4     SET REQUEST
          BX6    X6*X1
          LX5    24          SET REQUEST PARAMETERS
          ZR     X6,PCRX     IF NOT END OF SET OR POSITION LOST
          ZR     B6,PCR9     IF *POSMF* FUNCTION
          PL     X6,PCR8     IF NOT END OF SET
          SX5    IOS         * INCORRECT OPERATION AT END OF SET*
          EQ     ABR         ABORT REQUEST
 
 PCR8     SX2    B4-/CIO/REW
          ZR     X2,PCRX     IF *REWIND* FUNCTION
          SX5    FPI         * FILE POSITION INDETERMINATE*
          EQ     ABR         ABORT REQUEST
 
 PCR9     MX6    -59
          BX6    -X6*X1      CLEAR END OF SET FLAG
          LX6    6-6-59+6
          SA6    A1
 
 PCR      SUBR               ENTRY/EXIT
 
*         CHECK FOR REWIND OR REEL CHECK BEFORE *CIO* OPERATION.
 
          SA2    A0+UST2
          MX6    -2
          LX3    6
          MX7    -4
          LX2    0-10
          BX7    -X7*X3
          BX2    -X6*X2
          LX3    -6
          SB3    X2
          SB4    X7+         INTERNAL FUNCTION CODE
          EQ     B3,B1,PCR0  IF NO REWIND OR REEL CHECK REQUIRED
          SX5    B0+
          SX7    PRWF
          GT     B3,B1,PCRX  IF REWIND BEFORE REQUEST
          SX7    PCHR
          EQ     PCRX        PERFORM INITIAL REEL CHECK
 
*         CHECK FET PARAMETERS.
 
 PCR0     SA1    A0+UST4     CHECK FORMAT
          SA2    A0+UCIB     GET EXTERNAL CODE
          LX1    24
          AX1    54
          SB7    X1-TFF
          NZ     B7,PCR1     IF NOT F FORMAT
          MX6    1
          LX6    52-59
          BX1    X6*X3       GET *READN*/*WRITEN* FLAG
          NZ     X1,PCR1     IF *READN*/*WRITEN*
          LX6    53-59-52+59
          BX6    X3+X6       SET *READCW*/*WRITECW* FLAG
          SA6    A3+
          BX3    X6
 PCR1     LX2    58-48
          MX1    -7
          LX3    18
          BX4    -X1*X2      GET EXTERNAL FUNCTION CODE
          MX6    -6
          SB6    X4-110B/4   CHECK FOR *POSMF*
          BX1    -X6*X3      FET LENGTH - 5
          LX2    59-41-58+48
          SB5    X1-13+5
          LX3    -18
          SX6    1001B
          NZ     B6,PCR2     IF NOT *POSMF*
          PL     B5,PCR2     IF FET LENGTH .GE. 13D
          PL     X2,PCR3     IF NOT EXTENDED LABELS
 PCR2     SB7    B7-TFS+TFF
          MX5    -18
          LX2    41-59
          BX5    -X5*X2      *MLRS* VALUE
          IX6    X5-X6
          EQ     B7,B1,PCR4  IF L FORMAT
          NZ     B7,PCR6     IF NOT S FORMAT
          NG     X6,PCR4     IF MLRS .LE. 1000B
 
*         PROCESS BUFFER ARGUMENT ERROR.
 
 PCR3     SX5    BAE         * BUFFER ARGUMENT ERROR*
          EQ     ABR         ABORT REQUEST
 PUR      SPACE  4,10
**        PUR - PRE-PROCESS UNIT RETURN.
*
*         ENTRY  (X6) = *UFRQ*
*
*         EXIT   (X7) = REQUEST.
*                (X5) = 0.
*                TO *HGU* IF INCORRECT PROCESSOR SEQUENCE NUMBER.
*
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 6.
 
 
 PUR      SUBR               ENTRY/EXIT
 
*         THE RETURN UNIT PROCESSORS ARE DIVIDED INTO SEQUENCES SUCH
*         THAT PROCESSING CAN BE RESUMED AFTER A *1MT* OR *1MU* ERROR.
 
          MX0    -12
          LX6    -36
          BX1    -X0*X6      CURRENT SEQUENCE NUMBER
          SX5    B0
          SX2    X1-PURAL
          PL     X2,HGU      IF INCORRECT SEQUENCE NUMBER, HANG UNIT
          SA1    PURA+X1     GET PROCESSOR
          SX2    B1
          IX6    X6+X2       ADVANCE SEQUENCE NUMBER FOR REENTRY
          LX6    36
          SX7    X1          SET UNIT RETURN PROCESSOR
          SA6    A0+UFRQ
          EQ     PURX        RETURN
 
 
 PURA     BSS    0           TABLE OF RETURN UNIT PROCESSORS
          CON    PRTA        FIRST SEQUENCE
          CON    PRTB        SECOND SEQUENCE
          CON    PRTC        THIRD SEQUENCE
 PURAL    EQU    *-PURA      MAXIMUM SEQUENCE + 1
 PVD      SPACE  4,15
**        PVD - PROCESS VOLUME IN DRIVE ERROR.
*
*         ENTRY  (A0) = UDT ADDRESS OF UNIT ENCOUNTERING ERROR.
*                (B3) = MOUNT REQUEST ERROR CODE.
*
*         EXIT   DISMOUNT INITIATED IF DRIVE IN USE ERROR.
*                DISMOUNT INITIATED ON UNIT INDICATED IN RESPONSE IF
*                  VOLUME IN DRIVE ERROR, UNIT IS ON THIS SYSTEM, AND
*                  NO MOUNT OR DISMOUNT ACTIVITY IS PRESENT.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 0, 1, 3.
*                B - 2, 3, 4.
*
*         CALLS  DAU.
 
 
 PVD      SUBR               ENTRY/EXIT
 
*         CHECK FOR ERROR REQUIRING FORCED DISMOUNT.
 
          SB4    B3-/ATF/DIU
          ZR     B4,PVD2     IF DRIVE IN USE ERROR
          SB4    B3-/ATF/VID
          NZ     B4,PVDX     IF NOT VOLUME IN DRIVE ERROR
 
*         SEARCH FOR UNIT WITH VOLUME MOUNTED.
 
          SA1    RCAL+1+/ATF/RQP1
          SB2    -1
          TB3    -UNITL,UBUF
          TB4    0,UBUF,LWA
          MX6    21
          LX6    -36
          TX2    0,UACI
          BX6    X6*X1       DRIVE IDENTIFICATION FROM RESPONSE
          LX2    3
          MX7    12
          LX7    -36
 PVD1     SB3    B3+UNITL    ADVANCE UDT ADDRESS
          EQ     B3,B4,PVDX  IF END OF UDT ENTRIES
          SA1    B3+UST1
          SA3    B3+UMST
          SB2    B2+B1       ADVANCE UDT ORDINAL
          LX1    59-49
          PL     X1,PVD1     IF NOT ACS UNIT
          SA0    B3          SET UDT ADDRESS
          BX1    X7*X3
          BX1    X1+X2       DRIVE IDENTIFICATION
          BX1    X1-X6
          NZ     X1,PVD1     IF NOT INDICATED UNIT
          SA1    ACCU
          MX6    -3
          BX6    -X6*X3
          NZ     X6,PVDX     IF MOUNT OR DISMOUNT OR CONTROL PATH ERROR
          LX1    B2
          PL     X1,PVDX     IF UNIT NOT ACCESSIBLE
 
*         DISMOUNT UNIT.
 
 PVD2     RJ     DAU         DISMOUNT UNIT
          EQ     PVDX        RETURN
 PVE      SPACE  4,15
**        PVE - PROCESS VSN ERROR ON ACS UNIT MOUNT.
*
*         ENTRY  (A0) = UDT ADDRESS.
*                (B2) = UDT ORDINAL.
*                (X1) = VSN LEFT JUSTIFIED.
*                (B3) = *COMSATF* ERROR CODE.
*
*         EXIT   ENTRY MADE IN VSN ERROR TABLE.
*                VSN EVENT ISSUED IF UNIT UNASSIGNED WITH NO ACTIVITY.
*                (B3) = *COMSATF* ERROR CODE.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 2, 3, 6, 7.
*
*         CALLS  MQE.
 
 
 PVE      SUBR               ENTRY/EXIT
          SB4    B3-/ATF/MXVE
          PL     B4,PVEX     IF NOT VSN ERROR
          SA2    VET-1
          MX0    36
          BX1    X0*X1       VSN WITH ERROR
 PVE1     SA2    A2+1        GET NEXT ENTRY
          NZ     X2,PVE1     IF NOT END OF ENTRIES
          SX3    A2-VET-VETL
          ZR     X3,PVEX     IF TABLE FULL
          SX7    B0+
          SX6    B3-/ATF/MXFE  ERROR CODE
          SX3    B0+
          PL     X6,PVE2     IF TRANSIENT VSN ERROR
          SX6    B3-/ATF/URL
          SX3    /RSX/UOL
          ZR     X6,PVE2     IF UNREADABLE OPTICAL LABEL
          SX3    /RSX/NAC    SET NOT IN ACS
 PVE2     BX6    X1+X3
          SA6    A2          SET VSN AND ERROR
          SA7    A2+1        TERMINATE ENTRIES
          SA2    A0+UVRI
          SA3    A0+UREQ
          NZ     X2,PVEX     IF UNIT ASSIGNED OR SELECTED FOR UNIT SWAP
          NZ     X3,PVEX     IF PROCESSOR ACTIVE
          SX5    A6-VET      SET ORDINAL OF ERROR TABLE ENTRY
          SX7    PVME        ISSUE EVENT TO ROLL IN *RESEX*
          RJ     MQE         MAKE QUEUE ENTRY
          EQ     PVEX        RETURN
 RFL      SPACE  4,20
**        RFL - REDUCE FIELD LENGTH AND REPACK QUEUES.
*
*         THE REDUCTION OF FIELD LENGTH IS PERFORMED BEFORE
*         THE TABLES ARE COMPRESSED (WHICH MEANS THAT IT TAKES
*         32 SECONDS BEFORE THE SPACE IS RELEASED).  THIS IS DONE
*         SINCE VARIOUS TAPE ALTERNATE STORAGE RELATED PROGRAMS
*         MAY BE READING THE STAGE REQUEST TABLE (*TSRP*),  AND
*         REDUCING THE MEMORY FROM UNDER THEM COULD CAUSE THEM TO
*         ABORT.  WHILE THIS STILL MAY HAPPEN IF THEY DO NOT GET
*         THE CPU FOR 32 SECONDS, IT IS UNLIKELY.
*
*         (TSRP) IS SET TO ZERO DURING THE TABLE PACK.  BY
*         DOING THIS, *COMCSRI* WILL WAIT UNTIL THE PACK IS
*         COMPLETE.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4, 5, 6.
*
*         MACROS MEMORY.
 
 
 RFL      SUBR               ENTRY/EXIT
          SA1    TSRP
          SA2    TSRL
          SA3    FLST
          IX1    X1+X2       LWA+1 OF TABLE
          AX3    30          GET CURRENT FIELD LENGTH
          SX4    X1+2*PFTBL+77B+6 ADD GAP
          AX4    6
          LX4    6
          IX6    X3-X4
          ZR     X6,RFL1     IF NO MEMORY CHANGE
          MEMORY CM,A3,R,X4  REDUCE MEMORY
 
*         REPACK *UQUE* TABLE.
 
 RFL1     TA1    0,UQUE      REPACK QUEUE
          BX6    X1
          SA6    A1
 RFL2     SA1    A1+B1       SEARCH TABLE
          BX6    X1
          ZR     X1,RFL3     IF NO ENTRY
          SA6    A6+B1       STORE ENTRY
          EQ     RFL2        CONTINUE REPACKING QUEUE
 
 RFL3     PL     X1,RFL2     IF NOT END OF TABLE
          SA6    A6+B1       INSURE TABLE TERMINATION
          SA6    A6+B1
 
*         REPACK *PFM* REQUEST TABLE.
 
          SB4    A6+6+PFTBL  SET DESIRED INTERTABLE GAP
          SA2    TSRP
          SA3    A2-B1
          SB2    X2          FWA OF *PFM* REQUEST TABLE
          SB3    X3          LENGTH OF TABLE
          SB5    PFTBL
          SB6    -B5
          BX6    X6-X6
          SA6    A2          FLAG TABLE-PACK-IN-PROGRESS TO STAGES
          GE     B4,B2,RFL5  IF CANNOT MOVE FRONT OF TABLE DOWN
 RFL4     SB2    B2-B5       MOVE TABLE FWA BACKWARDS
          SB3    B3+B5       INCREMENT LENGTH
          SA6    B2+         SET ENTRY IDLE
          LT     B4,B2,RFL4  IF MORE SPACE TO MOVE TABLE
 RFL5     ZR     B3,RFL8     IF NO LENGTH TO TABLE
          SB3    B3-B5
          SA1    B3+B2       GET ENTRY
          ZR     X1,RFL5     IF LAST ENTRY IS IDLE
 RFL6     LE     B3,B6,RFL7  IF MOVED BEYOND FILL POINTER
          SB6    B6+B5       ADVANCE FILL POINTER
          SA1    B2+B6
          NZ     X1,RFL6     IF THIS ENTRY IS IN USE
          SA4    B2+B3       MOVE WORDS 0 AND 1
          SA2    A4+B1
          SA7    A1
          BX6    X4
          LX7    X2
          SA1    A2+B1       MOVE WORDS 2 AND 3
          SA2    A1+B1
          SA6    B2+B6
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA1    A2+B1       MOVE WORDS 4 AND 5
          SA2    A1+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA1    A2+B1       MOVE WORDS 6 AND 7
          SA2    A1+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA6    A7+B1
          SA7    A6+B1
          ERRNZ  PFTBL-8     CODE ASSUMES 8 WORD ENTRY
          EQ     RFL5        CHECK NEXT ENTRY
 
 RFL7     SB3    B3+PFTBL    RESTORE TABLE LENGTH
 RFL8     SX7    B3          UPDATE LENGTH AND FWA
          SX6    B2
          SA1    TSRM
          SA7    TSRL        UPDATE LENGTH
          SX7    X1+B1       INCREMENT MODIFICATION COUNTER
          SA7    A1
          SA6    A7-B1       UPDATE FWA
          EQ     RFLX        RETURN
 SBS      SPACE  4,30
**        SBS - SET BLOCK SIZE FOR S/L FORMAT TAPES.
*
*         BLOCK SIZE IS CALCULATED AS FOLLOWS-
*         1)     MLRS FIELD IS USED IF NON - ZERO.
*         2)     1000B IS USED IF S FORMAT AND MLRS = 0.
*         3)     IF BUFFER SIZE IS .LT. MLRS, BUFFER SIZE IS USED
*                UNLESS READ SKIP.
*         4)     IF L FORMAT AND MLRS = 0, BLOCK SIZE IS
*                COMPUTED AS FOLLOWS.
*                A) LIMIT-FIRST-1  IF NOT CONTROL WORD OPERATION
*                B) LIMIT-FIRST-2  IF 260/264 OPERATION
*                C) LIMIT-FIRST-3  IF 200/204 OPERATION
*                D) 377777B        IF *READSKP*
*
*         ENTRY  (B7) = 0, IF S FORMAT.
*                (X0) = 1000B.
*                (X2) = (UDT UCIB WORD).
*                (X3) = (UDT UCIA WORD).
*                (X4) = EXTERNAL *CIO* FUNCTION CODE/4.
*                (X5) = *MLRS* FIELD VALUE.
*                (A0) = UDT ADDRESS.
*                (A2) = UDT ADDRESS + UCIB.
*
*         USES   X - 1, 2, 4, 5, 6.
*                A - 1, 6.
 
 
 SBS4     IX4    X6-X5
          PL     X4,SBS5     IF *MLRS* .LT. BUFFER SIZE
          ZR     X1,SBS5     IF *READSKP*
          SX5    X6+         SET *MLRS* TO BUFFER SIZE
 SBS5     SX6    X5-1001B
          SA1    A0+UST4
          MX2    36
          SX4    B0+
          BX1    X2*X1
          NG     X6,SBS6     IF NO OVERFLOW COUNT
          SX6    LBWD        CALCULATE OVERFLOW
          SX2    X6
          SX4    X5
          IX6    X5/X6
          IX2    X6*X2       CALCULATE REMAINDER
          IX5    X4-X2
          SX4    X6
 SBS6     PL     X5,SBS7     IF WORD COUNT POSITIVE
          SX5    B0+         SET WORD COUNT ZERO
 SBS7     LX5    12
          BX4    X5+X4
          IX6    X1+X4
          SA6    A1
 
 SBS      SUBR               ENTRY/EXIT
          SA1    A0+UCIC
          SX6    X1          CALCULATE DEFAULT BLOCK SIZE
          AX1    24
          SX1    X1+B1
          IX6    X6-X1
          SX1    X4-20B/4
          PL     X6,SBS1     IF FET PARAMETERS PRESENT
          SX6    377777B     SET MAXIMUM DEFAULT BLOCK SIZE
 SBS1     BX4    X3
          LX4    0-52
          NZ     B7,SBS2     IF NOT S FORMAT
          IX2    X6-X0
          NG     X2,SBS2     IF BUFFER SIZE .LT. 1000B WORDS
          BX6    X0          SET FOR MAXIMUM OF 1000B WORDS
 SBS2     NZ     X5,SBS4     IF MLRS FIELD SPECIFIED
          BX5    X0
          MX2    -2
          ZR     B7,SBS4     IF S FORMAT
          BX4    -X2*X4      CONTROL WORD FLAGS
          IX6    X6-X4
          NZ     X1,SBS3     IF NOT *READSKP*
          SX6    377777B     SET MAXIMUM BLOCK SIZE
 SBS3     SX5    X6
          EQ     SBS5        BUILD *UST4*
 SPR      SPACE  4,10
**        SPR - SET PREVIEW DISPLAY REQUEST.
*
*         ENTRY  (X3) = 0 IF NO ERROR MESSAGE.
*                (X3) = *COMSRSX* MESSAGE CODE IF ERROR MESSAGE TO BE
*                       DISPLAYED.
*
*         EXIT   UDT SET WITH PREVIEW DISPLAY REQUEST.
*
*         USES   X - 1, 2, 3, 6.
*                A - 1, 2, 6.
 
 
 SPR      SUBR               ENTRY/EXIT
          SA1    A0+UISN
          SA2    A0+UVRI
          MX6    42
          LX3    12
          BX1    X6*X1
          BX6    X1+X3       SET ERROR CODE
          LX2    59-0
          SA6    A1
          NG     X2,SPRX     IF MESSAGE ALREADY SET
          MX6    1
          SA6    OPRF        SET NEW REQUEST FLAG
          BX6    X2+X6       SET MESSAGE FLAG
          LX6    0-0-59+0
          SA6    A2
          EQ     SPRX        RETURN
 SUA      SPACE  4,15
**        SUA - SET UDT ADDRESS.
*
*         ENTRY  (X5) = UDT ORDINAL (BITS 0 - 11).
*
*         EXIT   (X6) .GE. 0 IF INCORRECT UDT ADDRESS.
*                (A0) = UDT ADDRESS IF NO ERROR.
*                (B2) = UDT ORDINAL IF NO ERROR.
*
*         USES   X - 6, 7.
*                A - 0.
*                B - 2.
 
 
 SUA      SUBR               ENTRY/EXIT
          MX7    -12
          SX6    UNITL
          BX7    -X7*X5      UDT ORDINAL
          IX6    X6*X7       UDT OFFSET
          SB2    X7          SET UDT ORDINAL
          TA0    X6,UBUF     SET UDT ADDRESS
          TX6    A0,-UBUF,LWA
          EQ     SUAX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCCPM
*CALL     COMCMVE
*CALL     COMCSYS
*CALL     COMCWOD
          TITLE  *PFM*/TAPE ALTERNATE STORAGE ROUTINES.
**        *PFM*/TAPE ALTERNATE STORAGE ROUTINES.
*
*         THESE ROUTINES WILL BE OVERWRITTEN BY UDT-S IF
*         TAPE ALTERNATE STORAGE PROCESSING IS NOT SELECTED.
 
          USE    /STAGE/
 NETAB    BSS    0           UDT START IF NO TAPE ALTERNATE STORAGE
          QUAL   STAGE
          SPACE  4,10
*         LOCAL STORAGE.
 
 MVSN     DATA   0           MORE VSN-S WAITING FOR PROCESSING
 ROLF     DATA   0           ROLLIN EVENT TO BE ISSUED
 SJIF     DATA   0           VSN FOR STAGE JOB TO BE INITIATED
          SPACE  4,10
*         HANDLE RELOCATABLE INSTRUCTIONS.
 
 TINST    RMT
 TINSTL.  EQU    *-TINST     START OF TAPE ALTERNATE ONLY ENTRIES
 TINST    RMT
 CRJ      SPACE  4,60
**        CRJ - CHECK FOR REQUEST FROM STAGING JOB.
*
*         PROCESS THE FOLLOWING REQUESTS FROM *RESEX*/*PFRES*.
*
*         *SEV* (3) - SET STAGING VSN LIST.
*
*T RCAL   12/ FC,12/ MVSN,18/ STARTING OFFSET,18/ 1
*
*         MVSN               NONZERO, IF MORE VSN-S TO BE REQUESTED.
*         STARTING OFFSET    INDEX INTO TABLE TO ADD THESE VSN-S.
*                            A STARTING OFFSET OF ZERO CLEARS THE
*                            TABLE BEFORE COPYING THE VSN-S.
*
*         THE REMAINING WORDS HAVE THE FOLLOWING FORMAT-
*
*T        20/ ,1/B,3/RTY,12/ TF,24/ PACKED VSN
*
*         B                  SELECT BACKUP VSN.
*         RTY                RETRY COUNT.
*         TF                 *FCTF* FLAGS FROM PFC.
*         PACKED VSN         PACKED VSN OF STAGING TAPE (12/VP,12/VS)
*                            VP = TWO-CHARACTER DISPLAY CODE VSN PREFIX
*                            VS = NUMERIC VSN SUFFIX (0000 TO 4095).
*
*
*         *RER* (4) - REMOVE ENTRY FROM STAGE REQUEST TABLE.
*
*T RCAL   12/ FC,30/ UNIQUE ID,18/ 1
*
*         UNIQUE ID          UNIQUE IDENTIFIER OF ENTRY TO DELETE.
*
*
*         *TJE* (5) - TERMINATE ENTRY IN ACTIVE STAGE JOB TABLE.
*
*T RCAL   12/ FC,24/ JSN,6/ ,18/ 1
*
*         JSN                JSN OF JOB ENTRY TO DELETE FROM TABLE.
*
*
*         *QSR* (6) - REQUEUE STAGE REQUEST.
*
*T RCAL   12/ FC,20/ ,1/B,3/RTY,6/ ,18/ 8
*T,       6/ 1,3/ AL,19/ ,2/ P,6/ DN,12/ TRACK,12/ SECTOR
*T,       12/ TF,6/,18/ FSN,24/ PACKED VSN
*T,       42/ PFN,18/ UI
*T,       24/ JSN,15/ ,21/ EVENT
*T,       42/ FAMILY,18/
*T,       1/I,23/ LENGTH,36/ CREATION DATE-TIME
*
*
*         B                  SELECT BACKUP VSN.
*         RTY                RETRY COUNT.
*         AL                 ACCESS LEVEL OF THE FILE.
*         P                  *PFC* ENTRY ORDINAL.
*         DN                 DEVICE NUMBER.
*         TRACK              TRACK FOR THE *PFC* ENTRY.
*         SECTOR             SECTOR FOR THE *PFC* ENTRY.
*         TF                 *FCTF* FLAGS FROM PFC.
*         FSN                FILE SEQUENCE NUMBER ON ARCHIVE TAPE.
*         PACKED VSN         PACKED VSN OF STAGING TAPE (12/VP,12/VS)
*                            VP = TWO-CHARACTER DISPLAY CODE VSN PREFIX
*                            VS = NUMERIC VSN SUFFIX (0000 TO 4095).
*         PFN                PERMANENT FILE NAME.
*         UI                 USER INDEX.
*         JSN                JSN OF THE JOB REQUESTING THE FILE.
*         EVENT              EVENT THE JOB WILL ROLL OUT ON.
*         FAMILY             THE FAMILY/PACK CONTAINING THE PFC ENTRY.
*         I                  SET IF INDIRECT ACCESS FILE.
*         LENGTH             LENGTH OF THE FILE IN SECTORS.
*         CREATION DATE-TIME PACKED DATE AND TIME OF FILE CREATION.
*
*
*         *AIB* (7) - ALTER STAGE JOB INITIALIZATION BIT.
*
*T RCAL   12/ FC,24/ JSN,5/ ,1/I,18/ 1
*
*         JSN                JSN OF JOB ENTRY TO CHANGE.
*         I                  NEW VALUE FOR INITIALIZATION BIT.
*
*         ENTRY  (A5) = RCAL.
*                (X5) = FIRST WORD OF REQUEST.
*
*         EXIT   (X5) = 0, IF REQUEST PROCESSED.
*                (RCAL) CLEARED, IF REQUEST PROCESSED.
*                (X5) PRESERVED IF NOT TAPE ALTERNATE STORAGE REQUEST.
*                (A5) PRESERVED IF NOT TAPE ALTERNATE STORAGE REQUEST.
*
*         USES   X - 0, 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 4, 5, 6.
*
*         CALLS  FJE, QPR.
 
 
 CRJ      BSS    0           ENTRY
          BX7    X5
          AX7    48          POSITION FUNCTION CODE
          SX0    X7-SEV
 
*         *SEV* (3) - SET STAGING VSN LIST.
 
          NZ     X0,CRJ4     IF NOT *SEV* REQUEST
          SA1    TVSP        POINTER TO VSN TABLE
          AX5    18
          SB5    X5          GET STARTING OFFSET
          MX7    -1
          SB2    X1          FWA OF VSN TABLE
          AX5    18          POSITION FLAGS
          AX1    48
          BX7    -X7*X5      EXTRACT *MORE* FLAG
          SB3    X1          LENGTH OF VSN TABLE
          SX6    B0+
          SA7    MVSN        SET *MORE* VSN FLAG
          GE     B5,B3,CPRX  IF BEYOND END OF TABLE
          SB6    B5+RCALL-1  OFFSET OF LAST NEW ENTRY
          NZ     B5,CRJ2     IF NOT FIRST BLOCK
          SB4    B0          STARTING OFFSET TO CLEAR
 CRJ1     SA6    B2+B4
          SB4    B4+B1
          LT     B4,B3,CRJ1  IF MORE TO CLEAR
 CRJ2     SA1    A5+B1       GET FIRST ENTRY
          LE     B6,B3,CRJ3  IF NOT GOING BEYOND MAXIMUM
          SB6    B3
 CRJ3     BX6    X1
          SA1    A1+B1
          SA6    B2+B5
          SB5    B5+B1
          ZR     X6,CPRX     IF ZERO WORD TRANSFERRED
          LT     B5,B6,CRJ3  IF MORE TO TRANSFER
          EQ     CPRX        COMPLETE REQUEST
 
*         *RER* (4) - REMOVE ENTRY FROM STAGE REQUEST TABLE.
 
 CRJ4     SX0    X7-RER
          NZ     X0,CRJ6     IF NOT *RER* REQUEST
          SA3    TSRL
          SA2    A3+B1
          AX5    18          POSITION UNIQUE ID
          SB2    X2+6        OFFSET TO FIRST ENTRY
          MX7    -30
 CRJ5     ZR     X3,CPRX     IF NOT FOUND (IGNORE REQUEST)
          SX3    X3-PFTBL
          SA1    X3+B2
          BX1    X1-X5
          BX6    -X7*X1
          NZ     X6,CRJ5     IF NOT THIS ENTRY
          SA6    A1          CLEAR UNIQUE ID WORD
          SA6    A1-6        CLEAR FIRST WORD (FREE ENTRY)
          EQ     CPRX        COMPLETE REQUEST
 
*         *TJE* (5) - TERMINATE ENTRY IN ACTIVE STAGE JOB TABLE.
 
 CRJ6     SX0    X7-TJE
          NZ     X0,CRJ8     IF NOT *TJE* REQUEST
          LX5    12          POSITION JSN
          RJ     FJE         FIND JOB ENTRY
          NZ     X7,CRJ7     IF JOB NOT FOUND
          SA7    A1+         CLEAR JOB TABLE ENTRY
 CRJ7     SA1    MVSN
          ZR     X1,CPRX     IF NO PENDING REQUEST
          SA1    SJIF        CHECK IF STAGING JOB INITIATION IS PENDING
          NZ     X1,CPRX     IF INITIATION FLAG ALREADY SET
          MX6    59          FORCE INITIATION OF STAGING JOB
          SA6    A1
          EQ     CPRX        COMPLETE REQUEST
 
*         *QSR* (6) - REQUEUE STAGE REQUEST.
 
 CRJ8     SX0    X7-QSR
          NZ     X0,CRJ9     IF NOT *QSR* REQUEST
          SA5    A5+B1       INCREMENT TO FWA OF *TDAM* BLOCK
          RJ     QPR         QUEUE *PFM* REQUEST
          EQ     CPRX        COMPLETE REQUEST
 
*         *AIB* (7) - ALTER STAGE JOB INITIALIZATION BIT.
 
 CRJ9     LX5    12          POSITION JSN
          RJ     FJE         FIND JOB ENTRY IN ACTIVE JOB TABLE
          NZ     X7,CPRX     IF JOB ENTRY NOT FOUND
          LX5    24-18-12
          MX6    59
          LX6    24-0
          BX1    X6*X1       CLEAR CURRENT SETTING
          BX6    -X6*X5      ISOLATE DESIRED SETTING
          BX7    X6+X1
          SA7    A1          UPDATE ACTIVE JOB TABLE ENTRY
          ZR     X6,CRJ7     IF CLEARING BIT
          EQ     CPRX        COMPLETE REQUEST
 FJE      SPACE  4,15
**        FJE - FIND JOB ENTRY IN ACTIVE STAGING JOB TABLE.
*
*         ENTRY  (X5) = 24/JSN ,36/
*
*         EXIT   (A1) = ADDRESS OF JOB ENTRY.
*                (X1) = JOB ENTRY.
*                (X7) = 0, IF JOB ENTRY FOUND.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1.
*                B - 5, 6.
 
 
 FJE      SUBR               ENTRY/EXIT
          TB6    -1,TAJP,LWA
          TB5    0,TAJP
          MX6    24
 FJE1     SA1    B6+
          BX2    X1-X5
          BX7    X6*X2
          ZR     X7,FJEX     IF JSN MATCHES
          SB6    B6-B1
          GE     B6,B5,FJE1  IF MORE ENTRIES TO EXAMINE
          EQ     FJEX        RETURN (ENTRY NOT FOUND)
 IRE      SPACE  4,20
**        IRE - ISSUE ROLLIN EVENT AND/OR INITIATE STAGE JOB.
*
*         CHECK FLAGS ONLY WHEN TWO SECOND INTERVAL HAS ELAPSED.
*
*         ENTRY  (ROLF) .NE. 0 IF ROLLIN EVENT TO BE ISSUED.
*                (SJIF) .NE. 0 IF STAGING JOB TO BE INITIATED.
*                (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*
*         EXIT   (ROLF) = 0 IF ROLLIN EVENT ISSUED.
*                (SJIF) = 0 IF STAGING JOB INITIATED.
*                (X5) = *ITIM* SET FOR 2 SECOND INTERVAL TEST.
*
*         USES   X - 1, 2, 4, 6.
*                A - 1, 2, 4, 6.
*
*         CALLS  ISJ.
*
*         MACROS EESET.
 
 
 IRE      SUBR               ENTRY/EXIT
 
*         ISSUE EVENT TO ROLL IN EXISTING STAGE JOB.
 
          SA2    ROLF        CHECK *ROLLIN REQUESTED* FLAG
          ZR     X2,IRE1     IF ROLLIN NOT REQUESTED
          SX6    B0+         CLEAR FLAG
          SA6    A2
          EESET  /EVENT/VSNE+7777B  ISSUE ROLLIN EVENT
 
*         INITIATE NEW STAGE JOB.
 
 IRE1     SA4    SJIF
          ZR     X4,IREX     IF STAGE JOB INITIATION NOT REQUESTED
          RJ     ISJ         INITIATE NEW STAGE JOB
          EQ     IREX        RETURN
 ISJ      SPACE  4,20
**        ISJ - INITIATE STAGING JOB.
*
*         INITIATE A STAGE JOB UNLESS ANY OF THE FOLLOWING ARE TRUE.
*           A STAGE JOB ALREADY HAS THIS VSN ASSIGNED.
*           A STAGE JOB IS CURRENTLY IN INITIALIZATION.
*           ALL POSSIBLE STAGE JOBS ARE ALREADY ACTIVE.
*
*         ENTRY  (X4) = 34/0,1/ MEDIUM,1/0,24/ PACKED VSN
*                (X4) .LT. 0, IF SPECIAL STAGING JOB TO BE INITIATED,
*                             OR IF JOB TO BE INITIATED FOR ANY VSN.
*
*         EXIT   (SJIF) = 0, IF STAGE JOB INITIATED OR NOT NEEDED.
*                (SJIF) = VSN, IF INITIATION SHOULD BE RETRIED LATER.
*                (ROLF) .NE. 0, IF ANOTHER JOB IS IN INITIALIZATION.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 6.
*                B - 3, 4, 5, 6, 7.
*
*         MACROS ROUTE, WRITER.
 
 
 ISJ8     SX6    B1+         SET ROLLIN FLAG
          SA6    ROLF
 
 ISJ      SUBR               ENTRY/EXIT
          BX6    X4          SAVE VSN IN CASE UNABLE TO START JOB
          SA6    SJIF
          SB3    B0          SET TO TAPE FOR SPECIAL STAGING JOB
          NG     X4,ISJ0     IF SPECIAL STAGING JOB
          MX3    -1
          LX6    59-25+1     POSITION MEDIUM FLAG
          BX6    -X3*X6
          SB3    X6+         0 = TAPE, 1 = OPTICAL DISK
 ISJ0     TB5    0,TAJP      FWA OF ACTIVE STAGE JOB TABLE
          TB7    -1,TAJP,LWA LAST ENTRY IN TABLE
          SB6    B5+
          SA3    ISJH
          SB4    B0+         SET AVAILABLE ENTRY NOT FOUND
          BX4    X3*X4       ISOLATE VSN/MEDIUM FLAG
 
*         LOOK FOR AVAILABLE STAGING JOB.
 
 ISJ1     SA1    B6+         LOAD JOB TABLE ENTRY
          NZ     X1,ISJ2     IF ENTRY IN USE
          NZ     B4,ISJ2     IF AVAILABLE ENTRY ALREADY FOUND
          SB4    B6+         SAVE ADDRESS OF AVAILABLE ENTRY
 ISJ2     BX6    X3*X1       ISOLATE VSN/MEDIUM FLAG
          BX7    X6-X4
          ZR     X7,ISJ7     IF MATCHING VSN FOUND
          LX1    59-24
          PL     X1,ISJ3     IF JOB NOT IN INITIALIZATION
          NE     B3,ISJ3     IF OPTICAL DISK STAGING
          SB4    -B6         INDICATE JOB IN INITIALIZATION FOUND
 ISJ3     SB6    B6+1
          LE     B6,B7,ISJ1  IF MORE ENTRIES TO EXAMINE
          NG     B4,ISJ8     IF JOB IN INITIALIZATION FOUND
          NZ     B4,ISJ4     IF AVAILABLE ENTRY FOUND
          EQ     ISJX        RETURN
 
*         INITIATE NEW STAGING JOB.
 
 ISJ4     SA1    ISJE        *STAGE,S*
          EQ     B4,B5,ISJ5  IF SPECIAL STAGING JOB
          SA1    A1+B1       *STAGE*
          EQ     B3,ISJ5     IF NORMAL STAGING JOB FROM TAPE
          SA1    A1+B1       *STAGE,O*
 ISJ5     BX6    X1
          SA6    ISJC        SET TYPE OF STAGING JOB
          REWIND ISJA,R
          SX6    ISJB+ISJBL  FILL BUFFER BY SETTING *IN*
          SA6    X2+2
          WRITER X2,R        FLUSH BUFFER
          SA1    X2          SET FILE NAME INTO *DSP* BLOCK
          SA2    ISJD
          MX7    42
          BX1    X7*X1
          SX7    7776B       CLEAR OLD ERROR CODE AND COMPLETE BIT
          BX2    X7*X2
          BX6    X1+X2
          SA6    A2
          ROUTE  ISJD,R      ROUTE JOB TO INPUT QUEUE
 
*         SET JSN IN ACTIVE STAGING JOB TABLE ENTRY.
 
 ISJ6     SA1    ISJD        GET ACTUAL JSN FROM *DSP* BLOCK
          MX6    24
          BX6    X6*X1
          NE     B3,ISJ6.1   IF OPTICAL DISK STAGING
          SX7    B1          SET *INITIALIZATION IN PROGRESS* FLAG
          LX7    24-0
          BX6    X6+X7
 ISJ6.1   EQ     B4,B5,ISJ6.2  IF SPECIAL STAGING JOB
          EQ     B3,ISJ6.2   IF TAPE STAGING
          SA1    SJIF
          BX6    X1+X6       SET ASSIGNED VSN IN JOB TABLE
 ISJ6.2   SA6    B4
          NE     B4,B5,ISJ7  IF NOT SPECIAL STAGING JOB
          MX2    -24
          BX6    -X2+X6      SET VSN IN FORCE = 77777777B
          SA6    B4
          SA1    SJIF        CHECK IF NORMAL STAGE REQUEST PENDING
          PL     X1,ISJX     IF NORMAL REQUEST PENDING, RETRY LATER
 ISJ7     BX6    X6-X6       CLEAR *SJIF*
          SA6    SJIF
          EQ     ISJX        RETURN
 
 
 ISJA     BSS    0
 ZZZJOB   FILEC  ISJB,ISJBL+1
 
 ISJB     DATA   C*STAGING.*
          DATA   C*NORERUN.*
          DATA   C*GET,STAGE/NA.*
 ISJC     DATA   C*STAGE,X.*
 ISJBL    EQU    *-ISJB
 
 ISJD     BSS    0           *DSP* BLOCK
          VFD    42/0LZZZJOB,6/0,1/1,4/0,6/SYOT,1/0
          VFD    24/0,12/2RNO,3/0,1/1,2/0,18/1S17+1S12+1S4
          VFD    60/0
          VFD    60/0
          VFD    12/0,12/2RCT,36/0
          VFD    60/0
          VFD    60/0
 
 ISJE     DATA   C*STAGE,S.* SPECIAL STAGING JOB
 ISJF     DATA   C*STAGE.*   NORMAL  STAGING JOB (TAPE)
 ISJG     DATA   C*STAGE,O.* NORMAL  STAGING JOB (OPTICAL DISK)
 ISJH     CON    00000000000277777777B
 ISM      SPACE  4,15
**        ISM - ISSUE STATISTICAL MESSAGE.
*
*         ENTRY  (A5) = FWA OF *PFM* STAGE REQUEST.
*
*         USES   X -  0, 1, 6.
*                A -  1.
*                B -  2, 3, 5.
*
*         CALLS  CDD, COD, SNM.
*
*         MACROS MESSAGE.
 
 
 ISM      SUBR               ENTRY/EXIT
          SB5    -ISMA       SET UP FOR TAPE REQUEST
          SB3    ISMB
          SA1    A5          CHECK TYPE OF REQUEST
          AX1    54
          SX1    X1-2
          NZ     X1,ISM1     IF NOT OPTICAL DISK REQUEST
          SA1    A5+1        GET ARCHIVE FILE VERSION NUMBER
          MX0    -12
          AX1    24
          BX1    -X0*X1
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          SB2    B2-B1
          MX1    1           GENERATE CHARACTER MASK
          AX1    B2
          BX1    X1*X4       REMOVE SPACES
          SB5    -ISMC
          SB3    ISMB
          SB2    1R+
          RJ     SNM         SET VERSION NUMBER INTO MESSAGE
          SB5    ISMB
 ISM1     SA1    A5+2        GET PERMANENT FILE NAME
          MX0    42
          BX1    X0*X1
          SB2    1R#
          RJ     SNM         SET PERMANENT FILE NAME INTO MESSAGE
          SA1    A5+2        GET USER INDEX
          BX1    -X0*X1
          RJ     COD         CONVERT TO OCTAL DISPLAY
          SB2    B2-B1
          MX1    1           GENERATE CHARACTER MASK
          AX1    B2
          BX1    X1*X4       REMOVE SPACES
          SB5    ISMB
          SB2    1R$
          RJ     SNM         SET USER INDEX INTO MESSAGE
          SA1    A5+4        GET FAMILY/PACK NAME
          BX1    X0*X1
          SB2    1R&
          RJ     SNM         SET FAMILY/PACK NAME INTO MESSAGE
          SA1    A5+B1       GET VSN SUFFIX
          MX0    -12
          BX1    -X0*X1
          SX1    X1+10000D   FORCE LEADING ZEROES
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -24
          BX6    -X0*X6
          LX6    24
          SA1    A5+B1       GET VSN PREFIX
          MX0    12
          LX1    36
          BX1    X0*X1
          BX1    X1+X6       COMBINE VSN PREFIX AND SUFFIX
          SB2    1R-
          RJ     SNM         SET VSN INTO MESSAGE
          SA1    A5+7        GET RETRY COUNT
          AX1    36
          RJ     CDD         CONVERT TO DECIMAL DISPLAY
          MX0    -6          MASK TO ONE DIGIT
          BX1    -X0*X6
          LX1    -6          LEFT JUSTIFY
          SB2    1R=
          RJ     SNM         SET RETRY COUNT INTO MESSAGE
          MESSAGE  ISMB,5    ISSUE STATISTICAL MESSAGE TO ACCOUNT FILE
          EQ     ISMX        RETURN
 
 
 ISMA     DATA   C*STBS, #######, $$$$$$, &&&&&&&, ------, =.*
*         DATA   C*STBS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
 ISMAL    EQU    *-ISMA      LENGTH OF MESSAGE
 ISMB     BSS    ISMAL       MESSAGE ASSEMBLY BUFFER
 ISMC     DATA   C*SOBS, #######, $$$$$$, &&&&&&&, ------, ++++, =.*
*         DATA   C*SOBS, FILENAM, USERIN, FAMPACK, VSNVSN, VERS, R.*
 QPR      SPACE  4,20
**        QPR - QUEUE *PFM* REQUEST.
*
*         ENTRY  (A5) = FWA OF REQUEST BLOCK (IF FROM *PFM*).
*                (A5) = FWA+1 OF REQUEST BLOCK (IF FROM A CPU PROGRAM).
*                (X5) = FIRST WORD OF REQUEST.
*                IN BOTH ENTRIES, (A5) POINTS TO THE FIRST WORD OF THE
*                *PFM* *TDAM* ENTRY. IF THE REQUEST COMES FROM A CPU
*                PROGRAM, THE LAST WORD IS REFORMATTED AND MOVED TO THE
*                FRONT OF THE *SIC* BLOCK. THIS IS TO ACCOMODATE *SIC*.
*
*         EXIT   REQUEST CLEARED (IF (A5) = PFTB).
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3, 4.
*
*         CALLS  ISJ, ISM.
*
*         MACROS PDATE.
 
 
 QPR      SUBR               ENTRY/EXIT
          ZR     X5,QPRX     IF NO REQUEST
          PDATE  A5+7        ADD CURRENT DATE AND TIME TO REQUEST
          SX2    A5-PFTB     CHECK IF *PFM* REQUEST
          ZR     X2,QPR1     IF *PFM* CALL
 
*         PROCESS RE-REQUEST.
 
          SA1    A5-B1       RETRIEVE RETRY INFORMATION
          SA2    A5+7        MERGE WITH PACKED DATE AND TIME
          MX6    24
          LX1    12
          BX6    X6*X1
          BX6    X6+X2
          SA6    A2          UPDATE RETRY INFORMATION
 
*         MERGE UNIQUE ID INTO REQUEST.
 
 QPR1     SA2    QPRA        ADVANCE UNIQUE ID COUNTER
          MX0    -30
          SX7    X2+2        INCREMENT VALUE
          BX6    -X0*X7      ASSURE NO OVERFLOW
          SA7    A2
          SA6    A5+6        SET UNIQUE ID INTO BLOCK
          RJ     ISM         ISSUE STATISTICAL MESSAGE
 
*         MOVE REQUEST INTO *PFRT* TABLE.
 
          SA3    TSRL        GET CURRENT LENGTH
          SA2    A3+B1       GET FWA OF TABLE
          IX4    X3+X2
          SB2    X2          SET FWA
          SB3    X3          SET LENGTH
          SB4    -PFTBL      SET CURRENT OFFSET
 QPR2     SB4    B4+PFTBL
          GE     B4,B3,QPR3  IF END OF TABLE
          SA1    B2+B4
          NZ     X1,QPR2     IF NOT FREE SLOT
          SX4    A1          SET ADDRESS OF SLOT
 QPR3     SA1    A5          TRANSFER REQUEST ENTRY
          SA2    A1+B1       MOVE WORDS 0 AND 1
          BX6    X1
          LX7    X2
          SA1    A2+B1       MOVE WORDS 2 AND 3
          SA2    A1+B1
          SA6    X4
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA1    A2+B1       MOVE WORDS 4 AND 5
          SA2    A1+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA1    A2+B1       MOVE WORDS 6 AND 7
          SA2    A1+B1
          SA6    A7+B1
          SA7    A6+B1
          BX6    X1
          LX7    X2
          SA6    A7+B1
          SA7    A6+B1
          LT     B4,B3,QPR4  IF NOT EXTENDING TABLE
 
*         CHECK IF ADDITIONAL MEMORY NEEDED.
 
          SA2    FLST        CHECK AVAILABLE MEMORY
          SX6    B3+PFTBL
          SX7    X6+B2       LWA+1 OF TABLE
          AX2    30
          SA6    TSRL        UPDATE LENGTH
          SX6    X7+PFTBL*2+77  ALLOW FOR TWO MORE REQUESTS / ROUND UP
          AX6    6
          LX6    6
          IX2    X2-X6
          PL     X2,QPR4     IF NO NEED TO GET MORE MEMORY
          SA6    ROLF        SET ROLLIN EVENT FLAG
          MEMORY CM,A2,R,X7+MEMI
 
*         INITIATE STAGING JOB TO PROCESS REQUEST.
 
 QPR4     SA4    A5+B1       SET VSN
          SA1    A5
          MX3    -24
          AX1    54
          SX1    X1-1        0 = TAPE, 1 = OPTICAL DISK
          LX1    25
          BX4    -X3*X4      ISOLATE VSN
          BX4    X1+X4       SET MEDIUM FLAG
          RJ     ISJ         INITIATE STAGING JOB
          SX6    A5-PFTB
          NZ     X6,QPRX     IF NOT *PFM* CALL
          SA6    PFTB        CLEAR REQUEST
          EQ     QPRX        RETURN
 
 
 QPRA     CON    1           UNIQUE ID = 2*(REQUESTS RECEIVED) + 1
          SPACE  4,10
*         COMMON DECKS FOR TAPE ALTERNATE STORAGE PROCESSING.
 
 
*CALL     COMCCDD
*CALL     COMCCOD
*CALL     COMCCIO
*CALL     COMCSNM
 BUFFERS  SPACE  4,10
          TITLE  BUFFER AREA.
**        BUFFER ASSIGNMENTS.
 
 
          USE    BUFFERS
 TDTAB    SPACE  4,10
          QUAL   PRESET
 TDTAB    BSS    0
 PRS      SPACE  4,10
**        PRS - PRESET PROGRAM.
 
 
 PRS      SB1    1
          R=     A4,ARGR
          SA2    ACTR
          SB4    X2
          ZR     B4,PRS5     IF NO ARGUMENTS
          SB5    PRSO
          RJ     ARG         PROCESS ARGUMENTS
          ZR     X1,PRS2     IF NO ERRORS
 PRS1     MESSAGE  PRSP,,R  * ERROR IN ARGUMENTS.*
          ABORT
 
 PRS2     SX6    SJDF        SET DEFAULT NUMBER OF STAGING JOBS
          SA5    PRSK        GET SPECIFIED NUMBER OF STAGING JOBS
          ZR     X5,PRS3     IF NOT SPECIFIED
          SB7    B1+
          RJ     DXB         CONVERT TO BINARY (DECIMAL ASSUMED)
          NZ     X4,PRS1     IF ERROR IN CONVERSION
          SX4    X6-SJMX     MAXIMUM NUMBER OF STAGING JOBS
          PL     X4,PRS1     IF OVER MAXIMUM
 PRS3     SA6    A5          SET NUMBER OF STAGING JOBS
          SA5    A5+B1       GET NUMBER OF STAGING VSN-S TO DISPLAY
          SX6    SVDF        SET DEFAULT OF VSN-S
          ZR     X5,PRS4     IF NOT SPECIFIED
          SB7    B1+
          RJ     DXB         CONVERT TO BINARY (DECIMAL ASSUMED)
          NZ     X4,PRS1     IF ERROR IN CONVERSION
          SX4    X6-SVMX
          PL     X4,PRS1     IF OVER MAXIMUM
 PRS4     SA6    A5+         SET NUMBER OF STAGING VSN-S TO DISPLAY
 PRS5     SA1    JOPR        CHECK JOB ORIGIN
          MX6    -12
          LX1    -24
          SB2    B1+B1
          BX1    -X6*X1
          SX6    X1-SYOT
          SB3    TPRO
          ZR     X6,PRS6     IF SYSTEM ORIGIN
          MESSAGE  PRSE,0,R  * INCORRECT COMMAND.*
          ABORT
 
 PRS6     SA6    B2          CLEAR INTERFACE AREA
          SB2    B2+B1
          LT     B2,B3,PRS6  IF MORE WORDS TO CLEAR
 
*         CALL *1MT* TO PROCESS *MAGNET* INITIALIZATION.
 
 PRS7     SA1    PRSB        GET *1MT* CALL
          SA2    PRSA        MAKE *SPC* RA+1 CALL
          BX7    X1
          LX6    X2
          SA7    PRSC
          RJ     SYS=
          SA1    PRSC        CHECK REQUEST COMPLETE
          NZ     X1,PRS7     IF *SPC* REJECT
 PRS8     RECALL             WAIT FOR *1MT* TO FINISH PRESET
          SA1    PRSD
          NG     X1,PRS8     IF *1MT* NOT DONE
 
*         PURGE STAGE REQUEST FILE.
 
          SA1    PRSK        GET NUMBER OF STAGING JOBS
          SB4    NETAB       SET DEFAULT FWA OF UDT-S
          ZR     X1,PRS10    IF TAPE ALTERNATE STORAGE NOT ACTIVE
          MACHID PRSQ        SET MACHINE ID IN STAGE REQUEST FILE NAME
          SA1    PRSQ
          SA2    STRQ
          LX1    24
          BX6    X1+X2
          SA6    A2+
 PRS8.1   PURGE  STRQ
          SA1    X2+         CHECK ERROR CODE
          SX1    X1
          AX1    10
          ZR     X1,PRS8.3   IF NO ERROR
          SX6    X1-/ERRMSG/INA
          ZR     X6,PRS8.2   IF *INTERLOCK NOT AVAILABLE*
          SX6    X1-/ERRMSG/PFA
          NZ     X6,PRS8.3   IF NOT *PF UTILITY ACTIVE*, IGNORE ERROR
 PRS8.2   MESSAGE  PRSS,2    * PURGING STAGE REQUEST FILE.*
          RECALL             GIVE UP CPU
          EQ     PRS8.1      RETRY *PURGE*
 
*         ALLOCATE TABLES FOR TAPE ALTERNATE STORAGE PROCESSING.
 
 PRS8.3   MESSAGE  (=C**),2  CLEAR DAYFILE MESSAGE, IF PRESENT
          SA1    PRSK        NUMBER OF STAGING JOBS
          SX6    TDTAB       ALLOCATE ACTIVE STAGING JOB TABLE
          SX1    X1+B1       TABLE LENGTH (ALLOW FOR SPECIAL JOB)
          IX2    X1+X6       LWA+1 OF ACTIVE STAGING JOB TABLE
          LX1    48
          BX7    X6+X1       12/LENGTH, 24/, 24/FWA
          SX6    X2+B1       SET FWA OF VSN DISPLAY BUFFER
          LX2    24
          BX7    X7+X2       12/LENGTH, 24/LWA+1, 24/FWA
          SA7    TAJP        SET POINTER TO ACTIVE JOB TABLE
          SA1    PRSL        GET NUMBER OF VSN-S TO DISPLAY
          SB4    X1          MINIMUM NUMBER OF VSNS TO DISPLAY+1
          GT     B4,B1,PRS9  IF AT LEAST 1 VSN TO DISPLAY
          SX1    B1          SET MINIMUM LENGTH
 PRS9     IX4    X1+X6       LWA+1 OF VSN DISPLAY BUFFER
          LX1    48
          SB4    X4+B1       SET FWA OF UDT-S
          LX4    24
          BX1    X1+X6       12/LENGTH, 24/, 24/FWA
          BX6    X1+X4       12/LENGTH, 24/LWA+1, 24/FWA
          SA6    TVSP        SET POINTER TO STAGING VSN LIST
          EQ     PRS12       CHECK FOR *TMS* PROCESSING.
 
 PRS10    SX6    B1+         SET *PFM* *TDAM* BUFFER BUSY
          SA6    PFTB
 
*         CALL *CLC* TO CLEAR MEMORY.
 
 PRS12    SB6    LWA-CLC     NUMBER OF WORDS OF CODE TO MOVE
          SA1    CLCBUF+LWA-CLC  LAST WORD OF CODE
          BX6    X1
          SA6    LWA         LAST WORD TO MOVE CODE TO
 PRS13    SA1    A1-B1
          BX6    X1
          SA6    A6-B1
          SB6    B6-B1
          NZ     B6,PRS13    IF MORE CODE TO MOVE
+         RJ     CLC         CLEAR UDT-S (RJ TO VOID INSTRUCTION STACK)
 
 
 PRSA     VFD    18/3LSPC,1/0,1/1,10/0,12/,18/PRSC
 PRSB     VFD    18/3L1MT,6/0,12/1,24/PRSD
 PRSC     CON    0           *SPC* REQUEST WORD
 PRSD     VFD    1/1,47/0,12/1  *1MT* STATUS WORD
 
 PRSE     DATA   C* INCORRECT COMMAND.*
 
 SJDF     DECMIC SJDF        DEFAULT NUMBER OF STAGING JOBS
 SVDF     DECMIC SVDF        DEFAULT NUMBER OF STAGING VSN-S TO DISPLAY
 
 PRSK     CON    0           NUMBER OF STAGING JOBS ACTIVE CONCURRENTLY
 PRSL     CON    0           NUMBER OF STAGING TAPE VSN-S TO DISPLAY
 PRSM     DATA   C*'SJDF'*   DEFAULT NUMBER OF CONCURRENT STAGE JOBS
 PRSN     DATA   C*'SVDF'*   DEFAULT NUMBER OF VSNS TO DISPLAY
 
 PRSO     BSS    0           ARGUMENT TABLE
 SJ       ARG    PRSM,PRSK   NUMBER OF CONCURRENT STAGE JOBS
 SV       ARG    PRSN,PRSL   NUMBER OF STAGING TAPE VSN-S TO DISPLAY
          DATA   0           END OF TABLE
 
 PRSP     DATA   C* ERROR IN ARGUMENTS.*
 PRSQ     CON    0           MACHINE ID
 PRSR     BSSZ   6           ERROR MESSAGE BUFFER
 PRSS     DATA   C* PURGING STAGE REQUEST FILE.*
 
 STRQ     FILEB  0,0,(FET=16D),EPR,UPR  STAGE REQUEST FILE
          ORG    STRQ+CFPW
          VFD    42/0,18/PRSR  ERROR MESSAGE BUFFER
          ORG    STRQ+16D
          SPACE  4,10
*         PRESET COMMON DECKS - CAN BE OVERLAID.
 
 
*CALL     COMCARG
*CALL     COMCDXB
*CALL     COMCPFM
          TITLE  PRESET SUBROUTINES.
 CLCBUF   BSS    0
 PCLC     MAX    CLCBUF,TDTAB+SJMX+1+SVMX+1+MUNIT*UNITL+10
          LOC    PCLC
 CLC      SPACE  4,15
**        CLC - CLEAR MEMORY.
*
*         ENTRY  (B4) = STARTING ADDRESS OF UDT-S.
*
*         EXIT   TO *MAG*.
*
*         USES   X - 1, 2, 4, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 5, 6, 7.
*
*         CALLS  ISJ, PEQ, REL.
*
*         MACROS EESET, RTIME, SETICC, TIME.
 
 
 CLC      SUBR               ENTRY
          SB6    B4          FWA TO CLEAR
          SB7    *           LWA+1 TO CLEAR
          BX7    X7-X7
 CLC1     SA7    B6
          SB6    B6+B1
          LT     B6,B7,CLC1  IF STILL MORE MEMORY TO CLEAR
          RJ     PEQ         PROCESS EQUIPMENT ENTRIES
          RJ     REL         RELOCATE TABLE ACCESS INSTRUCTIONS
          SA1    UQUE        GET STARTING ADDRESS
          SX6    X1+100B     GET START OF REQUEST BUFFER
          SA6    TSRP
          SX7    X6+77B
          BX6    X6-X6
          SA6    A6+B1       SET NO LENGTH
          SA1    TAJP        CLEAR TAPE ALTERNATE STORAGE JOB TABLE
          SA2    TVSP        CLEAR TAPE ALTERNATE STORAGE VSN LIST
          ZR     X1,CLC3     IF NOT TAPE ALTERNATE STORAGE PROCESSING
          SB5    X1
          AX2    24          MOVE LWA+1 DOWN
          SB6    X2+
          SX6    B0+
          SA6    B6+
 CLC2     SB6    B6-B1
          SA6    B6
          GT     B6,B5,CLC2  IF MORE TO CLEAR
 CLC3     SETICC CLCA        SET INTER-CP COMMUNICATION POINTERS
          SA1    CLCB        SET SUBSYSTEM ACCESSIBILITY FLAG
          BX6    X1
          RJ     SYS=
          TIME   CTIM        SET STARTING CPU TIME
          RTIME  STAR        SET REAL TIME AT START UP
          SA1    TAJP
          ZR     X1,CLC4     IF NOT TAPE ALTERNATE STORAGE PROCESSING
          MX4    1           SET DUMMY VSN
          MX2    -24
          BX4    -X2+X4
          RJ     /STAGE/ISJ  INITIATE SPECIAL STAGING JOB
 CLC4     EESET  /EVENT/MTXE ISSUE MAGNET AVAILABLE EVENT
          SX6    1
          SA6    APRQ        FORCE *1MU* CALL TO GET UNIT ACCESSIBILITY
          EQ     MAG         PROCESS MAIN PROGRAM
 
 
 CLCA     VFD    1/1,11/0,6/RCALL-1,18/RCAL,6/0,18/0
 
 CLCB     VFD    18/3LSFM,6/20,12/SSTF,6/0,18/CLCB
 REL      SPACE  4,10
**        REL - RELOCATE INSTRUCTIONS.
*
*         EXIT   *T* INSTRUCTIONS RELOCATED.
*
*         USES   X - 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 6.
*                B - 5, 6, 7.
 
 
 REL      SUBR               ENTRY/EXIT
          SB7    TINSTL-1
          SA1    TAJP        SEE IF TAPE ALTERNATE STORAGE ACTIVE
          NZ     X1,REL0     IF TAPE ALTERNATE STORAGE INACTIVE
          SB7    TINSTL.-1   DO NOT RELOCATE /STAGE/ CODE
 REL0     MX7    -18
          NG     B7,RELX     IF NO INSTRUCTIONS TO RELOCATE
 REL1     SA1    TINST+B7    SET NEXT RELOCATION WORD
          SB7    B7-B1
          UX4,B6 X1          SET POSITION IN WORD
          SA2    X1          GET WORD
          AX1    18
          SX1    X1
          SX3    X1
          PL     X1,REL2     IF POSITIVE VALUE WANTED
          BX1    -X1
 REL2     SA1    X1
          PL     X3,REL3     IF COMPLEMENT OF ADDRESS WANTED
          BX1    -X1
 REL3     LX4    59-47
          PL     X4,REL4     IF FWA WANTED
          AX1    24          GET FWA
 REL4     BX1    -X7*X1
          SB5    B6-60
          AX2    X2,B5       POSITION ADDRESS
          BX3    -X7*X2      GET ADDRESS
          BX2    X7*X2       MASK OUT ADDRESS
          SX3    X3
          IX3    X3+X1       GENERATE NEW ADDRESS
          BX3    -X7*X3
          BX2    X2+X3       MERGE ADDRESS
          LX6    X2,B6       REPOSITION INSTRUCTION
          SA6    A2
          PL     B7,REL1     IF STILL MORE INSTRUCTIONS TO MODIFY
          EQ     RELX        RETURN
 
 TINST    BSS    0
 TINST    HERE
 TINSTL   EQU    *-TINST
 PEQ      SPACE  4,10
**        PEQ - PROCESS EQUIPMENT ENTRIES.
*
*         ENTRY  (B4) = STARTING ADDRESS OF UDT-S.
*
*         EXIT   CONTROL TABLES INITIALIZED.
*
*         USES   X - 1, 3, 6, 7.
*                A - 1, 6, 7.
*
*         CALLS  AUD.
 
 
 PEQ      SUBR               ENTRY/EXIT
          SX6    B0          ******** TEMPORARY ********
          SA6    UACI        ******** TEMPORARY ********
          RJ     AUD         ASSIGN UDT ENTRIES
          SX7    B5+B1       QUEUE TABLE FWA
          SA7    UQUE        SET QUEUE TABLE POINTER
          SX6    B0          TERMINATE QUEUE TABLE
          SA6    X7
          MX6    60
          SA6    A6+B1
          SA6    A6+B1
          SA1    CST+CPST
          MX6    48
          SX3    B4          UDT FWA
 PEQ1     BX1    X6*X1       CLEAR ENTRY PRESENT STATUS
          BX7    X1+X3       SET UDT FWA IN PROCESSOR STATUS
          SA7    A1+
          SA1    A1+CSTE
          NZ     X1,PEQ1     IF NOT END OF CST ENTRIES
          SX6    A0          SET STARTING FL
          LX6    30
          SA6    FLST
          EQ     PEQX        RETURN
 AUD      SPACE  4,15
**        AUD - ASSIGN UDT ENTRIES.
*
*         ENTRY  (B4) = FWA OF UDT.
*
*         EXIT   UDT ENTRIES ASSIGNED AND INITIALIZED.
*                (B4) = FWA OF UDT.
*                (B5) = LWA+1 OF UDT.
*
*         USES   X - 5, 6, 7.
*                A - 5, 6, 7.
*                B - 5.
 
 
 AUD      SUBR               ENTRY/EXIT
 
*         INITIALIZE FOR UINT SCAN.
 
          SA5    UINT-1      INITIALIZE UINT POINTER
          SB5    B4+         SET ADDRESS OF FIRST UNIT
 
*         INITIALIZE UDT ENTRY.
 
 AUD1     SA5    A5+B1       GET NEXT UINT ENTRY
          ZR     X5,AUD2     IF ALL UNITS PROCESSED
          MX6    36
          BX6    X6*X5       HARDWARE PARAMETERS
          SA6    B5+UST1     SET DEFINITON OF EQUIPMENT
          MX6    -3
          BX6    -X6*X5      DEVICE TYPE
          LX6    54
          SA6    B5+UST4     SET DEVICE TYPE
          MX6    -12
          LX6    12
          BX6    -X6*X5      ACS UNIT CONTROL PATH PARAMETERS
          MX7    60
          SA6    B5+UMST     SET PATH PARAMETERS IF ACS UNIT
          SA7    B5+UFRQ     INHIBIT FILE REQUESTS
          SB5    B5+UNITL    ADVANCE UDT ADDRESS
          EQ     AUD1        PROCESS NEXT UNIT
 
*         SET UDT POINTER WORDS.
 
 AUD2     MX7    1           TERMINATE UDT
          SA7    B5
          SX6    B5
          SX7    B4          SET FWA OF UDT
          LX6    24
          BX6    X6+X7       SET LWA+1 OF UDT
          SA6    UBUF        SET UDT POINTERS
          SA7    NXAU        INITIALIZE ACS UNIT ASSIGNMENT POINTER
          EQ     AUDX        RETURN
 
 
 LWA      BSS    0           LAST WORD OF CODE TO MOVE
          LOC    *O
 
 
          ERRMI  UIBF-*      OVERFLOW INTO FIRMWARE BUFFER
          SPACE  4,10
**        INITIAL FL FOR MAGNET.
 
 
          QUAL
 MAGNET   EQU    /PRESET/PRS
 RFL=     EQU    RQFL*100B-1  MAGNET INITIAL FL
          TTL    MAGNET/MAGNET1 - TERMINATION PROCESSOR.
          TITLE
          QUAL   MAGNET1
          IDENT  MAGNET1,TER,MAGNET1,0,0
          ENTRY  MAGNET1
          ENTRY  MFL=
          ENTRY  SSJ=
*COMMENT  MAGNET - TAPE EXECUTIVE TERMINATION.
          BASE   DECIMAL
          SPACE  4,10
***       MAGNET TERMINATION PROCESSOR.
*         R. E. TATE.        73/02/02.
*         MODIFIED BY D. D. SADLER  74/05/29.
          SPACE  4,10
***       MAGNET1 PERFORMS THE FOLLOWING FUNCTIONS.
*
*         1)     IDLE DOWN.
*         2)     RESTART OF MAGNET FOR LEVEL-3 RECOVERY.
*         3)     CLEAN-UP OF RESOURCE DEMAND FILE ON MAGNET DROP
*                OR ABORT WITH TAPES ASSIGNED.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         * INCORRECT COMMAND.* - *MAGNET1* WAS CALLED FROM
*         NON-SYSTEM ORIGIN JOB.
*
*         * MAGNET DROPPED DURING RECOVERY.* - MAGNET1 WAS DROPPED
*         WHEN ATTEMPTING MAGNET CLEAN-UP OR RECOVERY.
*
*         * MAGNET TERMINATION/NO TAPE JOBS.* - MAGNET WAS DROPPED
*         OR ABORTED WITH NO TAPE ASSIGNMENTS.
*
*         * 000000.000 PERCENT CPU UTILIZATION.* - SUMMARY MESSAGE
*         INDICATING MAGNET CPU UTILIZATION.
*
*         * RECOVERY COMPLETE.* - LEVEL-3 RECOVERY AND MAGNET RESTART
*         WAS SUCCESSFUL.
*
*         * RECOVERY IMPOSSIBLE.* - MAGNET HAS BEEN DROPPED OR
*         ABORTED OR LEVEL-3 RECOVERY WAS UNSUCCESSFUL.
*
*         * RECOVERY IN PROGRESS.* - MAGNET1 IS PROCESSING IDLE
*         DOWN AND CLEAN-UP/RESTART.
*
*         * SCANNING RESOURCE DEMAND FILE.* - MAGNET1 IS ATTEMPTING
*         CLEAN-UP OF RESOURCE DEMAND FILE.
*
*         * NN TAPE FILES RECOVERED.* - INDICATES NUMBER OF TAPE
*         ASSIGNMENTS RECOVERED BY LEVEL-3 DEADSTART.
*
*         * TAPES ASSIGNED AT MAGNET TERMINATION.* - MAGNET WAS
*         DROPPED OR ABORTED WITH TAPES ASSIGNED.  MAGNET1 PERFORMED
*         RESOURCE DEMAND FILE CLEAN-UP SO ONLY THOSE JOBS WITH
*         THESE TAPES ASSIGNED WILL BE AFFECTED.
*
*         * WAIT DEMAND FILE ATTACH.* - MAGNET1 IS WAITING FOR THE
*         RESOURCE DEMAND FILE TO BECOME AVAILABLE.
*
*         * WAIT 1MT COMPLETE.* - MAGNET1 IS WAITING FOR ALL 1MT,S
*         TO IDLE DOWN.
*
*         * 1MT PROBABLY LOST.* - MAGNET1 WAS DROPPED WHILE WAITING
*         FOR 1MT,S TO IDLE DOWN.
          SPACE  4,10
**        COMMON DECKS
 
 
*CALL     COMSSSJ
          TITLE
          ORG    RQFL*100B-1000B
 
*         CODE OVERLAID BY RESOURCE DEMAND FILE BUFFER.
 
 DBUF     EQU    *           DEMAND FILE CIO BUFFER
 DBUFL    EQU    /RSX/RDEL+2  DEMAND FILE CIO BUFFER LENGTH
          SPACE  4,10
**        TER - TERMINATION PROCESSOR.
 
 
 TER      SB1    1
          SA1    JOPR        GET JOB ORIGIN
          MX6    -12
          LX1    -24
          BX1    -X6*X1
          SX1    X1-SYOT
          NZ     X1,TER6     IF NOT SYSTEM ORIGIN
          EREXIT ERX         SET ERROR EXIT ADDRESS
          RJ     CPU         CALCULATE CPU UTILIZATION
          GETJCR TERA        READ JOB CONTROL WORD REGISTER
          SA1    TERA        CLEAR ERROR FLAG
          MX2    -54
          BX6    -X2*X1
          SA6    A1+B1
          BX5    X2*X1       SAVE ERROR FLAG
          SETJCR A6
          MESSAGE (=C* RECOVERY IN PROGRESS.*)
 
*         CHECK POINTERS.
 
          SA1    UBUF
          SB4    X1
          AX1    24
          SB5    X1
          SB6    A0-10
          LE     B4,B1,ABT   IF FWA OF UDT,S BAD
          GE     B4,B5,ABT   IF FWA OF UDT,S .GE. LWA OF UDT,S
          GE     B5,B6,ABT   IF LWA OF UDT,S BAD
          SA2    NTAS
          NG     X2,TER1     IF IDLEDOWN
          ZR     X5,REC      IF LEVEL 3 RECOVERY
 TER1     MESSAGE  CPUC,,R   *000000.000 PERCENT CPU UTILIZATION.*
          SX6    B0+         CLEAR ERROR EXIT MESSAGE
          SA1    NTAS
          SA6    ERXA
          PL     X1,ABT1     IF NOT IDLEDOWN
 
*         CHECK IF TAPES ASSIGNED.
 
 TER5     SA1    B4
          SA2    B4+UVRI
          AX1    48
          SB4    B4+UNITL
          NG     X1,ABT      IF PREMATURE END OF UDT
          NZ     X2,ABT1     IF JOB ASSIGNED
          LT     B4,B5,TER5  IF NOT END OF UDT
          SB2    ENDA        * MAGNET TERMINATE/NO TAPE JOBS.*
          EQ     END         ISSUE MESSAGE AND END
 
 TER6     MESSAGE  (=C* INCORRECT COMMAND.*),0,R
          ABORT
 
 
 TERA     BSS    2           JOB CONTROL REGISTER TEMPORARIES
 CPU      SPACE  4,10
**        CPU - CPU UTILIZATION.
*
*         CALLS  CFD.
*
*         MACROS RTIME, TIME.
 
 
 CPU      SUBR               ENTRY/EXIT
          TIME   CPUA
          RTIME  CPUB
          SA1    CTIM
          MX6    -12
          BX2    -X6*X1
          AX1    12
          SX5    1000
          IX4    X1*X5
          IX4    X4+X2       TOTAL CPU TIME PREVIOUSLY (MS)
          SA1    CPUA
          BX2    -X6*X1
          AX1    12
          IX3    X1*X5
          IX3    X3+X2       TOTAL CPU TIME CURRENTLY (MS)
          IX4    X3-X4       ELASPED CPU TIME (MS)
          SA1    CPUB
          SA2    STAR
          MX3    -36
          BX1    -X3*X1
          BX2    -X3*X2
          IX1    X1-X2       ELAPSED TIME
          SX5    100*1000
          IX4    X4*X5
          IX1    X4/X1
          RJ     CFD         CONVERT NUMBER
          SA6    CPUC
          EQ     CPUX        RETURN
 
 
 CPUA     CON    0
 CPUB     CON    0
 CPUC     DATA   C*000000.000 PERCENT CPU UTILIZATION.*
          SPACE  4,10
**        OVERLAID COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCFD
 REC      SPACE  4,10
**        REC - LEVEL 3 RECOVERY.
 
 
 REC      BSS    0           ENTRY
 
*         VERIFY TABLE POINTERS.
 
          SA1    UQUE        CHECK QUEUE POINTERS
          SA2    FLST
          BX6    X6-X6       CLEAR ERROR EXIT MESSAGE
          SB2    X1
          SA6    ERXA
          LX2    30
          SB3    X2
          LE     B2,B1,ABT   IF FWA OF QUEUE BAD
          GE     B3,B6,ABT   IF FIELD LENGTH STATUS WORD BAD
          GE     B2,B3,ABT   IF FWA OF QUEUE OUTSIDE OF FL
          GE     B5,B2,ABT   IF LWA OF UDT,S .GE. FWA OF QUEUE
          SX2    X2-TER
          PL     X2,ABT      IF RECOVERY CODE OVERLAID QUEUE
          SX6    B6          SET CURRENT FL
          LX6    30
          SA6    A2
 
*         RESET PP CALL WORDS.
 
          SA1    CST-CSTE
          SB2    MCHAN
 REC1     SA1    A1+CSTE
          SB2    B2-B1
          MX0    -59
          BX7    -X0*X1      CLEAR *1MT* ACTIVE
          SA7    A1
          NZ     B2,REC1     IF MORE  CHANNELS TO PROCESS
          SA1    APS
          BX7    -X0*X1      CLEAR *1MU* ACTIVE
          SA7    A1
 
*         CLEAR EXTERNAL REQUESTS AND CLEAR INTERVAL TIMER.
 
          SX6    B0+
          SA6    RCAL
          SA6    ITIM
          SA6    INTC
 
*         SET ERROR IN DRIVER REQUESTS IN PROGRESS.
*         CLEAR FILE REQUEST IF JOB AT CONTROL POINT DURING RECOVERY.
 
          SA1    UBUF
          SA1    X1-UNITL    INITIALIZE UDT ADDRESS
 REC2     SA1    A1+UNITL+UXRQ  GET REQUEST
          ERRNZ  UXRQ
          NG     X1,REC3     IF ALL UNITS CHECKED
          MX0    -12
          LX1    12
          BX2    -X0*X1
          SX2    X2-RIP
          NZ     X2,REC2.1   IF NOT REQUEST IN PROGRESS
          SX2    ERR&RIP
          BX6    X1-X2       SET ERROR STATUS
          LX6    48
          SA6    A1
          SA2    A1+UST3-UXRQ
          BX2    X0*X2
          SX6    EFT         SET ERROR FLAG TERMINATION CODE
          BX6    X2+X6
          SA6    A2
 REC2.1   SA2    A1+UFRQ-UXRQ
          SA3    A1+UST1-UXRQ
          ZR     X2,REC2     IF NO FILE REQUEST
          LX3    59-48
          SX6    B0
          NG     X3,REC2     IF JOB ROLLED OUT
          SA6    A2+         CLEAR FILE REQUEST
          EQ     REC2        CHECK NEXT UNIT
 
*         PROCESS TAPE ALTERNATE STORAGE.
 
 REC3     RJ     RES         RESET TAPE ALTERNATE STORAGE
 
*         RESTART MAGNET.
 
 REC4     SA1    RECC        GET *1MT* CALL
          SA2    RECB
          BX7    X1
          BX6    X2
          SA7    RECD
          RJ     SYS=        MAKE *SPC* CALL
          SA1    RECD
          NZ     X1,REC4     IF *SPC* REJECT
 REC10    RECALL
          SA1    RECA
          NG     X1,REC10    IF *1MT* NOT DONE
          EREXIT             CLEAR ERROR EXIT
          SETICC RECF        SET INTER-CP COMMUNICATION POINTERS
          SA1    RECG        GET *SFM* CALL
          BX6    X1
          RJ     SYS=        SET MAGNET AVAILABLE
          TIME   CTIM
          RTIME  STAR
          EESET  /EVENT/MTXE ISSUE MAGNET AVAILABLE EVENT
          MESSAGE RECE       * MAGNET RECOVERY COMPLETE.*
          EQ     MAG         ENTER MAGNET
 
 
 RECA     VFD    1/1,47/0,12/3  *1MT* STATUS WORD
 RECB     VFD    18/3LSPC,1/0,1/1,10/0,12/,18/RECD
 RECC     VFD    18/3L1MT,6/0,12/1,24/RECA
 RECD     CON    0           *SPC* REQUEST WORD
 RECE     DATA   C* MAGNET RECOVERY COMPLETE.*
 RECF     VFD    1/1,11/0,6/RCALL-1,18/RCAL,6/0,18/0
 RECG     VFD    18/3LSFM,6/20,12/SSTF,6/0,18/RECG
 RES      SPACE  4,15
**        RES - RESET TAPE ALTERNATE STORAGE.
*
*         EXIT   ACTIVE JOB TABLE CLEARED.
*                STAGE REQUEST TABLE CLEARED.
*                PENDING *PFM* REQUEST CLEARED.
*
*         USES   X - 1, 4, 6.
*                A - 1, 6.
*                B - 6, 7.
*
*         CALLS  ISJ.
 
 
 RES      SUBR               ENTRY/EXIT
          SA1    TAJP
          ZR     X1,RESX     IF TAPE ALTERNATE STORAGE NOT ACTIVE
          SB6    X1
          AX1    24
          SX6    B0+
          SB7    X1-1
 RES1     SA6    B7          CLEAR JOB TABLE
          SB7    B7-B1
          GE     B7,B6,RES1  IF MORE TO CLEAR
          SA6    TSRL        ZERO LENGTH OF PENDING REQUESTS
          SA6    PFTB+6      CLEAR UNIQUE ID WORD OF ENTRY
          SA6    PFTB        CLEAR PENDING *PFM* REQUEST
          SA1    TSRM        UPDATE MODIFICATION COUNT
          SX6    B1
          IX6    X6+X1
          SA6    A1
          MX4    1           SET DUMMY VSN
          MX1    -24
          BX4    -X1+X4
          RJ     /STAGE/ISJ  RESTART SPECIAL STAGING JOB
          EQ     RESX        RETURN
          SPACE  4,10
**        THE FOLLOWING CODE CANNOT BE OVERLAID BY THE RESOURCE DEMAND
*         FILE BUFFER.
 
          ERRNG  *-DBUF-DBUFL  CHECK FOR BUFFER OVERFLOW
 SDF      SPACE  4,20
**        SDF - SCAN DEMAND FILE.
*
*         EXIT   *TAPE ASSIGNMENT LOST* FLAG SET IN EACH DEMAND
*                FILE ENTRY THAT HAS NONZERO TAPE ASSIGNED COUNT.
*                (SDFA) .LT. 0, IF DEMAND FILE ATTACH FAILED.
*                       = 0, IF NO TAPES ASSIGNED AT TERMINATION.
*                       .GT. 0, IF TAPES ASSIGNED AT TERMINATION.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 2, 3.
*                X - 0, 1, 2, 3, 6, 7.
*
*         MACROS ATTACH, MACHID, MESSAGE, RECALL, REWRITE,
*                RPHR, SETUI.
 
 
 SDF9     RETURN DF,R
 
 SDF      SUBR               ENTRY/EXIT
          SETUI  377777B     SET USER INDEX
          MACHID SDFC        GET MACHINE ID
          MX0    12
          SA1    DF          SET ID IN DEMAND FILE NAME
          LX0    -24
          SA2    SDFC
          BX1    -X0*X1
          SX7    A2          SET PF ERROR MESSAGE ADDRESS
          LX2    24
          SA7    DF+10
          BX6    X1+X2
          SA6    A1
          BX0    X0-X0       INDICATE FIRST ATTEMPT TO ATTACH
          MESSAGE (=C* SCANNING RESOURCE DEMAND FILE.*),3
 SDF1     ATTACH DF,0,,,W,,,DF,FA  ATTACH RESOURCE DEMAND FILE
          SA1    X2          CHECK ERROR STATUS
          MX2    -8
          LX1    -10
          BX1    -X2*X1
          ZR     X1,SDF3     IF NO ERROR
          SX2    X1-1        CHECK FOR FILE BUSY
          SX3    X1-16B      CHECK FOR PF UTILITY ACTIVE
          IX2    X2*X3
          NZ     X2,SDF8     IF FATAL PF ERROR
          NZ     X0,SDF2     IF WAIT MESSAGE ALREADY ISSUED
          SX0    B1
          MESSAGE (=C* WAIT DEMAND FILE ATTACH.*),3
 SDF2     RECALL             WAIT FOR DEMAND FILE TO BECOME AVAILABLE
          EQ     SDF1        RETRY DEMAND FILE ATTACH
 
 SDF3     MX0    1           CLEAR EP BIT
          SA1    DF+1
          LX0    44-59
          BX6    -X0*X1
          SA6    A1
 
*         READ DEMAND FILE ENTRY.
 
 SDF4     SA1    SDFB        SET RANDOM INDEX IN FET
          SA2    DF+1        SET IN=OUT=FIRST
          SX7    X1+2        INCREMENT RANDOM INDEX
          SA7    DF+6
          SX6    X2
          SA6    A2+B1
          SA7    A1
          SA6    A6+B1
          RPHR   DF,R        READ DEMAND FILE ENTRY
          SA1    DF+2        CHECK FOR DATA TRANSFERRED
          SA2    A1+B1
          IX1    X1-X2
          ZR     X1,SDF9     IF EOR/EOF/EOI ENCOUNTERED
          SA3    DBUF+/RSX/RJID  CHECK JOB IDENTIFICATION
          ZR     X3,SDF4     IF UNUSED ENTRY
          SB2    /RSX/RMTL-1
 SDF5     LT     B2,SDF4     IF NO TAPES ASSIGNED TO THIS JOB
          SA1    DBUF+/RSX/RMTP+B2  GET TAPE ENTRY ASSIGNED COUNT
          MX0    -6
          LX1    18
          SB2    B2-B1
          BX6    -X0*X1
          ZR     X6,SDF5     IF NO TAPE ASSIGNED COUNT
          SA6    SDFA        SET TAPES ASSIGNED FLAG
 
*         SET TAPE ASSIGNMENT LOST FLAG AND REWRITE DEMAND FILE ENTRY.
 
          MX0    1           SET TAPE ASSIGNMENT LOST FLAG
          SA1    DBUF+/RSX/RVAL
          LX0    53-59
          SA2    SDFB        RESET RANDOM INDEX IN FET
          BX6    X1+X0
          LX0    29-59-53+59
          SA6    A1
          BX7    X0+X2       SET RANDOM REWRITE IN PLACE
          SA7    DF+6
          REWRITE DF,R       REWRITE DEMAND FILE ENTRY
          EQ     SDF4        CONTINUE PROCESSING DEMAND FILE
 
 SDF8     MESSAGE  SDFC      ISSUE PF ERROR MESSAGE
          SX6    -1          INDICATE DEMAND FILE ATTACH FAILED
          SA6    SDFA
          EQ     SDFX        RETURN
 
 
 SDFA     CON    0           TAPE ASSIGNED INDICATOR
 SDFB     CON    -1          DEMAND FILE RANDOM INDEX
 SDFC     BSS    3           PF ERROR MESSAGE BUFFER
 ABT      SPACE  4,15
**        ABT - ABORT ROUTINE.
*
*         ENTRY  (B2) = ENDING MESSAGE ADDRESS, 0 IF NO ENDING
*                     MESSAGE, FOR ENTRY AT *ABT2* ONLY.
*
*         EXIT   TO *END*.
*
*         USES   A - 1.
*                B - 2.
*                X - 1.
*
*         CALLS  SDF.
*
*         MACROS MESSAGE, SYSTEM.
 
 
*         ISSUE RECOVERY IMPOSSIBLE MESSAGE.
 
 ABT      MESSAGE (=C* RECOVERY IMPOSSIBLE.*)
 
*         SCAN DEMAND FILE FOR TAPES ASSIGNED.
 
 ABT1     RJ     SDF
          SA1    SDFA
          SB2    B0+
          NG     X1,ABT2     IF DEMAND FILE ATTACH FAILED
          SB2    ENDA        * MAGNET TERMINATION/NO TAPE JOBS.*
          ZR     X1,ABT2     IF NO TAPES ASSIGNED
          SB2    ENDB        * TAPES ASSIGNED AT MAGNET TERMINATION.*
 
*         DUMP MAGNET FIELD LENGTH.
 
 ABT2     SYSTEM DMD,R,10000B,0
*         EQ     END         ISSUE MESSAGE AND END
 END      SPACE  4,10
**        END - ENDING ROUTINE.
*
*         ENTRY  (B2) = ENDING MESSAGE ADDRESS, 0 IF NO MESSAGE.
*
*         MACROS ENDRUN, MESSAGE.
 
 
 END      ZR     B2,END1     IF NO ENDING MESSAGE
          MESSAGE B2
 END1     ENDRUN
 
 
 ENDA     DATA   C* MAGNET TERMINATION/NO TAPE JOBS.*
 ENDB     DATA   C* TAPES ASSIGNED AT MAGNET TERMINATION.*
 ENDC     DATA   C* MAGNET DROPPED DURING RECOVERY.*
 ERX      SPACE  4,15
**        ERX - ERROR EXIT PROCESSOR.
*
*         ENTRY  (ERXA) = FWA ERROR EXIT MESSAGE, 0 IF NO MESSAGE.
*
*         EXIT   TO *ABT2*.
*                (B2) = ENDING MESSAGE ADDRESS, 0 IF NO ENDING MESSAGE.
*
*         USES   A - 1.
*                B - 2.
*                X - 1, 2.
*
*         MACROS GETJCR, MESSAGE.
 
 
 ERX      SA1    ERXA
          ZR     X1,ERX1     IF NO MESSAGE TO ISSUE
          MESSAGE X1
 ERX1     GETJCR ERXC        GET ERROR FLAG
          SA1    ERXC
          AX1    54
          SB2    B0
          SX2    X1-ODET
          NZ     X2,ABT2     IF NOT OPERATOR DROP
          SB2    ENDC        * MAGNET DROPPED DURING RECOVERY.*
          EQ     ABT2        DUMP FIELD LENGTH BEFORE ENDING
 
 
 ERXA     CON    ERXB        ERROR EXIT MESSAGE ADDRESS
 ERXB     DATA   C* 1MT PROBABLY LOST.*
 ERXC     CON    0           ERROR FLAG
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCSYS
*CALL     COMCCPM
*CALL     COMCCIO
*CALL     COMCPFM
          SPACE  4,10
**        FETS.
 
 
 DF       BSS    0           RESOURCE DEMAND FILE
 RSXDXX   RFILEB DBUF,DBUFL,(FET=14),EPR
          SPACE  4,10
          USE    BUFFERS
          QUAL
          SPACE  4,10
**        ENTRY POINTS.
 
 
 MAGNET1  EQU    /MAGNET1/TER
 SSJ=     EQU    /MAGNET1/SSJP SSJ= PRIVILEGES ONLY
 MFL=     EQU    RQFL*100B-1
          ERRMI  UINT-1-*    MAGNET1 TOO LARGE
          TTL    MAGNET - MAGNETIC TAPE EXECUTIVE.
          SPACE  4,10
          END
Retro1.org codex

Table of Contents

MAGNET

Table Of Contents

Source Code
