PROC BFLUSH((QRADR),ERSTAT); # TITLE BFLUSH - FLUSHES THE I/O BUFFER. # BEGIN # BFLUSH # # ** BFLUSH - FLUSHES THE I/O BUFFER. * * *BFLUSH* FLUSHES THE *FCT* I/O BUFFER AND CLEARS THE BUFFER * MODIFIED FLAG IF THE DATA IN THE BUFFER HAS BEEN MODIFIED. * * BFLUSH - IS CALLED BY CBUFMAN,CEXTSC,CFLUSH,CRELSLK,CRMUSC. * * BFLUSH - IS CALLED BY CBUFMAN,CEXTSC,CFLUSH,CRELSLK, * CRMVSC,ASVAL,VLAMSF,VLAPFC,VLBICT,VLBLDVT, * VLCFS,VLFIX,VLNCS,VLSCH,VLSUBFM,VLWFIX. * * PROC BFLUSH((QRADR),ERSTAT) * * ENTRY (QRADR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT (ERSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMACMS*) * = NO ERRORS. * = *CIO* ERROR. * THE I/O BUFFER HAS BEEN FLUSHED IF NECESSARY AND THE * BUFFER MODIFIED FLAG CLEARED. # ITEM QRADR U; # *HLRQ* ENTRY ADDRESS # ITEM ERSTAT I; # ERROR STATUS # # **** PROC BFLUSH - XREF LIST BEGIN. # XREF BEGIN PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC REWRITE; # REWRITE DATA FROM IO BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC BFLUSH - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMSPFM ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; ORD = FB$ORD[0]; IF FB$BMF[0] THEN BEGIN # BUFFER MODIFIED # # * WRITE OUT BUFFER. # FB$BMF[0] = FALSE; # CLEAR BUFFER MODIFIED FLAG # ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL); FET$EP[0] = TRUE; FET$IN[0] = FET$FRST[0] + OCT$BUFL[ORD] - 1; FET$R[0] = TRUE; FET$RR[0] = FB$PRUNUM[0]; REWRITE(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(OCT$FAM[ORD],OCT$SUBF[ORD],QRADR,ERSTAT,FETSET[0]); RETURN; END END # BUFFER MODIFIED # IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN FB$CWRD[ORD] = 0; # CLEAR BUFFER CONTROL WORD # END RETURN; END # BFLUSH # TERM PROC CADDSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT); # TITLE CADDSC - ADD SUBCATALOG. # BEGIN # CADDSC # # ** CADDSC - ADD SUBCATALOG. * * *CADDSC* EXPANDS THE CATALOG FILE WITH SPACE FOR AN ADDITIONAL * SUBCATALOG WITH THE SPECIFIED NUMBER OF *FCT* AND *AST* ENTRIES. * THE CATALOG MUST BE OPEN IN MODIFY MODE. * * CADDSC - IS CALLED BY ADDCSU. * * CADDSC - IS CALLED BY ADDCSU. * * PROC CADDSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (NUM) - NUMBER OF *FCT* (AND *AST*) ENTRIES TO ADD. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE SUBCATALOG HAS BEEN ADDED AND THE CATALOG PREAMBLE * HAS BEEN UPDATED TO REFLECT THE CHANGE. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = SUBCATALOG ALREADY EXISTS. * = *CIO* ERROR. * IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN * ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED. * * NOTES THE CATALOG IS RE-ATTACHED IN WRITE MODE BEFORE ADDING * THE SUBCATALOG, (IN ORDER TO EXTEND THE CATALOG), AND * WHEN FINISHED, THE FILE IS ATTACHED IN MODIFY MODE * AGAIN. SPACE FOR A SUBCATALOG IS ALWAYS ADDED IN FULL * PRU-S, SO THAT EACH *FCT* AND *AST* BEGINS AT A PRU * BOUNDARY. HOWEVER, THE LENGTH OF THE *FCT* AND *AST* * MAINTAINED IN THE CATALOG PREAMBLE REFLECTS THE * NUMBER OF ENTRIES SPECIFIED BY (NUM). * * MESSAGES * PROGRAM ABNORMAL, CADDSC.*. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM NUM I; # NUMBER OF ENTRIES TO ADD # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CADDSC - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC BKSPRU; # BACKSPACE PHYSICAL RECORDS # PROC CDEFTF; # DEFINE TEMPORARY CATALOG # PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC MESSAGE; # ISSUE MESSAGE # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC READ; # READ FILE TO *CIO* BUFFER # PROC REPLCAT; # REPLACE MSF CATALOG # PROC REWIND; # REWIND A FILE # PROC RPHR; # READ PRU TO *CIO* BUFFER # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # PROC WPHR; # WRITE PRU FROM *CIO* BUFFER # PROC WRITE; # WRITE DATA FROM *CIO* BUFFER # PROC WRITEF; # WRITE END OF FILE # PROC WRITEW; # WRITE DATA FROM WORKING BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CADDSC - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMXMSC *CALL COMBMCT *CALL COMBPFP ITEM I I; # LOOP COUNTER # ITEM LOCAT I; # LOCATION OF NEW SUBCATALOG # ITEM NAST I; # NUMBER OF PRU-S IN *AST* # ITEM NFCT I; # NUMBER OF PRU-S IN *FCT* # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM STAT I; # ATTACH STATUS # ITEM TEMP I; # TEMPORARY STORAGE # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] NQ 0 THEN # SUBCATALOG ALREADY EXISTS # BEGIN ERRSTAT = CMASTAT"SCEXISTS"; RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END # * DEFINE TEMPORARY FILE AND COPY CATALOG TO IT. # PFP$WRD0[0] = 0; # SET FAMILY AND USER INDEX # PFP$FAM[0] = OCT$FAM[ORD]; PFP$UI[0] = DEF$UI + OCT$SUBF[ORD]; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN # FAMILY NOT FOUND # BEGIN CMA$RTN[0] = "CADDSC."; MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE # ABORT; END ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL); ZSETFET(TFETADR+RFETL,TSFMCAT,TBUFADR,TBUFL,RFETL); P = TFETADR; FET$EP[0] = TRUE; FET$EP[1] = TRUE; REWIND(FETSET[0],NRCL); CDEFTF(FETSET[1],ERRSTAT); # DEFINE TEMPORARY CATALOG FILE # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END REPEAT WHILE NOT FET$EOI[0] DO # COPY CATALOG FILE # BEGIN READ(FETSET[0],RCL); FET$IN[1] = FET$IN[0]; WRITE(FETSET[1],RCL); FET$OUT[0] = FET$OUT[1]; END WRITEF(FETSET[1],RCL); # * CALCULATE NUMBER OF PRU-S TO ADD. # NAST =(MAXORD/PRULEN)* 2 + 1; # * ALLOCATE SPACE AT END OF FILE. # FET$R[1] = TRUE; BKSPRU(FETSET[1],2,RCL); IF FET$AT[1] NQ 0 THEN BEGIN GOTO ERR; END LOCAT = FET$CRI[1]; # LOCATION OF NEW SUBCATALOG # SLOWFOR I = 1 STEP 1 UNTIL WBUFL DO BEGIN WBUF$W[I] = 0; # ZERO FILL WORKING BUFFER # END SLOWFOR I = NAST STEP -1 UNTIL 1 DO BEGIN WRITEW(FETSET[1],WBUF,WBUFL,STAT); IF STAT NQ 0 THEN # *CIO* ERROR # BEGIN GOTO ERR; END END WRITEF(FETSET[1],RCL); IF FET$AT[1] NQ 0 THEN BEGIN GOTO ERR; END # * UPDATE CATALOG PREAMBLE. # PRM$SMID[SMID ] = SMID ; PRM$ENTRC[SMID] = 0; PRM$ASTLOC[SMID] = LOCAT ; PRM$FCTLOC[SMID] = LOCAT + NAST; PRM$MXAUS[SMID] = 0; PRM$MXAUL[SMID] = 0; PRM$PDATE[SMID] = 0; FET$RR[1] = 1; # WRITE UPDATED PREAMBLE # FET$IN[1] = FET$FRST[1]; FET$OUT[1] = FET$FRST[1]; RPHR(FETSET[1],RCL); IF FET$AT[1] NQ 0 THEN BEGIN GOTO ERR; END TBUF$W[SMID +1] = PRM$SCW1[SMID]; TBUF$W1[SMID+1] = PRM$SCW2[SMID]; TBUF$W2[SMID+1] = PRM$SCW2[SMID]; FET$RR[1] = 1; FET$W[1] = TRUE; WPHR(FETSET[1],RCL); IF FET$AT[1] NQ 0 THEN BEGIN GOTO ERR; END # * REPLACE MSF CATALOG WITH NEW CATALOG (*TSFMCAT*). # REPLCAT(ORD,ERRSTAT); RETURN; ERR: # PROCESS *CIO* ERROR # CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[1]); END # CADDSC # TERM PROC CBUFMAN((FAMNM),(SUBF),(SMID),(FCTORD),(MODF), (QRADDR),ERRSTAT); # TITLE CBUFMAN - MANAGE CATALOG *FCT* BUFFER. # BEGIN # CBUFMAN # # ** CBUFMAN - MANAGE CATALOG *FCT* BUFFER. * * *CBUFMAN* ENSURES THAT THE REQUESTED FILE AND CARTRIDGE TABLE * ENTRY IS IN THE CATALOG *FCT* I/O BUFFER. THE WORD OFFSET OF THE * ENTRY WITHIN THE BUFFER IS RETURNED TO THE CALLER. * * CBUFMAN - IS CALLED BY CGETFCT,CPUTFCT. * * PROC CBUFMAN((FAMNM),(SUBF),(SMID ),(FCTORD),OFFSET,(MODF), * (QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (FCTORD) - ORDINAL OF ENTRY IN *FCT*. * (MODF) - CATALOG ATTACH MODE FLAG. * = FALSE, MODIFY MODE NOT REQUIRED. * = TRUE, MODIFY MODE IS REQUIRED. * (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. * * EXIT THE REQUESTED *FCT* ENTRY IS IN THE *FCT* I/O BUFFER. * (OFFSET) - WORD OFFSET OF ENTRY WITHIN BUFFER. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERROR. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * = *FCT* ORDINAL OUT OF RANGE. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM FCTORD I; # *FCT* ORDINAL # ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER # ITEM MODF B; # MODIFY MODE FLAG # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CBUFMAN - XREF LIST BEGIN. # XREF BEGIN PROC BFLUSH; # BUFFER FLUSH # PROC CCLOSE; # CLOSE CATALOG # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC READ; # READ FILE TO *CIO* BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CBUFMAN - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC *CALL COMSPFM ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM PRUNUM I; # PRU NUMBER # ITEM TEMP I; # TEMPORARY STORAGE ITEM # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG EXISTS # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; # RETURN ERROR STATUS # END IF FCTORD GR (PRM$ENTRC[SMID] + 15) OR FCTORD LQ 15 THEN # IF *FCT* ORDINAL BAD # BEGIN ERRSTAT = CMASTAT"ORDERR"; RETURN; # RETURN ERROR STATUS # END IF MODF AND OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END # * CALCULATE POSITION OF REQUESTED *FCT* ENTRY. * (PRUNUM) = PRU OFFSET WITHIN CATALOG. # TEMP = 16 * (FCTORD - 16); PRUNUM = PRM$FCTLOC[SMID ] + TEMP; # * ENSURE THAT REQUESTED *FCT* ENTRY IS IN I/O BUFFER. # IF PRUNUM NQ FB$PRUNUM[0] OR ORD NQ FB$ORD[0] OR PRM$SUBF[0] NQ SUBF OR PRM$FAM[0] NQ FAMNM THEN # IF ENTRY NOT IN BUFFER # BEGIN # READ ENTRY INTO BUFFER # IF PRM$SUBF[0] EQ SUBF AND PRM$FAM[0] EQ FAMNM THEN BEGIN BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END END ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL); P = FCTFADR; FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$RR[0] = PRUNUM; READ(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CCLOSE(FAMNM,SUBF,QRADDR,ERRSTAT); # CLOSE CATALOG # ERRSTAT = CMASTAT"CIOERR"; # RETURN ERROR STATUS # RETURN; END FB$ORD[0] = ORD; # SET BUFFER CONTROL WORD # FB$PRUCNT[0] = OCT$BUFL[ORD]/PRULEN; FB$PRUNUM[0] = PRUNUM; END # READ ENTRY INTO BUFFER # RETURN; END # CBUFMAN # TERM PROC CCLOSE((FAMNM),(SUBF),(QRADDR),ERRSTAT); # TITLE CCLOSE - CLOSE CATALOG. # BEGIN # CCLOSE # # ** CCLOSE - CLOSE CATALOG. * * *CCLOSE* TERMINATES CATALOG USAGE. IF THE CATALOG WAS * OPEN IN MODIFY MODE, THE UPDATED PREAMBLE IS WRITTEN * BACK TO THE CATALOG AND THE *FCT* I/O BUFFER IS FLUSHED * (IF THE DATA IN THE BUFFER WAS MODIFIED). * THE CATALOG FILE IS RETURNED AND THE *OCT* ENTRY IS CLEARED. * * CCLOSE - IS CALLED BY CBUFMAN,CPIOERR,CRDPRM,DBFLAG,DBFMAP, * DBRDFIL,DBREL,TERMCAT,USRPBAS,USRPDE,VLSUBFM. * * PROC CCLOSE((FAMNM),(SUBF),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = *CIO* ERROR. * # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CCLOSE - XREF LIST BEGIN. # XREF BEGIN PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC RETERN; # RETURN FILE TO SYSTEM # PROC REWRITE; # REWRITE DATA FROM I/O BUFFER # PROC RPHR; # READ PRU TO *CIO* BUFFER # PROC WPHR; # WRITE PRU FROM *CIO* BUFFER # PROC ZFILL; # ZERO FILLS A BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CCLOSE - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMSPFM ITEM I I; # LOOP COUNTER # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF FB$BMF[0] AND ORD EQ FB$ORD[0] THEN BEGIN # FLUSH BUFFER # ZSETFET(FCTFADR,OCT$LFN[ORD],FCTBADR,OCT$BUFL[ORD],RFETL); FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$IN[0] = FET$FRST[0] + OCT$BUFL[ORD] - 1; FET$RR[0] = FB$PRUNUM[0]; REWRITE(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN ERRSTAT = CMASTAT"CIOERR"; FET$AT[0] = 0; END FB$CWRD[0] = 0; END # FLUSH BUFFER # ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,2*PRULEN,RFETL); # * WRITE UPDATED PREAMBLE BACK TO THE CATALOG FILE. # IF OCT$ATTM[ORD] EQ "M" THEN # IF CATALOG OPEN IN MODIFY MODE # BEGIN # UPDATE CATALOG PREAMBLE # FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$RR[0] = 1; RPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN ERRSTAT = CMASTAT"CIOERR"; FET$AT[0] = 0; END P = OCT$PRMA[ORD]; FASTFOR I = 0 STEP 1 UNTIL MAXSM DO BEGIN TBUF$W[I+1] = PRM$SCW1[I]; TBUF$W1[I+1] = PRM$SCW2[I]; TBUF$W2[I+1] = PRM$SCW3[I]; END FET$RR[0] = 1; FET$W[0] = TRUE; WPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN ERRSTAT = CMASTAT"CIOERR"; FET$AT[0] = 0; END END # UPDATE CATALOG PREAMBLE # # * RETURN CATALOG FILE. # RETERN(FETSET[0],RCL); # * CLEAR ENTRY IN OPEN CATALOG TABLE. # ZFILL(OCT[ORD],OCTENTL); RETURN; END # CCLOSE # TERM PROC CDEFTF(FET,ERSTAT); # TITLE CDEFTF - DEFINE TEMPORARY CATALOG. # BEGIN # CDEFTF # # ** CDEFTF - DEFINE TEMPORARY CATALOG. * * *CDEFTF* DEFINES A FILE TO BE USED FOR CHANGING THE * SIZE OF THE MSS CATALOG. * * CDEFTF - IS CALLED BY CADDSC, CEXTSC,CRMVSC. * * * PROC CDEFTF(FET,ERSTAT) * * ENTRY FET - AN ARRAY CONTAINING THE FET FOR *TSFMCAT*. * * EXIT A FILE NAMED *TSFMCAT* HAS BEEN DEFINED. * (ERSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = *CIO* ERROR. * = FILE DEFINE ERROR. * = FILE PURGE ERROR. * * * NOTES IF THE FILE ALREADY EXISTS, IT IS PURGED AND * REDEFINED. # ARRAY FET [0:0] P(1); ; # FET FOR FILE *TSFMCAT* # ITEM ERSTAT I; # ERROR STATUS # # **** PROC CDEFTF - XREF LIST BEGIN. # XREF BEGIN PROC PFD; # PERMANENT FILE REQUEST DELAYS # PROC RETERN; # RETURN FILE TO SYSTEM # END # **** PROC CDEFTF - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMS *CALL COMBPFS *CALL COMXMSC *CALL COMSPFM CONTROL EJECT; PFD("DEFINE",TSFMCAT,0,"BR","Y","SR","MR","RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN BEGIN # DEFINE ERROR # IF PFSTAT EQ FAP THEN BEGIN # FILE ALREADY EXISTS # PFD("PURGE",TSFMCAT,"RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN # IF PURGE ERROR # BEGIN ERSTAT = CMASTAT"TPRGERR"; RETURN; END RETERN(FET[0],RCL); PFD("DEFINE",TSFMCAT,0,"BR","Y","SR","MR", "RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN # IF DEFINE ERROR # BEGIN ERSTAT = CMASTAT"TDEFERR"; RETURN; END END # FILE ALREADY EXISTS # ELSE BEGIN ERSTAT = CMASTAT"TDEFERR"; RETURN; END END # DEFINE ERROR # END # CDEFTF # TERM PROC CEXTSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT); # TITLE CEXTSC - EXTEND SUBCATALOG. # BEGIN # CEXTSC # # ** CEXTSC - EXTEND SUBCATALOG. * * *CEXTSC* EXPANDS AND REORGANIZES THE CATALOG FILE TO ACCOMODATE * AN INCREASE IN THE SIZE OF THE SUBCATALOG. THE CATALOG MUST BE * OPEN IN MODIFY MODE. * * CEXTSC - IS CALLED BY ADDCUBE. * * PROC CEXTSC((FAMNM),(SUBF),(SMID ),(NUM),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (NUM) - NUMBER OF *FCT* (AND *AST*) ENTRIES TO ADD. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE SIZE OF THE SPECIFIED SUBCATALOG HAS BEEN * INCREASED AND THE PREAMBLE HAS BEEN UPDATED TO * REFLECT THE CHANGE. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * = FILE DEFINE ERROR. * = FILE ATTACH ERROR. * = FILE PURGE ERROR. * = FILE RENAME ERROR. * IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN * ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED. * * NOTES THE CATALOG IS RE-ATTACHED IN WRITE MODE IN ORDER TO * EXTEND THE SUBCATALOG, AND WHEN FINISHED, THE FILE IS * ATTACHED IN MODIFY MODE AGAIN. * * MESSAGES * PROGRAM ABNORMAL, CEXTSC.*. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM NUM I; # NUMBER OF ENTRIES TO ADD # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CEXTSC - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC BFLUSH; # FLUSH *FCT* I/O BUFFER # PROC CDEFTF; # DEFINE TEMPORARY CATALOG # PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC MESSAGE; # ISSUE MESSAGE # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC READ; # READ FILE TO *CIO* BUFFER # PROC READW; # READ DATA TO WORKING BUFFER # PROC REPLCAT; # REPLACE MSF CATALOG # PROC REWIND; # REWIND A FILE # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # PROC WRITEF; # WRITE END OF FILE # PROC WRITEW; # WRITE DATA FROM WORKING BUFFER # PROC ZFILL; # ZERO FILL BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CEXTSC - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMBPFP *CALL COMXMSC ITEM EXT1 I; # EXTEND VALUE 1 # ITEM EXT2 I; # EXTEND VALUE 2 # ITEM I I; # LOOP COUNTER # ITEM J I; # LOOP COUNTER # ITEM N I; # COUNTER # ITEM NAST I; # NUMBER OF PRU-S IN *AST* # ITEM NFCT I; # NUMBER OF PRU-S IN *FCT* # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM STAT I; # STATUS # ITEM TEMP I; # TEMPORARY STORAGE # ITEM WRD$AV I; # NUMBER OF WORDS AVAILABLE # ITEM WRD$ND I; # NUMBER OF WORDS NEEDED # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; # RETURN ERROR STATUS # END BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # FB$CWRD[0] = 0; IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END # * SET FAMILY AND USER INDEX. # PFP$WRD0[0] = 0; PFP$FAM[0] = OCT$FAM[ORD]; PFP$UI[0] = DEF$UI + OCT$SUBF[ORD]; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN # IF FAMILY NOT FOUND # BEGIN CMA$RTN[0] = "CEXTSC."; MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE # ABORT; END ZSETFET(TFETADR,OCT$LFN[ORD],FCTBADR,SEQBL,RFETL); FET$EP[0] = TRUE; ZSETFET(TFETADR+RFETL,TSFMCAT,TBUFADR,TBUFL,RFETL); FET$EP[0] = TRUE; REWIND(TFET[0],NRCL); CDEFTF(TFET[1],ERRSTAT); # DEFINE TEMPORARY CATALOG FILE # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END # * DETERMINE CATALOG EXTENSION VALUES. * (EXT1) = RELATIVE SECTOR ADDRESS TO BEGIN *FCT* EXTENSION AT. * (NFCT) = NUMBER OF PRU-S NEEDED FOR THE *FCT* EXTENSION. # EXT1 = PRM$FCTLOC[SMID] + PRM$ENTRC[SMID] * 16; NFCT = 16 * NUM; # * UPDATE CATALOG PREAMBLE. # PRM$ENTRC[SMID ] = PRM$ENTRC[SMID ] + NUM; FASTFOR I = 1 STEP 1 UNTIL MAXSM DO BEGIN IF PRM$ASTLOC[I] GR PRM$ASTLOC[SMID] THEN # IF SUBCATALOG LOCATION CHANGED # BEGIN PRM$FCTLOC[I] = PRM$FCTLOC[I] + NFCT; PRM$ASTLOC[I] = PRM$ASTLOC[I] + NFCT; END END # * TRANSFER CATALOG FILE TO TEMPORARY FILE, EXTENDING SUBCATALOG. # READ(TFET[0],RCL); READW(TFET[0],WBUF,WBUFL,STAT); IF STAT EQ CIOERR THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]); RETURN; END IF STAT NQ 0 THEN # IF TRANSFER NOT COMPLETE # BEGIN CMA$RTN[0] = "CEXTSC."; MESSAGE(CMAMSG,UDFL1); ABORT; END P = WBUFADR; FASTFOR I = 0 STEP 1 UNTIL MAXSM DO BEGIN TBUF$W[I+1] = PRM$SCW1[I]; TBUF$W1[I+1] = PRM$SCW2[I]; TBUF$W2[I+1] = PRM$SCW3[I]; END P = TBUFADR; WRITEW(TFET[1],WBUF,WBUFL,STAT); SLOWFOR I = 2 STEP 1 WHILE STAT EQ 0 DO BEGIN # TRANSFER CATALOG # IF I EQ EXT1 THEN BEGIN # FILE TO BE EXTENDED # ZFILL(WBUF,WBUFL); SLOWFOR J = 1 STEP 1 UNTIL NFCT DO BEGIN WRITEW(TFET[1],WBUF,WBUFL,STAT); IF STAT NQ 0 THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END END END # FILE TO BE EXTENDED # READW(TFET[0],WBUF,WBUFL,STAT); IF STAT EQ CIOERR THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]); RETURN; END IF STAT NQ 0 AND (I + 1) EQ EXT1 THEN # ADD SPACE AT END OF FILE # BEGIN SLOWFOR J = 1 STEP 1 UNTIL NFCT DO BEGIN WRITEW(TFET[1],WBUF,WBUFL,STAT); IF STAT NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END END STAT = -1; TEST I; END IF STAT NQ 0 THEN # IF *EOR*, *EOF* OR *EOI* # BEGIN TEST I; # EXIT LOOP # END WRITEW(TFET[1],WBUF,WBUFL,STAT); IF STAT NQ 0 THEN # *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END END # TRANSFER CATALOG # WRITEF(TFET[1],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END # * REPLACE MSF CATALOG WITH NEW CATALOG (*TSFMCAT*). # REPLCAT(ORD,ERRSTAT); RETURN; END # CEXTSC # TERM PROC CFLUSH((FAMNM),(SUBF),(QRADDR),ERRSTAT); # TITLE CFLUSH - FLUSHES THE CATALOG I/O BUFFER. # BEGIN # CFLUSH # # ** CFLUSH - FLUSHES THE CATALOG I/O BUFFER. * * *CFLUSH* CHECKS FOR ERRORS AND CALLS *BFLUSH* TO FLUSH THE * CATALOG I/O BUFFER, WHICH IS USED FOR READING AND WRITING * *FCT* ENTRIES. THE CATALOG MUST BE OPEN IN MODIFY MODE. * * CFLUSH - IS CALLED BY ADDCAR,ADDCSU,ADDCUBE,DESTAGR,PURGCHN, * PURGFCT,RMVCAR,RMVCUBE,STAGER. * * * PROC CFLUSH((FAMNM),(SUBF),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = *CIO* ERROR. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CFLUSH - XREF LIST BEGIN. # XREF BEGIN PROC BFLUSH; # BUFFER FLUSH # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # END # **** PROC CFLUSH - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMSPFM ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; # * FIND ENTRY IN THE OPEN CATALOG TABLE. # OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; # RETURN ERROR STATUS # RETURN; END BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # RETURN; END # CFLUSH # TERM PROC CGETFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),(QRADDR), ERRSTAT); # TITLE CGETFCT - GET AN *FCT* ENTRY. # BEGIN # CGETFCT # # ** CGETFCT - GET AN *FCT* ENTRY. * * * *CGETFCT* RETURNS THE REQUESTED FILE AND CARTRIDGE TABLE ENTRY * TO THE CALLER. * * CGETFCT - IS CALLED BY ACQ$FCT,DBFLAG,DBFMAP,DBRDFIL,DBREL, * LBRMMSC,OPENCAT,USANALF,USRPDE,VLBLDVT. * * PROC CGETFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR), * (QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (FCTORD) - ORDINAL OF ENTRY IN *FCT*. * (BADDR) - ADDRESS OF BUFFER TO RECEIVE *FCT* ENTRY. * (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. * * EXIT THE REQUESTED *FCT* ENTRY IS RETURNED TO THE CALLER AT * THE ADDRESS SPECIFIED BY (BADDR). * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERROR. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * = *FCT* ORDINAL OUT OF RANGE. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM FCTORD I; # *FCT* ORDINAL # ITEM BADDR U; # ADDRESS OF *FCT* ENTRY BUFFER # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CGETFCT - XREF LIST BEGIN. # XREF BEGIN PROC CBUFMAN; # MANAGE CATALOG *FCT* BUFFER # END # **** PROC CGETFCT - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMCT ITEM I I; # LOOP COUNTER # ITEM MODF B = FALSE; # MODIFY MODE FLAG # ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER # BASED ARRAY ENTBUF [1:FCTENTL] P(1); # *FCT* ENTRY BUFFER # BEGIN ITEM ENT$WRD I(00,00,60); # ENTRY WORD # END CONTROL EJECT; # * ENSURE THAT REQUESTED *FCT* ENTRY IS WITHIN I/O BUFFER. # CBUFMAN(FAMNM,SUBF,SMID,FCTORD,MODF,QRADDR,ERRSTAT); IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END # * TRANSFER ENTRY TO CALLERS BUFFER. # P = BADDR; SLOWFOR I = 1 STEP 1 UNTIL FCTENTL DO BEGIN ENT$WRD[I] = FCTB$WRD[I]; END RETURN; END # CGETFCT # TERM PROC CGETPD((FAMNM),(SUBF),(SMID ),LASTPRG,(QRADDR),ERRSTAT); # TITLE CGETPD - GET PURGE DATE. # BEGIN # CGETPD # # ** CGETPD - GET PURGE DATE. * * * *CGETPD* GETS THE DATE AND TIME OF THE LAST PURGE OF ORPHAN * FILES (AN MSF FILE WITH NO REFERENCE TO IT IN THE *PFC*) FROM THE * APPROPRIATE CATALOG PREAMBLE ENTRY. * * CGETPD - IS CALLED BY GETPD AND VLSUBTD. * * PROC CGETPD((FAMNM),(SUBF),(SMID ),LASTPRG,(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT (LASTPRG) - LAST PURGE DATE AND TIME IN PACKED FORMAT, * AS RETURNED BY THE *PDATE* MACRO. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERROR. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = NO SUCH SUBCATALOG EXISTS. * = *CIO* ERROR. * * NOTES THE PREAMBLE TABLE DOES NOT CONTAIN THE LAST PURGE * DATE AND TIME (ONLY THE FIRST WORD OF EACH SUBCATALOG * ENTRY IS IN THE TABLE), SO THE PREAMBLE MUST BE READ * FROM THE CATALOG. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM LASTPRG U; # LAST PURGE DATE # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CGETPD - XREF LIST BEGIN. # XREF BEGIN PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC REWIND; # REWIND FILE # PROC RPHR; # READ PRU TO *CIO* BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CGETPD - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; END # * GET DATE AND TIME OF LAST PURGE OF ORPHAN FILES. # ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL); FET$EP[0] = TRUE; REWIND(FETSET[0],RCL); RPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]); RETURN; END P = TBUFADR; LASTPRG = PRM$PDATE[SMID ]; RETURN; END # CGETPD # TERM PROC CINIT((FAMNM),(SUBF),(FLNM),ERRSTAT); # TITLE CINIT - MSS CATALOG INITIALIZATION. # BEGIN # CINIT # # ** CINIT - MSS CATALOG INITIALIZATION. * * CINIT - IS CALLED BY DFCAT OF THE SSDEF DECK. * * *CINIT* CREATES A FILE AND INITIALIZES IT AS A SKELETON CATALOG * CONTAINING A PREAMBLE BUT NO SUBCATALOGS. THE PREAMBLE CONTAINS * THE FAMILY NAME AND SUBFAMILY DESIGNATOR IN THE HEADER. * * PROC CINIT((FAMNM),(SUBF),(FLNM),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (FLNM) - CATALOG FILE NAME, LEFT JUSTIFIED, ZERO * FILLED, 7 CHARACTER MAXIMUM. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERROR. * = CATALOG FILE ALREADY EXISTS. * = *CIO* ERROR. * = CATALOG DEFINE ERROR. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM FLNM C(7); # CATALOG FILE NAME # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CINIT - XREF LIST BEGIN. # XREF BEGIN PROC PFD; # PERMANENT FILE REQUEST DELAYS # PROC RETERN; # RETURN FILE TO SYSTEM # PROC WRITEF; # WRITE END OF FILE # PROC WRITEW; # WRITE DATA FROM WORKING BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CINIT - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMBPFS *CALL COMXMSC *CALL COMSPFM ITEM I I; # LOOP COUNTER # ITEM STAT I; # DEFINE STATUS # CONTROL EJECT; # * DEFINE CATALOG FILE. # ERRSTAT = CMASTAT"NOERR"; PFD("DEFINE",FLNM,0,"BR","Y","SR","MR","RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN BEGIN # DEFINE ERROR # IF PFSTAT EQ FAP THEN # IF FILE ALREADY EXISTS # BEGIN ERRSTAT = CMASTAT"INTLZD"; END ELSE BEGIN ERRSTAT = CMASTAT"DEFERR"; END RETURN; # RETURN ERROR STATUS # END # DEFINE ERROR # # * CREATE SKELETON CATALOG. # FASTFOR I = 1 STEP 1 UNTIL WBUFL DO # ZERO FILL WORKING BUFFER # BEGIN WBUF$W[I] = 0; END P = WBUFADR; PRM$FAM[0] = FAMNM; PRM$SUBF[0] = SUBF; # * THE PRM$ID IS SET TO 1 FOR THE M860 SFMCAT SO THAT IF * MSS AMD M860 ARE EVER RUN IN PARALLEL PFDUMP CAN DISTINGUISH * BETWEEN THE TWO. # PRM$ID[0] = 1; ZSETFET(TFETADR,FLNM,TBUFADR,TBUFL,RFETL); # SET UP FET # FET$EP[0] = TRUE; WRITEW(FETSET[0],PREAMBLE,WBUFL,STAT); WRITEF(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN ERRSTAT = CMASTAT"CIOERR"; END RETERN(FETSET[0],RCL); RETURN; END # CINIT # TERM PROC CNAME(FLNM); # TITLE CNAME - GET LFN FOR CATALOG. # BEGIN # CNAME # # ** CNAME - GET LFN FOR CATALOG. * * *CNAME* SUPPLIES A 7 CHARACTER NAME TO BE USED AS THE LFN ON AN * ATTACH OF A CATALOG FILE. * * CNAME - IS CALLED BY COPEN. * PROC CNAME(FLNM) * * EXIT (FLNM) - A SEVEN CHARACTER FILE NAME. * * NOTES *INT$NUM* IS INITIALIZED TO 1000000D SO THAT * WHEN IT IS CONVERTED TO DISPLAY CODE, THE RESULT * WILL CONTAIN DISPLAY CODED NUMBERS IN THE BOTTOM * 6 CHARACTERS RATHER THAN BLANKS. # ITEM FLNM C(7); # FILE NAME # # **** PROC CNAME - XREF LIST BEGIN. # XREF BEGIN FUNC XCDD C(10); # INTEGER TO DISPLAY CODE CONVERSION # END # **** PROC CNAME - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD ITEM DC$NUM C(10); # DISPLAY CODE NUMBER # ITEM INT$NUM I = 1000000; # INTEGER NUMBER # ITEM NEXTNM C(7) = "C000000"; # NEXT FILE NAME # CONTROL EJECT; FLNM = NEXTNM; # SET FILE NAME # # * INCREMENT FILE NAME. # INT$NUM = INT$NUM + 1; DC$NUM = XCDD(INT$NUM); C<1,6>NEXTNM = C<4,6>DC$NUM; B<0,60>DC$NUM = 0; # CLEAR DISPLAY CODE VALUE # RETURN; END # CNAME # TERM PROC COPEN((FAMNM),(SUBF),(FLNM),(ATTM),(ACCM),ERRSTAT); # TITLE COPEN - OPEN CATALOG. # BEGIN # COPEN # # ** COPEN - OPEN CATALOG. * * *COPEN* PREPARES THE GIVEN CATALOG FOR SUBSEQUENT REFERENCE * BY THE CALLER. * * COPEN - IS CALLED BY DBMAIN,LBRMMSC,OPENCAT,USRPDE,USRPBAS, * VLSUBFM. * * PROC COPEN((FAMNM),(SUBF),(FLNM),(ATTM),(ACCM),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (FLNM) - CATALOG FILE NAME, LEFT JUSTIFIED, ZERO * FILLED, 7 CHARACTER MAXIMUM. * (ATTM) - FILE ATTACH MODE IN DISPLAY CODE. * = *M*, MODIFY MODE. * = *RM*, READ/ALLOW MODIFY MODE. * (ACCM) - FILE ACCESS MODE. * = FALSE, RANDOM ACCESS. * = TRUE, SEQUENTIAL ACCESS. * * CALLER MUST ISSUE *SETPFP* TO APPROPRIATE FAMILY AND * USER INDEX, IF THE CATALOG FILE IS NOT LOCAL. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG ALREADY OPEN. * = *CIO* ERROR. * = CATALOG ATTACH ERROR. * = OPEN CATALOG TABLE FULL. * * NOTES THE PFN OF AN MSF CATALOG IS *SFMCATX*, WHERE *X* IS * THE SUBFAMILY DESIGNATOR. * *COPEN* ATTACHES THE CATALOG FILE *SFMCATX*, CREATES * AN ENTRY IN THE *OCT* AND IF THE CATALOG IS NOT * INTERLOCKED, THE FIRST WORD OF THE HEADER AND OF EACH * SUBCATALOG ENTRY IN THE PREAMBLE IS READ INTO A * TABLE. IF THE CALLER HAS ALREADY ATTACHED THE * CATALOG FILE, (FLNM) MUST BE THE LFN OF THE FILE * INSTEAD OF THE PFN, SO THAT THE ATTACH WILL BE * BYPASSED. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM FLNM C(7); # CATALOG FILE NAME # ITEM ATTM C(2); # FILE ATTACH MODE # ITEM ACCM B; # FILE ACCESS MODE # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC COPEN - XREF LIST BEGIN. # XREF BEGIN PROC CNAME; # GET CATALOG LFN # PROC CRDPRM; # READ CATALOG PREAMBLE # PROC PFD; # PERMANENT FILE REQUEST DELAYS # END # **** PROC COPEN - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMCT *CALL COMBPFS *CALL COMXCTF *CALL COMXMSC *CALL COMSPFM ITEM I I; # LOOP COUNTER # ITEM LFN C(7); # LOCAL FILE NAME # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; ERRSTAT = CMASTAT"NOERR"; IF C<0,6>FLNM EQ SFMCAT THEN # IF FILE NOT ALREADY ATTACHED # BEGIN # * ATTACH CATALOG FILE. # CNAME(LFN); PFD("ATTACH",LFN,FLNM,"M",ATTM,"RC",PFSTAT,"NA",0,"UP",0,0); IF PFSTAT NQ 0 AND PFSTAT NQ FBS THEN # IF ATTACH ERROR # BEGIN ERRSTAT = CMASTAT"ATTERR"; RETURN; # RETURN ERROR STATUS # END END ELSE BEGIN LFN = FLNM; END # * CREATE AN OPEN CATALOG TABLE ENTRY. # ORD = 0; FASTFOR I = 1 STEP 1 WHILE I LQ OCTLEN AND ORD EQ 0 DO BEGIN # SEARCH *OCT* # IF OCT$SUBF[I] EQ SUBF ## AND OCT$FAM[I] EQ FAMNM THEN # IF CATALOG ALREADY OPEN # BEGIN ERRSTAT = CMASTAT"FOPEN"; RETURN; # RETURN ERROR STATUS # END IF OCT$W1[I] EQ 0 THEN # IF EMPTY ENTRY # BEGIN ORD = I; END END # SEARCH *OCT* # IF ORD EQ 0 THEN # IF NO EMPTY ENTRIES # BEGIN ERRSTAT = CMASTAT"OCTFULL"; RETURN; # RETURN ERROR STATUS # END OCT$FAM[ORD] = FAMNM; OCT$SUBF[ORD] = SUBF; OCT$LFN[ORD] = LFN; OCT$ATTM[ORD] = ATTM; OCT$BUFL[ORD] = SEQBL; # * CHECK FOR CATALOG INTERLOCK. # IF PFSTAT EQ FBS THEN # IF CATALOG INTERLOCKED # BEGIN OCT$INTLK[ORD] = TRUE; # SET INTERLOCK FLAGS # GLBINTLK = TRUE; ERRSTAT = CMASTAT"INTLK"; RETURN; # RETURN WITH INTERLOCK STATUS # END CRDPRM(ORD,ERRSTAT); # READ AND UPDATE PREAMBLE # RETURN; END # COPEN # TERM PROC CPIOERR((FAMNM),(SUBF),(QRADDR),ERRSTAT,FET); # TITLE CPIOERR - PROCESS I/O ERROR ON MSF CATALOG. # BEGIN # CPIOERR # # ** CPIOERR - PROCESS I/O ERROR ON MSF CATALOG. * * *CPIOERR* CLOSES THE MSF CATALOG WITH THE I/O ERROR AND SETS * AN I/O ERROR STATUS. IF CALLED BY THE MSS EXECUTIVE IT ALSO * DUMPS THE FET FOR THE CATALOG TO *LOGFILE* AND ISSUES * AN ERROR MESSAGE TO THE K-DISPLAY AND TO EXEC-S DAYFILE. * * CPIOERR - IS CALLED BY BFLUSH,CADDSC,CEXTSC,CGETPD,CPUTPD, * CRDAST,CWTAST. * * PROC CPIOERR((FAMNM),(SUBF),(QRADDR),ERRSTAT,FET) * * ENTRY (FAMNM) - FAMILY NAME. * (SUBF) - SUBFAMILY DESIGNATOR. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * FET - AN ARRAY CONTAINING THE FET FOR THE MSF CATALOG. * * EXIT (ERRSTAT) - ERROR STATUS (VALUES DEFINED IN * *COMBCMS*). * = *CIO* ERROR. * * MESSAGES * I/O ERROR ON SFMCATN, CATALOG CLOSED. * RESPOND GO TO ACKNOWLEDGE.* # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CPIOERR - XREF LIST BEGIN. # XREF BEGIN PROC CCLOSE; # CLOSE MSF CATALOG # PROC KREQ; # K-DISPLAY REQUEST # PROC RECALL; # RECALL # END # **** PROC CPIOERR - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBKDD ARRAY FET [0:0] P(RFETL); ; # MSF CATALOG FET # CONTROL EJECT; IF EXEC THEN BEGIN # MSS EXECUTIVE PROCESSING # # * ISSUE ERROR MESSAGE TO EXEC-S DAYFILE AND TO THE K-DISPLAY. # P = LOC(KDISBLK[0]); IF KW$WORD[0] NQ 0 AND NOT KW$COMP[0] THEN # PREVIOUS MESSAGE NOT ISSUED # BEGIN # K-DISPLAY WORD BUSY # REPEAT WHILE NOT KW$COMP[0] DO # WAIT FOR MESSAGE TO BE ISSUED # BEGIN RECALL(0); END END # K-DISPLAY WORD BUSY # KW$WORD[0] = 0; KW$IC[0] = TRUE; KW$RPGO[0] = TRUE; KW$DF[0] = TRUE; KW$LINE1[0] = KM"KM13"; KW$LINE2[0] = KM"KM21"; KP$SF = SUBF; KREQ(P,KLINK); END # MSS EXECUTIVE PROCESSING # CCLOSE(FAMNM,SUBF,QRADDR,ERRSTAT); # CLOSE MSF CATALOG # ERRSTAT = CMASTAT"CIOERR"; RETURN; END # CPIOERR # TERM PROC CPUTFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR),(QRADDR), ERRSTAT); # TITLE CPUTFCT - PUT AN *FCT* ENTRY. # BEGIN # CPUTFCT # # ** CPUTFCT - PUT AN *FCT* ENTRY. * * *CPUTFCT* TRANSFERS THE SPECIFIED FILE AND CARTRIDGE TABLE ENTRY * FROM THE CALLERS BUFFER TO THE I/O BUFFER. THE CATALOG MUST * BE OPEN IN MODIFY MODE. * * CPUTFCT - IS CALLED BY RLS$FCT. * PROC CPUTFCT((FAMNM),(SUBF),(SMID ),(FCTORD),(BADDR), * (QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (FCTORD) - ORDINAL OF ENTRY IN *FCT*. * (BADDR) - ADDRESS OF BUFFER TO RECEIVE *FCT* ENTRY. * (QRADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. * * EXIT THE REQUESTED *FCT* ENTRY IS TRANSFERRED TO THE *FCT* * I/O BUFFER FROM THE ADDRESS SPECIFIED BY (BADDR). * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERROR. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * = *FCT* ORDINAL OUT OF RANGE. * * NOTES THE *FCT* ENTRY IS TRANSFERRED FROM THE CALLERS BUFFER * BACK TO THE I/O BUFFER, BUT IS NOT WRITTEN TO THE * CATALOG FILE UNTIL SOME SUBSEQUENT REQUEST CAUSES * THE I/O BUFFER TO BE FLUSHED. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM FCTORD I; # *FCT* ORDINAL # ITEM BADDR U; # ADDRESS OF *FCT* ENTRY BUFFER # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CPUTFCT - XREF LIST BEGIN. # XREF BEGIN PROC CBUFMAN; # MANAGE CATALOG *FCT* BUFFER # END # **** PROC CPUTFCT - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBMCT ITEM I I; # LOOP COUNTER # ITEM MODF B = TRUE; # MODIFY MODE FLAG # ITEM OFFSET I; # WORD OFFSET WITHIN BUFFER # BASED ARRAY ENTBUF [1:FCTENTL] P(1); # *FCT* ENTRY BUFFER # BEGIN ITEM ENT$WRD I(00,00,60); # ENTRY WORD # END CONTROL EJECT; # * ENSURE THAT REQUESTED *FCT* ENTRY IS WITHIN I/O BUFFER. # CBUFMAN(FAMNM,SUBF,SMID,FCTORD,MODF,QRADDR,ERRSTAT); IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END # * TRANSFER ENTRY TO *FCT* I/O BUFFER. # P = FCTBADR; P = BADDR; SLOWFOR I = 1 STEP 1 UNTIL FCTENTL DO BEGIN FCTB$WRD[I] = ENT$WRD[I]; END FB$BMF[0] = TRUE; # SET BUFFER MODIFIED FLAG # RETURN; END # CPUTFCT # TERM PROC CPUTPD((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT); # TITLE CPUTPD - PUT PURGE DATE. # BEGIN # CPUTPD # # ** CPUTPD - PUT PURGE DATE. * * *CPUTPD* PUTS THE DATE AND TIME OF THE LAST PURGE OF ORPHAN * FILES (AN MSF FILE WITH NO REFERENCE TO IT IN THE PFC) INTO THE * APPROPRIATE CATALOG PREAMBLE ENTRY. THE CURRENT PACKED DATE AND * TIME IS USED. THE CATALOG MUST BE OPEN IN MODIFY MODE. * * CPUTPD - IS CALLED BY PURGCHN,UPDCAT. * * PROC CPUTPD((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE CURRENT PACKED DATE AND TIME IS WRITTEN IN THE * SPECIFIED SUBCATALOG ENTRY IN THE PREAMBLE. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG EXISTS. * = *CIO* ERROR. * * NOTE THE PREAMBLE TABLE DOES NOT CONTAIN THE LAST PURGE * DATE AND TIME (ONLY THE FIRST WORD OF EACH SUBCATALOG * ENTRY IS IN THE TABLE), SO THE PREAMBLE MUST BE READ * FROM AND WRITTEN TO THE CATALOG. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CPUTPD - XREF LIST BEGIN. # XREF BEGIN PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC PDATE; # OBTAIN PACKED DATE AND TIME # PROC RPHR; # READ PRU TO *CIO* BUFFER # PROC WPHR; # WRITE PRU FROM *CIO* BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CPUTPD - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC *CALL COMSPFM ITEM LASTPRG U; # LAST PURGE DATE # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; END # * PUT DATE AND TIME OF LAST PURGE OF ORPHAN FILES INTO PREAMBLE. # PDATE(LASTPRG); # GET PACKED DATE AND TIME # PRM$PDATE[SMID] = LASTPRG; ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,TBUFL,RFETL); FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$RR[0] = 1; RPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN GOTO ERR; END P = TBUFADR; PRM$PDATE[SMID ] = LASTPRG; FET$RR[0] = 1; FET$W[0] = TRUE; WPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN GOTO ERR; END RETURN; ERR: # PROCESS *CIO* ERROR # CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]); RETURN; END # CPUTPD # TERM PROC CRCLMLK(ERRSTAT); # TITLE CRCLMLK - RECLAIM CATALOG INTERLOCKS. # BEGIN # CRCLMLK # # ** CRCLMLK - RECLAIM CATALOG INTERLOCKS. * * *CRCLMLK* TRIES TO RECLAIM ALL MSF CATALOG INTERLOCKS. IF THE * INTERLOCK IS RECLAIMED, (THE CATALOG IS SUCCESSFULLY ATTACHED) * THE STATUS OF ALL WAITING-FOR-INTERLOCK REQUESTS ARE SET * TO READY. * * CRCLMLK - IS CALLED BY RCLMLK. * * PROC CRCLMLK(ERRSTAT) * * EXIT THE CATALOG INTERLOCK IS RECLAIMED IF THE CATALOG * WAS SUCCESSFULLY ATTACHED. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = *CIO* ERROR. * = CATALOG ATTACH ERROR. * IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN * ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED. * * NOTES IF A CATALOG OPEN REQUEST WAS PREVIOUSLY ISSUED BUT * THE CATALOG WAS INTERLOCKED AT THAT TIME, THE * REMAINDER OF THE OPEN PROCESSING WILL BE DONE IF THE * CATALOG INTERLOCK IS RECLAIMED. FOR ALL OTHER * REQUESTS, THE INTERLOCK BIT IN THE *OCT* IS MERELY * CLEARED. * * MESSAGES * PROGRAM ABNORMAL, CRCLMLK.*. * * UNABLE TO REATTACH MSF CATALOG. * SFMCATN FOR FAMILY FFFFFFF CLOSED.* # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRCLMLK - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # PROC BZFILL; # BLANK OR ZERO FILL WORD # PROC CRDPRM; # READ CATALOG PREAMBLE # PROC MESSAGE; # ISSUE MESSAGE # PROC PF; # *PFM* REQUEST INTERFACE # PROC RMVBLNK; # REMOVE MULTIPLE BLANKS # PROC RTIME; # GET REAL TIME CLOCK READING # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # FUNC XCDD C(10); # INTEGER TO DISPLAY CODE CONVERSION # PROC ZFILL; # ZERO FILL A BUFFER # END # **** PROC CRCLMLK - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCHN *CALL COMBCMD *CALL COMBCMS *CALL COMBMCT *CALL COMBPFP *CALL COMXCTF *CALL COMXHLR *CALL COMXIPR *CALL COMXMSC *CALL COMSPFM ITEM CATPFN C(7); # MSS CATALOG PFN # ITEM DIS$SUBF C(10); # SUBFAMILY (DISPLAY CODE) # ITEM FAMILY C(7); # FAMILY NAME # ITEM I I; # LOOP COUNTER # ITEM INTLK B; # INTERLOCK STATUS # ITEM STAT I; # ATTACH STATUS # ITEM TEMP U; # TEMPORARY STORAGE # CONTROL EJECT; ERRSTAT = CMASTAT"NOERR"; # INITIALIZE VALUES # INTLK = FALSE; PFP$WRD0[0] = 0; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; # * SEARCH OPEN CATALOG TABLE FOR INTERLOCKED CATALOGS. # FASTFOR I = 1 STEP 1 UNTIL OCTLEN DO BEGIN # SEARCH *OCT* # IF NOT OCT$INTLK[I] THEN # IF CATALOG NOT INTERLOCKED # BEGIN TEST I; # CHECK NEXT ENTRY # END PFP$FAM[0] = OCT$FAM[I]; # SET FAMILY AND USER INDEX # PFP$UI[0] = DEF$UI + OCT$SUBF[I]; SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN # IF FAMILY NOT FOUND # BEGIN CMA$RTN[0] = "CRCLMLK."; MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE # ABORT; END # * ATTEMPT CATALOG FILE ATTACH. # CATPFN = SFMCAT; # BUILD CATALOG PFN # DIS$SUBF = XCDD(OCT$SUBF[I]); C<6,1>CATPFN = C<9,1>DIS$SUBF; PF("ATTACH",OCT$LFN[I],CATPFN,"M",OCT$ATTM[I], "RC",STAT,"NA",0,"UP",0,"SR","IE",0); IF STAT EQ FBS OR STAT EQ PFA OR STAT EQ INA ## OR STAT EQ FTF OR STAT EQ PEA THEN # FILE BUSY OR TEMPORARY ERROR # BEGIN INTLK = TRUE; END ELSE BEGIN # FILE NOT INTERLOCKED # OCT$INTLK[I] = FALSE; TEMP = OCT$LINK[I]; OCT$LINK[I] = 0; REPEAT WHILE TEMP NQ 0 DO BEGIN # ADD WAITING REQUESTS TO READY CHAIN # P = TEMP; TEMP = HLR$LNK1[0]; ADD$LNK(P,LCHN"HL$READY",0); END # ADD WAITING REQUESTS TO READY CHAIN # IF STAT NQ 0 THEN # IF ATTACH ERROR # BEGIN CMSGLINE[0] = CMSG3; MESSAGE(CMSGAREA,UDFL1); CMSGLINE[0] = CMSGCLOSE; CMSGCSUBF[0] = C<9,1>DIS$SUBF; FAMILY = OCT$FAM[I]; BZFILL(FAMILY,TYPFILL"BFILL",7); CMSGCFAM[0] = FAMILY; RMVBLNK(CMSGAREA,48); MESSAGE(CMSGAREA,UDFL1); ZFILL(OCT[I],OCTENTL); # CLEAR *OCT* ENTRY # TEST I; END # * CHECK FOR CATALOG OPENED. # IF OCT$PRMA[I] EQ 0 THEN # IF CATALOG OPEN NOT COMPLETE # BEGIN CRDPRM(I,ERRSTAT); # FINISH CATALOG OPEN # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END END END # FILE NOT INTERLOCKED # END # SEARCH *OCT* # IF NOT INTLK THEN # IF NO CATALOGS INTERLOCKED # BEGIN GLBINTLK = FALSE; # CLEAR GLOBAL INTERLOCK FLAG # ITLK$EXPIR = 0; END ELSE BEGIN RTIME(RTIMESTAT[0]); ITLK$EXPIR = RTIMSECS[0] + INLK$INTV; END RETURN; END # CRCLMLK # TERM PROC CRDAST((FAMNM),(SUBF),(SMID ),(BADDR),(QRADDR),ERRSTAT); # TITLE CRDAST - READ AVAILABLE STREAM TABLE. # BEGIN # CRDAST # # ** CRDAST - READ AVAILABLE STREAM TABLE. * * *CRDAST* READS THE ENTIRE AVAILABLE STREAM TABLE DIRECTLY INTO * THE CALLERS BUFFER. * * CRDAST - IS CALLED BY ADDCAR,ADDCUBE,ADDCSU,ALLOCAT,DESTAGR, * OPENCAT,PURGCHN,PURGFCT,RLSUNS,RMVCAR,RMVCUBE,SERAST, * STAGER,UPDCAT. * * PROC CRDAST((FAMNM),(SUBF),(SMID ),(BADDR),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (BADDR) - ADDRESS OF BUFFER TO CONTAIN *AST*. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE *AST* HAS BEEN READ INTO THE BUFFER AT THE ADDRESS * SPECIFIED BY (BADDR). * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * * NOTES THE *AST* IS READ DIRECTLY INTO THE CALLERS BUFFER. * IT IS THE CALLERS RESPONSIBILITY TO ENSURE THAT THE * BUFFER IS LARGE ENOUGH TO CONTAIN THE ENTIRE *AST*. * THE BUFFER SIZE SHOULD BE THE LENGTH OF THE *AST* * ROUNDED UP TO A PRU SIZE MULTIPLE OR LARGER. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM BADDR U; # *AST* BUFFER ADDRESS # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRDAST - XREF LIST BEGIN. # XREF BEGIN PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC CRDPRM; PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC READ; # READ FILE TO *CIO* BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CRDAST - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC ITEM LENGTH I; # *AST* LENGTH # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; END LENGTH = ABUFLEN; # * READ ENTIRE *AST* INTO CALLERS BUFFER. # ZSETFET(TFETADR,OCT$LFN[ORD],BADDR,LENGTH,RFETL); FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$RR[0] = PRM$ASTLOC[SMID ]; READ(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]); RETURN; END CRDPRM(ORD,ERRSTAT); RETURN; END # CRDAST # TERM PROC CRDPRM((TORD),ERRSTAT); # TITLE CRDPRM - READ CATALOG PREAMBLE. # BEGIN # CRDPRM # # ** CRDPRM - READ CATALOG PREAMBLE. * * *CRDPRM* READS THE HEADER OF EACH * SUBCATALOG ENTRY IN THE PREAMBLE INTO A BUFFER (THE * PREAMBLE TABLE). * * CRDPRM - IS CALLED BY COPEN. * * PROC CRDPRM((TORD),ERRSTAT) * * ENTRY (TORD) - ORDINAL OF CATALOGS ENTRY IN THE OPEN CATALOG * TABLE. * * EXIT A CATALOG PREAMBLE IS READ INTO A BUFFER AND * UPDATED. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = *CIO* ERROR. * = CATALOG ATTACH ERROR. * * NOTES WHEN A CATALOG IS OPENED, A PREAMBLE IS READ * INTO THE PREAMBLE TABLE, TO BE USED TO REFERENCE * DATA IN THE PREAMBLE, THUS REDUCING DISK REFERENCES. # ITEM TORD I; # OPEN CATALOG TABLE ORDINAL # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRDPRM - XREF LIST BEGIN. # XREF BEGIN PROC CCLOSE; # CLOSE CATALOGS # PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC REWIND; # REWIND FILE # PROC RPHR; # READ PRU TO *CIO* BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CRDPRM - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC ITEM I I; # LOOP COUNTER # ITEM J I; # LOOP COUNTER # CONTROL EJECT; # * READ CATALOG PREAMBLE INTO BUFFER. # OCT$PRMA[TORD] = (PRMBADR+((TORD-1)*PRMTLEN*3)); ZSETFET(TFETADR,OCT$LFN[TORD],TBUFADR,2*PRULEN,RFETL); FET$EP[0] = TRUE; REWIND(FETSET[0],RCL); RPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN GOTO ERR; END P = OCT$PRMA[TORD]; # * TRANSFER HEADER OF EACH ENTRY TO THE TABLE. # FASTFOR I = 0 STEP 1 UNTIL MAXSM DO BEGIN PRM$SCW1[I] = TBUF$W[I + 1]; PRM$SCW2[I] = TBUF$W1[I + 1]; PRM$SCW3[I] = TBUF$W2[I + 1]; END IF OCT$FAM[TORD] NQ PRM$FAM[0] ## OR OCT$SUBF[TORD] NQ PRM$SUBF[0] THEN # IF WRONG CATALOG ATTACHED # BEGIN CCLOSE(OCT$FAM[TORD],OCT$SUBF[TORD],0,ERRSTAT); ERRSTAT = CMASTAT"ATTERR"; RETURN; # RETURN ERROR STATUS # END # CHANGE DELETED 36 LINES THAT UPDATED STREAM COUNTS # RETURN; ERR: # PROCESS *CIO* ERROR # CPIOERR(OCT$FAM[TORD],OCT$SUBF[TORD],0,ERRSTAT,FETSET[0]); RETURN; END # CRDPRM # TERM PROC CRELSLK((FAMNM),(MASK),(QRADDR),ERRSTAT); # TITLE CRELSLK - RELEASE CATALOG INTERLOCKS. # BEGIN # CRELSLK # # ** CRELSLK - RELEASE CATALOG INTERLOCKS. * * *CRELSLK* RETURNS THE SPECIFIED CATALOGS IF THEY ARE INTERLOCKED * AND SETS THE INTERLOCK BIT IN THE OPEN CATALOG TABLE TO INDICATE * THAT THE INTERLOCK HAS BEEN GIVEN UP BY *MSSEXEC*. * * CRELSLK - IS CALLED BY HLRQMTR,TDAM$RP. * * PROC CRELSLK((FAMNM),(MASK),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (MASK) - THE 8-BIT DEVICE MASK FOR A DEVICE. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = *CIO* ERROR. * THE SPECIFIED CATALOGS ARE RETURNED. THE INTERLOCK * BIT IS SET IN THE CORRESPONDING *OCT* ENTRIES, AND THE * GLOBAL INTERLOCK FLAG IS SET. # ITEM FAMNM C(7); # FAMILY NAME # ITEM MASK U; # DEVICE MASK # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRELSLK - XREF LIST BEGIN. # XREF BEGIN PROC BFLUSH; # BUFFER FLUSH # PROC RETERN; # RETURN FILE TO SYSTEM # PROC RTIME; # GET REAL TIME CLOCK READING # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CRELSLK - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMXCTF *CALL COMXIPR ITEM I I; # LOOP COUNTER # CONTROL EJECT; ERRSTAT = CMASTAT"NOERR"; BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END FASTFOR I = 1 STEP 1 UNTIL OCTLEN DO BEGIN IF OCT$FAM[I] EQ FAMNM AND NOT OCT$INTLK[I] ## AND B<(59-OCT$SUBF[I]),1>MASK EQ 1 THEN # IF INTERLOCK TO BE GIVEN UP # BEGIN GLBINTLK = TRUE; # SET GLOBAL INTERLOCK FLAG # OCT$INTLK[I] = TRUE; RTIME(RTIMESTAT[0]); ITLK$EXPIR = RTIMSECS[0] + INLK$INTV; ZSETFET(TFETADR,OCT$LFN[I],TBUFADR,TBUFL,RFETL); RETERN(TFET[0],RCL); END END RETURN; END # CRELSLK # TERM PROC CRELSMM((FAMNM),(MASK),(QRADDR),ERRSTAT); # TITLE CRELSMM - RELEASE CATALOG IN MODIFY MODE. # BEGIN # CRELSMM # # ** CRELSMM - RELEASE CATALOG IN MODIFY MODE. * * *CRELSMM* ATTACHES THE SPECIFIED CATALOGS IN UPDATE MODE * (RELINQUISHING MODIFY MODE) IF THEY ARE INTERLOCKED BY * *SSEXEC* AND SETS THE UPDATE MODE INTERLOCK FLAG IN THE * OPEN CATALOG TABLE. *PFDUMP* WILL ATTACH THE CATALOGS IN * READ/ALLOW UPDATE MODE, PREVENTING *SSEXEC* FROM * RECLAIMING THE CATALOGS IN MODIFY MODE UNTIL IT RETURNS * THEM. DESTAGING FILES AND ADDING, EXTENDING OR REMOVING * SUBCATALOGS ARE NOT ALLOWED WHILE THIS INTERLOCK IS SET. * * PROC CRELSMM((FAMNM),(MASK),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (MASK) - THE 8-BIT DEVICE MASK FOR A DEVICE. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMACMS*) * = NO ERRORS. * = I/O ERROR. * = CATALOG ATTACH ERROR. * IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN * ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED. * * THE SPECIFIED CATALOGS ARE ATTACHED IN UPDATE MODE. * THE INTERLOCK FLAG IS SET IN THE CORRESPONDING *OCT* * ENTRIES AND THE GLOBAL INTERLOCK FLAG IS SET, IF THE * INTERLOCK WAS RELEASED. * * MESSAGES * PROGRAM ABNORMAL, CRELSMM.* * * UNABLE TO REATTACH SMF CATALOG. * SMFCATN FOR FAMILY FFFFFFF CLOSED.* # ITEM FAMNM C(7); # FAMILY NAME # ITEM MASK U; # DEVICE MASK # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRELSMM - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC BFLUSH; # BUFFER FLUSH # PROC BZFILL; # BLANK OR ZERO FILL WORD # PROC MESSAGE; # ISSUE MESSAGE # PROC PFD; # PERMANENT FILE REQUEST DELAYS # PROC RMVBLNK; # REMOVE MULTIPLE BLANKS # PROC RTIME; # GET REAL TIME CLOCK READING # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # FUNC XCDD C(10); # INTEGER TO DISPLAY CODE CONVERSION # PROC ZFILL; # ZERO FILL A BUFFER # END # **** PROC CRELSMM - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBPFP *CALL COMBPFS *CALL COMXCTF *CALL COMXIPR ITEM CATPFN C(7); # MSF CATALOG PFN # ITEM DIS$SUBF C(10); # SUBFAMILY (DISPLAY CODE) # ITEM FAMILY C(7); # FAMILY NAME # ITEM I I; # LOOP COUNTER # CONTROL EJECT; ERRSTAT = CMASTAT"NOERR"; BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END FASTFOR I = 1 STEP 1 UNTIL OCTLEN DO BEGIN # SEARCH *OCT* # IF OCT$FAM[I] EQ FAMNM ## AND NOT OCT$INTLK[I] ## # AND NOT OCT$UMI[I] # AND B<(59-OCT$SUBF[I]),1>MASK EQ 1 THEN BEGIN # INTERLOCK TO BE GIVEN UP # PFP$FAM[0] = OCT$FAM[I]; # SET FAMILY AND USER INDEX # PFP$UI[0] = DEF$UI + OCT$SUBF[I]; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP); IF PFP$STAT NQ 0 THEN # IF FAMILY NOT FOUND # BEGIN CMA$RTN[0] = "CRELSMM."; MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE # ABORT; END CATPFN = SFMCAT; # REATTACH IN UPDATE MODE # DIS$SUBF = XCDD(OCT$SUBF[I]); C<6,1>CATPFN = C<9,1>DIS$SUBF; PFD("ATTACH",OCT$LFN[I],CATPFN,"M","U", "RC",PFSTAT,"NA",0,"UP",0,0); IF PFSTAT NQ 0 THEN # ATTACH ERROR # BEGIN CMSGLINE[0] = CMSG3; MESSAGE(CMSGAREA,UDFL1); CMSGLINE[0] = CMSGCLOSE; CMSGCSUBF[0] = C<9,1>DIS$SUBF; FAMILY = OCT$FAM[I]; BZFILL(FAMILY,TYPFILL"BFILL",7); CMSGCFAM[0] = FAMILY; RMVBLNK(CMSGAREA,48); MESSAGE(CMSGAREA,UDFL1); ZFILL(OCT[I],OCTENTL); # CLEAR *OCT* ENTRY # TEST I; END GLBINTLK = TRUE; # SET GLOBAL INTERLOCK FLAG # # OCT$UMI[I] = TRUE # RTIME(RTIMESTAT[0]); ITLK$EXPIR = RTIMSECS[0] + INLK$INTV; END # INTERLOCK TO BE GIVEN UP # END # SEARCH *OCT* # RETURN; END # CRELSMM # TERM PROC CRMVSC((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT); # TITLE CRMVSC - REMOVE SUBCATALOG. # BEGIN # CRMVSC # # ** CRMVSC - REMOVE SUBCATALOG. * * *CRMVSC* REMOVES THE SPECIFIED SUBCATALOG FROM THE CATALOG FILE. * THE CATALOG MUST BE OPEN IN MODIFY MODE. * * CRMVSC - IS CALLED BY RMVCSU. * * PROC CRMVSC((FAMNM),(SUBF),(SMID ),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE SUBCATALOG HAS BEEN REMOVED AND THE CATALOG * PREAMBLE HAS BEEN UPDATED TO REFLECT THE CHANGE. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * = FILE DEFINE ERROR. * = FILE ATTACH ERROR. * = FILE PURGE ERROR. * = FILE RENAME ERROR. * IF THE DESIRED FAMILY IS NOT FOUND ON A *SETPFP*, AN * ERROR MESSAGE IS ISSUED AND THE PROGRAM IS ABORTED. * * NOTES THE CATALOG IS RE-ATTACHED IN WRITE MODE BEFORE * REMOVING THE SUBCATALOG IN ORDER TO ALTER THE FILE * LENGTH, AND WHEN FINISHED, THE FILE IS ATTACHED IN * MODIFY MODE AGAIN. * * MESSAGES * PROGRAM ABNORMAL, CRMVSC.*. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CRMVSC - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC BFLUSH; # FLUSH *FCT* I/O BUFFER # PROC CDEFTF; # DEFINE TEMPORARY CATALOG # PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC MESSAGE; # ISSUE MESSAGE # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC READ; # READ FILE TO *CIO* BUFFER # PROC READW; # READ DATA TO WORKING BUFFER # PROC REPLCAT; # REPLACE MSF CATALOG # PROC REWIND; # REWIND A FILE # PROC SETPFP; # SET PERMANENT FILE PARAMETERS # PROC WRITEF; # WRITE END OF FILE # PROC WRITEW; # WRITE DATA FROM WORKING BUFFER # PROC ZSETFET; # INITIALIZES A FET # END # **** PROC CRMVSC - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMBPFP *CALL COMXMSC ITEM I I; # LOOP COUNTER # ITEM J I; # LOOP COUNTER # ITEM NAST I; # NUMBER OF PRU-S IN *AST* # ITEM NFCT I; # NUMBER OF PRU-S IN *FCT* # ITEM NPRU I; # NUMBER OF PRU-S TO REMOVE # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM RMV I; # SUBCATALOG LOCATION # ITEM STAT I; # STATUS # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; # RETURN ERROR STATUS # END BFLUSH(QRADDR,ERRSTAT); # FLUSH CATALOG *FCT* I/O BUFFER # FB$CWRD[0] = 0; IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END # * SET FAMILY AND USER INDEX. # PFP$WRD0[0] = 0; PFP$FAM[0] = OCT$FAM[ORD]; PFP$UI[0] = DEF$UI + OCT$SUBF[ORD]; PFP$FG1[0] = TRUE; PFP$FG4[0] = TRUE; SETPFP(PFP); IF PFP$STAT[0] NQ 0 THEN # IF FAMILY NOT FOUND # BEGIN CMA$RTN[0] = "CRMVSC."; MESSAGE(CMAMSG,UDFL1); # ISSUE ERROR MESSAGE # ABORT; END ZSETFET(TFETADR,OCT$LFN[ORD],FCTBADR,SEQBL,RFETL); FET$EP[0] = TRUE; ZSETFET(TFETADR+RFETL,TSFMCAT,TBUFADR,TBUFL,RFETL); FET$EP[0] = TRUE; REWIND(TFET[0],NRCL); CDEFTF(TFET[1],ERRSTAT); # DEFINE TEMPORARY CATALOG FILE # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END # * DETERMINE SUBCATALOG LENGTH. # NFCT = PRM$ENTRC[SMID] * 16; NAST = (MAXORD/PRULEN) * 2 + 1; NPRU = NFCT + NAST; # SUBCATALOG LENGTH IN PRU-S # # * UPDATE CATALOG PREAMBLE. # RMV = PRM$ASTLOC[SMID]; # SAVE SUBCATALOG LOCATION # PRM$SCW1[SMID ] = 0; # CLEAR ENTRY IN PREAMBLE # FASTFOR I = 1 STEP 1 UNTIL MAXSM DO BEGIN IF PRM$FCTLOC[I] GR RMV THEN # IF SUBCATALOG LOCATION CHANGED # BEGIN PRM$FCTLOC[I] = PRM$FCTLOC[I] - NPRU; PRM$ASTLOC[I] = PRM$ASTLOC[I] - NPRU; END END # * TRANSFER CATALOG FILE TO TEMPORARY FILE, REMOVING SUBCATALOG. # READ(TFET[0],RCL); READW(TFET[0],WBUF,WBUFL,STAT); IF STAT EQ CIOERR THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]); RETURN; END IF STAT NQ 0 THEN # IF TRANSFER NOT COMPLETE # BEGIN CMA$RTN[0] = "CRMVSC."; MESSAGE(CMAMSG,UDFL1); ABORT; END FASTFOR I = 0 STEP 1 UNTIL MAXSM DO # UPDATE CATALOG PREAMBLE # BEGIN WBUF$W[I*3+1] = PRM$SCW1[I]; WBUF$W[I*3+2] = PRM$SCW2[I]; WBUF$W[I*3+3] = PRM$SCW3[I]; END P = LOC(WBUF[0]); # CLEAR SECOND WORD OF ENTRY # PRM$SCW1[SMID] = 0; PRM$SCW2[SMID ] = 0; PRM$SCW3[SMID] = 0; WRITEW(TFET[1],WBUF,WBUFL,STAT); FASTFOR I = 2 STEP 1 WHILE STAT EQ 0 DO BEGIN # TRANSFER CATALOG # IF I EQ RMV # IF AT SUBCATALOG TO BE REMOVED # THEN BEGIN # SUBCATALOG TO BE REMOVED # FASTFOR J = 1 STEP 1 UNTIL NPRU DO BEGIN # SKIP SUBCATALOG # READW(TFET[0],WBUF,WBUFL,STAT); IF STAT EQ CIOERR THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]); RETURN; END IF STAT NQ 0 THEN # IF *EOR*, *EOF* OR *EOI* # BEGIN TEST I; # EXIT TRANSFER CATALOG LOOP # END END # SKIP SUBCATALOG # END # SUBCATALOG TO BE REMOVED # READW(TFET[0],WBUF,WBUFL,STAT); IF STAT EQ CIOERR THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[0]); RETURN; END IF STAT NQ 0 # IF *EOR*, *EOF*, OR *EOI* # THEN BEGIN TEST I; # EXIT LOOP # END WRITEW(TFET[1],WBUF,WBUFL,STAT); IF STAT NQ 0 THEN # IF *CIO* ERROR # BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END END # TRANSFER CATALOG # WRITEF(TFET[1],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,TFET[1]); RETURN; END # * REPLACE MSF CATALOG WITH NEW CATALOG (*TSFMCAT*). # REPLCAT(ORD,ERRSTAT); RETURN; END # CRMVSC # TERM PROC CWTAST((FAMNM),(SUBF),(SMID ),(BADDR),(QRADDR),ERRSTAT); # TITLE CWTAST - WRITE AVAILABLE STREAM TABLE. # BEGIN # CWTAST # # ** CWTAST - WRITE AVAILABLE STREAM TABLE. * * *CWTAST* WRITES THE ENTIRE ALLOCATION SUMMARY TABLE FROM THE * CALLERS BUFFER TO THE CATALOG FILE. THE FREE AU COUNT * IN THE CATALOG PREAMBLE IS UPDATED. THE CATALOG MUST BE * OPEN IN MODIFY MODE. * * CWTAST - IS CALLED BY ADDCAR,ADDCUBE,ADDCSU,ALLOCAT, * DESTAGR,OPENCAT,PURGCHN,PURGFCT,RLSUNS,RMVCAR, * RMVCUBE,STAGER,UPDCAT. * * PROC CWTAST((FAMNM),(SUBF),(SMID ),(BADDR),(QRADDR),ERRSTAT) * * ENTRY (FAMNM) - FAMILY NAME, LEFT JUSTIFIED, ZERO FILLED, * 7 CHARACTER MAXIMUM. * (SUBF) - SUBFAMILY DESIGNATOR. * (SMID ) - NUMERIC SM IDENTIFIER. * (BADDR) - ADDRESS OF BUFFER CONTAINING *AST*. * (QRADDR) - *HLRQ* ENTRY ADDRESS, ELSE ZERO. * * EXIT THE *AST* HAS BEEN WRITTEN FROM THE BUFFER AT THE * ADDRESS SPECIFIED BY (BADDR) TO THE CATALOG. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * = CATALOG NOT OPEN IN MODIFY MODE. * = NO SUCH SUBCATALOG. * = *CIO* ERROR. * * NOTES THE LENGTH OF THE *AST* MUST NOT BE CHANGED * BY THE CALLER. THE CALLERS BUFFER SIZE SHOULD * BE THE LENGTH OF THE *AST* ROUNDED UP TO A PRU * MULTIPLE OR LARGER. # ITEM FAMNM C(7); # FAMILY NAME # ITEM SUBF U; # SUBFAMILY DESIGNATOR # ITEM SMID U; # SM IDENTIFIER # ITEM BADDR U; # *AST* BUFFER ADDRESS # ITEM QRADDR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC CWTAST - XREF LIST BEGIN. # XREF BEGIN PROC CPIOERR; # PROCESS MSF CATALOG I/O ERROR # PROC OCTSRCH; # SEARCH OPEN CATALOG TABLE # PROC REWRITE; # REWRITE DATA FROM I/O BUFFER # PROC ZSETFET; # INITIALIZES A FET # PROC RPHR; # RANDOM READ # PROC WPHR; # RANDOM WRITE # END # **** PROC CWTAST - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBMCT *CALL COMXMSC *CALL COMSPFM ITEM COUNT I; # FREE STREAM COUNT # ITEM I I; # LOOP COUNTER # ITEM LENGTH I; # *AST* LENGTH # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # CONTROL EJECT; OCTSRCH(FAMNM,SUBF,ORD,QRADDR,ERRSTAT); # GET *OCT* ORDINAL # IF ERRSTAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; # RETURN ERROR STATUS # END IF OCT$ATTM[ORD] NQ "M" THEN # IF NOT OPEN IN MODIFY MODE # BEGIN ERRSTAT = CMASTAT"MODERR"; RETURN; # RETURN ERROR STATUS # END P = OCT$PRMA[ORD]; IF PRM$SCW1[SMID ] EQ 0 THEN # IF NO SUCH SUBCATALOG # BEGIN ERRSTAT = CMASTAT"NOSUBCAT"; RETURN; END COUNT = 0; P = BADDR; # * WRITE ENTIRE *AST* FROM CALLERS BUFFER TO CATALOG FILE. # LENGTH = ABUFLEN; ZSETFET(TFETADR,OCT$LFN[ORD],BADDR,LENGTH,RFETL); FET$EP[0] = TRUE; FET$IN[0] = FET$FRST[0] + LENGTH - 1; FET$R[0] = TRUE; FET$RR[0] = PRM$ASTLOC[SMID ]; REWRITE(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN CPIOERR(FAMNM,SUBF,QRADDR,ERRSTAT,FETSET[0]); RETURN; END # * WRITE UPDATED PREAMBLE TO CATALOG FILE. # ZSETFET(TFETADR,OCT$LFN[ORD],TBUFADR,2*PRULEN,RFETL); FET$EP[0] = TRUE; FET$R[0] = TRUE; FET$RR[0] = 1; RPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN # READ ERROR # BEGIN ERRSTAT = CMASTAT"CIOERR"; FET$AT[0] = 0; END P = OCT$PRMA[ORD]; FASTFOR I = 0 STEP 1 UNTIL MAXSM DO # TRANSFER PREAMBLE TO TBUF # BEGIN TBUF$W[I + 1] = PRM$SCW1[I]; TBUF$W1[I + 1] = PRM$SCW2[I]; TBUF$W2[I + 1] = PRM$SCW3[I]; END FET$RR[0] = 1; FET$W[0] = TRUE; WPHR(FETSET[0],RCL); IF FET$AT[0] NQ 0 THEN BEGIN ERRSTAT = CMASTAT"CIOERR"; FET$AT[0] = 0; END RETURN; END # CWTAST # TERM PROC OCTSRCH((FAM),(SUB),ORD,(QRADR),ERRSTAT); # TITLE OCTSRCH - OPEN CATALOG TABLE SEARCH. # BEGIN # OCTSRCH # # ** OCTSRCH - OPEN CATALOG TABLE SEARCH. * * *OCTSRCH* SEARCHES THE OPEN CATALOG TABLE TO GET THE ORDINAL * OF THE ENTRY WITH THE SPECIFIED FAMILY NAME AND SUBFAMILY * DESIGNATOR. * * OCTSRCH - IS CALLED BY CADDSC,CBUFMAN,CCLOSE,CEXTSC,CFLUSH, * CGETPD,CPUTPD,CRDAST,CRMVSC,CSELSC,CWTAST,PURGCHN.* * * PROC OCTSRCH((FAM),(SUB),ORD,(QRADR),ERRSTAT) * * ENTRY (FAM) - FAMILY NAME. * (SUB) - SUBFAMILY DESIGNATOR. * (QRADR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. * * EXIT (ORD) - THE ORDINAL OF THE DESIRED ENTRY, IF NO * ERRORS. * (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = CATALOG FILE INTERLOCKED. * = CATALOG NOT OPEN. * IF THE CATALOG IS INTERLOCKED AND (QRADR) IS NON-ZERO, * THE CATALOG ACCESS REQUEST IS ADDED TO THE END OF A * WAITING-FOR-INTERLOCK CHAIN. * * NOTES CATALOG ACCESS REQUESTS FROM *MSSEXEC* PASS THE * ADDRESS OF THE *HLRQ* ENTRY ASSOCIATED WITH THE * REQUEST, SO THAT THE REQUEST CAN BE QUEUED IF THE * CATALOG IS INTERLOCKED. REQUESTS FROM MSS UTILITIES * SET (QRADR) EQUAL TO ZERO AND MUST BE RETRIED IF THE * CATALOG IS INTERLOCKED. # ITEM FAM C(7); # FAMILY NAME # ITEM SUB U; # SUBFAMILY DESIGNATOR # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM QRADR U; # *HLRQ* ENTRY ADDRESS # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC OCTSRCH - XREF LIST BEGIN. # XREF BEGIN PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # END # **** PROC OCTSRCH - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBCMD *CALL COMBCMS *CALL COMXHLR ITEM I I; # LOOP COUNTER # CONTROL EJECT; # * SEARCH THE *OCT* FOR THE REQUESTED ENTRY. # ERRSTAT = CMASTAT"NOERR"; ORD = 0; FASTFOR I = 1 STEP 1 WHILE ORD EQ 0 AND I LQ OCTLEN DO BEGIN # SEARCH FOR ENTRY # IF OCT$SUBF[I] EQ SUB ## AND OCT$FAM[I] EQ FAM THEN BEGIN # REQUESTED ENTRY FOUND # ORD = I; IF OCT$INTLK[I] THEN # IF CATALOG INTERLOCKED # BEGIN ERRSTAT = CMASTAT"INTLK"; IF QRADR NQ 0 THEN BEGIN # ADD REQUEST TO WAITING-FOR-INTERLOCK CHAIN # IF OCT$LINK[I] EQ 0 THEN # IF EMPTY CHAIN # BEGIN OCT$LINK[I] = QRADR; END ELSE BEGIN P = OCT$LINK[I]; REPEAT WHILE HLR$LNK1[0] NQ 0 DO # SEARCH FOR END OF CHAIN # BEGIN P = HLR$LNK1[0]; END HLR$LNK1[0] = QRADR; END END # ADD REQUEST TO WAITING-FOR-INTERLOCK CHAIN # END END # REQUESTED ENTRY FOUND # END # SEARCH FOR ENTRY # IF ORD EQ 0 THEN # IF CATALOG NOT OPEN # BEGIN ERRSTAT = CMASTAT"NOTOPEN"; END RETURN; END # OCTSRCH # TERM PROC REPLCAT((ORD),ERRSTAT); # TITLE REPLCAT - REPLACES THE MSF CATALOG. # BEGIN # REPLCAT # # ** REPLCAT - REPLACES THE MSF CATALOG. * * *REPLCAT* REPLACES THE MSF CATALOG WITH THE TEMPORARY CATALOG * (*TSFMCAT*) CREATED BY *CADDSC*, *CEXTSC* OR *CRMVSC*. THE * OLD CATALOG IS PURGED. THE TEMPORARY CATALOG IS REATTACHED * IN MODIFY MODE AND THE TEMPORARY CATALOG FILE NAME IS CHANGED * TO THE ACTUAL CATALOG FILE NAME. * * REPLCAT - IS CALLED BY CADDSC,CEXTSC,CRMVSC. * * * PROC REPLCAT((ORD),ERRSTAT) * * ENTRY (ORD) = ORDINAL OF *OCT* ENTRY FOR CATALOG. * TFETADR = ADDRESS OF FET FOR MSF CATALOG. * TFETADR+RFETL = ADDRESS OF FET FOR TEMPORARY CATALOG. * * THE MSF CATALOG IS ATTACHED IN MODIFY MODE AND * THE NEWLY CREATED CATALOG, *TSFMCAT*, IS ATTACHED * IN WRITE MODE. * * EXIT (ERRSTAT) - ERROR STATUS. * (VALUES DEFINED IN *COMBCMS*) * = NO ERRORS. * = TEMPORARY FILE ATTACH ERROR. * = TEMPORARY FILE PURGE ERROR. * = TEMPORARY FILE RENAME ERROR. * THE MSF CATALOG IS REPLACED WITH *TSFMCAT*. * * MESSAGES * MSF CATALOG REPLACE ERROR. * SFMCATN FOR FAMILY FFFFFFF CLOSED.* * * * DEVICE UNAVAILABLE ON MSF CATALOG ACCESS. * SFMCATN FOR FAMILY FFFFFFF CLOSED.* * * NOTES IF AN ERROR IDLE STATUS IS RETURNED ON A *PFM* * REQUEST, *REPLCAT* WILL RESTORE THE MSF CATALOG * TO ITS PRIOR STATE (BEFORE CURRENT UPDATE). IF * SOME OTHER ERROR IS RETURNED, ANALYST INTERVENTION * MAY BE REQUIRED TO RESTORE THE CATALOG. IN EITHER * CASE THE CATALOG WILL BE CLOSED. # ITEM ORD I; # ORDINAL OF *OCT* ENTRY # ITEM ERRSTAT I; # ERROR STATUS # # **** PROC REPLCAT - XREF LIST BEGIN. # XREF BEGIN PROC BZFILL; # BLANK OR ZERO FILL WORD # PROC MESSAGE; # ISSUE MESSAGE # PROC PFD; # PERMANENT FILE REQUEST DELAYS # PROC READ; # READ FILE TO *CIO* BUFFER # PROC RENAME; # RENAME LOCAL FILE # PROC RETERN; # RETURN A FILE # PROC REWIND; # REWIND A FILE # PROC RMVBLNK; # REMOVE MULTIPLE BLANKS # PROC WRITE; # WRITE DATA FROM *CIO* BUFFER # PROC WRITEF; # WRITE END OF FILE # FUNC XCDD C(10); # CONVERT DECIMAL TO DISPLAY # PROC ZFILL; # ZERO FILL BUFFER # END # **** PROC REPLCAT - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMDECKS # *CALL COMBFAS *CALL COMBBZF *CALL COMBCMD *CALL COMBCMS *CALL COMBFET *CALL COMBPFS *CALL COMXMSC *CALL COMSPFM ITEM CATPFN C(7); # MSF CATALOG PFN # ITEM DEV$NA B; # DEVICE NOT AVAILABLE FLAG # ITEM DIS$SUBF C(10); # SUBFAMILY (DISPLAY CODE) # ITEM FAMILY C(7); # FAMILY NAME # CONTROL EJECT; P = TFETADR; DEV$NA = FALSE; # * PURGE OLD CATALOG FILE. # CATPFN = SFMCAT; # BUILD CATALOG PFN # DIS$SUBF = XCDD(OCT$SUBF[ORD]); C<6,1>CATPFN = C<9,1>DIS$SUBF; PFD("PURGE",CATPFN,"RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN BEGIN DEV$NA = PFSTAT EQ PFN; ERRSTAT = CMASTAT"TPRGERR"; PFD("PURGE",TSFMCAT,"RC",PFSTAT,"UP",0,"SR","IE",0); GOTO RETNCAT; END # * REATTACH CATALOG IN MODIFY MODE. # PFD("ATTACH",TSFMCAT,0,"M","M","RC",PFSTAT,"NA",0,"UP",0,0); IF PFSTAT NQ 0 THEN BEGIN # ATTACH ERROR # ERRSTAT = CMASTAT"TATTERR"; IF PFSTAT EQ PFN THEN BEGIN GOTO RESTCAT; END ELSE BEGIN GOTO RETNCAT; END END # ATTACH ERROR # # * CHANGE TEMPORARY FILE NAME TO ACTUAL CATALOG NAME. # PFD("CHANGE",CATPFN,TSFMCAT,"RC",PFSTAT,"UP",0,0); IF PFSTAT NQ 0 THEN BEGIN # CHANGE ERROR # ERRSTAT = CMASTAT"TRNMERR"; IF PFSTAT EQ PFN THEN BEGIN GOTO RESTCAT; END ELSE BEGIN GOTO RETNCAT; END END # CHANGE ERROR # RETERN(FETSET[0],RCL); RENAME(FETSET[1],OCT$LFN[ORD]); RETURN; RESTCAT: # RESTORE ORIGINAL CATALOG # PFD("ATTACH",TSFMCAT,0,"M","W","RC",PFSTAT,"NA",0, ## "UP",0,"SR","IE",0); FET$IN[0] = FET$FRST[0]; # RESET FET POINTERS # FET$OUT[0] = FET$FRST[0]; FET$IN[1] = FET$FRST[1]; FET$OUT[1] = FET$FRST[1]; REWIND(FETSET[0],NRCL); REPEAT WHILE NOT FET$EOI[0] DO BEGIN READ(FETSET[0],RCL); FET$IN[1] = FET$IN[0]; WRITE(FETSET[1],RCL); FET$OUT[0] = FET$OUT[1]; END WRITEF(FETSET[1],RCL); PFD("CHANGE",CATPFN,TSFMCAT,"RC",PFSTAT,"UP",0,"SR","IE",0); DEV$NA = TRUE; RETNCAT: # RETURN LOCAL CATALOGS # RETERN(FETSET[0],RCL); RETERN(FETSET[1],RCL); IF DEV$NA # ISSUE ERROR MESSAGE # THEN BEGIN CMSGLINE[0] = CMSG1; END ELSE BEGIN CMSGLINE[0] = CMSG2; END MESSAGE(CMSGAREA,UDFL1); # ISSUE ERROR MESSAGE # CMSGLINE[0] = CMSGCLOSE; FAMILY = OCT$FAM[ORD]; BZFILL(FAMILY,TYPFILL"BFILL",7); CMSGCFAM[0] = FAMILY; CMSGCSUBF[0] = C<9,1>DIS$SUBF; RMVBLNK(CMSGAREA,48); MESSAGE(CMSGAREA,UDFL1); ZFILL(OCT[ORD],OCTENTL); RETURN; END # REPLCAT # TERM