Retro1.org codex

          IDENT  PFILES,FWA
          ABS
          SST
          ENTRY  APPEND
          ENTRY  ATTACH
          ENTRY  CHANGE
          ENTRY  DEFINE
          ENTRY  DROPDS
          ENTRY  GET
          ENTRY  NEW
          ENTRY  OLD
          ENTRY  PACKNAM
          ENTRY  PERMIT
          ENTRY  PURGE
          ENTRY  REPLACE
          ENTRY  SAVE
          ENTRY  NPC=
          ENTRY  RFL=
          ENTRY  SDM=
          ENTRY  SSM=
          SYSCOM B1          DEFINE (B1) = 1
          TITLE  PFILES - PERMANENT FILE REQUEST PROCESSOR.
*COMMENT  PFILES - PERMANENT FILE MANIPULATOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       PFILES - PERMANENT FILE MANIPULATOR.
*         J. L. WARDELL.    70/11/03.
*         G. R. GREENFIELD   75/02/07. (MODIFIED)
          SPACE  4
***              PFILES PROCESSES PERMANENT FILE REQUESTS FOR A JOB.
*         TO ACCESS ANY PERMANENT FILES THE USER MUST HAVE DEFINED A
*         USER NAME.  THIS IS DONE VIA *LOGIN* (FOR INTERACTIVE)
*         OR *USER* COMMAND (FOR BATCH).  THE USER NAME IS
*         A 7 CHARACTER FIELD WHICH REPRESENTS A SPECIFIC CATALOG IN
*         THE PERMANENT FILE SYSTEM.  UNLESS SPECIFIED VIA AN OPTIONAL
*         USER NAME, ALL PERMANENT FILE REQUESTS WILL BE TO THIS
*         CATALOG.
*         THOSE USER NAMES WITH ASTERISKS (*) REPRESENT USERS WITH
*         AUTOMATIC READ ONLY PERMISSION TO CATALOGS OF OTHER USERS
*         IF ALL NON-ASTERISK CHARACTERS OF THE TWO USER NAMES MATCH.
*
*         EXAMPLE.
*                NORMAL USER NAMES.
*                KRONOS1
*                KRONOS2
*                KRONOS3
*
*                A USER NAME WITH AUTOMATIC PERMISSION ON ALL FILES
*                IN CATALOGS OF
*                            KRONOS1
*                            KRONOS2
*                            KRONOS3
*                WOULD BE    KRON***
*                      OR    KRONO**
*                      OR    KRONOS*
*                      OR    *RONOS*
*
*
*         TWO METHODS OF ACCESS ARE AVAILABLE TO PERMANENT FILES.
*
*         1.     DIRECT ACCESS.  FILES CAN BE ACCESSED DIRECTLY VIA
*                NORMAL I/O PROCEDURES INCLUDING RANDOM READS AND
*                WRITES.  FILES OF THIS TYPE ARE ALLOCATED IN LARGE
*                BLOCKS (SEE *R* OPTION FOR BLOCK SIZES).
*
*         2.     INDIRECT ACCESS.  FILES CAN BE ACCESSED INDIRECTLY BY
*                USING A WORKING COPY OF THE PERMANENT FILE.  THIS COPY
*                CAN BE GENERATED VIA THE *GET* COMMAND. IF THE USER
*                DESIRES THE WORKING COPY TO REMAIN PERMANENT A SPECIFIC
*                PERMANENT FILE REQUEST MUST BE MADE AFTER THE FILE
*                HAS BEEN ALTERED (SEE SAVE OR REPLACE COMMAND).
*                FILES OF THIS TYPE ARE ALLOCATED IN BLOCK SIZES
*                OF 64 CM WORDS (640 CHARACTERS).
*
*
*         FOR ANY PERMANENT FILE (DIRECT OR INDIRECT) THAT HAS A
*         CURRENT COPY ON ALTERNATE STORAGE, THE USER CAN DROP THE
*         ASSOCIATED DISK SPACE WITH THE *DROPDS* COMMAND.  THIS
*         COMMAND WILL ALSO RETURN THE LOCAL FILE IF IT EXISTS.
*
*
*
*         PERMANENT FILE COMMAND FORMAT.
*
*         THE GENERAL FORMAT FOR A PERMANENT FILE REQUEST IS DESCRIBED
*         BELOW.  IF SPECIAL OPTIONS ARE DESIRED, THEY MUST FOLLOW ALL
*         FILES SPECIFIED AND MUST APPLY TO ALL FILES.  THE OPTIONS MUST
*         FOLLOW THE /, ARE ORDER-INDEPENDENT, AND ARE INDICATED BY
*         THE SPECIFIED KEYWORD.
*
*         PFCMD (LFN = PFN / KW1 = OPTION1, . . . , KWN = OPTIONN)
*
*                PFCMD
*                            THE PARTICULAR PERMANENT FILE COMMAND.
*                LFN
*                            THE WORKING FILE NAME USED WHILE ACCESSING
*                            THE PERMANENT FILE.
*                PFN
*                            THE NAME UNDER WHICH THE FILE IS CATALOGED
*                            IN THE PERMANENT FILE DIRECTORY.  IF THE
*                            PFN PARAMETER IS NOT PRESENT, LFN IS
*                            ASSUMED TO BE BE THE PERMANENT FILE NAME.
*
*         IN CERTAIN CASES, IF NO LFN IS SPECIFIED, THE USER-S
*         PRIMARY FILE IS IMPLIED.  THESE ARE DEFAULT CALLS,
*         AND OCCUR WHEN THE COMMAND IS *GET*, *PURGE*, *REPLACE*
*         OR *SAVE*, AND NO ARGUMENT OR ONE BLANK ARGUMENT IS
*         SPECIFIED, I.E. *GET.* OR *SAVE,.*
*
*         THE KEYWORDS AND OPTIONS WHICH MAY BE SUPPLIED ARE DESCRIBED
*         BELOW:
*
*         KEYWORD OPTION     DESCRIPTION
*
*         UN=    USERNAM     USER NAME FOR THE FILE.  THIS
*                            PARAMETER IS NECESSARY ONLY IF THE
*                            PERMANENT FILE INVOLVED RESIDES IN ANOTHER
*                            USERS CATALOG.  TO BE ABLE TO ACCESS OTHER
*                            FILE CATALOGS, THE USER MUST BE GRANTED
*                            EXPLICIT PERMISSION (SEE PERMIT COMMAND).
*                            THE FILE MUST BE A SEMIPRIVATE OR LIBRARY
*                            FILE, OR THE USER MUST HAVE AUTOMATIC
*                            PERMISSION (REFER TO THE PREVIOUS
*                            DESCRIPTION OF USER NAMES).
*
*         PW=    PASSWRD     THE USER HAS THE OPTION OF SPECIFYING A
*                            SEVEN CHARACTER PASSWORD FOR A FILE.  THIS
*                            PASSWORD MUST BE SPECIFIED WHENEVER
*                            ALTERNATE USERS ACCESS THE FILE.
*
*         PW                 SPECIFIES USER DESIRES SECURE ENTRY OF
*                            PASSWORD.
*
*         XD=    YYMMDD      OPTIONAL PASSWORD/PERMIT EXPIRATION DATE
*                            FOR THE FILE.  YYMMDD MUST NOT BE BEFORE
*                            THE CURRENT DATE.  *XD* CANNOT BE
*                            SPECIFIED TOGETHER WITH *XT*.  ON A *SAVE*
*                            OR *DEFINE*, *XD* CANNOT BE SPECIFIED
*                            WITHOUT *PW*.
*
*         XT=    NNNN        OPTIONAL PASSWORD/PERMIT EXPIRATION TERM
*                            WHERE NNNN IS THE NUMBER OF DAYS THAT IS
*                            ADDED TO THE CURENT DATE AND THEN USED AS
*                            THE PASSWORD/PERMIT EXPIRATION DATE.
*                            VALUES MAY RANGE FROM 0 TO 4095 (OR *),
*                            WHERE 0 SETS THE PASSWORD AS IMMEDIATELY
*                            EXPIRED, AND 4095 (OR *) IS USED TO SET A
*                            NON-EXPIRING PASSWORD/PERMIT.  *XT* CAN
*                            NOT BE SPECIFIED TOGETHER WITH *XD*.  ON
*                            A *SAVE* OR *DEFINE*, *XD* CANNOT BE
*                            SPECIFIED WITHOUT *PW*.
*
*         CT=                PERMANENT FILE CATEGORY.  PERMANENT FILES
*                            MAY FALL INTO THREE CATEGORIES WHICH
*                            CONTROL THE METHOD OF ACCESS.  THIS
*                            PARAMETER MUST BE SPECIFIED WHEN THE FILE
*                            IS SAVED OR DEFINED.
*                P  -        FILES AVAILABLE FOR ACCESS ONLY BY THE
*                PRIVATE     ORIGINATING USER OR TO THOSE EXPLICITLY
*                PR          GRANTED PERMISSION.  (SEE PERMIT COMMAND.)
*
*                S  -        FILES AVAILABLE FOR ACCESS BY ALL USERS
*                SPRIV       KNOWING THE FILE NAME, PASSWORD AND USER
*                            NUMBER.  ACCESSES FOR FILES OF THIS
*                            CATEGORY ARE RECORDED FOR THE ORIGINATOR
*                            OF THE FILE IN THE PERMIT ENTRIES OF
*                            THE FILE.
*                L  -        FILES AVAILABLE FOR ACCESS BY ALL USERS
*                LIBRARY     KNOWING THE FILE NAME, PASSWORD, AND USER
*                PUBLIC      NUMBER.  ACCESSES FOR FILES OF THIS TYPE
*                PU          ARE NOT RECORDED FOR THE ORIGINATOR OF THE
*                            FILE.
*
*         M=                 ACCESS MODE (PERMISSION LEVEL)
*                W -         WRITE, MODIFY, UPDATE, APPEND, READ,
*                WRITE       EXECUTE AND/OR PURGE
*                R -         READ AND/OR EXECUTE
*                READ
*                E -         EXECUTE ONLY
*                EXECUTE
*                A -         APPEND ONLY (INDIRECT FILES).
*                APPEND      APPEND, READ AND EXECUTE (DIRECT FILES).
*                N -         REMOVE PREVIOUS PERMISSION
*                NULL
*                M -         MODIFY, UPDATE, APPEND, READ AND EXECUTE.
*                MODIFY
*                RM -        READ/ALLOW MODIFY, READ/ALLOW UPDATE,
*                READMD      READ/ALLOW APPEND, READ AND EXECUTE.
*                RA -        READ/ALLOW APPEND, READ AND EXECUTE.
*                READAP
*                U -         UPDATE, READ AND EXECUTE.
*                UPDATE
*                RU -        READ/ALLOW UPDATE, READ AND EXECUTE.
*                READUP
*
*         AL=    LEVEL       OPTIONAL SECURITY ACCESS LEVEL THAT THE
*                            FILE IS TO BE CREATED WITH.  ONE- TO
*                            SEVEN-CHARACTER MNEMONIC.  IF *AL* IS
*                            NOT SPECIFIED, THE CURRENT JOB ACCESS
*                            LEVEL WILL BE USED.
*
*         SS=                FILE SUBSYSTEM.
*                            IF *SS* IS OMITTED, NO SUBSYSTEM IS USED
*                            EXCEPT IN THE CASE OF A *SAVE* OF THE
*                            PRIMARY FILE.  IF *SS* IS USED ALONE, THE
*                            CURRENT SUBSYSTEM IS FORCED ON ALL FILES
*                            AFFECTED.  IF *SS* IS EQUIVALENCED, THE
*                            SPECIFIED SUBSYSTEM IS FORCED ON ALL
*                            FILES AFFECTED.  A THREE-CHARACTER
*                            ABBREVIATION MAY BE USED FOR
*                            THE SUBSYSTEM NAME.
*
*         BR =               BACKUP REQUIREMENT (PFDUMP).
*                N -         NO BACKUP REQUIRED.
*                Y -         BACKUP ALWAYS REQUIRED.
*                MD -        (MEDIA DEPENDENT) BACKUP REQUIRED IF FILE
*                            RESIDES ON DISK, BUT NOT IF FILE
*                            RESIDES ON MSF.
*
*         PR =               PREFERRED RESIDENCE (TYPE OF DEVICE).
*                L -         FILE LOCKED TO DISK (VALIDATION REQUIRED).
*                D -         DISK RESIDENCE PREFERRED.
*                M -         CARTRIDGE ALTERNATE STORAGE RESIDENCE
*                              PREFERRED.
*                N -         NO PREFERENCE.
*                T -         TAPE ALTERNATE STORAGE RESIDENCE
*                              PREFERRED.
*
*         R=                 SPECIFIES TYPE OF DEVICE ON WHICH THE
*                            PERMANENT FILE RESIDES OR IS TO RESIDE.
*                            IF NOT REQUIRED FOR THE REQUESTED
*                            OPERATION, IT IS IGNORED.  THIS
*                            PARAMETER MAY ALSO HAVE BEEN SPECIFIED
*                            ON A PREVIOUS *PACKNAM* COMMAND.
*                            IF *R* HAS NOT BEEN SPECIFIED IN
*                            EITHER FASHION, A SYSTEM DEFAULT (SEE
*                            *COMSPFM*) WILL BE USED FOR AUXILIARY
*                            PACK REQUESTS.
*
*                            DEVICE             PRUS/BLOCK  CHARS/BLOCK
*
*                DE          EXTENDED MEMORY    16          10240
*                DI          844-21 PACK GROUP  107*N       68480*N
*                DIN         N = UNIT COUNT
*                                (1-8,BLANK=1)
*                DJ          844-41 PACK GROUP  227*N       145280*N
*                DJN         N = UNIT COUNT
*                                (1-8,BLANK=1)
*                DK          844-21 FULL TRACK  112*N       71680*N
*                DKN         N = UNIT COUNT
*                                (N=1-8,BLANK=1)
*                DL          844-4X FULL TRACK  227*N       145280*N
*                DLN         N = UNIT COUNT
*                                (N=1-8,BLANK=1)
*                DM          885 PACK GROUP     640*N       409600*N
*                DMN         N = UNIT COUNT
*                                (1-3,BLANK=1)
*                DP          EXTENDED MEMORY    16          10240
*                DQ          885 FULL TRACK     640*N       409600*N
*                DQN         N = UNIT COUNT
*                                (1-3,BLANK=1)
*                DV          819 SINGLE DENSITY 620         396800
*                DW          819 DOUBLE DENSITY 1240        793600
*
*         PN=                PACK NAME. UNIQUE SEVEN CHARACTER
*                            NAME ASSOCIATED WITH A REMOVABLE
*                            DEVICE. USER CAN SPECIFY THE PACK NAME
*                            OF THE DEVICE HE WISHES THE PERMANENT
*                            FILE REQUEST TO GO TO.
*
*         NA                 NO ABORT OPTION. IF SET PROGRAM WILL NOT
*                            ABORT. IF FILE IS BUSY (ATTACH ONLY)
*                            THE JOB WILL BE SUSPENDED TILL FILE IS
*                            AVAILABLE. FOR ALL OTHER CONDITIONS,
*                            THE ERROR MESSAGE WILL BE ISSUED AND
*                            THE PROGRAM WILL CONTINUE.  *NA* CANNOT BE
*                            SPECIFIED TOGETHER WITH *WB*.
*
*         WB                 WAIT BUSY OPTION.  IF SET, PROGRAM WILL
*                            WAIT FOR BUSY FILES AND PACK MOUNTS, BUT
*                            ALL OTHER ERRORS WILL CAUSE ABORTS.  *WB*
*                            CANNOT BE SPECIFIED TOGETHER WITH *NA*.
*
*         RT                 REAL-TIME OPTION.  IF SET, PROGRAM WILL
*                            CONTINUE PROCESSING AFTER A STAGE HAS
*                            BEEN INITIATED FOR A NON-DISK RESIDENT
*                            FILE, OR IF A PF UTILITY IS ACTIVE.
*                            IF NOT SET, PROGRAM WILL WAIT
*                            UNTIL STAGE IS COMPLETE OR PF UTILITY
*                            IS NO LONGER ACTIVE, AND FILE
*                            IS AVAILABLE.
*
*         CE                 CLEAR ERROR STATUS IN THE FILES
*                            CATALOG ENTRY. THIS OPTION IS ONLY
*                            PROCESSED BY *CHANGE*, AND CANNOT BE
*                            SPECIFIED TOGETHER WITH THE *CE* OPTION.
*
*         CP                 RESET THE CHARGE AND PROJECT NUMBERS IN
*                            THE FILE-S CATALOG ENTRY TO THE CURRENT
*                            ACTIVE CHARGE AND PROJECT NUMBERS.  THIS
*                            OPTION IS ONLY PROCESSED BY *CHANGE*, AND
*                            CANNOT BE SPECIFIED TOGETHER WITH THE *CP*
*                            PARAMETER.
*
*         S=                 SPACE DESIRED.  THIS SPECIFIES SPACE
*                            DESIRED, IN PRUS, FOR ALLOCATION.  IF
*                            SPECIFIED, DEVICE(OF DEVICE TYPE SPECIFIED
*                            BY *R*) WILL BE ASSIGNED IF THIS MANY
*                            PRUS ARE AVAILABLE FOR ALLOCATION.  NOTE -
*                            SPACE IS NOT RESERVED BY SPECIFING THIS
*                            PARAMETER.
*
*         ND                 DO NOT DROP NON-PRIMARY LOCAL FILES AFTER
*                            PROCESSING FUNCTION.
*
*         AC=                ALTERNATE CATLIST PERMISSION.
*                N -         ALTERNATE USERS ARE NOT PERMITTED TO
*                            CATLIST THE FILE.
*                Y -         ALTERNATE USERS ARE PERMITTED TO CATLIST
*                            THE FILE.
*
*
*         MULTIPLE FILE REQUESTS
*
*         UP TO 20 FILES MAY BE ACCESSED WITH A SINGLE CALL BY USING
*         THE FOLLOWING COMMAND FORMAT.  IF SPECIAL OPTIONS ARE
*         SPECIFIED, THEY APPLY TO ALL FILES.
*         NOTE - MULTIPLE FILE REQUESTS ARE NOT PERMITTED ON
*                *NEW* OR *OLD* FUNCTIONS.
*
*                PFCMD (LFNN = PFNN, LFN2, . . ., LFNN = PFNN) / KW1 =
*                 OPTION1, . . ., KWN = OPTIONN)
          SPACE  4,40
