Retro1.org codex

          IDENT  DSP,DSP 
          PERIPH
          BASE   MIXED
          SST
 SSJ$     EQU    1           ALLOW *SSJ=* JOBS SYSTEM PRIVILEGES
 QUAL$    EQU    1           FORCE UNQUALIFIED COMMON DECKS
*COMMENT  DSP - DISPOSE FILE TO I/O QUEUE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  DSP - DISPOSE FILE TO I/O QUEUE.
          SPACE  4
***       DSP - DISPOSE FILE TO I/O QUEUE.
*         R. A. JAPS.        76/01/12.
*         M. J. CARIDDI.     81/08/16.
*         P. C. SMITH.       82/04/01.
          SPACE  4
***       *DSP* PLACES A FILE IN THE INPUT OR OUTPUT QUEUE.
*         THE SYSTEM SECTOR IS FORMATTED WITH INFORMATION SUPPLIED
*         BY THE CALLER.
          SPACE  4
***       CALL.
*
*T        18/ *DSP*, 6/ 20B, 18/ 0, 18/ FET.
*
*                FET = FWA OF PARAMETER BLOCK.
*
*
*         PARAMETER BLOCK FORMAT.
*
*T FET0   42/ LFN,6/ ERR,1/F,4/ ,6/ OT,1/C
*T,FET1   6/ TF, 6/ 0, 12/ F1, 12/ DIS, 3/ EC, 1/S, 2/ IC, 18/ FLAGS
*T,FET2   18/ SLID, 18/ DLID, 24/ TID
*T,FET3   42/ UJN, 6/ RESERVE, 12/ PRIORITY
*T,FET3   60/ ENTRY TIME (*QMOVE* ONLY)
*T,FET4   2/ 0,4/ PI,6/ SC,12/ SVC,12/ FA,6/ RESERVE,6/ RC,12/ FNT
*T,FET5   24/ BC, 36/ COUNT
*T,FET6   42/ EQID, 18/ JSN
*
*         EXTENDED PARAMETER BLOCK FORMAT.
*
*T,FET7   12/ DD,24/ RA,6/0,18/ EFLAGS
*T,FET10  42/ OUN, 18/ IRTADDR
*T,FET11  42/ OFN, 18/ ERTADDR
*T,FET12  42/ CUN, 6/CP, 12/SSID
*T,FET13  42/ CFN, 18/ RESERVED
*T,FET14  42/ ENCRYPTED PASSWORD, 18/ RESERVED
*T,FET15  60/ RESERVED
*T,FET16  60/ RESERVED FOR INSTALLATIONS
*T,FET17  60/ CHARGE NUMBER
*T,FET20  60/ PROJECT NUMBER (FIRST 10 CHARACTERS)
*T,FET21  60/ PROJECT NUMBER (LAST 10 CHARACTERS)
*
*
*         LFN =  LOCAL FILE NAME.
*
*         ERR =  ERROR CODE RETURNED. (SEE DESCRIPTION OF DAYFILE
*                MESSAGES FOR ERROR CODES.)
*
*         F    = FORCED ORIGIN FLAG (*SYOT* ONLY).
*
*         OT   = FORCED ORIGIN CODE (*SYOT* ONLY).
*
*         C   =  COMPLETION BIT. MUST BE 0 ON CALL. SET TO 1 ON
*                COMPLETION.
*
*         TF = TERMINATION FLAGS.
*                IF AT JOB TERMINATION, FLAGS MEAN THE FOLLOWING -
*
*                BIT 59      DISABLE DEFERRED BATCH VALIDATION.
*                BIT 57      EOI RANDOM ADDRESS SET IN FET+7.
*
*         F1 =   FORMS CODE OR INPUT FLAGS.
*                IF THE FILE IS TO BE QUEUED TO THE INPUT QUEUE,
*                THE FIELD IS DEFINED AS FOLLOWS-
*
*                BIT 47-45   UNUSED
*                BIT 44      SEND FILE TO INPUT QUEUE IF FORCED ABORT
*                BIT 43      SEND FILE TO INPUT QUEUE IF JOB
*                            COMMAND ERROR OR USER COMMAND ERROR
*                            (SUBSYSTEM CALLER ONLY).
*                BIT 42      BINARY CARD SEQUENCE ERROR OR INCORRECT
*                            HOLLERITH CODE DETECTED IN CARD DECK.
*                BIT 41-36   UNUSED
*
*         DIS =  DISPOSITION CODE IN DISPLAY CODE. (REFER TO *COMSJIO*
*                TO DETERMINE VALID DISPOSITION CODES.)
*
*                PR          ANY PRINTER
*                P1          ANY 501 PRINTER
*                P2          ANY 512 PRINTER
*                LR          ANY 580-12 PRINTER
*                LS          ANY 580-16 PRINTER
*                LT          ANY 580-20 PRINTER
*                LX          ANY 5870 NIP
*                LY          ANY 5970 NIP
*                PU          PUNCH CODED
*                PH          PUNCH CODED
*                SB          PUNCH SYSTEM BINARY
*                PB          PUNCH SYSTEM BINARY (SAME AS SB)
*                P8          PUNCH TO 80 COLUMN BINARY
*                FR          MICROFILM PRINTER (NOT SUPPORTED)
*                FL          MICROFILM PLOTTER (NOT SUPPORTED)
*                HR          HARD COPY PRINTER (NOT SUPPORTED)
*                HL          HARD COPY PLOTTER (NOT SUPPORTED)
*                PL          PLOTTER
*                IN          ROUTE TO INPUT
*                NO          ROUTE TO INPUT WITH NO OUTPUT OPTION SET
*                SC          CHANGE TO LOCAL FILE (*LOFT*)
*                TO          ROUTE TO INPUT WITH *TT* OPTION SET
*                TT          ROUTE TO TERMINAL OUTPUT QUEUE
*                SO          ROUTE TO INPUT WITH *SS* OPTION SET
*                SS          ROUTE TO STATION OUTPUT QUEUE
*                WT          ROUTE TO WAIT QUEUE
*
*         EC   = EXTERNAL CHARACTERISTICS.
*                THE EC FIELD IS INTERPRETED IN ONE OF THREE WAYS
*                ACCORDING TO QUEUE TYPE.
*
*                PRINT (*PRQT*) FILES.
*
*                MNEMONIC    VALUE  DESCRIPTION
*                  ---         0      ANY PRINT TRAIN
*                  ---         1      RESERVED
*                  A4          2      ASCII 48 CHARACTER PRINT TRAIN
*                  B4          3      BCD 48 CHARACTER PRINT TRAIN
*                  B6          4      BCD 63/4 CHARACTER PRINT TRAIN
*                  A6          5      ASCII 64 CHARACTER PRINT TRAIN
*                  A9          6      ASCII 96 CHARACTER PRINT TRAIN
*                  ---         7      RESERVED FOR INSTALLATIONS
*
*
*                PUNCH (*PHQT*) FILES.
*                MNEMONIC    VALUE  DESCRIPTION
*                  PU OR ---   0      PUNCH CODED(O26/O29)
*                  SB          1      PUNCH SYSTEM BINARY
*                  80COL       2      PUNCH 80-COLUMN BINARY
*                  ---         3      RESERVED
*                  O26         4      PUNCH O26 MODE
*                  O29         5      PUNCH O29 MODE
*                  ASCII       6      PUNCH ASCII
*                  ---         7      RESERVED FOR INSTALLATIONS
*
*
*                PLOT (*PLQT*) FILES.
*                MNEMONIC    VALUE  DESCRIPTION
*                  ---         0      RESERVED
*                  T6          1      TRANSPARENT 6-BIT DATA
*                  T8          2      TRANSPARENT 8-BIT DATA
*                  ---         3      UNUSED
*                  ---         4      UNUSED
*                  ---         5      UNUSED
*                  ---         6      UNUSED
*                  ---         7      RESERVED
*
*
*         S =    FORCED SERVICE CLASS FLAG.
*
*         IC =   INTERNAL CHARACTERISTICS.
*
*                MNEMONIC    VALUE  DESCRIPTION
*                  DIS         0      FILE IS IN DISPLAY CODE
*                  ASCII       1      FILE IS IN ASCII
*                  BIN         2      FILE IS IN BINARY
*                  ---         3      RESERVED
*
*         FLAGS  FLAGS INDICATING WHICH PARAMETERS ARE SPECIFIED.
*
*               BIT         DESCRIPTION
*                17          RETURN JOBNAME IN LFN
*                16          ACCOUNTING
*                15          SPACING CODE FLAG
*                14          REPEAT COUNT
*                13          USER JOB NAME (UJN)
*                12          NO DAYFILE MESSAGES, RETURN ERROR
*                            IN ERR FIELD.
*                11          SUBSYSTEM INITIATION
*                10          FORMS CODE
*                9           PRIORITY
*                8           INTERNAL CHARACTERISTICS
*                7           EXTERNAL CHARACTERISTICS
*                6           EXTENDED PARAMETER BLOCK
*                5           RESERVED FOR INSTALLATIONS
*                4           DISPOSITION CODE
*                3           DLID/SLID
*                2           TID
*                1           ROUTE TO CENTRAL SITE
*                0           FORCED JSN FLAG (INPUT FILES ONLY)
*                0           DEFERRED ROUTE (OUTPUT FILES ONLY)
*
*                IF THE CENTRAL SITE BIT IS SET, THE FILE IS ROUTED
*                WITH BATCH ORIGIN TYPE.  IF IT IS CLEAR, AND THE TID
*                BIT IS SET, THE ORIGIN TYPE IS DETERMINED FROM THE
*                GIVEN TID.  IF BOTH BITS ARE CLEAR, THE ORIGIN TYPE IS
*                THAT OF THE JOB (EXCEPT, IT IS THAT OF THE PREVIOUS
*                ROUTING IF THE FILE HAD BEEN DEFERRED ROUTED).
*
*         SLID = SOURCE LID.  A 3-CHARACTER ALPHANUMERIC IDENTIFIER
*                FOR THE MAINFRAME WHICH IS TO BE CONSIDERED THE SOURCE
*                MAINFRAME FOR THIS FILE.  THE FOLLOWING SPECIAL OCTAL
*                VALUES MAY ALSO BE PLACED IN THIS FIELD.
*                000000 = GET SLID FROM JOB INPUT FILE SYSTEM SECTOR.
*                000001 = SET SLID TO ZERO.
*                000002 = SET SLID TO PHYSICAL ID OF THIS MAINFRAME.
*
*         DLID = DESTINATION LID.  A 3-CHARACTER ALPHANUMERIC ID
*                FOR THE MAINFRAME WHICH IS THE DESTINATION FOR THIS
*                FILE.  THE FOLLOWING SPECIAL OCTAL VALUES MAY ALSO
*                BE PLACED IN THIS FIELD.
*                000000 = SET DLID TO ZERO.
*                000001 = SET DLID TO ZERO.
*                000002 = SET DLID TO PHYSICAL ID OF THIS MAINFRAME.
*
*                NOTE - IF THE *SLID/DLID* FLAG BIT IS NOT SET IN THE
*                PARAMETER BLOCK, DLID IS SET FROM THE JOB INPUT FILE
*                SYSTEM SECTOR.  FOR A ROUTE TO INPUT, THE JOB INPUT
*                FILE DLID VALUE IS USED.  FOR A ROUTE TO OUTPUT, THE
*                JOB INPUT FILE SLID VALUE IS USED.
*
*         TID  = TERMINAL ID.
*                IF THE UPPER SIX BITS ARE EQUAL TO 77B, THE
*                LOWER EIGHTEEN BITS CONTAIN THE COMPLEMENT OF
*                THE CM ADDRESS OF A TWO WORD FAMILY NAME - USER
*                NUMBER AREA.
*                     TAG+0  42/ FAMILY NAME , 18/ 0
*                     TAG+1  42/ USER NAME , 18/ 0
*                IF THE CM ADDRESS IS ZERO, THE FILE WILL BE ROUTED TO
*                THE REMOTE BATCH QUEUE WITH THE DEFAULT DESTINATION
*                PARAMETERS OF THE JOB.
*                IF THE UPPER SIX BITS ARE NOT EQUAL TO 77B, THE
*                LOWER EIGHTEEN BITS CONTAINS A TID.
*                IF THE CENTRAL SITE AND TID BITS ARE SET, THE TID MUST
*                BE A BATCH ID CODE TO AVOID AN ERROR CONDITION.
*
*         UJN =  USER JOB NAME.  (0 TO 7 ALPHANUMERIC CHARACTERS)
*
*         PRIORITY = PRIORITY FOR FILE.
*                NOTE - IF BOTH THE PRIORITY FLAG (BIT 9 OF THE
*                FLAGS FIELD) AND THE REQUEUE FLAG (BIT 8 OF THE
*                EXTENDED FLAGS FIELD) ARE SET, THEN WORD 3 OF
*                THE PARAMETER BLOCK CONTAINS THE ENTRY TIME TO
*                SET IN THE FILE-S QFT ENTRY.  THIS FIELD IS SET
*                TO -1 BY *QMOVE* WHEN ACTIVATING AN INACTIVE FILE
*                SO THAT A NEW ENTRY TIME WILL BE SET.
*
*         PI =   PRINT IMAGE CODE FOR PRINT FILES.  WHEN THE UPPER BIT
*                IS SET, THE LOWER 3 BITS CONTAIN THE PRINT IMAGE CODE.
*                MEANINGFUL ONLY FOR 512 OR 580 PRINTERS.
*
*         SC   = SPACING CODE FOR PRINT FILES (580-PFC).  THIS IS A
*                NUMERIC VALUE FROM 0 - 77B.
*
*         SVC =  FORCED SERVICE CLASS IN DISPLAY CODE.
*                *DF* MAY ALSO BE SELECTED FOR THE SERVICE CLASS.
*                *DF* WILL SELECT THE USER DEFAULT SERVICE CLASS FOR
*                THE ORIGIN TYPE OF THE FILE.
*
*         FA =   FORCED ABORT CODE (IF INPUT FILE)
*                ABORT CODES ARE AS DEFINED IN *COMSDSP*.
*
*         FNT =  NFL OFFSET OF FNT ENTRY.
*
*         RC  =  REPEAT COUNT.
*
*         BC =   BINARY CARD SEQUENCE ERROR DATA.
*
*         COUNT = NUMBER OF CARDS READ.
*
*         EQID = LEFT JUSTIFIED, ZERO FILLED, DISPLAY CODE EQUIPMENT
*                IDENTIFICATION FOR CARD READER.
*                FOR *RBF*, EQID IS A TERMINAL NAME.
*                FOR *BATCHIO*, EQID IS THE MACHINE ID AND
*                EST ORDINAL OF THE CARD READER.
*
*         JSN =  JOB SEQUENCE NAME.  (ALPHANUMERIC CHARACTERS ONLY.)
*                JSN OF SUBSYSTEM IF *FRSI* FLAG SET, OR JSN TO SET
*                IF *FRFJ* FLAG SET.
*
*         RA  =  EOI RANDOM ADDRESS OF FILE.
*
*         DD =   DATA DECLARATION (DISPLAY CODE).  DEFINES THE
*                DATATYPE OF THE FILE, WHEN THE FILE IS DESTINED FOR
*                A REMOTE MAINFRAME.
*
*                C6 = 6-BIT CHARACTER DATA.
*                C8 = 8-BIT CHARACTER DATA.
*                US = UNDEFINED DATATYPE/STRUCTURED FILE.
*                UU = UNDEFINED DATATYPE/UNSTRUCTURED FILE.
*
*         EFLAGS = FLAGS INDICATING WHICH PARAMETERS ARE SPECIFIED
*                IN THE EXTENDED PARAMETER BLOCK.
*
*               BIT         DESCRIPTION
*                17          RESERVED
*                16          RESERVED
*                15          RESERVED
*                14          RESERVED
*                13          RESERVED
*                12          RESERVED
*                11          RESERVED
*                10          CHARGE/PROJECT (*SSJ=*)
*                9           DO NOT VALIDATE SERVICE CLASS (*SSJ=*)
*                8           SPECIAL REQUEUE OPERATION (*SSJ=*)
*                7           USE ENCRYPTED PASSWORD (*SSJ=*)
*                6           USE ORIGIN DEFAULT SERVICE CLASS (*SSJ=*)
*                5           CONTROL POINT AND SSID SPECIFIED
*                4           DO NOT VALIDATE PASSWORD (*SSJ=* ONLY)
*                3           SUBSYSTEM PROCESSING (*SSJ=* ONLY)
*                2           CREATOR USER/FAMILY NAMES (*SSJ=* ONLY)
*                1           OWNER USER/FAMILY NAMES (*SSJ=* ONLY)
*                0           DATA DECLARATION
*
*         IF THE *SUBSYSTEM PROCESSING* BIT IS SET, THE CALLER IS
*         TREATED AS IF IT WERE A SUBSYSTEM.  IN PARTICULAR, THE
*         FOLLOWING IS TRUE -
*           - ERROR PROCESSING MAY BE DONE ON USER COMMAND ERRORS,
*             AND ON OTHER ERRORS WHICH DO NOT NORMALLY ALLOW
*             ERROR PROCESSING.
*           - THE OWNER USER/FAMILY (AND OTHER SYSTEM SECTOR FIELDS)
*             WILL BE SET FROM THE USER COMMAND, INSTEAD OF BEING
*             PROPAGATED FROM THE CALLER-S INPUT FILE SYSTEM SECTOR.
*           - THE USER INDEX MAY BE SPECIFIED IN THE TID BLOCK
*             ALONG WITH THE USER NAME.
*           - BINARY CARD SEQUENCE ERROR DATA MAY BE SPECIFIED.
*
*         IF THE *SPECIAL REQUEUE* FLAG IS SET, MOST FIELDS SPECIFIED
*         IN THE PARAMETER BLOCK AND THE EXTENDED PARAMETER BLOCK WILL
*         BE IGNORED.  THIS OPTION IS USED TO REQUEUE AN ATTACHED QUEUE
*         FILE WITHOUT CHANGING EXISTING SYSTEM SECTOR AND QFT VALUES.
*         THE ONLY PARAMETERS THAT WILL NOT BE IGNORED ON A *SPECIAL
*         REQUEUE* ARE THE PRIORITY AND THE REPEAT COUNT.
*
*         THE *DO NOT VALIDATE SERVICE CLASS* FLAG IS USED ONLY IF THE
*         FORCED SERVICE CLASS FLAG IN FET+1 IS SET.  THE BIT USED TO
*         SELECT THE ORIGIN DEFAULT SERVICE CLASS WILL OVERRIDE THE
*         SELECTION OF THE FLAG TO NOT VALIDATE THE SERVICE CLASS.
*
*         OUN =  OWNER USER NAME (*SSJ=* ONLY).
*
*         IRTADDR = IMPLICIT REMOTE TEXT ADDRESS (*SSJ=* ONLY).
*                ADDRESS OF BLOCK CONTAINING IMPLICIT REMOTE TEXT.
*                THE FIRST WORD OF THE BLOCK CONTAINS THE LENGTH OF
*                THE TEXT (IN CHARACTERS).  THE REST OF THE BLOCK
*                CONSISTS OF 1 - 32B WORDS OF DISPLAY-CODE TEXT.
*
*         OFN =  OWNER FAMILY NAME (*SSJ=* ONLY).
*
*         ERTADDR = EXPLICIT REMOTE TEXT ADDRESS.
*                ADDRESS OF BLOCK CONTAINING EXPLICIT REMOTE TEXT.
*                THE FIRST WORD OF THE BLOCK CONTAINS THE LENGTH OF
*                THE TEXT (IN CHARACTERS).  THE REST OF THE BLOCK
*                CONSISTS OF 1 - 32B WORDS OF DISPLAY-CODE TEXT.
*
*         CUN =  CREATOR USER NAME (*SSJ=* ONLY).
*
*         CP =   CONTROL POINT SELECTION (SUBSYSTEM INITIATION).
*
*         SSID = SUBSYSTEM ID (SUBSYSTEM INITIATION).
*
*         CFN =  CREATOR FAMILY NAME (*SSJ=* ONLY).
*
*         ENCRYPTED PASSWORD FOR INPUT FILES (*SSJ=* ONLY).
          SPACE  4,20
***       ACCOUNT DAYFILE MESSAGES.
*
*
*         *ABLQ, C1, JSN, YYMMDD, HHMMSS, DC.*
*         *ABLQ, C2, XXXXXX.XXXKUNS.*
*                QUEUED FILE WITH JOB SEQUENCE NAME JSN AND
*                DISPOSITION CODE DC HAS BEEN ROUTED TO THE
*                QUEUE ON DATE YYMMDD AT TIME HHMMSS.
*                THE FILE HAS A DISPOSITION CODE OF DC AND IS
*                XXXXXX.XXX THOUSAND PRU-S IN LENGTH.
*
*         *ARRQ, C1, JSN, YYMMDD, HHMMSS, DC.*
*         *ARRQ, C2, XXXXXX.XXXKUNS.*
*                QUEUED FILE CREATED ON DATE YYMMDD AT TIME
*                HHMMSS WITH ORIGINAL JOB SEQUENCE NAME JSN
*                HAS BEEN REENTERED INTO THE ACTIVE QUEUE.
*                THE FILE HAS A DISPOSITION CODE OF DC AND IS
*                XXXXXX.XXX THOUSAND PRUS IN LENGTH.
*
*         *SIUN, USERNAME.*
*                THE INPUT FILE BEING ROUTED HAS AN INVALID USERNAME.
          SPACE  4
***       DAYFILE MESSAGES.
*
*         THE FOLLOWING ERROR DESCRIPTION WILL CAUSE *DSP* TO ABORT
*         UNCONDITIONALLY (UNLESS THE CALLER IS A SUBSYSTEM OR
*         HAS THE SUBSYSTEM PROCESSING BIT SET).
*
*         * DSP - INCORRECT REQUEST.*
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. DSP NOT CALLED WITH RECALL. (DOES NOT APPLY WHEN
*                   CALLED BY A SUBSYSTEM.)
*                2. PARAMETER LIST ADDRESS OUT OF RANGE.
*                3. AN INCORRECT TEXT LENGTH WAS SPECIFIED IN AN
*                   IMPLICIT OR EXPLICIT REMOTE TEXT BLOCK.
*                4. A NON-*SSJ=* PROGRAM HAS SPECIFIED ONE OF THE
*                   FOLLOWING - CUN, CFN, IRTADDR.
*                5. A NON-*SSJ=* AND NON-*SYOT* PROGRAM HAS SPECIFIED
*                   ONE OF THE FOLLOWING DISPOSITION CODES - SO, SS.
*                6. A JOB WITHOUT SYSTEM ORIGIN PRIVILEGES ATTEMPTED
*                   TO INITIATE A SUBSYSTEM.
*                7. THE SPECIFIED SUBSYSTEM DID NOT EXIST.
*                8. THE SPECIFIED SUBSYSTEM WAS ALREADY ACTIVE.
*                9. THE SPECIFIED SUBSYSTEM NAME AND SUBSYSTEM ID
*                   DID NOT MATCH.
*               10. A ZERO SUBSYSTEM ID WAS SPECIFIED ON A SUBSYSTEM
*                   INITIATION.
*               11. A SUBSYSTEM ID AND/OR A CONTROL POINT WAS SPECIFIED
*                   WITHOUT SPECIFYING SUBSYSTEM INITIATION.
*               12. THE FORCED JSN SPECIFIED CONTAINED AT LEAST ONE
*                   NON-ALPHANUMERIC CHARACTER.
*
*         * DSP - USER ACCESS NOT VALID.*
*                THE CALLER WAS NOT VALIDATED TO SPECIFY ONE OF THE
*                FOLLOWING  - DLID, SLID, DD.
*
*         * DSP - COMPLETE BIT ALREADY SET.*
*                THE COMPLETE BIT HAS NOT BEEN CLEARED BEFORE
*                DSP WAS CALLED.
*
*         * DSP - I/O SEQUENCE ERROR.*
*                A REQUEST WAS MADE ON A BUSY FILE.
*
*
*         THE FOLLOWING ERROR CONDITIONS WILL CAUSE *DSP* TO ABORT
*         IF CALLED BY A NON-SUBSYSTEM JOB.
*
*         * DSP - INCORRECT USER COMMAND.*  (ERR=34)
*                USER ATTEMPTED TO ROUTE AN INPUT FILE WITH AN
*                IMPROPER USER COMMAND.
*
*         * DSP - USER SECURITY COUNT EXHAUSTED.* (ERR=47).
*                THE USER ATTEMPTED TO ROUTE AN INPUT FILE
*                TO A USER NAME WHICH HAS EXHAUSTED IT-S
*                SECURITY COUNT.
*
*
*         THE FOLLOWING MESSAGES WILL BE ISSUED IF BIT 12 OF WORD
*         ONE IS NOT SET.
*
*         * ERROR IN ROUTE FUNCTION, LFN = FILENAM.*
*                INFORMATIVE MESSAGE TO SYSTEM DAYFILE STATING AN
*                ERROR OCCURED WHILE ROUTING *FILENAM*.
*
*         * DSP - FILE NAME ERROR.*  (ERR=1).
*                AN ATTEMPT WAS MADE TO CREATE A FILE WITH AN INCORRECT
*                FILE NAME.
*
*         * DSP - FILE NOT ON MASS STORAGE.*  (ERR=2).
*                AN ATTEMPT WAS MADE TO ROUTE A FILE NOT ON
*                MASS STORAGE.
*
*         * DSP - INCORRECT FILE TYPE.*  (ERR=3).
*                THE FILE BEING PROCESSED IS NOT A QFFT,
*                OR LOFT FILE TYPE.
*
*         * DSP - IMMEDIATE ROUTING - NO FILE.*  (ERR=6).
*                THE SPECIFIED FILE FOR THE IMMEDIATE ROUTE COULD
*                NOT BE FOUND.
*
*         * DSP - INCORRECT DISPOSITION CODE.*  (ERR=7).
*                SPECIFIED DISPOSITION CODE IS NOT RECOGNIZED.
*
*         * DSP - UNDEFINED SERVICE CLASS.*  (ERR=11).
*                THE SPECIFIED SERVICE CLASS IS NOT DEFINED.
*
*         * DSP - DEFERRED ROUTING NOT ALLOWED.* (ERR=13).
*                A FILE CANNOT BE DEFERRED ROUTED IF ANY ONE OF THE
*                FOLLOWING IS SPECIFIED - DD, IRTADDR, ERTADDR.
*
*         * DSP - INCORRECT DATA DECLARATION.* (ERR=14).
*                THE SPECIFIED DATA DECLARATION IS NOT RECOGNIZED.
*
*         * DSP - INCORRECT LID.* (ERR=15).
*                THE SPECIFIED SLID OR DLID IS EITHER AN INCORRECT
*                NAME, OR WAS NOT FOUND IN THE LID TABLE.
*
*         * DSP - CANNOT ROUTE JOB INPUT FILE.*  (ERR=16).
*                THE JOB INPUT FILE CAN NOT BE ROUTED.
*
*         * DSP - FILE ON REMOVABLE DEVICE.*  (ERR=20).
*                A FILE ON A REMOVABLE DEVICE CAN NOT BE ROUTED.
*
*         * DSP - INCORRECT TID.*  (ERR=21).
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. USER NAME, FAMILY NAME PARAMETERS NOT IN
*                CM FIELD LENGTH.
*                2. TID IS GREATER THAN OR EQUAL TO *IDLM* FOR
*                BATCH JOBS.
*
*         * DSP - FORMS CODE NOT ALPHANUMERIC.*  (ERR=22).
*                FORMS CODE MUST CONSIST OF TWO ALPHANUMERIC
*                CHARACTERS.
*
*         * DSP - INCORRECT INTERNAL CHARACTERISTICS.*  (ERR=23).
*                THE SPECIFIED INTERNAL CHARACTERISTICS WERE NOT VALID.
*
*         * DSP - QUEUED FILE READ ERROR.* (ERR=24).
*                A READ ERROR WAS ENCOUNTERED ON THE SYSTEM SECTOR
*                OF A PREVIOUSLY ROUTED FILE.
*
*         * DSP - QFT FULL.*  (ERR=25).
*                THERE IS NO ROOM IN THE QFT FOR CURRENT USE.
*
*         * DSP - THIS ROUTING NOT ALLOWED.*  (ERR = 26).
*                AN ATTEMPT TO CHANGE THE QUEUE TYPE OF A DEFERRED
*                ROUTED FILE WAS MADE.  (TO CHANGE THE QUEUE TYPE OF A
*                DEFERRED ROUTED FILE, THE FILE MUST FIRST BE CHANGED
*                TO A LOCAL FILE.)
*
*         * DSP - DEVICE FULL.*  (ERR=27).
*                THERE IS NO ROOM ON THE DEVICE FOR CURRENT USE.
*
*         * DSP - MASS STORAGE ERROR.*  (ERR=30).
*                A MASS STORAGE ERROR WAS ENCOUNTERED ON THE FILE.
*
*         * JOB COMMAND ERROR. (TWENTY CHARACTERS).*  (ERR=32).
*                A FILE BEING ROUTED TO THE INPUT FILE HAS AN
*                ERROR IN ITS JOB COMMAND. THE FIRST TWENTY CHARACTERS
*                ARE DISPLAYED IN THE MESSAGE.
*
*         * DSP - TOO MANY DEFERRED BATCH JOBS.*  (ERR=33).
*                USER HAS MORE JOBS IN THE SYSTEM THAN ALLOWED.
*                THIS CHECK IS IGNORED FOR USERS WITH SYSTEM ORIGIN
*                PRIVILEGES.
*
*         * DSP - DEVICE INACCESSIBLE.*  (ERR=35).
*                DSP WAS PREVENTED FROM SUCCESSFUL COMPLETION BECAUSE
*                OF AN INACCESSIBLE DEVICE CONDITION.
*
*         * DSP - INCORRECT FILE MODE.*  (ERR=36).
*                USER ATTEMPTED TO ROUTE A FILE WHICH WAS IN
*                EXECUTE ONLY MODE.
*
*         * DSP - INCORRECT EXTERNAL CHARACTERISTICS.* (ERR=37).
*                USER SPECIFIED AN EXTERNAL CHARACTERISITIC VALUE THAT
*                WAS NOT LEGAL FOR THE DISPOSITION CODE SPECIFIED.
*                THE USER SHOULD RETRY USING A DIFFERENT VALUE.
*
*         * DSP - INCORRECT ORIGIN TYPE.* (ERR=40).
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS.
*                1. THE ORIGIN TYPE WAS SPECIFIED BY A NON-SYSTEM
*                   ORIGIN JOB.
*                2. INTERACTIVE ORIGIN (IAOT) WAS SPECIFIED FOR AN
*                   INPUT FILE.
*                3. A FORCED JSN WAS SPECIFIED BY A NON-SYSTEM ORIGIN
*                   JOB.
*
*         * DSP - INCORRECT SPACING CODE.*  (ERR=41).
*                SPACING CODE VALUE IS GREATER THAN 77B.
*
*         * DSP - INCORRECT JOB ABORT CODE.* (ERR=42).
*                JOB ABORT CODE IS NOT IN RANGE.
*
*         * DSP - INCORRECT SERVICE CLASS.*  (ERR=45).
*                THE USER IS NOT VALIDATED TO SELECT THE SPECIFIED
*                SERVICE CLASS.
*
*         * DSP - ALTERNATE FAMILY NOT ALLOWED.*  (ERR=46).
*                THE USER IS NOT VALIDATED TO ROUTE A JOB
*                TO A DIFFERENT FAMILY.
*
*         * DSP - USER SECURITY COUNT EXHAUSTED.*  (ERR=47).
*                THE SECURITY COUNT FOR THE USER NAME SPECIFIED HAS
*                BEEN DECREMENTED TO ZERO.
*
*         * DSP - JSN ALREADY IN SYSTEM.*  (ERR=50).
*                THE FORCED JSN SPECIFIED IS ALREADY IN USE BY ANOTHER
*                JOB IN THE SYSTEM OR IS THE SAME AS A SUBSYSTEM NAME.
*
*         * DSP - ALTERNATE USER NOT ALLOWED.*  (ERR=51).
*                THE USER IS NOT VALIDATED TO ROUTE A JOB TO
*                ANOTHER USER NAME.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         THE FOLLOWING OPERATOR MESSAGES WILL BE DISPLAYED AT
*         THE USERS CONTROL POINT UPON OCCURANCE OF THE SPECIFIED
*         EVENT.
*
*         * QFT FULL.*
*                INDICATES THAT THE SYSTEM HAS NO AVAILABLE QFTS
*                AT THIS TIME.  *DSP* WILL WAIT FOR AN AVAILABLE
*                QFT UNLESS DROPPED BY THE OPERATOR.
*
*         * TRACK LIMIT.*
*                INDICATES THAT THE SYSTEM HAS RUN OUT OF TRACK
*                SPACE.  *DSP* WILL WAIT FOR AVAILABLE TRACK
*                SPACE UNLESS DROPPED BY THE OPERATOR.
          SPACE  4,10
