*
*
*M*      T:JOBENT  BLOCKED JOB ENTRY FROM USER (USED BY BATCH OR UTILIST)
*
         DEF      T:JOBENT:
T:JOBENT: EQU     %
*        RJR D00  15:56  10/25/72 .
*   ##            11:00  05/05/72  RJR  *
*        RJR          17:00  03/27/72  *
MONPROC  SET      1
BITS     SET      1
         SYSTEM   UTS
         DEF      T:JECLS           * CLEAN UP PARTIAL FILE @ JOBSTEP
         DEF      T:JOBENT          * ENTER A SYMBIONT FILE IN SYSTEM
         REF      BL:IFS            * BATCH LIM: IN FIL SLOTS
         REF      BL:OFS            * BATCH LIM: OUT FIL SLOTS
         REF      J:JIP             * BITS 15-31 JIT FLAG FOR
*,*                                 * JOBENT-IN-PROG (DA(DCB)).
         REF      JB:PRIV           * USER'S PRIVILEGE IN BYTE 0.
         REF      CHKBIT0           * PLIST SCAN SETUP
         REF      PUSHALL           * PUSHES R5-R11 + ONE MORE.
         REF      CHKBIT            * PLIST SCAN
         REF      SV:TYM
         REF      SH:SYMT
         REF      GSG               * GET A SYMBIONT GRANULE.
         REF      RSG               * FREE A SYMBIONT GRANULE.
         REF      QUEUE             * QUEUE UP AN I/O OPERATION.
         REF      IOSPIN            * WAIT FOR END OF I/O OP.
         REF      SGB               * CNT DISC GRANS IN USE
         REF      SGL               * LIM DISC GRANS AVAIL
         REF      S:USID
         REF      T:REG             * SCHEDULAR: REPORT EVENT &GIVE UP
         REF      J:JIT
         REF      J:ACCN            * USER'S ACCOUNT NUMBER.
         REF      J:BASE            * USERS REGISTERS
         REF      J:ABC             CHECK PRIORITY
         REF      BLANK
         REF      LPART             * LEN OF CORE BAT TABLES
         REF      NXTSID            * GET NEXT SYSID SUBR
         REF      PLH:SID           * GUYS NOW RUNNING
         REF      CKLIMIT
         REF      MSRWRTX           * EXIT I/O NORMAL.
         REF      RDERXIT           * EXIT I/O TO FPT ERRABN ADDR.
         REF      T:ABORTM          * EXIT ABORT THE USER.
         REF      RTCHK             * TESTS USER LOCKED-IN-CORE.
         REF      ABO               * BITS 15-31 HOLD FPT ABN ADDR.
         SREF     RTSIZE
*
         PAGE
*****************************************************************
*
*        PROC TO GENERATE VALID RCC TABLES
*
*****************************************************************
*
*
         OPEN     I,J
RCC%GEN  CNAME
         PROC
         BOUND    4
I        SET      NUM(AF),AF
LF       EQU      %
J        DO       NUM(I)
         DATA,1   I(J)
         FIN
         BOUND    4
         PEND
         CLOSE    I,J
*
*
*
         PAGE
          REF     J:RNST
         REF      TJOB
*                 MONITOR SERVICE TO PERFORM M:JOB PROCEDURE
*
*                 ENTERED VIA OBAL-EXITS WITH OBSR4
*                 6=DCB ADD. 7=PLIST+1
*                 8+10 ZERO IF NORMAL. CODE +DCB ADD. TO 10,
*                 ABN ADD. TO 8 IF ABNORMAL
*
         PAGE
*
*                 ABNORMAL CODES AND CONSTANTS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
BUFFBAD  EQU      X'3F'             BUFFER NOT VALID
DCBOPEN  EQU      X'3E'             DCB OPEN
NONSYMB  EQU      X'3D'             NON-SYMB OR LP NOT SYMB
SYMSAT   EQU      X'3B'             SYMBIONT SATURATED
NOTYOURS EQU      X'39'             NOT YOUR ACCOUNT (DELETE)
MIXFUNC EQU       X'38'             MIXED FUNCTION
NOTAUTH  EQU      X'37'             NOT AUTHORIZED
OPNO     EQU      X'36'             OPERATOR SAYS NO
ACCTBAD  EQU      X'35'             BAD ACCT OR PRIORITY
IN       EQU      1                 INPUT FUNCTION CODE
PRIMSK   GEN,8,8,16 0,-1,0
BLKSIZE  GEN,15,17 X'400',0
FUNCIN   DATA     IN**17
X7       EQU      M3
RTERR    DATA     X'070000B8'       REAL-TIME ERROR CODE : M:JOB CAL1
*                                   ISSUED WHILE M:HOLD WAS CAUSING A
*                                   SYSTEM GHOST JOB TO BE BLOCKED
*
         PAGE