***       DAYFILE MESSAGES.
*
*
*         * ERROR IN ALTERNATE CATLIST PERMISSION.* = ALTERNATE CATLIST
*                PERMISSION SPECIFIED WAS NOT RECOGNIZED.
*
*         * ERROR IN ARGUMENT.* = THE COMMAND IS SYNTACTICALLY
*                INCORRECT, OR AN INCORRECT PARAMETER WAS ENTERED
*                FOR THE COMMAND.
*
*         * ERROR IN BACKUP REQUIREMENT.* = BACKUP REQUIREMENT
*                SPECIFIED WAS NOT RECOGNIZED.
*
*         * ERROR IN EXPIRATION DATE.* = THE VALUE SPECIFIED
*                FOR *XD* WAS NOT A VALID DATE, OR THE VALUE
*                SPECIFIED FOR *XT* WAS GREATER THAN 4095.
*
*         * ERROR IN FILE CATEGORY.* = FILE CATEGORY SPECIFIED WAS
*                NOT RECOGNIZED.
*
*         * ERROR IN MODE.* = MODE SPECIFIED WAS NOT RECOGNIZED.
*
*         * ERROR IN PREFERRED RESIDENCE.* = PREFERRED RESIDENCE
*                SPECIFIED WAS NOT RECOGNIZED.
*
*         * ERROR IN RESIDENCE.* = RESIDENCE PARAMETER IS INCORRECT.
*
*         * ERROR IN SUBSYSTEM.* = SUBSYSTEM SPECIFIED WAS
*                NOT RECOGNIZED.
*
*         * INCORRECT PASSWORD.* = AN INCORRECT PASSWORD WAS ENCOUNTERD
*                UPON SECURE ENTRY.
*
*         * NO PRIMARY FILE.* = AN IMPLIED PRIMARY FILE OPERATION
*                (DEFAULT CALL) WAS MADE, BUT NO PRIMARY FILE WAS
*                FOUND.
*
*         * PARAMETERS CE AND CP ARE MUTUALLY EXCLUSIVE.* = THE
*                PARAMETERS *CE* AND *CP* CANNOT BE BOTH BE INCLUDED
*                ON THE SAME *CHANGE* COMMAND.
*
*         * UNKNOWN ACCESS LEVEL NAME.* = THE VALUE SPECIFIED FOR
*                THE *AL* PARAMETER WAS NOT VALID.  SEE *COMSMLS*
*                FOR A LIST OF VALID ACCESS LEVEL NAMES.
*
*         NOTE - SEE *PFM* DOCUMENTATION FOR ADDITIONAL ERROR MESSAGES.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*
*         NONE.
          SPACE  4
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSLFD
*CALL     COMSMLS
*CALL     COMSMSP
*CALL     COMSPFM
*CALL     COMSREM
*CALL     COMSTCM            (230)
          SPACE  4
**        PROGRAM CONSTANTS.
 
 
 NFILES   EQU    21          MAX NUMBER OF FILES + 1 IN ONE COMMAND
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
 BUFL     EQU    NWCE+2      BUFFER LENGTH
 SDM=     EQU    0           SUPPRESS DAYFILE MESSAGE
 SSM=     EQU    0           SECURE SYSTEM MEMORY
 CCPK     EQU    13B         PACKNAME COMMAND
 CCNW     EQU    14B         NEW COMMAND
 CCOL     EQU    15B         OLD COMMAND
 CCDS     EQU    16B         DROPDS COMMAND
 GFILES   EQU    40B         NUMBER OF ENTRIES IN GETFNT BUFFER
 GLEN     EQU    GFILES*2    LENGTH OF *GETFNT* BUFFER
*                            NOTE - SHOULD CONSIDER VALUE OF *RFL=*
 PBUFL    EQU    100         *PACKNAM* STRING BUFFER LENGTH
          TITLE  PARAMETER PROCESSING.
**        PFILES - PROCESS REQUEST.
 
 
          ORG    125B
 FET      SPACE  4
 FWA      BSS    0           DEFINE LOAD ADDRESS
 
 F        BSS    0
 FILE     FILEB  IBUF,BUFL,(FET=CFLM)
 .F       BSS    0
          ORG    F+1         SUPPRESS ADDRESS ON *PFM* ERRORS
          VFD    13/0,1/1,22/0,6/CFLM-5,18/IBUF
          ORG    .F
 
 I        BSS    0
 INPUT    FILEB  IBUF,BUFL,FET=6
 
 O        BSS    0
 OUTPUT   FILEB  PMSG,PMSGL+1,FET=6
 
 ERR      SPACE  4,10
**        ERR - PROCESS ARGUMENT ERROR.
*
*         MACROS ABORT, MESSAGE.
 
 
 ERR      BSS    0           ENTRY
          MESSAGE  (=C* ERROR IN ARGUMENT.*)
 ERR1     ABORT
 PFL      SPACE  4,10
**        PFL - PROCESS PERMANENT FILE REQUEST.
*
*         ENTRY  (B7) = COMMAND CODE.
*
*         USES   X - ALL.
*                A - 1, 2, 4, 5, 6.
*                B - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  ARG, CTJ, ESP, IDF, PAC, PAL, PBR, PCT, PDC, PMD,
*                PNA, PPX, PRE, PRT, PSS.
*
*         MACROS CONTROL, MESSAGE.
 
 
 PFL      SUBR               ENTRY/EXIT
          SX6    B7+         SAVE COMMAND CODE
          SB1    1
          SA6    PFLA
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SA1    ACTR        ARGUMENT COUNT
          SA2    PFLA        GET COMMAND CODE
          SB4    X1
          SB7    X2
          SB6    60          SET SHIFT COUNT FOR COMMAND
          SB6    B6-B7
          RJ     PDC         PROCESS DEFAULT CALL
          ZR     B2,PFL7     IF DEFAULT AND PRIMARY FOUND
 
