Retro1.org codex

          IDENT  VEJ,VEJ 
          PERIPH
          BASE   MIXED
          SST
 IOQ$     EQU    1           DEFINE TABLE FOR *SFA* MACRO
*COMMENT  VEJ - VERIFY JOB FILE INFORMATION.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  VEJ - VERIFY JOB FILE INFORMATION.
          SPACE  4
***       VEJ - VERIFY JOB FILE.
*         R. A. JAPS.        76/01/13.
*         M. J. CARIDDI.     81/07/17.
          SPACE  4
***       *VEJ* IS CALLED TO VERIFY BASIC JOB COMMAND AND OTHER
*         REQUIRED ACCOUNTING TYPE COMMANDS (CURRENTLY, ONLY THE
*         USER COMMAND) FOR A NEW JOB (INPUT) FILE.  *VEJ* WILL
*         VERIFY THE INFORMATION,  CREATE A SYSTEM NAME FOR THE
*         NEW JOB AND ASSIGN THE FILE TO THE APPROPRIATE DEVICE.
*
*         *VEJ* MUST BE CALLED BY A SUBSYSTEM.
          SPACE  4
***       CALL.
*
*T        18/ *VEJ*, 2/1, 22/ 0, 18/ FET ADDRESS
*
*         FORMAT OF FET.
*
*T,FET    42/    , 6/  , 11/  , 1/0
*T,FET+1  20/  , 1/ SP, 15/  , 24/ TID
*T,FET+2  42/  , 18/ LWA (IN)
*T,FET+3  42/  , 18/ FWA (OUT)
*T,FET+4  21/  , 3/ AL, 36/
*
*         SP  = SECURITY PROCESSING BIT.
*                INDICATES THAT *AL* FIELD HAS BEEN SPECIFIED.
*         TID = TERMINAL ID.
*                IF THE UPPER SIX BITS ARE EQUAL TO 77B, THE
*                LOWER EIGHTEEN BITS CONTAIN THE COMPLEMENT
*                OF A 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 UPPER SIX BITS ARE NOT EQUAL TO 77B, THE
*                LOWER TWENTYONE BITS CONTAIN THE TID.
*         LWA = LAST WORD ADDRESS OF BUFFER CONTAINING JOB/USER
*               COMMANDS.
*         FWA = FIRST WORD ADDRESS OF BUFFER.
*         AL  = ACCESS LEVEL LIMIT FOR COMMUNICATIONS LINE.
*                ON A SECURED SYSTEM, THE UPPER ACCESS LEVEL LIMIT
*                FOR THE JOB MUST BE .LE. THIS VALUE (IF SPECIFIED).
          SPACE  4
***       RETURN.
*
*T,FET    42/ JOBNAME , 6/ EC, 11/  , 1/1
*T,FET+1  36/  , 24/ TID
*T,FET+2  42/  , 18/ LWA
*T,FET+3  42/  , 18/ FWA
*T,FET+4  12/ FNT OFF , 48/
*
*         EC = ERROR CODES.
*                0 = NO ERROR ENCOUNTERED.
*                1 = JOB COMMAND ERROR.
*                2 = BUFFER ARGUMENT ERROR. (FATAL)
*                3 = ACCOUNT COMMAND ERROR.
*                4 = FNT/DEVICE FULL.
*                5 = INCORRECT TID.
*                6 = INCORRECT REQUEST. (FATAL)
*                7 = DEVICE UNAVAILABLE.
*
*         FNT OFF = OFFSET OF FNT ENTRY IN NFL.
          SPACE  4
**        DAYFILE MESSAGES.
*
*
*         * VEJ - BUFFER ARGUMENT ERROR.*
*                FET BUFFER POINTERS ARE INCORRECT.
*                (FWA .LT. LWA .LE. FL)
*
*         * VEJ - INCORRECT REQUEST.*
*                CAN INDICATE ONE OF THE FOLLOWING CONDITIONS -
*                1. *VEJ* NOT CALLED BY A SUBSYSTEM.
*                2. FET ADDRESS OUT OF RANGE.
*                3. A JOB WITHOUT SSJ= PRIVILEGES ATTEMPTED TO SPECIFY
*                   A SYSTEM SECTOR ADDRESS IN THE SYSTEM REQUEST.
*                4. SYSTEM SECTOR BUFFER NOT WITHIN FL.
*                5. CALLER WAS NOT SYSTEM ORIGIN OR DID NOT HAVE
*                   SYSTEM ORIGIN PRIVILEGES.
          SPACE  4