***       ZERO LEVEL OVERLAYS CALLED.
*
*
*         0AV - VERIFY USER NAME.
*         0BF - BEGIN FILE.
*         0DF - DROP FILE.
*         0DQ - DROP QUEUE FILE.
*         0QM - ISSUE QUEUE FILE ACCOUNTING MESSAGE.
*         0VJ - VERIFY JOB/USER STATMENTS.
          EJECT
*         COMMON DECKS.
 
 
*CALL     COMPMAC
*CALL     COMSACC
*CALL     COMSCPS
          LIST   X
*CALL     COMSDSP
          LIST   -X
*CALL     COMSEJT
*CALL     COMSEVT
*CALL     COMSJCE
*CALL     COMSJIO
*CALL     COMSLFD
*CALL     COMSMSP
*CALL     COMSPFM
*CALL     COMSPIM
*CALL     COMSSSD
          LIST   X
*CALL     COMSSSE
          LIST   -X
*CALL     COMSSSJ
          LIST   X
*CALL     COMSWEI
          LIST   -X
*CALL     COMSZOL
          TITLE  MACRO DEFINITIONS.
**        DRIN - DEFAULT ROUTING INFORMATION.
*
*         DRIN   DC,EX,IC,QT
*
*         ENTRY  *DC* = DISPOSITION CODE MNENONIC
*                *EX* = EXTERNAL CHARACTERISTICS CODE.
*                *IC* = INTERNAL CHARACTERISTICS CODE.
*                *QT* = QUEUE TYPE.
 
 
          PURGMAC  DRIN
 
 DRIN     MACRO  DC,EX,IC,QT
          MACREF DRIN
 .A       IF     DEF,DC_$
          VFD    12/0L_DC,6/QT,3/EX,3/IC
 .A       ENDIF
 DRIN     ENDM
 ERROR    SPACE  4
**        ERROR - SET ERROR CODE.
*
*         ERROR  ER
*
*         ENTRY  *ER* = ERROR CODE.
 
 
          PURGMAC  ERROR
 
 ERROR    MACRO  E
          MACREF ERROR
          LDN    E
          RJM    ERR
          ENDM
 OVERLAY  SPACE  4
**        OVERLAY - GENERATE OVERLAY CONSTANTS.
*
*
*         OVERLAY  (TEXT),OVL
*
*         ENTRY  *TEXT* = TEXT OF SUBTITLE.
*         *OVL* = ORIGIN OF OVERLAY
 
 
 .N       SET    0
 OVLB     MICRO  1,, 3D      BASE OVERLAY NAME
 
 
          PURGMAC OVERLAY
 
 OVERLAY  MACRO  TEXT,OVL
          MACREF OVERLAY
          QUAL
 .N       SET    .N+1
 .M       MICRO  .N,1, ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
 .O       MICRO  1,3, "OVLB"".M"
          QUAL   ".O"
          TTL    DSP/".O" - TEXT
          TITLE
          IDENT  ".O",OVL    TEXT
*COMMENT  DSP - TEXT
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          ORG    OVL
          LJM    *
          UJN    *-2
          ENDM
 SCLASS   SPACE  4,15
**        SCLASS - DEFINE SERVICE CLASS TABLE.
*
*         SCLASS NM,MN,DF,ST,TX
*
*         ENTRY  *NM* = SERVICE CLASS NAME.
*                *MN* = TWO CHARACTER MNEMONIC.
*                *DF* = DAYFILE MESSAGE CHARACTER.
*                *ST* = SHORT TEXT FOR *QFTLIST*.
*                *TX* = TEXT OF SERVICE CLASS NAME FOR BANNER PAGE.
*
*         NOTE - THE CALL TO *COMSSCD* MUST FOLLOW THE DEFINITION OF
*                THIS MACRO.
 
 
          PURGMAC SCLASS
 
 SCLASS   MACRO  NM,MN,DF,ST,TX
 .A       IFC    NE,$NM$SSSC$
 .SCL     RMT
          INDEX  NM,1R_DF    TX
 .SCL     RMT
 .SCLVSP  RMT
          INDEX  NM,MN_MK    TX
 .SCLVSP  RMT
 .A       ENDIF
 SCLASS   ENDM
 
 
 SCL$     EQU    0           ONLY PROCESS CLASSES WITH JCB-S
*CALL     COMSSCD
 SUBSYST  SPACE  4,10
**        SUBSYST - GENERATE SUBSYSTEM TABLE.
*
*         SUBSYST  NAME,ID,PR,PP,AUTO,DEF,DCP,CP,PROC,ABT
*
*         ENTRY  *NAME*= 3 CHARACTER SUBSYSTEM NAME.
*                *ID* = SUBSYSTEM ID.
*                *PP* = PP NAME FOR PP-INITIATED SUBSYSTEM.
*
*         GENERATE TABLE OF SUBSYSTEM NAMES AND ID-S FOR
*         NON-PP-INITIATED SUBSYSTEMS.
*
*T        24/  4LNAME, 12/  SSID
 
 
          PURGMAC  SUBSYST
 
 SUBSYST  MACRO  NM,ID,PT,PP,AU,DF,DC,CP,PR,AB
 .A       IFC    EQ,$PP$$
 .SUB     RMT
 .NM      EQU    *
          VFD    24/4L_NM_ ,12/ID
 TSUBE    EQU    *-.NM
 .SUB     RMT
 .A       ENDIF
 .SSN     RMT
 .NM_$    EQU    *
          VFD    24/4L_NM
 TSSNE    EQU    *-.NM_$
 .SSN     RMT
 SUBSYST  ENDM
 
 
 SUB$     EQU    1           ASSEMBLE *SUBSYST* MACRO
*CALL     COMSSSD
          TITLE  DIRECT LOCATION ASSIGNMENTS
**        DIRECT LOCATION ASSIGNMENTS.
 
 
 T8       EQU    16          TEMPORARY STORAGE
 FS       EQU    20 - 24     FST ENTRY (5 LOCATIONS)
 QA       EQU    26          ORDINAL OF QFT ENTRY (*0DQ*)
 ST       EQU    27          STATUS FLAGS
 CN       EQU    30 - 34     ASSEMBLE BUFFER (5 LOCATIONS)
 RI       EQU    35 - 36     RANDOM INDEX
 JF       EQU    35          JOB FIELD LENGTH (USED BY 0VJ)
 UN       EQU    40 - 44     USER NAME (5 LOCATIONS)
 OT       EQU    46          ORIGIN TYPE
 ER       EQU    47          ERROR STATUS
 FA       EQU    57          FST ADDRESS
 FN       EQU    60 - 64     FNT ENTRY (5 LOCATIONS)
 FB       EQU    65 - 66     FLAG BITS FROM REQUEST BLOCK (2 LOCATIONS)
 QT       EQU    67          QUEUE TYPE
          SPACE  4,20
**        STATUS WORD (ST) BIT DEFINITIONS.
*
*         BIT    SETTING     EXPLAINATION
*
*         0      1           NOT A SUBSYSTEM (SSFL)
*         1      1           FILE PREVIOUSLY ROUTED (DSFL)
*         2      1           ISSUE *UADM* FUNCTION (IUFL)
*         3      1           FILE CREATION NEEDED (FCFL)
*         4      1           SCHEDULER NEEDED (SCFL)
*         5      1           CONTROL POINT IS *SYOT* (SYFL)
*         6      1           DISPOSITION CODE SPECIFIED (DCFL)
*         7      1           CALLING PROGRAM IS *SSJ=* (SJFL)
*         10     1           DESTINATION LID SPECIFIED (DLFL)
*         11     1           SOURCE LID SPECIFIED (SLFL)
*         12     1           FILE LOCKED (LKFL)
*         13     1           FILE IS BEING REQUEUED (RQFL)
 
 
 SSFL     EQU    1           SUBSYSTEM FLAG
 DSFL     EQU    2           PREVIOUSLY ROUTED FLAG
 IUFL     EQU    4           ISSUE *UADM* FLAG
 FCFL     EQU    10B         FILE CREATION FLAG
 SCFL     EQU    20B         SCHEDULER NEEDED FLAG
 SYFL     EQU    40B         *SYOT* CONTROL POINT FLAG
 DCFL     EQU    100B        DISPOSITION CODE SPECIFIED FLAG
 SJFL     EQU    200B        *SSJ=* PROGRAM FLAG
 DLFL     EQU    400B        DESTINATION LID FLAG
 SLFL     EQU    1000B       SOURCE LID FLAG
 LKFL     EQU    2000B       FILE LOCKED FLAG
 RQFL     EQU    4000B       FILE BEING REQUEUED FLAG
          SPACE  4,10
**        SYMBOL DEFINITIONS.
 
 
 LHLAT    EQU    7000B       LOCAL HOST LID ATTRIBUTES (H, E, V)
          SPACE  4,10
          TITLE  MAIN PROGRAM.
**        DSP - MAIN PROGRAM.
 
          ORG    PPFW
 
 
 DSP      RJM    PRS         PRESET ROUTINE
          RJM    FFQ         FIND FILE TO QUEUE
          RJM    DDC         DETERMINE DISPOSITION CODE
          NJN    DSP1        IF NOT CHANGE TO LOCAL FILE
          EXECUTE  3DD       LOAD *CHANGE TO LOCAL FILE* OVERLAY
          RJM    CLF         CHANGE TO LOCAL FILE
          LJM    DSP8        RETURN INFORMATION TO PARAMETER BLOCK
 
 DSP1     RJM    VUL         VALIDATE USER LIMITS
          RJM    SQS         SET QUEUED FILE SYSTEM SECTOR
 DSPG     PSN
*         UJN    DSP4        (SPECIAL REQUEUE OPERATION)
 
*         PROCESS FILE DESTINATION.
 
          RJM    SDC         SET DISPOSITION CODE
          EXECUTE  3DA       LOAD FILE DESTINATION ROUTINES
          RJM    SFD         SET FILE DESTINATION
          LDD    FB+1
          SHN    21-13
          PJN    DSP2        IF NOT SUBSYSTEM INITIATION
          RJM    PSI         PROCESS SUBSYSTEM INITIATION
 DSP2     LDD    QT
          LMK    INQT
          NJN    DSP3        IF NOT ROUTE TO INPUT
          RJM    VIF         VERIFY INPUT FILE
          UJN    DSP4        UPDATE SYSTEM SECTOR AND EOI
 
 DSP3     EXECUTE  3DB       LOAD FILE ATTRIBUTE ROUTINES
          RJM    SOD         SET OUTPUT DATA
 
*         UPDATE SYSTEM SECTOR AND EOI.
 
 DSP4     EXECUTE  3DC       LOAD SYSTEM SECTOR/EOI UPDATE ROUTINES
 DSPH     PSN
*         UJN    DSP5        (SPECIAL REQUEUE OPERATION)
          RJM    BSE         CHECK FOR BINARY CARD SEQUENCE ERRORS
          RJM    PUF         PROCESS USER/FAMILY NAMES
          RJM    SCP         SET CHARGE/PROJECT DATA
          RJM    SLI         SET LOGICAL IDENTIFIERS
          RJM    PUP         PROCESS UJN PRESENCE
          LDD    MA          SET FN IN SYSTEM SECTOR
          CWD    FN
          CRM    FNSS,ON
 DSP5     LDD    FB+1        CHECK FOR DEFERRED ROUTE
          SHN    21-0
          PJN    DSP5.1      IF IMMEDIATE ROUTE
 
*         PROCESS DEFERRED ROUTE.
 
          AOD    FS+4        SET FILE NOT BUSY
          AOM    WQSA        DO NOT PRESERVE FILE
          RJM    AEO         ATTACH QFT TO EJT
 DSP5.1   LDN    IUFL        SET FLAG TO ISSUE *UADM* FUNCTION
          RAD    ST
 
*         WRITE QUEUED FILE SYSTEM SECTOR.
 
          RJM    WQS         WRITE QUEUED FILE SYSTEM SECTOR
 
*         SAVE SYSTEM SECTOR FIELDS.
 
          LDN    QFTE*5-1    SAVE QFT ENTRY
          STD    T1
 DSP6.1   LDM    IOSS,T1
          STM    QBUF,T1
          SOD    T1
          PJN    DSP6.1      IF MORE TO MOVE
          LDM    IOSS+5*JSNQ+0  SAVE JSN
          STM    DSPD
          LDM    IOSS+5*JSNQ+1
          STM    DSPE
          LDD    FB+1
          SHN    21-0
          MJN    DSP7        IF DEFERRED ROUTE
 DSPI     PSN
*         UJN    DSP6.2      (SPECIAL REQUEUE OPERATION)
 
*         WRITE QUEUED FILE EOI SECTOR (IMMEDIATE ROUTE ONLY).
 
          RJM    IES         INITIALIZE EOI SECTOR
          RJM    PRT         PROCESS REMOTE TEXT
          RJM    WES         WRITE EOI SECTOR
 
*         ISSUE ACCOUNTING MESSAGE FOR IMMEDIATE ROUTE.
 
 DSP6.2   RJM    IAM         ISSUE ACCOUNTING MESSAGE
 
*         UPDATE AND RELEASE QFT.
 
 DSP7     RJM    CLE         COMPLETE LOCAL ENTRY
          LDN    0
*         LDN    1           (IF ABORTED INPUT FILE)
 DSPF     EQU    *-1
          ZJN    DSP7.1      IF NOT ABORTED INPUT FILE
          STM    QBUF+ENTQ*5+4   SET ABORTED FLAG IN QFT
          LDN    0
          STM    QBUF+ENTQ*5+3
 DSP7.1   LDN    QFTE-1
          STD    T5
          SFA    QFT,QA      GET ADDRESS OF QFT ENTRY
          ADN    1           WRITE QFT DATA
          CWM    QBUF+5,T5
          SBN    QFTE        WRITE INTERLOCK WORD
          CWM    QBUF,ON
 
*         REQUEST SCHEDULER IF THIS IS FOR AN INPUT FILE.
 
          LDD    ST          CHECK IF SCHEDULER NEEDED
          LPN    SCFL
          ZJN    DSP8        IF SCHEDULER NOT NEEDED
          LDN    ZERL        CLEAR PARAMETERS FOR CALL
          CRD    CM
          AOD    CM+2        SET SCHEDULER FLAG
          MONITOR  RSJM      REQUEST SCHEDULER
 
*         RETURN REQUIRED INFORMATION TO PARAMETER BLOCK.
 
 DSP8     LDD    FB
          SHN    21-5
          PJN    DSPX        IF FILE NAME NOT TO BE RETURNED
          LDN    ZERL        RETURN INFORMATION TO CALLER
          CRD    FN
          LDC    **          (SET BY PRESET)
 DSPC     EQU    *-1
          STD    FN+4
          LDC    *           (FIRST PART OF JSN)
 DSPD     EQU    *-1
          STD    FN
          LDC    *           (SECOND HALF OF JSN)
 DSPE     EQU    *-1
          STD    FN+1
          UJN    DSP9        RETURN JSN TO CALLER
 
*         RETURN HERE FROM ERROR PROCESSOR.
 
 DSPX     RJM    GFA         READ FIRST WORD OF PARAMETER BLOCK
          CRD    FN
 DSP9     LDD    FN+3        SET ERROR FLAG
          SCN    77
          LMC    **
 DSPB     EQU    *-1         (ERROR CODE SET BY *ERP*)
          STD    FN+3
          LDD    FN+4        SET FUNCTION COMPLETE
          SCN    1
          LMN    1
          STD    FN+4
          RJM    GFA         REWRITE FIRST WORD OF PARAMETER BLOCK
          CWD    FN
          LJM    DPP         DROP PP
          SPACE  4,10
**        MEMORY LOCATIONS.
 
 CUAV     CON    0           *COMPCUA* USER ACCESS PRIVILEGES
 DDEC     CON    0           DATA DECLARATION
 DLAT     CON    LHLAT       ATTRIBUTES OF DLID
 DLID     CON    0,0         DESTINATION LOGICAL ID
 EBIT     CON    0,0         EXTENDED PARAMETER BLOCK FLAG BITS
 EJTO     CON    0           EJT ORDINAL
 ERTL     CON    0           EXPLICIT REMOTE TEXT LENGTH
 FJSN     BSS    2           FORCED JSN OR SUBSYSTEM NAME
 FSJS     CON    0           FORCED JSN FLAG
 FSOT     CON    4000        FORCED ORIGIN TYPE
 FSSC     CON    0           FORCED SERVICE CLASS
 INFL     CON    0           INPUT FLAGS
 IRTL     CON    0           IMPLICIT REMOTE TEXT LENGTH
 JBOT     CON    0           JOB ORIGIN TYPE
 LFAL     CON    0           LOCAL FILE ACCESS LEVEL
 LFST     CON    0           LOCAL FILE STATUS
 SBCP     CON    0           CP NUMBER FOR SUSBYSTEM INITIATION
 SBID     CON    0           SUBSYSTEM ID
 SLAT     CON    LHLAT       ATTRIBUTES OF SLID
 SLID     CON    0,0         SOURCE LOGICAL ID
          SPACE  4,10
*         BUFFER DEFINITIONS AND LOAD ADDRESSES.
 
 
 .OVL0    MAX    ZBFL,ZDQL   LENGTH OF *OVL0* BUFFER
 
 OVL0     EQU    EPFW-.OVL0  LOAD ADDRESS FOR *0BF* AND *0DQ*
 OVL1     EQU    BFMS-ZAVL   LOAD ADDRESS FOR *0AV*
 OVL2     EQU    EPFW-ZDFL   LOAD ADDRESS FOR *0DF*
 OVL3     EQU    BFMS-ZVJL   LOAD ADDRESS FOR *0VJ*
 OVL6     EQU    BFMS-ZDQL   LOAD ADDRESS FOR *0DQ*
 OVL7     EQU    BFMS-QFTE*5-ZQML  LOAD ADDRESS FOR *0QM*
 
 QBUF     EQU    BFMS-QFTE*5 QFT ENTRY BUFFER
 EBUF     EQU    QBUF-502    EOI SECTOR BUFFER
 
 SBUF     EQU    OVL3-5-502  SECTOR BUFFER FOR INPUT FILE
 STMT     EQU    SBUF+2      JOB/USER COMMAND
          TITLE  RESIDENT ROUTINES.
 DPP      SPACE  4,10
**        DPP - DROP PP.
 
 
 DPP      BSS    0           ENTRY
 DPPA     LDN    0
*         LDN    1           (SET FILE NOT BUSY)
          ZJN    DPP1        IF *FNB* CALL NOT NEEDED
          RJM    FNB         SET FILE NONBUSY
 DPP1     LDD    ST          CHECK IF *UADM* TO BE ISSUED
          LPN    IUFL
          NJN    DPP2        IF UADM REQUEST PRESENT
          MONITOR DPPM       DROP PPU
          UJN    DPP3        ENTER PP RESIDENT
 
 DPP2     LDN    1           SET WORD COUNT OF OPTIONS
          STD    CM+1
          LDN    0           SPECIFY DROP OF PPU
          STD    CM+2
          LDD    MA          UPDATE PRU LIMIT
          CWM    DPPB,CM+1
          MONITOR UADM
 DPP3     LJM    PPR         ENTER PP RESIDENT
 
 
 DPPB     CON    CICS
*         CON    CDCS        (DEFERRED ROUTE)
          CON    ACLW
          CON    0D*100+18D
 DPPC     CON    0
          CON    0
 EER      SPACE  4,15
**        EER - EVALUATE MASS STORAGE ERROR RETURN.
*
*         ENTRY  (T5) = EST ORDINAL.
*                (ST) = STATUS FLAGS.
*
*         EXIT   JOB IS ROLLED OUT TO WAIT FOR A DEVICE TO BECOME
*                ACCESSIBLE IF A NON-SUBSYSTEM JOB ENCOUNTERED A
*                RECOVERABLE READ/WRITE ERROR ON THE DEVICE.
*
*         USES   FA, IR+4.
*
*         CALLS  FNB, *1RJ*.
*
*         MACROS ERROR, EXECUTE, PAUSE.
 
 
 EER      BSS    0           ENTRY
          LDC    0           CHECK FILE STATUS
 EERA     EQU    *-1
          ZJN    EER1        IF NO HIDDEN FNT ENTRY
          STD    FA
 EER1     LDM    RDCT        CHECK ERROR STATUS
          SHN    21-12
          MJN    EER2        IF UNRECOVERABLE ERROR
          LDD    ST
          LPN    SSFL
          NJN    EER3        IF NOT SUBSYSTEM
 EER2     ERROR  /ERR/EC30   * MASS STORAGE ERROR.*
 
 EER3     LDD    T5
          STD    IR+4        SET EST ORDINAL
          RJM    FNB         CLEAN UP WORKING FILES
          PAUSE
          LDD    CM+1
          NJP    DSPX        IF ERROR FLAG SET
          EXECUTE  1RJ       ROLLOUT JOB
 ERR      SPACE  4,10
**        ERR - ERROR PROCESSOR.
*
*         ENTRY  (A) = ERROR CODE.
*                (FA) = NFL FNT ENTRY OFFSET.
*
*         EXIT   TO *DSPX* AFTER PROCESSING ERROR.
*                TO *PPR* IF JOB IS TO BE ABORTED.
*
*         USES   ER.
 
 
 ERR      SUBR               ENTRY
          STD    ER          SAVE ERROR CODE
          EXECUTE  3DE       LOAD ERROR PROCESSING OVERLAY
          RJM    ERP
*         LJM    DSPX        COMPLETE PROCESSING
*         LJM    PPR         COMPLETE PROCESSING
 FNB      SPACE  4,10
**        FNB - SET FILE NOT BUSY.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (FA) = NFL FNT ENTRY OFFSET.
*                (QA) = ORDINAL OF QFT TABLE ENTRY.
*                (FNBA) .NE. 0 IF QFT ENTRY CREATION MODE.
*
*         EXIT   FILE SET NOT BUSY OR RETURNED IF CREATED BY *DSP*.
*                QFT ENTRY CLEARED IF CREATION MODE.
*                (FA) = 0.
*                (QA) = 0.
*
*         USES   FA, QA, FS - FS+4.
*
*         CALLS  FQI, *0DF*, *0DQ*.
*
*         MACROS EXECUTE, NFA.
*
*         NOTE   (QA) .NE. 0, ONLY IF THE QFT ENTRY IS INTERLOCKED.
 
 
 FNB      SUBR               ENTRY/EXIT
 
*         PROCESS QFT ENTRY.
 
          LDD    QA
          ZJN    FNB3        IF NO GLOBAL ENTRY
          LDN    0
*         LDN    1           (CREATION MODE)
 FNBA     EQU    *-1
          ZJN    FNB1        IF NOT CREATION MODE QFT ENTRY
*         LDN    1           DROP QFT ENTRY ONLY
          STM    OVL0-1
          EXECUTE  0DQ,OVL0  DROP QFT ENTRY
          UJN    FNB2        CONTINUE
 
 FNB1     LDN    40          CLEAR QFT INTERLOCK
          RJM    FQI         FUNCTION INTERLOCK
 FNB2     LDN    0           CLEAR GLOBAL ENTRY
          STD    QA
 
*         PROCESS LOCAL FNT ENTRY.
 
 FNB3     LDD    FA
          ZJN    FNBX        IF NO FILE
          LDN    0
*         LDN    1           (IF FILE CREATED BY *DSP*)
 FNBB     EQU    *-1
          ZJN    FNB4        IF FILE NOT CREATED BY *DSP*
          LDN    0           RETURN FILE
          STM    OVL2-1
          EXECUTE  0DF,OVL2  DROP FILE
          UJN    FNB5        CONTINUE
 
 FNB4     NFA    FA,R        SET FILE NOT BUSY
          ADN    FSTL
          CRD    FS
          LDD    FS+4        SET FILE NOT BUSY
          SCN    1
          LMN    1
          STD    FS+4
          NFA    FA,R
          ADN    FSTL
          CWD    FS
          LDN    0           CLEAR FNT POINTER
          STD    FA
 FNB5     LJM    FNBX        RETURN
 FQI      SPACE  4,10
**        FQI - FUNCTION QFT INTERLOCK.
*
*         ENTRY  (A) = 0, SET QFT INTERLOCK.
*                (A) = 40, CLEAR QFT INTERLOCK.
*                (QA) = QFT ORDINAL.
*
*         EXIT   QFT INTERLOCK CLEARED.
*                (A) = 0, IF OPERATION COMPLETE.
*
*         USES   CM - CM+4.
*
*         MACROS DELAY, MONITOR, PAUSE, SFA.
*
*         NOTE   IF QFT INTERLOCK CANNOT BE SET OR CLEARED, AND
*                THE OPERATOR OVERRIDES THE JOB, SOME INTERLOCKS
*                MAY NOT BE CLEARED.
 
 
 FQI      SUBR               ENTRY/EXIT
          STM    FQIA        PRESERVE FUNCTION
 FQI1     LDC    **
 FQIA     EQU    *-1
          STD    CM+1
          LDN    0
          STD    CM+2
          SFA    QFT,QA      GET QFT ADDRESS
          STD    CM+4
          SHN    -14
          STD    CM+3
          MONITOR  UTEM      UPDATE TABLE ENTRY
          LDD    CM+1        CHECK FOR FUNCTION COMPLETE
          ZJN    FQIX        IF FUNCTION COMPLETE
          DELAY
          PAUSE
          LDD    CM+1        CHECK FOR OPERATOR OVERRIDE
          LMN    ORET
          NJN    FQI1        IF NO OVERRIDE
          LDN    1           SET ERROR STATUS
          LJM    FQIX        RETURN
 GEA      SPACE  4,10
**        GEA - GET EJT ADDRESS.
*
*         ENTRY  (AEOA) = EJT ORDINAL.
*
*         EXIT   (A) = ADDRESS OF EJT.
*
*         MACROS SFA.
 
 
 GEA      SUBR               ENTRY/EXIT
          LDM    EJTO        LOAD EJT ORDINAL
          SFA    EJT
          UJN    GEAX        RETURN
 GFA      SPACE  4,10
**        GFA - GET PARAMETER BLOCK ADDRESS.
*
*         ENTRY  (IR+3 - IR+4) = PARAMETER BLOCK ADDRESS.
*
*         EXIT   (A) = ABSOLUTE ADDRESS.
 
 
 GFA      SUBR               ENTRY/EXIT
          LDD    IR+3
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          UJN    GFAX        RETURN
 RFN      SPACE  4,10
**        RFN - READ FAMILY NAME.
*
*         EXIT   (A) = CM ADDRESS OF FAMILY NAME.
*
*         USES   CM - CM+4.
*
*         MACROS SFA.
 
 
 RFN      SUBR               ENTRY/EXIT
          LDD    CP          READ FAMILY POINTER
          ADN    PFCW
          CRD    CM
          SFA    EST,CM+3    READ EST
          ADK    EQDE
          CRD    CM
          LDD    CM+4        SET FAMILY ADDRESS
          SHN    3
          ADN    PFGL
          UJN    RFNX        RETURN
 RMS      SPACE  4,10