*         PROCESS FILE NAME LIST.
 
 PFL1     SA4    ARGR
          MX0    42
          SB2    B0          CLEAR FILE COUNT
          SX3    PRM17       SET MASK FOR *LFN=PFN* SYNTAX
 PFL2     BX6    X0*X4
          SX7    X4-1R=      CHECK SEPARATOR
          SX1    B0          CLEAR PF NAME
          ZR     X6,ERR      IF BLANK NAME
          SA6    B2+TSFN     SET SYSTEM FILE NAME
          NZ     X7,PFL3     IF NOT *=*
          SB4    B4-B1       DECREMENT ARG. COUNT
          SA4    A4+B1       READ NEXT ARG.
          ZR     B4,ERR      IF NO ARG.
          BX1    X0*X4
          ZR     X1,ERR      IF BLANK ARG.
          SX7    X4-1R=
          ZR     X7,ERR      IF *LFN1=PFN1=*
          LX7    X3,B6
          PL     X7,ERR      IF *LFN=PFN* SYNTAX NOT ALLOWED ON COMMAND
 PFL3     BX6    X1          SET PF NAME
          SA6    B2+TPFN
          SX7    B2          SAVE INDEX OF LAST FILE
          SA7    PFLB
          SB2    B2+B1       ADVANCE FILE COUNT
          SB5    B2-NFILES
          GT     B5,ERR      IF TOO MANY FILES
          SB3    X4-1R/      CHECK FOR SPECIAL ARG.
          SB4    B4-B1       DECREMENT ARG. COUNT
          SX6    B0          CLEAR NEXT FILE NAME
          SA6    B2+TSFN
          SA4    A4+B1       READ NEXT ARG.
          EQ     B3,PFL4     IF SPECIAL ARG.
          NZ     B4,PFL2     LOOP FOR NEXT ARG.
          EQ     PFL7        PROCESS SPECIAL PARAMETERS
 
*         PROCESS SPECIAL ARGUMENTS.
 
 PFL4     SB5    TARG        ARGUMENT TABLE
          RJ     ARG
          NZ     X1,ERR      IF ERROR
 
*         DETERMINE IF PARAMETERS ARE LEGAL FOR COMMAND SPECIFIED.
 
          SB2    TPARL
 PFL6     SB2    B2-B1
          LT     B2,PFL7     IF NO MORE PARAMETERS
          SA1    B2+TPAR     READ ARGUMENT VALIDATION
          SA2    B2+TARG
          SA2    X2
          ZR     X2,PFL6     IF ARGUMENT NOT ENTERED
          LX1    X1,B6
          NG     X1,PFL6     IF PARAMETER ALLOWED
          EQ     ERR         ISSUE ERROR
 
*         PROCESS SECURE PASSWORD ENTRY.
 
 PFL7     SA5    PWD
          SB2    X5
          SB2    B2-B1
          NZ     B2,PFL8     IF *PW* NOT ENTERED
          MX0    42
          BX5    X0*X5
          NZ     X5,PFL8     IF PASSWORD NOT ENTERED SECURELY
          RJ     ESP         ENTER SECURE PASSWORD
          SA6    PWD         SET PASSWORD
 
