         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
         SYSTEM   UTS
         DEF      T:JOBENT
         REF      BL:IFS            * BATCH LIM: IN FIL SLOTS
         REF      BL:OFS            * BATCH LIM: OUT FIL SLOTS
         REF      MUPO              *  (JIT FLAG)
         REF      CHKBIT1           * PLIST SCAN SETUP
         REF      CHKBIT            * PLIST SCAN
         REF      SV:TYM
         REF      SH:SYMT
         REF      Y04,GSG
         REF      M4
         REF      X7
         REF      QUEUE,DCT4,Y002
         REF      SGB               * CNT DISC GRANS IN USE
         REF      SGL               * LIM DISC GRANS AVAIL
         SREF     SNDDX
         REF      S:USID
         REF      T:REG             * SCHEDULAR: REPORT EVENT &GIVE UP
         REF      J:JIT
         REF      LPART             * LEN OF CORE BAT TABLES
         REF      NXTSID            * GET NEXT SYSID SUBR
         REF      PLH:SID           * GUYS NOW RUNNING
         REF      Y001
         REF      CKLIMIT
         REF      UH:FLG2,CALBAD
         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
SR4      EQU      11
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
MIXFUNC EQU       X'38'             MIXED FUNCTION
NOTAUTH  EQU      X'37'             NOT AUTHORIZED
OPNO     EQU      X'36'             OPERATOR SAYS NO
IN       EQU      1                 INPUT FUNCTION CODE
Y3F      GEN,8,24 X'3F',0
M24      GEN,8,24 0,-1
PRIMSK   GEN,8,8,16 0,-1,0
BLKSIZE  GEN,15,17 X'400',0
FUNCIN   DATA     IN**17
FLG:LIC  EQU      X'800'            UH:FLG2 MASK:  RT USER 'LOCKED'
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      %
         PSW,R11  TSTACK            SAVE SR4...=OBAL ADD.
*
*                 INSURE THAT REQUEST IS NOT COMING  FROM A REAL-TIME
*                 USER THAT IS LOCKED-IN-CORE AND BLOCKING ANY SYSTEM
*                 GHOST JOB FROM RUNNING
*
         LW,R1    S:CUN             CURRENT USER #
         LH,R11   UH:FLG2,R1
         CI,R11   FLG:LIC           IS USER LOCKED-IN-CORE?
         BAZ      JOB1              NO
         PUSH     9,R15             SAVE VULNERABLE REGISTERS
         LI,R4    3                 RBBAT'S USER #
         BAL,R6   RTSIZE            SEE IF RBBAT FITS IN AVAILABLE CORE
         STCF     R11               SAVE RTSIZE STATUS
         PULL     9,R15             RESTORE VULNERABLE REGISTERS
         LC       R11               DOES RBBAT FIT?
         BCR,1    JOB1              YES
         PLW,R11  TSTACK            RESTORE STACK FOR EXIT
         LW,R14   RTERR             SET UP FOR ABORT
         LI,R11   CALBAD            RETURN ADR. FROM T:SELFDESTRUCT
         B        T:SELFDESTRUCT
JOB1     EQU      %
*
         LW,R1    0,R7
         BEZ      JOBSTAT           NO PARAMS--STATUS CHECK
         LCI      7
         PSM,R5   TSTACK            MAKE CHKBIT HAPPY
         LI,R11   X'1FFFF'
         LW,R10   ABA,R6            GET ABN FROM DCB
         BAL,R2   CHKBIT1
         LW,R10   R12               OR PLIST
         LW,R2    FCD,R6
         CW,R2    Y002
         BANZ     ABNEXIT2          DCB OPEN
         LI,R8    1                 FORCE ASN=1
         LI,R9    X'F'
         STS,R8   ASN,R6
         STS,R10  ABA,R6            PUT INTO DCB
         LW,R10   BUF,R6            BUFF FROM DCB
         BAL,R2   CHKBIT
         LW,R10   R12               OR PLIST
         STS,R10  BUF,R6            STORE IN 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    MUPO+J:JIT        JOB IN PROGRESS
         BEZ      FUNCOK            NO
         CS,R8    FUN,R6            FUCNTION CHANGE
         BE       FUNCOK+1          NO-GOOD
         LI,R5    MIXFUNC           YES--SET ERROR 3F38
         B        FUNCOK            CONTINUE TESTING
FUNCBD   EQU      %
         LW,R10   R5                MOVE ERROR CODE
         BUMP     -7,R1
         B        ABNEXIT           KILL HIM
FUNCOK   EQU      %
         STS,R8   FUN,R6            PUT INTO DCB
         LI,R9    -1                PRIOR.-NONE
         BAL,R2   CHKBIT
         LW,R9    R12
         LW,R10   BLKSIZE
         LS,R10   FLP,R6
         STW,R10  FLP,R6            BLK SIZE TO DCB
         LS,R11   BUF,R6            BUFF FROM DCB
         LW,R4    R11
         STW,R11  QBUF,R6           QBUF
         BAL,R2   CHKBIT
         B        DELJOB            DELETE REQUEST R12=ID
         CI,R5    0                 TEST FOR ANY ERRORS
         BNEZ     FUNCBD            YES--ERROR THE GUY
         LI,R1    -7                * REMOVE CHKBIT DISP
         MSP,1    TSTACK            * FROM STACK.
         LW,R7    R11               MOVE BUFFER ADDRESS
         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:JIT+MUPO
         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,R10  RJEGSG            NO-GET A GRANULE
         STW,R14  20,R6             STORE IT AS FIRST
         STW,R14  21,R6             AND AS CURRENT
         BAL,R4   OUTPUT    ?
         B        FSTDONE           OUTPUT ENTRY
         SPACE 2
         LW,R10   TSTACK
         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       FSTDONE           OK--ITS A JOB CARD
         LI,R10   BUFFBAD           ERROR
         B        ABNEXIT
FSTDONE  RES      0
         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   MUPO+J:JIT        FLAG FOR END RUN
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
RJEG2RET 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
         REF      IOSPIN
         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    -8                *  (HIS 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  MUPO+J:JIT        CLEAR FLAG
*
*                 NORMAL EXIT
*
NORMEXIT LI,R8    0
         LI,R10   0
NORMEXT1 PLW,R11  TSTACK
         DESTRUCT
*
*                 NOT SO NORMAL EXIT
*
ABNEXIT  LI,R9    X'1FFFF'
         LS,R9    ABA,R6            GET ABN FROM DCB
         LW,R8    R9                SET IN SR1
ABNEXIT1 SLS,R10  17
         OR,R10   R6
         OR,R10   Y3F               SET ABN CODE IN SR3
         B        NORMEXT1
ABNEXIT2 LI,R1    -7
         MSP,1    TSTACK
         AND,R11  R10
         LW,R8    R11               ABN TO REG 8
         LI,R10   DCBOPEN
         B        ABNEXIT1
*
*                 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    -8                *DISP TO HIS 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   M24                *
         LS,R13   20,R6             FILE SDA 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    -8
         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    -8                DISP TO USER REG 8
         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      ACCN              JIT USER ACCOUNT
         REF      SGCR              SYM GHO COM REL
         REF      SGCQ2             SYM GHO QUE  2
*
         LI,R14   -7                * REMOVE CHKBIT OFFSET
         MSP,14   TSTACK            * FROM TSTACK.
*
         LCI      2                 *  *
         LM,R15   J:JIT+ACCN        * USERS ACCOUNT
*
         LW,R13   R12               * FETCH UP THAT SYSID
         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
*
*
         PAGE
         END