**        RMS - READ MASS STORAGE.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS.
*
*         EXIT   (A) .GE. 0.
*
*         ERROR  TO *EER*.
*
*         CALLS  RDS.
 
 
 RMS      SUBR               ENTRY/EXIT
          RJM    RDS
          PJN    RMSX        IF SUCCESSFUL READ
          LJM    EER         EVALUATE ERROR RETURN
 SQO      SPACE  4,10
**        SQO - SET QFT OWNERSHIP.
*
*         EXIT   QFT UPDATED.
*
*         USES   CN - CN+4, FN - FN+4, UN - UN+4.
*
*         CALLS  GEA, GFO, SSJ.
*
*         MACROS SFA.
 
 
 SQO3     LDD    CN+2        SET FO,UI IN SYSTEM SECTOR
          STM    IOSS+JSNQ*5+2
          LDD    CN+3
          STM    IOSS+JSNQ*5+3
 
 SQO      SUBR               ENTRY
          RJM    GEA         GET EJT ADDRESS
          ADK    JSNE        GET *FO,UI* FROM EJT
          CRD    CN
          LDD    CN+2        SET *FO,UI* IN SYSTEM SECTOR
          ADD    CN+3
          NJN    SQO3        IF FAMILY ORDINAL AND UI .NE. 0
          LDD    MA          SAVE FILE NAME
          CWD    FN
          CRD    UN
          LDD    CP          DETERMINE FAMILY ORDINAL FROM CPA
          ADK    PFCW
          CRD    CN
          SFA    EST,CN+3    GET FAMILY EST ORDINAL
          ADK    EQDE
          CRD    CN
          LDD    CN+4        LOAD MST ADDRESS
          SHN    3
          ADK    PFGL
          CRD    FN
          CRM    FOSS,ON
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL
          RJM    SSJ         CHECK FOR SSJ= BLOCK
          ZJN    SQO1        IF NO SSJ= BLOCK PRESENT
          ADK    UIDS        GET USER INDEX
          UJN    SQO2        CONTINUE
 
 SQO1     LDD    CP          GET UI FROM CPA
          ADK    UIDW
 SQO2     CRD    CN
          CRM    OASS,ON
          LDD    FN+4        SET FO,UI IN QFT
          SHN    6
          LMD    CN+3
          SCN    37          CLEAR CHARGE REQUIRED BIT
          LMD    CN+3
          STD    CN+2
          LDD    CN+4
          STD    CN+3
          LDD    MA          RESTORE FILE NAME
          CWD    UN
          CRD    FN
          LJM    SQO3        CONTINUE
 SSJ      SPACE  4,10
**        SSJ - CHECK FOR SSJ= BLOCK.
*
*         EXIT   (A) = 0 IF NO SSJ= BLOCK PRESENT.
*                (A) = SSJ= BLOCK ADDRESS IF PRESENT.
*
*         USES   CM - CM+4.
*
*         MACROS NFA.
 
 
 SSJ      SUBR               ENTRY/EXIT
          LDD    CP          CHECK FOR SSJ=
          ADC    SEPW
          CRD    CM
          LDD    CM
          LPN    4
          ZJN    SSJX        IF NOT SSJ=
          LDD    CM+3        CHECK IF SSJ= BLOCK PRESENT
          LPN    37
          ADD    CM+4
          ZJN    SSJX        IF NO SSJ= BLOCK
          NFA    SSJN        SET SSJ= BLOCK ADDRESS
          UJN    SSJX        RETURN
 VCA      SPACE  4,14
**        VCA - VALIDATE CENTRAL ADDRESS.
*
*         ENTRY  (A) = CENTRAL ADDRESS TO VALIDATE.
*
*         EXIT   (A) = 0, IF ADDRESS .LE. 1, OR .GE. FL.
*                (A) = CENTRAL ADDRESS IF VALID.
*                (T1 - T2) = CENTRAL ADDRESS.
*
*         USES   T1, T2.
 
 
 VCA1     STD    T1          CLEAR UPPER PART OF ADDRESS
 VCA2     LDN    0           SET BAD ADDRESS FLAG
 
 VCA      SUBR               ENTRY/EXIT
          STD    T2
          SCN    1
          ZJN    VCA1        IF ADDRESS .LE. 1
          SCN    77
          SHN    6
          STD    T1
          SHN    6
          SBD    FL
          PJN    VCA2        IF ADDRESS .GE. FL
          LDD    T1
          SHN    14
          LMD    T2
          UJN    VCAX        RETURN
 WMS      SPACE  4,10
**        WMS - WRITE MASS STORAGE.
*
*         ENTRY  (A) = BUFFER ADDRESS.
*                (T5 - T7) = MASS STORAGE PARAMETERS.
*
*         EXIT   (A) .GE. 0.
*
*         ERROR  TO *EER*.
*
*         CALLS  WDS.
 
 
 WMS      SUBR               ENTRY/EXIT
          RJM    WDS
          PJN    WMSX        IF SUCCESSFUL WRITE
          LJM    EER         EVALUATE ERROR RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
 EJT$     SET    1           CALCULATE EJT ADDRESS
 IFP$     EQU    1           ASSEMBLE REMOTE INITIALIZATION CODE
 QFT$     SET    1           CALCULATE QFT ADDRESS
*CALL     COMPGFP
 GFO$     SET    1           CONVERT FAMILY NAME TO FAMILY ORDINAL
 GFM$     SET    1           CONVERT FAMILY ORDINAL TO FAMILY NAME
*CALL     COMPUFT
          QUAL   MIO
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
 WEI$     SET    1           ALLOW *DSP* TO SPECIFY EOI BUFFER
*CALL     COMPWEI
          QUAL   *
 WEI      EQU    /MIO/WEI
          SPACE  4,10
*         THE FOLLOWING SUBROUTINES MAY BE OVERLAID BY *DSP* OVERLAYS.
          SPACE  4,10
 OVL4     EQU    *+5         LOAD ADDRESS FOR *DSP* OVERLAYS
 
          ERRNG  OVL2-5-*    OVERFLOW INTO *0DF*
          ERRNG  OVL0-5-*    OVERFLOW INTO *0DQ*
          TITLE  FILE INITIALIZATION ROUTINES.
 AMS      SPACE  4,20
**        AMS - ASSIGN MASS STORAGE.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (FA) = NFL FNT OFFSET.
*
*         EXIT   (FS - FS+4) = FST ENTRY.
*                MASS STORAGE ASSIGNED.
*                SYSTEM SECTOR AND EOI WRITTEN.
*                (T5) = EQUIPMENT.
*
*         USES   T5, T6, CM - CM+4, FS - FS+4.
*
*         CALLS  PDF, WEI, WSS.
*
*         MACROS ENDMS, MONITOR, NFA, SETMS.
 
 
 AMS      SUBR               ENTRY/EXIT
          LDD    FS+2
          NJN    AMSX        IF FILE USED
          LDD    FS+1
          NJN    AMS2        IF FILE ASSIGNED
 
*         ASSIGN MASS STORAGE.
 
 AMS1     LDN    ZERL        CLEAR PARAMETERS
          CRD    CM
          LDN    OUTS        SET *RTCM* PARAMETER FOR OUTPUT FILE
          STD    CM+2
          LDM    LFAL        SET ACCESS LEVEL SELECTION
          ADN    40
          SHN    6
          STD    CM+3
          MONITOR  RTCM      REQUEST TRACK CHAIN
          LDD    CM+1        SET EQUIPMENT
          STD    FS
          LDD    CM+4
          NJN    AMS2        IF TRACK ASSIGNED
          RJM    PDF         PROCESS DEVICE FULL
          UJN    AMS1        RETRY MASS STORAGE ALLOCATION
 
*         UPDATE FNT/FST.
 
 AMS2     STD    FS+1        SET FIRST TRACK
          STD    FS+2
          STD    T6
          LDD    FS          SET *EST* ORDINAL
          STD    T5
          LDN    FSMS        SET FIRST SECTOR
          STD    FS+3
          LDN    14          SET FILE BUSY
          STD    FS+4
          NFA    FA,R        WRITE FST
          ADN    FSTL
          CWD    FS
 
*         WRITE SYSTEM SECTOR AND EOI.
 
          SETMS  IO
          RJM    WSS         WRITE SYSTEM SECTOR
          LDC    BFMS        ADDRESS OF EOI BUFFER
          RJM    WEI         WRITE EOI
          ENDMS
 
*         UPDATE TRT.
 
          LDD    T5          SET EQUIPMENT
          STD    CM+1
          LDD    T6          SET TRACK
          LPC    3777
          STD    CM+2
          LDD    T7          SET SECTOR
          STD    CM+3
          MONITOR DTKM       DROP TRACKS AND UPDATE TRT
          LDM    SLM         SET SECTOR COUNT
          STM    DPPC+1
          LDN    CDCS        SET DECREMENT FUNCTION
          STM    DPPB
          LJM    AMSX        RETURN
 CSL      SPACE  4,10
**        CSL - CHECK FOR SPECIAL LID.
*
*         ENTRY  (A) = LID (MAY BE SPECIAL CODE).
*
*         EXIT   (A) = LID, IF NO SPECIAL CODE.
*                (A) = 0 IF SPECIAL CODE = *LCZR*.
*                (A) = PID IF SPECIAL CODE = *LCPD*.
*
*         USES   T1, CM - CM+4.
 
 
 CSL1     SHN    14          RESTORE LID AND EXIT
          LMD    T1
 
 
 CSL      SUBR               ENTRY/EXIT
          STD    T1
          SHN    -14
          NJN    CSL1        IF NOT SPECIAL CODE
          LDD    T1
          ZJN    CSLX        IF ZERO LID
          SBN    LCZR
          ZJN    CSLX        IF *ZERO LID* CODE SPECIFIED
          ERRNZ  LCPD-2      CODE DEPENDS ON VALUE
          ERRNZ  MXLC-3      CODE DEPENDS ON VALUE
 
*         CREATE HOST PID USING THE MACHINE ID.
 
          LDK    MMFL        GET MACHINE ID
          CRD    CM
          LDN    1RM
          SHN    14
          LMD    CM          MERGE *M* WITH MACHINE ID
          UJN    CSLX        RETURN
 EDF      SPACE  4,25
**        EDF - ENTER DEFERRED FILE.
*
*         ENTRY  (QT) = QUEUE TYPE.
*                (ST) = STATUS WORD.
*                (FA) = NFL FNT ENTRY OFFSET.
*
*         EXIT   *BFMS* CONTAINS UPDATED SYSTEM SECTOR FOR QUEUED FILE.
*                (FS - FS+4) = QUEUED FILE FST ENTRY.
*                (ST) = STATUS WORD.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                THIS ROUTING NOT ALLOWED.
*
*         USES   QA, ST, FN - FN+4, FS - FS+4.
*
*         CALLS  FNB, FQI.
*
*         MACROS ERROR, NFA.
 
 
 EDF4     AOM    DPPA        SET FILE NOT BUSY
          LJM    DPP         DROP PPU
 
 EDF      SUBR               ENTRY/EXIT
 
*         USE QUEUE TYPE FROM SYSTEM SECTOR, IF NOT SPECIFIED IN CALL.
 
          LDD    ST          CHECK IF DISPOSITION CODE SPECIFIED
          LPC    DCFL
          NJN    EDF1        IF DISPOSITION CODE SPECIFIED
          LDM    IOSS+JSNQ*5+4  USE QUEUE TYPE FROM SYSTEM SECTOR
          SHN    -11
          STD    QT
 
*         DETERMINE IF QUEUE TYPE HAS CHANGED.
 
 EDF1     LDM    IOSS+JSNQ*5+4
          SHN    -11
          LMD    QT
          ZJN    EDF2        IF NO CHANGE IN QUEUE TYPE
          ERROR  /ERR/EC26   * DSP - THIS ROUTING NOT ALLOWED.*
 
 EDF2     LDN    DSFL        FLAG DATA IN SYSTEM SECTOR
          RAD    ST
          LDM    GQSS        GET ORDINAL NUMBER
          STD    QA
          LDN    0           SET *INTERLOCK* FUNCTION
          RJM    FQI         FUNCTION QFT INTERLOCK
          NJN    EDF4        IF ENTRY NOT INTERLOCKED
          NFA    FA,R        READ FNT ENTRY OF FILE
          CRD    FN
          ADN    FSTL
          CRD    FS
          LDM    IOSS+JSNQ*5+4  CLEAR ATTACHED TO EJT BIT
          SCN    77
          STM    IOSS+JSNQ*5+4
 
*         DETERMINE IF FILE IS BEING REQUEUED.
 
          LDM    FGSS        CHECK IF FILE BEING REQUEUED
          LPN    2
          ZJN    EDF3        IF FILE NOT BEING REQUEUED
          LDC    RQFL        SAVE *FILE BEING REQUEUED* STATUS
          RAD    ST
 EDF3     LJM    EDFX        RETURN
 EFN      SPACE  4,15
**        EFN - ENTER FILE NAME IN FNT TABLE.
*
*         ENTRY  (FN - FN+4) = FILE NAME.
*
*         EXIT   (FS - FS+4) = FST ENTRY.
*                (FA) = NFL FNT OFFSET.
*                (FNBB) INCREMENTED.
*                (LFAL) = ACCESS LEVEL OF NEW FILE.
*
*         ERROR  TO *DPP*, IF DUPLICATE FILE ROUND.
*
*         USES   FS, CM - CM+4, UN - UN+4.
*
*         CALLS  *0BF*.
*
*         MACROS EXECUTE, MONITOR, NFA.
 
 
 EFN1     AOM    FNBB        SET FILE CREATED BY *DSP*
          NFA    FA,R
          ADK    FUTL
          CRD    CM
          LDD    CM+2
          LPN    7
          STM    LFAL
 
 EFN      SUBR               ENTRY/EXIT
          LDD    MA          GET FILE NAME
          CWD    FN
          CRD    UN
          LDN    NEEQ        SET NO MASS STORAGE ASSIGNMENT
          STD    FS
          LDN    0           SELECT NO RETURN WITHOUT FILE CREATED
          STM    OVL0-1
          EXECUTE 0BF,OVL0   BEGIN FILE
          UJN    EFN1        NO DUPLICATE ENTRY
 
*         PROCESS ADVANCE EXIT FROM *0BF* (FILE ALREADY EXISTS).
 
          LDN    SWET        SET SYSTEM SOFTWARE ERROR
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    DPP         DROP PP
 EQF      SPACE  4,10
**        EQF - ENTER QUEUED FILE IN GLOBAL TABLE.
*
*         EXIT   (QA) = ORDINAL OF ENTRY.
*                (FNBA) = 1 (CREATION MODE).
*                QFT BUFFER INITIALIZED.
*                *QFT FULL.* MESSAGE ISSUED TO OPERATOR, IF
*                CANNOT MAKE AN ENTRY IN THE QFT.
*
*         USES   QA, CM - CM+7.
*                TO *RCL* IF QFT FULL.
*
*         CALLS  CTE, FNB, GEA.
*
*         MACROS ERROR, PAUSE, SFA.
 
 
 EQF      SUBR               ENTRY/EXIT
          LDM    FJSN        SET FORCED JSN OR SUBSYSTEM NAME
          STD    CM+3
          LDM    FJSN+1
          STD    CM+4
          LDD    FB          CHECK FOR JOB TERMINATION
          SHN    21-11
          PJN    EQF2        IF NOT FINAL ROUTE FOR TERMINATING JOB
          RJM    GEA         GET EJT-S JSN
          ADK    JSNE
          CRD    CM+3
 EQF1     LDN    0           ZERO FILL JSN
          STD    CM+5
          STD    CM+6
          AOM    EQFA        PREVENT ALLOCATION OF NEW JSN
          UJN    EQF4        CONTINUE
 
 EQF2     LDM    FSJS
          NJN    EQF1        IF FORCED JSN
          LDD    FB+1
          SHN    21-13
          PJN    EQF3        IF NOT SUBSYSTEM INITIATION
          LDM    SBID
          ZJN    EQF1        IF SUBSYSTEM ID NOT SPECIFIED
          SBK    LSSI+1
          PJN    EQF1        IF SPECIFIED SUBSYSTEM IS IN *SSCT* TABLE
 EQF3     LDN    ZERL        SET UP FOR *CTE* CALL (ASSIGN NEW JSN)
          CRD    CM+3
 EQF4     LDN    7           SET CREATION + ATTACH + INTERLOCK
          STD    CM+7
          LDC    PQFT        REQUEST QFT ENTRY
*         LDC    PQFT+10000  (IF NEW JSN NOT NEEDED)
 EQFA     EQU    *-2
          RJM    CTE         CREATE TABLE ENTRY
          NJN    EQF6        IF ENTRY MADE
          LDD    CP          CONSOLE MESSAGE = * QFT FULL.*
          ADK    MS2W
          CWM    EQFB,TR
          PAUSE
          LDD    FB          CHECK IF ERROR PROCESSING NEEDED
          LPN    1
          ADD    CM+1        CHECK FOR ERROR FLAG AT CONTROL POINT
          ZJN    EQF5        IF NO ERROR PROCESSING NEEDED
          ERROR  /ERR/EC25   * DSP - QFT FULL.*
 
 EQF5     LJM    RCL         RECALL PP
 
 EQF6     LDD    CM+1        SAVE QFT ORDINAL
          STD    QA
          AOM    FNBA        SET CREATION MODE QFT ENTRY
          SFA    QFT,QA      GET ASSIGNED JSN
          ADK    JSNQ
          CRM    IOSS,ON
          LDN    0           CLEAR INTERLOCK AND CREATION BITS
          STM    IOSS+JSNQ*5+4
          LDD    FS          SET EQUIPMENT
          STM    IOSS+ENTQ*5+0
          LDD    FS+1        SET TRACK
          STM    IOSS+ENTQ*5+1
          LJM    EQFX        RETURN
 
 EQFB     DATA   C* QFT FULL.*
 GLI      SPACE  4,10
**        GLI - GET LOGICAL IDENTIFIERS.
*
*         ENTRY  (QT) = DESTINATION QUEUE TYPE.
*
*         EXIT   DLID/SLID SAVED FOR SYSTEM SECTOR AND QFT.
*
*         USES   T1, CN - CN+4.
*
*         CALLS  CSL, GFA.
 
 
 GLI      SUBR               ENTRY/EXIT
          LDM    SLSS        PROPAGATE OLD VALUES OF DLID/SLID
          LPN    77
          STM    SLID
          LDM    SLSS+1
          STM    SLID+1
          LDM    IOSS+INSQ*5+2
          SCN    77
          SHN    6
          LMM    IOSS+INSQ*5+1
          SHN    6
          STM    DLID+1
          SHN    -14
          STM    DLID
          LDD    QT
          LMK    INQT
          ZJN    GLI1        IF ROUTE TO INPUT
          LDM    SLID        SET DLID = SLID FOR OUTPUT FILES
          STM    DLID
          LDM    SLID+1
          STM    DLID+1
 GLI1     LDD    FB+1
          LPN    FRLD
          ZJN    GLI4        IF DLID/SLID NOT SPECIFIED
 
*         GET DLID FROM PARAMETER BLOCK.
 
          RJM    GFA         GET SLID/DLID
          ADN    2
          CRD    CN
          LDD    CN+1        CHECK DLID
          LPN    77
          SHN    14
          LMD    CN+2
          RJM    CSL         CHECK FOR SPECIAL LID
          STM    DLID+1      SAVE DLID
          SHN    -14
          STM    DLID
 
*         GET SLID FROM PARAMETER BLOCK.
 
          LDD    CN+1        CHECK SLID
          SCN    77
          SHN    6
          LMD    CN
          ZJN    GLI4        IF NO CHANGE IN SLID
          SHN    6
 GLI2     RJM    CSL         CHECK FOR SPECIAL LID
          STM    SLID+1      SAVE SLID
          SHN    -14
          STM    SLID
 GLI3     UJN    GLI5        SET ATTRIBUTES
 
*         CHECK IF DEFAULT SLID NEEDED.
 
 GLI4     LDM    SLID
          ADM    SLID+1
          NJN    GLI5        IF SLID NONZERO
          LDN    LCPD
          UJN    GLI2        SET SLID TO PID
 
*         GET ATTRIBUTES OF DLID/SLID.
 
 GLI5     LDM    DLID        GET DLID ATTRIBUTES
          SHN    14
          LMM    DLID+1
          ZJN    GLI6        IF NO DLID
          RJM    VID         GET ATTRIBUTES FROM LID TABLE
          ZJN    GLI6        IF LID TABLE NOT FOUND
          STM    DLAT        SAVE ATTRIBUTES
 GLI6     LDM    SLID        GET SLID ATTRIBUTES
          SHN    14
          LMM    SLID+1
          ZJN    GLI7        IF NO SLID
          RJM    VID         GET ATTRIBUTES FROM LID TABLE
          ZJN    GLI7        IF LID TABLE NOT FOUND
          STM    SLAT        SAVE ATTRIBUTES
 GLI7     LJM    GLIX        RETURN
 ISS      SPACE  4,25
**        ISS -  INITIALIZE SYSTEM SECTORS.
*
*         ENTRY  (FN - FN+4) = QUEUED FILE FNT ENTRY.
*                (FS - FS+4) = FST ENTRY
*                (FA) = NFL FNT ENTRY OFFSET.
*                (ST) = STATUS WORD.
*                (QT) = DESTINATION QUEUE TYPE.
*
*         EXIT   *BFMS* CONTAINS SYSTEM SECTOR FOR QUEUED FILE.
*                (FS - FS+4) = QUEUED FILE FST ENTRY
*
*         USES   CM - CM+4, T1 - T7.
*
*         CALLS  EQF, GEA, GLI, RFN, SSJ, SSR.
*
*         MACROS NFA.
 
 
 ISS      SUBR               ENTRY
          LDC    FNTN        READ INPUT FILE FNT
          STM    SSRB
          NFA    FNTN
          CRD    CM
          ADN    FSTL
          CRD    T5
          LDN    INFT        SET DESIRED FILE TYPE
          STM    SSRA
          LDD    ST          CHECK IF CALLED BY SUBSYSTEM
          LPN    SSFL
          NJN    ISS1        IF NOT CALLED BY A SUBSYSTEM
          LDD    QT          CHECK IF SUBSYSTEM OUTPUT FILE
          LMK    INQT
          NJN    ISS1        IF OUTPUT FROM A SUBSYSTEM
          AOM    ISSA        SET INPUT FILE NOT READ
          UJN    ISS2        CONTINUE
 
 ISS1     LDD    T5
          RJM    SSR         READ INPUT FILE SYSTEM SECTOR
          ZJN    ISS4        IF INPUT FILE SYSTEM SECTOR READ
 ISS2     LDC    501         CLEAR SYSTEM SECTOR BUFFER
          STD    T1
 ISS3     LDN    0
          STM    BFMS,T1
          SOD    T1
          PJN    ISS3        IF MORE TO CLEAR
          RJM    GLI         GET SLID/DLID
          LDD    ST          CHECK ORIGIN TYPE OF CALLING CP
          LPN    SYFL
          ZJN    ISS7        IF CP NOT *SYOT*
          LCN    0
          STM    VASS+5*AAWC+3
          STM    VASS+5*AAWC+4
          UJN    ISS7        SET DEFAULT TID
 
*         SET DEFAULT DESTINATION TERMINAL ID (TID).
 
 ISS4     RJM    GLI         GET SLID/DLID
          LDN    QFTE*5-1    CLEAR QFT IN SYSTEM SECTOR
          STD    T1
 ISS5     LDN    0           CLEAR QFT
          STM    IOSS,T1
          SOD    T1
          PJN    ISS5        IF NOT FINISHED
          LDN    DDSSL       CLEAR FILE DEPENDENT INFORMATION
          STD    T1
 ISS6     LDN    0
          STM    JISS,T1
          SOD    T1
          PJN    ISS6        IF MORE TO CLEAR
 
*         SET ROUTING INFORMATION FROM EJT.
 
 ISS7     LDC    **
 ISSA     EQU    *-1         (INPUT FILE NOT READ FLAG)
          NJN    ISS8        IF INPUT FILE NOT READ
          RJM    GEA         GET EJT ADDRESS
          ADK    SCLE
          CRD    CM
          LDD    CM          SET ORIGIN TYPE OF EJT
          SCN    60
          STM    IOSS+SCLQ*5+0
          LDD    CM+1        SET DEFAULT ROUTING INFORMATION
          STM    IOSS+SCLQ*5+1
          LDD    CM+2
          STM    IOSS+SCLQ*5+2
 
*         SET CREATION DATE AND MACHINE ID.
*         SET CREATION FAMILY AND USER NAME.
 
 ISS8     LDC    MMFL        SET MACHINE ID
          CRD    CM
          LDD    CM
          STM    CMSS
          STM    RMSS
          RJM    RFN         READ CREATION FAMILY NAME
          CRM    FMSS,ON
          RJM    SSJ         CHECK FOR SSJ= BLOCK
          ZJN    ISS9        IF NO SSJ= ADDRESS
          ADK    UIDS        USER NAME
          UJN    ISS10       READ USER NAME
 
 ISS9     LDD    CP          READ USER NAME
          ADK    UIDW
 ISS10    CRM    ACSS,ON
          LDM    FMSS+3      ZERO FILL FAMILY NAME
          SCN    77
          STM    FMSS+3
          LDN    0
          STM    FMSS+4
 
*         SET CHARGE AND PROJECT NUMBERS.
 
          NFA    CHGN
          CRM    CHSS,TR
          ERRNZ  PJSS-CHSS-5 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS
          ERRNZ  CHGN-PJ1N-1 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS
 
*         ENTER FILE INTO QFT.
 
          RJM    EQF         ENTER QUEUED FILE
 
*         SET ORIGINAL AND CREATION JSN-S IN SYSTEM SECTOR.
 
          LDM    IOSS+JSNQ*5+0
          STM    OJSS
          LDM    IOSS+JSNQ*5+1
          STM    OJSS+1
          RJM    GEA         SET CREATION JSN
          ADK    JSNE
          CRD    CM
          LDD    CM
          STM    CJSS
          LDD    CM+1
          STM    CJSS+1
          LJM    ISSX        RETURN
 PDF      SPACE  4,15
**        PDF - PROCESS DEVICE FULL.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                DEVICE FULL.
*
*         USES   CM - CM+4.
*
*         EXIT   *DEVICE FULL* MESSAGE ISSUED TO OPERATOR.
*
*         MACROS ERROR, MONITOR, PAUSE.
 
 
 PDF      SUBR               ENTRY/EXIT
 PDFA     LDN    0           CHECK IF ROUTINE PREVIOUSLY CALLED
*         LDN    1
          NJN    PDF1        IF ROUTINE PREVIOUSLY CALLED
          AOM    PDFA        SET ROUTINE PREVIOUSLY CALLED
          LDD    CP          CONSOLE MESSAGE = *TRACK LIMIT.*
          ADK    MS2W
          CWM    PDFB,TR
          LDN    ZERL        CLEAR PARAMETERS
          CRD    CM
          LDK    TKLE        SET TRACK LIMIT EVENT
          STD    CM+4
*         LDN    0           SET SYSTEM EVENT
*         STD    CM+3
          MONITOR  EATM
 PDF1     PAUSE
          LDD    FB
          LPN    1
          ADD    CM+1
          ZJN    PDFX        IF NO ERROR PROCESSING NEEDED
 PDF2     ERROR  /ERR/EC27   * DSP - DEVICE FULL.*
 
 PDFB     DATA   C*TRACK LIMIT.*
 RCL      SPACE  4,10
**        RCL - RECALL PP.
 
 
 RCL      BSS    0           ENTRY
          RJM    FNB         SET FILE NOT BUSY
          LDN    ZERL        DEFAULT TO TIMED RECALL
          CRD    CM
          LDD    MA
          CWD    IR
          MONITOR  RECM      RECALL PP
          LJM    PPR         ENTER PP RESIDENT
 SDC      SPACE  4,10
**        SDC - SET DISPOSITION CODE.
*
*         ENTRY  (SDCA) = TABLE INDEX SET BY *DDC*.
*                       = 0, IF NO DISPOSITION CODE SPECIFIED.
*
*         EXIT   QFT AND SYSTEM SECTOR UPDATED.
*
*         USES   T0, T1.
*
 
 
 SDC      SUBR               ENTRY EXIT
          LDD    ST          CHECK IF DISPOSITION CODE SPECIFIED
          LPC    DCFL
          ZJN    SDCX        IF DISPOSITION CODE NOT SPECIFIED
          LDC    **
 SDCA     EQU    *-1         (*TODC* TABLE ENTRY SET BY *DDC*)
          STD    T1
          LPN    77
          STD    T0
          LDC    **          SET DISPOSITION CODE IN SYSTEM SECTOR
 SDCB     EQU    *-1
          STM    DCSS
          LDM    IOSS+SCLQ*5+3
          SCN    77
          LMD    T0
          STM    IOSS+SCLQ*5+3
          LDM    IOSS+JSNQ*5+4  SET DISPOSITION CODE IN QFT
          LMD    T1
          LPN    77
          LMD    T1
          STM    IOSS+JSNQ*5+4
          UJN    SDCX        RETURN
 SPR      SPACE  4,10
