Retro1.org codex

          IDENT  MFILES,FETS 
          ABS
          SST
          ENTRY  CLEAR
          ENTRY  OUT
          ENTRY  OVWRITE
          ENTRY  RETURN
          ENTRY  REWIND
          ENTRY  SETFS
          ENTRY  UNLOAD
          ENTRY  NPC=
          ENTRY  RFL=
          ENTRY  SSM=
          SYSCOM B1
          TITLE  MFILES - MULTIPLE FILE PROCESSOR.
*COMMENT  MFILES - MULTIPLE FILE PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
*****     MFILES - MULTIPLE FILE PROCESSOR.
*
*         A.    SKJOLDEBRAND.     75/09/07.
*         H. G. VARNIS.           79/01/02.
*
*         *MFILES* REQUESTS THAT CERTAIN OPERATIONS BE PERFORMED ON A
*         SUBSET OF FILES ASSIGNED TO A JOB.
 MFILES   SPACE  4,30
***       *MFILES* REQUESTS THAT CERTAIN OPERATIONS BE PERFORMED ON A
*         SUBSET OF FILES ASSIGNED TO A JOB.  THE SUBSET IS DEFINED BY
*         THE COMMAND AS FOLLOWS:
*
*         FORMAT    FORMAT                   SUBSET
*          CODE
*
*            0  NAME.                   ALL FILES
*            1  NAME(*)                 ALL FILES
*            2  NAME(*,LFN1,...,LFNN)   ALL FILES EXCEPT LFN1,...,LFNN
*            3  NAME(LFN1,...,LFNN)     FILES LFN1,...,LFNN
*
*         LEGAL COMMAND NAMES ARE *CLEAR*, *OUT*, *OVWRITE*,
*         *RETURN*, *REWIND*, *SETFS*, AND *UNLOAD*.  OPERATIONS AND
*         ALLOWED FORMATS ARE GIVEN BY THE FOLLOWING TABLE.
*
*                                                  0   1   2   3
*                                                 --- --- --- ---
*         CLEAR    RELEASE FILE FROM JOB           X   X   X   -
*         OUT      RELEASE FILE TO OUTPUT QUEUE    X   X   X   -
*         OVWRITE  OVERWRITE FILES                 -   X   X   X
*         RETURN   RELEASE FILE FROM JOB           -   X   X   X
*         REWIND   POSITION FILE AT BOI            -   X   X   X
*         SETFS    SET FILE STATUS                 -   X   X   X
*         UNLOAD   RELEASE FILE FROM JOB           -   X   X   X
*
*         WHERE:  X = FORMAT ALLOWED FOR THIS COMMAND.
*                 - = FORMAT NOT ALLOWED FOR THIS COMMAND.
*
*
*         NOTES:
*
*         1.     THE *CLEAR* AND *RETURN* COMMANDS PRODUCE
*                IDENTICAL OPERATIONS ON THE FILES TO WHICH THEY REFER.
*                THEY DIFFER ONLY IN ALLOWED COMMAND FORMATS.
 MFILES   SPACE  4,20
***       THE COMMAND.
*
*
*         CLEAR.             RETURNS ALL FILES EXCEPT FOR FILES WITH
*                            *CBST*, *CKST* OR *NDST* STATUS, AND
*                            THE OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         CLEAR/OP=O.        RETURNS ALL OPTICAL DISK FILES AND THE
*                            OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         CLEAR(*)           RETURNS ALL FILES EXCEPT FOR FILES WITH
*                            *CBST*, *CKST* OR *NDST* STATUS, AND
*                            THE OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         CLEAR(*/OP=O)      RETURNS ALL OPTICAL DISK FILES AND THE
*                            OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         CLEAR(*,LFN1,...,LFNN)       RETURNS ALL FILES EXCEPT FOR
*                            FILES LFN1,...,LFNN, FILES WITH *CBST*,
*                            *CKST* OR *NDST* STATUS, AND THE OPTICAL
*                            DISK CONTROL FILE *ZZZZZOD*.
*
*
*         OUT.               RELEASES TO THE OUTPUT QUEUE ALL
*                            FILES OF TYPE *QFFT* AND ALL FILES
*                            WITH THE SPECIAL NAMES *OUTPUT*,
*                            *PUNCH*, *PUNCHB*, AND *P8*.
*
*         OUT(*)             SAME AS *OUT.*
*
*         OUT(*/OP=X)        SAME AS *OUT.* USING THE OPTION *X*.
*                            THIS FORM IS USED ONLY BY THE SYSTEM
*                            DURING JOB TERMINATION PROCESSING.
*                            THE POSSIBLE VALUES OF THE OPTION
*                            *X* AND THEIR MEANINGS ARE SHOWN
*                            BELOW.
*
*                            E         PERFORM END-OF-JOB ROUTING.
*
*         OUT(*,LFN1,...,LFNN)         SAME AS *OUT* WITH THE
*                            EXCEPTION OF FILES LFN1,...,LFNN.
*
*
*         OVWRITE,*.         OVERWRITE ALL MASS STORAGE FILES EXCEPT
*                            FOR FILES NOT IN WRITE MODE.
*
*         OVWRITE,*/OP=OPTIONS.        OVERWRITE ALL MASS STORAGE FILES
*                            EXCEPT FOR FILES NOT IN WRITE MODE WITH
*                            THE FOLLOWING OPTIONS.
*                            Z - OVERWRITE THE FILE WITH BINARY ZEROES.
*                                BOTH THE Z AND THE X OPTIONS CANNOT
*                                BE SIMULTANEOUSLY SELECTED.  THIS IS
*                                THE DEFAULT VALUE.
*
*                            X - OVERWRITE THE FILE FIRST WITH BINARY
*                                ZEROS, THEN WITH BINARY ONES, THEN
*                                WITH A PATTERN OF ALTERNATING BINARY
*                                ONES AND ZEROS.
*
*                            R - RETURN ALL FILES PROCESSED AFTER
*                                COMPLETION.
*
*         OVWRITE,*,LFN1,...,LFNN/OP=OPTIONS.
*                            OVERWRITE ALL MASS STORAGE FILES EXCEPT
*                            FOR FILES NOT IN WRITE MODE AND FILES
*                            LFN1,...LFNN USING SELECTED OPTIONS.
*
*         OVWRITE,LFN1,...,LFNN/OP=OPTIONS.
*                            OVERWRITE FILES LFN1,...,LFNN USING
*                            SELECTED OPTIONS.  NON-MASS STORAGE FILES
*                            AND FILES NOT IN WRITE MODE WILL BE
*                            IGNORED.
*
*
*         RETURN(*)          RETURNS ALL FILES EXCEPT FOR FILES WITH
*                            *CBST*, *CKST* OR *NDST* STATUS, AND
*                            THE OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         RETURN(*/OP=O)     RETURNS ALL OPTICAL DISK FILES AND THE
*                            OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         RETURN(*,LFN1,...,LFNN)      RETURNS ALL FILES EXCEPT FOR
*                            FILES LFN1,...,LFNN, FILES WITH *CBST*,
*                            *CKST* OR *NDST* STATUS, AND THE OPTICAL
*                            DISK CONTROL FILE *ZZZZZOD*.
*
*         RETURN(LFN1,...LFNN)         RETURNS FILES LFN1,...,LFNN.
*                            WILL *NOT* RETURN THE OPTICAL DISK
*                            CONTROL FILE *ZZZZZOD*.
*
*
*         REWIND(*)          REWINDS ALL FILES.
*
*         REWIND(*,LFN1,...,LFNN)      REWINDS ALL FILES EXCEPT
*                            FOR FILES LFN1,...,LFNN.
*
*         REWIND(LFN1,...,LFNN)        REWINDS FILES LFN1,...LFNN.
*
*
*         SETFS(*/FS=S)      SET FILE STATUS *S* ON ALL FILES.
*
*         SETFS(*,LFN1,...,LFNN/FS=S)  SET FILE STATUS *S* ON ALL FILES
*                            EXCEPT FILES LFN1,...,LFNN.
*
*         SETFS(LFN1,...,LFNN/FS=S)    SET FILE STATUS *S* ON FILES
*                            LFN1,....,LFNN.
*
*
*         UNLOAD(*)          UNLOADS ALL FILES EXCEPT FOR FILES WITH
*                            *CBST*, *CKST* OR *NDST* STATUS, AND
*                            THE OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         UNLOAD(*/OP=O)     UNLOADS ALL OPTICAL DISK FILES AND THE
*                            OPTICAL DISK CONTROL FILE *ZZZZZOD*.
*
*         UNLOAD(*,LFN1,...,LFNN)      UNLOADS ALL FILES EXCEPT FOR
*                            FILES LFN1,...,LFNN, FILES WITH *CBST*,
*                            *CKST* OR *NDST* STATUS, AND THE OPTICAL
*                            DISK CONTROL FILE *ZZZZZOD*.
*
*         UNLOAD(LFN1,...,LFNN)        UNLOADS FILES LFN1,...LFNN.
*                            WILL *NOT* UNLOAD THE OPTICAL DISK
*                            CONTROL FILE *ZZZZZOD*.
          SPACE  4,10