*
*                 GET PARAMS FROM DCB OR PLIST
*
T:JOBENT EQU      %
         BAL,R1   PUSHALL           SAVE R5-R11.
*
*                 INSURE THAT REQUEST IS NOT COMING  FROM A REAL-TIME
*                 USER THAT IS LOCKED-IN-CORE AND BLOCKING ANY SYSTEM
*                 GHOST JOB FROM RUNNING
*
         BAL,R1   RTCHK             IS USER LOCKED IN CORE...
         BCR,4    JOB2              --->NO.
         LI,R4    3                 R4= RBBAT'S USER#.
         BAL,R6   RTSIZE            WILL RBBAT FIT...
         BGE      JOB1              --->YES.
*E*      ERROR:   B8-07.
*E*      MESSAGE:   USER REQ SERVICE FROM GHOST AFTER LOCKING IT OUT.
*E*      DESCRIPTION: USER DID M:JOB CAL AFTER LOCKING SELF IN CORE,
*E*               AND THERE'S NO ROOM FOR RBBAT IN CORE.
         LW,R14   RTERR
         B        T:ABORTM          --->ABORT THE USER.
*
JOB1     LW,R4    TSTACK
         LCI      7                 RESORE R5-R11 DESTROYED
         LM,R5    -7,R4               BY RTSIZE.
JOB2     EQU      %
*
         LW,R1    0,R7
         BEZ      JOBSTAT           NO PARAMS--STATUS CHECK
         LW,R12   ABA,R6
         BAL,R2   CHKBIT0           R13<- X'1FFFF' MASK.
         NOP                        R12<- DCB:ABA OR USER ABN ADDR.
         STS,R12  J:JIT+ABO           PUT HERE FOR ALL ABN REPORTING.
         LI,R10   DCBOPEN
         LW,R2    FCD,R6
         CW,R2    Y002              IS DCB OPEN...
         BANZ     ABNEXIT           ---> YES. BAD NEWS.
         LI,R8    1                 FORCE ASN=1
         LI,R9    X'F'
         STS,R8   ASN,R6
         STS,R12  ABA,R6            PUT ABN ADDRESS INTO DCB.
         BAL,R2   CHKBIT              IF USER SPECIFIED IT,
         STS,R12  BUF,R6            PUT BUF ADDRESS INTO DCB.
*                                   R5 = 0 -NO ERRORS--
*                                   ERRORS WILL BE SAVED UNTIL
*                                   IT IS DETERMINED WHAT TYPE OF
*                                   CALL  --DELETE-IGNORE ERRORS-
         LI,R5    0                 SET TO NO ERRORS
         LW,R9    PRIMSK
         LW,R8    FUN,R6            FUN FROM DCB
         SLS,R8   -17
         BAL,R2   CHKBIT
         LW,R8    R12               OR PLIST
         SLS,R8   17
         CS,R8    FUNCIN
         BNE      FUNCGD
         REF      SV:FTYM
         REF,2    JH:LDCF
         LI,R3    JH:LDCF
         LH,R10   0,R3              CHECK IF JE IS FATH AND
         LI,R2    SV:FTYM           CHECK BIT IF SO
         LI,R3    X'FD1C5'          'JE' SIGN EXTENDED
JEFATH   CI,R2    SV:TYM
         BLE      JEFATH1
         CH,R3    SH:SYMT,R2
         BE       %+2
         BDR,R2   JEFATH
         SLS,10   0,2
         CI,10    X'8000'
         BANZ     JEFATH1
         LI,R5    X'3C'
         B        FUNCOK
JEFATH1  EQU      %
         LCI      2
         REF      MXFPL             CURRENT ACCT
         REF      SYSACT
         LM,R2    MXFPL+5           CURRENT ACCT
         CD,R2    SYSACT            LMN IN :SYS
         BE       FUNCGD
         LW,R2    Y002              *  PROCESSOR RUNNING BIT
         AND,R2   J:RNST            * SET IN JIT:RUN STATUS
         BNEZ     FUNCGD            * YES: ALLOW