**        SPR - SET PRIORITY.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (QT) = QUEUE TYPE.
*                (T3) .NE. 0, IF SPECIAL REQUEUE OPERATION.
*
*         EXIT   QFT UPDATED.
*                (FGSS) = FLAG SET IF PRIORITY PRESENT.
*
*         USES   CN - CN+4, T1 - T5.
*
*         CALLS  CET, GFA.
 
 
 SPR      SUBR               ENTRY/EXIT
          LDD    FB+1        CHECK PRIORITY
          SHN    21-11
          MJN    SPR2        IF PRIORITY SPECIFIED
          LDD    T3
          NJN    SPRX        IF SPECIAL REQUEUE OPERATION
          LDD    FB+1        CHECK IF DEFERRED ROUTE
          SHN    21-0
          MJN    SPRX        IF DEFERRED ROUTE
          LDM    FGSS        CHECK IF PRIORITY PREVIOUSLY SPECIFIED
          LPN    4
          NJN    SPR3        IF PRIORITY PREVIOUSLY SPECIFIED
 SPR0     LDC    RTCL        USE REAL TIME CLOCK
          CRD    T1
 SPR1     LJM    SPR5        SET ENTRY TIME IN QFT
 
 SPR2     RJM    GFA         READ PRIORITY
          ADN    3
          CRD    CN
          LDD    T3
          ZJN    SPR2.1      IF NOT SPECIAL REQUEUE OPERATION
          LDD    CN+2
          NJN    SPR0        IF NEW ENTRY TIME NEEDED
          LDD    CN+3        GET ENTRY TIME
          STD    T1
          LDD    CN+4
          STD    T2
          UJN    SPR1        SET ENTRY TIME IN QFT ENTRY
 
 SPR2.1   LDD    CN+4
          STM    PRSS
          LDM    FGSS        SET PRIORITY FLAG
          SCN    4
          LMN    4
          STM    FGSS
          LDD    FB+1        CHECK IF DEFERRED ROUTE
          SHN    21-0
          MJN    SPR6        IF DEFERRED ROUTE
 SPR3     LDM    FGSS        CLEAR PRIORITY SPECIFIED FLAG
          SCN    4
          STM    FGSS
          LDM    PRSS        CONVERT PRIORITY INTO ENTRY TIME
          STD    T1
          LDD    QT          GET QUEUE TYPE
          LMK    INQT
          ZJN    SPR4        IF INPUT FILE
          LDN    OTQT        SET OUTPUT QUEUE TYPE
 SPR4     STD    T2
          LDM    IOSS+SCLQ*5+0
          SCN    77
          SHN    6
          LMD    T2
          RJM    CET         CALCULATE ENTRY TIME
 SPR5     LDD    T2          SET ENTRY TIME IN QFT ENTRY
          STM    IOSS+ENTQ*5+4
          LDD    T1
          STM    IOSS+ENTQ*5+3
 SPR6     LJM    SPRX        RETURN
 SQS      SPACE  4,15
**        SQS - SET QUEUED FILE SYSTEM SECTOR IN *BFMS*.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (ST) = STATUS WORD.
*                (FA) = NFL FNT OFFSET.
*                (QT) = QUEUE TYPE.
*                (FN - FN+4) = FILE NAME.
*
*         EXIT   (FN - FN+4) = NFL FNT/FST ENTRY.
*                (FS - FS+4) = NFL FNT/FST ENTRY.
*                (QT) = QUEUE TYPE.
*                (QA) = ORDINAL OF GLOBAL *QFT* TABLE ENTRY.
*
*         USES   FN - FN+4.
*
*         USES   AMS, EFN, SPR, USS, VMS.
*
*         MACROS NFA.
 
 
 SQS      SUBR               ENTRY/EXIT
          LDD    ST          CHECK IF FILE CREATION NEEDED
          LPN    FCFL
          ZJN    SQS1        IF FILE EXISTS
          RJM    EFN         ENTER FILE NAME
 SQS1     RJM    AMS         ASSIGN MASS STORAGE
          LDD    FS          SET EQUIPMENT
          RJM    VMS         VALIDATE MASS STORAGE
          NFA    FA,R        READ FNT OF EXISTING FILE
          CRD    FN
          LDD    FN+4        SET FILE TYPE
          LPN    77
          LMC    QFFT*100
          STD    FN+4
          RJM    USS         SET SYSTEM SECTOR
          RJM    SPR         SET PRIORITY
          UJN    SQSX        RETURN
 SSR      SPACE  4,20
**        SSR - SYSTEM SECTOR READ.
*
*         ENTRY  (A) = EST ORDINAL.
*                (T6) = FIRST TRACK.
*                (CM - CM+4) = FNT ENTRY.
*                (SSRB) = NFL FNT ENTRY OFFSET.
*
*         EXIT   (A) = 0 IF NO ERRORS AND DATA IN SYSTEM SECTOR.
*                    .GT. 0 IF NO DATA IN SYSTEM SECTOR.
*                    .LT. 0 IF ERRORS IN SYSTEM SECTOR DATA.
*                DRIVER PRESET.
*
*         USES   T1, T3, T5.
*
*         CALLS  RSS, SSE.
*
*         MACROS ENDMS, NFA, SETMS.
 
 
 SSR2     ENDMS
*         LDN    0           RETURN (NO ERRORS)
 
 SSR      SUBR               ENTRY/EXIT
          STD    T5
          LMN    NEEQ
          ZJN    SSR1        IF NO FILE
          LDD    CM+4
          SHN    -6
 SSR1     LMC    QFFT
*         LMC    INFT        (READ JOB INPUT FILE)
 SSRA     EQU    *-1         (SET BY *ISS*)
          NJN    SSRX        IF NOT ALREADY QUEUE FILE
          SETMS  IO
          LDN    0
          RJM    RSS         READ SYSTEM SECTOR
          ZJN    SSR2        IF NO ERRORS
 
*         PROCESS SYSTEM SECTOR ERROR.
 
          LDN    0           SET FNT TYPE
          STD    T3
          LDC    *
 SSRB     EQU    *-1         (FNT OFFSET OF FILE READ)
          STD    T1
          NFA    T1,R
          RJM    SSE         REPORT SYSTEM SECTOR ERROR
          LCN    1           FLAG SYSTEM SECTOR ERROR
          UJN    SSRX        RETURN WITH ERROR
 USS      SPACE  4,20
**        USS - UPDATE SYSTEM SECTOR.
*
*         ENTRY  (FN - FN+4) = QUEUED FILE FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                (FA) = NFL FNT ENTRY OFFSET.
*
*         EXIT   *BFMS* CONTAINS SYSTEM SECTOR FOR QUEUED FILE.
*                (QT) = QUEUE TYPE.
*                (T3) .NE. 0, IF VALID SPECIAL REQUEUE FLAG SET.
*                REPEAT COUNT SET, IF VALID SPECIAL REQUEUE FLAG SET.
*
*         ERROR  TO *ERR* IF ERROR READING *QFFT* FILE SYSTEM SECTOR.
*
*         USES   QT, T3, T6, CM - CM+4.
*
*         CALLS  EDF, GFA, GLI, ISS, SQO, SSR.
*
*         MACROS ERROR, ISTORE, NFA.
 
 
 USS2     RJM    ISS         INITIALIZE SYSTEM SECTOR
          RJM    SQO         SET QFT OWNERSHIP
 USS3     LDN    0           SET NORMAL EXIT
          STD    T3
 
 USS      SUBR               ENTRY/EXIT
 
*         SET QUEUE FILE TYPE.
 
          LDM    SDCA        GET ENTRY FROM *TODC* TABLE
          SHN    -11
          STD    QT
 
*         READ SYSTEM SECTOR INFORMATION IF IT EXISTS.
 
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDD    FA          READ CURRENT FNT ENTRY
          STM    SSRB        SAVE FNT OFFSET
          NFA    FA,R
          CRD    CM
          LDD    FS
          RJM    SSR         READ SYSTEM SECTOR
          MJP    USS1        IF ERROR ON *QFFT* FILE
          NJN    USS2        IF SYSTEM SECTOR NOT READ
 
*         SET FNT/FST FOR DEFERRED ROUTED OR ATTACHED QUEUE FILE
*         (SYSTEM SECTOR INFORMATION IS ALREADY PRESENT).
 
          RJM    GLI         GET LID INFORMATION
          RJM    EDF         ENTER DEFERRED FILE
 
*         CHECK FOR SPECIAL REQUEUE FLAG.
 
          LDD    ST
          LPN    DSFL
          ZJN    USS3        IF FILE NOT PREVIOUSLY ROUTED
          LDM    EBIT+1
          LPC    EFRQ
          STD    T3
          ZJN    USS0        IF SPECIAL REQUEUE FLAG NOT SPECIFIED
          ISTORE DSPG,(UJN DSP4)
          ISTORE DSPH,(UJN DSP5)
          ISTORE DSPI,(UJN DSP6.2)
 
*         SET REPEAT COUNT FOR SPECIAL REQUEUE OPERATION.
 
          LDD    FB
          SHN    21-2
          PJN    USS0        IF REPEAT COUNT NOT SPECIFIED
          RJM    GFA         READ REPEAT COUNT
          ADN    4
          CRD    CM
          LDD    CM+3        SET REPEAT COUNT
          LPN    77
          STM    IOSS+INSQ*5+4
          STM    RCSS
 USS0     LJM    USSX        RETURN
 
 USS1     ERROR  /ERR/EC24   * DSP - QUEUED FILE READ ERROR.*
 VMS      SPACE  4,10
**        VMS - VALIDATE MASS STORAGE.
*
*         ENTRY  (A) = EQUIPMENT.
*
*         EXIT   (CM - CM+4) = EST ENTRY.
*                (T5) = EQUIPMENT.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                FILE NOT ON REMOVABLE DEVICE.
*                FILE NOT ON MASS STORAGE.
*
*         USES   T5, CM - CM+4.
*
*         MACROS ERROR, SFA.
 
 
 VMS1     SHN    21-10-21+13
          PJN    VMSX        IF NOT REMOVABLE DEVICE
          ERROR  /ERR/EC20   * DSP - FILE ON REMOVABLE DEVICE.*
 
 VMS      SUBR               ENTRY/EXIT
          STD    T5          SET EQUIPMENT
          SFA    EST         READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    CM          CHECK FOR MASS STORAGE
          SHN    21-13
          MJN    VMS1        IF MASS STORAGE
          ERROR  /ERR/EC02   * DSP - FILE NOT ON MASS STORAGE.*
          SPACE  4,10
**        COMMON DECKS.
 
 
 CET$     SET    1           CALCULATE ENTRY TIME
*CALL     COMPCPE
*CALL     COMPCTE
*CALL     COMPC2D
*CALL     COMPRJC
          QUAL   MIO
 RDS      EQU    RMS         USE *RMS* IN PLACE OF *RDS*
*CALL     COMPRSS
          QUAL   *
 RSS      EQU    /MIO/RSS
*CALL     COMPSSE
*CALL     COMPVID
          QUAL   MIO3
 WCS$     SET    1           WRITE CONSECUTIVE SECTORS
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS
          QUAL   *
 WSS      EQU    /MIO3/WSS
          SPACE  4,10
*         THE FOLLOWING SUBROUTINES MAY BE OVERLAID BY ZERO-LEVEL
*         OVERLAYS.
          SPACE  4,10
 OVL5     EQU    *+5         LOAD ADDRESS FOR OVERLAY *3DC*
          SPACE  4,10
          ERRNG  OVL0-5-*    OVERFLOW INTO *0BF*
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          TITLE  FILE INITIALIZATION ROUTINES (OVERLAYABLE).
 CFN      SPACE  4,10
**        CFN - COMPARE FILE NAMES.
*
*         ENTRY  (T1) = FWA OF FNT ENTRY
*                (FN - FN+4) = FILE NAME.
*
*         EXIT   (A) = 0, IF FILE FOUND.
*                (A) .GT. 0, FILE ASSIGNED TO CP, BUT NOT DESIRED FILE.
*                (A) .LT. 0, NO ENTRY.
 
 
 CFN1     LCN    1           NO FILE FOUND
 
 CFN      SUBR               ENTRY/EXIT
          LDI    T1
          ZJN    CFN1        IF NO ENTRY
          LMD    FN
          NJN    CFNX        IF NO COMPARE
          LDM    1,T1
          LMD    FN+1
          NJN    CFNX        IF NO COMPARE
          LDM    2,T1
          LMD    FN+2
          NJN    CFNX        IF NO COMPARE
          LDM    3,T1
          LMD    FN+3
          SCN    77
          UJN    CFNX        RETURN
 DDC      SPACE  4,25
**        DDC - DETERMINE DISPOSTION CODE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FN - FN+4) = FNT ENTRY.
*                (ST) = STATUS WORD.
*
*         EXIT   (A) = 0, IF *DC=SC*.
*                (ST) = SET, IF DISPOSITION CODE SPECIFIED.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT DISPOSITION CODE.
*                *DC=SO* OR *DC=SS* AND CALLER NOT *SYOT* OR *SSJ=*.
*
*         USES   ST, T1, CM+2.
*
*         CALLS  CFN.
*
*         MACROS ERROR.
 
 
 DDC      SUBR               ENTRY/EXIT
 DDC1     LDC    *           SET DISPOSITION CODE
 DDCB     EQU    *-1         (DISPOSITION CODE SET BY PRESET)
          STD    CM+2
          LDD    FB+1
          SHN    21-4
          MJN    DDC2        IF DISPOSITION CODE SPECIFIED
          LDD    FN+4        GET FILE TYPE
          SHN    -6
          LMN    LOFT
          ZJN    DDC4        IF NOT QUEUED FILE
          UJN    DDCX        RETURN
 
*         IF *DC=SO* OR *DC=SS*, VALIDATE CALLER.
 
 DDC2     LDD    CM+2
          LMC    2RSO
          ZJN    DDC3        IF *DC=SO*
          LMC    2RSO&2RSS
          NJN    DDC7        IF NOT *DC=SS*
 DDC3     LDD    ST          VALIDATE CALLER
          LPC    SJFL+SYFL
          NJN    DDC7        IF *SYOT* OR *SSJ=*
          ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 
*         SET DEFAULT DISPOSITION CODE.
 
 DDC4     LDC    TSFN-TSFNL  PRESET TABLE INDEX
          STD    T1
 DDC5     LDN    TSFNL       ADVANCE INDEX
          RAD    T1
          RJM    CFN         COMPARE FILE NAMES
          ZJN    DDC6        IF FILE FOUND
          PJN    DDC5        IF NO FILE NAME MATCH
          ERROR  /ERR/EC07   * DSP - INCORRECT DISPOSITION CODE.*
 
 DDC6     LDM    4,T1        SET DEFAULT DISPOSITION
          STD    CM+2
 
*         VALIDATE DISPOSITION CODE.
 
 DDC7     LDC    TODC-TODCL  SET TABLE INDEX
          STD    T1
 DDC8     LDN    TODCL       ADVANCE INDEX
          RAD    T1
          LDI    T1
          NJN    DDC9        IF NOT END OF TABLE
          LDD    CM+2
          LMC    2RSC
          ZJP    DDCX        IF *DC=SC*
          ERROR  /ERR/EC07   * DSP - INCORRECT DISPOSITION CODE.*
 
 DDC9     LMD    CM+2
          NJN    DDC8        IF NO MATCH
          AOD    T1          SET NEW QUEUE TYPE
          LDI    T1          SAVE TABLE ENTRY FOR ROUTINE *SDC*
          STM    SDCA
          SHN    -11
          LMK    INQT
          NJP    DDC17       IF NOT INPUT FILE
 
*         VALIDATE FORCED JSN, IF ANY.
 
          LDD    FB+1
          LPN    FRFJ
          ZJP    DDC15       IF FORCED JSN FLAG NOT SPECIFIED
          STM    FSJS        SET FORCED JSN
          LMD    FB+1        FORCE IMMEDIATE ROUTE FOR INPUT FILE
          ERRNZ  FRFJ-FRDR   (CODE ASSUMES FRFJ AND FRDR ARE SAME FLAG)
          STD    FB+1
          LDD    OT
          LMK    SYOT
          NJP    DDC16       IF NOT SYSTEM ORIGIN
          LDK    EJTP        READ EJT POINTER WORD
          CRD    CM
          LDN    0           START SEARCH AT ORDINAL 0
          STD    CM
 DDC10    LDD    CM
          SBD    CM+2
          PJN    DDC12       IF END OF EJT
          SFA    EJT,CM      GET EJT ENTRY
          ADK    JSNE
          CRD    CN
          AOD    CM          INCREMENT EJT ORDINAL
          LDD    CN
          ZJN    DDC10       IF BLANK ENTRY
          LMM    FJSN
          NJN    DDC10       IF NO MATCH ON FIRST 2 CHARACTERS
          LDD    CN+1        COMPARE REMAINDER OF JSN
          LMM    FJSN+1
          NJN    DDC10       IF NOT SAME JSN
 DDC11    ERROR  /ERR/EC50   * DSP - JSN ALREADY IN SYSTEM.*
 
 DDC12    LDC    TSSN        CHECK IF JSN MATCHES A SUBSYSTEM NAME
          STD    T1
 DDC13    LDI    T1          SEARCH TABLE FOR SUBSYSTEM
          LMM    FJSN
          NJN    DDC14       IF NO MATCH
          LDM    1,T1
          LMM    FJSN+1
          ZJN    DDC11       IF MATCH
 DDC14    LDN    TSSNE       GET NEXT TABLE ENTRY
          RAD    T1
          LMC    TSSNL
          NJN    DDC13       IF NOT END OF TABLE
          RJM    VJS         VALIDATE JSN SPECIFICATION
 DDC15    LDM    FSOT        CHECK FOR FORCED ORIGIN TYPE
          LMK    IAOT
          LPN    17
          NJN    DDC17       IF NOT INTERACTIVE ORIGIN TYPE
 DDC16    ERROR  /ERR/EC40   * DSP - INCORRECT ORIGIN TYPE.*
 
 DDC17    LDC    DCFL        SET DISPOSITION CODE SPECIFIED FLAG
          RAD    ST
          LDD    CM+2        SAVE FOR ACCOUNTING MESSAGE
          STM    SDCB
          LJM    DDCX        RETURN
 TODC     SPACE  4,10
**        TODC - TABLE OF DEFAULT ROUTING INFORMATION.
*
*T        12/ DC, 6/ QT, 3/ EC, 3/ IC.
*
*         DC = DISPOSITION CODE. (DISPLAY CODE)
*         EC = EXTERNAL CHARACTERISTICS FOR QFT.
*         IC = INTERNAL CHARACTERISTICS FOR QFT.
*         QT = QUEUE TYPE FOR SPECIFIED DISPOSITION CODE.
 
 
 IN$      EQU    1           ALLOW *DC=IN*
 NO$      EQU    1           ALLOW *DC=NO*
 TO$      EQU    1           ALLOW *DC=TO*
 TT$      EQU    1           ALLOW *DC=TT*
 SO$      EQU    1           ALLOW *DC=SO*
 SS$      EQU    1           ALLOW *DC=SS*
 
 TODC     BSS    0
          DRIN   PR,DFEX,DCIC,LPQF           ANY PRINTER
 TODCL    EQU    *-TODC                      LENGTH OF TABLE ENTRY
          DRIN   LP,DFEX,DCIC,LPQF           ANY PRINTER
          DRIN   P1,DFEX,DCIC,0              505 PRINTER
          DRIN   P2,DFEX,DCIC,P2QF           512 PRINTER
          DRIN   LQ,DFEX,DCIC,0              512 PRINTER
          DRIN   LR,DFEX,DCIC,LRQF           580-12 PRINTER
          DRIN   LS,DFEX,DCIC,LSQF           580-16 PRINTER
          DRIN   LT,DFEX,DCIC,LTQF           580-20 PRINTER
          DRIN   LX,DFEX,DCIC,LXQF           5870 NIP
          DRIN   LY,DFEX,DCIC,LYQF           5970 NIP
          DRIN   SB,PBFR,BNIC,PUQF           PUNCH BINARY
          DRIN   P8,P8FR,BNIC,PUQF           PUNCH 80 COLUMN
          DRIN   PB,PBFR,BNIC,PUQF           PUNCH BINARY
          DRIN   TT,DFEX,DFEX,TQQF           TERMINAL OUTPUT
          DRIN   SS,DFEX,DFEX,SQQF           STATION OUTPUT
          DRIN   WT,DFEX,DFEX,TQQF           WAIT QUEUE
 TODCA    EQU    *
          DRIN   PU,PHFR,DCIC,PUQF           PUNCH CODED
 TODCB    EQU    *
          DRIN   PH,PHFR,DCIC,PUQF           PUNCH CODED
          DRIN   FR,T6EX,0,FRQF              MICROFILM PRINT
          DRIN   FL,T6EX,0,FLQF              MICROFILM PLOT
          DRIN   PL,T6EX,0,PLQF              PLOTTER
          DRIN   HR,T6EX,0,HRQF              HARD COPY PRINT
          DRIN   HL,T6EX,0,HLQF              HARD COPY PLOT
          DRIN   IN,0,0,INQF                 INPUT
          DRIN   NO,0,0,NOQF                 INPUT NO OUTPUT
*         DRIN   SC,0,0,LOFT                 SCRATCH
          DRIN   TO,0,0,TOQF                 INPUT, TERMINAL OUTPUT
          DRIN   SO,0,0,SOQF                 INPUT, STATION OUTPUT
          CON    0                END OF TABLE
 TSFN     SPACE  4,10
**        TSFN - TABLE OF SPECIAL FILE NAMES AND DISPOSITION CODES.
*
*T        48/ FILE NAME ,12/ DC
*
*         DC = DISPOSITION CODE.
 
 
 TSFN     BSS    0
          VFD    48/0LOUTPUT,12/2LLP
 TSFNL    EQU    *-TSFN      LENGTH OF ENTRY
          SPACE  4,10
          VFD    48/0LPUNCH,12/2LPU
          VFD    48/0LPUNCHB,12/2LSB
          VFD    48/0LP8,12/2LP8
          VFD    48/0,12/2LSC
 TSSN     SPACE  4,10
**        TABLE OF SUBSYSTEM NAMES.
*
*         ENTRY FORMAT.
*
*T        24/ NAME
*
*         NAME = 3-CHARACTER SUBSYSTEM NAME + BLANK.
 
 
 TSSN     BSS    0
          LIST   G
 .SSN     HERE
          LIST   *
 TSSNL    BSS    0           END OF TABLE
 FFQ      SPACE  4,20
**        FFQ - FIND FILE TO QUEUE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FN - FN+4) = (UN - UN+4) = FILE NAME.
*                (ST) = STATUS WORD.
*
*         EXIT   (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                (FA) = NFL FNT ENTRY OFFSET.
*                (ST) = SET, IF FILE CREATION NEEDED.
*                (LFAL) = LOCAL FILE ACCESS LEVEL.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                FILE NAME ERROR.
*                IMMEDIATE ROUTE - NO FILE.
*                CANNOT ROUTE JOB INPUT FILE.
*                I/O SEQUENCE ERROR.
*                INCORRECT FILE MODE.
*                INVALID FILE TYPE.
*
*         USES   ST, T1, CM - CM+4, FN - FN+4.
*
*         CALLS  SAF, SFB, VFN, VMS.
*
*         MACROS ERROR, NFA.
 
 
 FFQ      SUBR               ENTRY/EXIT
          LDC    **          FNT ADDRESS
 FFQA     EQU    *-1         (SET BY PRESET)
          RJM    SAF         SEARCH FOR ASSIGNED FILE
          NJN    FFQ3        IF FILE FOUND
          RJM    VFN         VERIFY FILE NAME
          NJN    FFQ1        IF VALID FILE NAME
          ERROR  /ERR/EC01   * DSP - FILE NAME ERROR.*
 
 FFQ1     LDC    LOFT*100    SET LOCAL FILE FOR *DDC*
          STD    FN+4
          LDN    FCFL        SET FILE CREATION NEEDED
          RAD    ST
          LJM    FFQ10       CHECK FOR DEFERRED ROUTE
 
 FFQ3     LDD    FA
          LMC    FNTN
          NJN    FFQ4        IF NOT JOB INPUT FILE
          ERROR  /ERR/EC16   * DSP - CANNOT ROUTE JOB INPUT FILE.*
 
 FFQ4     RJM    SFB         SET FILE BUSY
          ZJN    FFQ5        IF FILE SET BUSY
          LDN    0           CLEAR NFL FNT OFFSET
          STD    FA
          ERROR  /ERR/EC31   * DSP - I/O SEQUENCE ERROR.*
 
*         CHECK IF FILE CAN BE ROUTED.
 
 FFQ5     NFA    FA,R        READ FNT FROM NFL
          ADK    FNTL
          CRD    FN
          ADN    FSTL-FNTL
          CRD    FS
          ADN    FUTL-FSTL
          CRD    CM
          LDD    CM+2        SAVE LOCAL FILE ACCESS LEVEL
          LPN    7
          STM    LFAL
          LDD    FN+3        CHECK FILE MODE
          SHN    21-2
          PJN    FFQ7        IF NOT EXECUTE ONLY MODE
          ERROR  /ERR/EC36   * DSP - INCORRECT FILE MODE.*
 
 FFQ7     SHN    21-0-21+2
          PJN    FFQ7.1      IF FILE NOT LOCKED
          LDC    LKFL        SET *FILE LOCKED* FLAG
          RAD    ST
 
*         VALIDATE FILE TYPE.
 
 FFQ7.1   LDD    FN+4        SET CURRENT FILE TYPE
          SHN    -6
          STD    T1
          LDC    SHNI+21
          SBD    T1
          STM    FFQB
          LDC    QMSK
          SHN    21-0
 FFQB     EQU    *-1         (MODIFIED *SHN* INSTRUCTION)
          MJN    FFQ8        IF VALID FILE TYPE
          ERROR  /ERR/EC03   * DSP - INCORRECT FILE TYPE.*
 
*         VALIDATE FILE-S CURRENT MASS STORAGE ASSIGNMENT.
 
 FFQ8     LDD    FS          CHECK FST ENTRY
          ZJN    FFQ10       IF NULL ENTRY
          RJM    VMS         VALIDATE MASS STORAGE FILE
          LDD    FS+1
          ZJN    FFQ10       IF NULL FILE
          LDD    FS+2
          ZJN    FFQ10       IF NULL FILE
 FFQ9     LJM    FFQX        RETURN
 
*         FOR A NULL OR NONEXISTENT FILE, ONLY ALLOW A DEFERRED ROUTE.
 
 FFQ10    LDD    FB+1
          LPN    FRDR
          NJN    FFQ9        IF DEFERRED ROUTE
          ERROR  /ERR/EC06   * DSP - IMMEDIATE ROUTING - NO FILE.*
 
 
 INFT     DECMIC INFT
 QFFT     DECMIC QFFT
 LOFT     DECMIC LOFT
 
 QMSK     EQU    1S"INFT"+1S"QFFT"+1S"LOFT"
 VJS      SPACE  4,10
**        VJS - VALIDATE JSN SPECIFICATION.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FJSN - FJSN+1) = FORCED JSN TO VALIDATE.
*
*         EXIT   JSN VALIDATED.
*
*         ERROR  TO *ERR* IF AN INVALID JSN WAS SPECIFIED.
*
*         MACROS ERROR.
 
 
 VJS      SUBR               ENTRY/EXIT
          LDM    FJSN        VALIDATE SPECIFIED JSN
          SHN    -6
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          PJN    VJS1        IF CHARACTER .GT. *9*
          LDM    FJSN
          LPN    77
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          PJN    VJS1        IF CHARACTER .GT. *9*
          LDM    FJSN+1
          SHN    -6
          ZJN    VJS1        IF CHARACTER .LT. *A*
          SBN    1R9+1
          MJN    VJSX        IF CHARACTER .LE. *9*
 VJS1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 VUL      SPACE  4,10
**        VUL - VALIDATE USER LIMITS.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                TOO MANY DEFERRED BATCH JOBS.
*
*         USES   T0 - T4, CM - CM+4.
*
*         CALLS  CDB, DBI, GEA.
*
*         MACROS ERROR.
 
 
 VUL      SUBR               ENTRY/EXIT
          LDD    FB
          SHN    21-13
          MJN    VULX        IF JOB TERMINATION AND VALIDATION DISABLED
          LDD    FB+1
          SHN    21-0
          MJN    VULX        IF DEFERRED ROUTE
          LDM    CUAV        CHECK USER ACCESS
          ZJN    VULX        IF USER SYSTEM PRIVILEGES
          RJM    GEA         GET EJT ADDRESS
          CRD    T0
          RJM    CDB         COUNT DEFERRED BATCH JOBS
          LDD    CP          GET *DB* FIELD FROM CONTROL POINT
          ADN    ALMW
          CRD    CM
          LDD    CM+1
          RJM    DBI         GET DEFERRED BATCH LIMITS
          MJN    VULX        IF UNLIMITED
          SBD    T4
          SBN    1
          PJN    VULX        IF LIMIT NOT REACHED
          ERROR  /ERR/EC33   * DSP - TOO MANY DEFERRED BATCH JOBS.*
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCDB
 DBI$     SET    1           DEFINE DEFERRED BATCH CONVERSION
*CALL     COMPCVI
 SAF$     SET    1           SELECT *COMPSAF* SEARCH FOR ASSIGNED FILE
*CALL     COMPSAF
*CALL     COMPSFB
*CALL     COMPVFN
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE.
*
*         EXIT   (FB - FB+1) = FLAG BITS.
*                (FN - FN+4) = (UN - UN+4) = FILE NAME.
*                (DDCB) = DISPOSITION CODE.
*                (EBIT - EBIT+1) = EXTENDED PARAMETER BLOCK FLAG BITS.
*                (SFDA) = FORCED ORIGIN TYPE INSTRUCTION.
*                (VULA) = SYSTEM ORIGIN PRIVILEGES FLAG.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT *DSP* REQUEST.
*                COMPLETE BIT ALREADY SET.
*                INCORRECT ORIGIN TYPE.
*
*         USES   ER, FA, QA, ST, T7, CM - CM+4, CN - CN+4,
*                FB - FB+1, FN - FN+4.
*
*         CALLS  CRS, CUA, GFA, IFP, VCA, VLD, VTA.
*
*         MACROS ERROR, SFA.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0           CLEAR ERROR STATUS AND FNT POINTERS
          STD    ER
          STD    ST
          STD    FA
          STD    QA
          STD    FB
          STD    FB+1
          RJM    IFP         INITIALIZE *SFA* CALL
          RJM    CUA         CHECK USER ACCESS
          STM    CUAV
 