*         PROCESS REMAINING PARAMETERS.
 
 PFL8     MX0    42
          RJ     PAC         PROCESS ALTERNATE CATLIST
          RJ     PAL         PROCESS ACCESS LEVEL
          RJ     PBR         PROCESS BACKUP REQUIREMENT
          RJ     PCT         PROCESS CATEGORY
          SA5    MODE        PROCESS MODE
          RJ     PMD
          RJ     PNA         PROCESS *NO ABORT*/*WAIT BUSY* PARAMETERS
          RJ     PPX         PROCESS PASSWORD/PERMIT EXPIRATION DATE
          RJ     PRE         PROCESS PREFERRED RESIDENCE
          RJ     PRT         PROCESS *REAL-TIME* PARAMETER
          RJ     PSS         PROCESS SUBSYSTEM
          RJ     PRD         PROCESS RESIDENCE DEFINITION
          EQ     PFLX        RETURN
 
 
 PFLA     CON    0           COMMAND CODE
 PFLB     CON    0           INDEX OF LAST FILE NAME
 PNC      SPACE  4,15
**        PNC - PROCESS NEXT COMMAND.
*
*         READ AHEAD ON COMMAND FILE, AND PROCESS
*         THE NEXT COMMAND IF IT IS A *PFILES* CALL.
*
*         EXIT   TO FUNCTION PROCESSOR.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 5, 6.
*                B - 2, 3.
*
*         CALLS  CTJ.
*
*         MACROS CONTROL, ENDRUN, MESSAGE, RECALL.
 
 
 PNC      BSS    0           ENTRY
          SA1    JOPR        CHECK FOR *DIS* CALL
          LX1    59-19
          NG     X1,PNC4     IF *DIS* CALL
          CONTROL CCDR,RSS
          SA5    CCDR
          ZR     X5,PNC4     IF NO COMMAND PENDING
          SA1    ACTR        READ PROGRAM NAME
          SA2    FWA-1       FIRST ENTRY NAME
          MX0    42
          BX1    X0*X1
 PNC1     NG     X2,PNC4     IF END OF ENTRY POINT NAMES
          BX3    X0*X2
          BX6    X3-X1
          SB2    X2
          SA2    A2-B1
          NZ     X6,PNC1     IF NO MATCH
          CONTROL CCDR       ADVANCE COMMAND
          SA1    PGNR
          SX6    B0+
          ZR     X1,ERR1     IF COMMAND LIMIT
          SB3    PARML       CLEAR PARAMETERS
 PNC2     SA6    PARM-1+B3
          SB3    B3-B1
          NZ     B3,PNC2     IF MORE PARAMETERS TO CLEAR
          RECALL F
          SB3    CFLM-CFCN
 PNC3     SA6    F+CFCN-1+B3 CLEAR *PFM* FET PARAMETERS
          SB3    B3-B1
          NZ     B3,PNC3     IF MORE WORDS IN FET
          SA1    F+1         CLEAR *EP*, *RT* AND *SP* BITS
          SX6    61B
          LX6    39-0
          BX6    -X6*X1
          SA6    A1
          SA2    F+4         CLEAR *AL* FIELD IN FET
          MX0    -6
          LX0    36-0
          BX6    X0*X2
          SA6    A2
          JP     B2          PROCESS CALL
 
 PNC4     RJ     CTJ         CHECK FOR *TXOT* JOB
          ZR     X2,PNC5     IF *TXOT* JOB
          MESSAGE (=C*PF REQUEST COMPLETE.*),1
          EQ     PNC6        END
 
 PNC5     SA1    ERRFLG
          NZ     X1,PNC6     IF ERROR ENCOUNTERED
          MESSAGE  ZR,1      CLEAR *MS1W*
 PNC6     ENDRUN
          SPACE  4
*         TABLES.
 
 
 ZR       CON    0           ZERO WORD FOR ARG. DEFAULT
 NZ       CON    1           NON-ZERO WORD FOR ARG. DEFAULT
 CE       CON    SRCE        CLEAR ERROR FUNCTION
 CPN      CON    SRCP        RESET CHARGE/PROJECT NUMBERS
 
 
 CSV      DECMIC CCSV-1
 CGT      DECMIC CCGT-1
 CPG      DECMIC CCPG-1
 CPM      DECMIC CCPM-1
 CRP      DECMIC CCRP-1
 CAP      DECMIC CCAP-1
 CDF      DECMIC CCDF-1
 CAT      DECMIC CCAT-1
 CCG      DECMIC CCCG-1
 CPK      DECMIC CCPK-1
 CNW      DECMIC CCNW-1
 COL      DECMIC CCOL-1
 CDS      DECMIC CCDS-1
 
 
 PRM1     SET    1S"CSV"+1S"CGT"+1S"CPG"+1S"CRP"+1S"CAP"+1S"CDF"+1S"CAT"
,+1S"CCG"+1S"COL"     PASSWORD
 PRM2     SET    1S"CSV"+1S"CRP"+1S"CDF"+1S"CAT"+1S"CCG"    MODE
 PRM3     SET    1S"CSV"+1S"CDF"+1S"CCG"            FILE CATEGORY
 PRM4     SET    1S"CSV"+1S"CGT"+1S"CDF"+1S"CPG"+1S"CPM"+1S"CRP"+1S"CAP"
,+1S"CAT"+1S"CCG"+1S"COL"+1S"CDS"   NO ABORT, WAIT BUSY
 PRM5     SET    1S"CGT"+1S"CPG"+1S"CRP"+1S"CAP"+1S"CAT"+1S"COL"   UN
 PRM6     SET    1S"CSV"+1S"CGT"+1S"CPG"+1S"CPM"+1S"CRP"+1S"CAP"+1S"CDF"
,+1S"CAT"+1S"CCG"+1S"CPK"+1S"COL"+1S"CDS"   PACKNAME, RESIDENCE
 PRM7     SET    1S"CDF"     SPACE
 PRM8     SET    1S"CNW"+1S"COL"     NO DROP
 PRM9     SET    1S"CGT"+1S"CSV"+1S"CPG"+1S"CRP"     NO ARGUMENTS
 PRM10    SET    1S"CCG"     CLEAR ERROR STATUS
 PRM11    SET    1S"CSV"+1S"CCG"  SUBSYSTEM
 PRM12    SET    1S"CDF"+1S"CCG"+1S"CSV"  BACKUP REQUIREMENT
 PRM13    SET    1S"CSV"+1S"CDF"+1S"CCG"  PREFERRED RESIDENCE
 PRM14    SET    1S"CGT"+1S"CAT"+1S"COL"  REAL TIME PARAMETER
 PRM15    EQU    1S"CCG"+1S"CDF"+1S"CSV"+1S"CPM"  PASSWORD/PERMIT EXP
 PRM16    EQU    1S"CDF"+1S"CSV"       FILE ACCESS LEVEL
 PRM17    EQU    1S"CSV"+1S"CGT"+1S"CPM"+1S"CRP"+1S"CDF"+1S"CAT"+1S"CCG"
,+1S"COL"+1S"CDS"                      *LFN=PFN* SYNTAX
 PRM18    SET    1S"CSV"+1S"CDF"+1S"CCG"  ALTERNATE CATLIST PERMISSION
 PRM19    SET    1S"CCG"     RESET CHARGE/PROJECT NUMBERS
 
 
*         NOTE - ENTRIES IN THE NEXT TWO TABLES MUST BE IN
*         THE SAME ORDER IN EACH TABLE.
 
 
*         TABLE OF LEGAL PARAMETERS FOR COMMANDS.
 
 TPAR     BSS    0
          VFD    42/0,18/PRM8   NO DROP
          VFD    42/0,18/PRM1   PASSWORD
          VFD    42/0,18/PRM2   MODE
          VFD    42/0,18/PRM3   FILE CATEGORY
          VFD    42/0,18/PRM6   RESIDENCE
          VFD    42/0,18/PRM5   USER NAME
          VFD    42/0,18/PRM6   PACKNAME
          VFD    42/0,18/PRM4   NO ABORT
          VFD    42/0,18/PRM4   WAIT BUSY
          VFD    42/0,18/PRM7   SPACE
          VFD    42/0,18/PRM10  CLEAR ERROR STATUS
          VFD    42/0,18/PRM11  SUBSYSTEM
          VFD    42/0,18/PRM12  BACKUP REQUIREMENT
          VFD    42/0,18/PRM13  PREFERRED RESIDENCE
          VFD    42/0,18/PRM14  REAL-TIME PARAMETER
          VFD    42/0,18/PRM15  PASSWORD/PERMIT EXPIRATION DATE
          VFD    42/0,18/PRM15  PASSWORD/PERMIT EXPIRATION TERM
          VFD    42/0,18/PRM16  FILE ACCESS LEVEL
          VFD    42/0,18/PRM18  ALTERNATE CATLIST PERMISSION
          VFD    42/0,18/PRM19  RESET CHARGE/PROJECT NUMBERS
 TPARL    EQU    *-TPAR         LIMIT OF PARAMETERS
 
 
*         TABLE OF KEYWORD/PARAMETER EQUIVALENCES.
 
 TARG     BSS    0
 ND       ARG    -NZ,NODROP
 PW       ARG    NZ,PWD
 M        ARG    NZ,MODE
 CT       ARG    NZ,CTG
 R        ARG    ZR,RES
 UN       ARG    ZR,USNM
 PN       ARG    ZR,PKNM,400B
 NA       ARG    -NZ,NABT
 WB       ARG    -NZ,WBUSY
 S        ARG    ZR,SPACE
 CE       ARG    -CE,CLRE
 SS       ARG    NZ,SUBSYS
 BR       ARG    NZ,BREQ
 PR       ARG    NZ,PRES
 RT       ARG    -NZ,RTIME
 XD       ARG    NZ,PXD,400B
 XT       ARG    NZ,PXT,400B
 AL       ARG    ZR,FAL,400B
 AC       ARG    ZR,ALCT
 CP       ARG    -CPN,CPNG
          ARG
 
 TARGP    BSS    0           ARGUMENT TABLE FOR *PACKNAM* COMMAND
 PN       ARG    ZR,PKNM
 R        ARG    ZR,RES
          ARG
 TARGPL   EQU    *-TARGP-1
          SPACE  4,10
**        PARAMETER AREA.
 
 PARM     BSS    0
 NODROP   CON    0           NO DROP
 PWD      CON    0           PASSWORD
 MODE     CON    0           FILE MODE
 CTG      CON    0           FILE CATEGORY
 RES      CON    0           RESIDENCE OF FILE
 USNM     CON    0           USER NAME
 PKNM     CON    0           PACKNAME
 NABT     CON    0           NO ABORT OPTION
 WBUSY    CON    0           WAIT BUSY OPTION
 SPACE    CON    0           SPACE
 CLRE     CON    0           CLEAR ERROR STATUS
 SUBSYS   CON    0           SUBSYSTEM
 BREQ     CON    0           BACKUP REQUIREMENT
 PRES     CON    0           PREFERRED RESIDENCE
 ALCT     CON    0           ALTERNATE CATLIST PERMISSION
 RTIME    CON    0           REAL-TIME PARAMETER
 PXD      CON    0           PASSWORD/PERMIT EXPIRATION DATE
 PXT      CON    0           PASSWORD/PERMIT EXPIRATION TERM
 FAL      CON    0           FILE ACCESS LEVEL
 CPNG     CON    0           RESET CHARGE/PROJECT NUMBERS
 SREQ     CON    0           SPECIAL REQUEST SUBFUNCTION FOR *CHANGE*
 ERRFLG   CON    0           NONZERO IF *PFM* ERROR DETECTED
 PARML    EQU    *-PARM
 
*         MESSAGE FOR SECURE ENTRY OF PASSWORD.
 
PMSG      DATA   10H"EM"  PASSWO
          DATA   10HRD:"NL"  (((
          DATA   10H((((("CR"  )
          DATA   10H)))))))"CR"
          DATA   10H MMMMMMMM
          DATA   10H"CR"  QQQQQQ
          DATA   10HQQ"CR"  XXXX
          DATA   10HXXXX"CR""CB""EL"
 PMSGL    EQU    *-PMSG
          TITLE  FUNCTION PROCESSORS.
 APPEND   SPACE  4,15
***       APPEND (P,F1,F2,F3,...,FN/PW,UN,PN,R,NA,WB)
*
*         APPEND FILES F1...FN TO PERMANENT FILE.
*         EACH FILE *FN* IS APPENDED AT EOI OF *P*.
*
*                P = PERMANENT FILE TO BE APPENDED TO.
*                FN = FILES TO BE APPENDED.
*                PW = FILE PASSWORD.
*                UN = USER NAME.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
 
 
 APPEND   BSS    0           ENTRY
          SB7    CCAP        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SA1    TSFN        SET PERMANENT FILE NAME
          BX6    X1
          SA6    F+CFPN
          SB3    B1          SET TABLE COUNTER
          SA5    B3+TSFN
          ZR     X5,ERR      IF NO LOCAL FILE NAME
 APP1     SX6    B1          SET LOCAL FILE NAME IN FET
          BX6    X6+X5
          SA6    F
          APPEND F,,USNM,PWD,PKNM,RES
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE POINTER
          SA5    B3+TSFN
          NZ     X5,APP1     IF ANOTHER FILE
          EQ     PNC         PROCESS NEXT COMMAND
 ATTACH   SPACE  4,25
***       ATTACH (F=P/UN,PW,M,PN,R,NA,WB,RT)
*
*         ATTACH PERMANENT FILE FOR DIRECT ACCESS USE.
*
*         AN ATTEMPT WILL BE MADE FIRST TO ATTACH EACH FILE WITH THE
*         *RT* BIT SET IN THE FET.  FOR ANY FILE FOR WHICH STAGING WAS
*         INITIATED OR A PF UTILITY WAS ACTIVE, ANOTHER *ATTACH* WILL
*         BE PERFORMED WITHOUT THE *RT* BIT SET TO ACTUALLY ATTACH
*         THE FILE.
*
*                F = WORKING FILE NAME
*                P = PERMANENT FILE NAME
*                UN = USER NAME.
*                PW = FILE PASSWORD
*                M = MODE OF ACCESS
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.  WAIT FOR BUSY
*                            FILE UNTIL AVAILABLE.
*                WB = WAIT FOR PACK MOUNT AND FOR BUSY FILE.
*                RT = RETURN CONTROL AFTER STAGE INITIATED OR IF
*                            PF UTILITY IS ACTIVE.  DO NOT
*                            WAIT FOR FILE TO BE AVAILABLE.
*
*                DEFAULT VALUES.
*                            M = READ.
*                            PW = 0.
*                            NA = 0.
 
 
 ATTACH   BSS    0           ENTRY
          SB7    CCAT        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SA1    PFLB        GET INDEX OF LAST FILE NAME
          SB4    X1+
 ATT1     SB3    B0+         GET FIRST FILE NAME
 ATT2     SA5    B3+TSFN
          ZR     X5,ATT5     IF PREVIOUS *ATTACH* OF THIS FILE WORKED
          SX6    B1          PROCESS FILE NAME
          BX6    X5+X6
          SA6    F
 ATT3     ATTACH F,B3+TPFN,USNM,PWD,MODE,PKNM,RES
          RJ     CES         CHECK ERROR STATUS
          ZR     X6,ATT6     IF FILE BUSY
          ZR     X7,ATT4     IF WAITING STAGING, UTILITY OR INTERLOCK
          SX6    B0+         CLEAR FILE NAME
          SA6    B3+TSFN
          EQ     ATT5        CHECK FOR MORE FILES
 
 ATT4     SX6    B1+         SET FLAG TO INDICATE RETRY NEEDED
          SA6    ATTA
 ATT5     SB3    B3+1        CHECK FOR MORE FILES
          LE     B3,B4,ATT2  IF MORE FILES TO PROCESS
          SA1    ATTA
          ZR     X1,PNC      IF NO RETRY NEEDED
          BX6    X6-X6       CLEAR FLAG
          SA6    A1
          SA1    RTIME
          NZ     X1,PNC      IF *RT* PARAMETER SPECIFIED
          SA1    F+1         CLEAR REAL-TIME PROCESSING BIT
          MX6    1
          LX6    43-59
          BX6    X1-X6
          SA6    A1
          EQ     ATT1        RETRY WITH *RT* CLEARED
 
 ATT6     ROLLOUT  ZR        ROLL OUT UNTIL FILE AVAILABLE
          EQ     ATT3        RETRY AFTER ROLLED IN
 
 
 ATTA     CON     0          NONZERO IF RETRY WITHOUT *RT* REQUIRED
 CHANGE   SPACE  4,20
***       CHANGE (N=P/PW,CT,M,BR,PR,SS,PN,R,NA,WB,CE,XT,AC,CP)
*
*         CHANGE CATALOG ENTRY FOR PERMANENT FILE.
*
*                N = NEW FILE NAME.
*                P = OLD PERMANENT FILE NAME.
*                PW = FILE PASSWORD.
*                CT = FILE CATEGORY.
*                M = MODE OF ACCESS ALLOWED FOR FILE.
*                BR = BACKUP REQUIREMENT.
*                PR = PREFERRED RESIDENCE.
*                SS = SUBSYSTEM.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
*                CE = CLEAR ERROR STATUS.
*                XT = PASSWORD EXPIRATION DATE OR TERM.
*                AC = ALTERNATE CATLIST PERMISSION.
*                CP = RESET CHARGE/PROJECT NUMBERS IN PFC.
 
 
 CHANGE   BSS    0           ENTRY
          SB7    CCCG        SET FUNCTION CODE
          MX6    42          SET PWD DEFAULT TO ALL 7S
          SA6    PWD
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          RJ     PSR         PROCESS SPECIAL REQUEST SUBFUNCTION
          SB3    B0
          SA5    B3+TSFN
 CHG1     SB4    A5
          SA1    B3+TPFN
          NZ     X1,CHG2     IF NAME CHANGE
          BX1    X5          SET PERMANENT FILE NAME
          SB4    B0          SET NO NEW NAME
 CHG2     CHANGE F,X1,B4,PWD,,CTG,MODE,PKNM,RES,,SREQ,SUBSYS,BREQ,PRES,P
,XT,ALCT
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1
          SA5    B3+TSFN
          NZ     X5,CHG1     IF ANOTHER FILE
          EQ     PNC         PROCESS NEXT COMMAND
 DEFINE   SPACE  4,30
***       DEFINE (F=P/PW,CT,M,BR,PR,PN,R,NA,WB,XT,AL,AC)
*
*         DEFINE PERMANENT FILE FOR DIRECT ACCESS USAGE.
*
*                F = WORKING FILE NAME.
*                P = PERMANENT FILE NAME.
*                PW = FILE PASSWORD
*                CT = FILE CATEGORY.
*                M = MODE OF ACCESS ALLOWED FOR SEMI-PRIVATE OR LIBRARY
*                BR = BACKUP REQUIREMENT.
*                PR = PREFERRED RESIDENCE.
*                PN = PACK NAME.
*                R = DEVICE TYPE FILE IS TO BE ASSIGNED TO.
*                S = SPACE REQUIRED ON DEVICE (PRUS-DECIMAL).
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
*                XT = PASSWORD EXPIRATION DATE OR TERM.
*                AL = FILE ACCESS LEVEL.
*                AC = ALTERNATE CATLIST PERMISSION.
*
*                DEFAULT VALUES.
*                            PW = 0.
*                            CT = PRIVATE.
*                            R = 0 (USES MASTER DEVICE OR DEVICE
*                                FILE CURRENTLY RESIDES ON).
*                            M = WRITE.
*                            S = 0.
*                            NA = 0.
*                            AC = NO.
 
 
 DEFINE   BSS    0           ENTRY
          SB7    CCDF        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SA5    SPACE       CONVERT SPACE PARAMETER
          ZR     X5,DEF1     IF NOT SPECIFIED
          SB7    B1          SET DECIMAL DEFAULT
          RJ     DXB
          NZ     X4,ERR      IF ERROR
          SA6    F+CFOU
 DEF1     SB3    B0
          SA5    B3+TSFN     SET SYSTEM FILE NAME
 DEF2     SX6    B1          SET STATUS COMPLETE
          BX6    X5+X6
          SA6    F
          DEFINE F,B3+TPFN,PWD,,RES,CTG,MODE,PKNM,,,BREQ,PRES,,PXT,FAL,A
,LCT
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT FILE
          SA5    B3+TSFN
          NZ     X5,DEF2     IF ANOTHER FILE TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
DROPDS    SPACE  4,15
***       DROPDS(F=P/PN,R,NA,WB)
*
*         DROP DISK SPACE FOR FILE WITH ALTERNATE STORAGE COPY.
*         RETURN LOCAL FILE IF PRESENT.
*
*                F = LOCAL FILE NAME.
*                P = PERMANENT FILE NAME.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
 
 
 DROPDS   BSS    0           ENTRY
          SB7    CCDS
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SB3    B0
          SA5    B3+TSFN
 DRO1     SX6    B1
          BX6    X5+X6
          SA6    F
          RETURN F,R
          SA1    B3+TPFN     SET PERMANENT FILE NAME (IF SPECIFIED)
          BX6    X1
          SA6    X2+CFPN
          DROPDS F
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT FILE
          SA5    B3+TSFN
          NZ     X5,DRO1     IF ANOTHER FILE TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
 GET      SPACE  4,20
***       GET (F=P/PW,UN,PN,R,RT,NA,WB)
*
*         RETRIEVE COPY OF INDIRECT ACCESS PERMANENT FILE.
*
*         AN ATTEMPT WILL BE MADE FIRST TO GET EACH FILE WITH THE
*         *RT* BIT SET IN THE FET.  FOR ANY FILE FOR WHICH STAGING WAS
*         INITIATED OR A PF UTILITY WAS ACTIVE, ANOTHER *GET* WILL BE
*         PERFORMED WITHOUT THE *RT* BIT SET TO ACTUALLY GET THE FILE.
*
*                F = WORKING FILE NAME.
*                P = PERMANENT FILE NAME
*                PW = FILE PASSWORD
*                UN = USER NAME.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                RT = RETURN CONTROL AFTER STAGE INITIATED OR IF
*                     A PF UTILITY IS ACTIVE. DO NOT
*                     WAIT FOR FILE TO BE AVAILABLE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
 
 
 GET      BSS    0           ENTRY
          SB7    CCGT        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          RJ     GPN         GET PRIMARY FILE NAME
          SA1    PFLB        GET INDEX OF LAST FILE NAME
          SB4    X1+
 GET1     SB3    B0+         GET FIRST FILE NAME
 GET2     SA5    B3+TSFN     SYSTEM FILE NAME
          ZR     X5,GET6     IF PREVIOUS *GET* OF THIS FILE WORKED
          SX6    B1
          BX6    X6+X5
          SA6    F
          SA2    GETTAB+1    CHECK FOR PRIMARY FILE
          BX2    X5-X2
          NZ     X2,GET3     IF NOT PRIMARY FILE
          OLD    F,B3+TPFN,USNM,PWD,PKNM,RES
          EQ     GET4        CHECK FOR NEXT FILE
 
 GET3     GET    F,B3+TPFN,USNM,PWD,PKNM,RES
 GET4     RJ     CES         CHECK ERROR STATUS
          ZR     X7,GET5     IF WAITING STAGING, UTILITY OR INTERLOCK
          SX6    B0+         CLEAR FILE NAME
          SA6    B3+TSFN
          EQ     GET6        ADVANCE TO NEXT FILE
 
 GET5     SX6    B1+         SET FLAG TO INDICATE THAT RETRY NEEDED
          SA6    GETA
 GET6     SB3    B3+1        ADVANCE TO NEXT FILE
          LE     B3,B4,GET2  IF ANOTHER FILE TO PROCESS
          SA1    GETA
          ZR     X1,PNC      IF NO RETRY NEEDED
          BX6    X6-X6       CLEAR FLAG
          SA6    A1
          SA1    RTIME
          NZ     X1,PNC      IF *RT* PARAMETER SPECIFIED
          SA1    F+1         CLEAR REAL-TIME PROCESSING BIT
          MX6    1
          LX6    43-59
          BX6    X1-X6
          SA6    A1
          EQ     GET1        RETRY WITH *RT* CLEARED
 
 
 GETA     CON    0           NONZERO IF RETRY WITHOUT *RT* REQUIRED
 NEW      SPACE  4,10
***       NEW (F/ND)
*
*         CREATE A NEW PRIMARY FILE. ANY CURRENT WORKING FILE
*         NAMED F IS RETURNED, AND A NEW (EMPTY) FILE F CREATED
*         AND MADE USER S NEW PRIMARY FILE.
*
*                F = NEW PRIMARY FILE NAME.
*                ND = IF NOT SPECIFIED, ALL WORKING FILES WILL BE
*                     RETURNED (EXCEPT PRIMARY).
 
 
 NEW      BSS    0           ENTRY
          SB7    CCNW        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SX1    B1          INDICATE FILE NOT BUSY
          SA2    TSFN
          SA3    A2+B1
          NZ     X3,ERR      IF MORE THAN 1 WORKING FILE SPECIFIED
          SA3    TPFN
          NZ     X3,ERR      IF PERMANENT FILE NAME SPECIFIED
          BX6    X1+X2
          SA6    F
          RETURN A6          RETURN EXISTING PRIMARY FILE
          PRIMARY X2         CREATE NEW PRIMARY FILE
          RJ     RNF         RETURN NON-PRIMARY FILES
          EQ     PNC         PROCESS NEXT COMMAND
 OLD      SPACE  4,15
***       OLD (F=P/PW,UN,PN,R,RT,NA,WB,ND)
*
*         RETRIEVE COPY OF PERMANENT FILE FOR SYSTEM USAGE.
*         INDIRECT ACCESS FILES ONLY.
*         FILE F WILL BE MADE USER S NEW PRIMARY FILE.
*
*                F = WORKING FILE NAME.
*                P = PERMANENT FILE NAME.
*                PW = FILE PASSWORD.
*                UN = USER NAME.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                RT = RETURN CONTROL AFTER STAGE INITIATED OR IF
*                     A PF UTILITY IS ACTIVE. DO NOT
*                     WAIT FOR FILE TO BE AVAILABLE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
*                ND = IF NOT SPECIFIED, ALL WORKING FILES WILL BE
*                     RETURNED (EXCEPT PRIMARY).
 
 
 OLD      BSS    0           ENTRY
          SB7    CCOL        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SX1    B1          INDICATE FILE NOT BUSY
          SA2    TSFN
          SA3    A2+B1
          NZ     X3,ERR      IF MORE THAN 1 WORKING FILE SPECIFIED
          BX6    X1+X2
          SA6    F
          OLD    F,TPFN,USNM,PWD,PKNM,RES
          RJ     CES         CHECK ERROR STATUS
          RJ     RNF         RETURN NON-PRIMARY FILES
          EQ     PNC         PROCESS NEXT COMMAND
 PACKNAM  SPACE  4,10
***       PACKNAM(NAME)
*         PACKNAM(NAME,TYPE)
*         PACKNAM(NAME,R=TYPE)
*         PACKNAM(PN=NAME)
*         PACKNAM(PN=NAME,R=TYPE)
*
*         SET DEFAULT PACKNAME AND DEVICE TYPE.
*
*                NAME = PACK NAME.
*                TYPE = DEVICE TYPE.
 
 
 PACKNAM  BSS    0           ENTRY
          SB1    1
          RJ     IDF         ISSUE DAYFILE MESSAGE
          SB2    CCDR        UNPACK COMMAND TO STRING BUFFER
          RJ     USB
          RJ     POP         SKIP OVER PROGRAM NAME
          ZR     B6,PAC2     IF NO ARGUMENTS
          SB2    TARGPL      CONVERT POSITIONAL ARGUMENTS
          SB3    TARGP
          SB4    PBUF
          RJ     CPA
          NG     B5,ERR      IF ERRORS IN CONVERSION
          PL     X1,PAC2     IF NO ARGUMENTS PROCESSED
          SX6    B5+         PROCESS ARGUMENTS
          SB6    PBUF
          SA6    USBC
          RJ     ARM
          NZ     X1,ERR      IF ARGUMENT ERROR
          RJ     PRD         PROCESS RESIDENCE DEFINITION
          SA4    RES         VALIDATE DEVICE TYPE
          ZR     X4,PAC2     IF DEVICE TYPE NOT SPECIFIED
          MX0    -6
          LX4    18
          BX6    -X0*X4
          NZ     X6,PAC1     IF THREE CHARACTER DEVICE TYPE SPECIFIED
          SX6    1R1         ADD *1* TO TWO CHARACTER DEVICE TYPE
          BX4    X4+X6
 PAC1     SA1    PKNM
          ZR     X1,PAC2     IF *PN* NOT SPECIFIED
          BX6    X1+X4       COMBINE *PN* WITH *R*
          SA6    A1
 PAC2     PACKNAM  PKNM      ENTER PACK NAME AND PACK TYPE
          EQ     PNC         PROCESS NEXT COMMAND
 PERMIT   SPACE  4,20
***       PERMIT (P,UN1=M1,UN2=M2,...,UNN=MN/PN,R,NA,WB,XT)
*
*         PERMIT USER TO ACCESS PERMANENT FILE WITH SPECIFIED MODE.
*
*                P = PERMANENT FILE NAME.
*                UN = USER NAME TO BE PERMITTED.
*                M = MODE OF ACCESS PERMITTED.
*                            W - WRITE, READ, EXECUTE APPEND
*                            R - READ, EXECUTE.
*                            E - EXECUTE.
*                            A - APPEND.
*                            N - NULL.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
*                XT = PERMIT EXPIRATION DATE OR TERM.
*
*                DEFAULT VALUES.
*                            M = READ.
 
 
 PERMIT   BSS    0           ENTRY
          SB7    CCPM        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SA1    TSFN        SET FILE NAME
          SA2    TPFN        CHECK FOR LOCAL FILE NAME
          NZ     X2,ERR      IF LOCAL FILE SPECIFIED
          SB7    CCPM        SET PERMIT FUNCTION
          SX6    B1
          BX6    X6+X1
          SA6    F
          SB3    B1
          SA1    B3+TSFN     READ FIRST USER NAME
          ZR     X1,ERR      IF NO USER SPECIFIED
 PER1     SA5    B3+TPFN     MODE
          RJ     PMD         CONVERT MODE
          PERMIT F,,B3+TSFN,MODE,PKNM,RES,,,PXT
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT USER
          SA1    B3+TSFN
          NZ     X1,PER1     IF ANOTHER USER TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
 PURGE    SPACE  4,15
***       PURGE (P/UN,PW,PN,R,NA,WB)
*
*         PURGE PERMANENT FILE.
*
*                P = PERMANENT FILE NAME
*                UN = USER NAME.
*                (USER MUST HAVE WRITE PERMISSION)
*                PW = FILE PASSWORD
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
 
 
 PURGE    BSS    0           ENTRY
          SB7    CCPG        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SB3    B0          PROCESS FILE NAME LIST
          SA5    B3+TSFN
 PUR1     SX6    B1
          BX6    X6+X5
          SA6    F
          PURGE  F,USNM,PWD,PKNM,RES
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT FILE
          SA5    B3+TSFN
          NZ     X5,PUR1     IF ANOTHER FILE TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
 REPLACE  SPACE  4,15
***       REPLACE (F=P/PW,M,UN,PN,R,NA,WB)
*
*         REPLACE PERMANENT FILE WITH COPY OF WORKING FILE.
*         INDIRECT ACCESS FILES ONLY.
*
*                F = WORKING FILE NAME.
*                P = PERMANENT FILE NAME
*                PW = FILE PASSWORD
*                M = MODE OF ACCESS (IF FILE DOES NOT ALREADY EXIST).
*                UN = USER NAME.
*                     (USER MUST HAVE WRITE PERMISSION).
*                PN = PACK NAME.
*                R = RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
 
 
 REPLACE  BSS    0           ENTRY
          SB7    CCRP        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          SB3    B0
          SA5    B3+TSFN     SYSTEM FILE NAME
 REP1     SX6    B1
          BX6    X5+X6
          SA6    F
          REPLACE  F,B3+TPFN,USNM,PWD,,PKNM,RES,,,MODE
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT FILE
          SA5    B3+TSFN
          NZ     X5,REP1     IF ANOTHER FILE TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
 SAVE     SPACE  4,25
***       SAVE (F=P/PW,CT,M,BR,SS,PR,PN,R,NA,WB,XT,AL,AC)
*
*         SAVE COPY OF WORKING FILE ON PERMANENT FILES.
*         IF PRIMARY FILE IS SAVED, ASSOCIATED SUBSYSTEM IS
*         SET INTO CATALOG.
*         INDIRECT ACCESS FILES ONLY.
*
*                F = WORKING FILE NAME.
*                P = PERMANENT FILE NAME
*                PW = FILE PASSWORD
*                CT = FILE CATEGORY
*                M = MODE OF ACCESS
*                BR = BACKUP REQUIREMENT.
*                SS = SUBSYSTEM.
*                PN = PACK NAME.
*                R = RESIDENCE.
*                PR = PREFERRED RESIDENCE.
*                NA = NO ABORT IF ERROR ENCOUNTERED.
*                WB = WAIT FOR PACK MOUNT.
*                XT = PASSWORD EXPIRATION DATE OR TERM.
*                AL = FILE ACCESS LEVEL.
*                AC = ALTERNATE CATLIST PERMISSION.
*
*                DEFAULT VALUES.
*                            PW = 0.
*                            CT = PRIVATE.
*                            M = WRITE.
*                            NA = 0.
*                            AC = NO.
 
 
 SAVE     BSS    0           ENTRY
          SB7    CCSV        SET FUNCTION CODE
          RJ     PFL         PROCESS PERMANENT FILE REQUEST
          RJ     GPN         GET PRIMARY FILE NAME
          SB3    B0
          SA5    B3+TSFN     SYSTEM FILE NAME
 SAV1     SX6    B1
          BX6    X6+X5
          SA6    F
          SA1    SUBSYS
          NZ     X1,SAV2     IF *SS* SPECIFIED
          SA1    GETTAB+1    CHECK FOR PRIMARY FILE
          BX1    X1-X5
          NZ     X1,SAV2     IF NOT MATCH
          SA2    PSSA        GET CURRENT SUBSYSTEM
          BX6    X2
          SA6    SUBSYS
 SAV2     SAVE   F,B3+TPFN,PWD,,CTG,MODE,PKNM,RES,,SUBSYS,BREQ,PRES,,PXT
,,FAL,ALCT
          RJ     CES         CHECK ERROR STATUS
          SB3    B3+B1       ADVANCE TO NEXT FILE
          SA5    B3+TSFN
          NZ     X5,SAV1     IF ANOTHER FILE TO PROCESS
          EQ     PNC         PROCESS NEXT COMMAND
          TITLE  SUBROUTINES.
 CES      SPACE  4,20
**        CES - CHECK ERROR STATUS.
*
*         ABORT IF *NA* WAS NOT SPECIFIED, AND AN ERROR OTHER THAN
*         *FILE BUSY*, *FILE INTERLOCKED*, *STAGE INITIATED* OR
*         *PF UTILITY ACTIVE* IS DETECTED.
*
*         ENTRY  (X2) = FET ADDRESS.
*
*         EXIT   (X6) = 0 IF *FILE BUSY* ERROR.
*                (X7) = 0 IF *STAGE INITIATED*, *PF UTILITY ACTIVE*
*                            OR *FILE INTERLOCKED*.
*                (ERRFLG) .NE. 0 IF ERROR OTHER THAN *FILE BUSY*,
*                   *STAGE INITIATED*, *PF UTILITY ACTIVE* OR
*                   *FILE INTERLOCKED*.
*
*         USES   X - 1, 6, 7.
*                A - 1, 6.
*
*         MACROS ABORT.
 
 
 CES      SUBR               ENTRY/EXIT
          MX6    -8          CHECK ERROR STATUS FIELD
          SA1    X2
          AX1    10
          BX1    -X6*X1
          SX6    X1-/ERRMSG/FBS
          SX7    X1-/ERRMSG/PSI
          ZR     X1,CESX     IF NO ERROR
          ZR     X6,CESX     IF *FILE BUSY* STATUS
          ZR     X7,CESX     IF *STAGE INITIATED* STATUS
          SX7    X1-/ERRMSG/PFA
          ZR     X7,CESX     IF *PF UTILITY ACTIVE* STATUS
          SX7    X1-/ERRMSG/FIN
          ZR     X7,CESX     IF *FILE INTERLOCKED* STATUS
          SA6    ERRFLG      SAVE ERROR FLAG
          SA1    NABT
          NZ     X1,CESX     IF *NA* SPECIFIED RATHER THAN *WB* OR *RT*
          ABORT              ABORT (ERROR MESSAGE ISSUED BY *PFM*)
 CTJ      SPACE  4,9
**        CTJ - CHECK FOR *TXOT* JOB.
*
*         EXIT   (X2) = 0, IF *TXOT* JOB.
*
*         USES   X - 0, 1.
*                A - 1.
 
 
 CTJ      SUBR               ENTRY/EXIT
          SA1    JOPR        FETCH ORIGIN TYPE FROM COMMUNICATION AREA
          LX1    -24
          MX0    -12
          BX1    -X0*X1
          SX2    X1-TXOT
          EQ     CTJX        EXIT
 CVT      SPACE  4,15
**        CVT - CONVERT ARGUMENT
*
*         ENTRY  (B5) = ADDRESS OF TABLE
*                (X5) = ARGUMENT
*                TABLE OF ARGUMENTS IN FOLLOWING FORMAT.
*T,       42/ARGUMENT,18/VALUE
*
*         EXIT   (X6) = 0 IF LEGAL ARGUMENT
*                (X7) = EQUIVALENT VALUE (RIGHT JUSTIFIED)
*
*         CALLS  *NONE*
*
*         USES   X - 0, 2, 4, 5, 6, 7.
*                A - 4.
*                B - 5.
 
 
 CVT      SUBR               ENTRY/EXIT
          MX0    42
          MX6    1
          BX5    X0*X5
 CVT1     SA4    B5          READ NEXT TABLE ENTRY
          ZR     X4,CVTX     IF END OF TABLE
          SB5    B5+B1       ADVANCE TABLE POINTER
          BX2    X0*X4       PICK ARGUMENT
          BX7    -X0*X4      PICK EQUIVALENCE
          IX6    X2-X5
          ZR     X6,CVTX     IF ARGUMENT FOUND
          EQ     CVT1        LOOP FOR NEXT TABLE VALUE
 ESP      SPACE  4,25
**        ESP - ENTER SECURE PASSWORD.
*
*         THIS SUBROUTINE PROCESSES SECURELY ENTERED PASSWORDS.
*         IF OUTPUT FILE IS ASSIGNED TO A TERMINAL THE MESSAGE
*         *PASSWORD:* ALONG WITH BLANK OUT CHARACTERS FOR SECURE
*         ENTRY OF PASSWORD WILL BE SENT TO THE TERMINAL.
*         FILE *INPUT* WILL THEN BE READ FOR THE PASSWORD.
*         FOR BATCH JOBS FILE *INPUT* IS READ FOR THE PASSWORD.
*
*         ENTRY  (PFLA) = COMMAND CODE.
*
*         EXIT   (X6) = PASSWORD.
*                (B7) = COMMAND CODE.
*                TO *ABT* IF INCORRECT PASSWORD ENCOUNTERED.
*
*         USES   X - ALL.
*                A - 1, 2, 6, 7.
*                B - 2, 3, 4, 5, 6, 7.
*
*         CALLS  STF.
*
*         MACROS CSET, MESSAGE, READSKP, WRITE.
 
 
 ESP      SUBR               ENTRY/EXIT
          SX2    O           SET ADDRESS OF FET
          RJ     STF         CHECK IF OUTPUT ASSIGNED TO TERMINAL
          NZ     X6,ESP1     IF OUTPUT NOT ASSIGNED TO TERMINAL
          SA1    X2+B1       SET BUFFER FULL
          SX7    X1
          SX6    X1+PMSGL
          SA6    A1+B1       SET IN BELOW DATA FOR MESSAGE
          SA7    A6+B1       SET OUT = FIRST
          WRITE  X2,*        FORCE WRITE BIT SET
          SA1    O
          MX0    42
          BX2    X0*X1       FILE NAME FOR OUTPUT POINTER
          SX1    A1          SET ADDRESS OF FET FOR POINTER
          BX6    X1+X2
          SA6    ARGR        FORCE WRITE BEFORE READ ON ROLLOUT
 ESP1     SX2    I           SET ADDRESS OF FET
          RJ     STF         CHECK IF INPUT ASSIGNED TO TERMINAL
          NZ     X6,ESP2     IF INPUT NOT ASSIGNED TO TERMINAL
          CSET   NORMAL      ENSURE TERMINAL IN NORMAL MODE
 ESP2     READSKP I,,R       READ INPUT FOR PASSWORD
          SA1    I+2         DETERMINE NUMBER OF WORDS READ
          SA2    A1+B1
          IX6    X1-X2
          ZR     X6,ESP10    IF NO DATA ENTERED (NULL PASSWORD)
          SB5    X6
          SB3    B0
          BX5    X5-X5
          BX6    X6-X6
          SB4    60
          SB7    B0
          MX0    -6
 ESP3     SA2    IBUF+B3     PICK UP NEXT DATA WORD
          SB2    B0+
 ESP4     LX2    6
          BX1    -X0*X2      PICK UP CHARACTER TO CHECK
          NZ     X1,ESP5     IF CHARACTER NOT ZERO
          NZ     X5,ESP10    IF 00 ENCOUNTERED
          SX5    B1+         SET FLAG TO INDICATE 0 ENCOUNTERED
          EQ     ESP9        CHECK FOR MORE CHARACTERS
 
 ESP5     NZ     X5,ESP11    IF PREVIOUS CHARACTER = COLON
 ESP6     SB6    X1-1R9
          GT     B6,ESP8     IF NOT ALPHANUMERIC CHARACTER
 ESP7     SB4    B4-6
          LX7    X1,B4
          BX6    X7+X6
          SB7    B7+1
          SB6    B7-7
          GT     B6,ESP11    IF PASSWORD .GT. SEVEN CHARACTERS
          EQ     ESP9        CHECK FOR MORE CHARACTERS
 
 ESP8     SX4    X1-1R*
          ZR     X4,ESP7     IF CHARACTER = *
          SX3    X1-1R
          NZ     X3,ESP11    IF CHARACTER NOT BLANK
 ESP9     SB2    B2+B1
          SB6    B2-10
          LT     B6,ESP4     IF NOT END OF WORD
          SB3    B3+B1
          SB6    B5-B3
          EQ     B6,ESP11    IF TOO MUCH DATA ENTERED
          EQ     ESP3        GET NEXT WORD
 
 ESP10    SA1    I+1
          BX7    X1
          SA7    A1+B1       SET IN = FIRST FOR INPUT BUFFER
          SA1    PFLA        RESET (B7) = COMMAND CODE
          SB7    X1
          SA1    =1L0        CHECK FOR *0*
          BX7    X6-X1
          NZ     X7,ESPX     IF *0* NOT SPECIFIED
          BX6    X7          SET NULL PASSWORD
          EQ     ESPX        RETURN
 
 ESP11    MESSAGE (=C* INCORRECT PASSWORD.*)
          ABORT
 GPN      SPACE  4,21
**        GPN - GET PRIMARY FILE NAME.
*         THIS SUBROUTINE IS USED FOR DETERMINING THE NAME OF
*         THE USER S PRIMARY FILE- IF ONE EXISTS.
*
*         A LFM GETFNT CALL IS MADE, WITH SELECTIVITY OF PRIMARY
*         TYPE ONLY, AND CONTROL BITS SET FOR NORMAL TREATMENT
*         OF CHECKPOINT FILES AND NO MODIFICATION OF FST ENTRIES.
*
*         ENTRY  (GPNB) .NE. 0 IMPLIES PRIMARY HAS ALREADY BEEN
*                            FETCHED BY A DEFAULT CALL.
*
*         EXIT   IF (GPNB) = 0,
*                (GETTAB+1) AND (X6) .NE. 0 IMPLIES PRIMARY EXISTS AND
*                                    CONTAINS NAME (LEFT
*                                    JUSTIFIED WITH ZERO FILL).
*                (GETTAB+1) AND (X6) = 0 IMPLIES NO PRIMARY EXISTS.
*
*         USES   X - 2, 3, 6, 7.
*                A - 2, 6, 7.
*
*         MACROS GETFNT.
 
 
 GPN      SUBR               ENTRY/EXIT
          SA2    GPNB
          NZ     X2,GPNX     IF HAVE ALREADY FETCHED PRIMARY, EXIT
          BX7    X7-X7       CLEAR BUFFER CONTROL WORD
          SA7    GETTAB
          SA2    GPNA
          BX6    X2
          SA6    F+CFPN
          GETFNT F
          BX6    X6-X6       CLEAR PFM LOCATION FET+CFPN
          SA6    F+CFPN
          SA2    GETTAB+1
          MX3    42          MASK OUT ALL BUT NAME OF PRIMARY
          BX6    X2*X3
          SA6    A2
          EQ     GPNX        EXIT
 
*         GETFNT CONTROL WORD.
 
 PRIM     DECMIC PTFT
 PMSK     EQU    1S"PRIM"
 GPNA     VFD    12/1,24/PMSK,6/15B,18/GETTAB
 GPNB     DATA   0           PRIMARY FETCHED FLAG
 IDF      SPACE  4,10
**        IDF - ISSUE DAYFILE MESSAGE.
*
*         ENTRY  (CCDR) = COMMAND.
*
*         USES   X - 4, 5.
*                A - 4, 5.
*                B - 2, 6.
*
*         CALLS  CTJ, RSP.
 
 
 IDF      SUBR               ENTRY/EXIT
          SA4    TARG+1      FWA ARGUMENT TABLE
          SB6    TKPR        FWA KEYWORD/POSITION TABLE
          SA5    CCDR        FWA COMMAND BUFFER
          SB2    1R/         SKIP TO */*
          RJ     RSP         REMOVE SECURE PARAMETERS FROM COMMAND
          MESSAGE CCDR,0,R   ISSUE COMMAND TO DAYFILE
          EQ     IDFX        RETURN
 
 
 TKPR     BSS    0           TABLE OF KEYWORDS/POSITIONS TO REMOVE
          CON    2LAL        ACCESS LEVEL
          CON    2LPW        PASSWORD
          CON    0           END OF TABLE
 PAC      SPACE  4,15