*                                   * NO: DISALLOW
         LI,R5    NOTAUTH           SET ERROR AND CONTINUE
FUNCGD   EQU      %
         LI,R3    X'FFFF'
         LS,R3    J:JIP             JOB IN PROGRESS...
         BEZ      FUNCOK            NO
         CS,R8    FUN,R6            FUCNTION CHANGE
         BE       FUNCOK+1          NO-GOOD
         LI,R5    MIXFUNC           YES--SET ERROR 3F38
FUNCOK   EQU      %
         STS,R8   FUN,R6            PUT INTO DCB
         LI,R9    -1                PRIOR.-NONE
         BAL,R2   CHKBIT
         LW,R9    R12
         LW,R12   BLKSIZE
         LS,R12   FLP,R6
         STW,R12  FLP,R6            PUT BLKSIZE INTO DCB.
         LW,R12   BUF,R6
         STS,R12  QBUF,R6           MONITOR BUFFER = USER BUFFER.
         BAL,R2   CHKBIT
         B        DELJOB            DELETE REQUEST R12=ID
         LW,R10   R5                TEST FOR ANY ERRORS.
         BNEZ     ABNEXIT           ---> GO. ERRORS.
         LI,R7    X'1FFFF'
         AND,R7   QBUF,R6           MOVE BUFFER ADDRESS.
         LW,R4    R7                AND MOVE IT AGAIN.
         LI,R15   256*4             LOAD BUFFER SIZE
         BAL,R0   CKLIMIT           TEST FOR VALID BUFFER
         BCR,3    LEGAL               OK
         LI,R10   BUFFBAD           ERROR
         B        ABNEXIT
*
LEGAL    EQU      %
         LI,R10   MIXFUNC           ERROR 3F38
         PAGE
*****************************************************************
*
*        B U F F E R  V E R I F I C A T I O N
*
*****************************************************************
         LW,R1    PRIMSK
         LS,R1    FUN,R6
         SLS,R1   -17
         CI,R1    2                 FUN
         BG       ABNEXIT
         BE       SET%TYP%INDX      OUTPUT
         LI,R1    1                 SET TYPE TO INPUT
*
SET%TYP%INDX EQU  %                 0 = INPUT 1 = OUTPUT
         AI,R1    -1
         LI,R10   BUFFBAD           SET ABNORMAL CODE IN 10
         SLS,R4   +2                CONVERT TO BYTE ADDRESS
         LW,R7    R4                COMPUTE END LIMIT
         AI,R7    254*4
         AI,R4    4                 POINT TO CONTROL INFORMATION
LOAD%CONTROL EQU  %                 LOAD CONTROL INFORMATION
*                                   GET CONTROL INFORMATION
*                                   R15 = BCC (RECORD LENGTH)
*                                       = RCC (RECORD CONTROL CHAR)
*                                      = SK (SKIP CHAR)
*
*
         LW,R5    FOUR%TO%15        SET UP MOVE TO R15
         MBS,R4   0                 MOVE CONTROL TO 15
*
TEST%REC%SIZE EQU %
         LH,R13   R15               GET BCC
         BLEZ     TEST%EOB          0 OR LESS SEE IF END
         CH,R13   RECORD%SIZE,R1    TEST FOR GREATER THAN MAXIMUM
         BG       ABNEXIT             TOO LARGE ERROR
*
TEST%RCC EQU      %
         LI,R2    2                 GET INDEX TO RCC
         LB,R14   R15,R2            GET RCC CHAR
         LW,R2    RCC%PTR,R1        GET POINTER TO CORRECT RCC TABLE
         LB,R5    *R2               GET # OF ENTRIES IN TABLE
*
RCC%LOOP EQU      %                 TEST FOR VALID RCC CHAR
         CB,R14   *R2,R5            VALID ONE
         BE       TEST%SK           YES
         BDR,R5   RCC%LOOP          LOOP TILL DONE
*
TEST%EOB EQU      %                 TEST FOR END OF BUFFER CONDITION
         AND,R15  =X'FFFFFF00'      ELIMINATE SKP BITS
         CI,R15   EOB%CHAR          EOB%CHAR = X'00004000'
         BNE      ABNEXIT             ERROR
         B        FRMATOK           VALID BUFFER
*
TEST%SK  EQU      %
         AND,R15  X7                GET ONLY 3 BITS
         BEZ      ABNEXIT           ERROR
