IDENT ISF,FWA ABS SST ENTRY ISF ENTRY RFL= ENTRY SSJ= SYSCOM B1 DEFINE (B1) = 1 *COMMENT ISF - INITIALIZE SYSTEM FILES. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. TITLE ISF - INITIALIZE SYSTEM FILES. SPACE 4 *** ISF - INITIALIZE SYSTEM FILES. * G. R. MANSFIELD. 71/07/07. * S. L. KSANDER. 75/04/28. * P. C. SMITH. 78/01/30. SPACE 4 *** ISF PROCESSES AND/OR INITIALIZES SPECIAL SYSTEM FILES. * ALL FILES ARE FOUND ON USER NAME *SYSTEMX* (UI = 377777). * * COMMAND FORMAT - * * ISF(R=FILE1,E=FILE2,FM=FAMILY,SJ=FILE3,SP=FILE4) * * R = RETURN FAST ATTACH FILE. * *FILE1* = NAME OF FILE TO BE RETURNED. * IF R=0, ALL FAST ATTACH FILES WILL BE RETURNED. * * E = ENTER NEW FILE. * *FILE2* = NAME OF FILE TO BE ENTERED. * IF E=0, ALL FILES WILL BE ENTERED. * FAST ATTACH FILES MUST BE RETURNED BEFORE THEY * ARE RE-ENTERED. R AND E OPTIONS CAN NOT APPEAR ON THE * SAME COMMAND. * * FM = FAMILY NAME. * IF NOT PRESENT, *ISF* WILL PROCESS FILES FOR THE * JOBS FAMILY. * * IF PRESENT, *ISF* WILL PROCESS FILES BELONGING TO THE * SPECIFIED FAMILY. IF THE *E=0* OPTION IS SELECTED, * RESOURCE FILES WILL BE SET UP, IF THEY ARE NOT * ALREADY PRESENT IN FAST ATTACH MODE. IF THE *R=0* * OPTION IS SELECTED, RESOURCE FILE OPERATIONS ARE * IGNORED. THE JOB-S FAMILY WILL BE RESTORED UPON * EXIT FROM *ISF*. * * SJ = SUBMIT JOB WHEN ISF IS COMPLETE. * *FILE3* = NAME OF JOB FILE TO BE SUBMITTED * (MUST BE INDIRECT ACCESS PERMANENT FILE). * IF *SJ* IS SPECIFIED BUT NOT EQUIVALENCED, * *SYSJOB* WILL BE SUBMITTED. IF SJ=0, * NO JOB WILL BE SUBMITTED. * * SP = CALL PROCEDURE FILE WHEN ISF IS COMPLETE. * *FILE4* = NAME OF PROCEDURE FILE TO BE CALLED * (MUST BE INDIRECT ACCESS PERMANENT FILE). * IF *SP* IS SPECIFIED BUT NOT EQUIVALENCED, * *SYSPROC* WILL BE CALLED. IF SP=0, * NO PROCEDURE FILE WILL BE CALLED. * * NOTES - * * IF THE R OR E OPTION IS SPECIFIED FOR ONE OF THE * RESOURCE FILES (RSXDXX OR RSXVXX), THE OPERATION WILL * ALSO BE PERFORMED AUTOMATICALLY ON THE OTHER FILE. * * IF THE *R* OPTION IS SPECIFIED THE PROFILE FILE (IF IT * EXISTS) IS ATTACHED IN WRITE MODE. THIS IS AN INTERLOCK * TO PREVENT *CHARGE* COMMAND PROCESSING IN THE FAMILY FOR * THE DURATION OF THE *ISF* EXECUTION. * * ASSUMED - * E = 0. * FM = 0. * SJ = 0. * SP = 0. * R NOT SELECTED. SPACE 4 *** DAYFILE MESSAGES - * * * ARGUMENT ERROR.* * INCORRECT PARAMETER OR COMBINATION OF PARAMETERS. * * * FAMILY FILES ACTIVE.* * THE NUMBER OF ACTIVE DIRECT ACCESS FILES ON THE * FAMILY IS GREATER THAN THE NUMBER OF FAST * ATTACH FILES. * * * FILE NOT IN ALTERNATE FAMILY.* * FAMILY SPECIFIED FOR DEFAULT FAMILY FILE. * * * INCORRECT FAMILY NAME.* * FAMILY NOT FOUND. * * * INCORRECT FILE NAME.* * FILE NAME NOT ON LIST OF SPECIAL FILES. * * * ISF COMPLETE.* * OPERATION COMPLETE. SPACE 4,10 **** ASSEMBLY CONSTANTS. SBUFL EQU ESMX*ESTE+77B/100B*100B+1 FILE BUFFER LENGTH RDFL EQU 36B-1 (LENGTH - 1) OF RSXDXX IN PRUS RVFL EQU 36B-1 (LENGTH - 1) OF RSXVXX IN PRUS **** SPACE 4 *CALL COMCMAC *CALL COMCCMD *CALL COMSACC *CALL COMSPFM *CALL COMSPRD *CALL COMSPRO *CALL COMSSCD *CALL COMSSFM *CALL COMSSSJ *CALL COMSSSD TITLE DATA ASSIGNMENTS. DATA SPACE 4 ** DATA ASSIGNMENTS. ORG 110B FWA BSS 0 S BSS 0 SYSTEM FILEB SBUF,SBUFL,(FET=CFLM),EPR T BSS 0 PROFILE FILE SCR FILEB 0,0,(FET=CFPK+1),EPR SSJ= BSS 0 SPECIAL SYSTEM JOB PARAMETER BLOCK VFD 36/0,12/ISCS,12/UJSI BSSZ SSJL-1 * TEMPORARY STORAGE. ESTO CON 0 EST ORDINAL FOR SUSPECT SEARCH FAMD CON 0L0 SYSTEM DEFAULT FAMILY FAMN CON 0 NEW FAMILY FAMU CON 0 USER-S FAMILY LEST CON 0 LAST EST ORDINAL + 1 PRAF CON 0 PROFILE ATTACHED FLAG RSBP CON 0 *RSB* POINTER TITLE MAIN PROGRAM. ISF SPACE 4 ** ISF - MAIN PROGRAM. ISF SB1 1 PRESET PROGRAM RJ PRS RJ WMV WAIT FOR *1MV* TO COMPLETE SX5 TSFNL NUMBER OF SPECIAL FILES * EAF - ENTER ALL FILES. EAF SX5 X5-1 (RETURN POINT FROM PROCESSORS) NG X5,EAF1 IF NO MORE SPECIAL FILES SA1 TSFN+X5 SPECIAL FILE NAME ZR X1,EAF IF FILE NAME CLEARED MX0 42 SB2 X1+ PROCESSOR ADDRESS BX1 X0*X1 JP B2 ENTER SPECIAL FILE EAF1 SX5 TDFFL NUMBER OF DEFAULT FAMILY FILES EAF2 SX5 X5-1 NG X5,END IF NO MORE DEFAULT FAMILY FILES SA1 TDFF+X5 DEFAULT FAMILY SPECIAL FILE NAME ZR X1,EAF2 IF FILE NAME CLEARED MX0 42 SX6 X1+ LENGTH OF FILE IN PRUS BX1 X0*X1 RJ EDF ENTER DEFAULT FAMILY FILE EQ EAF2 PROCESS NEXT FILE END SPACE 4,10 ** END - TERMINATION PROCESSING. END RJ SJF SUBMIT JOB FILE RJ SPC SET PROCEDURE FILE CALL RJ RPF RETURN PROFILE FILE MESSAGE (=C* ISF COMPLETE.*) SA1 SPCB+1 ZR X1,END1 IF NO PROCEDURE FILE EXCST SPCB CALL PROCEDURE FILE END1 RJ RIF RESTORE INITIAL FAMILY ENDRUN SPACE 4 ** TSFN - TABLE OF SPECIAL FILE NAMES. * *T 42/FILE NAME,18/PROCESSOR ADDRESS TSFN BSS 0 CON 0L"APFN"+EFF VALIDATION FILE PRFN CON 0L"PPFN"+EFF PROJECT PROFILE FILE TSFNL EQU *-TSFN TDFF SPACE 4,10 ** TDFF - TABLE OF DEFAULT FAMILY SPECIAL FILE NAMES. * (THIS TABLE IS A CONTINUATION OF TSFN, AND MUST FOLLOW IT.) * *T 42/FILE NAME,18/FILE SIZE TDFF BSS 0 RDFN CON 0LRSXDXX+RDFL RESOURCE DEMAND FILE RVFN CON 0LRSXVXX+RVFL RESOURCE VSN FILE TDFFL EQU *-TDFF CON 0 END OF TABLE ERF SPACE 4 ** EDF - ENTER DEFAULT FAMILY FILE. * * IF FILE IS PRESENT AS FAST ATTACH, ACCEPT IT AS IS. * OTHERWISE, DEFINE THE FILE IF NECESSARY AND INITIALIZE IT. * * ENTRY (X1) = FILE NAME. * (X6) = SIZE OF FILE IN PRUS. * * USES X - 0, 1, 6, 7. * A - 1, 6, 7. * * CALLS CES. * * MACROS ATTACH, DEFINE, ENFA, MESSAGE, PURGE, RECALL, RETURN, * WRITER, WRITEW. EDF4 RETURN X2 EDF SUBR ENTRY/EXIT SA6 EDFA SAVE FILE SIZE SX7 B1 BX7 X1+X7 RECALL S SA7 X2+ ATTACH X2,,,,R,,,DF,FA ATTEMPT FAST ATTACH RJ CES CHECK FET ERROR STATUS ZR X0,EDF4 IF FILE IS ALREADY FAST ATTACH NZ X3,EDF3 IF NOT *FILE NOT FOUND* ATTACH X2,,,,W,,,DF,IE ATTEMPT REGULAR ATTACH RJ CES CHECK ERROR STATUS ZR X0,EDF1 IF ATTACH SUCCESSFUL ZR X3,EDF0 IF *FILE NOT FOUND* * FOR ERROR OTHER THAN *FILE NOT FOUND*, PURGE EXISTING FILE. PURGE X2,,,,,DF,IE RJ CES CHECK ERROR STATUS NZ X0,EDF3 IF ERROR IN PURGE * CREATE A NEW RESOURCE FILE. THE FILE WILL BE CREATED WITH * *BR=N* TO AVOID THE NECESSITY OF *PFDUMP* PROCESSING, AND * TO PREVENT A POTENTIAL DEADLOCK BETWEEN *PFDUMP* AND *RESEX*. EDF0 SA1 X2+B1 CLEAR DEVICE TYPE IN FET MX0 12 BX6 -X0*X1 SA6 A1 DEFINE X2,,,,,,,,,DF,N,,IE RJ CES CHECK ERROR STATUS NZ X0,EDF3 IF ERROR IN DEFINE EDF1 SA1 X2+B1 SET OUT=IN=FIRST SX6 X1 SA6 A1+B1 SA6 A6+B1 * INITIALIZE RESOURCE FILE. SA1 X2+B1 CLEAR ERROR PROCESSING BIT MX6 1 LX6 44-59 BX6 -X6*X1 SA6 A1 WRITER X2,R WRITE INITIAL EOR SA1 EDFA LENGTH OF FILE SX0 X1+ EDF2 SX0 X0-1 WRITEW X2,ZBUF,64 WRITE SECTOR OF DATA NZ X0,EDF2 IF NOT COMPLETE WRITER X2,R WRITE FINAL BUFFER OF DATA SA1 X2+B1 SET ERROR PROCESSING BIT MX6 1 LX6 44-59 BX6 X6+X1 SA6 A1 ENFA X2 ENTER LOCAL FAST ATTACH EQ EDF4 RETURN EDF3 MESSAGE CERM ISSUE ERROR MESSAGE EQ EDFX RETURN EDFA CON 0 FILE SIZE EFF SPACE 4,15 ** EFF - ENTER FAST ATTACH FILE. * * ENTRY (X1) = FILE NAME. * * EXIT TO EAF. * * CALLS CES, SFF. * * MACROS ATTACH, ENFA, MESSAGE, RETURN. EFF BSS 0 ENTRY RJ SFF SET FILE NAME IN FET ATTACH X2,,,,W,,,IP,FA ATTEMPT FAST ATTACH RJ CES CHECK ERROR STATUS ZR X0,EFF0 IF FILE IS ALREADY FAST ATTACH ZR X6,EFF0 IF *FILE BUSY* NZ X3,EFF2 IF NOT *FILE NOT FOUND* ATTACH X2,,,,W,,,IP,IE ATTEMPT NORMAL ATTACH RJ CES CHECK ERROR STATUS NZ X0,EFF1 IF ERROR IN ACCESS ENFA X2,GLOBAL ENTER GLOBAL FAST ATTACH FILE EFF0 RETURN X2 EQ EAF PROCESS NEXT FILE EFF1 NZ X6,EFF2 IF NOT *FILE BUSY* ENFA X2,LINK LINK TO EXISTING FAST ATTACH RETURN X2 EQ EAF PROCESS NEXT FILE EFF2 MESSAGE CERM ISSUE ERROR MESSAGE EQ EAF PROCESS NEXT FILE RTF SPACE 4,10 ** RTF - RETURN FAST ATTACH FILE. * * ENTRY (X1) = FILE NAME. * * USES X - 0, 2, 7. * A - 2, 7. * * CALLS CER, SFF. * * MACROS ATTACH, DFAT, RETURN. RTF SUBR ENTRY/EXIT SA2 PRFN BX2 X2-X1 MX0 42 BX7 X0*X2 NZ X7,RTF1 IF NOT ATTACHING PROFILE SA2 PRAF ZR X2,RTFX IF PROFILE DOES NOT EXIST MX7 0 CLEAR PROFILE ATTACHED FLAG SA7 PRAF DFAT T RETURN T EQ RTFX RETURN RTF1 RJ SFF SET FILE NAME IN FET ATTACH X2,,,,W,,,IP,FA RJ CER CHECK ERROR STATUS NZ X0,RTFX IF ERROR IN ACCESS DFAT X2 RETURN X2 EQ RTFX RETURN SJF SPACE 4,15 ** SJF - SUBMIT JOB FILE. * * ENTRY (SJFA) = SUBMIT JOB FILE NAME. * * EXIT JOB SUBMITTED, IF FOUND. * * USES X - 1, 6. * A - 1. * * CALLS CER, SFF. * * MACROS GET, ROUTE. SJF SUBR ENTRY/EXIT SA1 SJFA MX6 42 BX1 X6*X1 ZR X1,SJFX IF NO SUBMIT JOB RJ SFF SET FILE NAME IN FET GET X2,,,,,,IP,IE GET SUBMIT JOB FILE RJ CER CHECK ERROR NZ X0,SJFX IF ERROR ROUTE SJFA,R SUBMIT SYSTEM-ORIGIN JOB EQ SJFX RETURN SJFA BSS 0 *DSP* PARAMETER BLOCK VFD 42/0,6/0,1/1,4/0,6/SYOT,1/0 VFD 24/0,12/2RIN,12/40B,12/22B BSSZ 5 SPC SPACE 4,15 ** SPC - SET PROCEDURE CALL. * * ENTRY (SPCA) = PROCEDURE FILE NAME. * * EXIT FILE NAME SET IN CALL, IF FILE FOUND. * * USES X - 1. * A - 1, 6. * * CALLS CER, SFF, SFN. * * MACROS GET, SETFS. SPC SUBR ENTRY/EXIT SA1 SPCA ZR X1,SPCX IF NO PROCEDURE FILE RJ SFF SET FILE NAME IN FET GET X2,,,,,,IP,IE GET PROCEDURE FILE RJ CER CHECK ERROR NZ X0,SPCX IF ERROR SETFS X2,0 CLEAR SPECIAL SYSTEM FILE STATUS SA1 SPCA SET PROCEDURE FILE NAME IN CALL RJ SFN SA6 SPCB+1 EQ SPCX RETURN SPCA CON 0 PROCEDURE FILE NAME SPCB CON 10H$BEGIN,, CON 0 CON 1L. TITLE SUBROUTINES. CER SPACE 4,10 ** CER - CHECK ERROR AND ISSUE MESSAGE. * * ENTRY (X2) = FWA OF FET. * * EXIT (X0) = FET ERROR STATUS. * * USES X - 0. * * CALLS CES. * * MACROS MESSAGE. CER SUBR ENTRY/EXIT RJ CES CHECK ERROR STATUS ZR X0,CERX IF NO ERROR MESSAGE CERM EQ CERX CERM BSSZ 4 ERROR MESSAGE BUFFER CES SPACE 4,10 ** CES - CHECK AND CLEAR ERROR STATUS IN FET. * * ENTRY (X2) = FWA OF FET. * * EXIT (X0) = FET ERROR STATUS. * (X3) = 0 IF *FILE NOT FOUND* STATUS. * (X6) = 0 IF *FILE BUSY* STATUS. * * USES A - 1, 6. * X - 0, 1, 3, 6. CES SUBR ENTRY/EXIT SA1 X2 READ FET STATUS MX3 -8 LX1 -10 BX0 -X3*X1 ERROR STATUS BX6 X3*X1 CLEAR STATUS IN FET SX3 X0-/ERRMSG/FNF *FILE NOT FOUND* STATUS LX6 10 SA6 A1+ SX6 X0-/ERRMSG/FBS *FILE BUSY* STATUS EQ CESX RETURN PEC SPACE 4,10 ** PEC - PROCESS EXIT CLEANUP. * * CALLS RIF, RPF. PEC SUBR ENTRY/EXIT RJ RIF RESTORE INITIAL FAMILY RJ RPF RETURN PROFILE FILE EQ PECX RETURN RIF SPACE 4,10 ** RIF - RESTORE INITIAL FAMILY. * * USES A - 1. * X - 1, 6. * * MACROS ENFAM. RIF SUBR ENTRY/EXIT SA1 FAMU ZR X1,RIFX IF USER-S FAMILY NOT SET ENFAM FAMU RESTORE FAMILY MX6 0 CLEAR USER-S FAMILY SA6 FAMU EQ RIFX RETURN RPF SPACE 4,10 ** RPF - RETURN PROFILE FILE. * * USES A - 1, 6. * X - 1, 6. * * MACROS RETURN. RPF SUBR ENTRY/EXIT SA1 PRAF ZR X1,RPFX IF PROFILE NOT ATTACHED MX6 0 SA6 PRAF CLEAR PROFILE ATTACHED FLAG RETURN T EQ RPFX RETURN SFF SPACE 4,10 ** SFF - SET FILE NAME IN FET. * * ENTRY (X1) = FILE NAME. * * EXIT (X2) = FWA OF FET. * * USES X - 2, 7. * A - 7. * * MACROS RECALL. SFF SUBR ENTRY/EXIT SX7 B1 STORE FILE NAME BX7 X1+X7 RECALL S SA7 X2 EQ SFFX RETURN WMV SPACE 4,10 ** WMV - WAIT FOR *1MV* TO COMPLETE. * * USES X - ALL. * A - 1, 2, 5, 6, 7. * * CALLS RSB=. * * MACROS MESSAGE, RECALL, SYSTEM. WMV SUBR ENTRY/EXIT MESSAGE (=C* WAIT 1MV COMPLETE.*),1 SA1 WMVA READ EST POINTER WORD MX6 1 BX7 X1 SA6 SBUF SET LOW CORE READ SA7 RSBP SYSTEM RSB,R,RSBP READ *ESTP* SA2 SBUF SET *COMCRSB* ENTRY CONDITIONS MX3 -12 SX1 A2 SET ADDRESS TO TRANSFER TO AX2 12 BX7 -X3*X2 AX2 24 SET ADDRESS TO TRANSFER FROM R= X6,ESTE SA7 LEST SAVE LAST EST ORDINAL + 1 IX3 X7*X6 SET WORD COUNT SX4 B0 SET SUBSYSTEM (= *CMR*) MX6 1 SA6 X1 RJ RSB= READ EST INTO *SBUF* SX6 NOPE INITIALIZE EST ORDINAL FOR SEARCH SA6 ESTO WMV1 SA5 ESTO SX7 X5+B1 SA7 A5 SA1 LEST CHECK ORDINAL IX6 X5-X1 R= X0,ESTE IX7 X5*X0 SA1 SBUF+X7+EQDE GET EST ENTRY MX0 -12 ZR X6,WMVX IF END OF EST PL X1,WMV1 IF NOT MASS STORAGE SX7 MSTB SET MST BUFFER ADDRESS SX2 MSTL BX1 -X0*X1 LX2 36 LX1 18+3 MST ADDRESS BX7 X7+X2 BX7 X1+X7 SA7 RSBP WMV2 MX6 1 SA6 MSTB FLAG LOW CORE READ SYSTEM RSB,R,RSBP READ MST SA1 MSTB+DALL CHECK FOR SUSPECT SX6 1200B SX7 200B LX1 12 BX1 X6*X1 BX1 X7-X1 NZ X1,WMV1 IF *OFF*, *DOWN*, OR NOT SUSPECT RECALL EQ WMV2 RECHECK DEVICE FOR SUSPECT WMVA VFD 24/1,18/ESTP,18/SBUF SPACE 4 * COMMON DECKS. *CALL COMCQFM *CALL COMCCIO *CALL COMCCPM *CALL COMCLFM *CALL COMCPFM *CALL COMCRDW *CALL COMCRSB *CALL COMCSFM *CALL COMCSFN *CALL COMCSYS *CALL COMCWTW TITLE PRESET. BUFFERS SPACE 4,10 * BUFFERS. USE // SEG ZBUF BSSZ 100B SECTOR OF ZEROES SBUF BSS SBUFL CIO BUFFER FOR S MSTB BSS MSTL MST BUFFER RFL= EQU *+8 ALLOW FOR *COMCWTW* LOOK-AHEAD ORG SBUF PRS SPACE 4 ** PRS - PRESET PROGRAM. PRS SUBR ENTRY/EXIT SX7 CERM SET ERROR MESSAGE BUFFER ADDRESS SA7 S+CFPW MACHID PRSA RETRIEVE MACHINE ID SA3 PRSA MX0 12 SA1 RDFN SET ID IN RESEX FILE NAMES SA2 RVFN LX0 -24 BX1 -X0*X1 LX3 24 BX2 -X0*X2 BX6 X3+X1 SA6 A1 BX7 X3+X2 SA7 A2 SA1 ACTR SB4 X1 ZR B4,PRSX IF NO ARGUMENTS SA4 ARGR FIRST ARGUMENT SB5 TARG ARGUMENT TABLE RJ ARG NZ X1,PRS16.1 IF ERROR * CHANGE TO SPECIFIED FAMILY. ENFAM FAMD SET DEFAULT FAMILY SA1 FAMD SAVE USER-S FAMILY NAME MX0 48 BX6 X0*X1 SA6 FAMU SA1 FAM SAVE NEW FAMILY NAME BX7 X1 SA7 FAMN NZ X1,PRS1 IF *FM* SPECIFIED SA6 FAMN USE USER-S FAMILY PRS1 ENFAM FAMN SET FAMILY WHERE FILES ARE LOCATED SA1 FAMN BX6 X0*X1 LX1 59-11 NG X1,PRS17 IF INCORRECT FAMILY SA6 FAMD * CHECK FILE RETURN REQUEST. SA1 RET ZR X1,PRS11 IF NO RETURN SA2 ENT NZ X2,PRS16 IF BOTH *E* AND *R* SPECIFIED RJ CFC CHECK FILE COUNT SA1 RET SX3 0L0 LX3 42 BX2 X1-X3 ZR X2,PRS7 IF ALL FILES TO BE RETURNED * PROCESS *R*=FILENAME. * SEARCH FILE LIST. SB4 TSFN SEARCH SPECIAL FILE TABLE SB5 TSFN+TSFNL SB3 B1+ DONT FORCE DEFAULT FAMILY PRS2 SA2 B4 BX7 X2-X1 SB4 B4+B1 AX7 18 ZR X7,PRS3 IF FOUND LT B4,B5,PRS2 IF NOT END OF TABLE ZR B3,PRS14 IF NOT VALID FILE NAME SB4 TDFF SB5 TDFF+TDFFL SB3 B0 FORCE DEFAULT FAMILY EQ PRS2 SEARCH DEFAULT FAMILY FILE TABLE PRS3 NZ B3,PRS6 IF NOT DEFAULT FAMILY FILE SA3 FAM NZ X3,PRS4 IF *FM* SPECIFIED SA3 FAMU GET USER-S FAMILY PRS4 SA2 FAMD BX3 X3-X2 AX3 18 NZ X3,PRS18 IF NOT DEFAULT FAMILY SX5 B4-RDFN-1 ZR X5,PRS5 IF RESOURCE DEMAND FILE SX5 B4-RVFN-1 NZ X5,PRS6 IF NOT RESOURCE VSN FILE PRS5 SA1 RDFN RETURN BOTH RESOURCE FILES MX0 42 BX1 X0*X1 RJ RTF RETURN FILE SA1 RVFN MX0 42 BX1 X0*X1 PRS6 RJ RTF RETURN FILE EQ END EXIT * PROCESS *R*=0. * RETURN SPECIAL FILES IN SPECIFIED FAMILY. PRS7 SX5 TSFNL-1 PRS8 SA1 TSFN+X5 MX0 42 BX1 X0*X1 SX5 X5-1 RJ RTF RETURN FILE PL X5,PRS8 IF MORE FILES TO RETURN SA1 FAM GET *FM* FAMILY NZ X1,PRS9 IF *FM* SPECIFIED SA1 FAMU GET USER-S FAMILY PRS9 SA2 FAMD BX3 X1-X2 AX3 18 NZ X3,END IF .NE. DEFAULT * RETURN DEFAULT FAMILY FILES. SX5 TDFFL-1 PRS10 SA1 TDFF+X5 MX0 42 BX1 X0*X1 SX5 X5-1 RJ RTF RETURN FILE PL X5,PRS10 IF MORE FILES TO RETURN EQ END EXIT * CHECK FILE ENTER REQUEST. PRS11 SA1 ENT ZR X1,PRSX IF NOT SPECIFIED SX3 0L0 LX3 42 BX2 X1-X3 ZR X2,PRSX IF ALL FILES TO BE ENTERED SB3 B1 PRESET FILE NOT FOUND MX6 0 SA2 TSFN SEARCH FILE LIST SA4 RDFN CHECK FOR BOTH RESOURCE FILES SA5 RVFN BX7 X1-X4 BX3 X5 SECOND FILE = RSXVXX AX7 18 ZR X7,PRS12 IF FILE = RSXDXX BX7 X1-X5 BX3 X4 SECOND FILE = RSXDXX AX7 18 ZR X7,PRS12 IF FILE = RSXVXX SX3 B0+ NO SECOND FILE PRS12 BX7 X1-X2 AX7 18 ZR X7,PRS15 IF FOUND BX7 X2-X3 CHECK SECOND FILE AX7 18 ZR X7,PRS15 IF FOUND SA6 A2+ ZERO NON-MATCHING ENTRY PRS13 SA2 A2+B1 NZ X2,PRS12 IF MORE FILE NAMES TO CHECK ZR B3,PRSX EXIT IF FOUND PRS14 RJ PEC PROCESS EXIT CLEANUP MESSAGE (=C* INCORRECT FILE NAME.*) ABORT PRS15 SB3 B0 EQ PRS13 CONTINUE LOOP PRS16 RJ PEC PROCESS EXIT CLEANUP PRS16.1 MESSAGE (=C* ARGUMENT ERROR.*) ABORT PRS17 MESSAGE (=C* INCORRECT FAMILY NAME.*) ABORT PRS18 RJ PEC PROCESS EXIT CLEANUP MESSAGE (=C* FILE NOT IN ALTERNATE FAMILY.*) ABORT PRSA CON 0 MACHINE ID PRSB VFD 12/,12/1,18/DSSL,18/PRSC *RSB* STATUS WORD PRSC CON -1 *RSB* REPLY WORD CFC SPACE 4,10 ** CFC - CHECK FILE COUNT. * * COMPARE ACTIVE DIRECT ACCESS FILE COUNT AND FAST ATTACH * FILE COUNT. THE PROFILE FILE IS ATTACHED IN WRITE MODE TO * PREVENT FURTHER *CHARGE* COMMAND PROCESSING. * * USES A - 2, 7. * X - 0, 1, 2, 7. * * CALLS CES, RIF. * * MACROS ABORT, ATTACH, CFAT, MESSAGE, RECALL, RETURN. CFC SUBR ENTRY/EXIT SA2 PRFN ATTACH PROFILE FILE MX0 42 SX7 B1 BX2 X0*X2 BX7 X7+X2 RECALL T SA7 X2+ ATTACH X2,,,,W,,,IP,FA RJ CES CHECK ERROR (DO NOT PRINT MESSAGE) ZR X0,CFC1 IF NO ERROR ZR X3,CFC2 IF *FILE NOT FOUND* ERROR RJ RIF RESTORE INITIAL FAMILY ABORT ABORT CFC1 SX7 B1+ SET PROFILE ATTACHED FLAG SA7 PRAF CFC2 CFAT S COUNT FAFT FILES SA2 S+5 SA1 PRAF COMPENSATE FOR ATTACHED PROFILE FILE IX2 X2-X1 ZR X2,CFCX IF FAFT COUNT = DAF COUNT ZR X1,CFC3 IF PROFILE NOT ATTACHED RETURN T CFC3 RJ RIF RESTORE INITIAL FAMILY MESSAGE (=C* FAMILY FILES ACTIVE.*) ABORT ABORT * COMMON DECKS. *CALL COMCARG * ARGUMENT TABLE. TARG BSS 0 E ARG ENT,ENT,400B FM ARG FAM,FAM,400B R ARG RET,RET,400B SJ ARG SJB,SJFA SP ARG SPF,SPCA ARG * ASSUMED OPTION VALUES. ENT CON 0 FILE TO BE ENTERED FAM CON 0 ALTERNATE FAMILY NAME RET CON 0 FILE TO BE RETURNED SJB VFD 42/0LSYSJOB,6/0,1/1,4/0,6/SYOT,1/0 JOB TO SUBMIT SPF CON 0LSYSPROC PROCEDURE FILE TO BE CALLED ERRNG RFL=-* IF *PRS* OVERFLOWS *SBUF* END