*         CHECK AUTO RECALL STATUS.
 
          LDD    CP          READ SUBSYSTEM ID
          ADN    JCIW
          CRD    CM
          ADN    AACW-JCIW
          CRD    FS
          ADN    SEPW-AACW   GET SPECIAL ENTRY POINT WORD
          CRD    CN
          LDC    LSSI
          SBD    CM+2
          MJN    PRS1        IF SUBSYSTEM
          LDN    SSFL        FLAG NO SUBSYSTEM
          RAD    ST
          RJM    CRS         CHECK RECALL STATUS
          ZJN    PRS3        IF NOT CALLED WITH RECALL
 PRS1     LDD    CN          CHECK ENTRY POINTS
          SHN    21-2
          PJN    PRS2        IF NOT *SSJ=*
          LDC    SJFL        FLAG *SSJ=* PROGRAM
          RAD    ST
 
*         CHECK ADDRESS OF ARGUMENT TABLE.
 
 PRS2     LDD    IR+3        CHECK PARAMETER ADDRESS
          LPN    37
          SHN    14
          LMD    IR+4
          RJM    VCA         VALIDATE ADDRESS
          ZJN    PRS3        IF NOT VALID ADDRESS
          ADN    DPBL-1      CHECK IF PARAMETER BLOCK IS WITHIN FL
          RJM    VCA         VALIDATE ADDRESS
          NJN    PRS4        IF VALID ADDRESS
 PRS3     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 
 PRS4     ADN    EPBL-DPBL   CHECK IF EXTENDED BLOCK IS WITHIN FL
          RJM    VCA
          NJN    PRS5        IF ENOUGH SPACE FOR EXTENDED BLOCK
          AOM    PRSA        SET *NOT ENOUGH SPACE* FLAG
 
*         READ FILE NAME AND FLAG BITS FROM ARGUMENT TABLE.
 
 PRS5     RJM    GFA         READ FIRST WORD OF PARAMETER BLOCK
          CRD    FN
          ADN    1           READ FLAG BITS
          CRD    CM
          ADN    3           GET FNT ADDRESS
          CRD    CN
          LDD    CN+4
          STM    FFQA
          LDD    CM+1        SAVE INPUT FLAGS
          STM    INFL
          LDD    CM+3        SAVE FLAG BITS
          LPN    77
          STD    FB
          LDD    CM+4
          STD    FB+1
          SHN    21-6
          MJN    PRS6        IF EXTENDED BLOCK SPECIFIED
          LJM    PRS15       BYPASS EXTENDED BLOCK PROCESSING
 
*         SAVE FLAG BITS FOR EXTENDED PARAMETER BLOCK.
 
 PRS6     LDN    0
*         LDN    1           (NOT ENOUGH SPACE FOR EXTENDED BLOCK)
 PRSA     EQU    *-1
          NJN    PRS7        IF NOT ENOUGH SPACE
          RJM    GFA         GET EXTENDED FLAG BITS
          ADN    7
          CRD    CN
          LDD    CN+3
          LPN    77
          STM    EBIT
          LDD    CN+4
          STM    EBIT+1
          LPK    EFOU+EFCU+EFSP+EFNV+EFSC+EFEP+EFRQ+EFDS+EFCH
          ZJN    PRS8        IF NO PRIVILEGED FLAG BITS SET
          LDD    ST
          SHN    21-7
          MJN    PRS7.1      IF CALLER IS *SSJ=*
          SHN    21-0-21+7
          PJN    PRS7.1      IF CALLER IS SUBSYSTEM
 PRS7     LJM    PRS3        * DSP - INCORRECT REQUEST.*
 
 PRS7.1   LDM    EBIT+1      CHECK FOR SUBSYSTEM PROCESSING
          LPN    EFSP
          ZJN    PRS8        IF SUBSYSTEM PROCESSING BIT NOT SET
          LDD    ST          FLAG SUBSYSTEM
          SCN    SSFL
          STD    ST
 
*         VALIDATE REMOTE TEXT ADDRESSES.
 
 PRS8     RJM    GFA         CHECK IMPLICIT TEXT ADDRESS
          ADN    10
          CRD    CM
          RJM    VTA         VALIDATE TEXT ADDRESS
          STM    IRTL        SAVE LENGTH OF IMPLICIT TEXT
          ZJN    PRS10       IF NO IMPLICIT TEXT SPECIFIED
          LDD    ST          CHECK FOR *SSJ=*
          SHN    21-7
          PJN    PRS7        IF NOT *SSJ=*
          LDD    FB+1
          SHN    21-0
          PJN    PRS10       IF NOT DEFERRED ROUTE
 PRS9     ERROR  /ERR/EC13   * DSP - DEFERRED ROUTING NOT ALLOWED.*
 
 PRS10    RJM    GFA         CHECK EXPLICIT TEXT ADDRESS
          ADN    11
          CRD    CM
          RJM    VTA         VALIDATE TEXT ADDRESS
          STM    ERTL        SAVE LENGTH OF EXPLICIT TEXT
          ZJN    PRS11       IF NO EXPLICIT TEXT SPECIFIED
          LDD    FS+3
          SHN    21-5
          PJN    PRS12       IF NOT VALIDATED TO SPECIFY LID
          LDD    FB+1
          SHN    21-0
          MJN    PRS9        IF DEFERRED ROUTE
 
*         PROCESS DATA DECLARATION.
 
 PRS11    LDM    EBIT+1
          SHN    21-0
          PJN    PRS15       IF DATA DECLARATION NOT SPECIFIED
          LDD    FS+3
          SHN    21-5
          MJN    PRS13       IF VALIDATED TO SPECIFY LID
 PRS12    LJM    PRS18       * DSP - USER ACCESS NOT VALID.*
 
 PRS13    LDD    FB+1
          SHN    21-0
          MJN    PRS9        IF DEFERRED ROUTE
          RJM    GFA         GET DATA DECLARATION VALUE
          ADN    7
          CRD    CM
          LDD    CM          SAVE DATA DECLARATION
          STM    DDEC
          LDN    TODDL
          STD    T1
 PRS14    LDD    CM
          LMM    TODD-1,T1
          ZJN    PRS15       IF LEGAL DATA DECLARATION
          SOD    T1
          NJN    PRS14       IF MORE LEGAL VALUES TO CHECK
          ERROR  /ERR/EC14   * DSP - INCORRECT DATA DECLARATION.*
 
*         CLEAR ERROR CODE IN PARAMETER BLOCK.
 
 PRS15    LDD    FN+3        CLEAR ERROR CODE
          SCN    77
          STD    FN+3
          LDD    FN+4        CHECK COMPLETE BIT
          STM    DSPC
          LPN    1
          ZJN    PRS16       IF COMPLETE BIT CLEARED
          ERROR  /ERR/EC17   * DSP COMPLETE BIT ALREADY SET.*
 
*         PROCESS *SLID*/*DLID* PARAMETERS.
 
 PRS16    LDD    FB+1
          SHN    21-3
          MJN    PRS17       IF SLID/DLID SPECIFIED
          LJM    PRS21       SET OUTPUT FILE DESTINATION
 
 PRS17    LDD    FS+3
          SHN    21-5
          MJN    PRS19       IF VALIDATED TO SPECIFY SLID/DLID
 PRS18    ERROR  /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
 
 PRS19    RJM    GFA         GET SLID/DLID
          ADN    2
          CRD    CN
          LDD    CN+1
          SCN    77
          SHN    6
          LMD    CN
          SHN    6
          ZJN    PRS20       IF SLID NOT SPECIFIED
          RJM    VLD         VALIDATE SLID
          LDC    SLFL        SET *SLID SPECIFIED* FLAG
          RAD    ST
 PRS20    LDD    CN+1
          LPN    77
          SHN    14
          LMD    CN+2
          ZJN    PRS21       IF DLID NOT SPECIFIED
          RJM    VLD         VALIDATE DLID
          LDC    DLFL        SET *DLID SPECIFIED* FLAG
          RAD    ST
 
*         SET OUTPUT FILE DESTINATION, IF END OF JOB.
 
 PRS21    LDD    CP          DETERMINE IF END OF JOB
          ADK    TFSW
          CRD    CM
          LDD    CM
          STM    EJTO        SAVE EJT ORDINAL
          SFA    EJT
          ADK    SCHE
          CRD    T3
          LDD    CP          GET END OF JOB DESTINATION
          ADN    EOJW
          CRD    CN
          RJM    GFA
          ADN    1
          CRD    CM
          LDD    T3+2
          LPC    3000
          LMK    NOTM*1000
          ZJN    PRS22       IF NOT END OF JOB
          LDD    CN          SET END OF JOB DESTINATION
          SHN    -6
          LPN    7
          STD    T7
          LDM    TOQD,T7     GET CORRESPONDING DISPOSITION CODE
          STD    T7
          LDI    T7
          STM    TSFN+TSFNL-1
          LDD    CM          SET TERMINATION FLAG BITS
          SCN    77
          RAD    FB
 PRS22    LDD    CM+2        SET DISPOSITION CODE
          STM    DDCB
 
*         SET DEFAULT PUNCH MODE IN DISPOSITION TABLE.
 
          LDD    CP          CHECK KEYPUNCH MODE OF JOB
          ADN    SNSW
          CRD    CM
          LDD    CM
          SHN    21-12
          PJN    PRS23       IF O26
 .A       IF     DEF,PU$
          LDM    TODCA+1
          SCN    70
          LMN    P9FR*10
          STM    TODCA+1
 .A       ENDIF
 .B       IF     DEF,PH$
          LDM    TODCB+1
          SCN    70
          LMN    P9FR*10
          STM    TODCB+1
 .B       ENDIF
 
*         CHECK FOR FORCED ORIGIN TYPE.
 
 PRS23    LDM    EJTO        GET ORIGIN TYPE FROM EJT
          SFA    EJT
          ADK    SCLE
          CRD    CM
          LDD    CM          SAVE ORIGIN TYPE OF CALLING JOB
          SCN    60
          STM    JBOT
          LPN    17
          STD    OT
          LMK    SYOT
          NJN    PRS26       IF NOT SYSTEM ORIGIN
          LDN    SYFL        SET *SYOT* CP STATUS
          RAD    ST
          LDD    FN+4
          SHN    21-13
          PJN    PRS26       IF NOT FORCED ORIGIN FLAG
          SHN    -21+13-1
          LPN    77
          STD    T7          SAVE FORCED ORIGIN CODE
          SBN    MXOT
          PJN    PRS24       IF OUT OF RANGE
          LDM    TOOT,T7
          NJN    PRS25       IF LEGAL ORIGIN TYPE
 PRS24    ERROR  /ERR/EC40   * DSP - INCORRECT ORIGIN TYPE.*
 
 PRS25    LDD    T7
          STM    FSOT        SAVE FORCED ORIGIN TYPE
 
*         CHECK FOR FORCED SERVICE CLASS.
 
 PRS26    RJM    GFA         GET FORCED SERVICE CLASS FLAG
          ADN    1
          CRD    CM
          ADN    3           GET FORCED SERVICE CLASS
          CRD    CN
          LDD    CM+3
          SHN    21-10
          PJN    PRS29       IF NOT FORCED SERVICE CLASS FLAG
          LCN    0           PRESET USER DEFAULT SELECTED
          STD    T7
          LDD    CN+1
          LMC    2RDF
          ZJN    PRS28       IF USER DEFAULT SELECTED
          LDN    MXSC-1      SET TABLE INDEX
          STD    T7
 PRS27    LDM    TSCC,T7
          LMD    CN+1
          ZJN    PRS28       IF MATCH
          SOD    T7          DECREMENT INDEX
          NJN    PRS27       IF NOT END OF TABLE
          ERROR  /ERR/EC11   * DSP - UNDEFINED SERVICE CLASS.*
 
 PRS28    LDD    T7          SAVE FORCED SERVICE CLASS
          STM    FSSC
 
*         PROCESS SUBSYSTEM INITIATION PARAMETERS.
 
 PRS29    RJM    GFA         GET POSSIBLE SUBSYSTEM NAME / FORCED JSN
          ADN    6
          CRD    CN
          LDD    CN+3        SAVE JSN
          LPN    77
          SHN    14
          LMD    CN+4
          SHN    -6+22
          STM    FJSN
          SHN    -6
          SCN    77
          LMN    1R          SPACE FILL JSN
          STM    FJSN+1
          LDM    EBIT+1      CHECK SUBSYSTEM/CONTROL POINT SELECTION
          LPN    EFCP
          ZJN    PRS30       IF NO SUBSYSTEM/CONTROL POINT SELECTED
          LDN    NCPL        GET NUMBER OF CONTROL POINTS IN SYSTEM
          CRD    CM
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    12
          CRD    CN          READ PARAMETERS
          LDD    CN+3        CHECK CONTROL POINT NUMBER
          LPN    77
          SBD    CM+1
          ZJN    PRS29.1     IF LAST CONTROL POINT NUMBER
          PJN    PRS31       IF INCORRECT CONTROL POINT NUMBER
 PRS29.1  ADD    CM+1
          NJN    PRS29.2     IF CONTROL POINT SELECTED
          LDN    77          SELECT ANY AVAILABLE CONTROL POINT
 PRS29.2  STM    SBCP        PRESET CONTROL POINT SELECTION
          LDD    CN+4        CHECK SSID
          ZJN    PRS31       IF NOT SPECIFIED
          STM    SBID        PRESET SSID
          LDD    FB+1
          SHN    21-13
          PJN    PRS31       IF SUBSYSTEM INITIATION NOT SET
 PRS30    LJM    PRSX        RETURN
 
 PRS31    LJM    PRS3        * DSP - INCORRECT REQUEST *
 TSCC     SPACE  4,10
**        TSCC - TABLE OF SERVICE CLASS CODES.
*
*         INDEXED BY SERVICE CLASS.
*
*T        12/ SVC
*
*                SVC = SERVICE CLASS IN DISPLAY CODE.
 
 
 TSCC     BSS    0
          LOC    0
 
          DATA   H+"NMSC"+
 
          LOC    *O
 VLD      SPACE  4,15
**        VLD - VALIDATE LID.
*
*         ENTRY  (A) = LID.
*
*         EXIT   TO *ERR* IF INCORRECT LID SPECIFIED.
*
*         CALLS  VID.
*
*         MACROS ERROR.
 
 
 VLD      SUBR               ENTRY/EXIT
          MJN    VLD1        IF NOT SPECIAL CODE
          SBN    MXLC
          MJN    VLDX        IF VALID SPECIAL CODE
          ADN    MXLC
 VLD1     RJM    VID         VALIDATE LOGICAL ID
          NJN    VLDX        IF VALID LID FOUND
          ERROR  /ERR/EC15   * DSP - INCORRECT LID.*
 VTA      SPACE  4,15
**        VTA - VALIDATE TEXT ADDRESS.
*
*         ENTRY  (CM+3 - CM+4) = ADDRESS OF REMOTE TEXT.
*
*         EXIT   (A) = LENGTH OF REMOTE TEXT (IN CM WORDS).
*                (A) = 0 IF NO TEXT.
*                TO *ERR* IF TEXT OUTSIDE FL, OR IF BAD TEXT LENGTH.
*
*         USES   T3, CN - CN+4.
*
*         CALLS  DV5, VCA.
*
*         MACROS ERROR.
 
 
 VTA      SUBR               ENTRY/EXIT
          LDD    CM+3
          LPN    77
          SHN    14
          LMD    CM+4
          ZJN    VTAX        IF NO TEXT
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          ZJN    VTA1        IF TEXT NOT WITHIN FL
          SHN    -6+22       READ LENGTH OF TEXT
          ADD    RA
          SHN    6
          CRD    CN
          LDD    CN+4        CHECK TEXT LENGTH
          ZJN    VTA1        IF INCORRECT LENGTH
          ADC    -257D
          PJN    VTA1        IF INCORRECT LENGTH
          ADC    257D+1      ROUND UP
          SHN    -1          CONVERT CHARACTER LENGTH TO CM WORDS
          RJM    DV5
          STD    T3
          LDD    CM+3        ENSURE ENTIRE TEXT IS WITHIN FL
          LPN    77
          SHN    14
          LMD    CM+4
          ADD    T3
          RJM    VCA         VALIDATE ADDRESS
          ZJN    VTA1        IF TEXT NOT WITHIN FL
          LDD    T3          RETURN LENGTH OF TEXT
          LJM    VTAX        RETURN
 
 VTA1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 TODD     SPACE  4,10
**        TODD - TABLE OF LEGAL DATA DEFINITIONS.
 
 
 TODD     BSS    0
          CON    2LC6
          CON    2LC8
          CON    2LUS
          CON    2LUU
 TODDL    EQU    *-TODD
 TOOT     SPACE  4,10
**        TOOT - TABLE OF ORIGIN TYPES.
*
*T        12/FO
*
*         FO = IF NONZERO, THIS ORIGIN TYPE IS VALID AS A
*                ORIGIN TYPE FOR *SYOT* CALLERS.
 
 
 TOOT     INDEX
          INDEX  SYOT,2
          INDEX  BCOT,2
          INDEX  EIOT,2
          INDEX  IAOT,2
          INDEX  MXOT
 TOQD     SPACE  4,10
**        TOQD - TABLE OF QUEUE DESTINATIONS.
*
*T        12/DC
*
*         DC= DESTINATION CODE FOR SPECIFIED QUEUE
 
 
 TOQD     INDEX
          INDEX  QOJT,(=C*LP*)  QUEUE ALL OUTPUT
          INDEX  NOJT,(=C*SC*)  DROP ALL OUTPUT
          INDEX  TTJT,(=C*TT*)  OUTPUT TO INTERACTIVE QUEUE
          INDEX  SSJT,(=C*SS*)  OUTPUT TO STATION OUTPUT QUEUE
          INDEX  MXJT
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPCRS
*CALL     COMPCUA
 RND$     EQU    1           FORCE ROUNDING ON *DV5* CONVERSION
*CALL     COMPDV5
          SPACE  4,10
 IFP      HERE               REMOTE INITIALIZATION CODE
          SPACE  4,10
          OVERFLOW  PPFW,EPFW
          OVERLAY  (FILE DESTINATION ROUTINES.),OVL4
 CAA      SPACE  4,10
**        CAA - CHECK ALTERNATE FAMILY/USER ACCESS.
*
*         ENTRY  (ST) = STATUS WORD.
*
*         EXIT   TO *ERR* IF ACCESS NOT ALLOWED.
*
*         USES   T1, T4 - T7, CM - CM+4, UN - UN+4.
*
*         CALLS  CPN, RFN, SSJ.
*
*         MACROS ERROR.
 
 
 CAA      SUBR               ENTRY/EXIT
          LDD    ST
          LPN    SYFL
          NJN    CAAX        IF SYSTEM ORIGIN
          LDD    ST
          LPN    SSFL
          ZJN    CAAX        IF SUBSYSTEM PROCESSING
          RJM    SSJ         CHECK FOR *SSJ=* BLOCK
          ZJN    CAA1        IF NO *SSJ=* BLOCK
          ADK    AACS        READ ACCESS WORD
          CRD    T4
          ADK    UIDS-AACS
          UJN    CAA2        READ USER NAME
 
 CAA1     LDD    CP          READ ACCESS WORD
          ADK    AACW
          CRD    T4
          ADK    UIDW-AACW   READ USER NAME
 CAA2     CRD    UN          READ USER NAME
          LDD    T4+2
          SHN    21-6
          MJN    CAA3        IF ROUTE TO ALTERNATE FAMILY ALLOWED
          RJM    RFN         READ FAMILY NAME
          CRD    CM
          LDN    CM
          STD    T1          SET CURRENT FAMILY NAME ADDRESS
          LDC    FMSS        SET NEW FAMILY NAME ADDRESS
          RJM    CPN         COMPARE FAMILY NAMES
          ZJN    CAA3        IF SAME FAMILY
          ERROR  /ERR/EC46   * DSP - ALTERNATE FAMILY NOT ALLOWED.*
 
 CAA3     LDD    T4+2
          SHN    21-5
          MJN    CAA4        IF ROUTE TO ALTERNATE USER NAME ALLOWED
          LDN    UN          SET CURRENT USER NAME ADDRESS
          STD    T1
          LDC    ACSS        SET NEW USER NAME ADDRESS
          RJM    CPN         COMPARE USER NAMES
          NJN    CAA5        IF NOT SAME USER NAME
 CAA4     LJM    CAAX        RETURN
 
 CAA5     ERROR  /ERR/EC51   * DSP - ALTERNATE USER NOT ALLOWED.*
 CPN      SPACE  4,10
**        CPN - COMPARE NAMES.
*
*         ENTRY  (A) = ADDRESS OF SECOND NAME TO COMPARE.
*                (T1) = ADDRESS OF FIRST NAME TO COMPARE.
*
*         EXIT   (A) = 0 IF NAMES MATCH.
*                (A) .NE. 0 IF NAMES DO NOT MATCH.
*
*         USES   T1, T2.
 
 
 CPN      SUBR               ENTRY/EXIT
          STD    T2          SET SECOND NAME ADDRESS
          ADN    3           SET ADDRESS OF LAST BYTE
          STD    T0
 CPN1     LDI    T1
          LMI    T2
          NJN    CPNX        IF NO MATCH
          AOD    T1
          AOD    T2
          LMD    T0
          NJN    CPN1        IF MORE FULL BYTES TO CHECK
          LDI    T1
          LMI    T2
          SCN    77
          UJN    CPNX        RETURN WITH (A) = 0 IF MATCH
 VIF      SPACE  4,25
**        VIF - VERIFY INPUT FILE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FS - FS+4) = FST ENTRY.
*                (OT) = ORIGIN TYPE.
*
*         EXIT   (FN - FN+4) = FNT ENTRY FOR INPUT FILE.
*                (FS - FS+4) = FST ENTRY.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                ROUTE TO INPUT NOT IMMEDIATE.
*                IMMEDIATE ROUTE - NO FILE.
*                INCORRECT USER COMMAND.
*                JOB COMMAND ERROR.
*                INCORRECT JOB ABORT CODE.
*                INCORRECT SERVICE CLASS.
*                ALTERNATE FAMILY NOT ALLOWED.
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0VJ*.
*
*         USES   ST, T1, T3, T5 - T7, FN - FN+4, CM - CM+4, CN - CN+4,
*                UN - UN+4.
*
*         CALLS  CAA, CPN, CVS, GFA, GFM, GFO, RFN, RNS, SQO, SSJ, WMS,
*                *0VJ*.
*
*         MACROS ENDMS, ERROR, EXECUTE, SETMS.
 
 
 VIF      SUBR               ENTRY/EXIT
          LDM    INFL        CHECK INPUT FLAGS
          SHN    21-10
          MJP    VIF15       IF FORCED ABORT FLAG SET
 
*         READ FIRST SECTOR OF INPUT FILE.
 
          AOM    VIFA        INDICATE FIRST SECTOR OF FILE WAS READ
          LDD    FS          SET EQUIPMENT
          STD    T5
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          LDN    FSMS        SET FIRST SECTOR
          STD    T7
          SETMS  IO
          LDC    SBUF        READ NEXT SECTOR
          RJM    RNS
          ENDMS
          LDD    T1
          NJN    VIF2        IF FILE NOT EMPTY
          ERROR  /ERR/EC06   * DSP - IMMEDIATE ROUTING - NO FILE.*
 
*         VALIDATE JOB COMMAND AND USER COMMAND.
 
 VIF2     LDC    STMT        SET COMMAND BUFFER ADDRESS
          STD    CN
          LDM    DLAT        SET DLID ATTRIBUTES
          STD    CN+1
          LDM    LFAL        SET LOCAL FILE ACCESS LEVEL
          STD    CN+2
          LDM    EBIT+1      PASS *DO NOT VALIDATE PASSWORD* FLAG
          LPN    EFNV
          STM    VIFE+1
          SHN    13-4
          ERRNZ  EFNV-20     CODE DEPENDS ON VALUE
          RAD    CN+2
          LDD    ST
          LPN    DSFL        IF FILE ROUTED BEFORE, CHECK ENCRYPTED PW
          SHN    12-1
          ERRNZ  DSFL-2      CODE DEPENDS ON VALUE
          RAD    CN+2
          LDM    EBIT+1
          LPK    EFEP
          ZJN    VIF3        IF ENCRYPTED PASSWORD NOT SPECIFIED
          LDD    CN+2        SET ENCRYPTED PW VALIDATION BIT
          LPC    5777
          LMC    2000
          STD    CN+2
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    14
          CRD    CM
          LDD    MA          MOVE PASSWORD TO SYSTEM SECTOR
          CWD    CM
          CRM    EPSS,ON
 VIF3     LDD    OT
          LMK    SYOT
          NJN    VIF3.1      IF NOT ROUTE TO *SYOT*
          LDC    1000        SET SYSTEM ORIGIN JOB BIT
          RAD    CN+2
 VIF3.1   LDD    ST
          LPK    DLFL
          NJN    VIF4        IF DLID SPECIFIED IN PARAMETER BLOCK
          LDD    ST
          LPK    DSFL
          ZJN    VIF3.2      IF NOT PREVIOUSLY ROUTED FILE
          LDM    DLID
          ADM    DLID+1
          NJN    VIF4        IF DLID NONZERO
 VIF3.2   STD    CN+1        CLEAR DLID ATTRIBUTES
 VIF4     EXECUTE 0VJ,OVL3   VERIFY JOB/USER COMMANDS
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    ST
          LPN    SSFL
          ZJN    VIF4.1      IF SUBSYSTEM CALLER
          LDD    CP          USE DEFERRED BATCH LIMIT OF OWNER USER
          ADK    ALMW
          CRD    CM
          LDD    CM+1
          LMM    VASS+AHMT*5+1
          SCN    70
          LMD    CM+1
          STM    VASS+AHMT*5+1
 VIF4.1   LDD    FN+4
          LPN    77
          LMC    INFT*100
          STD    FN+4
          LDD    CN
          ZJN    VIF5        IF DLID NOT SPECIFIED
          STM    DLAT        SET DLID ATTRIBUTES
          LJM    VIF6.3      ALLOW ALTERNATE FAMILY/USER WITH DLID
 
 VIF5     RJM    CAA         CHECK ALTERNATE FAMILY/USER ACCESS ALLOWED
 
*         VERIFY THAT THE FAMILY AND THE USER INDEX HAVE NOT BEEN
*         CHANGED IF THE *DO NOT VALIDATE PASSWORD* FLAG IS SET.
 
 VIFE     LDC    **          (*DO NOT VALIDATE PASSWORD* FLAG)
          ZJN    VIF6.3      IF PASSWORD VALIDATION REQUIRED
          RJM    RFN         READ FAMILY NAME
          CRD    CM
          LDN    CM          SET CURRENT FAMILY NAME ADDRESS
          STD    T1
          LDC    FMSS        ADDRESS OF FAMILY IN SYSTEM SECTOR
          RJM    CPN         COMPARE FAMILY NAMES
          NJN    VIF6.2      IF DIFFERENT FAMILIES
          RJM    SSJ         CHECK FOR *SSJ=* BLOCK
          ZJN    VIF6        IF NO *SSJ=* BLOCK
          ADK    UIDS
          UJN    VIF6.1      CHECK USER INDEX
 
 VIF6     LDD    CP          GET CP USER INDEX
          ADK    UIDW
 VIF6.1   CRD    CM
          LDD    CM+3
          LMM    ACSS+3
          LPN    37
          SHN    14
          ADD    CM+4
          LMM    ACSS+4
 VIF6.2   NJP    VIF7        IF DIFFERENT USER INDEX
 
*         CHECK FOR USER COMMAND ERROR.
 
 VIF6.3   LDD    ER          CHECK ERROR STATUS
          LMN    3
          NJP    VIF9        IF NOT USER COMMAND ERROR
          LDM    DLAT
          SHN    21-13
          MJN    VIF6.4      IF HOST LID
          SHN    21-11-21+13
          PJN    VIF9        IF VALIDATION NOT REQUIRED FOR DLID
 VIF6.4   LDN    0           CLEAR DLID
          STM    IOSS+INSQ*5+1
          LDM    IOSS+INSQ*5+2
          LPN    77
          STM    IOSS+INSQ*5+2
          LDD    OT
          LMK    SYOT
          ZJN    VIF10       IF ROUTE TO *SYOT* - IGNORE USER COMMAND
          LDD    ST
          LPN    SSFL
          NJN    VIF6.5      IF NOT SUBSYSTEM CALL
          LDM    INFL
          SHN    21-7
          MJN    VIF9        IF FILE TO BE QUEUED
 VIF6.5   LDM    JASS        CHECK ERROR CODE
          LMN    UCIE
          ZJN    VIF8        IF USER SECURITY COUNT EXHAUSTED
 VIF7     ERROR  /ERR/EC34   * DSP - INCORRECT USER COMMAND.*
 
 VIF8     ERROR  /ERR/EC47   * DSP - USER SECURITY COUNT EXHAUSTED.*
 
 VIF9     LJM    VIF11       CHECK SERVICE CLASS
 
*         SET *SYSTEMX* LIMITS FOR SYSTEM JOBS WITH NO
*         OR INCORRECT USER COMMANDS.
 
 VIF10    LDD    MA          SAVE THE FNT ENTRY
          CWD    FN
          CRM    VIFB,ON
          LDN    1           GET DEFAULT FAMILY NAME
          RJM    GFM
          LDD    MA          SET UN/UI IN VALIDATION BLOCK
          CWM    VIFC,ON
          CWD    FN
          ADN    1
          CWM    VIFD,ON
          LDD    MA
          CRM    VASS+ACCN*5,ON
          SBN    1
          CRM    ACSS,ON     SET USER NAME
          CRM    FMSS,ON     SET FAMILY NAME
          CRM    VASS+AHMT*5,ON  SET UNLIMITED USER VALIDATION INDICES
          SBN    1
          CRM    VASS+AHDS*5,ON
          SBN    1
          CRM    VASS+AAWC*5,ON
          LDD    MA          RESTORE FNT ENTRY
          CWM    VIFB,ON
          SBN    1
          CRD    FN
 
*         CHECK FOR SERVICE CLASS SPECIFIED IN PARAMETER BLOCK.
 
 VIF11    LDD    FB+1
          SHN    21-13
          MJP    VIF15       IF SUBSYSTEM INITIATION
          LDM    EBIT+1
          LPK    EFSC
          ZJN    VIF12       IF ORIGIN DEFAULT NOT SELECTED
          LDM    VIFT,OT
          LJM    VIF14       SET ORIGIN DEFAULT
 
 VIF12    LDM    FSSC
          SHN    6
          STD    T1
          ZJP    VIF15       IF NO SERVICE CLASS SPECIFIED
          PJN    VIF13       IF NOT USER DEFAULT
          LDD    CN+1        USE DEFAULT RETURNED BY *0VJ*
          STM    FSSC
          SHN    6
          STD    T1
          ZJP    VIF23       IF INCORRECT USER DEFAULT
 VIF13    RJM    CVS         CHECK FOR VALID SERVICE CLASS
          NJP    VIF23       IF ERROR
          LDM    IOSS+SCLQ*5 UPDATE SERVICE CLASS IN QFT ENTRY
          LPN    77
          LMD    T1
 VIF14    STM    IOSS+SCLQ*5
          LDM    JASS
          LMN    SCIE
          ZJN    VIF14.1     IF INCORRECT SERVICE CLASS
          LMN    USIE&SCIE
          NJN    VIF15       IF NOT UNDEFINED SERVICE CLASS ERROR
 VIF14.1  STM    JASS        CLEAR ERROR IF SKIPPING VALIDATION
 
*         CHECK FOR JOB COMMAND ERRORS.
 
 VIF15    LDM    JASS
          ZJP    VIF25       IF NO ERROR
          LMN    SCIE
          ZJN    VIF17       IF INCORRECT SERVICE CLASS
          LMN    USIE&SCIE
          NJN    VIF18       IF DEFINED SERVICE CLASS
 VIF17    LDM    VIFT,OT     RESET SERVICE CLASS
          STM    IOSS+SCLQ*5
 VIF18    LDM    INFL        GET INPUT FLAGS
          SHN    21-7
          PJN    VIF18.1     IF FILE NOT TO BE QUEUED
          AOM    DSPF        FLAG ABORTED INPUT FILE
          LJM    VIF27       QUEUE THE FILE
 
 VIF18.1  LDM    JASS        CHECK ERROR FLAG
          LMN    JCIE
          NJN    VIF19       IF NOT JOB COMMAND ERROR
          ERROR  /ERR/EC32   (JOB COMMAND ERROR.)
 
 VIF19    LMN    IDIE&JCIE
          NJN    VIF20       IF NOT INCORRECT LID
          ERROR  /ERR/EC15   * DSP - INCORRECT LID.*
 
 VIF20    LMN    STIE&IDIE
          NJN    VIF22       IF NOT INCORRECT ATTEMPT TO SPECIFY *ST*
 VIF21    ERROR  /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
 
 VIF22    LMN    SCIE&STIE
          NJN    VIF24       IF NOT INCORRECT SERVICE CLASS
 VIF23    ERROR  /ERR/EC45   * DSP - INCORRECT SERVICE CLASS.*
 
 VIF24    LMN    USIE&SCIE
          NJN    VIF25       IF NOT UNDEFINED SERVICE CLASS ERROR
          ERROR  /ERR/EC11   * DSP - UNDEFINED SERVICE CLASS.*
 
 VIF25    LDM    IOSS+INSQ*5+1
          NJN    VIF26       IF DLID SPECIFIED ON JOB COMMAND
          LDD    ST
          LPC    DLFL
          ZJN    VIF27       IF DLID NOT SPECIFIED IN PARAMETER BLOCK
 VIF26    LDD    CP
          ADK    AACW        CHECK FOR *CUST* VALIDATION
          CRD    CM
          LDD    CM+3
          SHN    21-5
          PJN    VIF21       IF CALLING USER NOT VALIDATED TO USE *ST*
          SHN    21-4-21+5   CHECK FOR *CQLK* VALIDATION
          MJN    VIF27       IF CALLING USER VALIDATED TO USE LCN
          LDM    DLAT
          SHN    21-13
          PJP    VIF21       IF DLID DOES NOT HAVE *HOST* ATTRIBUTE
 
*         SET QUEUE FILE OWNERSHIP.
 
 VIF27    LDD    ST          CHECK IF SUBSYSTEM CALL
          LPN    SSFL
          ZJN    VIF28       IF SUBSYSTEM
          RJM    SQO         SET QFT OWNER
          LJM    VIF29       CONTINUE
 
 VIF28    LDD    MA          SAVE FILE NAME
          CWD    FN
          CRD    UN
          CWM    ACSS,ON     SET ACCOUNT OF OWNER
          CWM    FMSS,ON     SET FAMILY OF OWNER
          LDD    MA
          CRM    OASS,ON
          CRM    FOSS,ON
          SBN    1
          CRD    FN          GET FAMILY ORDINAL
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL
          LDD    FN+4
          SHN    6
          LMM    OASS+3      SET *FO,UI* OF OWNER
          SCN    77
          LMM    OASS+3
          STM    IOSS+JSNQ*5+2
          LDM    OASS+4
          STM    IOSS+JSNQ*5+3
          LDD    MA
          CWD    UN
          CRD    FN
 
*         SET ACCOUNTING INFORMATION INTO SYSTEM SECTOR.
 
 VIF29    LDD    FB          CHECK IF NO ACCOUNTING SET
          SHN    21-4
          PJN    VIF30       IF NO ACCOUNTING INFORMATION
          RJM    GFA         SET ACCOUNTING INFORMATION
          ADN    5
          CRD    CM
          ADN    1
          CRM    TNSS,ON     READ TERMINAL NAME OR EST ORDINAL
          LDD    CM+3        SET COMMAND COUNT
          STM    CRSS
          LDD    CM+4
          STM    CRSS+1
 
*         SET ABORT CODE IN SYSTEM SECTOR.
 
 VIF30    LDM    INFL        CHECK INPUT FLAGS
          SHN    21-10
          PJN    VIF31       IF FORCED ABORT FLAG NOT SET
          LDM    JASS
          NJN    VIF31       IF ERROR STATUS ALREADY SET
          RJM    GFA         GET JOB ABORT CODE
          ADN    4
          CRD    CM
          LDD    CM+2        SAVE JOB ABORT CODE
          STM    JASS
          SBN    MXIE
          MJN    VIF31       IF VALID JOB ABORT CODE
          ERROR  /ERR/EC42   * DSP - INCORRECT JOB ABORT CODE.*
 
 VIF31    LDD    FB+1        CHECK FOR SUBSYSTEM INITIATION
          SHN    21-13
          PJN    VIF32       IF NOT SUBSYSTEM INITIATION
          LDM    SBID        SET SUBSYSTEM ID
          STM    SISS
          LDM    SBCP        SET CONTROL POINT NUMBER SPECIFICATION
          STM    CPSS
 VIF32    LDN    SCFL        SET REQUEST SCHEDULER FLAG
          RAD    ST
 
*         *0VJ* CALLS *0AV* TO VALIDATE THE USER NAME EVEN IF THE
*         *PRE-VALIDATE* BIT IS NOT SET IN THE LID CONFIGURATION
*         TABLE.  ALSO, *0VJ* ALWAYS DELETES THE PASSWORD FROM THE
*         BUFFER CONTAINING THE FIRST SECTOR OF THE INPUT FILE.
*         THEREFORE, THE BUFFER CONTAINING THE FIRST SECTOR OF THE
*         INPUT FILE SHOULD NOT BE REWRITTEN TO THE FILE IF BOTH OF
*         THE FOLLOWING CONDITIONS ARE PRESENT -
*         1) THE PASSWORD WAS NOT VALID, AND
*         2) THE FILE WAS DESTINED FOR ANOTHER MAINFRAME.
 
 VIFA     LDN    0           CHECK IF FIRST SECTOR HAS BEEN READ
*         LDN    1           (FIRST SECTOR HAS BEEN READ)
          ZJN    VIF35       IF FIRST SECTOR HAS NOT BEEN READ
          LDM    JASS
          LMN    UNIE
          NJN    VIF33       IF USER NAME/PASSWORD VALID
          LDM    DLAT
          SHN    21-13
          PJN    VIF35       IF NOT HOST LID
 VIF33    LDD    FS          SET DISK ADDRESS
          STD    T5
          LDD    FS+1
          STD    T6
          LDN    FSMS
          STD    T7
          SETMS  IO,RW
          LDC    SBUF+WLSF
          RJM    WMS         WRITE SECTOR
 VIF34    ENDMS
 VIF35    LJM    VIFX        RETURN
 
 VIFB     BSS    5           BUFFER FOR FNT ENTRY
 VIFC     VFD    42/0,18/SYUI
 VIFD     VFD    60/-0
 
 
*         TABLE OF DEFAULT ORIGIN TYPE AND SERVICE CLASS DESCRIPTORS
*         FOR INPUT FILES.
 
 VIFT     BSS    0
          LOC    0
          VFD    6/SYSC,6/SYOT  SYSTEM SERVICE CLASS
          VFD    6/BCSC,6/BCOT  BATCH SERVICE CLASS
          VFD    6/RBSC,6/RBOT  REMOTE BATCH SERVICE CLASS
          VFD    6/BCSC,6/BCOT  INTERACTIVE SERVICE CLASS
          LOC    *O
 CRF      SPACE  4,10
**        CRF - CLEAR REMOTE FAMILY/USER NAME.
*
*         EXIT (RFSS - RFSS+4) AND (RUSS - RUSS+4) ARE CLEARED.
 
 
 CRF      SUBR               ENTRY/EXIT
          LDK    ZERL        CLEAR REMOTE FAMILY
          CRM    RFSS,ON
          SBN    1           CLEAR REMOTE USER NAME
          CRM    RUSS,ON
          UJN    CRFX        RETURN
 CVS      SPACE  4,10
**        CVS - CHECK FOR VALID SERVICE CLASS.
*
*         ENTRY  (FSSC) = SERVICE CLASS TO BE VALIDATED.
*                (CN+2 - CN+4) = SERVICE CLASS VALIDATION MASK.
*
*         EXIT   (A) = ERROR CODE.  ZERO IF NO ERROR.
*
*         USES   T3.
*
*         CALLS  VSP.
 
 
 CVS3     LDN    0           INDICATE NO ERROR
 
 CVS      SUBR               ENTRY/EXIT
          LDM    EBIT+1
          LPK    EFDS
          NJN    CVS3        IF NOT TO VALIDATE SERVICE CLASS
          LDN    0           PRESET NON-SUBSYSTEM AND NON-SSJ= JOB
          STD    T3
          LDM    EBIT+1
          LPN    EFCU
          NJN    CVS2        IF CREATION FAMILY/USER SPECIFIED
          LDD    QT
          LMK    INQT
          ZJN    CVS2        IF INPUT FILE
          LDD    ST
          LPN    SSFL
          ZJN    CVS1        IF SUBSYSTEM
          LDD    ST
          LPK    SYFL
          ZJN    CVS2        IF CALLING JOB IS NOT *SYOT*
          LDD    ST
          LPK    SJFL
          ZJN    CVS2        IF CALLING PROGRAM IS NOT *SSJ=*
 CVS1     LDN    1           SET SUBSYSTEM OR *SYOT*/*SSJ=* CALLER
          STD    T3
 CVS2     LDM    FSSC
          RJM    VSP         VALIDATE SERVICE CLASS
          UJN    CVSX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
 CUV$     EQU    1           CHECK SERVICE CLASS VALID FOR USER