***       DAYFILE MESSAGES.
*
*
*         * ERROR IN ARGUMENTS.* = AN INCORRECT ARGUMENT OR FORMAT
*                WAS USED ON THE COMMAND.  COMPARE THE
*                COMMAND USED WITH THE DOCUMENTED FORMATS.
*
*         * FILE STATUS NOT SPECIFIED.* = A *SETFS* COMMAND WAS
*                ISSUED WITH NO FILE STATUS SPECIFIED.
*
*         * INCORRECT FILE STATUS.* = THE FILE STATUS SPECIFIED
*                ON A *SETFS* COMMAND WAS NOT VALID.
*
*         * INCORRECT */* OPTION.* = AN INCORRECT COMMAND
*                OPTION WAS ENTERED FOLLOWING A */* SEPARATOR.
*
*         * NNN FILE(S) PROCESSED.* = NNN IS THE NUMBER OF FILES FOR
*                WHICH THE FUNCTION WAS REQUESTED.
*
*         * XXXXXXX ROUTED.  JSN IS YYYY.* = XXXXXXX IS THE NAME
*                OF THE FILE BEING ROUTED AND YYYY IS THE JSN WHICH
*                WAS ASSIGNED TO THAT FILES QFT ENTRY.
*
*         * (FILENAME) NOT ON MASS STORAGE.* = THE NAMED FILE WAS NOT
*                PROCESSED BECAUSE IT DOES NOT RESIDE ON MASS STORAGE.
*
*         * (FILENAME) NOT IN WRITE MODE.* = THE NAMED FILE WAS NOT
*                PROCESSED BECAUSE IT IS NOT IN WRITE MODE.
 MFILES   TITLE  CONSTANTS AND MACRO DEFINITIONS.
 MFILES   SPACE  4,10
**        DEFINITION COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSDSP
*CALL     COMSJCE
*CALL     COMSLFD
          SPACE  4,15
**        MACRO DEFINITIONS.
 ACON     SPACE  4,10
**        ACON - SET ARGUMENT CONTROL.
*
*         ACON   P,T
*
*         ENTRY  *P* = ARGUMENT PROCESSOR ADDRESS.
*                *T* = ARGUMENT TABLE (*COMCARG* FORMAT) ADDRESS.
*
*         EXIT   24/0, 18/P, 18/T
 
 
          PURGMAC ACON
 ACON     MACRO  P,T
+         VFD    24/0,18/P,18/T
          ENDM
 SCON     SPACE  4,10
**        SCON - SET COMMAND CONTROL.
*
*         SCON   A,B,C,D,EXP,CF
*
*         ENTRY  *A* = 1 IF FORMAT 0 ALLOWED.
*                *B* = 1 IF FORMAT 1 ALLOWED.
*                *C* = 1 IF FORMAT 2 ALLOWED.
*                *D* = 1 IF FORMAT 3 ALLOWED.
*                *EXP* = ADDRESS OF FILE EXCLUSION PROCESSOR.
*                *CF* = *CIO* FUNCTION CODE.
 
 
          PURGMAC SCON
 
 SCON     MACRO  A,B,C,D,EXP,CF
          VFD    1/A,1/B,1/C,1/D,20/0,18/EXP,18/CF
          ENDM
 MFILES   SPACE  4,10
****      INSTALLATION PARAMETERS.
 
 
 MNF      EQU    200B        FILES PROCESSED PER *GETFNT* CALL
****
          SPACE  4,10
**        ASSEMBLY CONSTANTS.
 
 
 FMT0     EQU    0           FORMAT 0
 FMT1     EQU    1           FORMAT 1
 FMT2     EQU    2           FORMAT 2 (EXCLUSION FORMAT)
 FMT3     EQU    3           FORMAT 3 (INCLUSION FORMAT)
 FNTBL    EQU    2*MNF+2     *GETFNT* BUFFER SIZE
 PSBFL    EQU    1           LENGTH OF PSEUDO BUFFER FOR FETS
 FRDC     EQU    20B         *DSP* FLAG FOR DISPOSITION CODE
 MFILES   TITLE  TABLES AND DATA STORAGE.
**        FETS.
 
 
          ORG    110B
 FETS     BSS    0
 FET1     FILEB  PSBF,PSBFL,(FET=8)
 FET2     FILEB  PSBF,PSBFL,(FET=8)
 FET3     FILEB  PSBF,PSBFL,(FET=8)
 FETX     FILEB  PSBF,PSBFL,(FET=13)  *GETFNT* FET (MUST BE LAST FET)
 
 FETC     EQU    FETX+8      *GETFNT* CONTROL WORD ADDRESS
 FETL     EQU    FET2-FET1   FET LENGTH
 FETW     EQU    FETX-FETS   LENGTH OF FET BLOCK
 FETN     EQU    FETW/FETL+1 NUMBER OF FETS
          SPACE  4,10
**        RESERVED LOCATIONS.
 
 
 CSOC     CON    0           COMMAND OPTION COUNT
 EOJS     CON    0           END-OF-JOB PROCESSING STATUS
 FICT     CON    0           FILE COUNT
 FLST     CON    0           FILE STATUS TO BE SET
 FRMT     CON    0           FORMAT CODE
 OPARG    CON    0           *OP=* ARGUMENT
 OPOF     CON    0           *OP=O* PROCESSED FLAG
 OVWF     CON    0           *OVWRITE* OPTION FLAG
 NOJF     CON    1           *NOJT* TERMINATION FLAG
 ZODF     CON    0           OPTICAL DISK CONTROL FILE FOUND FLAG
          SPACE  4,10
**        PRESERVED REGISTER STORAGE LOCATIONS.
 
 
 SVA3     CON    0           SAVE (A3)
 SVB2     CON    0           SAVE (B2)
 SVB3     CON    0           SAVE (B3)
 SVB4     CON    0           SAVE (B4)
          SPACE  4,10
**        *GETFNT* CONTROL WORD.
 
 
 GFCW     VFD    12/MNF,6/0,18/0,2/0,1/1,3/4,18/FNTB
          SPACE  4,10
**        COMMAND TABLE.
 
 
 TCSC     BSS    0                FWA OF CONTROL WORD TABLE
 CLCC     SCON   1,1,1,0,CPF,70B  CLEAR
 OUCC     SCON   1,1,1,0,COF,0B   OUT
 OVCC     SCON   0,1,1,1,CMS,244B OVWRITE
 OVCR     SCON   0,1,1,1,CMS,254B OVWRITE RETURN
 RTCC     SCON   0,1,1,1,CPF,70B  RETURN
 RWCC     SCON   0,1,1,1,0,50B    REWIND
 SFCC     SCON   0,1,1,1,CIF,0    SETFS
 UNCC     SCON   0,1,1,1,CPF,60B  UNLOAD
 TACW     SPACE  4,10