*
UPDATE%POINT EQU  %                 POINT TO NEXT RECORD
         AI,R15   -1                DECREMENT STK
         AW,R4    R15               R4 = DISP + STK - 1
         AW,R4    R13               R4 = DISP + STK -1 + BCC
         CW,R4    R7                TEST FOR END OF BUFFER
         BLE      LOAD%CONTROL      LOOP FOR NEXT RECORD
         B        ABNEXIT           RECORD TOO LONG
*
RECORD%SIZE EQU   %
         DATA,2   1007              INPUT
         DATA,2   1007              OUTPUT
*
RCC%PTR  EQU      %
         DATA     RCC%INPUT
         DATA     RCC%OUTPUT
*
RCC%INPUT RCC%GEN  0,1,2
RCC%OUTPUT RCC%GEN X'86',7,6,5,4
*
FOUR%TO%15 DATA   X'04000000'+R15*4   SET FOR MOVE 4 BYTES TO R15
*
EOB%CHAR EQU      X'4000'           BCC=0 RCC=40 STK=0
         PAGE
*
*
*                 CHECK FIRST TIME THROUGH
*
FRMATOK  EQU      %
         LI,R10   DCBOPEN
         LI,R1    X'FFFF'
         LS,R1    J:JIP
         BEZ      FRSTIM
         SLS,R1   1
         CW,R1    R6
         BNE      ABNEXIT           WRONG DCB
         LW,R1    20,R6             IS THERE A BEG. DISK ADD.
         BNEZ     NOTFRST           YES
FRSTIM   BAL,R4   OUTPUT
         B        FSTDONE           --->OUTPUT
         SPACE                      --V INPUT
         LW,R4    QBUF,R6           BUFFER
         SLS,R4   +2                CONVERT TO BYTE ADDR
         AI,R4    7                 POINT TO STK FOR FIRST RECORD
         LB,R1    0,R4              GET STK
         AND,R1   X7                MASK ONLY THREE BITS
         AW,R4    R1                POINT TO DATA
         LW,R5    FOUR%TO%15        SET UP MOVE
         MBS,R4   0                 MOVE 1ST 4 BYTES OF DATE TO R15
         CW,R15   TJOB              !JOB?
         BE       ACCTCHK           OK - ITS A JOB CARD
         LI,R10   BUFFBAD           ERROR
         B        ABNEXIT
         SPACE
ACCTCHK  LB,R14   JB:PRIV           IF X'C0' PRIV - NO CHECK
         CI,R14   X'C0'
         BGE      FSTDONE
         LI,R10   4                 COUNT CHAR. POSITION IN CARD
         BAL,R11  GETFLD            GET ACCT
         CW,R14   J:ACCN            SAME ACCT??
         BNE      BADACCT           NO - ILLEGAL
         CW,R15   J:ACCN+1
         BNE      BADACCT
SKIPNAME BAL,R11  GETFLD            SKIP THE NAME FIELD
         CI,R5    ','               END OF NAME??
         BE       CHKPRIO           YES - CHECK PRIORITY
         CI,R5    '.'               IS PRIORITY DEFAULT??
         BE       FSTDONE           YES - OK
         CI,R10   79                END OF CARD - DEFAULT PRIO??
         BGE      FSTDONE           YES - PRIO OK
         B        SKIPNAME          OTHER TERM MEANS MORE NAME TO SKIP
CHKPRIO  BAL,R11  GETFLD            GET PRIORITY
         CI,R1    -1                NO PRIORITY - DEFAULT
         BE       FSTDONE
         LB,R15   R14,R1            GET PRIO
         CI,R15   X'F0'             IS IT A NUMBER
         BGE      %+2               YES
         AI,R15   X'9'              NO - LETTER - ADD NINE
         SLS,R15  28                SCRUB X'C' OR X'F' FROM TEXT
         SLS,R15  -8                POSITION FOR COMPARE
         CS,R15   J:ABC             CHECK AGAINST MAX PRIO
         BG       BADACCT           ILLIGAL
FSTDONE  BAL,R10  RJEGSG            GET FIRST GRANULE OF FILE.
         STW,R14  20,R6             STORE IT AS FIRST GRANULE
         STW,R14  21,R6              AND  AS CURRENT GRANULE.
         LI,R1    0
         STW,R1   19,R6             STORE BLINK....FIRST TIME
         STW,R1   CLK,R6            **AND CLEAR GRANULE COUNTER
         LW,R0    R6
         SLS,R0   -1                DA(DCB)
         LI,R1    X'FFFF'
         STS,R0   J:JIP             FLAG WE'RE IN PROGRESS.