*CALL     COMPVSP
          SPACE  4,10
          USE    OVL
          ERRNG  SBUF-*      OVERFLOW INTO *0VJ* COMMAND BUFFER
          TITLE  OVERLAYABLE ROUTINES.
 DFO      SPACE  4,10
**        DFO - DESTINATION FAMILY ORDINAL.
*
*         ENTRY  (FDSS) = DESTINATION FAMILY NAME.
*
*         EXIT   ROUTING INFORMATION UPDATED.
*
*         USES   FN - FN+4, UN - UN+4.
*
*         CALLS  GFO.
 
 
 DFO      SUBR               ENTRY/EXIT
          LDD    MA          PRESERVE FILE NAME
          CWD    FN
          CRD    UN
          CWM    FDSS,ON
          SBN    1
          CRD    FN
*         LDN    (NONZERO)   DO NOT ADD FAMILY
          RJM    GFO         GENERATE FAMILY ORDINAL
          LDD    FN+4
          SHN    6
          RAM    IOSS+SCLQ*5+1
          LDD    MA          RESTORE FILE NAME
          CWD    UN
          CRD    FN
          UJN    DFOX        RETURN
 GUD      SPACE  4,10
**        GUD - GET USER DEFAULT SERVICE CLASS.
*
*         ENTRY  (T3) = ADDRESS OF ACCOUNT BLOCK.
*
*         EXIT   (FSSC) = USER DEFAULT SERVICE CLASS.
*                (A) .EQ. SERVICE CLASS VALUE.
*                (A) .EQ. ZERO IF ERROR.
*
*         USES   T1, T2.
 
 
 GUD      SUBR               ENTRY/EXIT
          LDN    SYSC        PRESET SYSTEM ORIGIN DEFAULT
          STD    T2
          LDD    OT
          LMK    SYOT
          ZJP    GUD4        IF SYSTEM ORIGIN
          LDN    0
          STD    T2
          LDD    T3          GET ADDRESS OF USER DEFAULT
          ADK    ASC1*5
          STD    T1
          LDD    OT          SET BYTE NUMBER WITH USER DEFAULT
          SHN    21
          STM    GUDA
          PJN    GUD1        IF UPPER SIX BITS ARE USER DEFAULT
          LDN    0
          STM    GUDB
 GUD1     LDM    0,T1        GET USER DEFAULT SERVICE CLASS
 GUDA     EQU    *-1         (BYTE NUMBER OF USER DEFAULT)
          SHN    -6
*         SHN    0           (LOWER SIX BITS ARE USER DEFAULT)
 GUDB     EQU    *-1
          LPN    77
          STD    T1
 GUD2     LDM    TGUD,T2     GET SERVICE CLASS VALUE
          LMD    T1
          ZJN    GUD4        IF MATCH
          AOD    T2
          SBN    MXSC
          NJN    GUD2        IF NOT END OF SERVICE CLASSES
 GUD3     LJM    GUDX        RETURN
 
 GUD4     LDD    T2          SET SERVICE CLASS
          STM    FSSC
          UJN    GUD3        RETURN
 
 
**        TGUD - TABLE OF USER DEFAULT SERVICE CLASSES.
 
 TGUD     INDEX
          LIST   D
 .SCL     HERE
          LIST   *
          INDEX  MXJC
 NTS      SPACE  4,15
**        NTS - NO TID SPECIFIED.
*
*         EXIT   FAMILY NAME DETERMINED FROM *FO*.
*                DESTINATION USER INDEX TAKEN FROM EJT.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID.
*
*         USES   CN - CN+4, FN - FN+4, UN - UN+4.
*
*         CALLS  CRF, GEA, GFM.
*
*         MACROS ERROR.
 
 
 NTS1     LDD    MA          SAVE FAMILY NAME
          CWD    FN
          CRM    FDSS,ON
 NTS2     LDD    MA          RESTORE (FN - FN+4)
          CWD    UN
          CRD    FN
          LDD    CN+1        SET DESTINATION UI
          LMM    DASS+3
          SCN    37
          LMD    CN+1
          STM    DASS+3
          LDD    CN+2
          STM    DASS+4
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
 
 NTS      SUBR               ENTRY/EXIT
          LDD    ST
          LPN    DSFL
          NJN    NTSX        IF FILE PREVIOUSLY ROUTED
          RJM    GEA         GET *FO,UI* FROM EJT
          ADK    SCLE
          CRD    CN
          LDD    MA          PRESERVE (FN - FN+4)
          CWD    FN
          CRD    UN
          LDD    CN+1
          SHN    -6
          ZJN    NTS2        IF NO DESTINATION FAMILY SPECIFIED
          RJM    GFM         GET FAMILY NAME
          NJP    NTS1        IF FAMILY NAME FOUND
          ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
 PSI      SPACE  4,15
**        PSI - PROCESS SUBSYSTEM INITIATION.
*
*         ENTRY  (FJSN - FJSN+1) = SUBSYSTEM NAME.
*                (SBID) = SUBSYSTEM ID (IF SPECIFIED IN CALL).
*
*         EXIT   (SBID) = SUBSYSTEM ID.
*                TO ERR, IF INCORRECT REQUEST.
*
*         USES   RI.
*
*         CALLS  AST.
*
*         MACROS ERROR.
 
 
 PSI      SUBR               ENTRY/EXIT
          LDM    CUAV        CHECK USER ACCESS
          ZJN    PSI2        IF VALID USER
 PSI1     ERROR  /ERR/EC12   * DSP - INCORRECT REQUEST.*
 
 PSI2     LDD    QT
          LMK    INQT
          NJN    PSI1        IF NOT INPUT FILE
          LDD    OT
          LMK    SYOT
          NJN    PSI1        IF NOT ROUTE TO SYSTEM ORIGIN
          LDC    TSUB
          STD    RI
          LDM    SBID
          ZJN    PSI3        IF SUBSYSTEM ID NOT SPECIFIED IN CALL
          SBK    LSSI+1
          MJN    PSIX        IF SUBSYSTEM NOT IN *SSCT* SPECIFIED
 PSI3     LDI    RI          SEARCH TABLE FOR SUBSYSTEM
          LMM    FJSN
          NJN    PSI4        IF NO MATCH
          LDM    1,RI
          LMM    FJSN+1
          ZJN    PSI6        IF MATCH
 PSI4     LDN    TSUBE       GET NEXT TABLE ENTRY
          RAD    RI
          LMC    TSUBL
          NJN    PSI3        IF NOT END OF TABLE
 PSI5     LJM    PSI1        * DSP - INCORRECT REQUEST.*
 
 PSI5.1   LDM    SBID        CHECK FOR CYBIS
          LMC    PLSI
          ZJP    PSIX        IF ALREADY ACTIVE
          UJN    PSI5        SET ERROR
 
 PSI6     LDM    SBID
          ZJN    PSI6.1      IF SUBSYSTEM ID NOT SPECIFIED IN CALL
          LMM    2,RI
          NJN    PSI5        IF SUBSYSTEM ID DID NOT MATCH NAME
 PSI6.1   LDM    2,RI        SAVE SUBSYSTEM ID
          STM    SBID
          LMC    FEAF*10000  CHECK FOR SUBSYSTEM ALREADY ACTIVE
          RJM    AST
 PSI6.2   NJN    PSI5.1      IF SUBSYSTEM ALREADY ACTIVE
          LDM    SBID
          LMC    RDSI
          NJN    PSI9        IF NOT *RDF*
          LDC    IFSI+FEAF*10000  CHECK IF *IAF* ACTIVE
 PSI7     RJM    AST
          NJN    PSI6.2      IF SUBSYSTEM ACTIVE
 PSI8     LJM    PSIX        RETURN
 
 PSI9     LMC    IFSI&RDSI
          NJN    PSI8        IF NOT *IAF*
          LDC    RDSI+FEAF*10000
          UJN    PSI7        CHECK IF *RDF* ACTIVE
 TSUB     SPACE  4,10
**        TABLE OF NON-PP-INITIATED SUBSYSTEMS.
*
*         ENTRY FORMAT.
*
*T        24/NAME, 12/SSID
*
*         NAME = 3-CHARACTER SUBSYSTEM NAME + BLANK.
*         SSID = SUBSYSTEM ID.
 
 
 TSUB     BSS    0
          LIST   G
 .SUB     HERE
          LIST   *
 TSUBL    BSS    0           END OF TABLE
 SBI      SPACE  4,10
**        SBI - SET BATCH ID.
*
*         ENTRY  (CM - CM+4) = SECOND WORD OF ARGUMENT TABLE.
*                (CM - CM+4) = 0 IF NO BATCH ID IS SPECIFIED.
*                (FB+1) = FLAG BITS.
*                (OT) = DESTINATION ORIGIN TYPE.
*
*         EXIT   QFT UPDATED.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID.
*
*         USES   T1, T2.
*
*         CALLS  CRF.
*
*         MACROS ERROR.
 
 
 SBI      SUBR               ENTRY
          LDD    FB+1
          LPN    4
          NJN    SBI0        IF BATCH ID SPECIFIED
          LDM    IOSS+SCLQ*5+1
          ZJN    SBIX        IF BATCH ID IS ALREADY SET
 SBI0     LDD    CM+3
          STM    IOSS+SCLQ*5+1
          ZJN    SBI2        IF VALID TID
 SBI1     ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
 
 SBI2     LDD    CM+4
          STM    IOSS+SCLQ*5+2
          SBN    IDLM
          PJN    SBI1        IF ID .GT. MAXIMUM ALLOWED
          LDN    ZERL        CLEAR DESTINATION FAMILY
          CRM    FDSS,ON
          SBN    1           CLEAR DESTINATION USER NAME
          CRM    DASS,ON
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
          UJN    SBIX        RETURN
 SDO      SPACE  4,10
**        SDO - SET DESTINATION ORIGIN TYPE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (OT) = ORIGIN TYPE OF CONTROL POINT AREA.
*                (QT) = DESTINATION QUEUE TYPE.
*
*         EXIT   (OT) = ORIGIN TYPE.
*                (A) = ORIGIN TYPE OF QUEUED FILE.
*
*         USES   OT, CM - CM+4.
*
*         CALLS  GFA.
 
 
 SDO      SUBR               ENTRY/EXIT
 
*         SET ORIGIN TYPE FOR FILE.
 
          LDD    ST          CHECK IF FILE PREVIOUSLY ROUTED
          LPN    DSFL
          ZJN    SDO1        IF NOT PREVIOUSLY ROUTED
          LDM    IOSS+SCLQ*5
          UJN    SDO3        SET FROM QFT ENTRY
 
 SDO1     LDD    QT
          LMK    INQT
          NJN    SDO2        IF NOT INPUT FILE
          LDM    JBOT
          LPN    17
          LMK    SYOT
          NJN    SDO1.1      IF NOT SYSTEM ORIGIN JOB
          LDN    BCOT        SET BATCH ORIGIN TYPE
          STD    OT
 SDO1.1   LDM    VIFT,OT     INITIALIZE ORIGIN TYPE AND SERVICE CLASS
          STM    JBOT
 SDO2     LDM    JBOT        SET FROM EJT ENTRY OF CALLER
          STM    IOSS+SCLQ*5
 SDO3     LPN    17
          STD    OT
          LDM    FSOT
          SHN    21-13
          MJN    SDO4        IF NOT FORCED ORIGIN REQUEST
          SHN    13-21
          STD    OT
          LDM    SCDT,OT     RESET ORIGIN TYPE AND SERVICE CLASS
          STM    IOSS+SCLQ*5
 SDO4     LDD    FB+1
          SHN    21-13
          PJN    SDO5        IF NOT SUBSYSTEM INITIATION
          LDM    IOSS+SCLQ*5 RESET SERVICE CLASS
          LPN    17
          LMC    SSSC*100
          STM    IOSS+SCLQ*5
 SDO5     UJP    SDOX        RETURN
 
 
*         TABLE OF DEFAULT ORIGIN TYPE AND SERVICE CLASS DESCRIPTORS
*         FOR OUTPUT FILES.
 
 SCDT     BSS    0
          LOC    0
          VFD    6/SYSC,6/SYOT  SYSTEM SERVICE CLASS
          VFD    6/BCSC,6/BCOT  BATCH SERVICE CLASS
          VFD    6/RBSC,6/EIOT  REMOTE BATCH SERVICE CLASS
          VFD    6/TSSC,6/IAOT  INTERACTIVE SERVICE CLASS
          LOC    *O
 SFD      SPACE  4,30
**        SFD - SET FILE DESTINATION.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                (OT) = DEFAULT ORIGIN TYPE.
*                (QT) = QUEUE TYPE.
*
*         EXIT   (FN - FN+4) = UPDATED FNT.
*                (FS - FS+4) = FST ENTRY.
*                (OT) = ORIGIN TYPE.
*                (QT) = QUEUE TYPE.
*                (DASS - DASS+4) = DESTINATION USER NAME.
*                QFT ROUTE INFO UPDATED.
*                (FDSS - FDSS+4) = DESTINATION FAMILY NAME.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT TID.
*                INCORRECT SERVICE CLASS.
*                ALTERNATE FAMILY NOT ALLOWED.
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0AV*.
*
*         USES   FN+3, FS+2, FS+3, OT, T1, T2, CM - CM+4,
*                CN - CN+4, UN - UN+4.
*
*         CALLS  CRF, CVS, DFO, GUD, GFA, NTS, RFN, SBI, SDO, SSJ, VCA.
*                *0AV*.
*
*         MACROS ERROR, EXECUTE.
 
 
 SFD      SUBR               ENTRY/EXIT
          RJM    SDO         SET DESTINATION ORIGIN TYPE
          LDD    FB+1
          LPN    6
          NJN    SFD1        IF CENTRAL SITE OR TID SPECIFIED
          RJM    NTS         NO TID SPECIFIED
          UJN    SFD4        CHECK FOR FORCED SERVICE CLASS
 
 SFD1     LPN    4
          NJN    SFD2        IF TID SPECIFIED
          LDN    ZERL
          UJN    SFD3        CLEAR ROUTING INFORMATION
 
 SFD2     RJM    GFA         GET TID FROM PARAMETER BLOCK
          ADN    2
 SFD3     CRD    CM
          LDD    CM+3
          NJN    SFD6        IF ADDRESS SPECIFIED
          RJM    SBI         SET BATCH ID
 SFD4     LJM    SFD19       CHECK FOR FORCED SERVICE CLASS
 
 SFD5     ERROR  /ERR/EC21   * DSP - INCORRECT TID.*
 
*         PROCESS TID PARAMETER BLOCK.
 
 SFD6     LDD    QT
          LMK    INQT
          NJN    SFD7        IF NOT ROUTE TO INPUT
          LDM    SLAT
          UJN    SFD8        CHECK SLID ATTRIBUTES (INPUT FILE)
 
 SFD7     LDM    DLAT        CHECK DLID ATTRIBUTES (OUTPUT FILE)
 SFD8     SHN    21-13
          MJN    SFD9        IF LOCAL HOST
          LDN    PSNI        SET RUSS/RFSS RATHER THAN DASS/FDSS
          STM    SFDA
          STM    SFDA+1
          STM    SFDC
          LDN    ZERL        PRESET SELECTION OF DEFAULT FAMILY
          CRM    RFSS,ON
 SFD9     LDD    CM+3        VALIDATE ADDRESS OF PARAMETER BLOCK
          SHN    14
          SCN    77
          LMD    CM+4
          LMC    777777
          NJN    SFD10       IF NONZERO ADDRESS SPECIFIED
          LJM    SFD12       SET DEFAULT FAMILY AND USER NAME
 
 SFD10    RJM    VCA         VALIDATE ADDRESS
 SFD11    ZJP    SFD5        IF INCORRECT ADDRESS
          ADN    1
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          ZJN    SFD11       IF INCORRECT ADDRESS
          SBN    1
 SFDA     LJM    SFD15       PROCESS TID
*         PSN                (SET RUSS/RFSS FROM TID)
 
*         SET REMOTE FAMILY AND USER NAME FROM TID BLOCK.
 
          SHN    14          READ REMOTE USER/FAMILY
          ADD    RA
          SHN    6
          CRM    RFSS,ON
          CRM    RUSS,ON
 SFD11.1  LDN    0           ZERO FILL REMOTE USER/FAMILY
          STM    RUSS+4
          STM    RFSS+4
          LDM    RUSS+3
          SCN    77
          STM    RUSS+3
          LDM    RFSS+3
          SCN    77
          STM    RFSS+3
          LDK    ZERL        CLEAR DESTINATION FAMILY
          CRM    FDSS,ON
          SBN    1           CLEAR DESTINATION USER NAME
          CRM    DASS,ON
          LJM    SFD19       CHECK FOR FORCED SERVICE CLASS
 
*         READ DEFAULT FAMILY AND USER NAME FROM CPA.
 
 SFD12    RJM    SSJ         CHECK IF SSJ= JOB
          ZJN    SFD13       IF NO SSJ= BLOCK
          ADK    UIDS
          UJN    SFD14       CONTINUE PROCESSING
 
 SFD13    LDD    CP          READ UI FROM CONTROL POINT AREA
          ADK    UIDW
 SFD14    CRD    CM
 SFDC     UJN    SFD14.1     SET DASS/FDSS
*         PSN                (SET RUSS/RFSS)
          CRM    RUSS,ON     READ REMOTE USER NAME
          RJM    RFN         DETERMINE FAMILY NAME
          CRM    RFSS,ON
          LJM    SFD11.1     ZERO FILL REMOTE USER/FAMILY
 
 SFD14.1  CRM    DASS,ON     READ DESTINATION USER NAME
          LDD    CM+3        PRESET UI FOR ROUTING FIELD
          LPN    37
          STD    T1
          LDD    CM+4
          STD    T2
          RJM    RFN         READ DESTINATION FAMILY NAME
          CRM    FDSS,ON
          LJM    SFD18       DETERMINE FAMILY ORDINAL
 
*         SET DESTINATION FAMILY AND USER NAME FROM TID BLOCK.
 
 SFD15    SHN    14
          ADD    RA
          SHN    6
          CRD    CN          READ FAMILY NAME
          CRM    FDSS,ON
          CRD    UN          READ USER NAME
          CRM    DASS,ON
          LDD    CN
          NJN    SFD16       IF FAMILY NAME PRESENT
          RJM    RFN         READ FAMILY NAME
          CRD    CN
          CRM    FDSS,ON
 SFD16    LDD    ST
          LPN    SSFL
          NJN    SFD17       IF NOT SUBSYSTEM CALL
          LDD    UN+3        CHECK IF UI IS SPECIFIED
          LPN    37
          STD    T1
          SHN    14
          LMD    UN+4
          STD    T2
          NJN    SFD18       IF USER INDEX SPECIFIED
 