**        PAC - PROCESS ALTERNATE CATLIST PERMISSION.
*
*         ENTRY  (ALCT) = ALTERNATE CATLIST PERMISSION (DISPLAY CODE).
*
*         EXIT   (ALCT) = ALTERNATE CATLIST PERMISSION
*                        (NUMERIC EQUIVALENT).
*
*         USES   X - 5, 7.
*                A - 5, 7.
*                B - 5.
*
*         CALLS  CVT.
*
*         MACROS ABORT, MESSAGE.
 
 
 PAC      SUBR               ENTRY/EXIT
          SA5    ALCT
          ZR     X5,PACX     IF NOT SPECIFIED
          SB5    TACP
          RJ     CVT         CONVERT ARGUMENT
          SA7    A5
          ZR     X6,PACX     IF LEGAL ARGUMENT
          MESSAGE  (=C* ERROR IN ALTERNATE CATLIST PERMISSION.*)
          ABORT
 
 
****
*         TABLE OF ALTERNATE CATLIST PERMISSIONS.
 
 
 TACP     BSS    0
          VFD    42/0LN,18/ACNO
          VFD    42/0LY,18/ACYS
          CON    0
****
 PAL      SPACE  4,10
**        PAL - PROCESS ACCESS LEVEL.
*
*         EVALUATE IF AN ACCESS LEVEL HAS BEEN SPECIFIED.  IF SO,
*         SET ACCESS LEVEL VALUE AND *SP* BIT IN THE FET.
*
*         ENTRY  (FAL) = FILE ACCESS LEVEL.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*                B - 2.
*
*         CALLS  VLC.
*
*         MACROS ABORT.
 
 
 PAL      SUBR               ENTRY/EXIT
          SA1    FAL
          ZR     X1,PALX     IF *AL* NOT SPECIFIED
          SB2    B0          SET ACCESS LEVEL FLAG
          RJ     VLC         VALIDATE ACCESS LEVEL MNEMONIC
          NG     X2,PAL1     IF INCORRECT ACCESS LEVEL
          BX6    X2          SET *AL* IN FET
          SA6    FAL
          SA1    F+B1        SET *SP* BIT IN FET
          SX2    B1
          LX2    39-0
          BX6    X1+X2
          SA6    A1
          EQ     PALX        RETURN
 
 PAL1     MESSAGE  (=C* UNKNOWN ACCESS LEVEL NAME.*)
          ABORT
 PBR      SPACE  4,20
