MAGNET
          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 
