IDENT PFAM1,/COMSPFS/OVLA,PFA,01,00
TITLE PFAM - PERMANENT FILE ARCHIVE MANAGEMENT UTILITIES.
ABS
SST
SYSCOM B1
SPACE 4,10
*COMMENT PFAM - PERM FILE ARCHIVE MANAGEMENT UTILITIES.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
SPACE 4,10
*** PFAM - PERMANENT FILE ARCHIVE MANAGEMENT UTILITIES.
*
* G. S. YODER 87/02/20.
* P. C. SMITH 87/04/08.
SPACE 4,10
*** *PFAM* CONTAINS UTILITIES FOR MANAGING ARCHIVE FILES CREATED
* BY *PFDUMP*. THESE UTILITIES MAY BE CALLED THROUGH THE *PFS*
* COMMAND OR DIRECTLY BY UTILITY NAME.
*
* THE FOLLOWING UTILITIES RESIDE IN *PFAM* -
*
* PFATC - CATALOG ARCHIVE FILE.
* PFCOPY - COPY FILES FROM ARCHIVE FILE.
* PFRES - RESTORE FILES FROM TAPE ALTERNATE STORAGE TO DISK
* RESIDENCE.
*** MESSAGE LEGEND.
*
* THE FOLLOWING LEGEND DEFINES PARAMETERS THAT ARE USED IN MANY
* OF THE UTILITY ERROR MESSAGES. THE DESCRIPTIVE CHARACTER
* STRINGS DEFINED HERE ARE REPLACED BY THEIR ACTUAL VALUE WHEN
* A PARTICULAR MESSAGE IS ISSUED.
*
* FFFFFFF = FAMILY NAME.
* MMMMMM = NUMBER OF FILES.
* NNNNNNN = PERMANENT FILE NAME.
* UUUUUU = USER INDEX.
SPACE 4,10
*** OPERATOR MESSAGES.
*
* *CATALOGING NNNNNNN UUUUUU*
* FILE FFFFFFF ON USER INDEX UUUUUU ON THE ARCHIVE FILE
* IS BEING PROCESSED BY *PFATC*.
*
* *COPYING NNNNNNN UUUUUU*
* FILE FFFFFFF ON USER INDEX UUUUUU ON THE ARCHIVE FILE
* IS BEING PROCESSED BY *PFCOPY*.
*
* *RESTORING NNNNNNN UUUUUU*
* *PFRES* IS RESTORING THE DATA FOR PERMENENT FILE
* NNNNNNN CATALOGED ON USER INDEX UUUUUU.
*
* *SKIPPING NNNNNNN UUUUUU*
* FILE NNNNNNN ON USER INDEX UUUUUU ON THE ARCHIVE FILE
* WAS NOT SELECTED FOR PROCESSING BY *PFATC*, *PFCOPY*
* OR *PFRES*.
SPACE 4,10
*** INFORMATIVE DAYFILE MESSAGES.
*
* * FILE NAME CHANGED TO ZZZZZLF.*
* THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
* SPECIFIED OUTPUT FILE. THE LOGICAL FILE NAME WAS
* CHANGED TO PREVENT A CONFLICT.
*
* * FILE NAME CHANGED TO ZZZZZSF.*
* THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
* SPECIFIED SUMMARY FILE. THE LOCAL FILE NAME WAS
* CHANGED TO PREVENT A CONFLICT.
*
* * FILE NAME CHANGED TO ZZZZZTF.*
* THE NAME OF THE FILE BEING COPIED WAS THE SAME AS THE
* SPECIFIED ARCHIVE FILE. THE LOCAL FILE NAME WAS
* CHANGED TO PREVENT A CONFLICT.
*
* * PFATC COMPLETE.*
* *PFATC* TERMINATED WITHOUT FATAL ERRORS.
*
* * PFCOPY COMPLETE.*
* *PFCOPY* TERMINATED WITHOUT FATAL ERRORS.
*
* * PFRES COMPLETE.*
* *PFRES* TERMINATED WITHOUT FATAL ERRORS.
*
* * MMMMMM FILES CATALOGED.*
* MMMMMM FILES WERE CATALOGED BY *PFATC*.
*
* * MMMMMM FILES COPIED.*
* MMMMMM FILES WERE COPIED BY *PFCOPY.*
*
* * MMMMMM FILES RESTORED.*
* MMMMMM FILES WERE RESTORED BY *PFRES.*
SPACE 4
*** NON-FATAL ERROR MESSSAGES.
*
* * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
* INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
* TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE. ALSO
* ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
* MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
* IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
* ENCOUNTERED.
*
* * ARCHIVE FILE BLOCK ERROR, FN=NNNNNNN, UI=UUUUUU,
* FM=FFFFFFF.*
* A PFC, PERMIT, OR DATA BLOCK WAS DETECTED WITH AN
* INCORRECT SUB-TYPE, AN INCORRECT LENGTH FOR THE BLOCK
* TYPE, OR INCORRECT CONTENTS FOR THE BLOCK TYPE. ALSO
* ISSUED WHEN PERMIT OR DATA BLOCKS WERE PRESENT OR
* MISSING WHEN THEY SHOULD NOT BE BASED ON INFORMATION
* IN THE PFC BLOCK OR WHEN A BLOCK OF UNKNOWN TYPE IS
* ENCOUNTERED.
*
* * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU.*
* A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
* PROCESSING THE INDICATED FILE.
*
* * ARCHIVE FILE READ ERROR, FN=NNNNNNN, UI=UUUUUU,
* FM=FFFFFFF.*
* A READ ERROR OCCURRED ON THE ARCHIVE FILE WHILE
* PROCESSING THE INDICATED FILE.
*
* * FILE VERIFICATION ERROR, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.*
* WHEN STAGING THE INDICATED FILE, THE PFC ON THE
* ALTERNATE STORAGE TAPE DID NOT MATCH THE PFC OF THE
* FILE TO BE STAGED.
*
* * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU.*
* NO TEMPORARY FILE DEVICE WAS AVAILABLE THAT WILL ALLOW
* THE SECURITY ACCESS LEVEL OF THE INDICATED FILE TO
* RESIDE THERE.
*
* * NO DEVICE FOR FILE ACCESS LEVEL, FN=NNNNNNN, UI=UUUUUU,
* FM=FFFFFFF.*
* NO DEVICE COULD BE FOUND THAT WILL ALLOW THE SECURITY
* ACCESS LEVEL OF THE INDICATED FILE TO RESIDE THERE.
*
* * NO FILES TO RESTORE.*
* *PFRES* WAS INITIATED, BUT NO STAGE REQUESTS WERE
* PENDING.
*
* * PFM ERROR ENCOUNTERED, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.
* *PFM* WAS NOT ABLE TO RESTORE THE INDICATED FILE TO
* DISK RESIDENCE.
*
* * STAGE ABANDONED, FN=NNNNNNN, UI=UUUUUU, FM=FFFFFFF.*
* THE STAGE REQUEST FOR THE INDICATED FILE WAS ABANDONED
* BECAUSE IT HAD BEEN RETRIED UNSUCCESSFULLY THE MAXIMUM
* NUMBER OF TIMES.
SPACE 4,10
*** FATAL ERROR MESSAGES.
*
* * ARCHIVE FILE LABEL READ ERROR.*
* A READ ERROR OCCURRED WHEN READING THE ARCHIVE FILE
* LABEL.
*
* * INCORRECT CATALOG SIZE.*
* THE ARCHIVE TAPE WHICH WAS ASSIGNED TO *PFRES* AS A
* STAGING TAPE WAS DUMPED WITH 8-WORD PFC-S.
*
* * PREMATURE EOF DETECTED.*
* END OF FILE DETECTED BEFORE END OF DUMP CONTROL WORD.
*
* * STAGING TAPE NOT ASSIGNED.*
* A FILE OTHER THAN A TAPE WAS ASSIGNED TO *PFRES* AS A
* STAGING TAPE.
*
* * STAGING TAPE VSN ERROR. VSN = VVVVVV.*
* THE TAPE ASSIGNED TO *PFRES* AS A STAGING TAPE HAD A
* VSN WHICH WAS NOT LEGAL FOR A STAGING TAPE.
SPACE 4,10
*** ACCOUNT FILE MESSAGES.
*
* *STAS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
* INDICATES THE ABANDONMENT OF A STAGE REQUEST FOR
* FILE *FILENAM*, OF USER INDEX *USERIN*, ON FAMILY/PACK
* *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R* RETRIES.
*
* *STES, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
* INDICATES THE SUCCESSFUL COMPLETION OF A STAGE REQUEST
* FOR FILE *FILENAM*, OF USER INDEX *USERIN*, ON
* FAMILY/PACK *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R*
* RETRIES.
* INDICATES THE SUCCESSFUL COMPLETION OF A STAGE REQUEST
* FOR FILE *FILENAM*, OF USER INDEX *USERIN*, ON
* FAMILY/PACK *FAMPACK*, FROM VSN *VSNVSN*, AFTER *R*
* RETRIES.
*
* *STTA, FAMPACK, VSNVSN, NNNN.*
* INDICATES THAT FOR FAMILY/PACK *FAMPACK* STAGING VSN
* *VSNVSN* HAS BEEN ASSIGNED TO RESTORE *NNNN* FILES.
SPACE 4,10
* COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMSMLS
QUAL MTX
LIST X
*CALL COMSMTX
LIST *
QUAL *
*CALL COMSPFM
LIST X
*CALL COMSPFS
LIST *
*CALL COMSPFU
*CALL COMSPRD
*CALL COMSRPV
*CALL COMSSFM
*CALL COMSSSD
TITLE ASSEMBLY CONSTANTS.
*CALL COMSVER
* ASSEMBLY CONSTANTS.
CWSW EQU 5 CONTROL WORD STATUS WORD
MEMI EQU 1000B CM FL INCREMENT TO REQUEST
SSLN EQU 100B SYSTEM SECTOR LENGTH
* BUFFER LENGTHS.
CATHL EQU NWCE CATALOG ENTRY HOLD BUFFER LENGTH
DBUFL EQU 2001B ARCHIVE DATA BLOCK WORKING BUFFER LENGTH
MBUFL EQU 6001B MAIN BUFFER LENGTH
MSFBL EQU 10001B *COMCMSF* SORT FILES BUFFER LENGTH
OUTBL EQU 10001B OUTPUT FILE BUFFER LENGTH
PFLBL EQU 1001B PROCESSED FILES FILE BUFFER LENGTH
QBUFL EQU 1000B STAGE REQUEST QUEUE BUFFER LENGTH
RBUFL EQU 1001B STAGE REQUEST FILE BUFFER LENGTH
SABFL EQU 1000B SUMMARY FILE ASSEMBLY BUFFER LENGTH
SBUFL EQU 1001B SCRATCH STAGE REQUEST FILE BUFFER LENGTH
SRTBL EQU 20000B SORT BUFFER LENGTH
SUMBL EQU 1001B SUMMARY FILE BUFFER LENGTH
TBUFL EQU 30061B ARCHIVE FILE BUFFER LENGTH
ODEBL EQU 20B OPTICAL DISK EXTENSION BUFFER LENGTH
* *COMSPFS* EQUIVALENCES.
CPAR EQU /COMSPFS/CPL
IDSA EQU /COMSPFS/PADR
TITLE RESERVED LOCATIONS AND FETS.
ORG /COMSPFS/OVLA
SPACE 4,10
* DATA LOCATIONS.
CIPF CON 0 CIR BLOCK PROCESSED FLAG
CAPF CON 0 CATALOG BLOCK PROCESSED FLAG
EFPF CON 0 EOF JUST PROCESSED FLAG
FPRF CON 0 FILE BEING PROCESSED FLAG
NSSR CON 0 NUMBER OF STAGE REQUESTS SELECTED
MSTAT CON 0 MEMORY STATUS
PVSN CON 0 PACKED VSN OF STAGING TAPE
SRFF CON 1 STAGE REQUEST FILE ATTACHED (*PFRES*)
SRQF CON QBUF FWA OF STAGE REQUEST QUEUE
SRQL CON 0 LENGTH OF STAGE REQUEST QUEUE
SRQN CON 0 NUMBER OF ENTRIES OF STAGE REQUEST QUEUE
STRA CON 0 ADDRESS OF STAGE REQUEST BEING PROCESSED
SVSN CON 0 STAGING TAPE VSN
SPACE 4,10
* FETS.
T BSS 0 ARCHIVE FILE
TAPE FILEB TBUF,TBUFL,EPR,FET=13D
ODEB BSSZ ODEBL OPTICAL DISK EXTENSION BUFFER
F BSS 0 LOCAL/MASTER FILE
FILEA FILEB MBUF,MBUFL,FET=16D
.SRB BSS 0
ORG F+CFPW
VFD 42/0,18/EMBF ERROR MESSAGE BUFFER ADDRESS
ORG F+CFSR
VFD 42/0,18/SRB SPECIAL REQUEST BLOCK ADDRESS
ORG .SRB
SRB BSSZ 4 SPECIAL REQUEST BLOCK
EMBF BSSZ 6 ERROR MESSAGE BUFFER
SPACE 4,10
* INFORMATIONAL MESSAGES.
MSCA DATA 10HCATALOGING
MSCP DATA 10HCOPYING
MSRS DATA 10HRESTORING
MSSK DATA 10HSKIPPING
BLNK DATA 30H
SPACE 4,10
* FILE COUNT MESSAGES.
MSFA DATA C* ?????? FILE! CATALOGED.*
MSFO DATA C* ?????? FILE! COPIED.*
MSFR DATA C* ?????? FILE! RESTORED.*
SPACE 4,10
* ERROR MESSAGES.
ERAB DATA C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!.*
ERAL DATA C* ARCHIVE FILE LABEL READ ERROR.*
ERAR DATA C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!.*
ERFL DATA C* FILE NAME CHANGED TO ZZZZZLF.*
ERFS DATA C* FILE NAME CHANGED TO ZZZZZSF.*
ERFT DATA C* FILE NAME CHANGED TO ZZZZZTF.*
ERFV DATA C* FILE VERIFICATION ERROR, FN=???????, UI=!!!!!!, FM=+
,++++++.*
ERIC DATA C* INCORRECT CATALOG SIZE.*
ERDA DATA C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!.*
ERNR DATA C* NO FILES TO RESTORE.*
ERNT DATA C* STAGING TAPE NOT ASSIGNED.*
ERPE DATA C* PREMATURE EOF DETECTED.*
ERPF DATA C* PFM ERROR ENCOUNTERED, FN=???????, UI=!!!!!!, FM=+++
,++++.*
ERRA DATA C* NO DEVICE FOR FILE ACCESS LEVEL, FN=???????, UI=!!!!
,!!, FM=+++++++.*
ERRB DATA C* ARCHIVE FILE BLOCK ERROR, FN=???????, UI=!!!!!!, FM=
,+++++++.*
ERRR DATA C* ARCHIVE FILE READ ERROR, FN=???????, UI=!!!!!!, FM=+
,++++++.*
ERSA DATA C* STAGE ABANDONED, FN=???????, UI=!!!!!!, FM=+++++++.*
ERVE DATA C* STAGING TAPE VSN ERROR. VSN = $$$$$$.*
TITLE MAIN ROUTINES.
PFA SPACE 4,10
** PFAM - MAIN PROGRAM.
*
* EXIT TO *AFL* TO READ ARCHIVE FILE.
*
* USES X - 1.
* A - 1.
*
* CALLS PRS.
*
* MACROS SKIPFF.
PFA BSS 0 ENTRY
RJ PRS PRESET PROGRAM
SA1 CPAR+/COMSPFS/CPSF
ZR X1,AFL IF NO FILES TO SKIP
SKIPFF TAPE,X1,R SKIP NUMBER OF FILES
* EQ AFL PROCESS ARCHIVE FILE LABEL
AFL SPACE 4,20
** AFL - PROCESS ARCHIVE FILE LABEL.
*
* EXIT ARCHIVE LABEL PROCESSED IF FOUND.
* TO *CUP* IF NO READ ERROR ON LABEL READ.
* TO *ABT* IF READ ERROR ON LABEL READ.
* TO *TER* IF EOI AND IF EOF JUST PROCESSED.
* TO *ABT* IF EOI NOT PRECEDED BY EOF.
* TO *EAF* IF LAST ARCHIVE FILE AND NO FILES SELECTED.
*
* USES X - 0, 2, 1, 3, 5.
* A - 0, 2, 1, 3, 5.
* B - 2.
*
* CALLS PLP, SER.
*
* MACROS MOVE, READ, READW, RECALL.
AFL BSS 0 ENTRY
READ TAPE,R
SA3 TAPE
LX3 59-11
PL X3,AFL1 IF NO ERROR
SB2 ERAL * ARCHIVE FILE LABEL READ ERROR.*
EQ ABT ABORT
AFL1 LX3 59-9-59+11
PL X3,AFL1.1 IF NOT AT EOI
SA1 EFPF
NZ X1,TER IF EOF JUST PROCESSED
SB2 ERPE * PREMATURE EOF DETECTED.*
EQ ABT ABORT
AFL1.1 SX6 B0+ CLEAR *EOF JUST PROCESSED* FLAG
SA6 EFPF
SA1 TAPE+3 CHECK IF LABEL
SA1 X1
MX0 -3
AX1 12
BX1 -X0*X1
ZR X1,AFL2 IF DUMP ARCHIVE LABEL
SA0 B0+ SET LABEL NOT FOUND
SX1 X1-1
ZR X1,AFL3 IF CATALOG CONTROL WORD
RJ SER SKIP TO END OF RECORD
SA0 B0+ SET LABEL NOT FOUND
EQ AFL3 CLEAR MESSAGE AREAS
AFL2 READW TAPE,DBUF,B1 READ LABEL CONTROL WORD
SA1 DBUF GET CONTROL WORD
MX0 -9
BX5 -X0*X1
READW TAPE,DBUF,X5 READ LABEL
SA0 DBUF SET LABEL BUFFER ADDRESS
AFL3 RJ PLP PROCESS LABEL PARAMETERS
RECALL TAPE
SA5 IDSA+/COMSPFS/ADMS CLEAR MESSAGE AREAS
MOVE 3,BLNK,X5
SA5 IDSA+/COMSPFS/ADER CLEAR MESSAGE AREAS
MOVE 3,BLNK,X5
SA1 AFDM GET ARCHIVE FILE DEVICE MASK
SA2 FLSM GET REMAINING FILE SELECTIONS MASK
BX1 X1*X2
ZR X1,EAF IF LAST ARCHIVE FILE AND NO FILES SELECTED
* EQ CUP CALL UTILITY PROCESSOR
CUP SPACE 4,15
** CUP - CALL UTILITY PROCESSOR.
*
* ENTRY ARCHIVE FILE POSITIONED FOR READ OF CONTROL WORD.
*
* EXIT TO *ATC* IF *PFATC*.
* TO *COP* IF *PFCOPY*.
* TO *RES* IF *PFRES*.
*
* USES X - 1, 2.
* A - 1.
CUP BSS 0 ENTRY
SA1 /COMSPFS/UTLC CHECK UTILITY CODE
SX2 X1-/COMSPFS/ATUT
ZR X2,ATC IF *PFATC*
SX2 X1-/COMSPFS/COUT
ZR X2,COP IF *PFCOPY*
EQ RES PROCESS *PFRES*
ATC SPACE 4,10
** ATC - *PFATC* MAIN LOOP.
*
* USES X - 1, 2, 4, 6.
* A - 0, 1, 4, 6.
*
* CALLS CFB, CFC, CSP, DFN, OCD, OCI, PPE, RCW, SER.
*
* MACROS READW, SKIPW.
ATC BSS 0 ENTRY
* CHECK CONTROL WORD.
ATC1 SX6 B0+
SA6 FPRF CLEAR FILE PROCESSING FLAG
RJ RCW READ CONTROL WORD
NG X3,ATC1 IF EOR
SX1 X2-1
ZR X1,ATC5 IF PF CATALOG ENTRY
SX1 X2-5
ZR X1,ATC3 IF CIR
ATC2 SKIPW TAPE,X5 SKIP BLOCK
RJ SER SKIP TO EOR
EQ ATC1 READ CONTROL WORD
* PROCESS CATALOG IMAGE RECORD BLOCK.
ATC3 ZR X5,ATC1 IF EMPTY BLOCK
RJ CFB CHECK FOR FIRST BLOCK
READW TAPE,DBUF,X5 READ CATALOG IMAGE BLOCK
RJ PPE PROCESS PARITY ERROR
NZ X6,ATC1 IF PARITY ERROR
SX6 DBUF SET CIR BUFFER POINTER
BX7 X5 SET WORD COUNT
RJ OCI OUTPUT CATALOG IMAGE BLOCK
EQ ATC1 READ CONTROL WORD
* PROCESS CATALOG BLOCK.
ATC5 RJ CFB CHECK IF FIRST CATALOG BLOCK
RJ CFC CHECK FILES PROCESSED COUNT
RJ CSP CHECK SELECTION PARAMETERS
ZR X6,ATC7 IF NOT TO PROCESS FILE
SA6 FPRF SET FILE PROCESSING FLAG
SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSCA *CATALOGING ...*
RJ DFN DISPLAY MESSAGE
RJ VPD VERIFY PERMIT AND DATA BLOCKS
SA0 CATH SET CATALOG ENTRY ADDRESS
RJ CFP COUNT FILE PROCESSED
EQ ATC1 CHECK NEXT CONTROL WORD
ATC7 SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSSK *SKIPPING ...*
RJ DFN DISPLAY MESSAGE
RJ SER SKIP TO END OF RECORD
EQ ATC1 CHECK NEXT CONTROL WORD
COP SPACE 4,10
** COP - *PFCOPY* MAIN LOOP.
*
* USES X - 1, 2, 6, 7.
* A - 0, 1, 2, 6, 7.
*
* CALLS CCB, CFB, CFC, CFP, PDB, PPB, RCW, SER.
*
* MACROS MESSAGE, SKIPW.
COP BSS 0 ENTRY
* CHECK NEXT CONTROL WORD.
COP1 SX6 B0+
SA6 FPRF CLEAR FILE PROCESSING FLAG
RJ CFC CHECK FILE SELECTION COUNT
RJ RCW READ CONTROL WORD
NG X3,COP1 IF EOR
SX1 X2-1
ZR X1,COP3 IF CATALOG CONTROL WORD
SKIPW TAPE,X5 SKIP BLOCK
RJ SER SKIP TO EOR
EQ COP1 CHECK NEXT CONTROL WORD
COP3 RJ CFB CHECK IF FIRST CATALOG BLOCK
RJ CCB PROCESS CATALOG BLOCK
NZ X6,COP1 IF FILE NOT TO BE PROCESSED
RJ PPB PROCESS PERMIT BLOCK
NZ X6,COP1 IF PARITY ERROR
RJ PDB PROCESS DATA BLOCK
ZR X6,COP4 IF NO ERROR
RETURN F,R RETURN LOCAL FILE
EQ COP1 CHECK NEXT FILE
COP4 SA0 CATH SET CATALOG ENTRY ADDRESS
RJ CFP COUNT FILE PROCESSED
EQ COP1 CHECK NEXT FILE
RES SPACE 4,10
** RES - *PFRES* MAIN LOOP.
*
* EXIT TO *TER* WHEN NO REQUESTS LEFT TO PROCESS.
*
* USES X - 0, 1, 2, 4, 5, 6, 7.
* A - 0, 1, 2, 5, 6, 7.
* B - 2, 5.
*
* CALLS CAR, CFP, CLC, PDB, PPE, RCB, RCW, SER, STE.
*
* MACROS EESET, MESSAGE, SKIPW, UNLOAD.
RES BSS 0 ENTRY
* CHECK NEXT FILE ON TAPE.
RES1 SX6 B0+ CLEAR FILE PROCESSING FLAG
SA6 FPRF
RJ RCW READ CONTROL WORD
NG X3,RES1 IF EOR
SX1 X2-1
ZR X1,RES3 IF CATALOG CONTROL WORD
SX1 X2-5
NZ X1,RES2 IF NOT CATALOG IMAGE RECORD
SKIPW TAPE,X5 SKIP CIR BLOCK
RJ SER SKIP TO EOR
EQ RES1 CHECK NEXT CONTROL WORD
RES2 RJ STE SKIP TAPE ERROR
EQ RES1 CHECK NEXT CONTROL WORD
RES3 RJ RCB PROCESS CATALOG BLOCK
NZ X6,RES1 IF FILE NOT TO BE PROCESSED
* SKIP PERMIT BLOCKS, IF PRESENT.
RES4 RJ RCW READ CONTROL WORD
BX0 X3
SX4 X2-3
ZR X4,RES6 IF DATA BLOCK
SX4 X2-2
ZR X4,RES5 IF PERMIT BLOCK
SA5 STRA
SB2 ERRB * ARCHIVE FILE BLOCK ERROR ...*
RJ SRE SEND ERROR MESSAGE
RJ STE SKIP TAPE ERROR
EQ RES7 PROCESS ERROR
RES5 ZR X5,RES4 IF ZERO WORD COUNT
SKIPW TAPE,X5 SKIP PERMIT BLOCK
RJ PPE PROCESS PARITY ERROR
NZ X6,RES7 IF PARITY ERROR
EQ RES4 CHECK NEXT BLOCK
* PROCESS DATA BLOCK.
RES6 RJ PDB PROCESS DATA BLOCK
ZR X6,RES8 IF NO ERROR
RES7 UNLOAD F RETURN LOCAL FILE
EQ RES9 CHECK FOR ADDITIONAL REQUESTS
* COMPLETE STAGE PROCESS.
RES8 RJ CLC CONNECT LOCAL FILE TO CATALOG ENTRY
NZ X6,RES7 IF ERROR
UNLOAD F RELEASE FILE
SA1 STRA INDICATE FILE STAGED
SA2 X1+3 GET EVENT
MX6 -21
BX1 -X6*X2
EESET X1 ISSUE EVENT
SB5 -ISMA ISSUE *STES* MESSAGE
SA5 STRA
RJ ISM
SA1 STRA INDICATE STAGE REQUEST PROCESSED
BX6 X6-X6
SA6 X1
SA6 A1
SA0 CATH SET CATALOG ENTRY ADDRESS
RJ CFP COUNT FILE PROCESSED
RES9 RJ CAR CHECK FOR ADDITIONAL REQUESTS
ZR X6,TER IF NO REQUESTS LEFT TO PROCESS
EQ RES1 CHECK NEXT FILE
EAF SPACE 4,20
** EAF - END PROCESSING ON CURRENT ARCHIVE FILE.
*
* ENTRY PROCESSING COMPLETE ON CURRENT ARCHIVE FILE.
*
* EXIT TO *EOF*.
* ARCHIVE FILE POSITIONED TO START OF NEXT FILE.
*
* USES X - 1, 6, 7.
* A - 1.
*
* MACROS RECALL, SKIPFF.
EAF BSS 0 ENTRY
RECALL TAPE
SA1 X2+B1 REWIND BUFFER
SX6 X1
SA6 A1+B1
SA6 A6+B1
SA1 X2 CHECK FOR EOF/EOI ON ARCHIVE FILE
SX6 30B
BX7 X6*X1
BX6 X7-X6
ZR X6,EOF IF AT EOF/EOI
SKIPFF X2,B1,R SKIP TO EOF
* EQ EOF PROCESS END OF FILE
EOF SPACE 4,15
** EOF - PROCESS END OF FILE ON ARCHIVE FILE.
*
* ENTRY END OF FILE ENCOUNTERED ON ARCHIVE FILE.
*
* EXIT TO *AFL* IF MORE FILES TO PROCESS.
* BLOCK PROCESSED FLAGS RESET.
* (EFPF) NONZERO.
* TO *TER* IF NO MORE FILES TO PROCESS.
*
* USES X - 1, 6.
* A - 1, 6.
*
* CALLS PSF.
EOF BSS 0 ENTRY
SA1 CAPF
ZR X1,EOF1 IF CATALOG BLOCK NOT PROCESSED
RJ PSF PROCESS SORTED FILE LIST AND STATISTICS
EOF1 SA1 TAPE CHECK FOR *EOI*
LX1 59-9
NG X1,TER IF *EOI* ENCOUNTERED
SA1 CPAR+/COMSPFS/CPNB CHECK IF NUMBER OF FILES SPECIFIED
ZR X1,TER IF NOT SPECIFIED
SX6 X1-1
ZR X6,TER IF NUMBER SPECIFIED PROCESSED
SA6 A1
BX6 X6-X6 RESET BLOCK PROCESSED FLAGS
SA6 CIPF
SA6 CAPF
SX6 B1+ SET *EOF JUST PROCESSED* FLAG
SA6 EFPF
EQ AFL PROCESS NEXT ARCHIVE FILE
TER SPACE 4,20
** TER - PERFORM TERMINATION.
*
* EXIT TO *AFL* IF MORE STAGE REQUESTS TO PROCESS FOR *PFRES*.
* TO *END* IF OVERLAY PROCESSING COMPLETE.
* LOCAL FILE AND TAPE RETURNED (*PFRES*).
* UNPROCESSED STAGE REQUESTS REQUEUED.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 6.
* B - 2, 5.
*
* CALLS CAR, RUR, TCM.
*
* MACROS MESSAGE, MOVE, RETURN, REWIND.
TER BSS 0 ENTRY
SA1 /COMSPFS/UTLC
SX1 X1-/COMSPFS/RSUT
NZ X1,TER3 IF NOT *PFRES*
* IF STAGE REQUESTS REMAIN, REWIND TAPE AND READ FROM BEGINNING
* (UNLESS NO NEW REQUESTS HAVE BEEN RECEIVED AND NO FILES HAVE
* BEEN STAGED SINCE THE LAST ENTRY TO *TER*).
RJ CAR CHECK FOR ADDITIONAL STAGE REQUESTS
ZR X6,TER2 IF NO MORE STAGE REQUESTS TO BE PROCESSED
SA1 SRQN
SA2 TERA
BX6 X1
SA6 A2 SAVE NUMBER OF REQUESTS RECEIVED
IX3 X1-X2
SA1 NSSR
SA2 TERB
BX6 X1
SA6 A2 SAVE NUMBER OF REQUESTS SELECTED
NZ X3,TER1 IF MORE REQUESTS RECEIVED SINCE LAST CALL
IX1 X1-X2
ZR X1,TER2 IF NO MORE FILES STAGED SINCE LAST CALL
TER1 REWIND TAPE,R
RJ CAR CHECK FOR ADDITIONAL STAGE REQUESTS
EQ AFL PROCESS ADDITIONAL STAGE REQUESTS
TER2 RJ /MTX/TCM TERMINATE CONNECTION WITH *MAGNET*
RJ RUR REQUEUE UNPROCESSED STAGE REQUESTS
RETURN F,R
RETURN T,R
* PROCESS *PFATC* OR *PFCOPY* TERMINATION.
TER3 EQ END TERMINATE
TERA CON 0 STAGE REQUESTS RECEIVED BEFORE PRIOR CALL
TERB CON 0 STAGE REQUESTS SELECTED BEFORE PRIOR CALL
TITLE PRIMARY SUBROUTINES.
CCB SPACE 4,15
** CCB - *PFCOPY* PROCESS CATALOG BLOCK.
*
* ENTRY (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
* (X5) = CATALOG BLOCK WORD COUNT.
*
* EXIT (X6) .NE. 0, IF FILE NOT TO BE PROCESSED.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6.
*
* CALLS ALD, CSP, CFE, DFN, SER, SFE.
*
* MACROS MESSAGE, RECALL, RETURN, WRITER, WRITEW.
CCB SUBR ENTRY/EXIT
RJ CSP CHECK SELECTION PARAMETERS
ZR X6,CCB1 IF FILE NOT TO BE COPIED
SA1 FLST
LX1 59-0
NG X1,CCB1 IF *PFC ONLY* FILE
SA6 FPRF SET FILE PROCESSING FLAG
EQ CCB3 SET FILE NAME IN FET
* SET SKIPPING FN UI MESSAGE.
CCB1 SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSSK *SKIPPING ...*
RJ DFN DISPLAY MESSAGE
CCB2 RJ SER SKIP TO EOR
SX6 B1 INDICATE FILE NOT TO BE PROCESSED
EQ CCBX RETURN
* SET FILE NAME IN FET.
CCB3 RECALL FILEA
SA3 CPAR+/COMSPFS/CPMF CHECK IF MASTER FILE SPECIFIED
NZ X3,CCB7 IF MASTER FILE SPECIFIED
SA4 FILEA SET FILE NAME IN FET
MX0 42
BX7 -X0*X4 SAVE CODE AND STATUS
SA3 CATH
BX1 X0*X3
SA2 CPAR+/COMSPFS/CPTB
BX2 X2-X1
NZ X2,CCB4 IF NOT ARCHIVE FILE NAME
MESSAGE ERFT * FILE NAME CHANGED TO ZZZZZTF.*
SA1 =0LZZZZZTF
EQ CCB6 CHANGE NAME IN FET
CCB4 SA2 CPAR+/COMSPFS/CPLB
BX2 X2-X1
NZ X2,CCB5 IF NOT OUTPUT FILE NAME
MESSAGE ERFL * FILE NAME CHANGED TO ZZZZZLF.*
SA1 =0LZZZZZLF
EQ CCB6 CHANGE FILE NAME IN FET
CCB5 SA2 CPAR+/COMSPFS/CPSU
BX2 X2-X1
NZ X2,CCB6 IF NOT SUMMARY FILE NAME
MESSAGE ERFS * FILE NAME CHANGED TO ZZZZZSF.*
SA1 =0LZZZZZSF
CCB6 BX6 X7+X1
SA6 A4
RETURN FILEA,R
RJ ALD ASSIGN MASS STORAGE DEVICE
ZR X6,CCB7 IF DEVICE ASSIGNED
SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSSK *SKIPPING ...*
RJ DFN DISPLAY MESSAGE
SA1 CATH+FCUI
SB2 ERDA * NO DEVICE FOR FILE ACCESS LEVEL ...*
RJ SFE SEND ERROR MESSAGE
RJ CFE COUNT FILE SKIPPED
EQ CCB2 SKIP FILE
* SET COPYING FN UI MESSAGE.
CCB7 SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSCP *COPYING ...*
RJ DFN DISPLAY MESSAGE
* WRITE CATALOG PREFACE RECORD IF SELECTED.
SA1 CPAR+/COMSPFS/CPOP
LX1 59-50
PL X1,CCB8 IF NO PREFACE RECORDS REQUESTED
WRITEW FILEA,CATH,NWCE
WRITER FILEA,R
CCB8 BX6 X6-X6 INDICATE FILE TO BE PROCESSED
EQ CCBX
CFB SPACE 4,20
** CFB - CHECK FOR FIRST BLOCK OF TYPE ON CURRENT ARCHIVE FILE.
*
* ENTRY (X2) = BLOCK TYPE (MUST BE 1 OR 5).
* = 1 IF CATALOG ENTRY.
* = 5 IF *CIR* ENTRY.
* (X3) = BLOCK CONTROL WORD SUB-TYPE.
* (X5) = BLOCK WORD COUNT.
*
* EXIT (CIPF) .NE. 0 IF *CIR* BLOCK.
* (CAPF) .NE. 0 IF CATALOG BLOCK.
* (X3) = BLOCK CONTROL WORD SUB-TYPE.
* (X5) = BLOCK WORD COUNT.
*
* USES X - 2, 3, 5, 6, 7.
* A - 3, 5, 6, 7.
*
* CALLS ICI, IFP, PSI.
CFB SUBR ENTRY/EXIT
SX2 X2-5
SX1 CIPF
ZR X2,CFB1 IF *CIR* TYPE
SX1 CAPF
CFB1 SA1 X1
NZ X1,CFBX IF NOT FIRST BLOCK
SX6 B1 SET FIRST BLOCK FOUND
SA6 A1+
BX6 X3
BX7 X5
SA6 CFBA SAVE BLOCK SUB-TYPE
SA7 CFBB SAVE WORD COUNT
NZ X2,CFB2 IF NOT CIR BLOCK
RJ ICI INITIALIZE CIR OUTPUT
EQ CFB4 RESET BLOCK PARAMETERS
CFB2 SA1 CIPF
ZR X1,CFB3 IF CIR NOT PROCESSED
RJ PSI PROCESS SORTED CIR OUTPUT
CFB3 RJ IFL INITIALIZE CATALOG OUTPUT
CFB4 SA3 CFBA RESTORE SUB-TYPE
SA5 CFBB RESTORE WORD COUNT
EQ CFBX RETURN
CFBA CON 0 BLOCK SUB-TYPE
CFBB CON 0 BLOCK WORD COUNT
PDB SPACE 4,20
** PDB - PROCESS DATA BLOCK.
*
* ENTRY NON-PERMIT CONTROL WORD READ.
* (X3) = CONTROL WORD SUB-TYPE.
* = -1, IF EOR WAS ENCOUNTERED.
* (DBUF) = CONTROL WORD.
*
* EXIT (X6) .NE. 0, IF READ ERROR OR ARCHIVE FILE ERROR.
* DATA BLOCK PROCESSED.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 2, 6, 7.
*
* CALLS PPE, RCW, STE.
*
* MACROS MESSAGE, READW, RECALL, SETFS, WRITE, WRITEF, WRITER,
* WRITEW.
PDB SUBR ENTRY/EXIT
RECALL FILEA
BX6 X6-X6 CLEAR EOF FLAG
SX7 B1 SET FILE PROCESSED FLAG
SA6 PDBA
SX6 SSLN INITIALIZE REMAINING SYSTEM SECTOR LENGTH
SA6 PDBD
EQ PDB2 PROCESS SYSTEM SECTOR
* READ CONTROL WORD.
PDB1 RJ RCW READ CONTROL WORD
PDB2 NG X3,PDB12 IF EOR
SA1 DBUF CHECK DATA CONTROL WORD
AX1 12
MX0 -3
BX1 -X0*X1
SX1 X1-3
ZR X1,PDB5 IF DATA BLOCK
* PROCESS ERROR IN ARCHIVE FILE.
PDB3 SA1 /COMSPFS/UTLC
SX1 X1-/COMSPFS/RSUT
ZR X1,PDB4 IF *PFRES*
SA1 CATH+FCUI
SB2 ERAB * ARCHIVE FILE BLOCK ERROR... *
RJ SFE SEND ERROR MESSAGE
EQ PDB4.1 SKIP TAPE ERROR
PDB4 SA5 STRA
SB2 ERRB * ARCHIVE FILE BLOCK ERROR... *
RJ SRE SEND ERROR MESSAGE
PDB4.1 RJ STE SKIP TAPE ERROR
SX6 B1 INDICATE ERROR
EQ PDBX RETURN
* READ DATA.
PDB5 BX0 X3
BX6 X3 SAVE DATA MARK
SA6 PDBC
ZR X5,PDB10 IF ZERO WORD COUNT
READW TAPE,DBUF,X5
RJ PPE PROCESS PARITY ERROR
NZ X6,PDBX IF PARITY ERROR
* SKIP OVER SYSTEM SECTOR.
SA1 PDBD GET REMAINING SYSTEM SECTOR LENGTH
SX2 X0-4
BX6 X1+X2
ZR X6,PDB3 IF EXTRA SYSTEM SECTOR (NOT AT BOI)
ZR X2,PDB7 IF SYSTEM SECTOR
ZR X1,PDB9 IF SYSTEM SECTOR ALREADY PROCESSED
SX7 X1-SSLN
NZ X7,PDB3 IF SYSTEM SECTOR TRUNCATED
SA7 PDBD CLEAR REMAINING SYSTEM SECTOR LENGTH
EQ PDB9 WRITE DATA SECTOR
PDB7 IX7 X1-X5
NG X7,PDB3 IF SYSTEM SECTOR TOO LONG
SA7 A1 UPDATE REMAINING SYSTEM SECTOR LENGTH
EQ PDB1 BYPASS SYSTEM SECTOR
* WRITE DATA.
PDB9 WRITEW FILEA,DBUF,X5
* PROCESS DATA MARK.
PDB10 ZR X0,PDB1 IF NO DATA MARK
SX2 X0-4
ZR X2,PDB1 IF SYSTEM SECTOR
SX0 X0-1
NZ X0,PDB11 IF END OF FILE
WRITER FILEA,R
EQ PDB1 READ NEXT CONTROL WORD
PDB11 WRITEF FILEA,R
SX6 B1+ SET EOF FLAG
SA6 PDBA
EQ PDB1 READ NEXT CONTROL WORD
* PROCESS FILES WITH NO EOF.
PDB12 SETFS FILEA,0 CLEAR SPECIAL FILE STATUS
SA1 PDBA CHECK EOF FLAG
NZ X1,PDB13 IF EOF FLAG SET
SA1 PDBC CHECK LAST DATA MARK
NZ X1,PDB13 IF EOR, RETURN
WRITE FILEA,R
SA1 FILEA+2 CHECK FOR EMPTY BUFFER
SA2 A1+B1
IX7 X1-X2 IN - OUT
ZR X7,PDB13 IF BUFFER FLUSHED, RETURN
WRITER FILEA,R
PDB13 BX6 X6-X6 INDICATE NO ERROR
EQ PDBX RETURN
PDBA CON 0 EOF FLAG
PDBC CON 0 LAST DATA MARK
PDBD CON 0 REMAINING SYSTEM SECTOR LENGTH
PPB SPACE 4,20
** PPB - PROCESS PERMIT BLOCK (*PFCOPY*).
*
* ENTRY CATALOG BLOCK PROCESSED.
*
* EXIT (X6) .NE. 0, IF PARITY ERROR.
* PERMIT BLOCK PROCESSED.
* NON-PERMIT CONTROL WORD READ.
* (X3) = CONTROL WORD SUB-TYPE.
* = -1, IF EOR WAS ENCOUNTERED.
*
* USES X - 0, 1, 4, 6.
* A - 1, 6.
*
* CALLS PPE, RCW.
*
* MACROS READW, RECALL, WRITER, WRITEW.
PPB SUBR ENTRY/EXIT
RECALL F
SX6 B0+ CLEAR PERMIT FLAG
SA6 PPBA
* CHECK IF PERMIT BLOCK.
PPB1 RJ RCW READ CONTROL WORD
BX0 X3
SX4 X2-2
ZR X4,PPB3 IF PERMIT BLOCK
SA1 PPBA
NZ X1,PPB2 IF PERMITS EXIST
* WRITE ZERO LENGTH RECORD IF PREFACE RECORDS REQUESTED.
SA1 CPAR+/COMSPFS/CPOP
LX1 59-50
PL X1,PPB2 IF NO PREFACE RECORD
WRITER FILEA,R
PPB2 BX6 X6-X6 INDICATE NO ERROR
EQ PPBX RETURN
* READ PERMIT INFORMATION.
PPB3 ZR X5,PPB1 IF ZERO WORD COUNT
SX6 B1 SET PERMIT FLAG
SA6 PPBA
READW TAPE,DBUF,X5 READ PERMIT BLOCK
RJ PPE PROCESS PARITY ERROR
NZ X6,PPBX IF PARITY ERROR
* WRITE PERMIT PREFACE RECORD.
SA1 CPAR+/COMSPFS/CPOP
LX1 59-50
PL X1,PPB1 IF NO PREFACE RECORD REQUESTED
WRITEW FILEA,DBUF,X5
ZR X0,PPB1 IF NO DATA MARK
WRITER FILEA,R
EQ PPB1 READ NEXT CONTROL WORD
PPBA BSSZ 1 PERMIT FLAG
RCB SPACE 4,20
** RCB - *PFRES* PROCESS CATALOG BLOCK.
*
* ENTRY (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
* (X5) = CATALOG BLOCK WORD COUNT.
*
* EXIT (X6) = 0, IF FILE IS TO BE PROCESSED.
* (CATH) = CATALOG ENTRY FOR FILE.
* TO *ABT* IF INCORRECT CATALOG SIZE.
* TO *TER* IF FILE SKIPPED AND NO MORE REQUESTS.
*
* USES X - 0, 1, 2, 5, 6.
* A - 1, 5, 6.
* B - 2.
*
* CALLS ALD, APD, CAR, CSR, DFN, PPE, SEM, SRE, SSR, VCE.
*
* MACROS RECALL, RETURN, WRITER, WRITEW.
RCB SUBR ENTRY/EXIT
SX1 X5-NWCE
ZR X1,RCB1 IF CORRECT SIZE CATALOG ENTRY
SB2 ERIC * INCORRECT CATALOG SIZE.*
EQ ABT ABORT
RCB1 SX0 X3 SAVE *PFC ONLY* STATUS
READW TAPE,CATH,X5 READ CATALOG ENTRY
RJ PPE PROCESS PARITY ERROR
NZ X6,RCB3 IF PARITY ERROR ON CATALOG READ
NZ X0,RCB4 IF NOT *PFC ONLY* FILE
* SKIP FILE.
RCB2 SA1 CATH SET FILE NAME AND USER INDEX
SA2 MSSK *SKIPPING ...*
RJ DFN DISPLAY MESSAGE
RJ SER SKIP TO EOR
RJ CAR CHECK FOR ADDITIONAL STAGE REQUESTS
ZR X6,TER IF NO REQUESTS REMAIN TO BE PROCESSED
RCB3 SX6 B1 INDICATE THAT FILE IS NOT TO BE PROCESSED
EQ RCBX RETURN
* CHECK IF FILE IS TO BE STAGED.
RCB4 RJ CSR CHECK FOR STAGE REQUEST FOR THIS FILE
ZR X6,RCB2 IF NO STAGE REQUEST FOR THIS FILE
RJ VCE VERIFY CATALOG ENTRY FIELDS
NZ X6,RCB2 IF ACTIVE PFC DOES NOT MATCH PFC ON TAPE
* SET UP TO STAGE FILE.
SX6 1
SA6 FPRF SET FILE PROCESSING FLAG
RJ SSR SETUP *PFM* SPECIAL REQUEST BLOCK
SA1 CATH+FCBS
LX1 59-11
PL X1,RCB5 IF INDIRECT ACCESS FILE
RJ APD ASSIGN PERMANENT FILE DEVICE
ZR X6,RCB7 IF DEVICE ASSIGNED
EQ RCB6 PROCESS NO DEVICE FOUND
RCB5 RJ ALD ASSIGN LOCAL FILE DEVICE
ZR X6,RCB7 IF DEVICE ASSIGNED
RCB6 SA5 STRA
SB2 ERRA * NO DEVICE FOR FILE ACCESS LEVEL ...*
RJ SRE SEND ERROR MESSAGE
EQ RCB2 SKIP FILE
* SET *RESTORING FN UI* MESSAGE.
RCB7 SA1 STRA SET FILE NAME AND USER INDEX
SA1 X1+2
SA2 MSRS *RESTORING ...*
RJ DFN DISPLAY MESSAGE
BX6 X6-X6 INDICATE THAT FILE IS TO BE PROCESSED
EQ RCBX RETURN
RCW SPACE 4,25
** RCW - READ CONTROL WORD.
*
* EXIT (X2) = CONTROL WORD TYPE.
* (X3) = CONTROL WORD SUB-TYPE.
* = -1, IF EOR.
* (DBUF) = CONTROL WORD.
* (X5) = WORD COUNT.
* TO *EAF* IF END OF DUMP CONTROL WORD.
* TO *CUP* IF PARITY ERROR.
* TO *ABT* IF EOF BEFORE END OF DUMP CONTROL WORD.
*
* USES X - 0, 1, 2, 3, 5.
* A - 1.
* B - 2.
*
* CALLS PPE.
*
* MACROS MESSAGE, READ, READW.
RCW SUBR ENTRY/EXIT
READW TAPE,DBUF,B1
RJ PPE PROCESS PARITY ERROR
NZ X6,CUP IF PARITY ERROR
SB2 ERPE * PREMATURE EOF DETECTED.*
NG X1,ABT IF EOF
ZR X1,RCW1 IF NOT EOR
* PROCESS END OF RECORD.
READ TAPE
RJ PPE PROCESS PARITY ERROR
SX3 -1 SET EOR
ZR X6,RCWX IF NO PARITY ERROR
EQ CUP CALL UTILITY PROCESSOR
* BREAK UP CONTROL WORD.
RCW1 SA1 DBUF BREAK APART CONTROL WORD
MX0 -9
BX5 -X0*X1 MASK OFF WORD COUNT
AX0 6
AX1 9
BX3 -X0*X1 MASK OFF SUB-TYPE CODE
AX1 3
BX2 -X0*X1 MASK OFF TYPE CODE
SX1 X2-7
ZR X1,EAF IF END OF ARCHIVE FILE CONTROL WORD
EQ RCWX RETURN
VPD SPACE 4,20
** VPD - VERIFY PERMIT AND DATA BLOCKS.
*
* ENTRY CATALOG ENTRY IN *CATH*.
*
* EXIT PERMIT OR DATA ERROR FLAGS SET IN *FLST* IF ERROR
* BLOCKS PRESENT ON ARCHIVE FILE.
* ERROR MESSAGES ISSUED IF FILE PERMITS OR DATA
* UNREADABLE OR LOGIGAL ERROR IN PERMIT OR DATA
* BLOCKS.
*
* USES X - 1, 2, 4, 6, 7.
* A - 1, 2, 6, 7.
*
* CALLS RCW, SFE, STE.
*
* MACROS READW.
VPD SUBR ENTRY/EXIT
* CHECK CONSISTENCY OF PFC AND PERMITS BLOCKS.
RJ RCW READ CONTROL WORD
SA1 CATH+FCRI GET PERMITS RANDOM INDEX
SX7 X2-2 CHECK FOR PERMITS BLOCK
MX6 -24
LX1 24
BX1 -X6*X1
NZ X1,VPD1 IF PERMITS IN CATALOG
NG X3,VPD4 IF EOR ON ARCHIVE FILE
NZ X7,VPD4 IF NOT PERMITS BLOCK
EQ VPD9 PROCESS ARCHIVE FILE ERROR
VPD1 NG X3,VPD9 IF EOR ON ARCHIVE FILE
NZ X7,VPD9 IF NOT PERMITS BLOCK
* CHECK FOR ERROR STATUS IN PERMITS BLOCKS.
VPD2 SA1 DBUF
MX6 -3
LX1 -15
BX6 -X6*X1
ZR X6,VPD3 IF NOT ERROR BLOCK
SA1 FLST SET PERMIT ERROR IN FILE STATUS
SX6 4
BX6 X1+X6
SA6 A1
VPD3 READW TAPE,DBUF,X5 READ PERMITS BLOCK
RJ PPE PROCESS PARITY ERROR
NZ X6,VPDX IF PARITY ERROR
RJ RCW READ NEXT CONTROL WORD
NG X3,VPD4 IF EOR ON ARCHIVE FILE
SX7 X2-2
ZR X7,VPD2 IF PERMITS BLOCK
* CHECK CONSISTENCY OF PFC AND DATA BLOCKS.
VPD4 SA1 FLST GET *PFC ONLY* FLAG
LX1 59-0
PL X1,VPD5 IF NOT *PFC ONLY* FILE
NG X3,VPDX IF EOR ON ARCHIVE FILE
EQ VPD9 PROCESS ARCHIVE FILE ERROR
VPD5 NG X3,VPD9 IF EOR ON ARCHIVE FILE
SX7 X2-3
NZ X7,VPD9 IF NOT DATA BLOCK
* CHECK FOR ERROR STATUS IN DATA BLOCKS.
VPD6 SA1 DBUF
SA2 VPDA
MX6 42
MX7 -3
BX6 X6*X1
LX1 -15
BX6 X6-X2
BX7 -X7*X1 EXTRACT ERROR TYPE
NZ X6,VPD8 IF NOT ERROR BLOCK
SA1 FLST
SX6 10B SET TRUNCATED FILE
ZR X7,VPD7 IF TRUNCATED FILE ERROR
SX6 2 SET ERROR IN DATA
VPD7 BX6 X1+X6
SA6 FLST
VPD8 READW TAPE,DBUF,X5 READ DATA BLOCK
RJ PPE PROCESS PARITY ERROR
NZ X6,VPDX IF PARITY ERROR
RJ RCW READ NEXT CONTROL WORD
NG X3,VPDX IF EOR ON ARCHIVE FILE
SX7 X2-3
ZR X7,VPD6 IF DATA BLOCK
* PROCESS ARCHIVE FILE ERROR.
VPD9 BX7 X3 SAVE EOR STATUS
SA7 VPDB
SA1 CATH+FCUI
SB2 ERAB * ARCHIVE FILE BLOCK ERROR ...*
RJ SFE SEND ERROR MESSAGE
SA3 VPDB
NG X3,VPDX IF EOR ON ARCHIVE FILE
RJ STE SKIP TO END OF RECORD
EQ VPDX RETURN
VPDA VFD 42/7LERROR**,18/0
VPDB CON 0 ARCHIVE FILE EOR STATUS
TITLE GENERAL SUBROUTINES.
APR SPACE 4,15
** APR - ABORT PROCESSOR.
*
* ENTRY CONTROL POINT OR PROGRAM FATAL ERROR DETECTED.
*
* EXIT FILES RETURNED (*PFRES*).
* UNPROCESSED STAGE REQUESTS FOR THIS VSN REQUEUED
* (*PFRES).
*
* USES X - 1.
* A - 1.
*
* CALLS CAR, RUR, /MTX/TCM.
*
* MACROS RETURN.
APR SUBR 0 ENTRY/EXIT
SA1 /COMSPFS/UTLC
SX1 X1-/COMSPFS/RSUT
NZ X1,APRX IF NOT *PFRES*
* PROCESS *PFRES* ABORT. GET ANY ADDITIONAL STAGE REQUESTS FOR
* THIS VSN FROM *MAGNET*, THEN TERMINATE CONNECTION AND REQUEUE
* UNPROCESSED REQUESTS.
APR1 RJ CAR GET ADDITIONAL REQUESTS FOR THIS VSN
GT B6,B0,APR1 IF ADDITIONAL REQUEST FOUND
RJ /MTX/TCM TERMINATE CONNECTION WITH *MAGNET*
RJ RUR REQUEUE UNPROCESSED STAGE REQUESTS
RETURN F,R RETURN LOCAL FILE
RETURN T,R RETURN TAPE
SA1 SRFF
ZR X1,APRX IF STAGE REQUEST FILE NOT ATTACHED
RETURN R,R RETURN STAGE REQUEST FILE
EQ APRX RETURN
ALD SPACE 4,15
** ALD - ASSIGN LOCAL FILE DEVICE.
*
* ENTRY (CATH) = PFC ENTRY.
* (SYSS) = SYSTEM SECURITY MODE.
*
* EXIT (X6) = 0, IF DEVICE FOUND FOR FILE.
*
* USES X - 0, 1, 6.
* A - 1.
*
* CALLS SAF.
*
* MACROS RECALL, REQUEST, SETFET.
ALD SUBR ENTRY/EXIT
RECALL F
SX6 B0+ SET NO ERROR
SA1 SYSS
ZR X1,ALDX IF NOT SECURED SYSTEM
RJ SAF SET ACCESS LEVEL IN FET
SETFET F,ERP=E,DTY==2RMS SET ERROR PROCESSING, DEVICE TYPE
REQUEST F,U,N
SETFET F,ERP=0 CLEAR ERROR PROCESSING
SA1 F RETURN ERROR STATUS
LX1 -10
MX0 -8
BX6 -X0*X1
EQ ALDX RETURN
APD SPACE 4,15
** APD - ASSIGN PERMANENT FILE DEVICE.
*
* ENTRY (CATH) = PFC ENTRY.
* (SYSS) = SYSTEM SECURITY MODE.
*
* EXIT (X6) = 0, IF DEVICE FOUND FOR FILE.
*
* USES X - 0, 1, 6.
* A - 1.
*
* CALLS SAF.
*
* MACROS ASSIGNPF, RECALL, SETFET.
APD SUBR ENTRY/EXIT
RECALL F
SA1 SYSS
ZR X1,APD1 IF NOT SECURED SYSTEM
RJ SAF SET ACCESS LEVEL IN FET
APD1 SETFET F,ERP=UE,DTY=0 SET ERROR PROCESSING, CLEAR DEVICE TYPE
SX6 SRSY*10000B *SET SYSTEM SECTOR* SPECIAL REQUEST
SA6 F+8
ASSIGNPF F
SETFET F,ERP=0 CLEAR ERROR PROCESSING
BX6 X6-X6 CLEAR SPECIAL REQUEST
SA6 F+8
SA1 F RETURN ERROR STATUS
LX1 -10
MX0 -8
BX6 -X0*X1
EQ APDX RETURN
ARQ SPACE 4,15
** ARQ - ADD STAGE REQUEST TO QUEUE.
*
* ENTRY (B6) = FWA OF REQUEST TO ENTER.
*
* EXIT STAGE REQUEST ADDED TO QUEUE, IF NOT DUPLICATE.
* FIELD LENGTH INCREASED IF NECESSARY.
*
* USES X - 0, 1, 2, 3, 4, 6, 7.
* A - 1, 2, 3, 4, 6, 7.
* B - 5, 7.
*
* MACROS MEMORY, MOVE.
ARQ SUBR ENTRY/EXIT
SA3 SRQL
SA2 SRQF
SB7 X3+B1 VSN / SEQUENCE NUMBER WORD OF QUEUE ENTRY
SA4 B6+B1 VSN / SEQUENCE NUMBER OF NEW REQUEST
SB5 /MTX/PFTBL LENGTH OF STAGE REQUEST
MX0 -42
ARQ1 SB7 B7-B5 CHECK PREVIOUS ENTRY
NG B7,ARQ2 IF NO MORE ENTRIES
SA1 X2+B7
BX6 X1-X4
BX6 -X0*X6
NZ X6,ARQ1 IF VSN / SEQUENCE NUMBER DO NOT MATCH
EQ ARQX DUPLICATE REQUEST (IGNORE)
ARQ2 IX3 X2+X3 ADD REQUEST TO QUEUE
MOVE B5,B6,X3
SA1 SRQN UPDATE NUMBER OF ENTRIES
SX6 X1+B1
SA6 A1
SA1 SRQL UPDATE LENGTH
SX6 X1+B5
SA6 A1
SA1 SRQF CHECK REMAINING AVAILABLE MEMORY
SX6 X6+2*/MTX/PFTBL+8
IX1 X1+X6
SA2 MSTAT
AX2 30
IX3 X2-X1
PL X3,ARQX IF ENOUGH MEMORY FOR TWO MORE REQUESTS
MEMORY CM,MSTAT,R,X1+MEMI INCREASE FIELD LENGTH
EQ ARQX RETURN
CAR SPACE 4,15
** CAR - CHECK FOR ADDITIONAL STAGE REQUESTS.
*
* CALLS *GSR* IF FOUR SECONDS HAVE ELAPSED SINCE LAST CALL,
* OR IF NO MORE REQUESTS REMAIN TO BE PROCESSED.
*
* EXIT (B6) .GT. 0, IF NEW REQUEST FOUND.
* (X6) = 0, IF NO REQUESTS LEFT TO PROCESS.
*
* USES X - 1, 2, 3, 6.
* A - 1, 2, 6.
*
* CALLS ARQ, GSR.
*
* MACROS RTIME.
CAR2 SA1 NSSR RETURN NUMBER OF REQUESTS LEFT TO PROCESS
SA2 SRQN
IX6 X2-X1
CAR SUBR ENTRY/EXIT
SA1 NSSR NUMBER OF REQUESTS SELECTED
SA2 SRQN NUMBER OF ENTRIES IN TABLE
IX1 X2-X1 NUMBER OF FILES YET TO BE PROCESSED
ZR X1,CAR1 IF ALL FILES PROCESSED (IMMEDIATE CHECK)
RTIME CARA+1 GET CURRENT TIME
SA1 CARA
SA2 CARA+1
IX1 X2-X1
AX1 36
SX3 X1-4
BX6 X2
NG X3,CARX IF NOT 4 SECONDS SINCE LAST *GSR* CALL
SA6 A1 UPDATE TIME
CAR1 RJ /MTX/GSR SEE IF MORE REQUESTS
LE B6,B0,CAR2 IF NO REQUESTS
RJ ARQ ADD REQUEST
EQ CAR1 GET NEXT REQUEST
CARA BSSZ 2 ENTRY TIME VALUES
CFC SPACE 4,10
** CFC - CHECK FILES PROCESSED COUNT.
*
* EXIT TO CALLER IF NO FILE SELECTIONS OR ALL SELECTED FILES
* NOT PROCESSED.
* TO *TER* IF ALL SELECTED FILES PROCESSED.
*
* USES X - 1, 2.
* A - 1, 2.
CFC SUBR ENTRY/EXIT
SA1 /COMSPFS/FISP
SA2 /COMSPFS/NFIS
ZR X1,CFCX IF NO USER INDEX/FILE NAME SELECTIONS
NZ X2,CFCX IF ALL SPECIFIED FILES NOT PROCESSED
EQ TER TERMINATE
CLC SPACE 4,15
** CLC - CONNECT LOCAL FILE TO CATALOG ENTRY.
*
* EXIT (X6) .NE. 0, IF ERROR.
*
* USES X - 1, 5, 6.
* A - 1, 5.
*
* CALLS SRE.
*
* MACROS MESSAGE, RECALL, ROLLOUT, SETDA, SETFET, UREPLAC.
CLC7 SETFET F,ERP=0 CLEAR ERROR PROCESSING
BX6 X6-X6 INDICATE NO ERROR
CLC SUBR ENTRY/EXIT
SETFET F,ERP=UE SET *EP* AND *UP*
CLC1 SA1 CATH+FCBS
LX1 59-11
PL X1,CLC2 IF INDIRECT ACCESS FILE
SETDA F SET DISK ADDRESS FOR DIRECT ACCESS FILE
EQ CLC3 CHECK *PFM* STATUS
CLC2 UREPLAC F UTILITY-REPLACE INDIRECT ACCESS FILE
RECALL X2
CLC3 SA1 X2 CHECK FOR *PFM* ERROR
MX6 -8
LX1 -10
BX6 -X6*X1
ZR X6,CLC7 IF NO ERROR
* PFM ERROR ENCOUNTERED. IF ERROR IS THE RESULT OF SYSTEM
* ACTIVITY, DELAY AND RETRY. IF ERROR COULD BE THE RESULT
* OF THE USER MODIFYING OR DELETING THE FILE, ABANDON STAGE
* WITH NO MESSAGE. OTHERWISE, ISSUE ERROR MESSAGE AND
* ABANDON STAGE.
CLC4 SX1 X6-/ERRMSG/INA
ZR X1,CLC5 IF *INTERLOCK NOT AVAILABLE*
SX1 X6-/ERRMSG/PFA
ZR X1,CLC6 IF *PF UTILITY ACTIVE*
SX1 X6-/ERRMSG/FNF
ZR X1,CLC7 IF *FILE NOT FOUND*
SX1 X6-/ERRMSG/ICU
ZR X1,CLC7 IF *INVALID CATALOG UPDATE*
SX1 X6-/ERRMSG/PVE
ZR X1,CLC7 IF *PFC VERIFICATION ERROR*
SA5 STRA SET STAGE REQUEST ADDRESS
SB2 ERPF * PFM ERROR ENCOUNTERED ...*
RJ SRE SEND ERROR MESSAGE
MESSAGE EMBF,,R SEND *PFM* ERROR MESSAGE TO SYSTEM DAYFILE
SX6 B1 INDICATE ERROR
EQ CLCX RETURN ERROR STATUS
* PROCESS *INTERLOCK NOT AVAILABLE.*
CLC5 RECALL GIVE UP CPU
EQ CLC1 TRY AGAIN
* PROCESS *PF UTILITY ACTIVE.*
CLC6 ROLLOUT WAIT FOR UTILITY
RECALL
EQ CLC1 TRY AGAIN
CSP SPACE 4,25
** CSP - CHECK SELECTION PARAMETERS.
*
* ENTRY (X3) = CATALOG BLOCK CONTROL WORD SUB-TYPE CODE.
* (X5) = CATALOG BLOCK WORD COUNT.
*
* EXIT (X6) .NE. 0 IF FILE TO BE PROCESSED.
* CATALOG ENTRY CONVERTED TO 16 WORD FORMAT IF 8 WORD
* FORMAT.
* (FLST) = 0 IF NOT *PFC* ONLY FILE
* (FLST) = 59/0, 1/1 IF *PFC ONLY* FILE.
* (NFIS) = UPDATED FILE SELECTION COUNT.
* TO *CUP* IF PARITY ERROR ON CATALOG READ.
* TO *EAF* IF ALL SELECTED FILES PROCESSED.
*
* USES X - 1, 2, 4, 5, 6, 7.
* A - 1, 2, 5, 6, 7.
*
* CALLS CCE, CSC, PPE.
*
* MACROS READW.
CSP SUBR ENTRY/EXIT
BX6 X6-X6
NZ X3,CSP1 IF NOT *PFC ONLY* FILE
SX6 B1 SET *PFC ONLY* FILE FLAG
CSP1 SA6 FLST INITIALIZE FILE STATUS
BX6 X5 SAVE WORD COUNT
SA6 CSPA
READW TAPE,CATH,X5 READ CATALOG ENTRY
RJ PPE PROCESS PARITY ERROR
NZ X6,CUP IF PARITY ERROR ON CATALOG READ
* CHECK FORMAT OF CATALOG ENTRY.
SA5 CSPA RESTORE WORD COUNT
SX1 X5-NWCE
ZR X1,CSP2 IF CORRECT SIZE CATALOG ENTRY
SX4 CATH
RJ CCE CONVERT CATALOG ENTRY TO 16 WORD FORMAT
* CHECK SELECTIVE PARAMETERS.
CSP2 SA5 MXDC
SA1 CATH+FCUI
ZR X5,CSP3 IF NO DEVICE POSITION INFORMATON
MX2 -3
BX2 -X2*X1 SUBFAMILY INDEX
SA2 SFDT+X2
LX1 -3
SX6 X2+ CATALOG TRACK MASK
BX2 -X6*X2 ARCHIVE FILE DEVICE ORDINAL
BX1 X6*X1 CATALOG TRACK
BX6 X2+X1
IX6 X5-X6
NG X6,EAF IF BEYOND HIGHEST SELECTED USER INDEX
CSP3 SB4 CATH SET CATALOG ADDRESS
RJ CSC CHECK SELECTION CRITERIA
ZR X6,CSPX IF FILE NOT TO BE PROCESSED
ZR B6,CSPX IF FILE NAME NOT FOUND
SA1 B6+ READ FILE NAME SELECTION
SA2 /COMSPFS/NFIS
SX7 B1
LX7 17-0
BX7 X1+X7 MARK FILE NAME FOUND
SA7 A1
SX7 X2-1 DECREMENT SELECTION COUNT
SA7 A2+
EQ CSPX RETURN
CSPA BSS 1 SAVE AREA FOR WORD COUNT
CSR SPACE 4,15
** CSR - CHECK FOR STAGE REQUEST FOR THIS FILE.
*
* ENTRY (CATH) = CATALOG ENTRY FOR CURRENT FILE ON TAPE.
*
* EXIT (X6) = 0, IF NO STAGE REQUEST FOUND FOR THIS FILE.
* (X6) = (STRA) = ADDRESS OF STAGE REQUEST, IF FOUND.
* (NSSR) INCREMENTED IF STAGE REQUEST FOUND.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 3, 6.
* B - 4, 5.
CSR SUBR ENTRY/EXIT
SA1 SRQF
SA2 SRQL
SA3 CATH+FCTV VSN / SEQUENCE NUMBER OF FILE ON TAPE
SB4 X1
SB5 X2
MX0 -42
BX6 X6-X6
CSR1 SB5 B5-/MTX/PFTBL CHECK PREVIOUS ENTRY
NG B5,CSRX IF ALL ENTRIES CHECKED
SA1 B4+B5
ZR X1,CSR1 IF ENTRY ALREADY PROCESSED
SA2 A1+B1 VSN / SEQUENCE NUMBER FROM STAGE REQUEST
NG X2,CSR1 IF ENTRY ALREADY SELECTED
BX7 X2-X3
BX7 -X0*X7
NZ X7,CSR1 IF NOT A MATCH
MX7 1 SET *ENTRY ALREADY SELECTED* FLAG
BX7 X2+X7
SA7 A2
SA2 NSSR INCREMENT NUMBER OF REQUESTS SELECTED
SX7 X2+B1
SA7 A2
SX6 A1 SAVE ADDRESS OF STAGE REQUEST
SA6 STRA
EQ CSRX RETURN
IFM SPACE 4,10
** IFM - ISSUE FILE COUNT MESSAGES.
*
* EXIT FILE COUNT MESSAGES ISSUED TO DAYFILE.
*
* USES X - 1, 5, 6.
* A - 1, 5.
*
* CALLS IFC.
IFM SUBR ENTRY/EXIT
SA1 /COMSPFS/UTLC
SA5 IFMC
SX6 X1-/COMSPFS/RSUT
ZR X6,IFM1 IF *PFRES*
SA5 IFMB
SX6 X1-/COMSPFS/COUT
ZR X6,IFM1 IF *PFCOPY*
SA5 IFMA
IFM1 RJ IFC ISSUE FILE COUNT MESSAGES
EQ IFMX RETURN
IFMA BSS 0 *PFATC* MESSAGE TABLE
VFD 1/1,1/1,22/0,18/MSFA,18/PRFC
CON 0 END OF TABLE
IFMB BSS 0 *PFCOPY* MESSAGE TABLE
VFD 1/1,1/1,22/0,18/MSFO,18/PRFC
CON 0 END OF TABLE
IFMC BSS 0 *PFRES* MESSAGE TABLE
VFD 1/1,1/1,22/0,18/MSFR,18/PRFC
CON 0 END OF TABLE
ISM SPACE 4,20
** ISM - ISSUE STATISTICAL MESSAGE.
*
* ENTRY (X5) = FWA OF STAGE REQUEST.
* (B5) = NEGATIVE ADDRESS OF MESSAGE TEMPLATE.
*
* EXIT MESSAGE ISSUED TO ACCOUNT FILE.
*
* USES X - 0, 1, 6.
* A - 1.
* B - 2, 3, 5.
*
* CALLS CDD, COD, SNM.
*
* MACROS MESSAGE.
ISM SUBR ENTRY/EXIT
SA1 X5+2 GET PERMANENT FILE NAME
MX0 42
BX1 X0*X1
SB3 ISMB
SB2 1R#
RJ SNM SET PERMANENT FILE NAME INTO MESSAGE
SA1 X5+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 SPACES
SB5 ISMB
SB2 1R$
RJ SNM SET USER INDEX INTO MESSAGE
SA1 X5+4 GET FAMILY/PACK NAME
BX1 X0*X1
SB2 1R&
RJ SNM SET FAMILY/PACK NAME INTO MESSAGE
SA1 SVSN GET VSN
SB2 1R-
RJ SNM SET VSN INTO MESSAGE
SA1 X5+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,R ISSUE STATISTICAL MESSAGE TO ACCOUNT FILE
EQ ISMX RETURN
ISMA DATA C*STES, #######, $$$$$$, &&&&&&&, ------, =.*
* DATA C*STES, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
ISMAL EQU *-ISMA LENGTH OF MESSAGE
ISMB BSS ISMAL MESSAGE ASSEMBLY BUFFER
ISMC DATA C*STAS, #######, $$$$$$, &&&&&&&, ------, =.*
* DATA C*STAS, FILENAM, USERIN, FAMPACK, VSNVSN, R.*
ERRNZ *-ISMC-ISMAL MESSAGE TEMPLATES MUST BE SAME LENGTH
PPE SPACE 4,20
** PPE - PROCESS PARITY ERROR.
*
* ENTRY WHENEVER INPUT FILE IS READ.
* (STRA) = ADDRESS OF STAGE REQUEST, IF STAGING FILE.
*
* EXIT (X6) = NON-ZERO, IF PARITY ERROR.
*
* USES X - 1, 3, 5, 6.
* A - 1, 3, 5, 6.
*
* CALLS SFE, SRE, STE.
PPE SUBR ENTRY/EXIT
BX6 X6-X6
SA3 TAPE
LX3 59-11
PL X3,PPEX IF NO ERROR
SA1 FPRF
ZR X1,PPE2 IF NO FILE BEING PROCESSED
SA1 /COMSPFS/UTLC
SX1 X1-/COMSPFS/RSUT
ZR X1,PPE1 IF *PFRES*
SA1 CATH+FCUI
SB2 ERAR * ARCHIVE FILE READ ERROR ...*
RJ SFE SEND ERROR MESSAGE
EQ PPE2 SKIP TAPE ERROR
PPE1 SA5 STRA SET STAGE REQUEST ADDRESS
SB2 ERRR * ARCHIVE FILE READ ERROR ...*
RJ SRE SEND ERROR MESSAGE
SA1 STRA
SA1 X1+7 SET *SELECT BACKUP VSN* BIT
SX6 B1
LX6 39-0
BX6 X1+X6
SA6 A1
PPE2 RJ STE SKIP TAPE ERROR
SX6 B1
EQ PPEX RETURN
RIP SPACE 4,10
** RIP - REPRIEVE INTERRUPT PROCESSOR.
*
* EXIT BUSY FETS SET COMPLETE TO ALLOW TERMINATION
* PROCESSING.
*
* MACROS COMPFET.
RIP SUBR ENTRY/EXIT
SA1 /COMSPFS/UTLC
SX1 X1-/COMSPFS/RSUT
ZR X1,RIP1 IF *PFRES*
COMPFET (O,SU)
EQ RIPX RETURN
RIP1 COMPFET (F,T,R)
EQ RIPX RETURN
RUR SPACE 4,20
** RUR - REQUEUE UNPROCESSED STAGE REQUESTS.
*
* EXIT UNPROCESSED STAGE REQUESTS REQUEUED.
* STAGE REQUESTS AT RETRY LIMIT ABANDONED, WITH
* ACCOUNT FILE AND DAYFILE/ERRLOG MESSAGES ISSUED.
*
* USES X - 1, 2, 5, 6, 7.
* A - 1, 2, 6.
* B - 5.
*
* CALLS ISM, /MTX/RSR, SEM.
RUR SUBR ENTRY/EXIT
SA1 SRQL SET UP INDEX
BX6 X1
SA6 RURA
RUR1 SA1 RURA CHECK PREVIOUS ENTRY
SX6 X1-/MTX/PFTBL
SA6 A1
NG X6,RURX IF NO MORE ENTRIES TO CHECK
SA2 SRQF
IX2 X2+X6
SA1 X2 GET ENTRY
ZR X1,RUR1 IF ENTRY NOT UNPROCESSED
SA2 A1+B1 CLEAR *REQUEST SELECTED* FLAG IN ENTRY
MX6 -59
BX6 -X6*X2
SA6 A2
SA2 A1+7 CHECK RETRY COUNT
MX6 -3
LX2 -36
BX6 -X6*X2
SX7 X6-/MTX/SRRM
NG X7,RUR2 IF MORE RETRIES ALLOWED
SB5 -ISMC ISSUE *STAS* MESSAGE TO ACCOUNT FILE
SX5 A1 SET STAGE REQUEST ADDRESS
RJ ISM
SB2 ERSA * STAGE ABANDONED ...*
RJ SRE SEND ERROR MESSAGE
EQ RUR1 CHECK NEXT QUEUE ENTRY
RUR2 SX7 X6-7
ZR X7,RUR3 IF RETRY COUNT ALREADY AT MAXIMUM
SX6 B1 INCREMENT RETRY COUNT
IX6 X2+X6
LX6 36
SA6 A2
RUR3 RJ /MTX/RSR REQUEUE STAGE REQUEST
EQ RUR1 CHECK NEXT QUEUE ENTRY
RURA CON 0 INDEX OF CURRENT ENTRY
SAF SPACE 4,10
** SAF - SET ACCESS LEVEL IN FET.
*
* ENTRY (CATH) = CATALOG ENTRY FOR FILE (FROM TAPE).
* (STRA) = ADDRESS OF STAGE REQUEST FOR FILE (*PFRES*).
*
* EXIT ACCESS LEVEL SET IN FET.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
SAF SUBR ENTRY/EXIT
SA2 CATH+FCAL GET ACCESS LEVEL FROM CATALOG ENTRY
SA1 /COMSPFS/UTLC CHECK UTILITY CODE
SX1 X1-/COMSPFS/RSUT
NZ X1,SAF1 IF NOT *PFRES*
SA1 STRA GET ACCESS LEVEL FROM STAGE REQUEST
SA2 X1
LX2 36-51
SAF1 MX0 -3
LX0 36
BX2 -X0*X2 FILE ACCESS LEVEL
SA1 F+4
BX1 X0*X1
BX6 X1+X2 SET ACCESS LEVEL IN FET
SA6 A1
EQ SAFX RETURN
SER SPACE 4,10
** SER - SKIP TO EOR.
*
* EXIT ARCHIVE FILE POSITIONED AT PHYSICAL EOR.
*
* CALLS PPE, RCW.
*
* MACROS SKIPW.
SER SUBR ENTRY/EXIT
SER1 RJ RCW READ CONTROL WORD
NG X3,SERX IF EOR
ZR X5,SER1 IF ZERO WORD COUNT
SKIPW TAPE,X5 SKIP WORDS
RJ PPE PROCESS PARITY ERROR
ZR X6,SER1 IF NO ERROR
EQ SERX
SRE SPACE 4,15
** SRE - SEND STAGE REQUEST ERROR MESSAGE.
*
* ENTRY (X5) = STAGE REQUEST ADDRESS.
* (B2) = ERROR MESSAGE SKELETON ADDRESS.
*
* EXIT MESSAGE ISSUED.
*
* USES X - 1, 6.
* A - 1.
* B - 2, 5.
*
* CALLS SEM, SFU, SNM.
SRE SUBR ENTRY/EXIT
SA1 X5+2 GET FILE NAME AND USER INDEX
RJ SFU SET FILE NAME AND USER INDEX IN MESSAGE
SA1 X5+4
MX6 42
BX1 X6*X1 FAMILY NAME
SB2 1R+
SB5 MSGB
RJ SNM SET FAMILY NAME IN MESSAGE
SB2 MSGB SET MESSAGE ADDRESS
RJ SEM SEND ERROR MESSAGE
EQ SREX RETURN
SSR SPACE 4,10
** SSR - SETUP *PFM* SPECIAL REQUEST BLOCK.
*
* ENTRY (STRA) = ADDRESS OF STAGE REQUEST ENTRY.
*
* EXIT *PFM* SPECIAL REQUEST BLOCK BUILT.
*
* USES X - 1, 3, 6, 7.
* A - 1, 3, 6.
SSR SUBR ENTRY/EXIT
SA3 STRA GET STAGE REQUEST
SA1 X3 SET PEO, DN, TRACK AND SECTOR
MX6 -32
BX6 -X6*X1
SA6 SRB+0
SA1 A1+B1 SET ALTERNATE STORAGE INFORMATION
MX6 -42
SX7 B1
BX6 -X6*X1
LX7 42-0 SET TAPE ALTERNATE STORAGE BIT
BX6 X6+X7
SA6 A6+B1
SA1 X3+5 SET CREATION DATE AND TIME
MX6 -36
BX6 -X6*X1
SA6 A6+B1
SA1 A1-B1 SET FAMILY AND USER INDEX
MX7 42
BX6 X7*X1
SA1 X3+2
BX7 -X7*X1
BX6 X6+X7
SA6 A6+B1
EQ SSRX RETURN
STE SPACE 4,10
** STE - SKIP TAPE ERROR.
*
* ENTRY PARITY ERROR ENCOUNTERED.
*
* EXIT EOR DETECTED.
* TO *EAF* IF EOF DETECTED.
*
* MACROS READ, READW, RECALL.
STE SUBR ENTRY/EXIT
STE1 RECALL TAPE
READW TAPE,DBUF,DBUFL
NG X1,EAF IF EOF ENCOUNTERED
ZR X1,STE1 IF NOT EOR
READ TAPE,R
EQ STEX RETURN
VCE SPACE 4,15
** VCE - VERIFY CATALOG ENTRY FIELDS.
*
* ENTRY (STRA) = ADDRESS OF STAGE REQUEST ENTRY.
* (CATH) = CATALOG ENTRY FROM TAPE.
*
* EXIT (X6) = 0, IF STAGE REQUEST MATCHES PFC ON TAPE.
*
* USES X - 1, 2, 5, 6.
* A - 1, 2, 5, 6.
*
* CALLS SRE.
VCE SUBR ENTRY/EXIT
SA1 STRA GET STAGE REQUEST ADDRESS
SA1 X1+5 VERIFY CREATION DATE AND TIME
SA2 CATH+FCCD
BX1 X1-X2
MX2 -36
BX6 -X2*X1
ZR X6,VCEX IF CREATION DATE AND TIME MATCHES
SA5 STRA SET STAGE REQUEST ADDRESS
SB2 ERFV * FILE VERIFICATION ERROR ...*
RJ SRE SEND STAGE REQUEST ERROR MESSAGE
SX6 B1 INDICATE ERROR
EQ VCEX RETURN
SPACE 4,10
* COMMON DECKS.
FCE$ EQU 0
*CALL COMCCCE
*CALL COMCCDD
*CALL COMCCIO
*CALL COMCCOD
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCEDT
*CALL COMCFCE
GMS$ EQU 1 USE SORT KEY MASK
MWK$ EQU 1 ALLOW MULTIPLE WORD SORT KEYS
*CALL COMCGMS
*CALL COMCJCR
*CALL COMCLFM
*CALL COMCMSF
*CALL COMCMVE
*CALL COMCPFM
COM$ EQU 1 ASSEMBLE COMMON ROUTINES
PFA$ EQU 1 ASSEMBLE ARCHIVE FILE ROUTINES
LIST X
*CALL COMCPFS
LIST *
*CALL COMCPFU
*CALL COMCRDW
*CALL COMCSCB
*CALL COMCSFN
*CALL COMCSKW
*CALL COMCSNM
*CALL COMCSYS
LIST X
QUAL MTX
QUAL$ EQU 1
*CALL COMCSRI
QUAL *
LIST *
*CALL COMCVDT
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTO
*CALL COMCWTW
*CALL COMCZTB
TITLE BUFFERS.
USE LITERALS
SPACE 4,10
* BUFFERS.
MBUF EQU * MAIN BUFFER
CATH EQU MBUF+MBUFL CATALOG ENTRY HOLD BUFFER
DBUF EQU CATH+CATHL ARCHIVE DATA BLOCK WORKING BUFFER
TBUF EQU DBUF+DBUFL ARCHIVE FILE BUFFER
OUTB EQU TBUF+TBUFL OUTPUT FILE BUFFER
SUMB EQU OUTB+OUTBL SUMMARY FILE BUFFER
PFLB EQU SUMB+SUMBL PROCESSED FILES FILE BUFFER
MS1B EQU PFLB+PFLBL SORT FILE 1
MS2B EQU MS1B+MSFBL SORT FILE 2
MS3B EQU MS2B+MSFBL SORT FILE 3
MS4B EQU MS3B+MSFBL SORT FILE 4
SRTB EQU MS3B SORT BUFFER (OVERLAYS *MS3B* AND *MS4B*)
ERRNG MSFBL*2-SRTBL SORT BUFFER OVERFLOW
EBUF EQU MS4B+MSFBL+5 END OF BUFFERS
* *PFRES* BUFFERS OVERLAY BUFFERS FROM *SUMB* TO *SRTB*.
RBUF EQU SUMB STAGE REQUEST FILE BUFFER (*PFRES* PRESET)
SBUF EQU RBUF+RBUFL SCRATCH FILE BUFFER (*PFRES* PRESET)
QBUF EQU SBUF+SBUFL STAGE REQUEST QUEUE (*PFRES* PRESET)
EBUFP EQU QBUF+QBUFL END OF BUFFERS (*PFRES* PRESET)
TITLE PRESET.
PRS SPACE 4,20
** PRS - PRESET PROGRAM.
*
* ENTRY FILES *ZZZZZG0* THROUGH *ZZZZZG8* RETURNED BY *PFS*.
* FILE *ZZZZZG9* RETURNED BY *PFS* IF NO FILE
* SELECTIONS.
* FILE *ZZZZZG9* CONTAINS FILE SELECTIONS IF PRESENT.
*
* EXIT FILE NAMES SET IN FETS.
* SECURITY PROCESSING BIT SET IN FET, IF NEEDED.
* (SYSS) = SYSTEM SECURITY MODE.
*
* USES X - 0, 1, 2, 5, 6.
* A - 0, 1, 2, 5, 6.
*
* CALLS FSR, IOF, ITA, PFO, RPS, RST, SSS.
*
* MACROS MACHID, MEMORY, REPRIEVE, SETFET.
PRS SUBR ENTRY/EXIT
SB1 1
MEMORY CM,,R,EBUF REQUEST REQUIRED MEMORY
REPRIEVE RPVB,SET,277B
RJ SSS SET SECURED SYSTEM STATUS
SA1 SYSS
ZR X1,PRS1 IF NOT SECURED SYSTEM
SA1 F+1 SET SECURITY PROCESSING BIT IN FET
SX6 B1
LX6 39-0
BX6 X1+X6
SA6 A1
* SET UTILITY NAME IN MESSAGES.
PRS1 SA1 /COMSPFS/UTLC CHECK UTILITY CODE
SX1 X1-/COMSPFS/RSUT
NZ X1,PRS2 IF NOT *PFRES*
* PROCESS *PFRES*.
MEMORY CM,MSTAT,R,EBUFP REQUEST ADDITIONAL MEMORY
MACHID PRSA GET MACHINE ID
SA1 PRSA
SA2 R SET MACHINE ID INTO *STRQID* FET
LX1 24
BX6 X1+X2
SA6 A2
RJ RST REQUEST STAGING TAPE
RJ FSR FIND STAGE REQUESTS
RJ ITA ISSUE TAPE ASSIGNED MESSAGE
EQ PRSX RETURN
* INITIALIZE OUTPUT FILE AND SUMMARY FILE.
PRS2 RJ IOF INITIALIZE OUTPUT FILES
* INITIALIZE ARCHIVE FILE.
SA1 CPAR+/COMSPFS/CPTB SET ARCHIVE FILE NAME
SA2 TAPE
MX6 -18
BX6 -X6*X2
BX6 X6+X1
SA6 A2
SX2 TAPE SET OPTICAL DISK EXTENSION BUFFER
SA3 PRSB
RJ SOE SET FET EXTENSION IF OPTICAL DISK FILE
OPEN TAPE,READNR,R
* INITIALIZE *PFCOPY* MASTER FILE.
SA1 CPAR+/COMSPFS/CPMF CHECK IF MASTER FILE SPECIFIED
ZR X1,PRS3 IF MASTER FILE NOT SPECIFIED
SA5 FILEA
RJ PFO OPEN MASTER FILE
SETFET SU,ERP=0 CLEAR USER ERROR PROCESSING
* READ FILE NAME AND USER INDEX SELECTIONS.
PRS3 SX0 EBUF SET SELECTION BUFFER ADDRESS
RJ RPS READ PERMANENT FILE SELECTIONS
EQ PRSX RETURN
PRSA CON 0 MACHINE ID WORD
PRSB VFD 36/,6/ODEBL,18/ODEB POINTER TO *OD* EXT. BUFFER
TITLE PRESET SUBROUTINES.
FSR SPACE 4,20
** FSR - FIND STAGE REQUESTS.
* READ STAGE REQUESTS FROM REQUEST FILE AND REPACK FILE.
* READ ADDITIONAL STAGE REQUESTS FROM *MAGNET*-S FL.
*
* ENTRY STAGE REQUEST FILE ATTACHED (BY *RESEX*).
*
* EXIT STAGE REQUESTS QUEUED IN *QBUF*.
* SELECTED REQUESTS DELETED FROM STAGE REQUEST FILE.
* STAGE REQUEST FILE RETURNED.
* TO *ABT* IF NO STAGE REQUESTS FOR ASSIGNED VSN.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 5, 6.
* B - 2, 6.
*
* CALLS ARQ, GSR.
*
* MACROS MEMORY, MESSAGE, MOVE, READEI, READW, REWIND, RTIME,
* UNLOAD, WRITE, WRITER, WRITEW.
FSR SUBR ENTRY/EXIT
REWIND R
READEI X2 INITIATE READ
WRITE S,*
SA5 PVSN GET VSN ASSIGNED TO THIS JOB
* READ NEXT ENTRY FROM REQUEST FILE.
FSR1 READW R,FSRA,/MTX/PFTBL
NZ X1,FSR3 IF END OF REQUEST FILE
SA1 FSRA CHECK FUNCTION CODE
AX1 54
SX1 X1-1
NZ X1,FSR1.1 IF NOT TAPE STAGE REQUEST
SA1 FSRA+1 COMPARE VSN REQUIRED
BX2 X1-X5
MX0 -24
BX2 -X0*X2
ZR X2,FSR2 IF VSN MATCHES VSN ASSIGNED TO THIS JOB
FSR1.1 WRITEW S,FSRA,/MTX/PFTBL WRITE UNSELECTED REQ TO SCRATCH
EQ FSR1 READ NEXT REQUEST
FSR2 SB6 FSRA
RJ ARQ ADD REQUEST TO QUEUE
EQ FSR1 READ NEXT REQUEST
* COPY SCRATCH FILE (UNSELECTED REQUESTS) BACK TO REQUEST FILE.
FSR3 WRITER S FLUSH BUFFER
REWIND X2
READEI X2
REWIND R,R
WRITE X2,*
FSR4 READW S,FSRA,/MTX/PFTBL
NZ X1,FSR5 IF END OF FILE
WRITEW R,FSRA,/MTX/PFTBL
EQ FSR4 COPY NEXT REQUEST
FSR5 WRITER R FLUSH BUFFER
UNLOAD X2,R RETURN BOTH FILES
UNLOAD S,R
BX6 X6-X6 INDICATE STAGE REQUEST FILE RETURNED
SA6 SRFF
* MOVE REQUEST QUEUE DOWN (ON TOP OF *RBUF*/*SBUF*).
SA5 SRQL GET NUMBER OF WORDS IN CURRENT QUEUE
ZR X5,FSR6 IF NO REQUESTS
MOVE X5,QBUF,RBUF
FSR6 SX6 RBUF UPDATE QUEUE POINTER
SA6 SRQF
* PROCESS REQUESTS PENDING IN *MAGNET*.
FSR7 RJ /MTX/GSR GET STAGE REQUEST
LE B6,B0,FSR8 IF NO REQUEST
RJ ARQ ADD REQUEST TO QUEUE
EQ FSR7 GET NEXT REQUEST
FSR8 RTIME CARA INITIALIZE STARTING TIME
SA1 SRQL CHECK IF ANY REQUESTS FOUND
ZR X1,FSR9 IF NO REQUESTS FOUND
MEMORY CM,MSTAT,R,RBUF+X1+MEMI REDUCE FIELD LENGTH
EQ FSRX RETURN
FSR9 SB2 ERNR * NO FILES TO RESTORE.*
EQ ABT ABORT
FSRA BSS /MTX/PFTBL STAGE REQUEST BUFFER
ITA SPACE 4,15
** ITA - ISSUE TAPE ASSIGNED MESSAGE.
*
* ENTRY (SRQF) = POINTER TO FWA OF STAGE REQUEST QUEUE.
* (SRQN) = NUMBER OF RESTORE REQUESTS.
* (SVSN) = STAGING TAPE VSN.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2.
* B - 2, 3, 5.
*
* CALLS CDD, SNM.
*
* MACROS MESSAGE.
ITA SUBR ENTRY/EXIT
MX0 42
SB3 ITAB
SB5 -ITAA
SA1 SRQF
SA2 X1+4 GET FAMILY/PACK NAME
BX1 X0*X2
SB2 1R$
RJ SNM SET FAMILY/PACK NAME INTO MESSAGE
SA1 SVSN GET VSN
SB5 ITAB
SB2 1R-
RJ SNM SET VSN INTO MESSAGE
SA1 SRQN GET NUMBER OF ENTRIES IN REQUEST QUEUE
RJ CDD CONVERT TO DECIMAL DISPLAY
MX0 -24 MASK TO FOUR DIGITS
BX1 -X0*X6
LX1 -24 LEFT JUSTIFY
SB2 1R=
RJ SNM SET NUMBER OF ENTRIES INTO MESSAGE
MESSAGE ITAB,5 ISSUE STAGING TAPE ASSIGNED MESSAGE
EQ ITAX RETURN
ITAA DATA C*STTA, $$$$$$$, ------, ====.*
* DATA C*STTA, FAMPACK, VSNVSN, NNNN.*
ITAAL EQU *-ITAA LENGTH OF MESSAGE
ITAB BSS ITAAL MESSAGE ASSEMBLY BUFFER
RST SPACE 4,20
** RST - REQUEST STAGING TAPE.
*
* EXIT STAGING TAPE ASSIGNED.
* (SVSN) = VSN OF STAGING TAPE.
* (PVSN) = PACKED VSN OF STAGING TAPE.
* STAGE REQUEST FILE ATTACHED (BY *RESEX*).
* TO *ABT* IF IMPROPER TAPE ASSIGNED.
*
* USES X - 0, 1, 2, 5, 6, 7
* A - 1, 2, 6.
* B - 2, 5, 6, 7.
*
* CALLS DXB, SNM.
*
* MACROS FILINFO, LABEL, MOVE, UNLOAD.
RST SUBR ENTRY/EXIT
SA1 TAPE SET FILE NAME IN *FILINFO* BLOCK
SA2 RSTA
MX7 42
BX1 X7*X1
BX2 -X7*X2
BX6 X1+X2
SA6 RSTA
UNLOAD TAPE,R
MOVE 5,TAPE,RSTB COPY FET FIELDS
LABEL RSTB REQUEST STAGING TAPE
FILINFO RSTA
SA1 RSTA+1 CHECK TAPE FILE FLAG
LX1 59-24
NG X1,RST1 IF TAPE FILE
SB2 ERNT * STAGING TAPE NOT ASSIGNED.*
EQ ABT ABORT
RST1 SA1 RSTA+5 GET VSN OF TAPE
MX0 36
BX6 X0*X1
SA6 SVSN SAVE VSN
LX0 6
BX0 -X0*X6 VERIFY SIX CHARACTER VSN
NZ X0,RST3 IF SIX CHARACTER VSN
RST2 SA1 SVSN SET VSN IN DAYFILE MESSAGE
SB2 1R$
SB5 ERVE
RJ SNM
SB2 ERVE * STAGING TAPE VSN ERROR. VSN = $.*
EQ ABT ABORT
RST3 SA1 SVSN BUILD PACKED VSN
MX5 24
LX1 12
SB7 B1 SET DECIMAL CONVERSION
BX5 X5*X1
RJ DXB CONVERT VSN SUFFIX TO BINARY
NZ X4,RST2 IF ERROR IN CONVERSION (NOT PROPER VSN)
SX7 X6-5000
NG X7,RST5 IF NOT BACKUP VSN
SX6 X7 USE PRIMARY VSN FOR COMPARISON PURPOSES
RST5 SA1 SVSN GET VSN PREFIX
MX2 12
BX1 X2*X1
LX1 -36
BX6 X1+X6
SA6 PVSN SAVE PACKED VSN
EQ RSTX RETURN
RSTA VFD 42/0,6/6,12/1 *FILINFO* BLOCK
BSSZ 4
VFD 54/,6/4
RSTB FILEB TBUF,TBUFL,FET=16B FET FOR *LABEL*
ORG RSTB+10B PO=R,LB=KL,NO UNLOAD
VFD 6/20B,3/0,3/0,12/50B,6/0,6/0,24/0
BSSZ RSTB+16B-*
SPACE 4,10
* PRESET DATA LOCATIONS.
R BSS 0 STAGE REQUEST FILE
STRQ FILEB RBUF,RBUFL,FET=6
S BSS 0 SCRATCH STAGE REQUEST FILE
ZZZZZG4 FILEB SBUF,SBUFL,FET=6
SPACE 4,10
* PRESET COMMON DECKS.
LIST X
*CALL COMCPFP
LIST *
*CALL COMCSOE
SPACE 4,10
ERRPL *-TBUF-1 PRESET OVERFLOWS INTO BUFFERS
SPACE 4,10
END