         DEF      DISPLAY
         REF      AVRNOU
ANSPROC  SET      1
         SYSTEM   UTS
         REF      AVRID,Y4
RBCODE   SET      1                 TURNS ON REMOTE BATCH DISPLAYS
         REF      CVSYSID
         REF      GMB,RMB,GMBSIZ
         REF      KPLB
         REF      AVRTBLNE
         REF      AVRFNMT,ANSFLGS
         SREF     NSCPU             NUMBER OF SLAVE CPUS
         SREF     S:MPDISP          DISPLAY FLAG FOR SLAVE CPUS
         SREF     TXMOOSE           TEXTC OF MOOSE
         REF      T:GJOBSTRT        START OF GHOST
         PAGE
         CSECT    0
DISPLAY  EQU      %
*                 SYMBOLIC REGISTER DEFINITIONS.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5        EQU       5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*ROUTINE TO DISPLAY SPECIFIED MONITOR INFORMATION
*ENTERED BY KEY-IN ROUTINE BECAUSE OF UNSOLICITED KEY-IN OF THE FORM:
*!DISPLAY (OPTION)(NL)
*IF (OPTION) EQUALS:
*DISC
*THEN LIST ON THE OC DEVICE:
*(NL)USER = (# OF GRANULES) (SYMBIONT = (# OF GRANULES))(NL)          41
*
*TAPES
*THEN LIST ON THE OC DEVICE FOR EACH TAPE DRIVE IN THE SYSTEM:        30
*(NL)(YYNDD) (EMPTY|SCRATCH|USER|SYSTEM) (REEL#) (IN USE|AVAILABLE)(NL)
*
*(SYSTEM ID)
*THEN CALL RBBAT TO LIST SYMFILE INFO ON THE OC
*
*JOB
*THEN LIST ON THE OC DEVICE FOR THE CURRENTLY ACTIVE JOBS:
*THE ID,PARTITION AND ACCOUNT OF THE JOB
*
*(NO OPTION),Q,OC
*THEN CALL RBBAT TO LIST ALL SYMFILE INFO ON THE APPROPRIATE DEVICE
*
*USER                                                                RL3
*THEN LIST ON THE OC DEVICE THE USERS: BATCH, ON-LINE, AND ASLEEP    RL3
*                                                                    RL3
*(R5)=JOB INFO TABLE ADDRESS
*(R7)=KEY-IN PARAMETER LIST ADDRESS
*(SR1)=CURRENT KEY-IN MESSAGE CHARACTER
*        B        KIDIS
         PAGE
         REF      KEYINR,KEYERR,SSIG
         REF      GKIFLD,KFL,NXKICHR
         DEF      KIDIS
KIDIS    EQU      %
         B        KIDIS1
         BAL,SR4  NXKICHR           GET NEXT DELIMITER
KDS00    CI,SR1   X'40'             SPACE DELIMITER
         BE       %-2               YES,TRY AGAIN
KIDIS1   EQU      %
         CI,SR1   X'15'             NO OPTION(NEW LINE DELIMITER FOUND)
         BE       KDS01             YES
         BAL,SR4  GKIFLD            YES,GET OPTION
         BCR,8    KDS00             OPTIONLENGTH,IF CORRECT,BRANCH
         LW,R0    KFL,R7            NO OPTION(LENGTH.EQ.0)
         BEZ      KDSNOP            YES
KDSERR   B        KEYERR            NO,ERROR EXIT
KDS01    EQU      %
         LW,R0    KFL,R7
         BEZ      KDSNOP
         LI,R1    OPTION#
         LW,R0    KPLB,R7
         CW,R0    OPTIONS,1
         BE       KDGCK
         BDR,1    %-2
         LW,R0    SNDDX
         BEZ      KEYERR
         BAL,SR4  CVSYSID
         BCR,8    KDSYID
         B        KEYERR
KDGCK    EQU      %                 IF THE OPTION DOES NOT CALL RBBAT GET A MONI
         CI,R1    GHOPT             BUFFER BEFORE EXITING TO THE OPTION ROUTINE
         BLE      OPTBL,R1
         BAL,15   BLKIT
         B        OPTBL,R1
         PAGE
*
*INPUT MESSAGE PARAMETERS
*
OPTIONS  DATA     %-1
KDSPACES TEXT     '    '            SPACES
         TEXT     'DISP'
         TEXT     'Q   '
         TEXT     'NORU'
         TEXT     'OC  '
         TEXT     'SYMB'
         TEXT     'OUTP'
         TEXT     'CPU'
GHOPT    EQU      %-KDSPACES
         DO       RBCODE
         TEXT     'RBT '
         FIN
KDSDISC  TEXT     'DISC'
KDSJOB   TEXT     'JOB '
KDVOLU   TEXT     'VOLU'
KDSTAPES TEXT     'TAPE'
KDSUSER  TEXT     'USER'                                             RL3
KDSPACK TEXT      'PACK'
         TEXT     'COC'
         TEXT     'RES'
*
OPTION#  EQU      %-KDSPACES
OPTBL    DATA     %-1
         B        KDSNOP
         B        KDSNOP
         B        KDSNOP
         B        KDSNOR
         B        KDSOC
         B        KDSYM
         B        KDOUT
         B        KDCPU
         DO       RBCODE
         B        KDRBT
         FIN
         B        KDS04
         B        KDS07
         B        KDSVOL
         B        KDSTAP
         B        KDS08
       B          KDPACK
         B        KDSCOC
         B        KDSRES
*OUTPUT MESSAGE PARAMETERS
*
KDSUSER1 TEXT     '
USER = '
KDSDC    TEXT     ' DC '
KDSDP    TEXT     ' DP '
KDSYMB   TEXT     ' SYMBIONT = '
KDSEMPTY GEN,40,24 'EMPTY',
KDSCRACH TEXT     'SCRATCH '
KDSUSER2 TEXT     'USER    '
KDPUBLIC TEXT     ' PUBLIC '
KDLOCKED TEXT     ' LOCKED '
KDSHARE  TEXT     ' SHARED '
KDID     GEN,24,8 'ID=',
KDSYSTEM TEXT    'SYSTEM'
KDSAVAIL GEN,40,24 'AVAIL',
ALLOHEADS EQU     '    BATCH ON-LINE GHOST'
ALLOHEAD DATA,1   S:NUMC(ALLOHEADS)+2,X'15',S:UT(ALLOHEADS),X'15'
         BOUND    4
COCHEADS EQU      'LINE# ID'
COCHEAD  DATA,1   S:NUMC(COCHEADS)+2,X'15',S:UT(COCHEADS),X'15'
         BOUND    4
         PAGE
*
*DISC OPTION
*
         REF      SNDDX,Y15
KDS04    EQU      %
         REF      GRANRAD
         LW,D2    GRANRAD
         BAL,SR2  CONVERT
         LI,R3    8                 INITIALIZE OC LIST CHARACTER INDEX
         LW,R0    KDSUSER1          '(NL)USE'
         LW,R1    KDSUSER1+1        'R = '
         STW,R0   0,R6              TO OC LIST
         STW,R1   1,R6              MESSAGE BUFFER
         BAL,SR2  KDS8CHM           USER GRANULE COUNT TO OC LIST MSG
         LW,D3    KDSDC
         BAL,SR2  KDS8CHM           PUT 'DC' INTO MESSAGE
         REF      GRANPACK
         LW,D2    GRANPACK
         BAL,SR2  CONVERT
         BAL,SR2  KDS8CHM           PUT IN MESSAGE
         LW,D3    KDSDP
         BAL,SR2  KDS8CHM
         LI,R2    KDSYMB            YES,SET TO EDIT ' SYMBION'
         BAL,SR2  KDS8FRTO          TO OC LIST MESSAGE
         LW,D3    KDSYMB+2          'T = '
         BAL,SR2  KDS8CHM           TO OC LIST MESSAGE
         REF      GRANSYM
         LW,D2    GRANSYM
         BAL,SR2  CONVERT
         BAL,SR2  KDS8CHM           SYMB GRAN COUNT TO OC LIST MSG
         LW,D3    Y15
KDS04A   BAL,SR2  KDS8CHM           TO OC LIST MESSAGE BUFFER
KDS09B   EQU      %
         BAL,15   TYPEIT
         B        RELXX
         PAGE
*ROUTINE TO COUNT DISC GRANULES AND CONVERT SAME TO EBCDIC
*D2 = COUNT
*D3 = ANS
*BAL,SR2
*RETURN
*
CONVERT  RES      0
         LI,D3    0                 CLEAR EBCDIC COUNT                  020
KDSGC05  LI,D1    0                 EXTEND DISC GRANULE COUNT
         DW,D1    XA                /10
         AI,D1    X'F0'             ADD EBCDIC BIAS TO DIGIT
         SLD,D3   -8                POSITION EBCDIC GRANULE COUNT       020
         STB,D1   D3                EDIT IN DIGIT                       020
         AI,D2    0                 CONVERSION DONE                     020
         BNEZ     KDSGC05           NO,LOOP                             020
         B        *SR2              EXIT
         PAGE
*ROUTINE TO MOVE UP TO 8 CHARACTERS TO OC LIST MESSAGE BUFFER
*(R2)=ADDRESS AT WHICH CHARACTERS ARE LOCATED
*        BAL,SR2  KDS8FRTO
KDS8FRTO EQU      %
         LW,D3    0,R2              PICK UP 8 CHARACTERS
         LW,D4    1,R2              TO MOVE TO MESSAGE BUFFER
*(R3)=OC LIST CHARACTER INDEX
*(R6)=MESSAGE BUFFER ADDRESS
*(D3)AND(D4) CONTAIN THE CHARACTERS
*        BAL,SR2  KDS8CHM
KDS8CHM  LB,R0    D3                MOST SIGNIFICANT CHARACTER.EQ.NULL
         BEZ      *SR2              YES,EXIT
         STB,R0   *R6,R3            NO,MOVE TO MESSAGE BUFFER
         AI,R3    1                 INCR.CHARACTER INDEX
         SLD,D3   8                 POSITION NEXT CHARACTER
         B        KDS8CHM           LOOP
         DEF      DISPENT
DISPENT  RES      15
         PAGE
*
*        ROUTINE TO PROCESS DISPLAY CPU , STATE OF EACH
*           OF SLAVE CPUS FOR MULTIPROCESSING SYSTEMS
*        ACTUAL DISPLAY DONE BY MOOSE GHOST
*           HERE ONLY SET S:MPDISP  AND GJOBSTRT MOOSE
*
KDCPU    EQU      %
         LI,4     NSCPU             ANY SLAVE CPUS
         BEZ      KEYERR            NO,ERROR
         MTW,1    S:MPDISP          SET DISPLAY FLAG
         LD,0     TXMOOSE           GO START UP MOOSE
         BAL,10   T:GJOBSTRT
         B        KEYINR
         PAGE                                                        RL3
         PAGE
         SREF     LNOL,LB:UN,COC
KDSCOC   EQU      %
         LI,D3    COC               COC-LESS SYSTEM
         BNEZ     COC0              NO
         LW,D3    R6                MB
         BAL,11   RMB               GIVE IT BACK
         B        KEYERR
COC0     EQU      %
         LI,D3    BA(COCHEAD)       COC HEADING
         ANLZ,D4  BAMB              BYTE ADDRESS MONITOR BUFFER
         LB,R3    COCHEAD
         STB,R3   D4                COUNT
         MBS,D3   1                 MOVE HEAD SKIPPING COUNT
         BAL,15   TYPEIT
         LI,5     0
COC1     EQU      %
         MTB,0    LB:UN,5           ID
         BEZ      COC2
         STB,5    D2                LINE#
         PUSH     R6                SAVE BUFFER ADDRESS
         LI,6     2                 # POSITIONS CONVERT
         BAL,11   XTOBCD            CONVERT
         OR,D3    ='  '**16
         PULL     R6                RESTORE BUFFER ADDRESS
         STW,D3   0,6
         LB,D2    LB:UN,5           ID
         LI,R3    4                 INIT BUFFER INDEX
         BAL,R0   4BYTE
         LW,D3    Y15               CR
         BAL,SR2  KDS8CHM
         BAL,15   TYPEIT
COC2     EQU      %
         AI,5     1
         CI,5     LNOL
         BL       COC1
         B        RELXX
         PAGE
         REF      SH:RBCU,SH:ROCU,SH:RGCU,SV:RSIZ,SB:RTY,TB:FLGS,SH:RNM
KDSRES   EQU      %
         LI,D3    BA(ALLOHEAD)      ALLOCATION HEADING
         ANLZ,D4  BAMB              BYTE ADDRESS MONITOR BUFFER
         LB,R3    ALLOHEAD          COUNT
         STB,R3   D4
         MBS,D3   1                 MOVE HEAD SKIPPING COUNT
         BAL,15   TYPEIT
         LI,5     SV:RSIZ           RESOURCE TABLE SIZE
RES0     EQU      %
         LB,3     SB:RTY,5          TYPE
         CI,3     X'FF'             NOT RESOURCE
         BE       RES2
         LB,3     TB:FLGS,3         FLAGS
         SLS,3    -6                TYPE BITS
         CI,3     2                 1 0 = TAPE; 1 1 = DISC
         BL       RES2              NOT OF INTEREST
         LH,3     SH:RNM,5          TEXT
         SLS,3    16                LEFT JUSTIFY
         AI,3     '  '
         STW,3    0,6
         LH,D2    SH:RBCU,5         BATCH ALLOCATION
         BAL,SR2  CONVERT
         LI,3     6                 BUFFER INDEX
         BAL,SR2  KDS8CHM           IN BUFFER
         LH,D2    SH:ROCU,5         ON-LINE ALLOCATION
         BAL,SR2  CONVERT
         LI,3     13                INDEX
         BAL,SR2  KDS8CHM           IN BUFFER
         LH,D2    SH:RGCU,5         GHOST ALLOCATION
         BAL,SR2  CONVERT
         LI,3     20                INDEX
         BAL,SR2  KDS8CHM           IN BUFFER
         LW,D3    Y15               CR
         BAL,SR2  KDS8CHM           IN BUFFER
         BAL,15   TYPEIT
RES2     EQU      %
         BDR,5    RES0
         B        RELXX
BAMB     MTB,0    *6                SUBJECT FOR ANLZ
         PAGE
*ROUTINE TO DISPLAY USERS                                            RL3
**       FORMAT IS:  BATCH:  ID, ID, ID, ID, ID                      RL3
*                    ONLINE: ID, ID, ID, ID, ID, ID, ID, ID, ID, ID; RL3
*                            ID, ID, ID                              RL3
*                    ASLEEP: ID, ID
         REF      SW                                                 RL3
         REF      UB:US                                              RL3
         BOUND    8                                                  RL3
MESS     TEXT     '
BATCH: '                                         RL3
         TEXT     '
ONLINE:'                                         RL3
         TEXT     '
ASLEEP:'                                         RL3
NXTL     GEN,8,56 X'15','       '
KDS08    EQU      %                                                  RL3
         LI,7     -1
BUFMESS  EQU      %                                                  RL3
         LI,R3    0
         MTW,1    7
         LD,D3    MESS,7
         BAL,SR2  KDS8CHM
START    LI,4     SMUIS             INDEX ON MAX USERS
         LB,1     UB:US,4           USER?
         REF      SNULL             NULL STATE
         CI,1     SNULL             FOR EMPTY USER SLOTS
         BNE      TEST              YES, GOT AN ACTIVE USER
LOOP     BDR,4    START+1
         CI,3     8
         BNE      OUTPUT-1          NO
         CI,7     2                 FINISHED
         BNE      BUFMESS           NO
KDREL    LW,14    6
         B        RELXX
TEST     CI,1     SW                ASLEEP
         BNE      TEST1             NO
         CI,7     2                 HIS TURN
         BNE      LOOP              NO
         BAL,11   UBAT              BATCH [ ON-LINE
         B        IDER              ON-LINE USER #
         B        IDER+1            BATCH SYSID
TEST1    BAL,11   UBAT
         B        TEST2
         CI,7     0
         BE       IDER+1
         B        LOOP
TEST2    CI,4     1
         BE       LOOP
         CI,7     1
         BNE      LOOP
IDER     LW,D2    4                 ID FOR SLEEP,ONLINE
         BAL,0    4BYTE
         CI,4     1                 LAST ENTRY
         BE       OUTPUT            YES-WRITE IT
         CI,3     57
         BE       TLINE             YES
         LI,2     ','               EDIT COMMA
         STB,2    *6,3
         AI,3     1
         B        LOOP              GET NEXT ID
TLINE    EQU      %
         LI,2     ';'               EDIT SEMI-COLON
         STB,2    *6,3
         AI,3     1
         B        OUTPUT
         MTW,-1   3
OUTPUT   BAL,15   TYPEIT
         LD,D3    NXTL
         BAL,SR2  KDS8CHM
         B        LOOP
         PAGE
*
*        USES:    R1,R2,R4,D2
*        ENTER:   BAL,11
*        RETURN:  *11 IF
*                  1. NOT BATCH
*                  2. NOT FOUND IN PLB:USR
*                 *11+1 WHEN FOUND, SID IN D2
*
UBAT     CI,4     SMUIS
         BG       *11
         LI,1     X'100'
         CH,1     UH:FLG,4
         BAZ      *11
         LI,2     LPART
NEXT     CB,4     PLB:USR,2         FIND HIM
         BE       FOUND
         BDR,2    NEXT
         B        *11
FOUND    LH,D2    PLH:SID,2         GET HIS ID
         MTW,1    11
         B        *11
F0TO40   PUSH     6
         LW,6     Y8
         LW,D4    KDSPACES
F0T40L   LB,D1    D3,6
         BEZ      F0T40
         CI,D1    X'F0'
         BE       F0T40
         PULL     6
         B        *11
F0T40    STB,D4   D3,6
         BIR,6    F0T40L
         PAGE
* SIXBACK RETURNS A SIX CHARACTER SERIAL #
* R2=HASHED SERIAL #
* SR1-SR2=EBCDIC SIX CHARACTER SERIAL # LEFT JUSTIFIED
* CALL: BAL,SR4   SIXPACK
*
SIXBACK  EQU      %
         PUSH      4,R3
         SLD,R2   -20
         SLS,R3   -12
         LW,R5    R3
         LI,R6    6
SIXBACK1 EQU      %
         SLD,R2   -2
         SLS,R3   -26
         LI,R4    0
         DW,R4    XA
         OR,R3    R4
         BEZ      %+2
         AI,R3    X'80'
         AI,R3    X'40'
         SLD,SR1  -8
         STB,R3   SR1
         BDR,R6   SIXBACK1
         PULL     4,R3
         B        *SR4
         REF      XA
         PAGE
*
*JOB OPTION
*
         REF      UH:FLG
         REF      PLH:SID
         REF      SMUIS
         REF      LPART
         REF      PLD:ACT
         REF      Y2,JTYPEA
         REF      PLB:USR
         REF      IDTOBCD,XTOBCD
KDS07    RES      0                 ENTRY
         LI,7     LPART
NEXTPART RES      0
         MTH,0    PLH:SID,7         TEST FOR ACTIVE
         BEZ      KDSL
         LD,D1    PLD:ACT,7
         BEZ      KDSL
         LW,5     6
         SLS,5    2                 BA
         LI,4     BA(PART)          BA SOURCE
         AW,5     Y2                32 BYTES
         MBS,4    0
         LW,5     D3                BUFFER
         STW,D1   4,5
         STW,D2   5,5
         PAGE
*        D2= INPUT
*        6=BUFFER
*        3=OFF SET
         SPACE 2
         LH,D2    PLH:SID,7
         SLS,13   16
         BAL,11   IDTOBCD           D3=ANSWER
         STW,D3   1,5               ID
         LW,13    7
         SLS,D2   24
         LI,6     2
         BAL,11   XTOBCD            6=# OF BYTES  TO CONVERT
         LI,4     14+1
         STH,D3   *5,4
         LW,6     5
         LI,3     32
         BAL,15   TYPEIT
KDSL     RES      0
         BDR,7    NEXTPART
RELXX    EQU      %
         LI,11    KEYINR
         B        RMB
PARTS    EQU      'ID=     ACCNT=          PART=  '
PART     DATA,1   X'15',S:UT(PARTS)
         BOUND    4
         PAGE
*
*
         REF      KDISPGFC,KSGCQ,DCT16
         DO       RBCODE
         REF      RBB:ID,RBLIMS,SYMX,SYMTABCK
         SREF     RBD:WSN,RB:FLAG,LOFBIT,DISCBIT
         SREF     SSSBIT,FRBIT,LIPBIT,ACTBIT
         SREF     ALBIT,DCBIT,HASPBIT
         SREF     RBB:HOU,STB:LNK,RBB:HIN
         FIN
*
*
KDSYID   EQU      %                 FOR THE RBBAT DISPLAY KEYINS R12 HAS THE GFC
         LW,14    R2                AND R13 AND R14 ARE AS FOLLOWS
         LI,13    1                 :
         B        KDGQ                 OPTION       R13         R14
KDSNOP   EQU      %                    ------       ---         ---
         LI,13    0                 :
         LI,14    0                  (NO OPTION)     0           0
         B        KDGQ                    Q          0           0
KDSNOR   EQU      %                      OC          0          -5
         LI,13    -1                   NORUN         -1         -5
KDGQ1    EQU      %                     (ID)        1           (ID)
         LI,14    -5                   SYMB     -2       -
KDGQ     EQU      %                    OUTPUT   -3      -5
         LI,12    KDISPGFC          WITH THESE CODES IN THE REGISTERS KSGCQ IS C
         B        KSGCQ             TO TELL THE GHOST.
KDSOC    EQU      %
         LI,13    0
         B        KDGQ1
KDSYM    EQU      %
         LI,13    -2
         B        KDGQ
KDOUT    EQU      %
         LI,13    -3
         B        KDGQ1
*
*
         DO       RBCODE
*
KDRBT    EQU      %                 DISPLAY RBT
         LW,5     RBLIMS+1          :
         CW,5     RBLIMS            IF RBB:ID = 0 AND LIPBIT ISN'T SET SAY
         BL       RELXX             'EMPTY'  IF LIPBIT IS SET SAY 'LOGGING ON'
         LD,14    DCT16,5           IF RBB:ID =/ 0 SAY THE STATE OF THE
         STW,14   *R6               RBT DEPENDING ON:
         STW,15   1,R6              :
         LW,14    DASH              LOFBIT +DISCBIT  --  LOGGING OFF
         STW,14   2,6               SYMX=1 AND FRBIT --  INACTIVE
         LW,10    RB:FLAG,5         SYMX=1 AND NO FRBIT  -- INPUTTING
         CW,10    ALBIT
         BANZ     KDRBT3
         CW,10    DCBIT
         BANZ     KDRBT3
         LB,13    RBB:ID,5          SYMX=2 AND SSSBIT  --  SUSPENDED
         BEZ      KDRBT1            SYMX=2 AND NO SSSBIT -- OUTPUTTING
KDRBT3   EQU      %
         LD,14    RBD:WSN,5         :
         STW,14   3,6               ONE MESSAGE IS OUTPUT FOR EACH RBT.
         STW,15   4,6
         LW,14    DASH
         STW,14   5,6
         LB,13    RBB:ID,5
         BAL,9    CONVERT
         SLS,14   -8
         CI,14    X'40'
         BAZ      %-2
         OR,14    KDSPACES
         STW,14   6,6
         LW,14    DASH
         STW,14   7,6
         LI,13    20
         LI,1     0
         CI,10    ACTBIT+LIPBIT
         BAZ      KDRBT2
         CI,10    ACTBIT
         BAZ      KDRBT2-1
         LI,R1    2
         CI,10    LOFBIT+DISCBIT
         BANZ     KDRBT2
         CW,10    HASPBIT
         BAZ      KDRBT4
         LI,1     7
         LB,3     RBB:HIN,5
         BNEZ     KDRBT2
         LB,R3    RBB:HOU,5
         BEZ      KDRBT35
         LB,11    SSIG,3
         BNEZ     KDRBT2
         LB,3     STB:LNK,3
         BNEZ     %-3
KDRBT35  EQU      %
         LI,1     5
         B        KDRBT2
KDRBT4   EQU      %
         AI,R1    1
         LB,2     RBB:HIN,5
         BEZ      KDRBT5
         AI,R1    2
         CW,10    FRBIT
         BANZ     KDRBT2
         B        KDRBT2-1
KDRBT5   EQU      %
         LB,2     RBB:HOU,5
         BEZ      KDRBT35
         CI,10    SSSBIT
         BANZ     KDRBT2
         AI,R1    1
KDRBT2   EQU      %
         LD,2     RBPTRS,1
         AW,3     6
         AI,3     3
         SLS,3    2
         AW,3     13
         LB,14    3
         AW,14    13
         AI,14    12
         MBS,2    0
         LW,3     14
         AI,5     -1
         LI,15    KDRBT+1
         B        TYPEIT
KDRBT1   EQU      %
         LI,R1    0
         CI,10    LIPBIT+ACTBIT
         BAZ      KDRBT2
         B        KDRBT2-1
*
*
*
DASH     TEXT     ' -- '
EMPM     TEXT     'EMPTY'
LGNM     TEXT     'LOGGING ON'
INPM     TEXT     'INPUTTING'
OPTM     TEXT     'OUTPUTTING'
INACM    TEXT     'INACTIVE'
SUSM     TEXT     'SUSPENDED'
LGFM     TEXT     'LOGGED OFF'
HACTM    TEXT     'ACTIVE'
PTR      COM,32,10,22  BA(AF(1)),AF(2),0
         BOUND    8
RBPTRS   EQU      %
         PTR      EMPM,5
         PTR      LGNM,10
         PTR      LGFM,10
         PTR      SUSM,9
         PTR      OPTM,10
         PTR      INACM,8
         PTR      INPM,9
         PTR      HACTM,6
*
*
*
         FIN
         PAGE
TYPEIT   EQU      %
         LW,14    3
         LW,13    6
         PUSH     15
         PUSH     2,4
         BAL,11   JTYPEA
         NOP
         PULL     2,4
         PULL     15
BLKIT    PUSH     2,1
         BAL,11   GMB
         BEZ      GMB
         LI,2     GMBSIZ-1
         LW,1     KDSPACES
         STW,1    *14,2
         BDR,2    %-1
         PULL     2,1
         LW,6     14
         LI,3     0
         B        *15
4BYTE    SLS,D2   16
         PUSH     0
         BAL,11   IDTOBCD
         BAL,11   F0TO40
UP3      RES      0
         LI,15    0
         BAL,SR2  KDS8CHM
         PULL     0
         B        *0
         PAGE
*
KDPACK  LI,7     AVRTBLNE-1
        LI,8     AVRTBLSIZ
        B        KDSTAPA
*
*
CKSYS   CW,D2    Y8
        BAZ      TYPOMES
        LI,2     KDSYSTEM
        B        TYPOMES
*
*
*TAPES OPTION
*
         REF      DCT3
         REF      BATAPE,AVRTBL,AVRTBLSIZ
         REF      Y1,Y8
KDSVOL   LI,7     AVRTBLNE-1
         B        KDSTAP+1
KDSTAP   LI,7     AVRTBLSIZ-1
         LI,8     0
KDSTAPA  LI,R2    BATAPE
         BEZ      RELXX
         AW,R2    8
         LC       DCT3,R2
         BCR,2    %+3               DEVICE UP
         AI,8     1
         B        KDSTAPA
         LD,D3    DCT16,R2
         SLD,D3   16
         LI,R3    X'15'
         STB,R3   D3
         AI,D4    X'4000'
         STW,D3   0,R6              EDITED YYNDD
         STW,D4   1,R6              TO MESSAGE BUFFER
         LI,R3    7                 SET MESSAGE CHARACTER INDEX
         LW,5     8
         LD,D1    AVRTBL,5
         LH,4     AVRID,5
         BNEZ     IDSET
JJSC     LI,2     KDSEMPTY
         B        ANS%USE
NOTANS0  EQU      %
         LW,11    D1                ANY INSN
        BEZ      CKSYS
INUSE    EQU      %
        LI,R2    KDPUBLIC
        CW,D2    Y8
        BANZ     TYPOMES
         LI,2     KDSUSER2
         CI,4     0                 ANY ID
         BNE      TYPOMES           YES-ITS IN USE
         LI,2     KDSCRACH
        LI,R2    KDSHARE
        MTH,0    AVRNOU,R5
        BNEZ     TYPOMES            SHARED
         CW,D2    Y1                IS IT A SCRATCH
         BANZ     TYPOMES           YES
         LI,2     KDSAVAIL          NO,IT HAS BEEN PREMOUNTED
TYPOMES  BAL,SR2  KDS8FRTO          CHAR TO MESSAGE BUFFER
         LW,D4    D1
         BEZ      CHKID
         CI,D4    -1                MAYBE SCRATCH
         BE       CHKID
         B        ANS%SN            CHECK ANS SERIAL #
NOTANS1  EQU      %
         LI,D3    ','
         SLD,D3   24
         BAL,SR2  KDS8CHM
CHKID    EQU      %
         AI,4     0
         BEZ      SETCR             NO ID
         LW,D4    KDID
         LI,D3    ','               EDIT COMMA
         SLD,D3   24
         BAL,SR2  KDS8CHM
         BAL,11   UBAT
         LW,13    4
         BAL,0    4BYTE
SETCR    EQU      %
         B        ANS%FNM           CHECK ANS FILE NAME
NOTANS2  EQU      %
         CW,5     7
         BE       KDS09B
         AI,8     1
         BAL,15   TYPEIT
         B        KDSTAPA
IDSET    RES      0
         CI,R4    -1
         BNE      JJSC
         LI,R2    KDLOCKED
         B        TYPOMES
         PAGE
* ADDITIONS FOR ANS TAPES
ANS%SN   EQU      %
         CI,R5    AVRTBLSIZ         TAPE | PACK
         BGE      NOTANS1           PACK
         LB,SR4   ANSFLGS,R5        ANS TAPE ON THIS DRIVE
         CI,SR4   X'C8'             ANS TAPE FLAGS
         BAZ      NOTANS1
         PUSH     SR1
         LW,R2    D1
         BAL,SR4  SIXBACK           DEHASH SERIAL # (SR1-SR2)
         SLD,SR1  -16
         SLD,SR1  8
         OR,SR1   =','**24          EDIT COMMA
         LD,D3    SR1
         PULL     SR1
         B        CHKID-1
*
ANS%FNM  EQU      %
         CI,R5    AVRTBLSIZ         TAPE | PACK
         BGE      NOTANS2           PACK
         LB,SR4   ANSFLGS,R5        ANS TAPE ON THIS DRIVE
         CI,SR4   X'C8'             ANS TAPE FLAGS
         BAZ      NOTANS2
         PUSH     R5
         MI,R5    6*4               AVRFNMT IS A 6 WORD TABLE
ANS%FNM0 EQU      %                 KEEP THIS LABEL ON THIS INSTRUCTION
         LB,SR4   AVRFNMT,R5        COUNT
         BEZ      ANS%FNM1
         LW,D3    =','''**16        EDIT COMMA, QUOTE
         BAL,SR2  KDS8CHM
         ANLZ,D1  ANS%FNM0          BYTE ADDRESS OF FILE NAME
         ANLZ,D2  KDS8CHM+2         BYTE ADDRESS BUFFER
         AW,R3    SR4               ADD COUNT TO BUFFER INDEX
         STB,SR4  D2                COUNT TO MBS
         MBS,D1   1                 MOVE FILE NAME EXCLUDING COUNT
         LW,D3    =''''**24         EDIT CLOSE QUOTE
         BAL,SR2  KDS8CHM
         ANLZ,R2  ANS%FNM0
         AI,R2    18                DISP TO FILE SEQ #
         LB,D2    0,R2
         BEZ      ANS%FNM1          NO MORE
         LW,D3    =','**24          EDIT COMMA
         BAL,SR2  KDS8CHM
         BAL,SR2  CONVERT           CONVERT TO EBCDIC
         BAL,SR2  KDS8CHM
         LW,D3    =','**24          EDIT COMMA
         BAL,SR2  KDS8CHM
         ANLZ,D1  ANS%FNM0
         ANLZ,D2  KDS8CHM+2
         AI,R3    5                 JULIAN DATE IS 5 CHARACTERS
         MTB,5    D2                COUNT
         MBS,D1   19                MOVE JULIAN DATE
ANS%FNM1 EQU      %
         PULL     R5
         B        NOTANS2
ANS%USE  EQU      %
         CI,R5    AVRTBLSIZ         TAPE | PACK
         BGE      NOTANS0           PACK
         LB,SR4   ANSFLGS,R5
         CI,SR4   X'C8'
         BAZ      NOTANS0
         B        INUSE
DISPLAYSZ EQU     %-DISPLAY
         END

