ISF 
          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 