*         VALIDATE USER NAME.
 
 SFD17    LDN    0           SET VALIDATE USER NAME FUNCTION
          STD    UN+4
          EXECUTE  0AV,OVL1
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T1
          SHN    14
          LMD    T2
          NJN    SFD18       IF UI PRESENT
          LJM    SFD5        * DSP - INCORRECT TID.*
 
*         STORE ROUTING INFORMATION IN QFT.
 
 SFD18    LDD    T1          PRESERVE UI IN QFT
          STM    IOSS+SCLQ*5+1
          LDM    DASS+3
          SCN    77
          LMD    T1
          STM    DASS+3
          LDD    T2
          STM    IOSS+SCLQ*5+2
          STM    DASS+4
          RJM    DFO         DETERMINE FAMILY ORDINAL
          RJM    CRF         CLEAR REMOTE FAMILY/USER NAME
 
*         VALIDATE SERVICE CLASS.
 
 SFD19    LDD    QT
          LMK    INQT
          ZJP    SFDX        IF INPUT FILE
          LDM    EBIT+1
          SHN    21-6
          ERRNZ  EFSC-100    SHIFT COUNT INCORRECT
          PJN    SFD21       IF ORIGIN DEFAULT NOT SELECTED
 SFD20    LDM    SCDT,OT
          UJP    SFD30       SET ORIGIN DEFAULT SERVICE CLASS
 
*         IF CREATION USER NAME IS SPECIFIED, GET SERVICE
*         CLASS VALIDATION MASK FOR THAT USER.
 
 SFD21    LDM    EBIT+1
          LPN    EFCU
          ZJN    SFD22       IF CREATION USER NAME NOT SPECIFIED
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    13
          CRD    CN          GET CREATION FAMILY NAME
          SBN    1
          UJN    SFD25       GET CREATION USER NAME
 
 SFD22    LDM    FSSC
          ZJN    SFD23       IF NO SERVICE CLASS SELECTED
          SHN    6
          MJN    SFD24       IF USER DEFAULT REQUIRED
          NFA    SCVN
          UJP    SFD29       GET VALIDATION MASK
 
*         PROCESS USER DEFAULT SERVICE CLASS SPECIFICATION.
 
 SFD23    LDM    FSOT
          SHN    21-13
          MJP    SFDX        IF NO FORCED ORIGIN TYPE
          SHN    13-21
          LMK    SYOT
          ZJN    SFD20       IF SYSTEM ORIGIN DEFAULT REQUIRED
          LCN    0           FORCE USER DEFAULT
          STM    FSSC
 SFD24    LDN    ZERL        SET NO FAMILY NAME
          CRD    CN
          RJM    SSJ         CHECK FOR SSJ= BLOCK
          ZJN    SFD24.1     IF NO SSJ= BLOCK PRESENT
          ADK    UIDS
          UJN    SFD25       GET USER NAME
 
 SFD24.1  LDD    CP          GET USER NAME
          ADK    UIDW
 SFD25    CRD    UN
          LDD    UN
          ZJP    SFD20       IF NO USER NAME FOR *DIS* JOB
          LDD    UN+3
          SCN    77
          STD    UN+3
          LDN    0           SET VALIDATE USER NAME FUNCTION
          STD    UN+4
          EXECUTE  0AV,OVL1
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T1
          ADD    T2
          ZJP    SFD20       IF CREATION USER NOT VALID
          LDM    FSSC
          SHN    21-13
          PJN    SFD28       IF USER DEFAULT SERVICE CLASS NOT NEEDED
          RJM    GUD         GET USER DEFAULT SERVICE CLASS
          NJN    SFD28       IF FOUND
 SFD27    ERROR  /ERR/EC45   * DSP - INCORRECT SERVICE CLASS.*
 
 SFD28    LDD    T3          GET VALIDATION MASK
          ADK    ASCV*5
          STM    SFDB
          LDD    MA
          CWM    **,ON
 SFDB     EQU    *-1         (ADDRESS OF VALIDATION MASK)
          SBN    1
 SFD29    CRD    CN
          RJM    CVS         CHECK FOR VALID SERVICE CLASS
          NJN    SFD27       IF INCORRECT
          LDM    IOSS+SCLQ*5 SET SERVICE CLASS
          SHN    21-5
          SCN    77
          LMM    FSSC
          SHN    6
 SFD30    STM    IOSS+SCLQ*5
          LJM    SFDX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPAST
*CALL     COMPCUA
          QUAL   MIO
 RDS      EQU    RMS         USE *RMS* IN PLACE OF *RDS*
*CALL     COMPRNS
          QUAL   *
 RNS      EQU    /MIO/RNS
          SPACE  4,10
**        DEFINE UNQUALIFIED ENTRY POINTS.
 
          QUAL
 PSI      EQU    /3DA/PSI
 SFD      EQU    /3DA/SFD
 VIF      EQU    /3DA/VIF
          QUAL   *
          SPACE  4,10
          OVERFLOW  OVL4,BFMS
          SPACE  4,10
          USE    OVERFLOW
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          OVERLAY  (FILE ATTRIBUTE ROUTINES.),OVL4
 SOD      SPACE  4,20
**        SOD - SET OUTPUT FILE DATA.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FS - FS+4) = FST ENTRY.
*                (QT) = QUEUE TYPE.
*
*         EXIT   (RCSS) = REPEAT COUNT.
*                QFT FIELDS UPDATED.
*
*         ERROR  TO *ERR*, IF ONE OF THE FOLLOWING OCCURS,
*                INCORRECT EXTERNAL CHARACTERISTICS.
*                INCORRECT INTERNAL CHARACTERISTICS.
*                FORMS CODE NOT ALPHANUMERIC.
*                INCORRECT SPACING CODE.
*
*         USES   CM - CM+4, T0 - T5.
*
*         CALLS  GEA, GFA, VFC.
*
*         MACROS ERROR.
 
 
 SOD      SUBR               ENTRY/EXIT
 
*         SET REPEAT COUNT.
 
          LDD    FB
          SHN    21-2
          PJN    SOD1        IF REPEAT COUNT NOT SPECIFIED
          RJM    GFA         READ REPEAT COUNT
          ADN    4
          CRD    CM
          LDD    CM+3        SET REPEAT COUNT
          LPN    77
          STM    IOSS+INSQ*5+4
          STM    RCSS
 
*         SET RANDOM ADDRESS.
 
 SOD1     RJM    GFA
          ADN    1           READ INTERNAL AND EXTERNAL CHARACTERISTICS
          CRD    CM
          ADN    6           READ RANDOM ADDRESS
          CRD    T1
          LDD    FB
          SHN    21-11
          PJN    SOD2        IF RANDOM ADDRESS NOT SET
          LDD    T1+1        SET RANDOM ADDRESS IN SYSTEM SECTOR
          STM    RASS
          LDD    T1+2
          STM    RASS+1
 
*         SET EXTERNAL CHARACTERISTICS.
 
 SOD2     LDD    CM+3        SET EXTERNAL CHARACTERISTICS
          SHN    -11
          STD    T1
          LDM    TDIC,T1     SET DEFAULT INTERNAL CHARACTERISTICS
          STD    T2
          LDD    FB+1
          SHN    21-7
          MJN    SOD3        IF EXTERNAL CHARACTERISTICS SPECIFIED
          LJM    SOD7        SET INTERNAL CHARACTERISTICS
 
 SOD3     LDD    T1          SAVE EXTERNAL CHARACTERISTICS
          SHN    3
          STD    T0
 
*         SET DEFAULT INTERNAL CHARACTERISTICS BASED ON
*         EXTERNAL CHARACTERISTICS.
 
          LDD    QT          DETERMINE QUEUE TYPE
          LMN    PHQT
          ZJN    SOD5        IF PUNCH FILE
          LMN    PLQT&PHQT
          ZJN    SOD4        IF PLOT FILE
          LDD    T2          SET IC FOR PRINT FILES
          SHN    -10
          UJN    SOD6        SET IC
 
 SOD4     LDD    T2          SET IC FOR PLOT FILES
          UJN    SOD6        SET IC
 
 SOD5     LDD    T2          SET IC FOR PUNCH FILES
          SHN    -4
 SOD6     LPN    17
          STD    T2
          RAD    T0
 
*         SET INTERNAL AND EXTERNAL CHARACTERISTICS.
 
          LDM    IOSS+SCLQ*5+3
          SCN    77
          LMD    T0
          STM    IOSS+SCLQ*5+3
          LDD    T2          VALIDATE EXTERNAL CHARACTERISTICS
          LMN    17
          NJN    SOD7        IF VALID EXTERNAL CHARACTERISTICS
          ERROR  /ERR/EC37   *DSP - INCORRECT EXTERNAL CHARACTERISTICS.*
 
*         SET INTERNAL CHARACTERISTICS.
 
 SOD7     LDD    FB+1
          SHN    21-10
          PJN    SOD8        IF INTERNAL CHARACTERISTICS NOT SPECIFIED
          LDD    CM+3        SET INTERNAL CHARACTERISTICS
          SHN    -6
          LPN    3
          STD    T0
          LDM    IOSS+SCLQ*5+3
          SCN    7
          LMD    T0
          STM    IOSS+SCLQ*5+3
          LPN    7
          SBN    MXIC
          MJN    SOD8        IF VALID INTERNAL CHARACTERISTICS
          ERROR  /ERR/EC23   *DSP - INCORRECT INTERNAL CHARACTERISTICS.*
 
*         CHECK IF FILE NEEDS *SOST* STATUS.
 
 SOD8     LDD    T1
          LMN    A9EX
          NJN    SOD9        IF EC .NE. A9
          LDM    IOSS+SCLQ*5+3
          LPN    7
          LMK    DCIC
          ZJN    SOD9        IF IC .EQ. DIS
          LMK    A6IC&DCIC
          ZJN    SOD9        IF IC .EQ. ASCII6
          LDD    QT          DETERMINE IF PRINT FILE
          LMN    PRQT
          NJN    SOD9        IF NOT PRINT FILE
          LDD    FB+1
          SHN    21-0
          PJN    SOD9        IF NOT DEFERRED ROUTE
          LDN    SOST        SET *SOST* STATUS
          STM    LFST
 
*         SET FORMS CODE.
 
 SOD9     LDD    FB+1
          SHN    21-12
          PJN    SOD10       IF FORMS CODE NOT SELECTED
          LDD    CM+1
          STM    IOSS+SCLQ*5+4
          RJM    VFC         VALIDATE FORMS CODE
          PJN    SOD10       IF VALID FORMS CODE
          ERROR  /ERR/EC22   * DSP - FORMS CODE NOT ALPHANUMERIC.*
 
*         SET PRINT IMAGE CODE FOR PRINT FILES.
 
 SOD10    RJM    GFA         GET PARAMETER BLOCK ADDRESS
          ADN    4
          CRD    CM
          LDD    CM
          SHN    21-11
          PJN    SOD10.1     IF NO PRINT IMAGE SPECIFIED
          LDM    SCSS        CLEAR PRINT IMAGE PRESERVING SPACING CODE
          LPN    77
          STM    SCSS
          LDD    CM
          LPC    1700        PRINT IMAGE FLAG AND CODE
          RAM    SCSS
 
*         SET SPACING CODE FOR PRINT FILES.
 
 SOD10.1  LDD    FB
          SHN    21-3
          PJN    SOD11       IF SPACING CODE NOT SPECIFIED
          LDM    SCSS        CLEAR SPACING CODE PRESERVING PRINT IMAGE
          SCN    77
          STM    SCSS
          LDD    CM          SET SPACING CODE
          LPN    77
          RAM    SCSS
          LDD    CM
          SHN    -6
          ZJN    SOD11       IF VALID SPACING CODE
          LPN    10          CHECK PRINT IMAGE FLAG
          NJN    SOD11       IF PRINT IMAGE SPECIFIED
          ERROR  /ERR/EC41   * DSP - INCORRECT SPACING CODE.*
 
*         SET ACCESS LEVEL INTO QFT ENTRY.
 
 
 SOD11    LDM    LFAL        GET LOCAL FILE ACCESS LEVEL
          SHN    3
          LMM    IOSS+INSQ*5+3
          LPN    70
          LMM    IOSS+INSQ*5+3
          STM    IOSS+INSQ*5+3
 
*         SET UP ACCOUNTING LIMITS FOR PRINT, PUNCH AND PLOT FILES.
 
          LDD    CP          READ FILE SIZE LIMITS
          ADK    ALMW
          CRD    CM
          LDD    QT          DETERMINE QUEUE TYPE
          LMN    PHQT
          ZJN    SOD13       IF PUNCH FILE
          LMN    PLQT&PHQT
          ZJN    SOD12       IF PLOT FILE
          LDD    CM+4        SET PRINT FILE LIMIT
          SHN    -6
          UJN    SOD14       SET LIMIT
 
 SOD12    LDD    CM          SET PLOT FILE LIMIT
          UJN    SOD14       SET LIMIT
 
 SOD13    LDD    CM+4        SET PUNCH FILE LIMIT
 SOD14    LPN    77
          STM    LCSS
          UJP    SODX        RETURN
          SPACE  4,10
**        TDIC - TABLE OF DEFAULT INTERNAL CHARACTERISTICS.
*
*         INDEXED BY EXTERNAL CHARACTERISTICS CODE.
*
*T        4/ PRIC, 4/PHIC, 4/ PLIC
*                PHIC = PUNCH INTERNAL CHARACTERISTICS.
*                PRIC = PRINT INTERNAL CHARACTERISTICS.
*                PLIC = PLOT INTERNAL CHARACTERISTICS.
*                17B = INCORRECT INTERNAL CHARACTERISTICS.
 
 
 TDIC     BSS    0
          LOC    0
*                                      PRINT     PUNCH     PLOT
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/17B,4/BNIC,4/BNIC   INVALID   BINARY    BINARY
          VFD    4/ASIC,4/BNIC,4/ASIC  ASCII     BINARY    ASCII
          VFD    4/DCIC,4/17B,4/17B    DISPLAY   INVALID   INVALID
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/DCIC,4/DCIC,4/17B   DISPLAY   DISPLAY   INVALID
          VFD    4/ASIC,4/ASIC,4/17B   ASCII     ASCII     INVALID
          VFD    4/17B,4/17B,4/17B     INVALID   INVALID   INVALID
          LOC    *O
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPVFC
          SPACE  4,10
**        DEFINE UNQUALIFIED ENTRY POINTS.
 
 
          QUAL
 SOD      EQU    /3DB/SOD
          QUAL   *
          SPACE  4,10
          OVERFLOW  OVL4,BFMS
          SPACE  4,10
          USE    OVERFLOW
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          OVERLAY  (SYSTEM SECTOR/EOI UPDATE ROUTINES.),OVL4
 AEO      SPACE  4,10
**        AEO - ATTACH EJT ORDINAL.
*
*         *AEO* DETERMINES THE EJT ORDINAL OF THE CONTROL
*         POINT AND THEN INSERTS THE ORDINAL INTO THE QFT.
*
*         EXIT   APPROPRIATE FLAGS SET IN QFT SAYING QFT
*                IS ATTACHED TO AN EJT.
 
 
 AEO      SUBR               ENTRY/EXIT
          LDM    EJTO        GET EJT ORDINAL
          STM    IOSS+ENTQ*5+4
          LDM    IOSS+JSNQ*5+4  FLAG FILE ASSIGNED TO EJT
          SCN    37
          LMN    2           FLAG FILE ASSIGNED TO EJT
          STM    IOSS+JSNQ*5+4
          UJN    AEOX        RETURN
 BSE      SPACE  4,15
**        BSE - CHECK FOR BINARY CARD SEQUENCE ERROR.
*
*         ENTRY  (ST) = STATUS WORD.
*                (QT) = QUEUE TYPE.
*
*         EXIT   SYSTEM SECTOR UPDATED.
*
*         USES   CM - CM+6.
*
*         CALLS  GFA.
 
 
 BSE      SUBR               ENTRY/EXIT
          LDD    QT
          LMK    INQT
          NJN    BSEX        IF NOT ROUTE TO INPUT
          LDD    ST          DETERMINE IF SUBSYSTEM
          LPN    SSFL
          NJN    BSEX        IF NOT SUBSYSTEM
          LDM    INFL        GET INPUT FLAGS
          SHN    21-6
          PJN    BSEX        IF NOT ERRORS
          RJM    GFA         READ BINARY CARD DATA
          ADN    5
          CRD    CM
          SBN    1           READ ABORT CODE
          CRD    CM+2
          LDD    CM+2+2      SET ABORT CODE
          STM    JASS
          LDD    CM          SET RECORD NUMBER
          STM    RNSS
          LDD    CM+1        SET CARD NUMBER
          STM    CNSS
          UJN    BSEX        RETURN
 CLE      SPACE  4,10
**        CLE - COMPLETE LOCAL ENTRY.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FN - FN+4) = NFL FNT ENTRY.
*                (FS - FS+4) = NFL FST ENTRY.
*
*         EXIT   (FS - FS+4) = WRITTEN TO NFL.
*                (FN - FN+4) = WRITTEN TO NFL.
*
*         USES   FN+4, FS+4, CM - CM+4.
*
*         MACROS MONITOR, NFA.
 
 
 CLE2     LDN    ZERL        CLEAR PARAMETERS
          CRD    CM
          LDN    DLFS        DROP LOCAL ENTRY
          STD    CM+1
          LDC    *           (LOCAL FNT ORDINAL)
 CLEB     EQU    *-1
          STD    CM+4
          MONITOR  PLFM
 
 CLE      SUBR               ENTRY/EXIT
          LDD    FB+1
          SHN    21-0
          PJN    CLE2        IF IMMEDIATE ROUTE
          LDD    FS+4        SET FILE NOT BUSY
          SCN    1
          LMN    1
          STD    FS+4
          LDM    LFST        SET FILE STATUS
          NJN    CLE1        IF FILE STATUS CHANGED
          LDD    FN+4        GET CURRENT FILE STATUS
          LPN    77
 CLE1     LMC    QFFT*100
          STD    FN+4
          NFA    CLEB,R      REWRITE NFL FNT/FST ENTRY
          CWD    FN
          ADN    FSTL
          CWD    FS
          UJN    CLEX        RETURN
 IAM      SPACE  4,10
**        IAM - ISSUE ACCOUNTING MESSAGES.
*
*         EXIT   *ABLQ* OR *ARRQ* MESSAGES ISSUED TO ACCOUNT FILE.
*
*         CALLS  *0QM*.
*
*         MACROS EXECUTE.
 
 
 IAM      SUBR               ENTRY/EXIT
          LDD    ST
          LPC    RQFL
          NJN    IAM1        IF FILE BEING REQUEUED
          LDC    2RAB        SET *ABLQ* MESSAGE
          STM    OVL7-2
          LDC    2RLQ
          UJN    IAM2        SET MESSAGE IDENTIFIER
 
 IAM1     LDC    2RAR        SET *ARRQ* MESSAGE
          STM    OVL7-2
          LDC    2RRQ
 IAM2     STM    OVL7-1
          EXECUTE  0QM,OVL7  ISSUE MESSAGES
          UJN    IAMX        RETURN
 IES      SPACE  4,15
**        IES - INITIALIZE EOI SECTOR.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (QT) = DESTINATION QUEUE TYPE.
*
*         EXIT   *EBUF* INITIALIZED AS EOI SECTOR.
*
*         USES   T1, T5 - T5+4.
*
*         CALLS  RMS, SEI.
*
*         MACROS ENDMS, ERROR, NFA, SETMS.
 
 
 IES      SUBR               ENTRY/EXIT
          LDD    ST
          LPN    DSFL
          ZJN    IES1        IF FILE NOT ALREADY A QUEUE FILE
          LDD    ST
          LPC    LKFL
          NJN    IES5        IF FILE IS LOCKED
 IES1     LDD    ST
          LPN    SSFL
          NJN    IES4        IF NOT CALLED BY SUBSYSTEM
          LDD    QT
          LMK    INQT
          NJN    IES4        IF NOT ROUTE TO INPUT QUEUE
 
*         INITIALIZE EOI FOR ROUTE TO INPUT QUEUE FROM SUBSYSTEM.
 
          LDC    501         CLEAR EOI BUFFER
          STD    T1
 IES2     LDN    0
          STM    EBUF,T1
          SOD    T1
          PJN    IES2        IF MORE TO CLEAR
 IES3     UJN    IESX        RETURN
 
*         READ EOI FROM JOB INPUT FILE.
 
 IES4     NFA    FNTN        READ JOB INPUT FILE FST
          ADN    FSTL
          CRD    T5
          UJN    IES6        READ EOI SECTOR
 