**        ROUTINES CALLED.
*
*         0AV - ACCOUNT VALIDATION.
*         0BF - BEGIN FILE.
*         0DF - DROP FILE.
*         0DQ - DROP QFT ENTRY.
*         0VJ - VERIFY JOB AND USER COMMAND.
          SPACE  4
*         COMMON DECKS.
 
*CALL     COMPMAC
*CALL     COMSCPS
*CALL     COMSDSP
*CALL     COMSEVT
*CALL     COMSMSP
*CALL     COMSSCD
*CALL     COMSSSD
*CALL     COMSSSE
*CALL     COMSSSJ
*CALL     COMSWEI
*CALL     COMSZOL
          SPACE  4
****      DIRECT LOCATION ASSIGNMENTS.
 
 
 FS       EQU    20 - 24     FST (5 LOCATIONS)
 QA       EQU    26          ORDINAL OF QFT ENTRY
 FT       EQU    27          TABLE FWA
 CN       EQU    30 - 34     CM BUFFER (5 LOCATIONS)
 SC       EQU    35          SCRATCH
 FN       EQU    40 - 44     FILE NAME (5 LOCATIONS)
 OT       EQU    46          ORIGIN TYPE
 ER       EQU    47          ERROR STATUS
 FA       EQU    57          NFL FNT ENTRY OFFSET
 
****
          TITLE  MACRO DEFINITIONS.
**        ERROR - ERROR PROCESSING.
*
*         ERROR  ER
 
 
          PURGMAC ERROR
 
 ERROR    MACRO  E
          MACREF  ERROR
          LDN    E
          STD    ER
          LJM    VEJ5        SET ERROR CODE
          ENDM
          SPACE  4
**        ABORT - ABORT CONTROL POINT.
*
*         ABORT  ER
*
*                ER = ERROR CODE.
 
 
          PURGMAC ABORT
 
 ABORT    MACRO  E
          MACREF  ABORT
          LDN    E
          RJM    ABT
          ENDM
          EJECT
          TITLE  MAIN PROGRAM.
          ORG    PPFW
          SPACE  4
**        MAIN PROGRAM.
 
 
 VEJ      BSS    0           ENTRY
          RJM    PRS         PRESET
          LDN    ZERL        CLEAR DLID / SET LOWER ACCESS LEVEL LIMIT
          CRD    CN
          LDC    STMT        SET FIRST WORD OF PP BUFFER
          STD    CN
          LDC    400         SET *DO NOT DELETE PASSWORD* FLAG
          RAD    CN+2
          LDN    0
          STM    IOSS+INSQ*5+1  CLEAR DLID IN QFT / SYSTEM SECTOR
          LDM    IOSS+INSQ*5+2
          LPN    77
          STM    IOSS+INSQ*5+2
          LDM    OAST,OT     SET ORIGIN AND SERVICE CLASS
          STM    IOSS+SCLQ*5+0
          EXECUTE 0VJ,OVL0   VERIFY JOB AND USER COMMAND
          PJN    VEJ1        IF VERIFICATION COMPLETE
          ERROR  ERUA        * DEVICE UNAVAILABLE.*
 
 VEJ1     LDM    SLSS        CLEAR SLID IN SYSTEM SECTOR
          SCN    77
          STM    SLSS
          LDN    0
          STM    SLSS+1
          LDD    ER
          LMN    ERAC
          ZJN    VEJ2        IF *USER COMMAND ERROR*
 VEJA     LDN    0
*         LDN    1           (*SP* BIT SPECIFIED)
          ZJN    VEJ4        IF *SP* NOT SPECIFIED OR UNSECURED SYSTEM
          LDM    IOSS+5*INSQ+3  CHECK UPPER ACCESS LEVEL LIMIT
          LPN    7
 VEJB     SBN    1
*         SBN    AL+1        (SPECIFIED ACCESS LEVEL + 1)
          MJN    VEJ4        IF JOB MAY BE CREATED
          LDN    ERJC        SET *JOB COMMAND ERROR* STATUS
          STD    ER
          LDN    JCIE
          STM    VEJC
          UJN    VEJ3        DO NOT CREATE JOB
 