**        TACW - TABLE OF ARGUMENT CONTROL WORDS.
*
*         THIS TABLE IS ADDRESSED USING THE OFFSET (*TACW*) FROM
*         THE CORRESPONDING ENTRY IN THE COMMAND
*         CONTROL WORD TABLE.
 
 
 TACW     EQU    *-TCSC      TABLE OFFSET FROM *TCSC*
          ACON   CAP,TOARG   CLEAR
          ACON   OAP,TOARG   OUT
          ACON   VAT,TOARG   OVWRITE
          ACON   VAT,TOARG   OVWRITE RETURN
          ACON   CAP,TOARG   RETURN
          ACON   0,0         REWIND
          ACON   SAP,TSARG   SETFS
          ACON   CAP,TOARG   UNLOAD
 TDSP     SPACE  4,10
**        TDSP - *DSP* PARAMETER BLOCK.
 
 
 TDSP     BSSZ   1
          VFD    42/0,18/FRFN  RETURN JSN TO CALLER
          BSSZ   5
 TSFN     SPACE  4,10
**        TSFN - TABLE OF SPECIAL FILE NAMES.
*
*T        42/FILE NAME, 18/ 0
 
 
 TSFN     BSS    0           START OF TABLE
          LOC    0
 OTPT     CON    0LOUTPUT
          CON    0LPUNCH
          CON    0LPUNCHB
          CON    0LP8
          CON    0           END OF TABLE
          LOC    *O
          SPACE  4,10
 MFILES   TITLE  COMMAND ENTRY POINTS.
**        CLEAR.
*
*         RETURN FILES ASSIGNED TO A JOB.
 
 
 CLEAR    SB2    CLCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN ROUTINE
 OUT      SPACE  4,10
**        OUT.
*         OUT(.../OP=X)
*
*         RELEASE FILES ASSIGNED TO A JOB TO THE OUTPUT QUEUE.
*         THE OPTION SPECIFIED BY *X* IS DESCRIBED BELOW.  IT
*         IS VALID ONLY DURING JOB TERMINATION PROCESSING.
*
*                E           PERFORM END-OF-JOB ROUTING.
*
*                Q           QUEUE FILE REGARDLESS OF USER
*                            VALIDATION LIMITS.
 
 
 OUT      SB2    OUCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN LOOP
 OVWRITE  SPACE  4,10
**        OVWRITE.
*
*         OVERWRITE FILES.
 
 
 OVWRITE  SB2    OVCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN ROUTINE
          SPACE  4,10
**        RETURN.
*
*         RETURN FILES ASSIGNED TO A JOB.
 
 
 RETURN   SB2    RTCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN ROUTINE
          SPACE  4,10
**        REWIND.
*
*         REWIND FILES ASSIGNED TO A JOB.
 
 
 REWIND   SB2    RWCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN ROUTINE
 SETFS    SPACE  4,10
**        SETFS.
*
*         SET STATUS ON FILES ASSIGNED TO A JOB.
 
 
 SETFS    SB2    SFCC        SET COMMAND WORD ADDRESS
          EQ     MFP         ENTER MAIN ROUTINE
          SPACE  4,10
**        UNLOAD.
*
*         UNLOAD FILES ASSIGNED TO A JOB.
 
 
 UNLOAD   SB2    UNCC        SET COMMAND WORD ADDRESS
*         EQ     MFP         ENTER MAIN ROUTINE
 MFILES   TITLE  MAIN PROGRAM.
 MFILES   SPACE  4,10
**        RESERVED REGISTER USAGE.
*
*                (A3) = ADDRESS OF FIRST FILE NAME ARGUMENT.
*                (B2) = COMMAND WORD ADDRESS.
 MFP      SPACE  4,15
**        MFP - MULTIPLE FILE PROCESSOR.
*
*         ENTRY  (B2) = COMMAND WORD ADDRESS.
*
*         USES   X - 4, 6, 7.
*                A - 4, 6, 7.
*
*         CALLS  IFC, PAF, PRS.
*
*         MACROS ENDRUN, GETFNT, RECALL.
 
 
 MFP      BSS    0           ENTRY
          RJ     PRS         PRESET
          SA4    GFCW        PUT *GETFNT* CONTROL WORD IN FET
          BX6    X4
          SX7    B0
          SA6    FETC
          SA7    FNTB        SET INITIAL *GETFNT* CALL
 MFP1     GETFNT FETX
          RJ     PAF         PROCESS ALL FILES
          ZR     X1,MFP2     IF ALL FILES RETURNED IN BUFFER
          RECALL FETX
          EQ     MFP1        GET ANOTHER BUFFER OF FNT ENTRIES
 
*         TERMINATE JOB.
 
 MFP2     SA4    FRMT        GET FORMAT CODE
          SX4    X4-FMT3
          ZR     X4,MFP3     IF FORMAT 3
          RJ     IFC         ISSUE FILE COUNT MESSAGE
 MFP3     ENDRUN
          TITLE  SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ISSUE MESSAGE AND ABORT.
*
*         ENTRY  (X2) = MESSAGE ADDRESS.
*
*         MACROS ABORT, MESSAGE.
 
 
 ABT      BSS    0           ENTRY
          MESSAGE  X2,3
          ABORT              ABORT CONTROL POINT
 CFN      SPACE  4,20
**        CFN - CHECK FILE NAME FOR EXCLUSION.
*
*         *CFN* CHECKS AN ARGUMENT LIST FOR THE PRESENCE OF THE FILE
*         NAME GIVEN BY AN FNT ENTRY.  DEPENDING ON THE CONTROL
*         COMMAND, OTHER EXCLUSION TESTS MAY BE MADE.
*
*         ENTRY  (X1) = FNT ENTRY.
*                (X3) = FILE NAME.
*                (A1) = ADDRESS OF FNT ENTRY IN *GETFNT* BUFFER.
*                (A3) = ADDRESS OF FIRST ARGUMENT.
*                (B2) = COMMAND WORD ADDRESS.
*
*         EXIT   (X6) = 0 IF FILE TO BE EXCLUDED.
*                (X6) .NE. 0 IF FILE NOT TO BE EXCLUDED.
*
*         USES   X - 0, 4, 6.
*                A - 4.
*                B - 7.
*
*         CALLS  IRJ.
*
*         NOTE   EXCLUSION PROCESSOR SUBROUTINES MUST NOT DESTROY
*                REGISTERS A3, X3, B2, B3, OR B4.
 
 
 CFN      SUBR               ENTRY/EXIT
          SA4    B2          GET EXCLUSION PROCESSOR ADDRESS
          MX0    -18
          AX4    18
          BX4    -X0*X4
          ZR     X4,CFN1     IF NO EXCLUSION PROCESSOR DEFINED
          SB7    X4+         SET PROCESSOR ADDRESS
          RJ     IRJ         EXECUTE EXCLUSION PROCESSOR
          ZR     X6,CFNX     IF FILE TO BE EXCLUDED
 CFN1     SA4    FRMT        GET FORMAT CODE
          SB7    X4-FMT3
          SA4    A3+         READ FIRST FILE NAME ARGUMENT
 CFN2     ZR     X4,CFN3     IF END OF ARGUMENT LIST
          BX6    X4-X3
          SA4    A4+B1       READ NEXT ARGUMENT
          NZ     X6,CFN2     IF NOT FOUND
 
*         THE FILE NAME WAS FOUND AS ONE OF THE ARGUMENTS SPECIFIED
*         (EITHER FORMAT 2 OR FORMAT 3 WAS USED).  AN ADDITIONAL CHECK
*         IS REQUIRED TO DETERMINE IF THE FILE IS TO BE INCLUDED
*         OR EXCLUDED FROM PROCESSING.  IF THE INCLUSION FORMAT
*         (FORMAT 3) WAS SPECIFIED, THE FILE WILL NOT BE EXCLUDED.
 
          NZ     B7,CFNX     IF NOT FORMAT 3
          SX6    B1+         SET FILE NOT EXCLUDED
          EQ     CFNX        RETURN
 
