Retro1.org codex

          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