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