*         THE FILE NAME DID NOT MATCH ANY OF THE ARGUMENTS SPECIFIED.
*         A CHECK MUST BE MADE TO DETERMINE IF THE FILE SHOULD
*         BE EXCLUDED OR INCLUDED BY THE PROCESSING TYPE SPECIFIED.
*         IF THE INCLUSION FORMAT (FORMAT 3) WAS SPECIFIED, THE
*         FILE WILL BE EXCLUDED.
 
 CFN3     NZ     B7,CFNX     IF NOT FORMAT 3
          SX6    B0+         SET FILE EXCLUDED
          EQ     CFNX        RETURN
 CIF      SPACE  4,10
**        CIF - CHECK FOR INPUT* FILE.
*
*         ENTRY  (X1) = FNT ENTRY.
*
*         EXIT   (X6) = 0 IF FILE IS INPUT*.
*
*         USES   X - 0, 4, 6, 7.
*                A - 4.
 
 
 CIF      SUBR               ENTRY/EXIT
          SA4    =6LINPUT*
          MX0    42
          BX7    X0*X1
          BX6    X4-X7
          EQ     CIFX        RETURN
 CMS      SPACE  4,15
**        CMS - CHECK FOR MASS STORAGE AND READ ONLY FILE.
*
*         ENTRY  (X1) = FNT ENTRY.
*                (A1) = ADDRESS OF FNT ENTRY IN *GETFNT* BUFFER.
*                (X3) = FILE NAME.
*                (A3) = ADDRESS OF FIRST ARGUMENT.
*
*         EXIT   (X6) = 0 IF FILE TO BE EXCLUDED.
*
*         USES   X - 0, 1, 4, 6.
*                A - 4.
*                B - 2, 3, 5.
*
*         CALLS  CIF, RSR, SNM, SVR.
*
*         MACROS MESSAGE.
 
 
 CMS      SUBR               ENTRY/EXIT
          MX0    2
          LX0    14-59
          BX6    X0*X1
          SB5    -CMSA       MESSAGE TEXT
          NZ     X6,CMS1     IF FILE NOT MASS STORAGE
          RJ     CIF
          ZR     X6,CMSX     IF INPUT* FILE
          SA4    A1+B1       CHECK FOR WRITE MODE
          MX0    -4
          SX6    B1+         SET FILE INCLUDED
          LX4    -4
          BX4    -X0*X4
          SB5    X4
          EQ     B5,B1,CMSX  IF FILE IN WRITE MODE
          SB5    -CMSB       MESSAGE TEXT
 
*         SEARCH ARGUMENT LIST FOR MATCHING FILE NAME TO DETERMINE
*         IF WARNING MESSAGE SHOULD BE ISSUED.
 
 CMS1     SA4    A3+         READ FIRST FILE NAME ARGUMENT
 CMS2     ZR     X4,CMS3     IF END OF ARGUMENT LIST
          BX0    X4-X3
          SA4    A4+B1       READ NEXT ARGUMENT
          NZ     X0,CMS2     IF NOT FOUND
          SA4    FRMT        GET FORMAT CODE
          SX4    X4-FMT3
          NZ     X4,CMS3     IF NOT FORMAT 3
 
*         ISSUE WARNING MESSAGE AND EXCLUDE FILE.
 
          RJ     SVR         SAVE REGISTERS
          SB2    1R+         SET SEARCH CHARACTER
          SB3    CMSC        MESSAGE ASSEMBLY BUFFER
          MX0    42
          BX1    X0*X1       FILE NAME
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  CMSC,3,R
          RJ     RSR         RESTORE REGISTERS
 CMS3     SX6    B0+         EXCLUDE FILE
          EQ     CMSX        RETURN
 
 CMSA     DATA   C* +++++++ NOT ON MASS STORAGE.*
 CMSB     DATA   C* +++++++ NOT IN WRITE MODE.*
 CMSC     BSS    4           ASSEMBLY BUFFER
 COC      SPACE  4,10
**        COC - CHECK FOR OPTICAL CONTROL FILE *ZZZZZOD*.
*
*         ENTRY  (X1) = FNT ENTRY.
*
*         EXIT   (X6) = 0 IF FILE IS ZZZZZOD.
*
*         USES   X - 0, 4, 6, 7.
*                A - 4.
 
 
 COC      SUBR               ENTRY/EXIT
          MX0    2
          LX0    14-59
          BX6    X0*X1
          NZ     X6,COCX     IF FILE NOT MASS STORAGE
          SA4    =7LZZZZZOD
          MX0    42
          BX7    X0*X1
          BX6    X4-X7
          EQ     COCX        RETURN
 COF      SPACE  4,20
**        COF - CHECK IF OUTPUT FILE.
*
*         *COF* CHECKS TO SEE IF THE GIVEN FILE SHOULD BE
*         ROUTED TO THE OUTPUT QUEUE.  THE CRITERIA USED
*         FOR SELECTION ARE -
*
*                (1)  FILE TYPE IS *QFFT*.
*                (2)  FILE IS A LOCAL FILE (FILE TYPE *LOFT*) AND
*                     HAS A SPECIAL NAME, *OUTPUT*, *PUNCH*, *P8*,
*                     OR *PUNCHB*.
*
*         ENTRY  (X1) = FNT ENTRY.
*                (X3) = FILE NAME.
*
*         EXIT   (X6) = NONZERO IF FILE TO BE ROUTED TO QUEUE.
*
*         USES   X - 4, 6, 7.
*                A - 4.
*                B - 6.
 
 
 COF      SUBR               ENTRY/EXIT
 
*         CHECK FILE TYPE.
 
          BX4    X1          CHECK FNT PARAMETERS
          MX6    -2
          AX4    13
          BX6    -X6*X4
          NZ     X6,COF3     IF NOT MASS STORAGE FILE
          BX4    X1          CHECK FILE TYPE
          MX6    -6
          AX4    6
          BX7    -X6*X4
          SB6    X7-QFFT
          ZR     B6,COF1.1   IF QUEUED FILE
          SB6    X7-LOFT
          NZ     B6,COF3     IF NOT LOCAL FILE
          SA4    NOJF        CHECK TERMINATION OPTION FLAG
          ZR     X4,COF3     IF NOT ROUTING *SPECIAL NAME* LOCAL FILES
 
*         CHECK FOR SPECIAL FILE NAMES.
 
 COF1     SA4    TSFN+B6     READ TABLE ENTRY
          ZR     X4,COF3     IF END OF TABLE
          BX7    X4-X3       COMPARE FILE NAMES
          SB6    B6+B1       ADVANCE TABLE INDEX
          NZ     X7,COF1     IF NO MATCH
 
*         PROCESS END-OF-JOB FILE ROUTING.
 
 COF1.1   SA4    EOJS        CHECK FOR END-OF-JOB PROCESSING
          ZR     X4,COF2     IF NOT END-OF-JOB
          BX7    -X6*X1      CHECK FILE STATUS
          SX7    X7-SOST
          ZR     X7,COF2     IF *SOST* STATUS
          SA4    NOJF        CHECK TERMINATION OPTION FLAG
          ZR     X4,COF2     IF ROUTING ANY QUEUED FILE
          SA4    TSFN+OTPT   CHECK FILE NAME
          BX7    X3-X4
          NZ     X7,COF2     IF FILE NAME .NE. *OUTPUT*
          BX4    X1          CHECK IF *OUTPUT* IS LOCKED
          LX4    59-12
          PL     X4,COF3     IF *OUTPUT* IS NOT LOCKED
 
*         RETURN STATUS TO ROUTE FILE.
 
 COF2     SX6    B1+
          EQ     COFX        RETURN
 
