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