**        PBR - PROCESS BACKUP REQUIREMENT.
*
*         ENTRY  (BREQ) = BACKUP REQUIREMENT (DISPLAY CODE).
*
*         EXIT   (BREQ) = BACKUP REQUIREMENT (NUMERIC EQUIVALENT).
*
*         USES   X - 5.
*                A - 5, 7.
*                B - 5.
*
*         CALLS  CVT.
*
*         MACROS ABORT, MESSAGE.
 
 
 PBR      SUBR               ENTRY/EXIT
          SA5    BREQ
          ZR     X5,PBRX     IF NO ARGUMENT SPECIFIED
          SB5    TBREQ
          RJ     CVT         CONVERT ARGUMENT TO EQUIVALENT
          SA7    A5          SAVE CONVERSION
          ZR     X6,PBRX     IF LEGAL ARGUMENT
 
          MESSAGE  (=C* ERROR IN BACKUP REQUIREMENT.*)
          ABORT
 
 
****
*         TABLE OF BACKUP REQUIREMENTS.
 
 
 TBREQ    BSS    0
          VFD    42/0LN,18/BRNO  BACKUP NOT REQUIRED
          VFD    42/0LY,18/BRAL  BACKUP ALWAYS REQUIRED
          VFD    42/0LMD,18/BRMD  BACKUP REQUIRED UNLESS FILE ON MSF
          CON    0