*         RETURN STATUS TO IGNORE FILE.
 
 COF3     SX6    B0+
          EQ     COFX        RETURN
 
 CPF      SPACE  4,10
**        CPF - CHECK FOR PROTECTED FILE.
*
*         ENTRY  (X1) = FNT ENTRY.
*                (X3) = FILE NAME.
*                (A3) = ADDRESS OF FIRST ARGUMENT.
*
*         EXIT   (X6) = 0 IF PROTECTED FILE TO BE EXCLUDED.
*
*         USES   X - 4, 6, 7.
*                A - 4, 7.
*
*         CALLS  COC, CIF, RSR, SVR.
*
*         MACROS FILINFO.
 
 
 CPF5     SX7    X4+         SET CONTROL FILE FOUND FLAG IF *OP=O*
          SA7    ZODF
 
 CPF      SUBR               ENTRY/EXIT
          RJ     CIF
          ZR     X6,CPFX     IF INPUT* FILE
          RJ     COC         CHECK FOR OPTICAL CONTROL FILE
          SA4    OPOF
          ZR     X6,CPF5     IF OPTICAL CONTROL FILE
          NZ     X4,CPF4     IF *OP=O* SPECIFIED
          MX4    -6          CHECK IF *CBST*, *CKST* OR *NDST* STATUS
          BX4    -X4*X1
          SX6    X4-CBST
          ZR     X6,CPF1     IF CHECKPOINT FILE
          SX6    X4-CKST
          ZR     X6,CPF1     IF CHECKPOINT FILE
          SX6    X4-NDST
          NZ     X6,CPFX     IF NOT NO-AUTO-DROP STATUS
 
*         IT IS A PROTECTED FILE.  SEARCH THE ARGUMENT LIST FOR
*         MATCHING FILE NAME.  IF A MATCH IS FOUND AND INCLUSION
*         PROCESSING (FORMAT 3) HAS BEEN SELECTED, RETURN (X6)
*         NON-ZERO SO THAT THE FILE WILL BE PROCESSED.  OTHERWISE,
*         RETURN (X6) = 0 SO THAT THE FILE WILL BE EXCLUDED.
 
 CPF1     SA4    A3+         READ FIRST FILE NAME ARGUMENT
 CPF2     ZR     X4,CPFX     IF END OF ARGUMENT LIST
          BX7    X4-X3
          SA4    A4+B1       READ NEXT ARGUMENT
          NZ     X7,CPF2     IF NOT FOUND
          SA4    FRMT        GET FORMAT CODE
          SX4    X4-FMT3     CHECK FOR FORMAT 3
 CPF3     NZ     X4,CPFX     IF FILE TO BE EXCLUDED
          SX6    B1+         PROCESS THE FILE
          EQ     CPFX        RETURN
 
*         *OP=O* SPECIFIED - CHECK FOR OPTICAL DISK FILE.
 
 CPF4     SA4    CPFA        SET UP *FILINFO* PARAMETER BLOCK
          MX6    42
          BX7    X6*X1
          BX6    -X6*X4
          BX7    X6+X7
          SA7    A4+
          RJ     SVR         SAVE REGISTERS
          FILINFO  CPFA      GET FILE INFORMATION
          RJ     RSR         RESTORE REGISTERS
          SA4    CPFA+1
          BX6    X6-X6       SET TO EXCLUDE FILE IF NOT OPTICAL DISK
          AX4    48
          SX4    X4-2ROD
          EQ     CPF3        EXCLUDE FILE UNLESS ON OPTICAL DISK
 
 CPFA     VFD    42/0,6/5,12/1  *FILINFO* PARAMETER BLOCK
          BSSZ   5
 GNF      SPACE  4,20
**        GNF - GET NONBUSY FET.
*
*         *GNF* DETERMINES WHETHER ANY FET IN THE SET OF FETS IS
*         CURRENTLY BUSY WITH THE GIVEN FILE AND IF NONE IS, RETURNS
*         THE ADDRESS OF A NONBUSY FET.
*
*         ENTRY  (X3) = FILE NAME TO LOOK FOR.
*
*         EXIT   (X2) = 0 IF A FET IS BUSY WITH THE FILE.
*                (X2) = ADDRESS OF A NONBUSY FET OTHERWISE.
*
*         USES   X - 0, 1, 2.
*                A - 1.
*                B - 5, 7.
*
*         MACROS RECALL.
 
 
 GNF2     SX2    A1+         SAVE ADDRESS OF NONBUSY FET
          NZ     B5,GNFX     IF EXCLUSION FORM
 GNF3     SA1    A1+FETL
          SB7    A1-FETX-1
          NG     B7,GNF1     IF NOT PAST END OF FETS
          NZ     X2,GNFX     IF NONBUSY FET FOUND
          RECALL FETS
 
 GNF      SUBR               ENTRY/EXIT
          SA1    FRMT        GET FORMAT CODE
          SB5    X1-FMT3
          SA1    FETS
          MX0    42
          BX2    X2-X2
 GNF1     LX1    59-0
          NG     X1,GNF2     IF NOT BUSY
          LX1    1           RESTORE X1
          NZ     B5,GNF3     IF EXCLUSION FORM
          BX1    X0*X1
          BX1    X1-X3
          NZ     X1,GNF3     IF NOT A FILE NAME MATCH
          SX2    B0+
          EQ     GNFX        RETURN
 IFC      SPACE  4,15
**        IFC - ISSUE FILE COUNT MESSAGE.
*
*         ENTRY  (FICT) = FILE COUNT.
*
*         EXIT   MESSAGE ISSUED.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
*
*         CALLS  CDD.
*
*         MACROS MESSAGE.
 
 
 IFC      SUBR               ENTRY/EXIT
          SA1    FICT        GET FILE COUNT
          SX2    IFCA        ASSUME NO FILES
          ZR     X1,IFC1     IF NO FILES PROCESSED
          SX6    X1-1        CHECK FILE COUNT
          SX2    IFCB
          ZR     X6,IFC1     IF ONE FILE PROCESSED
          RJ     CDD         CONVERT TO DECIMAL
          SA1    IFCC        MERGE FILE COUNT WITH MESSAGE
          MX2    24
          LX6    36
          BX1    -X2*X1
          BX6    X2*X6
          BX6    X6+X1
          SA6    A1
          SX2    A1          SET MESSAGE ADDRESS
 IFC1     MESSAGE X2,3       ISSUE DAYFILE MESSAGE
          EQ     IFCX        RETURN
 
 IFCA     DATA   C* NO FILES PROCESSED.*
 IFCB     DATA   C* 1 FILE PROCESSED.*
 IFCC     DATA   C* 000 FILES PROCESSED.*
 IRJ      SPACE  4,15
**        IRJ - INDEX RETURN JUMP.
*
*         EXECUTES A RETURN JUMP TO (B7).
*
*         ENTRY  (B7) = BRANCH ADDRESS.
*
*         EXIT   TO (B7)+1.
*                JUMP INSTRUCTION TO RETURN LOCATION IN ((B7)).
*
*         USES   X - 5, 6.
*                A - 5, 6.
 
 
 IRJ      SUBR               ENTRY/EXIT
          SA5    IRJ         READ RETURN INSTRUCTION
          BX6    X5          SET RETURN IN CALLED ROUTINE
          SA6    B7
          JP     B7+1        ENTER CALLED ROUTINE
 PAF      SPACE  4,20
**        PAF - PROCESS ALL FILES.
*
*         *PAF* REQUESTS AN OPERATION FOR EACH FILE IN THE SET OF
*         FNT ENTRIES EXCEPT THOSE THAT ARE EXCLUDED.
*
*         ENTRY  (A3) = ADDRESS OF THE FIRST ARGUMENT.
*                (B2) = COMMAND WORD ADDRESS.
*
*         EXIT   (X1) = 0 IF ALL FILES RETURNED IN THE BUFFER.
*
*         USES   X - 0, 1, 3.
*                A - 1, 3.
*                B - 3, 4.
*
*         CALLS  CFN, POF.
 
 
 PAF3     SA1    ZODF
          ZR     X1,PAFX     IF NOT PROCESSING OPTICAL CONTROL FILE
          SA3    =7LZZZZZOD
          RJ     POF         PROCESS ONE FILE