*         IF FILE IS *QFFT* AND LOCKED, IT IS A QUEUED FILE ATTACHED
*         BY *QAC*/*GET*.  READ EXISTING EOI SECTOR FROM FILE.
 
 IES5     LDD    FS
          STD    T5
          LDD    FS+1
          STD    T6
 IES6     LDN    0           FIND EOI SECTOR
          RJM    SEI
          SETMS  IO          READ EOI SECTOR
          LDC    EBUF
          RJM    RMS
          ENDMS
          UJN    IES3        RETURN
 PRT      SPACE  4,10
**        PRT - PROCESS REMOTE TEXT.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (EBUF) = EOI SECTOR.
*
*         EXIT   IMPLICIT/EXPLICIT TEXTS SET IN EOI.
*                DATA DECLARATION SET IN EOI.
*
*         USES   T1, CM - CM+4, CN - CN+4.
*
*         CALLS  GFA.
 
 
 PRT      SUBR               ENTRY/EXIT
          LDD    ST          CHECK IF SLID SPECIFIED
          SHN    21-11
          PJN    PRT2        IF SLID NOT SPECIFIED
          LDN    0           CLEAR IMPLICIT TEXT IN EOI
          STM    EBUF+ILEI
          LDC    TXLEI-1
          STD    T1
 PRT1     LDN    0
          STM    EBUF+ITEI,T1
          SOD    T1
          PJN    PRT1        IF MORE TEXT TO CLEAR
 
*         SET IMPLICIT AND EXPLICIT TEXT IN EOI.
 
 PRT2     LDD    FB+1
          SHN    21-6
          PJN    PRTX        IF NO EXTENDED BLOCK
          RJM    GFA         GET TEXT ADDRESSES
          ADN    10
          CRD    CM
          ADN    1
          CRD    CN
          LDM    IRTL        LENGTH OF IMPLICIT TEXT
          ZJN    PRT3        IF IMPLICIT TEXT NOT SPECIFIED
          STD    T1
          LDD    CM+3
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CRD    CM
          ADN    1
          CRM    EBUF+ITEI,T1  READ TEXT
          LDD    CM+4
          STM    EBUF+ILEI   SET CHARACTER LENGTH OF TEXT
 PRT3     LDM    ERTL        LENGTH OF EXPLICIT TEXT
          ZJN    PRT4        IF EXPLICIT TEXT NOT SPECIFIED
          STD    T1
          LDD    CN+3
          LPN    77
          SHN    6
          ADD    RA
          SHN    6
          ADD    CN+4
          CRD    CN
          ADN    1
          CRM    EBUF+EXEI,T1  READ TEXT
          LDD    CN+4
          STM    EBUF+ELEI   SET CHARACTER LENGTH OF TEXT
 
*         SET DATA DECLARATION IN EOI.
 
 PRT4     LDM    DDEC        DATA DECLARATION VALUE
          ZJN    PRT5        IF DATA DECLARATION NOT SPECIFIED
          STM    EBUF+DDEI
 PRT5     LJM    PRTX        RETURN
 PUF      SPACE  4,15
**        PUF - PROCESS USER/FAMILY NAMES.
*
*         EXIT   (FN - FN+4) PRESERVED.
*                SYSTEM SECTOR UPDATED.
*                QFT ENTRY UPDATED.
*
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0AV*.
*
*         USES   CN - CN+4, FN - FN+4, UN - UN+4.
*
*         CALLS  GFA, GFO, *0AV*.
*
*         MACROS EXECUTE.
 
 
 PUF      SUBR               ENTRY/EXIT
 
*         SET AND VALIDATE SPECIFIED CREATOR USER/FAMILY
*         (SKIP FOR INPUT FILES).
 
          LDM    EBIT+1
          LPN    EFCU
          ZJN    PUF1        IF CREATOR USER/FAMILY NOT SPECIFIED
          LDD    QT
          LMK    INQT
 PUF1     ZJP    PUF2        IF INPUT QUEUE TYPE
          RJM    GFA         SET SPECIFIED USER/FAMILY IN SYSTEM SECTOR
          ADN    12
          CRD    UN
          CRM    ACSS,ON
          CRD    CN
          CRM    FMSS,ON
          LDD    UN+3        CLEAR LOWER 18 BITS OF USER NAME
          SCN    77
          STD    UN+3
          LDN    0           VALIDATE CREATOR USER/FAMILY
          STD    UN+4
          EXECUTE  0AV,OVL1
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T2          SET CREATOR USER INDEX IN SYSTEM SECTOR
          STM    ACSS+4
          LDM    ACSS+3
          SCN    77
          LMD    T1
          STM    ACSS+3
 
*         SET AND VALIDATE SPECIFIED OWNER USER/FAMILY.
 
 PUF2     LDM    EBIT+1
          LPN    EFOU
          ZJP    PUFX        IF OWNER USER/FAMILY NOT SPECIFIED
          RJM    GFA         SET SPECIFIED USER/FAMILY IN SYSTEM SECTOR
          ADN    10
          CRD    UN
          CRM    OASS,ON
          CRD    CN
          CRM    FOSS,ON
          LDD    UN+3
          SCN    77
          STD    UN+3
          LDN    0           VALIDATE OWNER USER/FAMILY
          STD    UN+4
          EXECUTE  0AV,OVL1
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
          LDD    T2          SET OWNER USER INDEX IN SYSTEM SECTOR
          STM    OASS+4
          STM    PUFB+1      SAVE OWNER USER INDEX FOR QFT
          LDM    OASS+3
          SCN    77
          LMD    T1
          STM    OASS+3
          STM    PUFA+1
 
*         SET OWNER FO/UI IN QFT.  IF SPECIFIED OWNER USER/FAMILY
*         WAS NOT VALID, USE FO/UI OF CREATOR USER/FAMILY.
 
          LDD    T1
          ADD    T2
          NJN    PUF3        IF SPECIFIED OWNER USER/FAMILY VALID
          LDD    MA          SET FAMILY = CREATOR FAMILY
          CWM    FMSS,ON
          SBN    1
          CRD    CN
          LDM    ACSS+3      SET USER INDEX = CREATOR USER INDEX
          STM    PUFA+1
          LDM    ACSS+4
          STM    PUFB+1
 PUF3     LDD    MA          SAVE (FN - FN+4)
          CWD    FN
          CRD    UN
          CWD    CN          SET FAMILY NAME
          CRD    FN
*         LDN    (NONZERO)
          RJM    GFO         GET FAMILY ORDINAL
          LDD    FN+4        SET OWNER FAMILY ORDINAL IN QFT ENTRY
          SHN    6
          STM    IOSS+JSNQ*5+2
 PUFA     LDC    *           SET OWNER USER INDEX IN QFT ENTRY
          LPN    77
          RAM    IOSS+JSNQ*5+2
 PUFB     LDC    *
          STM    IOSS+JSNQ*5+3
          LDN    0           CLEAR BOTTOM OF FAMILY NAME
          STM    FOSS+4
          LDM    FOSS+3
          SCN    77
          STM    FOSS+3
          LDD    MA          RESTORE (FN - FN+4)
          CWD    UN
          CRD    FN
          LJM    PUFX        RETURN
 PUP      SPACE  4,10
**        PUP - PROCESS UJN PRESENCE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*
*         EXIT   (JNSS - JNSS+4) = UJN IF PRESENT.
*
*         CALLS  GFA.
 
 
 PUP      SUBR               ENTRY/EXIT
          LDD    FB          CHECK FOR UJN SPECIFIED
          SHN    21-1
          PJN    PUPX        IF NO UJN SPECIFIED
          RJM    GFA         MOVE UJN TO SYSTEM SECTOR
          ADN    3
          CRM    JNSS,ON
          LDN    0           ZERO FILL UJN FIELD
          STM    JNSS+4
          LDM    JNSS+3
          SCN    77
          STM    JNSS+3
          UJN    PUPX        RETURN
 SCP      SPACE  4,10
**        SCP - SET SPECIFIED CHARGE AND PROJECT NUMBERS.
*
*         EXIT   CHARGE/PROJECT NUMBERS SET IF SPECIFIED.
*
*         CALLS  GFA.
 
 
 SCP      SUBR               ENTRY/EXIT
          LDM    EBIT+1
          LPK    EFCH
          ZJN    SCPX        IF CHARGE/PROJECT NUMBERS NOT SPECIFIED
          RJM    GFA
          ADN    17
          CRM    CHSS,TR
          ERRNZ  PJSS-CHSS-5 CHARGE AND PROJECT NUMBER NOT CONTIGUOUS
          UJN    SCPX        RETURN
 SLI      SPACE  4,10
**        SLI - SET LOGICAL IDENTIFIERS.
*
*         ENTRY  (QT) =  QUEUE TYPE.
*                (SLID) = SOURCE LID.
*                (DLID) = DESTINATION LID.
*
*         EXIT   SLID/DLID SET IN SYSTEM SECTOR AND QFT.
 
 
 SLI      SUBR               ENTRY/EXIT
 
*         SET DLID IN QFT / SYSTEM SECTOR.
 
          LDD    ST
          LPC    DLFL
          NJN    SLI1        IF DLID SPECIFIED IN PARAMETER BLOCK
          LDD    QT
          LMK    INQT
          NJN    SLI1        IF NOT ROUTE TO INPUT
          LDM    IOSS+INSQ*5+1
          NJN    SLI2        IF DLID SET IN SYSTEM SECTOR BY *0VJ*
 SLI1     LDM    DLID
          SHN    14
          LMM    DLID+1
          SHN    -6+22
          STM    IOSS+INSQ*5+1
          SHN    -6
          LMM    IOSS+INSQ*5+2
          SCN    77
          LMM    IOSS+INSQ*5+2
          STM    IOSS+INSQ*5+2
 
*         SET SLID IN SYSTEM SECTOR.
 
 SLI2     LDM    IOSS+INSQ*5+1
          NJN    SLI3        IF DLID PRESENT
          STM    SLID        CLEAR SLID
          STM    SLID+1
 SLI3     LDM    SLID+1      SET SLID
          STM    SLSS+1
          LDM    SLSS
          SCN    77
          LMM    SLID
          STM    SLSS
          LJM    SLIX        RETURN
 UFS      SPACE  4,15
**        UFS - UPDATE FILE STATE.
*
*         ENTRY  (FB - FB+1) = FLAG BITS.
*                (FS - FS+4) = FST STATUS.
*                (ST) = STATUS BITS.
*
*         EXIT   (T5) = EQUIPMENT.
*                FILE LENGTH DETERMINED.
*                IF IMMEDIATE ROUTE, GET DATA FOR *UADM* MESSAGE.
*                IF FILE BEING REQUEUED BY SUBSYSTEM, RANDOM INDEX SET.
*
*         USES   T5, T6, T7.
*
*         CALLS  SEI, SRA.
 
 
 UFS      SUBR               ENTRY/EXIT
          LDD    FS          SET EQUIPMENT
          STD    T5
          LDD    ST
          SHN    21-13
          ERRNZ  RQFL-4000   CODE DEPENDS ON VALUE
          PJN    UFS2        IF NOT REQUEUEING FILE
          SHN    21-0-21+13
          ERRNZ  SSFL-1      CODE DEPENDS ON VALUE
          MJN    UFS2        IF NOT SUBSYSTEM CALLER
          LDD    QT
          LMK    INQT
          ZJN    UFS2        IF INPUT FILE
          LDD    FS+2        SET RANDOM ADDRESS
          STD    T6          SET CURRENT TRACK
          LDD    FS+3        SET CURRENT SECTOR
          STD    T7
          LDD    FS+1        SET FIRST TRACK
          RJM    SRA         SET RANDOM ADDRESS
          ZJN    UFS1        IF TRACK AND SECTOR IN TRACK CHAIN
          LDN    SWET        SET SYSTEM SOFTWARE ERROR
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONALLY HANG PP
          LJM    DPP         DROP PP
 
*         SET INTERRUPT RANDOM ADDRESS IN SYSTEM SECTOR.
 
 UFS1     LDD    RI          SET RANDOM ADDRESS IN SYSTEM SECTOR
          STM    RTSS
          LDD    RI+1
          STM    RTSS+1
 UFS2     LDD    FS+1        SET FIRST TRACK
          STD    T6
*         LDN    (NONZERO)   (DO NOT REQUIRE CURRENT TRT)
          RJM    SEI         SEARCH FOR END OF INFORMATION
 
*         SET DATA FOR *UADM* FUNCTION.
 
          LDD    T2          SET FILE LENGTH
          STM    FLSS
          LDD    T3
          SBN    1
          STM    FLSS+1
          PJN    UFS2.1      IF NO UNDERFLOW
          AOM    FLSS+1
          SOM    FLSS
 UFS2.1   LDD    FB+1
          SHN    21-0
          MJN    UFS3        IF DEFERRED ROUTE
          LDD    T2          ROUND UP SECTOR COUNT
          SHN    14
          LMD    T3
          SBD    T7
          ADM    SLM         (*COMPWEI* LOADED CORRECT DRIVER)
          STM    DPPC+1
          SHN    -14
          STM    DPPC
 UFS3     LJM    UFSX        RETURN
 WES      SPACE  4,15
**        WES - WRITE EOI SECTOR.
*
*         ENTRY  (FS - FS+4) = FST ENTRY.
*                (EBUF) = EOI SECTOR.
*
*         EXIT   EOI SECTOR WRITTEN.
*
*         USES   T5, T6.
*
*         CALLS  SEI, WEI.
*
*         MACROS ENDMS, ERROR, SETMS.
 
 
 WES      SUBR               ENTRY/EXIT
          LDD    FS          SET EQUIPMENT AND FIRST TRACK
          STD    T5
          LDD    FS+1
          STD    T6
          STM    EBUF+FTEI
          LDN    0           FIND EOI
          RJM    SEI
          SETMS  IO
          LDC    EBUF        WRITE EOI SECTOR
          RJM    WEI
          ENDMS
          UJN    WESX        RETURN
WQS       SPACE  4,20
**        WQS - WRITE QUEUED FILE SYSTEM SECTOR.
*
*         ENTRY  (WQSA) .NE. 0, DO NOT PRESERVE FILE.
*                (FA) = NFL FNT ENTRY OFFSET.
*                (QA) = ORDINAL OF QFT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*
*         EXIT   SYSTEM SECTOR WRITTEN.
*                FILE PRESERVED, IF REQUESTED.
*                (FASS) = LOCAL FNT ENTRY OFFSET.
*                (GQSS) = ORDINAL OF QFT ENTRY.
*
*         USES   FA, T6, CM - CM+4.
*
*         CALLS  RFI, UFS, WSS.
*
*         MACROS ENDMS, MONITOR, SETMS.
 
 
 WQS      SUBR               ENTRY/EXIT
 
*         IF *DC=SO* OR *DC=SS*, DO NOT PRESERVE FILE.
 
          LDM    DCSS        CHECK DISPOSITION CODE
          LMC    2RSO
          ZJN    WQS1        IF *DC=SO*
          LMN    2RSS&2RSO
          NJN    WQS2        IF NOT *DC=SS*
 WQS1     AOM    WQSA        DO NOT PRESERVE FILE
 WQS2     LDM    WQSA
          NJN    WQS3        IF FILE NOT TO BE REQUEUED
          LDM    FGSS        CHECK FOR FILE BEING REQUEUED
          LPN    2
          STM    WQSB
          LDM    FGSS        SET FILE IN QUEUE AND ACTIVE STATUS
          SCN    3
          LMN    3
          STM    FGSS
          LDC    0
*         LDC    2           (FILE BEING REQUEUED)
 WQSB     EQU    *-1
          NJN    WQS3        IF FILE BEING REQUEUED
          LDN    PDTL        SET QUEUED FILE CREATION DATE AND TIME
          CRD    CM
          LDD    CM+2
          STM    CDSS+2
          LDD    CM+3
          STM    CDSS+3
          LDD    CM+4
          STM    CDSS+4
 WQS3     RJM    UFS         UPDATE FILE STATE
          LDC    FLSS        ADDRESS OF SYSTEM SECTOR FILE LENGTH
          RJM    RFI         SET FILE SIZE INDEX IN QFT ENTRY
 
*         COMPLETE SYSTEM SECTOR.
 
          LDD    FA          SET FNT POINTERS
          STM    FASS
          STM    EERA
          STM    CLEB
          LDD    QA
          STM    GQSS
          LDN    0           INDICATE PRESET SYSTEM SECTOR FNT
          STD    FA
          LDD    FS+1        SET FIRST TRACK
          STD    T6
          SETMS  IO,RW
          RJM    WSS         WRITE SYSTEM SECTOR
          ENDMS
 
*         PRESERVE QUEUED FILE.
 
          LDC    0
*         LDC    1           (IF FILE NOT TO BE PRESERVED)
 WQSA     EQU    *-1
          NJN    WQS4        IF FILE NOT TO BE PRESERVED
          LDD    T5          CONDITIONALLY SET PROTECT BIT, CHECKPOINT
          LMC    6000
          STD    CM+1
          LDD    T6
          STD    CM+2
          LDN    SPFS        SET PRESERVED FILE BIT
          STD    CM+3
          MONITOR  STBM
 WQS4     LJM    WQSX        RETURN
          SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMPRFI
 SEI$     SET    1           GUARANTEE CURRENT TRT FOR *COMPSEI*
*CALL     COMPSEI
*CALL     COMPSFE
*CALL     COMPSRA
          QUAL   MIO
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS
          QUAL   *
 WSS      EQU    /MIO/WSS
          SPACE  4,10
**        DEFINE UNQUALIFIED ENTRY POINTS.
 
 
          QUAL
 AEO      EQU    /3DC/AEO
 BSE      EQU    /3DC/BSE
 CLE      EQU    /3DC/CLE
 IAM      EQU    /3DC/IAM
 IES      EQU    /3DC/IES
 PRT      EQU    /3DC/PRT
 PUF      EQU    /3DC/PUF
 PUP      EQU    /3DC/PUP
 RFI      EQU    /3DC/RFI
 SCP      EQU    /3DC/SCP
 SLI      EQU    /3DC/SLI
 WES      EQU    /3DC/WES
 WQS      EQU    /3DC/WQS
 WQSA     EQU    /3DC/WQSA
          QUAL   *
          SPACE  4,10
          OVERFLOW  OVL4,EBUF
          SPACE  4,10
          USE    OVERFLOW
          ERRNG  OVL1-5-*    OVERFLOW INTO *0AV*
          ERRNG  OVL7-5-*    OVERFLOW INTO *0QM*
          ERRNG  QBUF-*      OVERFLOW INTO QFT ENTRY BUFFER
          OVERLAY  (CHANGE TO LOCAL FILE.),OVL5
 CLF      SPACE  4,15
**        CLF - CHANGE TO LOCAL FILE.
*
*         ENTRY  (FN - FN+4) = LOCAL FNT ENTRY.
*                (FS - FS+4) = LOCAL FST ENTRY.
*                (UN - UN+4) = FILE NAME, IF *FCFL* IS SET IN (ST).
*                (FA) = NFL FNT OFFSET.
*
*         EXIT   QFT ENTRY DROPPED.
*                FILE UNPRESERVED.
*                LOCAL FILE CREATED IF NONE EXISTS.
*
*         ERROR  TO *EER3* IF INACCESSIBLE DEVICE RETURN BY *0DQ*.
*
*         USES   FN+4, FS+4, QA, T5, T6, CM - CM+4.
*
*         CALLS  AMS, EFN, WSS, *0DQ*.
*
*         MACROS ENDMS, EXECUTE, MONITOR, NFA, SETMS, SFA.
 
 
 CLF      SUBR               ENTRY/EXIT
          LDD    ST          CHECK IF FILE EXISTS
          LPN    FCFL
          ZJN    CLF1        IF FILE EXISTS
          RJM    EFN         ENTER FILE NAME
          RJM    AMS         ASSIGN MASS STORAGE
          UJN    CLF3        CHANGE FILE TYPE
 
 CLF1     STD    QA          SET TO SEARCH FOR QFT ENTRY
          LDD    FS
          ZJN    CLF3        IF NO EQUIPMENT
          LDD    FS+1
          ZJN    CLF3        IF NO TRACK
          LDN    1           DROP QFT ENTRY ONLY
          STM    OVL6-1
          EXECUTE  0DQ,OVL6  CLEAR QFT ENTRY
          MJP    EER3        IF MASS STORAGE DEVICE INACCESSIBLE
 CLF3     AOD    FS+4        SET FILE NOT BUSY
          LDD    FN+4        SET LOCAL FILE TYPE
          LPN    77
          LMC    LOFT*100
          STD    FN+4
          LDD    FN+3        CLEAR LOCK (READ-ONLY) BIT
          SCN    1
          STD    FN+3
 
*         DETERMINE IF FILE WAS A PRESERVED FILE.
 
          LDD    FS          CHECK FOR EQUIPMENT ASSIGNMENT
          ZJP    CLF4        IF NO EQUIPMENT ASSIGNED
          SFA    EST,FS      READ EST ENTRY
          ADK    EQDE
          CRD    CM
          LDD    FS+1        GET TRACK
          LPC    3777        SET TRT WORD NUMBER
          SHN    21-1
          STD    T2
          SHN    1-21
          ADC    SHNI+21-13
          STM    CLFA
          LDD    CM+4        GET FWA OF TRT
          SHN    3
          ADN    TRLL
          CRD    CM
          LDD    CM+3
          LPN    77
          SHN    14
          LMD    CM+4
          ADD    T2          READ TRT WORD
          CRD    CM
          LDD    CM+4        SET TRACK BITS
 CLFA     SHN    0
          PJN    CLF4        IF FILE NOT PRESERVED
          LDD    FS          SET EQUIPMENT
          STD    T5
          STD    CM+1
          LDD    FS+1        SET TRACK
          STD    T6
          STD    CM+2
          LDN    CPFS        SET CLEAR PRESERVED FILE BIT FUNCTION
          STD    CM+3
          MONITOR  STBM
          SETMS  IO,RW
          RJM    WSS         REWRITE SYSTEM SECTOR
          ENDMS
 CLF4     NFA    FA,R        REWRITE LOCAL FNT/FST
          CWD    FN
          ADN    FSTL
          CWD    FS
          LDN    0           CLEAR JSN IN PARAMETER BLOCK
          STM    DSPD
          STM    DSPE
          LJM    CLFX        RETURN
          SPACE  4,10
**        DEFINE UNQUALIFIED ENTRY POINTS.
 
          QUAL
 CLF      EQU    /3DD/CLF
          QUAL   *
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMPSFI
          QUAL   MIO2
 WDS      EQU    WMS         USE *WMS* IN PLACE OF *WDS*
*CALL     COMPWSS
          QUAL   *
 WSS      EQU    /MIO2/WSS
          SPACE  4,10
          OVERFLOW  OVL5,BFMS
          SPACE  4,10
          USE    OVERFLOW
          ERRNG  OVL0-5-*    OVERFLOW INTO *0BF*
          ERRNG  OVL6-5-*    OVERFLOW INTO *0DQ*
          OVERLAY  (ERROR PROCESSOR.),OVL3
 ERP      SPACE  4,15
**        ERP - ERROR PROCESSOR.
*
*         ENTRY  (ER) = ERROR CODE.
*                (FA) = FST ADDRESS.
*                (DSPB) = ERROR CODE.
*
*         EXIT   TO *PPR* IF JOB IS TO BE ABORTED.
*                TO *DSPX* IF ERROR CODE IS TO BE RETURNED.
*
*         USES   T2, FN - FN+4.
*
*         CALLS  FEM, FNB, GFA, IDM, PUE, SQE.
*
*         MACROS MONITOR.
 
 
 ERP      SUBR               ENTRY/EXIT
          LDD    ER
          LMN    /ERR/EC24
          NJN    ERP1        IF NOT * QUEUED FILE READ ERROR*
          RJM    SQE         SET QFT ERROR
          UJN    ERP2        CONTINUE
 
 ERP1     RJM    FNB         SET FILE NOT BUSY
 ERP2     LDD    ER
          LMN    /ERR/EC34
          ZJN    ERP3        IF USER NAME ERROR
          LMN    /ERR/EC47&/ERR/EC34
          NJN    ERP4        IF NOT USER SECURITY COUNT EXHAUSTED ERROR
 ERP3     RJM    PUE         PROCESS USER NAME ERROR
 ERP4     LDD    ST
          LPN    SSFL
          ZJN    ERP6        IF SUBSYSTEM CALL
 
*         CHECK IF ERROR PROCESSING ALLOWED.
 
          LDN    0
          STD    T2
 ERP5     LDM    TABT,T2
          ZJN    ERP6        IF END OF TABLE
          LMD    ER
          ZJN    ERP7        IF JOB SHOULD BE ABORTED
          AOD    T2          INCREMENT INDEX
          UJN    ERP5        CHECK NEXT TABLE ENTRY
 
 ERP6     LDD    FB
          SHN    21-0
          PJN    ERP7        IF ERROR PROCESSING NOT SELECTED
          LDD    ER
          STM    DSPB
          LJM    DSPX        RETURN
 
 ERP7     LDD    ER          CHECK FOR JOB COMMAND ERROR
          SBN    /ERR/EC32
          NJN    ERP8        IF NOT JOB COMMAND ERROR
          RJM    FEM         FORMAT ERROR MESSAGE
 ERP8     LDM    TDFM,ER
          RJM    IDM         ISSUE DAYFILE MESSAGES
          LDD    ER          CHECK ERROR STATUS
          LMN    /ERR/EC12
          ZJN    ERP9        IF INCORRECT REQUEST
          RJM    GFA         GET PARAMETER BLOCK ADDRESS
          CRD    FN
          LDD    FN+4        SET FUNCTION COMPLETE
          SCN    1
          LMN    1
          STD    FN+4
          RJM    GFA         WRITE COMPLETE BIT
          CWD    FN
 ERP9     MONITOR  ABTM      ABORT CONTROL POINT
          LJM    PPR
          SPACE  4
**        TABT - TABLE OF ERROR CODES TO ABORT UNCONDITIONALLY.
 
 
 TABT     BSS    0
          CON    /ERR/EC12   * DSP - INCORRECT REQUEST.*
          CON    /ERR/EC10   * DSP - USER ACCESS NOT VALID.*
          CON    /ERR/EC17   * DSP - COMPLETE BIT ALREADY SET.*
          CON    /ERR/EC31   * DSP - I/O SEQUENCE ERROR.*
          CON    0           END OF TABLE
 FEM      SPACE  4,10
**        FEM - FORMAT ERROR MESSAGE.
*
*         EXIT   ERROR MESSAGE FORMATTED AND PLACED IN *FEMA*.
*
*         USES   T1.
 
 
 FEM      SUBR               ENTRY
          LDD    MA          SET-UP ERROR MESSAGE
          CWM    STMT,TR
          SBD    TR
          CRM    FEMB,TR
          LDC    FEMB-1
          STD    T1
 FEM1     AOD    T1          SET END OF JOB COMMAND ERROR MESSAGE
          LMC    FEMC
          ZJN    FEM2        IF END OF MESSAGE BUFFER
          LDI    T1
          ZJN    FEM2        IF END OF JOB COMMAND
          LPN    77
          NJN    FEM1        IF NOT END OF JOB COMMAND
          LDN    1R)
          RAI    T1
          UJN    FEM3        SET END OF MESSAGE
 
 FEM2     LDC    2R)
          STI    T1
 FEM3     LDN    0
          STM    1,T1
          UJN    FEMX        RETURN
 TDFM     SPACE  4
**        TDFM - TABLE OF DAYFILE MESSAGE ADDRESSES.
 
 
 TDFM     INDEX
          INDEX  /ERR/EC01,(=C* DSP - FILE NAME ERROR.*)
          INDEX  /ERR/EC02,(=C* DSP - FILE NOT ON MASS STORAGE.*)
          INDEX  /ERR/EC03,(=C* DSP - INCORRECT FILE TYPE.*)
          INDEX  /ERR/EC05,(=C* DSP - ROUTE TO INPUT NOT IMMEDIATE.*)
          INDEX  /ERR/EC06,(=C* DSP - IMMEDIATE ROUTING - NO FILE.*)
          INDEX  /ERR/EC07,(=C* DSP - INCORRECT DISPOSITION CODE.*)
          INDEX  /ERR/EC10,(=C* DSP - USER ACCESS NOT VALID.*)
          INDEX  /ERR/EC11,(=C* DSP - UNDEFINED SERVICE CLASS.*)
          INDEX  /ERR/EC12,(=C* DSP - INCORRECT REQUEST.*)
          INDEX  /ERR/EC13,(=C* DSP - DEFERRED ROUTING NOT ALLOWED.*)
          INDEX  /ERR/EC14,(=C* DSP - INCORRECT DATA DECLARATION.*)
          INDEX  /ERR/EC15,(=C* DSP - INCORRECT LID.*)
          INDEX  /ERR/EC16,(=C* DSP - CANNOT ROUTE JOB INPUT FILE.*)
          INDEX  /ERR/EC17,(=C* DSP - COMPLETE BIT ALREADY SET.*)
          INDEX  /ERR/EC20,(=C* DSP - FILE ON REMOVABLE DEVICE.*)
          INDEX  /ERR/EC21,(=C* DSP - INCORRECT TID.*)
          INDEX  /ERR/EC22,(=C* DSP - FORMS CODE NOT ALPHANUMERIC.*)
          INDEX  /ERR/EC23,(=C* DSP - INCORRECT INTERNAL CHARACTERISTICS
,.*)
          INDEX  /ERR/EC24,(=C* DSP - QUEUED FILE READ ERROR.*)
          INDEX  /ERR/EC25,(=C* DSP - QFT FULL.*)
          INDEX  /ERR/EC26,(=C* DSP - THIS ROUTING NOT ALLOWED.*)
          INDEX  /ERR/EC27,(=C* DSP - DEVICE FULL.*)
          INDEX  /ERR/EC30,(=C* DSP - MASS STORAGE ERROR.*)
          INDEX  /ERR/EC31,(=C* DSP - I/O SEQUENCE ERROR.*)
          INDEX  /ERR/EC32,FEMA  JOB COMMAND ERROR
          INDEX  /ERR/EC33,(=C* DSP - TOO MANY DEFERRED BATCH JOBS.*)
          INDEX  /ERR/EC34,(=C* DSP - INCORRECT USER COMMAND.*)
          INDEX  /ERR/EC35,(=C* DSP - DEVICE INACCESSIBLE.*)
          INDEX  /ERR/EC36,(=C* DSP - INCORRECT FILE MODE.*)
          INDEX  /ERR/EC37,(=C* DSP - INCORRECT EXTERNAL CHARACTERISTICS
,.*)
          INDEX  /ERR/EC40,(=C* DSP - INCORRECT ORIGIN TYPE.*)
          INDEX  /ERR/EC41,(=C* DSP - INCORRECT SPACING CODE.*)
          INDEX  /ERR/EC42,(=C* DSP - INCORRECT JOB ABORT CODE.*)
          INDEX  /ERR/EC45,(=C* DSP - INCORRECT SERVICE CLASS.*)
          INDEX  /ERR/EC46,(=C* DSP - ALTERNATE FAMILY NOT ALLOWED.*)
          INDEX  /ERR/EC47,(=C* DSP - USER SECURITY COUNT EXHAUSTED.*)
          INDEX  /ERR/EC50,(=C* DSP - JSN ALREADY IN SYSTEM.*)
          INDEX  /ERR/EC51,(=C* DSP - ALTERNATE USER NOT ALLOWED.*)
          INDEX  /ERR/ECMX
 IDM      SPACE  4,10
**        IDM - ISSUE DAYFILE MESSAGES.
*
*         ENTRY  (A) = FWA OF MESSAGE.
*
*         EXIT   MESSAGE ISSUED.
*
*         USES   ER.
*
*         CALLS  DFM, GFA, SEM.
 
 
 IDM      SUBR               ENTRY/EXIT
          STM    IDMA
          RJM    GFA         SET FILE NAME IN MESSAGE
          CRM    IDMB,ON
          LDC    IDMB
          RJM    SEM         SET END OF MESSAGE
          LDC    MSGA        * ERROR IN ROUTE FUNCTION, LFN = XXXXXXX.*
          RJM    DFM
          LDC    **          ISSUE DAYFILE MESSAGE
 IDMA     EQU    *-1         (FWA OF MESSAGE)
          ZJN    IDMX        IF NO ADDRESS
          ADC    CPON
          RJM    DFM
          UJN    IDMX        RETURN
 
 
 MSGA     DATA   H* ERROR IN ROUTE FUNCTION, LFN =*
 IDMB     VFD    60/0
 
 MSGB     DATA   H*SIUN,*
 IDMC     EQU    *
 PUE      SPACE  4,13
**        PUE - PROCESS USER NAME ERROR.
*
*         ENTRY  (UN - UN+4) = USER NAME.
*
*         EXIT   TO *DPP*, IF NOT A SUBSYSTEM CALL.
*
*         USES   CM+1.
*
*         CALLS  DFM, IDM, SEM.
*
*         MACROS MONITOR.
 
 
 PUE      SUBR               ENTRY/EXIT
          LDD    ST
          LPN    SSFL
          ZJN    PUEX        IF SUBSYSTEM CALL
          LDM    TDFM,ER     ISSUE ERROR MESSAGE
          RJM    IDM
          LDD    ER
          LMN    /ERR/EC47
          ZJN    PUE1        IF *SECURITY COUNT EXHAUSTED* ERROR
          LDD    MA          SET USER NAME IN ACCOUNT FILE MESSAGE
          CWD    UN
          CRM    IDMC,ON
          LDC    IDMC
          RJM    SEM         SET END OF MESSAGE
          LDC    MSGB+ACFN   * SIUN, USERNAM.*
          RJM    DFM
 PUE1     LDN    SVET        SET SECURITY CONFLICT ERROR FLAG
          STD    CM+1
          MONITOR CEFM
          LJM    DPP         DROP PPU
 SEM      SPACE  4,10
**        SEM - SET END OF MESSAGE.
*
*         ENTRY  (A) = ADDRESS OF MESSAGE INSERT.
*
*         EXIT   PERIOD SET AT END OF MESSAGE.
*
*         USES   T1, T2.
 
 
 SEM      SUBR               ENTRY/EXIT
          STD    T1
          ADN    3
          STD    T2
 SEM1     LDI    T1
          ZJN    SEM2        IF END OF FILE NAME
          LPN    77
          ZJN    SEM3        IF END OF FILE NAME
          AOD    T1
          LMD    T2
          NJN    SEM1        IF NOT 7TH CHARACTER
          LDI    T1          CHECK 7TH CHARACTER
          SCN    77
          NJN    SEM3        IF NOT END OF FILE NAME
 SEM2     LDC    1R.*100
          UJN    SEM4
 
 SEM3     LDI    T1
          SCN    77
          LMN    1R.
 SEM4     STI    T1          SET PERIOD
          LDN    0           SET END OF MESSAGE
          STM    1,T1
          UJN    SEMX        RETURN
 FEMA     SPACE  4,10
*         ERROR MESSAGE FORMATTING BUFFER.
 
 FEMA     DATA   H* JOB COMMAND ERROR.  (*
 FEMB     EQU    *
 FEMC     EQU    FEMB+10D
 SQE      SPACE  4,15
**        SQE - SET QFT ERROR.
*
*         *SQE* CHANGES THE QUEUE TYPE OF THE QFT ENTRY TO
*         *ERQF* AND RETURNS THE LOCAL COPY OF THE FILE.
*
*         ENTRY  (FA) = NFL OFFSET OF FILE.
*
*         EXIT   FILE RETURNED.
*                QFT UPDATED BEFORE RELEASED.
*
*         USES   T7, CM - CM+4, CN - CN+4, FN - FN+4, FS - FS+4,
*                UN - UN+4.
*
*         MACROS MONITOR, NFA, SFA.
 
 
 SQE      SUBR               ENTRY/EXIT
          LDN    QFTP        SET LIMIT FOR QFT SEARCH
          CRD    UN
          LDN    0           INITIALIZE ORDINAL POINTER
          STD    T7
          NFA    FA,R        RETRIEVE NFL FNT/FST ENTRY
          CRD    FN
          ADN    FSTL
          CRD    FS
 
*         FIND MATCHING QFT ENTRY.
 
 SQE1     AOD    T7          ADVANCE ORDINAL
          LMD    UN+2
          ZJN    SQE3        IF QFT NOT FOUND
 SQE2     SFA    QFT,T7      READ TRACK AND EQUIPMENT OF QFT ENTRY
          ADK    ENTQ
          CRD    CN
          SBN    ENTQ
          STD    CM+4
          SHN    -14
          STD    CM+3
 
*         COMPARE TRACK AND EQUIPMENT IN FST FOR MATCH.
 
          LDD    CN+1        CHECK FIRST TRACK
          LMD    FS+1
          NJN    SQE1        IF NO MATCH
          LDD    CN          CHECK EQUIPMENT
          LMD    FS
          NJN    SQE1        IF NO MATCH
          LDN    2           SET NUMBER OF REQUESTS FOR *UTEM*
          STD    CM+1
          LDD    MA          WRITE *UTEM* PARAMETER WORDS
          CWM    SQEA,CM+1
          LDN    0
          STD    CM+2
          MONITOR  UTEM      UPDATE QFT ENTRY
          LDD    CM+1        CHECK STATUS OF UPDATE
          NJN    SQE2        IF UPDATE FAILED
          UJN    SQE4        RETURN LOCAL FILE ENTRY
 
 SQE3     LDN    0           SET NO ERROR FLAG
          STD    CM+2
          LDC    *           SET ADDRESS WHERE ERROR DETECTED
          STD    CM+1
          MONITOR  CHGM      CONDITIONALLY HANG PP
 
*         RETURN LOCAL FILE ENTRY.
 
 SQE4     LDD    FA          SET NFL OFFSET FOR *PLFM*
          STD    CM+4
          LDN    0
          STD    CM+2
          STD    CM+3
          LDN    DLFS        SET DELETE LOCAL FILE OPTION
          STD    CM+1
          MONITOR  PLFM      RETURN LOCAL FILE
          LJM    SQEX        RETURN
 
 SQEA     VFD    1/0,5/JSNQ,6/6,6/6,42/ERQF
          VFD    1/0,5/JSNQ,6/5,6/1,42/0
          SPACE  4,10
**        DEFINE UNQUALIFIED ENTRY POINTS.
 
          QUAL
 ERP      EQU    /3DE/ERP
          QUAL   *
          SPACE  4,10
          OVERFLOW  OVL3,BFMS
          SPACE  4
          TTL    DSP - DISPOSE FILE TO I/O QUEUE.
          USE    OVERFLOW
          ERRNG  OVL0-5-*    OVERFLOW INTO *0DQ*
          ERRNG  OVL2-5-*    OVERFLOW INTO *0DF*
          SPACE  4
          TTL    DSP - DISPOSE FILE TO I/O QUEUE.
          END