NOTFRST  LW,R8    21,R6             GET FLINK
         BEZ      JOBINS            FLINK ZERO...
         LI,R14   0
         LW,R15   R9
         BGEZ     NOFORELK
         CI,R8    1                 GOT SECOND HALF YET
         BAZ      RJEG2ND           NOPE, GET IT
         BAL,R10  RJEGSG            YES...NEED NEW GRANULE
*
*                 LINK UP GRANULE AND WRITE
*
NOFORELK RES      0
         LW,R15   QBUF,R6           PUT DA IN CDA
         MTB,1    R15
         STW,R15  QBUF,R6           I/O OUTSTANDING
         STW,R14  *R15              FLINK TO QBUF
         XW,R14   21,R6
         STW,R14  CDA,R6
         AI,R15   255
         XW,R14   19,R6             GET BLINK/SAVE
         STW,R14  *R15
         LW,R8    Y04
         AW,R8    R6
         LW,R13   Y001
         STS,R13  WAT,R6            SET WAIT BIT
         BAL,R11  QUEUE
         BAL,R11  IOSPIN            WAIT FOR I/O TO COMPLETE
         LW,R15   R9
         BLZ      NORMEXIT
*
*                 PUT JOB INTO SYMFILE-LAST FLAG ON
*
JOBINS   EQU      %
         BAL,R4   OUTPUT
         B        INSOUPT           YES
*
*        AIFJE    - - JOB ENTRY ADD INPUT FILE (TELL GHOST)- -
*
         REF      SGC:NCB           SYM GHO COMM: NO COMM BUF
         REF      SSTAT             SYMFILE DIR FULL FLAG
         REF      AIFJE             * ADD INPUT FILE JOB ENT GFC
         REF      SGCQ              * SYM GHO COMM QUE (MEDIUM)
*
         LI,R10   OPNO
         MTB,0    SSTAT             FILE DIRECTORY FULL
         BNEZ     ABNEXIT
         MTW,-1   BL:IFS            * GRAB A SLOT
         BGZ      %+3               * ENUF THERE CONTINUE
         MTW,+1   BL:IFS            * NOT ENUF TELL USER
         B        DISMISS           *     VIA SYMBSAT.