*         CHECK IF JOB SHOULD BE CREATED DESPITE USER COMMAND ERROR.
 
 VEJ2     LDD    CN          CHECK DESTINATION LID ATTRIBUTES
          ZJN    VEJ3        IF NO DESTINATION LID
          SHN    21-13
          MJN    VEJ3        IF DESTINED FOR LOCAL HOST LID
          SHN    21-11-21+13
          MJN    VEJ3        IF VALIDATION REQUIRED FOR THIS LID
          LDN    0           CLEAR ERROR CODE
          STD    ER
          STM    JASS        CLEAR JOB ABORT CODE
          UJN    VEJ4        CREATE JOB
 
 VEJ3     LDC    UNIE        SET *USER NAME / PASSWORD NOT VALID*
*         LDC    JCIE        (*JOB COMMAND ERROR*)
 VEJC     EQU    *-1
          STM    JASS        SET JOB ABORT CODE IN SYSTEM SECTOR
 
*         RETURN HERE FROM *WIF* IF MASS STORAGE ERROR.
 
 VEJ4     LDN    ZERL        CLEAR ENCRYPTED PASSWORD
          CRM    EPSS,ON
          RJM    AIF         ASSIGN INPUT FILE
          RJM    WIF         WRITE INPUT FILE
 
*         ENTER HERE FROM *ERROR* MACRO CALLS.
 
 VEJ5     LDD    FN+3        SET ERROR CODE
          SCN    77
          LMD    ER
          STD    FN+3
          LDN    1           SET FET COMPLETE
          STD    FN+4
          RJM    GFA         SET FNT OFFSET
          ADN    4
          CRD    CM
          LDD    FA
          STD    CM
          RJM    GFA         WRITE FET INFORMATION
          ADN    4
          CWD    CM
          SBN    4
          CWD    FN
 
 DPP      MONITOR DPPM       DROP PPU
          LJM    PPR
 OAST     SPACE  4,10
**        OAST - ORIGIN TYPE AND SERVICE CLASS TABLE.
*
*T        6/ SC, 6/ OT
*                SC = SERVICE CLASS.
*                OT = ORIGIN TYPE.
 
 
 OAST     BSS    0
          VFD    6/SYSC,6/SYOT
          VFD    6/BCSC,6/BCOT
          VFD    6/RBSC,6/RBOT
          VFD    6/TSSC,6/IAOT
          TITLE  ERROR PROCESSING ROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT CONTROL POINT.
*
*         ENTRY  (A) = ERROR CODE.
*
*         EXIT   TO *PPR*.
*
*         USES   T1.
*
*         CALLS  DFM.
*
*         MACROS MONITOR.
 
 
 ABT      SUBR               ENTRY
          STD    T1
          LDM    TDFM,T1     GET FWA OF DAYFILE MESSAGE
          ZJN    ABT1        IF NO ADDRESS
          ADC    CPON
          RJM    DFM
 ABT1     MONITOR ABTM       ABORT CONTROL POINT
          LJM    PPR
 TERC     SPACE  4,5
**        TERL - TABLE OF ERROR CODES.
*         THE ORDER OF *TERC* IS DEPENDENT ON *TDFM*.
 
 
 TERC     BSS    0
          LOC    1
 ERJC     BSS    1           JOB COMMAND ERROR
 ERBA     BSS    1           BUFFER ARGUMENT ERROR
 ERAC     BSS    1           USER COMMAND ERROR
 ERFD     BSS    1           FNT/DEVICE FULL
 ERTD     BSS    1           INCORRECT TID
 ERIR     BSS    1           INCORRECT REQUEST
 ERUA     BSS    1           DEVICE UNAVAILABLE
          LOC    *O
          ORG    TERC
 TDFM     SPACE  4
**        TDFM - TABLE OF DAYFILE MESSAGE ADDRESSES.
*         THE ORDER OF *TDFM* IS DEPENDENT ON *TERC*.
 
 
 TDFM     BSS    0
          LOC    0
          CON    0
          CON    0           JOB COMMAND ERROR
          CON    DMBA        BUFFER ARGUMENT ERROR
          CON    0           ACCOUNT COMMAND ERROR (PROCESSED BY *0VJ*)
          CON    0           FNT/DEVICE FULL
          CON    0           INCORRECT TID
          CON    DMIR        INCORRECT REQUEST
          CON    0           DEVICE UNAVAILABLE
          LOC    *O
 
 
*         DAYFILE MESSAGES.
 
 
 DMBA     DATA   C* VEJ - BUFFER ARGUMENT ERROR.*
 DMIR     DATA   C* VEJ - INCORRECT REQUEST.*
 AIF      TITLE  SUBROUTINES.
