VEJ 
          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 