*         SX1    0           (*POF* EXIT CONDITION)
 
 PAF      SUBR               ENTRY/EXIT
          SB4    FNTBL-1     END OF *GETFNT* BUFFER
          SB3    B1
 PAF1     SA1    B3+FNTB     GET FNT ENTRY
          MX0    42
          BX3    X0*X1
          ZR     X1,PAF3     IF END OF ENTRIES
          RJ     CFN         CHECK FILE NAME FOR EXCLUSION
          ZR     X6,PAF2     IF FILE TO BE EXCLUDED
          RJ     POF         PROCESS ONE FILE
 PAF2     SB3    B3+2
          NE     B3,B4,PAF1  IF MORE FNT ENTRIES
          SX1    B1+
          EQ     PAFX        RETURN
 POF      SPACE  4,20
**        POF - PROCESS ONE FILE.
*
*         *PAF* REQUESTS AN OPERATION FOR ONE FILE.
*
*         ENTRY  (X3) = NAME OF FILE TO BE PROCESSED.
*                (B2) = COMMAND WORD ADDRESS.
*
*         EXIT   SPECIFIED FILE PROCESSED AS REQUESTED.
*                (X1) = 0.
*
*         USES   X - 0, 1, 2, 4, 6, 7.
*                A - 1, 4, 6, 7.
*                B - 2, 3, 5, 6.
*
*         CALLS  CIO=, GNF, RSR, SNM, SVR.
*
*         MACROS MESSAGE, ROUTE, SETFS.
 
 
 POF      SUBR               ENTRY/EXIT
          SB6    B2-OUCC
          ZR     B6,POF3     IF *OUT* COMMAND
          SA4    B2          GET *CIO* CODE
          SX7    X4
          RJ     GNF         GET NONBUSY FET
          ZR     X2,POF5     IF FILE ALREADY DONE
          SX4    B1
          BX6    X3+X4
          SA6    X2+
          SB6    B2-SFCC
          ZR     B6,POF2     IF *SETFS* COMMAND
          SB6    B2-OVCC
          NZ     B6,POF1     IF NOT *OVWRITE* COMMAND
          SA1    OVWF        OPTIONAL PARAMETER INDICATOR
          LX1    18-0
          BX2    X1+X2       COMBINE OPTIONAL PARAMETER WITH FILE NAME
 
*         PROCESS *CIO* FUNCTION.
 
 POF1     RJ     CIO=        MAKE REQUEST
          EQ     POF4        INCREMENT FILE COUNT
 
*         PROCESS  *LFM* REQUEST.
 
 POF2     SA1    FLST        SET FILE STATUS
          SETFS  X2,X1
          EQ     POF4        INCREMENT FILE COUNT
 
*         PROCESS *DSP* FUNCTION.
 
 POF3     BX7    X3          SET FILE NAME
          MX0    42
          BX1    X0*X7
          SA7    TDSP
          RJ     SVR         SAVE REGISTERS
          SB2    1R=         SET SCAN PARAMETER
          SB5    -POFA       SET STENCIL ADDRESS
          SB3    POFB        SET ASSEMBLY BUFFER ADDRESS
          RJ     SNM         SET NAME IN MESSAGE
          ROUTE  TDSP,RECALL
          MX0    24
          SA1    TDSP        GET JSN RETURNED
          BX1    X0*X1
          SB2    1R+         SET SCAN PARAMETER
          SB5    POFB        SET *POFB* AS ASSEMBLY BUFFER
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  POFB,0,RECALL  SEND MESSAGE TO USER DAYFILE
          RJ     RSR         RESTORE REGISTERS
 POF4     SA1    FICT        INCREMENT FILE COUNT
          SX6    X1+B1
          SA6    A1
 POF5     SX1    B0+
          EQ     POFX        RETURN
 
 POFA     DATA   C* ======= ROUTED.  JSN IS ++++. *
 POFB     DATA   C* ======= ROUTED.  JSN IS ++++. *
 RSR      SPACE  4,10
**        RSR - RESTORE RESERVED REGISTERS.
*
*         RESTORES THE CONTENTS OF X3, A3, B2, B3, AND B4.
*
*         ENTRY  (SVA3)   = (A3).
*                ((SVA3)) = (X3).
*                (SVB2)   = (B2).
*                (SVB4)   = (B4).
*                (SVB3)   = (B3).
*
*         USES   X - 3.
*                A - 3.
*                B - 2, 3, 4.
 
 
 RSR      SUBR               ENTRY/EXIT
          SA3    SVB4        RESTORE (B4)
          SB4    X3
          SA3    A3-B1       RESTORE (B3)
          SB3    X3
          SA3    A3-B1       RESTORE (B2)
          SB2    X3
          SA3    A3-B1       READ A3
          SA3    X3+         RESTORE (A3) AND (X3)
          EQ     RSRX        RETURN
 SVR      SPACE  4,15
**        SVR - SAVE RESERVED REGISTERS.
*
*         SAVES RESERVED REGISTERS A3, X3, B2, B3, AND B4.
*         THESE REGISTERS MAY LATER BE RESTORED BY
*         EXECUTING *RSR*.  NOTE THAT X3 IS NOT SAVED
*         DIRECTLY, BUT IS AUTOMATICALLY RELOADED WHEN
*         A3 IS RESTORED.
*
*         EXIT   (SVA3) = (A3).
*                (SVB2) = (B2).
*                (SVB4) = (B4).
*                (SVB3) = (B3).
*
*         USES   X - 6.
*                A - 6.
 
 
 SVR      SUBR               ENTRY/EXIT
          SX6    A3          SAVE (A3)
          SA6    SVA3
          SX6    B2          SAVE (B2)
          SA6    A6+B1
          SX6    B3+         SAVE (B3)
          SA6    A6+B1
          SX6    B4          SAVE (B4)
          SA6    A6+B1
          EQ     SVRX        RETURN
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCSNM
*CALL     COMCSYS
 BUFFERS  SPACE  4,10
**        BUFFER ASSIGNMENTS.
 
 
          USE    BUFFERS
 
 PSBF     EQU    *           PSEUDO BUFFER FOR FETS
 FNTB     EQU    PSBF+PSBFL  BUFFER FOR *GETFNT*
 RFL=     EQU    FNTB+FNTBL
 NPC=     EQU    0           FORCE OPERATING SYSTEM PARAMETER FORMAT
 SSM=     EQU    0           DECLARE *SSM=* ENTRY POINT
 
          ERRNG  JTFL*100B-RFL=  IF OVERFLOW MAXIMUM JOB TERMINATION FL
 MFILES   TITLE  OVERLAID PRESET.
 PRS      SPACE  4,30