****
 PCT      SPACE  4,15
**        PCT - PROCESS FILE CATEGORY.
*
*         ENTRY  (CTG) = LEFT JUSTIFIED DISPLAY CODED ARGUMENT.
*
*         EXIT   (CTG) = RIGHT JUSTIFIED EQUIVALENT ARGUMENT.
*
*         USES   X - 5, 7.
*                A - 5, 7.
*                B - 5.
*
*         CALLS  CVT.
*
*         MACROS ABORT, MESSAGE.
 
 
 PCT      SUBR               ENTRY/EXIT
          SA5    CTG
          ZR     X5,PCTX     IF NO ARGUMENT
          SB5    TCAT
          RJ     CVT         CONVERT ARGUMENT TO EQUIVALENT
          SX7    X7+40B
          SA7    A5          SAVE CONVERSION
          ZR     X6,PCTX     IF LEGAL ARGUMENT
 
          MESSAGE (=C* ERROR IN FILE CATEGORY.*)
          ABORT
 
 
****
*         TABLE OF FILE CATEGORIES.
 
 
 TCAT     BSS    0
          VFD    42/0LPRIVATE,18/FCPR
          VFD    42/0LP,18/FCPR
          VFD    42/0LPR,18/FCPR
          VFD    42/0LSPRIV,18/FCSP
          VFD    42/0LS,18/FCSP
          VFD    42/0LLIBRARY,18/FCLI
          VFD    42/0LL,18/FCLI
          VFD    42/0LPUBLIC,18/FCLI
          VFD    42/0LPU,18/FCLI
          CON    0
****
 PDC      SPACE  4,25
**        PDC - PROCESS DEFAULT CALL.
*
*         DETERMINE IF THE COMMAND IS A DEFAULT CALL.
*         THIS IS A *GET*, *PURGE*, *REPLACE*, OR *SAVE*
*         WITH NO ARGUMENTS OR ONE BLANK ARGUMENT.
*
*         ENTRY  (B4) = ARGUMENT COUNT.
*                (B6) = SHIFT COUNT FOR COMMAND.
*                (B7) = COMMAND CODE.
*
*         EXIT   (B2) .NE. 0 IF NOT DEFAULT CALL.
*                ABORT IF DEFAULT AND NO PRIMARY FILE.
*                IF DEFAULT AND PRIMARY FILE FOUND-
*                (B2) = 0
*                (TSFN) = PRIMARY FILE NAME.
*                (GPNB) .NE. 0.
*
*         USES   X - 1, 2, 6.
*                A - 2, 6.
*                B - 2.
*
*         CALLS  GPN.
*
*         MACROS ABORT, MESSAGE.
 
 
 PDC      SUBR               ENTRY/EXIT
          SB2    B1+         SET NO DEFAULT EXIT
          GT     B4,B1,PDCX  IF TOO MANY ARGUMENTS
          SX1    PRM9
          LX1    X1,B6
          PL     X1,PDCX     IF DEFAULT NOT LEGAL FOR COMMAND
          SA2    ARGR
          NZ     X2,PDCX     IF ARGUMENT NOT BLANK
          RJ     GPN         GET PRIMARY FILE NAME
          ZR     X6,PDC1     IF NO PRIMARY FILE
          SA6    GPNB        SET PRIMARY FETCHED FLAG
          SA6    TSFN        SET DEFAULT FILE NAME
          SB2    B0          SET DEFAULT EXIT
          BX6    X6-X6
          SA6    TSFN+1      TERMINATE *TSFN* TABLE
          SA6    TPFN
          EQ     PDCX        RETURN
 
 PDC1     MESSAGE (=C* NO PRIMARY FILE.*)
          ABORT
 PMD      SPACE  4,15
**        PMD - PROCESS MODE OF FILE.
*
*         ENTRY  (X5) = ACCESS MODE (DISPLAY CODE).
*
*         EXIT   (MODE) = ACCESS MODE (NUMERIC EQUIVALENT).
*
*         USES   X - 5, 7.
*                A - 5, 7.
*                B - 5.
*
*         CALLS  CVT.
*
*         MACROS ABORT, MESSAGE.
 
 
 PMD      SUBR               ENTRY/EXIT
          NZ     X5,PMD2     IF MODE ENTERED
          SX7    PTRD        SET DEFAULT MODE (READ MODE)
 PMD1     SA7    MODE
          EQ     PMDX
 
 PMD2     SB5    TMDE
          RJ     CVT         CONVERT ARGUMENT
          SX7    X7+40B
          ZR     X6,PMD1     IF LEGAL ARGUMENT
 
          MESSAGE (=C* ERROR IN MODE.*)
          ABORT
 
 
****
*         TABLE OF FILE MODE EQUIVALENCES.
 
 
 TMDE     BSS    0
          VFD    42/0LWRITE,18/PTWR
          VFD    42/0LW,18/PTWR
          VFD    42/0LREAD,18/PTRD
          VFD    42/0LR,18/PTRD
          VFD    42/0LEXECUTE,18/PTEX
          VFD    42/0LE,18/PTEX
          VFD    42/0LAPPEND,18/PTAP
          VFD    42/0LA,18/PTAP
          VFD    42/0LNULL,18/PTNU
          VFD    42/0LN,18/PTNU
          VFD    42/0LMODIFY,18/PTMD
          VFD    42/0LM,18/PTMD
          VFD    42/0LREADMD,18/PTRM
          VFD    42/0LRM,18/PTRM
          VFD    42/0LREADAP,18/PTRA
          VFD    42/0LRA,18/PTRA
          VFD    42/0LUPDATE,18/PTUP
          VFD    42/0LU,18/PTUP
          VFD    42/0LREADUP,18/PTRU
          VFD    42/0LRU,18/PTRU
          CON    0
****
 PNA      SPACE  4,10
**        PNA - PROCESS *NO ABORT* AND *WAIT BUSY* OPTIONS.
*
*         ENTRY  (NABT) .NE. 0 IF *NO ABORT* SPECIFIED.
*                (WBUSY) .NE. 0 IF *WAIT BUSY* REQUESTED.
*
*         EXIT   ERROR PROCESSING BIT SET IF REQUIRED.
*                TO *ERR* IF BOTH *NA* AND *WB* SPECIFIED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
 
 
 PNA      SUBR               ENTRY/EXIT
          SA1    NABT
          SA2    WBUSY
          IX1    X1+X2
          ZR     X1,PNAX     IF NEITHER *NA* OR *WB* SPECIFIED
          SX1    X1-2
          ZR     X1,ERR      IF BOTH *NA* AND *WB* SPECIFIED
          SA1    F+1         SET ERROR PROCESSING BIT
          SX6    B1
          LX6    44
          BX6    X1+X6
          SA6    A1
          EQ     PNAX        RETURN
 PPX      SPACE  4,20
**        PPX - PROCESS PASSWORD/PERMIT EXPIRATION DATE/TERM.
*
*         ENTRY  (B7) = (PFLA) = COMMAND CODE.
*                (PXD) = EXPIRATION DATE (DISPLAY CODE).
*                (PXT) = EXPIRATION TERM (DISPLAY CODE).
*
*         EXIT   (B7) = COMMAND CODE.
*                (PXT) = NUMERIC EXPIRATION DATE/TERM.
*                TO *ERR* IF BOTH *XD* AND *XT* SPECIFIED,
*                OR IF ONE IS SPECIFIED ON A *SAVE OR *DEFINE*
*                WITHOUT *PW*.
*
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 3, 6.
*                B - 2, 7.
*
*         CALLS  DXB, VDT.
*
*         MACROS ABORT, MESSAGE, PDATE.
 
 
 PPX6     SA6    PXT         SAVE *XT*
          SA1    PFLA        RESTORE COMMAND CODE
          SB7    X1
 
 PPX      SUBR               ENTRY/EXIT
          SA1    PXT
          SA2    PXD
          SB2    X1
          SB2    X2+B2
          ZR     B2,PPXX     IF NEITHER *XD* OR *XT* SPECIFIED
          NE     B2,B1,ERR   IF BOTH *XD* AND *XT* SPECIFIED
          SB2    B7-CCCG
          ZR     B2,PPX1     IF *CHANGE* COMMAND
          SB2    B7-CCPM
          ZR     B2,PPX1     IF *PERMIT* COMMAND
          SA3    PWD
          ZR     X3,ERR      IF *PW* NOT ENTERED
 PPX1     MX0    42
          ZR     X2,PPX2     IF *XT* SPECIFIED RATHER THAN *XD*
 