**        AIF - ASSIGN INPUT FILE.
*
*         EXIT   (FA) = RELATIVE FNT ADDRESS IN NFL.
*                (QA) = QFT ORDINAL.
*                (T5) = EQUIPMENT.
*                (T6) = FIRST TRACK.
*                (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST INFORMATION.
*
*         ERROR  TO ERROR PROCESSOR IF DEVICE FULL OR ERROR FROM *0DF*.
*
*         USES   T5, T6, CM - CM+7, FN - FN+4, FS - FS+2,
*                FS+4, QA.
*
*         CALLS  CTE, DRF, GFO, *0BF*, *0DF*.
*
*         MACROS ERROR, EXECUTE, MONITOR, SFA.
 
 
 AIF      SUBR               ENTRY/EXIT
 
*         ASSIGN QFT ENTRY.
 
          LDN    ZERL
          CRD    CM+3
          LDN    7           SET CREATION, EJT AND INTERLOCK BITS
          STD    CM+7
          LDN    PQFT
          RJM    CTE         CREATE TABLE ENTRY
          ZJP    AIF6        IF QFT ENTRY NOT ASSIGNED
          CRD    FN
          CRM    IOSS,ON
          SBN    1
          CRM    OJSS,ON
          LDD    CM+1        PRESERVE QFT ORDINAL
          STD    QA
          LDN    0           ZERO FILE FILE NAME
          STD    FN+2
          STD    FN+3
          STD    FN+4
 
*         ASSIGN FNT/FST AND MASS STORAGE TO FILE.
 
 AIF1     LDN    NEEQ        SELECT NO MASS STORAGE ASSIGNMENT
          STD    FS
          LDM    IOSS+5*INSQ+3  GET LOWER ACCESS LEVEL LIMIT OF JOB
          LPN    70
          SHN    3
          LMD    TH          SET ACCESS LEVEL ON *0BF* CALL
          ADN    5           RETURN ON NFL INCREASE, LOCAL FILE LIMIT
          STM    OVL0-1
          EXECUTE  0BF,OVL0  BEGIN FILE
          UJN    AIF2        CHECK RETURN STATUS
 
*         PROCESS ADVANCE EXIT FROM *0BF* IF FILE ALREADY EXISTS.
 
          NFA    FA,R        READ FNT ENTRY
          CRD    FS
          RJM    SFB         SET FILE BUSY
          NJN    AIF3        IF FILE BUSY REJECT
          LDN    1           DROP DUPLICATE FILE
          STM    OVL0-1
          EXECUTE  0DF,OVL0
          PJN    AIF4        IF FILE UNLOADED
          AOD    FS+4
          NFA    FA,R        CLEAR FILE BUSY
          CWD    FS
          ERROR  ERUA        * DEVICE UNAVAILABLE.*
 
*         PROCESS LOCAL FILE LIMIT OR WAIT FOR NFL INCREASE.
 
 AIF2     ZJN    AIF5        IF FNT ENTRY CREATED
          LMN    4
          ZJP    AIF6        IF LOCAL FILE LIMIT
 AIF3     PAUSE  NE
          DELAY
 AIF4     LJM    AIF1        RETRY FILE CREATION
 
*         ASSIGN MASS STORAGE.
 
 AIF5     LDN    ZERL        REQUEST MASS STORAGE SPACE
          CRD    CM
          LDN    2
          STD    CM+4
          LDN    INPS
          STD    CM+2
          LDM    IOSS+5*INSQ+3  GET LOWER ACCESS LEVEL LIMIT OF JOB
          LPN    70
          SHN    3
          LMC    4000        SET ACCESS LEVEL SELECTION ON *RTCM*
          STD    CM+3
          MONITOR  RTCM      REQUEST TRACK CHAIN
          LDD    CM+4
          NJN    AIF7        IF DISK SPACE ASSIGNED
 
*         PROCESS DEVICE FULL.
 
          LDD    CP          CONSOLE MESSAGE = *TRACK LIMIT.*
          ADN    MS2W
          CWM    AIFE,TR
          LDN    ZERL        CLEAR PARAMETERS
          CRD    CM
          LDN    TKLE        SET TRACK LIMIT EVENT
          STD    CM+4
*         LDN    0           SET SYSTEM EVENT
*         STD    CM+3
          MONITOR  EATM
 AIF6     RJM    DRF         DROP FILE
          ERROR  ERFD        *FNT/DEVICE FULL.*
 
*         SET INFORMATION IN FNT/FST AND SYSTEM SECTOR.
 
 AIF7     STD    T6          SET FIRST TRACK
          STD    FS+1
          STM    IOSS+ENTQ*5+1
          STD    FS+2        SET CURRENT TRACK
          LDD    CM+1        SET EQUIPMENT
          STD    FS
          STM    IOSS+ENTQ*5+0
          STD    T5
          LDC    QFFT*100
          STD    FN+4
          LDD    MA          SET FNT IN SYSTEM SECTOR
          CWD    FN
          CRM    FNSS,ON
          LDN    15          SET FILE NOT BUSY
          STD    FS+4
          LDN    2           SET INITIAL FILE LENGTH
          STM    FLSS+1
          LDC    FLSS        GET ADDRESS OF SYSTEM SECTOR FILE LENGTH
          RJM    RFI         SET FILE SIZE INDEX IN QFT ENTRY
          LDC    2RIN        SET DISPOSITION CODE FIELD
          STM    DCSS
          LDN    1           SET FILE PLACED IN QUEUE FLAG
          STM    FGSS
          LDD    CP          ASSIGN QFT TO EJT
          ADN    TFSW
          CRD    CM
          LDD    CM
          STM    IOSS+ENTQ*5+4
          SFA    EJT         SET CREATION JSN
          ADK    JSNE
          CRD    CM
          LDD    CM
          STM    CJSS
          LDD    CM+1
          STM    CJSS+1
          LDC    MMFL        SET RESIDENT MACHINE ID
          CRD    CM
          LDD    CM
          STM    RMSS
          STM    CMSS
          LDN    PDTL        SET QUEUED DATE/TIME
          CRD    CM
          LDD    CM+2
          STM    CDSS+2
          LDD    CM+3
          STM    CDSS+3
          LDD    CM+4
          STM    CDSS+4
          LDM    ACSS+3      GET CREATION USER INDEX
          LPN    77
          STM    IOSS+JSNQ*5+2
          LDM    ACSS+4
          STM    IOSS+JSNQ*5+3
 
*         GET CREATION FAMILY ORDINAL.
 
          LDD    MA
          CWM    FMSS,ON
          SBN    1
          CRD    FN          READ FAMILY NAME
          LDN    1
          RJM    GFO
          LDD    FN+4
          NJN    AIF8        IF ORDINAL FOUND
          STM    IOSS+JSNQ*5+2  SET NO CREATION USER
          STM    IOSS+JSNQ*5+3
          UJN    AIF9        MOVE FILE NAME TO FNT WORD
 
 AIF8     SHN    6
          RAM    IOSS+5*JSNQ+2
 AIF9     LDD    MA          MOVE FILE NAME TO FNT WORD
          CWM    FNSS,ON
          SBN    1
          CRD    FN
          LJM    AIFX        RETURN
 
 AIFE     DATA   C* TRACK LIMIT.*
 CUT      SPACE  4,10
**        CUT - CONVERT USER NAME TO TID.
*
*         ENTRY  (T1+3 - T1+4) = TID FROM FET.
*                (OT) = ORIGIN TYPE.
*
*         EXIT   ROUTING INFORMATION SET IN SYSTEM SECTOR.
*
*         USES   T1, T2, CN - CN+4, FN - FN+4.
*
*         CALLS  GFO, VCA, *0AV*.
*
*         MACROS ABORT, ERROR, EXECUTE.
 
 
 CUT4.1   LDD    T1          CHECK USER INDEX
          SHN    14
          ADD    T2
          ZJN    CUT4.4      IF NO USER INDEX PRESENT
          STM    DASS+4      SET DESTINATION TID (USER INDEX)
          STM    IOSS+SCLQ*5+2
          SHN    -14
          STM    IOSS+SCLQ*5+1
          LDM    DASS+3      COMBINE UI WITH 7TH CHARACTER OF UN
          SCN    77
          LMD    T1
          STM    DASS+3
          LDD    MA          GET FAMILY ORDINAL
          CWM    FDSS,ON
          SBN    1
          CRD    FN
*         LDN    (NONZERO)   DO NOT ADD FAMILY
          RJM    GFO         GET FAMILY ORDINAL
          LDD    FN+4
          ZJN    CUT4.4      IF FAMILY NOT FOUND
          SHN    6
          RAM    IOSS+SCLQ*5+1
          UJN    CUTX        RETURN
 
 CUT4.4   ERROR  ERTD        *INCORRECT TID*
 
 CUT5     LDN    0           SET BATCH ID
          STM    IOSS+SCLQ*5+1
          LDD    T5
          STM    IOSS+SCLQ*5+2
          SBN    IDLM        CHECK FOR INCORRECT ID
          PJN    CUT4.4      IF INCORRECT TID
 
 CUT      SUBR               ENTRY/EXIT
          LDD    OT
          LMN    EIOT
          NJN    CUT5        IF NOT REMOTE BATCH
          LDD    T1+3
          SHN    -6
          LMN    77
          NJN    CUT4.4      IF NOT COMPLEMENT OF ADDRESS
          LDD    T1+3
          SHN    14
          LMN    77
          LMD    T1+4
          LMC    777777
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          ZJN    CUT1        IF INCORRECT ADDRESS
          ADN    1
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          NJN    CUT2        IF VALID ADDRESS
 CUT1     ABORT  ERBA        * BUFFER ARGUMENT ERROR.*
 
 CUT2     SHN    14          READ USER NAME
          ADD    RA
          SHN    6
          CRD    FN
          CRM    DASS,ON
          SBN    2
          CRD    CN
          CRM    FDSS,ON
          LDD    CN
          NJN    CUT3        IF FAMILY NAME PRESENT
          LDC    FOTP        SET DEFAULT FAMILY NAME
          CRD    CN
          LDD    CN
          SHN    14
          LMD    CN+1
          ADN    1
          CRD    CN
          CRM    FDSS,ON
 CUT3     LDD    FN+3
          LPN    37
          STD    T1
          SHN    14
          LMD    FN+4
          STD    T2
          NJN    CUT4        IF USER INDEX PRESENT
          EXECUTE 0AV,OVL0   VALIDATE USER NAME
          PJN    CUT4        IF NO ERROR
          ERROR  ERUA        * DEVICE UNAVAILABLE.*
 
 CUT4     LJM    CUT4.1      CHECK USER INDEX
 DRF      SPACE  4,10
**        DRF - DROP FILE AND QFT ENTRY.
*
*         ENTRY  (FA) = FNT ADDRESS.
*                (QA) = ORDINAL OF QFT ENTRY.
*
*         EXIT   (A) = (QA) = 0.
*
*         CALLS  *0DF*, *0DQ*.
*
*         MACROS EXECUTE.
 
 
 DRF      SUBR               ENTRY/EXIT
          LDN    1
          STM    OVL0-1      SELECT UNLOAD OPTION FOR *0DF*
          LDD    FA
          ZJN    DRF1        IF NO FILE
          EXECUTE  0DF,OVL0  DROP LOCAL FILE
 DRF1     LDD    QA
          ZJN    DRFX        IF NO QFT ENTRY
*         LDN    1
*         STM    OVL0-1      SELECT NO DROP OF DISK SPACE
          EXECUTE  0DQ,OVL0
          LDN    0           CLEAR QFT ORDINAL
          STD    QA
          UJN    DRFX        RETURN
 GFA      SPACE  4,5
**        GFA - GET FET ADDRESS.
*
*         ENTRY  (IR+3 - IR+4) = FET ADDRESS.
*
*         EXIT   (A) = FET ADDRESS.
 
 
 GFA      SUBR               ENTRY/EXIT
          LDD    IR+3
          LPN    37
          SHN    6
          ADD    RA
          SHN    6
          ADD    IR+4
          UJN    GFAX        RETURN
 WIF      SPACE  4,25
**        WIF - WRITE INPUT FILE.
*
*         ENTRY  (T5) = EQUIPMENT.
*                (T6) = FIRST TRACK.
*                (FA) = NFL FNT ENTRY OFFSET.
*                (FN - FN+4) = FNT ENTRY.
*                (FS - FS+4) = FST ENTRY.
*                (QA) = ORDINAL OF QFT ENTRY.
*                *BFMS* CONTAINS SYSTEM SECTOR BUFFER.
*
*         EXIT   (FA) = RELATIVE FNT ADDRESS IN NFL.
*
*         ERROR  TO *VEJ4*.
*
*         USES   FA, SC, T5, CM - CM+4, FN - FN+4, FS - FS+4.
*
*         CALLS  DRF, WEI, WSS.
*
*         MACROS ENDMS, NFA, SETMS, SFA.
 
 
 WIF      SUBR               ENTRY/EXIT
 
*         WRITE SYSTEM SECTOR AND EOI.
 
          LDD    FA
          ZJN    WIFX        IF NO FILE
          STM    FASS        SET FST ADDRESS IN SYSTEM SECTOR
          STD    SC          SAVE FNT OFFSET
          LDN    FSMS
          STD    FS+3
          NFA    FA,R        UPDATE FNT / FST IN NFL
          CWD    FN
          ADN    FSTL
          CWD    FS
          LDD    QA
          STM    GQSS
          LDN    0           CLEAR FST ADDRESS
          STD    FA
          SETMS  IO,,WDSB
          RJM    WSS         WRITE SYSTEM SECTOR
          MJN    WIF1        IF ERROR
          RJM    WEI         WRITE EOI SECTOR
          PJN    WIF2        IF NO ERROR
 WIF1     LDD    SC
          STD    FA
          RJM    DRF         DROP FILE
          LJM    VEJ4        RETRY ASSIGNING INPUT FILE
 
 WIF2     ENDMS
          LDD    SC          UPDATE FNT/FST IN NFL
          STD    FA
          LDN    2           UPDATE QFT ENTRY
          STM    IOSS+JSNQ*5+4
          LDN    QFTE-1
          STD    T5
          SFA    QFT,QA      SET QFT ADDRESS
          ADN    1           WRITE QFT DATA
          CWM    IOSS+5,T5
          SBN    QFTE-JSNQ   WRITE INTERLOCK WORD
          CWM    IOSS,ON
          LJM    WIFX        RETURN
 VCA      SPACE  4,10
**        VCA - VALIDATE CENTRAL ADDRESS.
*
*         ENTRY  (A) = CENTRAL ADDRESS TO VALIDATE.
*
*         EXIT   (A) = 0, IF ADDR .LE. 1, OR .GE. FL.
*                (A) = CENTRAL ADDRESS IF VALID.
*                (T1 - T2) = CENTRAL ADDRESS.
 
 
 VCA1     STD    T1          CLEAR UPPER PART OF ADDRESS
 VCA2     LDN    0           SET BAD ADDRESS
 
 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
          SPACE  4
*         COMMON DECKS.
 
 
 SSJ$     EQU    1           ALLOW NON-SYSTEM ORIGIN SSJ= JOBS
*CALL     COMPCUA
*CALL     COMPCTE
 IFP$     SET    1           SELECT *COMPGFP* REMOTE INITIALIZATION
 QFT$     SET    1           SELECT *COMPGFP* QFT ADDRESSING
 EJT$     SET    1           SELECT *COMPGFP* EJT ADDRESSING
*CALL     COMPGFP
*CALL     COMPRFI
*CALL     COMPSFB
 GFO$     SET    1           SELECT *COMPUFT* GET FAMILY ORDINAL
*CALL     COMPUFT
*CALL     COMPWEI
 WCS$     EQU    1           CONSECUTIVE SECTOR AFTER SYSTEM SECTOR
*CALL     COMPWSS
 PRS      TITLE  PRESET.
**        PRS - PRESET ROUTINE.
*
*         EXIT   (OT) = JOB ORIGIN TYPE.
*
*         USES   FA, QA, CM - CM+4, T1 - T5.
*
*         CALLS  CUT, DOT, GFA, IFP, VCA.
*
*         MACROS ABORT.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    0
          STD    FA          CLEAR FST ADDRESS
          STD    QA          CLEAR QFT ORDINAL
          RJM    IFP         INITIALIZE *COMPGFP* ROUTINES
          RJM    DOT         DETERMINE ORIGIN TYPE
          MJN    PRS1        IF NOT SUBSYSTEM
          LDD    IR+3        CHECK FET ADDRESS
          LPN    37
          SHN    14
          LMD    IR+4
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          ZJN    PRS1        IF INCORRECT ADDRESS
          ADN    4
          RJM    VCA         VALIDATE CENTRAL ADDRESS
          NJN    PRS2        IF VALID ADDRESS
 PRS1     ABORT  ERIR        * VEJ - INCORRECT REQUEST.*
 
*         SET FET PARAMETERS.
 
 PRS2     RJM    GFA         GET FET ADDRESS
          ADN    2
          CRD    T1          READ LWA
          ADN    1
          CRD    CM          READ FWA
          LDD    T1+3
          LPN    37
          STD    T1+3
          SHN    14
          LMD    T1+4
          SBN    1
          SHN    -6
          SBD    FL
          PJN    PRS3        IF LWA .GE. FL
          LDD    CM+3
          LPN    37
          STD    CM+3
          LDD    T1+3
          SBD    CM+3
          SHN    14
          ADD    T1+4
          SBD    CM+4
          ZJN    PRS3        IF ZERO WORD COUNT
          PJN    PRS4        IF FWA .LE. LWA
 PRS3     ABORT  ERBA        * VEJ - BUFFER ARGUMENT ERROR.*
 
 PRS4     STD    T1
          SBN    BUFL
          MJN    PRS5        IF BUFFER LENGTH .LT. 18 CM WORDS
          LDN    BUFL        SET MAXIMUM BUFFER SIZE
          STD    T1
 PRS5     LDD    CM+3        READ JOB/USER COMMANDS FROM CM BUFFER
          SHN    6
          ADD    RA
          SHN    6
          ADD    CM+4
          CRM    STMT,T1
 
*         PROCESS TID.
 
          RJM    GFA         READ TID
          ADN    1
          CRD    T1
          LDC    501         CLEAR SYSTEM SECTOR
          STD    T3
 PRS6     LDN    0
          STM    BFMS,T3
          SOD    T3
          PJN    PRS6        IF NOT END OF BUFFER
          RJM    CUT         CONVERT USER NAME TO TID
 
*         PROCESS ACCESS LEVEL.
 
          LDK    SSML        CHECK OPERATING SYSTEM SECURITY MODE
          CRD    CM
          LDD    CM
          LPN    7
          ZJN    PRS7        IF SYSTEM IN UNSECURED MODE
          RJM    GFA         READ *SP* BIT AND ACCESS LEVEL
          ADN    1
          CRD    T1
          ADN    4-1
          CRD    CM
          LDD    T1+1
          LPN    10
          ZJN    PRS7        IF *SP* BIT NOT SET
          AOM    VEJA        SET *ACCESS LEVEL SPECIFIED* FLAG
          LDD    CM+1
          LPN    7
          RAM    VEJB        SET ACCESS LEVEL
 PRS7     LJM    PRSX        RETURN
          SPACE  4
*         BUFFERS AND OVERLAY ADDRESSES.
 
 
 STMT     EQU    *           JOB AND USER COMMAND BUFFER
 
 BUFL     EQU    9D*2        COMMAND BUFFER LENGTH
 OVL0     EQU    STMT+BUFL*5+10  OVERLAY LOAD ADDRESS
 WDSB     EQU    OVL0        WRITE ERROR PROCESSING BUFFER
          ERRNG  BFMS-OVL0-ZAVL
          ERRNG  EPFW-OVL0-ZBFL
          ERRNG  BFMS-OVL0-ZDFL
          ERRNG  BFMS-OVL0-ZDQL
          ERRNG  BFMS-OVL0-ZVJL
 DOT      SPACE  4,10
**        DOT - DETERMINE ORIGIN TYPE OF CONTROL POINT.
*
*         ENTRY  NONE.
*
*         EXIT   (OT) = ORIGIN TYPE.
*                (A) .GE. 0, IF JOB IS VALID CALLER.
*
*         USES   T1, CM - CM+4, CN - CN+4.
*
*         MACROS SFA.
 
 
 DOT3     LDD    CP          READ EJT ORDINAL FROM CP AREA
          ADN    TFSW
          CRD    CN
          SFA    EJT,CN      GET EJT ADDRESS
          ADN    SCLE
          CRD    CN
          LDD    CN          SET ORIGIN TYPE
          LPN    17
          STD    OT
          LDD    CM+2
          NJN    DOTX        IF VALID CALL
          LCN    0           FLAG INCORRECT CALL
 
 DOT      SUBR               ENTRY/EXIT
          LDD    CP          READ SUBSYSTEM ID
          ADN    JCIW
          CRD    CM
          LDN    0
          STD    T1
 DOT1     LDM    TQPR,T1
          ZJN    DOT3        IF END OF TABLE
          LMD    CM+2
          ZJN    DOT2        IF MATCH
          LDN    TQPRE       ADVANCE INDEX
          RAD    T1
          UJN    DOT1
 
 DOT2     LDM    TQPR+1,T1   SET ORIGIN TYPE
          STD    OT
          UJN    DOTX        RETURN
 
 
*         TQPR - TABLE OF SUBSYSTEM ID-S.
*
*T        12/ SI, 12/ OT
*         SI = SUBSYSTEM ID.
*         OT = ORIGIN TYPE.
 
 
 TQPR     BSS    0
          CON    RBSI,EIOT   RBF
 TQPRE    EQU    *-TQPR      LENGTH OF AN ENTRY
          CON    BISI,BCOT   BATCHIO
          CON    0,0         END OF TABLE
          SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMPCRS
          SPACE  4,10
 IFP      HERE
          SPACE  4,10
          END