**        PRS - PRESET.
*
*         *PRS* DETERMINES THE FORMAT OF THE CALLING CONTROL
*         COMMAND, SETS THE ADDRESS OF THE FIRST ARGUMENT
*         TO PROCESS AND CHECKS FOR THE PRESENCE OF NONZERO
*         SEPARATORS (= OR /).
*
*         ENTRY  (B2) = COMMAND WORD ADDRESS.
*
*         EXIT   (X3) = FIRST ARGUMENT.
*                (A3) = ADDRESS OF FIRST ARGUMENT TO PROCESS.
*                (FRMT) = COMMAND FORMAT CODE.
*                TO *ABT* IF ARGUMENT ERROR.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 3, 4, 6.
*                B - 1, 3, 4, 5, 6.
*
*         CALLS  MOL, POL.
*
*         ERROR  TO *ABT*.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           SET CONSTANT B1=1
          RJ     MOL         MOVE */* OPTION LIST
          SX2    =C* ERROR IN ARGUMENTS.*
          SB4    B0          INITIALIZE FORMAT CODE TO 0
          ERRNZ  FMT0        ADJUST IF VALUE CHANGES
          MX0    42
          SA3    ARGR        GET FIRST ARGUMENT
          SA4    ACTR        GET ARGUMENT COUNT
          SB3    X4+
          ZR     B3,PRS1     IF NO ARGUMENTS - FORMAT 0
          SB4    FMT3
          SA4    PRSA        GET SPECIAL ARGUMENT VALUE (*)
          BX4    X3-X4
          NZ     X4,PRS1     IF ARGUMENT NOT * - FORMAT 3
          SA3    A3+B1
          SB3    B3-B1       ADJUST ARGUMENT COUNT FOR *
          SB4    B1
          ERRNZ  FMT1-1      ADJUST IF VALUE CHANGES
          ZR     B3,PRS1     IF ONLY * - FORMAT 1
          SB4    B4+B1       SET FORMAT CODE TO 2
          ERRNZ  FMT2-FMT1-1 ADJUST IF VALUE CHANGES
 
*         CHECK COMMAND FORMAT VALIDITY.
 
 PRS1     SA1    B2          GET CONTROL WORD
          LX4    X1,B4
          PL     X4,ABT      IF INCORRECT COMMAND FORMAT
 
*         CHECK SEPARATORS OF ARGUMENTS.
 
          SA1    A3          GET FIRST ARGUMENT
          SB5    B0
          SX6    B4+         SAVE FORMAT CODE
          SA6    FRMT
          SB6    B4-FMT3
          NZ     B6,PRS2     IF NOT FORMAT 3
          MX6    6
          BX4    X6*X1
          SX5    1R*
          LX4    6
          BX4    X4-X5
          ZR     X4,ABT      IF FIRST CHARACTER OF FILENAME IS *
 PRS2     EQ     B5,B3,PRS3  IF END OF ARGUMENTS
          BX4    -X0*X1
          ZR     X1,ABT      IF BLANK ARGUMENT
          NZ     X4,ABT      IF SEPARATOR IS = OR /
          SA1    A1+B1
          SB5    B5+B1
          EQ     PRS2        CHECK NEXT ARGUMENT
 
 PRS3     NZ     X1,ABT      IF NOT ZERO LAST WORD
          RJ     POL         PROCESS */* OPTION LIST
          EQ     PRSX        RETURN
 
 PRSA     DATA   0L*         SPECIAL ARGUMENT
 MFILES   TITLE  OVERLAID PRESET SUBROUTINES.
 MOL      SPACE  4,20
**        MOL - MOVE */* OPTION LIST.
*
*         MOVES THE OPTION LIST DELIMITED BY THE */* SEPARATOR
*         TO A SEPARATE OPTION LIST AND CLEARS IT FROM THE
*         ORIGINAL COMMAND PARAMETER LIST.  THE PARAMETER
*         COUNT OF THE REMAINING COMMAND PARAMETER LIST
*         IS ADJUSTED TO REFLECT THE NEW PARAMETER COUNT.
*
*         ENTRY  (B2) = COMMAND WORD ADDRESS.
*
*         EXIT   (CSOC) = COUNT OF */* OPTION LIST PARAMETERS.
*                (TOPS) = */* OPTION LIST.
*                (ACTR) = ADJUSTED PARAMETER COUNT.
*
*         ERROR  TO *ABT* IF NO FILE STATUS SPECIFIED ON *SETFS*.
*
*         USES   X - 0, 1, 2, 6, 7.
*                A - 1, 6, 7.
*                B - 4, 5, 6, 7.
 
 
 MOL      SUBR               ENTRY/EXIT
          SA1    ACTR        GET ARGUMENT COUNT
          SB6    B0          CLEAR INDEX
          MX0    42          SET PARAMETER MASK
          SB7    X1+         (B7) = ARGUMENT COUNT
          ZR     B7,MOLX     IF NO ARGUMENTS, RETURN
 
*         SEARCH FOR */* DELIMITER IN PARAMETER LIST.
 
 MOL1     SA1    ARGR+B6     READ ARGUMENT
          SB6    B6+B1       COUNT ARGUMENT
          BX6    -X0*X1      CHECK SEPARATOR
          SX6    X6-1R/
          ZR     X6,MOL2     IF */*
          NE     B6,B7,MOL1  IF NOT END OF PARAMETER LIST
          SX2    =C* FILE STATUS NOT SPECIFIED.*
          SB5    B2-SFCC
          ZR     B5,ABT      IF *SETFS* COMMAND
          EQ     MOLX        RETURN
 
*         ADJUST PARAMETER COUNT.
 
 MOL2     BX7    X0*X1       CLEAR */* FROM PARAMETER
          SA7    A1
          SA1    ACTR        READ PARAMETER COUNT WORD
          SX6    B6          SET NEW PARAMETER COUNT
          BX1    X0*X1
          NZ     X7,MOL3     IF NOT NOW A NULL LAST PARAMETER
          SX6    X6-1        DECREMENT PARAMETER COUNT
 MOL3     BX6    X1+X6       STORE NEW PARAMETER COUNT
          SA6    A1+
          SX7    B7-B6       SET OPTION LIST ARGUMENT COUNT
          SA7    CSOC
          SX7    B0          CLEAR (X7)
          SB4    B0          CLEAR INDEX
 
*         MOVE OPTIONS TO SEPARATE LIST.
 
 MOL4     SA1    ARGR+B6     READ OPTION FROM PARAMETER LIST
          SB6    B6+B1       COUNT OPTION
          BX6    X1
          SA6    TOPS+B4     STORE OPTION IN OPTION LIST
          SA7    A1          CLEAR OPTION FROM PARAMETER LIST
          SB4    B4+B1
          NE     B6,B7,MOL4  IF NOT END OF LIST
          EQ     MOLX        RETURN
 CAP      SPACE  4,25
**        CAP - *CLEAR* ARGUMENT PROCESSOR.
*
*         PROCESSES THE OPTIONAL ARGUMENTS FOR THE *CLEAR*,
*         *RETURN* AND *UNLOAD* COMMANDS.  *OP=O* ALLOWED
*         ONLY ON FORMAT 0 OR 1 FOR THESE COMMANDS.
*
*         ENTRY  (OPARG) = *OP=* ARGUMENT.
*                (B4) = FORMAT MODE.
*
*         EXIT   (OPOF) = NON-ZERO IF PROCESSING ONLY OPTICAL DISK
*                         FILES AND THE *ZZZZZOD* FILE (*O* OPTION).
*
*         ERROR  TO *ABT* IF INCORRECT ARGUMENT OR FORMAT.
*
*         USES   X - 1, 2, 6.
*                A - 1, 6.
 
 
 CAP      SUBR               ENTRY/EXIT
          SX2    =C+ INCORRECT */* OPTION.+  PRESET ERROR MESSAGE
          SA1    OPARG       READ ARGUMENT
          SX6    1RO         CLEAR, RETURN OR UNLOAD W/OP=O.
          LX1    6
          BX1    X6-X1
          NZ     X1,ABT      IF NOT *O* OPTION
 
*         PROCESS *O* OPTION.
 
          GT     B4,B1,ABT   IF NOT FORMAT 0 OR 1.
          SA6    OPOF
          EQ     CAPX        RETURN
 OAP      SPACE  4,25