*         PROCESS EXPIRATION DATE.
 
          BX1    X0*X2
          SX2    B0
          BX3    X1
          LX3    -54
          SX3    X3-1R*
          ZR     X3,PPX2.1   IF NON-EXPIRING PASSWORD/PERMIT REQUESTED
          RJ     VDT         VERIFY DATE SPECIFIED
          NG     X1,PPX5     IF DATE ALREADY OCCURRED
          NG     X6,PPX5     IF CONVERSION ERROR
          EQ     PPX6        SAVE EXPIRATION DATE
 
*         PROCESS EXPIRATION TERM.
 
 PPX2     BX1    X0*X1
          BX5    X1
          LX1    -54
          SX2    X1-1R*      CHECK FOR *XT* = ASTERISK
          NZ     X2,PPX3     IF NOT NON-EXPIRING
 PPX2.1   SX6    7777B
          EQ     PPX6        STORE NON-EXPIRING TERM
 
 PPX3     SX2    X1-1R0      CHECK FOR *XT* = CHARACTER ZERO
          NZ     X2,PPX4     IF NOT IMMEDIATELY EXPIRING
          PDATE  PPXA        SET *XT* = CURRENT DATE
          SA2    PPXA
          AX2    18
          BX6    X2
          EQ     PPX6        SAVE CURRENT DATE
 
 PPX4     ZR     X5,PPX5     IF NULL TERM SPECIFIED
          SB7    1           CONVERT DECIMAL NUMBER
          RJ     DXB         CONVERT DISPLAY CODE TO BINARY NUMBERS
          NZ     X4,PPX5     IF CONVERSION ERROR
          SB2    X6-7777B
          LE     B2,B0,PPX6  IF TERM DOES NOT EXCEED MAXIMUM
 PPX5     MESSAGE  (=C* ERROR IN EXPIRATION DATE.*)
          ABORT
 
 PPXA     DATA   0
 PRD      SPACE  4,10
**        PRD - PROCESS RESIDENCE DEFINITION.
*
*         ENTRY  (RES) = RESIDENCE OF FILE.
*
*         USES   X - 0, 1, 2, 3.
*                A - 2, 3.
*
*         MACROS ABORT, MESSAGE.
 
 
 PRD      SUBR               ENTRY/EXIT
          SA3    RES
          ZR     X3,PRDX     IF RESIDENCE NOT DEFINED
          MX0    12
          BX1    X0*X3
          MX2    -6
          LX3    18
          BX2    -X2*X3
          BX0    X0*X3
          NZ     X0,PRD3     IF RESIDENCE ENTRY TOO LONG
          ZR     X2,PRD1     IF *N* NOT DEFINED
          SX3    X2-1R1
          SX2    X2-1R9
          NG     X3,PRD3     IF *N* .LT. 1
          PL     X2,PRD3     IF *N* .GT. 8
 PRD1     SA2    TDVM-1
 PRD2     SA2    A2+B1
          BX3    X1-X2
          ZR     X3,PRDX     IF MATCH ON DEVICE
          NZ     X2,PRD2     IF NOT END OF TABLE
 PRD3     MESSAGE  PRDA      * ERROR IN RESIDENCE.*
          ABORT
 
 
 PRDA     DATA   C* ERROR IN RESIDENCE.*
 TDVM     SPACE  4,10
**        TDVM - TABLE OF DEVICE MNEMONICS.
*
*T TDVM   12/MN, 48/0
*
*         MN = DEVICE MNEMONIC.
 
 
**        TBLM - DEFINE MACRO TO PRODUCE *TDVM* TABLE.
 
          PURGMAC  TBLM
 TBLM     MACRO  EQ
          VFD    12/2R_EQ,48/0
          ENDM
 
          LIST   G
 TDVM     TBL    "MSEQ"
          CON    0           END OF TABLE
          LIST   -G
 PRE      SPACE  4,20
**        PRE - PROCESS PREFERRED RESIDENCE.
*
*         ENTRY  (PRES) = PREFERRED RESIDENCE (DISPLAY CODE).
*
*         EXIT   (PRES) = PREFERRED RESIDENCE (NUMERIC EQUIVALENT).
*
*         USES   X - 5.
*                A - 5, 7.
*                B - 5.
*
*         CALLS  CVT.
*
*         MACROS ABORT, MESSAGE.
 
 
 PRE      SUBR               ENTRY/EXIT
          SA5    PRES
          ZR     X5,PREX     IF NO ARGUMENT SPECIFIED
          SB5    TPRES
          RJ     CVT         CONVERT ARGUMENT TO EQUIVALENT
          SA7    A5          SAVE CONVERSION
          ZR     X6,PREX     IF LEGAL ARGUMENT
          MESSAGE  (=C*ERROR IN PREFERRED RESIDENCE.*)
          ABORT
 
 
****
*         TABLE OF PREFERRED RESIDENCES.
 
 
 TPRES    BSS    0
          VFD    42/0LL,18/RSLK
          VFD    42/0LD,18/RSDS
          VFD    42/0LM,18/RSMS
          VFD    42/0LN,18/RSNP
          VFD    42/0LT,18/RSTP
          CON    0
****
 PRT      SPACE  4,10
**        PRT - PROCESS *RT* PARAMETER.
*
*         ENTRY  (RTIME) = 0 IF *RT* NOT SPECIFIED.
*                (PFLA) = COMMAND CODE.
*                (PFLB) = NUMBER OF FILES SPECIFIED - 1.
*
*         EXIT   *RT* BIT SET IN FET IF REQUESTED, OR IF MORE THAN ONE
*                FILE SPECIFIED ON AN *ATTACH* OR *GET* COMMAND.
*
*         USES   X - 1, 6.
*                A - 1, 6.
 
 
 PRT      SUBR               ENTRY/EXIT
          SA1    RTIME
          NZ     X1,PRT2     IF *RT* SPECIFIED
          SA1    PFLA
          SX6    X1-CCAT
          ZR     X6,PRT1     IF *ATTACH* COMMAND
          SX6    X1-CCGT
          NZ     X6,PRTX     IF NOT *GET* COMMAND
 PRT1     SA1    PFLB
          ZR     X1,PRTX     IF ONLY ONE FILE SPECIFIED
 PRT2     SA1    F+1         SET REAL-TIME PROCESSING BIT
          MX6    1
          LX6    43-59
          BX6    X1+X6
          SA6    A1
          EQ     PRTX        RETURN
 PSR      SPACE  4,10
**        PSR - PROCESS SPECIAL REQUEST SUBFUNCTION.
*
*         EXIT   *SREQ* SET TO *CE* OR *CP* IF EITHER IS PRESENT.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6.
*
*         MACROS ABORT, MESSAGE.
 
 
 PSR      SUBR               ENTRY/EXIT
          SA1    CLRE        ENSURE *CE* AND *CP* NOT BOTH SPECIFIED
          ZR     X1,PSR1     IF *CE* PARAMETER NOT PRESENT
          SA2    CPNG        GET *CP* PARAMETER
          BX6    X1
          ZR     X2,PSR2     IF *CP* PARAMETER NOT PRESENT
          MESSAGE (=C* PARAMETERS CE AND CP ARE MUTUALLY EXCLUSIVE.*)
          ABORT
 
 PSR1     SA2    CPNG        PLACE *CP* INTO *SREQ* (MAY BE ZERO)
          BX6    X2
 PSR2     SA6    SREQ        PLACE EITHER *CE* OR *CP* INTO *SREQ*
          EQ     PSRX        RETURN
 PSS      SPACE  4,10
**        PSS - PROCESS SUBSYSTEM SELECTION.
*
*         ENTRY  (SUBSYS) = VALUE FROM *SS* PARAMETER.
*
*         EXIT   (SUBSYS) = SUBSYSTEM VALUE (IF *SS* SPECIFIED).
*                (PSSA) = CURRENT SUBSYSTEM.
*
*         USES   X - 0, 1, 5, 7.
*                A - 1, 5, 7.
*
*         CALLS  CVT.
 
 
 PSS      SUBR               ENTRY/EXIT
          SA5    SUBSYS      GET *SS* PARAMETER VALUE
          GETSS  PSSA        GET CURRENT SUBSYSTEM
          ZR     X5,PSSX     IF *SS* NOT SPECIFIED
          MX0    42
          SA1    PSSA
          BX5    X0*X5
          BX7    X1
          ZR     X5,PSS1     IF *SS* NOT EQUIVALENCED
          SB5    TSSY
          RJ     CVT         CONVERT ARGUMENT
          ZR     X6,PSS1     IF LEGAL VALUE
          MESSAGE  (=C* ERROR IN SUBSYSTEM.*)
          ABORT
 
 PSS1     SX7    X7+40B      SAVE SELECTED SUBSYSTEM
          SA7    SUBSYS
          EQ     PSSX        RETURN
 
 PSSA     CON    0           CURRENT SUBSYSTEM
 
 
****
*         TABLE OF SUBSYSTEMS.
 
 
 TSSY     BSS    0
          VFD    42/0LNULL,18/NULS
          VFD    42/0LNUL,18/NULS
          VFD    42/0LBASIC,18/BASS
          VFD    42/0LBAS,18/BASS
          VFD    42/0LFORTRAN,18/FORS
          VFD    42/0LFOR,18/FORS
          VFD    42/0LFTNTS,18/FTNS
          VFD    42/0LFTN,18/FTNS
          VFD    42/0LEXECUTE,18/EXES
          VFD    42/0LEXE,18/EXES
          VFD    42/0LBATCH,18/BATS
          VFD    42/0LBAT,18/BATS
          CON    0
****
 RNF      SPACE  4,14
**        RNF - RETURN NON-PRIMARY FILES.
*         THIS SUBROUTINE USES THE LFM FUNCTION GETFNT TO RETURN ALL
*         FILES CURRENTLY ASSIGNED TO JOB (EXCEPT THE PRIMARY FILE
*         AND ANY FILE WITH *CBST*, *CKST* OR *NDST* STATUS SET).
*
*         ENTRY  NONE.
*
*         EXIT   NONE.
*
*         USES   X - 0, 1, 2, 3, 4, 7.
*                A - 2, 7.
*                B - 3, 4.
*
*         MACROS GETFNT, RECALL, RETURN.
 
 
 RNF      SUBR               ENTRY/EXIT
          SA2    NODROP
          NZ     X2,RNFX     IF ND PARAMETER SPECIFIED, EXIT
          BX7    X7-X7       CLEAR BUFFER CONTROL WORD
          SA7    GETTAB
          SA2    RNFA        MAKE GETFNT CALL
          BX7    X2
          MX0    42
          RECALL F
          SA7    F+CFPN
 
 RNF1     GETFNT F
          SB3    B0
          SB4    GLEN
          MX3    -6
 
 RNF2     SA2    B3+GETTAB+1
          ZR     X2,RNFX     IF END OF FILES
          BX1    -X3*X2
          SX7    X1-NDST
          ZR     X7,RNF3     IF *NDST* FILE
          SX7    X1-CBST
          SX4    X1-CKST
          ZR     X7,RNF3     IF CHECKPOINT FILE
          ZR     X4,RNF3     IF CHECKPOINT FILE
          BX4    X0*X2
          SX1    B1+         SET COMPLETE BIT
          BX7    X1+X4
          RECALL F
          SA7    F
          RETURN F
 
 RNF3     SB3    B3+2
          NE     B3,B4,RNF2  IF MORE FILES IN GETTAB
          SA2    GETTAB
          NZ     X2,RNF1     IF MORE FILES TO PROCESS
          EQ     RNFX        RETURN
 
*         GETFNT CONTROL WORD.
 
 RNFA     VFD    12/GFILES,24/-PMSK,6/15B,18/GETTAB
          SPACE  4
*         COMMON DECKS.
 
*CALL     COMCARM
*CALL     COMCARG
*CALL     COMCCIO
*CALL     COMCCPA
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCPFM
*CALL     COMCPOP
*CALL     COMCRSP
*CALL     COMCSTF
*CALL     COMCSYS
*CALL     COMCUSB
*CALL     COMCVDT
*CALL     COMCVLC
          SPACE  4,10
*         BUFFER DEFINITIONS.
 
 
          USE    BUFFERS
 
 TSFN     BSSN   NFILES      SYSTEM FILE NAMES
 TPFN     BSSN   NFILES      PERMANENT FILE NAMES
 IBUF     BSSN   BUFL        INPUT BUFFER
 GETTAB   BSSN   GLEN+2      *GETFNT* TABLE
 PBUF     BSSN   PBUFL       *PACKNAM* STRING BUFFER
 RFL=     BSSN   0
          SPACE  4
          END