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