**        OAP - *OUT* ARGUMENT PROCESSOR.
*
*         PROCESSES THE OPTIONAL ARGUMENTS FOR THE *OUT*
*         COMMAND.
*
*         ENTRY  (OPARG) = *OP=* ARGUMENT.
*
*         EXIT   (EOJS) = END-OF-JOB STATUS IF PROCESSING
*                         *E* OPTION.
*
*         ERROR  TO *ABT* IF INCORRECT ARGUMENT.
*
*         USES   X - 1, 2, 4, 6.
*                A - 1, 4, 6.
*
*         MACROS GETEOJS.
 
 
 OAP      SUBR               ENTRY/EXIT
          SX2    =C+ INCORRECT */* OPTION.+  PRESET ERROR MESSAGE
          ZR     B4,ABT      IF FORMAT CODE = 0
          SA1    OPARG       READ ARGUMENT
          SX6    1RE
          LX1    6
          BX6    X6-X1
          NZ     X6,ABT      IF NOT *E* OPTION
 
*         CHECK FOR JOB TERMINATION IN PROGRESS.
 
          GETEOJS  OAPA      READ END-OF-JOB STATUS
          SA4    OAPA        READ REPLY WORD
          SX2    =C+ INCORRECT */* OPTION.+
          SX6    X4-100B     CHECK FOR TERMINATION IN PROGRESS
          NG     X6,ABT      IF TERMINATION NOT IN PROGRESS
          MX2    -3          MASK FOR TERMINATION DISPOSITION
          BX2    -X2*X4
          SX6    X2-NOJT
          SA6    NOJF        SET *NOJT* TERMINATION OPTION
 
*         PROCESS *E* OPTION.
 
          SX6    X4+         SET END-OF-JOB PROCESSING STATUS
          SA6    EOJS
          EQ     OAPX        RETURN
 
 OAPA     CON    0           *GETEOJS* REPLY WORD
 SAP      SPACE  4,15
**        SAP - *SETFS* ARGUMENT PROCESSOR.
*
*         PROCESSES THE ARGUMENTS FOR THE *SETFS* COMMAND.
*
*         ENTRY  (FLST) = SPECIFIED FILE STATUS (DISPLAY CODE).
*
*         EXIT   (FLST) = FILE STATUS (BINARY).
*
*         ERROR  TO *ABT* IF INCORRECT ARGUMENT.
*
*         USES   X - 0, 1, 2, 4, 6.
*                A - 1, 4, 6.
 
 
 SAP      SUBR               ENTRY/EXIT
          SA1    FLST
          SX2    =C* INCORRECT FILE STATUS.*
          MX0    42
          SA4    SAPA
 SAP1     BX6    X0*X4       CHECK TABLE FOR MATCH
          BX6    X1-X6
          ZR     X6,SAP2     IF SPECIFIED FILE STATUS FOUND
          SA4    A4+B1
          NZ     X4,SAP1     IF NOT END OF TABLE
          EQ     ABT         PROCESS INCORRECT FILE STATUS
 
 SAP2     SX6    X4          SAVE FILE STATUS VALUE
          SA6    A1
          EQ     SAPX        RETURN
 
 
 SAPA     BSS    0           TABLE OF VALID FILE STATUSES
          VFD    42/0LAD,18/0
          VFD    42/0LNAD,18/NDST
          CON    0
 VAT      SPACE  4,15
**        VAT - *OVWRITE* ARGUMENT PROCESSOR.
*
*         PROCESSES THE OPTIONAL ARGUMENTS FOR THE *OVWRITE* COMMAND.
*
*         ENTRY  (OPARG) = *OP=* ARGUMENT.
*
*         EXIT   (OVWF) = 0, IF *Z* OPTION SELECTED.
*                         3, IF *X* OPTION SELECTED.
*                (B2) = COMMAND WORD ADDRESS.
*
*         ERROR  TO *ABT* IF INCORRECT ARGUMENT.
*
*         USES   X - 0, 2, 4, 6, 7.
*                A - 4, 6.
*                B - 2, 3, 5.
 
 VAT      SUBR               ENTRY/EXIT
          SX2    =C+ INCORRECT */* OPTION.+
          SX6    3           PRESET *X* OPTION
          MX0    -6
          SA4    OPARG       LIST OF OPTIONAL PARAMETERS
          SB3    B1          INITIALIZE OPTION COUNTER
 VAT1     LX4    6           RIGHT JUSTIFY CHARACTER
          BX7    -X0*X4
          ZR     X7,VAT4     IF END OF OPTIONAL PARAMETERS
          SB5    X7-1RZ
          ZR     B5,VAT3     IF *Z* PARAMETER
          SB5    X7-1RX
          ZR     B5,VAT2     IF *X* PARAMETER
          SB5    X7-1RR
          NZ     B5,ABT      IF NOT A LEGAL OPTION
          SB2    OVCR        RESET COMMAND
          EQ     VAT1        CHECK NEXT OPTION
 
 VAT2     SA6    OVWF        SET *X* OPTION FLAG
 VAT3     SB3    B3-1        DECREMENT OPTION COUNT
          EQ     VAT1        PROCESS NEXT OPTION
 
 VAT4     LT     B3,ABT      IF INCORRECT OPTION COMBINATION
          EQ     VATX        RETURN
 POL      SPACE  4,15
**        POL - PROCESS OPTION LIST.
*
*         CRACKS THE COMMAND OPTIONAL ARGUMENTS
*         AND EXECUTES THE ARGUMENT PROCESSOR DEFINED FOR
*         THE COMMAND.
*
*         ERROR  TO *ABT* IF ARGUMENT ERROR.
*
*         USES   X - 1, 2, 4.
*                A - 1, 4.
*                B - 4, 5, 7.
*
*         CALLS  ARG, IRJ, RSR, SVR.
*
*         NOTE   THE ARGUMENT PROCESSOR SUBROUTINES MUST NOT
*                DESTROY (B4), (A3), OR (X3).
 
 
 POL      SUBR               ENTRY/EXIT
          SA4    CSOC        CHECK OPTION LIST PARAMETER COUNT
          ZR     X4,POLX     IF NULL LIST, RETURN
          SA1    B2+TACW     GET ARGUMENT CONTROL WORD
          ZR     X1,POL1     IF NO ARGUMENTS ALLOWED
 
*         PROCESS ARGUMENT LIST.
 
          RJ     SVR         SAVE RESERVED REGISTERS
          SB4    X4          SET ARGUMENT COUNT
          SB5    X1          SET ARGUMENT TABLE ADDRESS
          SA4    TOPS        READ FIRST ARGUMENT
          RJ     ARG         CRACK ARGUMENT LIST
          RJ     RSR         RESTORE RESERVED REGISTERS
          NZ     X1,POL1     IF ERROR IN ARGUMENT LIST
 
*         EXECUTE ARGUMENT PROCESSOR.
 
          SA1    B2+TACW     GET ARGUMENT CONTROL WORD
          AX1    18
          SB7    X1          SET PROCESSOR ADDRESS
          ZR     B7,POLX     IF NO PROCESSOR DEFINED
          RJ     IRJ         EXECUTE PROCESSOR
          EQ     POLX        RETURN
 
*         PROCESS ARGUMENT ERROR.
 
 POL1     SX2    =C+ INCORRECT */* OPTION.+
          EQ     ABT         ABORT
          SPACE  4,10
*         *CLEAR*, *OUT*, *OVWRITE*, *RETURN* AND *UNLOAD*
*         COMMAND ARGUMENT TABLE.
 
 
 TOARG    BSS    0           ARGUMENT TABLE FOR *COMCARG*
 OP       ARG    OPARG,OPARG
          ARG
 TSARG    SPACE  4,10
*         *SETFS* COMMAND ARGUMENT TABLE.
 
 
 TSARG    BSS    0
 FS       ARG    FLST,FLST
          ARG
 MFILES   SPACE  4,10
**        OVERLAID COMMON DECKS.
 
 
*CALL     COMCARG
 MFILES   SPACE  4,10
**        TOPS - TABLE OF COMMAND */* OPTIONS.
 
 
 TOPS     BSS    0           OPTIONS TABLE FWA
 TOPSE    EQU    TOPS+64     END OF TABLE
 
 
          ERRNG  RFL=-TOPSE  PRESET OVERFLOWS BUFFERS.
 
 
          END