*
         BAL,R11  NXTSID            ACQUIRE A SYS IDENT
         LI,R2    R8-23             *  (USER'S R8 I.E. SR1)
         STW,R12  *TSTACK,R2        *  TELL HIM THE SYSID
*
         LI,R12   AIFJE             *GFC IDENTIFIES SERVICE
         LW,R13   20,R6             * FILE STARTING DISC ADDR
         LW,R14   *TSTACK,R2        * SYSTEM IDENT
         LW,R4    J:JIT             GET CURRENT USER #
         STH,R4   R14               STORE FOR COM BUF
*
*
*        ARG      LNK,-,GFC  8,16,8
*                 SDA        32
*                 CUN,0,SYSID 8,8,16
*
*
         BAL,R4   SGCQ              TELL THE GHOST
         B        SGC:NCB           NO ROOM TO COMMUNICATE
*
FINIT    LI,R10   0
         LI,R11   X'FFFF'
         STS,R10  J:JIP             CLEAR JOBENT-IN-PROGRESS FLAG.
*
*                 NORMAL EXIT
*
NORMEXIT DESTRUCT MSRWRTX
*
*                 NOT SO NORMAL EXIT
*
ABNEXIT  SCS,R10  -7                ABN SUBCODE TO R10(0-6)
         AI,R10   X'3F'             ABN CODE TO R10(24-31)
         DESTRUCT RDERXIT           ---> GO REPORT ERROR.
*
*                 INSERT JOB IN OUTPUT
*
INSOUPT  LI,R10   NONSYMB
         REF      AOFNB             ADD OUTPUT FILE NON BATCH
*
         LI,R2    SV:TYM            # SYMB TYPES
         LI,R3    'LP'+X'F0000'
         CH,R3    SH:SYMT,R2        SEARCH TABLE
         BE       %+3
         BDR,R2   %-2               TRY AGAIN
         B        ABNEXIT           LP NOT SYMBIONT
*
*
         REF      SNDDXSIZ
         LI,R11   SNDDXSIZ
         DISABLE
         CW,R11   BL:OFS
         BLE      %+3
         ENABLE
         B        DISMISS
         MTW,-1   BL:OFS
         ENABLE
*
         BAL,R11  NXTSID            GET SYSID
         LW,R14   R12               MOVE FOR COMBUF
         LI,R2    R8-23             *  (USER'S R8 I.E. SR1)
         STW,R12  *TSTACK,R2        * PUT DOWN THE SYSID
*
*        AOFNB    - - ADD OUTPUT FILE NON-BATCH (GHOST CALL) - -
*
**** **** **** **** MUST ALLOW FOR FULL WORD DA HERE.
**** **** **** **** (& IN RBBAT).
L1       EQU      6                 6 = LP DEV TYPE
         LI,R12   L1                GET DCTX
         LW,R13   20,R6             FILE FDA FROM DCB
         LI,R2    1                 STORE COUNT
         STB,R2   R13
         SLS,R12  8                 MOVE OVER DCTX
         AI,R12   AOFNB              TO MAKE ROOM FOR GFC
         LW,R0    R9                USER SUPPLIED PRIORITY
         AND,R0   M4                  (MUST BE: 0 ... 15)
         STB,R0   R14                *
         LW,R2    CLK,R6            * *THE GRANULE SIZE OF THE FILE* *
*
*        ARG      R12 = 0,6,AOFNB   16,8,8
*                 R13 = COUNT,SDA   8,24
*                 R14 = PRIO,0,SYSID 8,8,16
*                 R2  = GRAN COUNT  32
*
         BAL,R4   SGCQ              TELL THE GHOST
         B        SGC:NCB           (NO ROOM TO COMMUNICATE)
*
         B        FINIT             JOIN REGULAR PROCESSING
*                                    (IN PROCESS OF COURSE)
         PAGE
*                 TEST STATUS OF JOB
*
JOBSTAT  LI,R4    R8-23             *  (USER'S R8 I.E. SR1)
         LW,R13   *TSTACK,R4        * USER SUPPLIED SYSID
         LI,R10   0                 * NULL COUNT (IN CASE SIMPLE)
         LI,R8    3                 * IS THAT NON-EXISTENT
         CW,R13   S:USID            *   *
         BG       NONAHED           * YEP, THAT'S IT
*
         LI,R8    1                 * IS THAT CURRENTLY RUNNING
*
         LI,R4    LPART             LEN OF CORE BAT TABLES
         CH,R13   PLH:SID,R4         * IS IT THERE
         BE       NONAHED            * YES, THEN NONE AHEAD
         BDR,R4   %-2                *     -KEEP LOOKING-
*                                    * NO, WASNT THER THIS INSTANT
*
*
*        MUST ASK GHOST THEN
*
         REF      JESTAT            JOBENT STATUS GFC
         REF      S:CUN             SYSTEM'S: CURRENT USER NUMBER
         REF      E:QA              SCHEDULAR EVENT: QUEUED FOR ACCESS
*
         LI,R12   JESTAT            * GFC
         LW,R14   S:CUN             * ASKER
         STB,R14  R13               * REPOSITIONED
*
*  JESTAT ARG12   LNK,-,GFC  8,16,8
*            13   S:CUN,-,SYSID     8,8,16
*            14   -                 32
*
         BAL,R4   SGCQ              ASK GHOST
         B        SGC:NCB            (NO ROOM TO COMMUNICATE)
*
         PSW,R6   TSTACK
         LI,R6    E:QA              QUEUED FOR ACCESS EVENT
         BAL,R11  T:REG             REPORT AND GIVE UP
*
         BAL,R11  JESNAFU           *DID HE DO US IN
*                                   --COME HERE,WERE OK
*                                   *IF HE DID WE REG AGAIN
         PLW,R6   TSTACK
         LW,R8    1,R1              GHOST ANSWER CODE
         LW,R10   2,R1              # TO RUN (IF ANY)
*
         BAL,R4   SGCR              RELEASE GHO COMM BUF
*
NONAHED  EQU      %
*        ANSWER TO USER
*        8        0 = COMPLETED
*                 1 = RUNNING
*                 2 = WAITING
*                       10 SAYS HOW MANY AHEAD
*                 3 = NONEXISTANT
*                 4 = WAITING ON OUTPUT
*
         LI,R4    R8-23              (USER'S R8 I.E. SR1)
         LCI      3
         STM,R8   *TSTACK,R4        STORE STAT,ID,COUNT
         B        NORMEXIT
*
*
*                 DELETE JOB FROM SYMBIONT QUEUE
*
DELJOB   RES      0
         REF      JEDEL             JOBENT DELETE GFC
         REF      SGCR              SYM GHO COM REL
         REF      SGCQ2             SYM GHO QUE  2
*
         LW,R13   R12               R13= SYSID OF JOB TO BE DELETED.
         LI,R12   J:ACCN
         BAL,R2   CHKBIT             SEE IF USER SPECIFIED ACCT
         NOP                        R12=>ACCT IF SO.
         CI,R12   X'1FFF0'          IS IT THRU REGISTERS
         BANZ     %+2               NOPE
         AW,R12   J:BASE            YEP
         LCI      2                 *  *
         LM,R15   *R12              R15/R0= USER'S OR USER-SPEC ACCT.
         CW,R15   J:ACCN            SEE IF ACCT
         BNE      C0CHK             NUMBER IS
         CW,R0    J:ACCN+1          USER'S OWN.
         BE       DELOK             IF SO, OK; IF NOT,
C0CHK    LB,R11   JB:PRIV           SEE IF USER
         CI,R11   X'C0'             HAS C0 PRIVILEGE.
         BGE      DELOK             ---> IF SO, OKAY.
         LI,R10   NOTYOURS          IF NOT,
         B        ABNEXIT           ---> ABORT HIM.
DELOK    EQU      %
         LW,R11   S:CUN             *    WHO FOR
         STB,R11  R13               *     *
         PSW,R6   TSTACK            SAVE DCB ADDRESS
*
*  JEDEL ARG12    LNK,-,GFC         8,16,8
*           13    USER NO.,-,SYSID  8,8,16
*           15,0  ACCT              64
*
         LI,R12   JEDEL             * WHAT TO DO
*                                   (12 RELOADED IF SGC:NCB)
         BAL,R4   SGCQ2             :: TELL THE GHOST
         BDR,R4   SGC:NCB            NO COMM BUFS
         LW,R1    R6                SAVE CONTEXT BUFFER ADDRESS
         LI,R6    E:QA              QUE USER FOR ACCESS
         BAL,R11  T:REG             GIVE UP TILL LATER
*
         BAL,R11  JESNAFU           * DID HE DO US IN
*                                   --COME HERE, WERE OK
*                                   * IF HE DID WE REG AGAIN
         PLW,R6   TSTACK
*
         LW,R10   1,R1              GHOST ANSWER
*                                     * 0= A O K
*                                     *3A= TOO LATE
*                                     *39= NOT YOUR SYSID
*
         BAL,R4   SGCR              RELEASE BUF PTD AT BY 1
*
         AI,R10   0
         BEZ      NORMEXIT          DELETED
         B        ABNEXIT           CODE IN 10
*
JESNAFU  EQU      %
         AI,R1    1                 *POINT AT COMM WRD 1
         MTB,0    *R1               * S:CUN STILL THERE
         BEZ      %+2               -NOPE, ANSWER IS
         AI,R11   -3                --USER BRK.;REG AGAIN
         BDR,R1   *R11              *(CORRECTING 1)
*                 GET SYMBIONT GRANULE OR DISMISS
*
RJEGSG   EQU      %
         LW,R11   SGB               *SYMB GRANS BOUGHT
         CW,R11   SGL               *SYMB GRAN LIMIT
*                                   *(IE HAVE WE BOUGHT TOO MANY)
         BG       DISMISS
         BAL,R11  GSG               GET A GRANULE
         LW,R14   R8
         BEZ      DISMISS
         MTW,+1   CLK,R6            *THATS ONE MORE COUNTED GRANULE* *
         B        *R10
*
*                 USE SECOND HALF OF GRANULE
*
RJEG2ND  AI,R8    1                 2ND HALF REL SECT IS +1
         LW,R14   R8                ANSWER REG
         B        NOFORELK
*
*
*                 SYMBIONT SATURATED...QUEUE FULL OR NO GRANULES
*
DISMISS  LI,R10   SYMSAT
         B        ABNEXIT
*
OUTPUT LW,R3      PRIMSK
         LS,R3    FUN,R6
         SLS,R3   -17
         CI,R3    1
         BLE      1,R4              INPUT
         B        0,R4              OUTPUT
*
*
*    GETFLD - CALLED BY JOB CARD SCAN
GETFLD   LI,R1    -1                INDEX TO R14-15
         LW,R14   BLANK             BLANK FIELD BUFFER
         LW,R15   BLANK
GETFLD1  AI,R4    1                 INC. POSITION IN CARD BUFFER
         AI,R10   1                 COUNT POSITION IN CARD
         CI,R10   79                END OF CARD??
         BGE      *R11              YES - RETURN
         LB,R5    0,R4              GET CHARACTER
         CI,R5    ','               END OF FIELD??
         BE       *R11
         CI,R5    '.'               END OF CARD??
         BE       *R11
         CI,R5    ' '               IGNORE BLANKS
         BE       GETFLD1
         AI,R1    1
         CI,R1    7
         BG       *R11              ONLY GET 8 CHAR MAX.
         STB,R5   R14,R1            STORE CHARACTER.
         B        GETFLD1
*
*
*  BADACCT - USER TRYING TO BATCH JOB IN ANOTHER ACCT
*            OR WITH A HIGHER THAN LEGAL PRIVELEGE
*
BADACCT  LI,R10   ACCTBAD           USER HAS BAD ACCT OR PRIO
         B        ABNEXIT
         PAGE
*F*      NAME:    T:JECLS
*F*      PURPOSE: FREE GRANULES FROM PARTIAL JOBENT FILE AT JOBSTEP.
*F*               CALLED FROM STEP AND LNKTRC.
*D*      NAME:    T:JECLS
*D*      REGISTERS: ALL ARE VOLATILE.
*D*      CALL:    BAL,R11 T:JECLS
*D*            OR OVERLAY MISOVSEG,T:JECLS#
*D*      INTERFACE: QUEUE,IOSPIN,RSG.
*D*      ENVIRONMENT: MASTER MAPPED.
*D*      INPUT:   R11= LINK REGISTER.
*D*               R6= DOUBLEWORD ADDRESS OF DCB USED FOR JOBENT.
*D*      DESCRIPTION: THE JOBENT DCB CONTAINS SEVERAL DISC ADDRESSES
*D*               DESCRIBING THE PARTIALLY-BUILT SYMBIONT FILE TO BE
*D*               DELETED...
*D*               WORD 20 = FIRST DISC ADDRESS OF FILE.
*D*               WORD 21 = LAST DISC ADDRESS OF FILE.
*D*                 WORD 0 OF EACH DISC BLOCK POINTS TO NEXT BLOCK.
T:JECLS  EQU      %
         PUSH     R11               SAVE RETURN ADDRESS.
         LCW,R7   R6
         AWM,R7   J:JIP             CLEAR DCBADDR IN J:JIP.
         SLS,R6   +1                R6 = WA(JOBENT DCB).
         LW,R10   20,R6             R10= FDA (JOBENT FILE).
         BEZ      RELDONE           --->NO FDA MEANS NO CLEANUP.
CALJBCM  CW,R10   21,R6               SEE IF CURR DA IS ALSO LAST.
         BE       CALJBFN           --->IF SO, NO READING NEEDED.
         STW,R10  CDA,R6              PREPARE TO READ CURR DA.
         LI,R5    BAFCN
         MTB,1    *R6,R5            I/O OUTSTANDING TO DCB
         LW,R8    R6
         LW,R13   Y001
         STS,R13  WAT,R6
         BAL,R11  QUEUE
         BAL,R11  IOSPIN
         LW,R11   QBUF,R6           BUFFER
         LW,R10   *R11              FLINK
         BEZ      CALJBFN           --->END OF FILE.
         LW,R8    CDA,R6            CDA
         CI,R8    1
         BAZ      CALJBCM           --->EVEN; DONT RELEASE YET.
         AI,R8    -1                    ODD. RELEASE EVEN SECTOR.
         BAL,R11  RSG
         BEZ      RELDONE           --->*** BAD DA.  QUIT RIGHT NOW.
         LI,R8    0
         STW,R8   CDA,R6            ZAP CDA.
         B        CALJBCM           --->GO ON RELEASING.
CALJBFN  LW,R8    CDA,R6
         BEZ      RELDONE           --->ALL DONE IF NO CDA NOW.
         BAL,R11  RSG                   RELEASE LAST GRANULE.
RELDONE  EQU      %
         PULL     R11               RESTORE RETURN TO STEP.
         DESTRUCT                   --->AND RETURN.
         END

