         DEF      KEYN
KEYN     EQU      %
ANSPROC  SET      1
         SYSTEM   UTS
         PSR      0
         REF      AVRFNMT,ANSFLGS,ANSPRT
         LOCAL    KBUF,MT
KEYIN    EQU      %
         B        START%KEYIN
*
*
*                 IF  FRGRND =  1  , THEN REALTIME VERSION
*
*
*        KEYIN    PROCESSOR
*
*                 ENTRY POINT -  KEYIN1
*
       PAGE
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       SET      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
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
IF%UTS   SET      0
IF%UTS   SET      1
2741CODE SET      1                 SET FOR 2741 CAPABILITY
*
IF%NOT%UTS SET    1-IF%UTS
*
         DO       IF%UTS
FRGRND   SET      0
CHKPT    SET      0
WAIT     SET      0
INT      SET      0
SYST     SET       1
SWITCH   SET      0
DOFFON   SET      0
RBCODE   SET      1                 SET TO ZERO FOR NO RB CODE
         ELSE
FRGRND   SET      0
CHKPT    SET      0
WAIT     SET      1
INT      SET      1
SYST     SET      0
SWITCH   SET      1
         FIN
         PAGE
         PAGE
         DEF      KEYERR
         DEF      KEYINR
         DEF      NXKICHR,GKIFLD,KFL,KPLB
         DEF      DEVCK,CVSYSID
         PAGE
         REF      KIDEL,KIPRI
         REF      KFRMCG
         REF      KIDIS                                                 746
         SREF     QRQD
         REF      DCTSIZ,DCT4
         REF      DCT1
         REF      DCT3
         REF      RAD1ST
         REF      TIME
         REF      DATE
         SREF     SYMX,SNDDX,DCT16
         REF      KEYINBUF
         REF      BATAPE
         REF      Y3,Y4,YFFFF,X0
         REF      NBATAPE
         REF      Y1
         REF      AVRTBL
         REF      AVRTBLSIZ
         REF      XFF
         REF      SYMCOM
         REF      E:CBK
         REF      S:MBSF,ASPIN,HOWALO,RAT:DCT4,SC31
         REF      SH:RGCU
         REF      STB:TYP,MXSTRM,OH:NM,TYPMNSZ
         PAGE
         REF      CTRIG
          REF      UB:US
         REF      S:GUAIS
         REF      S:OUAIS
         REF      SMUIS
         REF      M8,M24,SGCQ,RMB,MING
         DEF      KSGCQ             :
         REF      Y01
         REF      Y000A
         REF      T:DELUS
         REF      E:ABRT
         REF      T:BTSCHED
         REF      E:ERR
         REF      GETUSER#
         REF      T:GJOBSTRT
         REF      T:RUE
         REF      OCQUEUE
         SREF     COCMESS
         SREF     COC
         SREF     COCTERM
         SREF     CPOS
         SREF     LB:UN
         SREF     COCOTV
         SREF     COCSENDX
         SREF     ECHOCR2
         SREF     MODE2
         SREF     LNOL
         SREF     COCDSABL
         SREF     COCENABL
         REF      S:BUAIS
         REF      Y8
         REF      AVRTBLNE
         REF      SV:RSIZ
         REF      SH:RNM
         REF      SB:RTY
         REF      TB:FLGS
         REF      XF,XFC            MASKS
         SREF     S:MPKYN           MP RE-ENTRANCY COUNTER
         SREF     SB:INIT           CPU START/STOP FLAGS
         SREF     SB:STATE          SLAVE CPU STATE
         SREF     NSCPU             NUMBER OF SLAVE CPUS
         DEF      TXMOOSE           TEXTC OF MOOSE
*
         DO       RBCODE            :
         REF      RBLIMS,RBB:ID     :
         REF      SNDGFC,BCSTGFC,SWITGFC
         SREF     RB:XFLG,RB:FLAG,RBD:WSN
         SREF     OFFBIT,RBXBIT,LIPBIT,ACTBIT
         REF      SGCQ2             :
         FIN                        :
*
         DO       FRGRND
         REF      EPRMFRCL                                              746
         REF      Y4,Y2
         DO1      21
         REF      NINT,TNINT,INTBASE,CLKBASE
         REF      INTTABLE
         REF      Y008
         REF      CNSCKPT                                               746
         SREF     NCLKTMRS,CLKNAMS,CLKTMRS                              746
FLAGS    EQU      5
WDINST   EQU      4
Y6       DATA     X'60000000'
         FIN
TCBSS    EQU      12
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K4       EQU      4
K5       EQU      X'5'
K8       EQU      X'8'
KA       EQU      10
K10      EQU      X'10'
K50      EQU      X'50'
KC1      EQU      X'C1'
KC6      EQU      X'C6'
KF0      EQU      X'F0'
KF9      EQU      X'F9'
KFFFF    EQU      X'FFFF'
KN6      EQU      -X'6'
KN8      EQU      -X'8'
KN10     EQU      -X'10'
KN18     EQU      -X'18'
KNC100   EQU      -X'C100'
KBLANK   EQU      ' '
KCRET    EQU      X'15'
KCOMMA   EQU      ','
KEOB     EQU      X'26'
         PAGE
         SPACE    4
*
STARTBIT EQU      1                 START BIT IN SB:INIT
STOPBIT  EQU      2                 STOP BIT IN SB:INIT
         REF      BLANK,M11
X7FF     EQU      M11
*
X30      DATA     X'30'
YC5FF    DATA     X'C5FF0000'
         REF      X1000FFFF
XCF      DATA     X'CF'
XF7      DATA     X'F7'
         REF      Y18,M31
BLP      TEXT     'BLP '
BAUNIT1  MTB,0    AVRFNMT,R3
BAUNIT2  MTB,0    AVRFNMT,R5
         BOUND    8
KEYINQ   TEXT     'KEYIN'
TXMOOSE  TEXTC    'MOOSE'
         PAGE
GKIFLD1  STB,SR1  *R7,R2            CHAR TO BFR
         STW,SR1  KFLAGS,R7         BLNK ACTIVE
         AI,R2    K1
**********************************************************************
*        NXKICHR    NEXT KEYIN CHAR                                  *
*                 GETS NEXT KEYIN CHAR FROM INPUT BUFFER             *
*        ENTER WITH                                                  *
*                 (R7) = ADR OF KEYIN PARAMETER LIST                 *
*                                                                    *
*        EXIT WITH                                                   *
*                 (SR1) =  CUR CHAR                                  *
*                 CC1 = 1  IF CUR CHAR IS A DELIMITER                *
*                                                                    *
*                                                                    *
*                                                                    *
**********************************************************************
NXKICHR  EQU      %
NXKICHR1 EQU      %
         LW,R3    KCCP,R7           (R3) = CUR CHAR POSITION
         CI,R3    72                SIZE OF KEYIN BUFFER
         BL       NXKICHR5          COUNT UP TO IT
         LI,SR1   KEOB
NXKICHR4 LCI      K8                DELIM, SET CC1
         B        *SR4
NXKICHR5 RES      0
         LW,R4    KBUF,R7           (R4) = ADR OF KEYIN BUFFER
         LB,SR1   *R4,R3            PICK UP NEXT CHAR
         CI,SR1   KCRET             CHECK IF A CARRIAGE RETURN
         BE       NXKICHR4
         MTW,1    KCCP,R7           SET  CCP =CCP+1
         CI,SR1   KBLANK            CHECK IF CHAR IS A BLANK
         BNE      NXKICHR2
         LW,R3    KFLAGS,R7         CHECK IF BLANK IS ACTIVE
         BEZ      NXKICHR1
*
NXKICHR2 EQU      %
         LB,R3    *R7               (R3) = NO. OF DELIM
         LW,R4    0,R7              BA(DELIMITERS)
NXKICHR3 EQU      %
         CB,SR1   0,R4              CHECK IF CHAR IS A DELIMITER
         BE       NXKICHR4
NXKICHR31 AI,R4   1                 NEXT INDEX
         BDR,R3   NXKICHR3
NXKICHR32 LCI     0                 NORMAL RETURN
         B        *SR4
*
         PAGE
**********************************************************************
*        GKIFLD     GET  KEYIN  FIELD                                *
*                 GETS THE NEXT KEYIN FIELD FROM BUFFER              *
*                                                                    *
*        ENTER WITH                                                  *
*                 (R7) ADR OF  KEYIN  PARAMETER LIST                 *
*                                                                    *
*        EXIT WITH                                                   *
*                 FIELD IN PARAM LIST BUFFER AND CC1 =0.             *
*                 CC1 = 1 IF FIELD LENGTH = 0 OR IS > 12 CHAR        *
*                                                                    *
*                                                                    *
**********************************************************************
GKIFLD   EQU      %
         PUSH     SR4
         LW,R2    BLANK
         STW,R2   KPLB,R7           FILL
         STW,R2   KPLB+1,R7             BUFFER
         STW,R2   KPLB+2,R7                   WITH BLANKS
*
         LI,R1    K0
         STW,R1   KFLAGS,R7         SET BLANK NOT ACTIVE
         LI,R0    KMAXKIFL+1        (R0) = MAX KEYIN FIELD LENGTH+1
         LI,R2    BAKPLB
GKIFLD2  EQU      %
         BAL,SR4  NXKICHR           GET NEXT KEYIN CHAR
         BCS,8    GKIFLD3           BRANCH IF A DELIMITER
         BDR,R0   GKIFLD1
         B        GKIFLD4           FIELD IS MORE THAN 12CHAR LONG
*
GKIFLD3  EQU      %
         CI,R2    BAKPLB            CHK 0 LNGTH FLD
         BNE      GKIFLD5           BRANCH IF NOT
GKIFLD4  EQU      %
         OR,R0    Y8
GKIFLD5  EQU      %
         AI,R2    -BAKPLB
         STW,R2   KFL,R7            FIELD LENGTH
         STW,R1   KFLAGS,R7         SET BLANK NOT ACTIVE
         PULL     SR4
         LC       R0
         B        *SR4              EXIT
         PAGE
**********************************************************************
*        KEYIN1  -  PROCESS KEYIN MESSAGES                           *
*                 (!ABORT OR !X, !CHKPT, !DATE OR !D, !ERROR OR !E,  *
*                 !RESTART, !START OR !S, !TIME OR !T, !WAIT OR !W,  *
*                 !SYST, OR !YYNDD)                                  *
*                                                                    *
*                 OUTPUTS  !!KEYERR  IF KEYIN IS IN ERROR            *
*                                                                    *
*                 ENTER WITH KEYIN  IN  KEYINBUF                     *
*                                                                    *
**********************************************************************
*
KEYERR   EQU      %
         LI,1     4
         B        %+2
KEYERR1  EQU      %
         LI,1     3                 MESSAGE CODE FOR 'LATER'
         LI,7     0                 CANNED MESSAGE CODE
         BAL,11   OCQUEUE           OUTPTUT MESSAGE
*
         LW,8     Y01               TRIGGER ANOTHER COPY
         BAL,11   CTRIG             OF KEYIN
*
KEYINR   EQU      %
KEYINR1  EQU      %
         B        T:DELUS           EXIT TO STEP LOGS SELF OFF
         PAGE
*
*        KIPL - KEYIN  PARAMETER  LIST
*
         BOUND    4
KIPL     EQU      %
         GEN,8,24 NKIDL,BA(KIDL)    NO. DELIM. , BA(KEYIN DELIMETERS)
         DATA     0                 CUR CHAR POSITION    KCCP
         DATA     0                 BLANK ACTIVE FLAG   KFLAGS
         DATA     KEYINBUF          ADR OF KEYIN BUFFER
         DATA     0                 FIELD LENGTH         KFL
         RES      3                 12 CHAR FIELD BUFFER
*
         BOUND    4
KIDL     EQU      %                 KEYIN DELIMITER LIST
         DATA,1   ':'
         DATA,1   '/'
         DATA,1   '('
         DATA,1   ')'
         DATA,1   ','
         DATA,1   '.'
         DATA,1   ' '
NKIDL    EQU      BA(%)-BA(KIDL)    NO. OF KEYIN DELIMETERS
*
KCCP     EQU      1                 CUR CHAR POSITION
KFLAGS   EQU      2                 BLANK ACTIVE FLAG
KBUF     EQU      3                 UBFFER ADDRESS
KFL      EQU      4                 FIELD LENGTH
KPLB     EQU      5                 FIELD BUFFER
KMAXKIFL EQU      12                MAX. KEYIN FIELD LENGTH
BAKPLB   EQU      4*KPLB
HAKPLB   EQU      2*KPLB
         BOUND    4
         PAGE
START%KEYIN RES   0
KEYIN1   EQU      %
         LI,1     KCRET
         CB,1     KEYINBUF
         BE       KEYINR1
         BUMP     15,R1
         LW,R7    TSTACK
         AI,R7    -7
         LCI      5                 MOVE  PARAMETER
         LM,R0    KIPL                             LIST TO TSTACK
         STM,R0   0,R7
KEYIN20  LI,R1    0
         STW,R1   KCCP,R7           SET CUR CHAR POSTION = 0
         BAL,SR4  GKIFLD            GET 1ST FIELD OF KEYIN
         BCS,8    KEYERR            CHECK IF A LEGAL FIELD
*
         LW,R1    KPLB,R7           (R1) = 1ST 4 CHAR OF FIELD
         LI,R3    NKEYINS           (R3) = NO. OF KEYINS
KEYINA   CW,R1    KITBL,R3
         BNE      KEYINB
         B        KIJMPTBL,R3       BRANCH TO APPROIATE ROUTINE
         PAGE
*
*        KEYIN  NAME  TABLE
*
KITBL    EQU      %
         TEXT     '    '            DUMMY ENTRY
         TEXT     'ERSE'            OPERATOR ERROR LOG COMM.
         TEXT     'ABOR'            ABORT
         DO       CHKPT
         TEXT     'CHKP'            CHKPT
         FIN
         TEXT     'DATE'            DATE
         TEXT     'D   '            D
         TEXT     'ERRO'            ERROR
         DO       FRGRND
         TEXT     'REST'            RESTART
         FIN
         TEXT     'STAR'            START
         TEXT     'TIME'            TIME
         TEXT     'T   '            T
         DO       IF%NOT%UTS
         TEXT     'WAIT'            WAIT
         TEXT     'W   '            W
         FIN
         DO       SYST
         TEXT     'SYST'            SYST
         FIN
         TEXT     'MOUN'
         DO       IF%NOT%UTS
         TEXT     'INT '
         TEXT     'SWIT'
         FIN
         TEXT     'INT'
         DO       FRGRND
         TEXT     'TRIG'
         TEXT     'ARM '
         FIN
         TEXT     'ON  '            # ON-LINE USERS ALLOWED
         TEXT     'ONB '            #BATCH USERS ALLOWED
         TEXT     'OFF '            GENTLE DOWN
         TEXT     'ZAP '            FORCE DOWN
         TEXT     'SEND'            GENTLE SEND OF MESSAGE
GJOBTXT  TEXT     'GJOB'
         TEXT     'DELE'            DELETE
         TEXT     'PRIO'            PRIORITY
         TEXT     'FORM'
         TEXT     'SCPU'
         TEXT     'XCPU'
         DO       RBCODE            :
         TEXT     'RBSE'            RBSEND
         TEXT     'RBBD'            RBBDCST
         TEXT     'RBX '            RBX
         TEXT     'RBS '            RBS
         TEXT     'RBDI'            RBDISC
         TEXT     'RBSW'            RBSWITCH
         TEXT     'RBLO'
         TEXT     'RBCO'
         FIN                        :
         TEXT     'E   '            ERROR
         TEXT     'S   '            START
         TEXT     'SS  '            START SYMBIONT
         TEXT     'REQU'            REQUEST TAPE DRIVE
         TEXT     'DISP'            DISPLAY
         TEXT     'X   '            ABORT
         TEXT     'SCRA'            CARD READER OR  SCRATCH
         DO       DOFFON
         TEXT     'Q   '            FORCE QUIESCENT
         TEXT     'DON '
         TEXT     'DOFF'
         FIN
         TEXT     'PREF'
         TEXT     'ANSS'            ANS SCRATCH
         TEXT     'ANSM'            ANS MOUNT
         TEXT     'OVER'            ANS OVERWRITE
         TEXT     'READ'
         TEXT     'DIAG'            DIAGNOSTIC ID
         TEXT     'OBON'
         TEXT     'OBOF'
NKEYINS  EQU      %-KITBL-1         NUMBER OF KEYINS
         PAGE
*
*        KEYIN  JUMP TABLE
*
KIJMPTBL EQU      %
         B        KEYERR
         B        ERSEND            OPERATOR ERROR LOG COMM.
         B        KIABORT           ABORT         KEYIN
         DO       CHKPT
         B        KICHKPT           CHECK POINT   KEYIN
         FIN
         B        KIDATE            DATE          KEYIN
         B        KIDATE            DATE          KEYIN
         B        KIERROR           ERROR         KEYIN
         DO       FRGRND
         B        KIRESTART         RESTART       KEYIN
         FIN
         B        KISTART           START         KEYIN
         B        KITIME            TIME          KEYIN
         B        KITIME            TIME          KEYIN
         DO       IF%NOT%UTS
         B        KIWAIT            WAIT          KEYIN
         B        KIWAIT            WAIT          KEYIN
         FIN
         DO       SYST
         B        KEYERR
         FIN
         B        KIMOUNT
         DO       IF%NOT%UTS
         B        KIINT
         B        KISWIT
         FIN
         B        ENTINT
         DO       FRGRND
         B        KITRIG
         B        KIARM
         FIN
         B        KIGUP             GENTLE UP
         B        KIGBUP
         B        KIGDOWN           GENTLE DOWN
         B        KIFDOWN           FORCE DOWN
         B        KISEND            SEND MESSAGE GENTLY
         B        KIGJOB            GHOST TASK INITIATION
         B        KIDEL
         B        KIPRI
         B        KFRMCG
         B        KSCPU
         B        KXCPU
         DO       RBCODE            :
         B        KRBSEND           SEND MESSAGE TO GIVEN RBT
         B        KRBBCST           SEND MESSAGE TO ALL RBTS
         B        KRBX              TURN OFF REMOTE BATCH
         B        KRBS              TURN ON REMOTE BATCH
         B        KRBDISC           DISCONNECT GIVEN RBT
         B        KRBSWIT           SWITCH FILES BETWEEN RBTS
         B        KRBLOG
         B        KRBCOM
         FIN                        :
         B        KIERROR
         B        KISTART
         B        KISTSY            START SYMBIONT
         B        KIREQ
         B        KIDIS
         B        KIABORT
         B        KISCRTH
         DO       DOFFON
         B        KIQUIES           FORCE QUIESCENT
         B        KIDON
         B        KIDOFF
         FIN
         B        KIRAD1ST
         B        KIANSS
         B        KIANSM
         B        KIANSO
         B        KIANSO
         B        KDIAG             DIAGNOSTIC AUTHORIZATION
         B        KOBN
         B        KOBF
 ERROR,1,%-KIJMPTBL-1~=NKEYINS 'KIJMPTBL NOT PARALLEL TO KITBL'
*
         PAGE
         DO       CHKPT
*        PROCESS  CHECK POINT  KEYIN  (!CHKPT)
*
KICHKPT  EQU      %
         LW,R2    L(X'08001000')                                        746
         LW,R3    L(X'FF00F000')                                        746
         LW,R1    RUNFLAG,R5                                            746
         CI,R1    X'8000'           CHECK IF CHECKPOINT IN PROGRESS     746
         BANZ     KEYERR            YES                                 746
         CW,R1    Y001
         BAZ      KEYERR                                                746
         STS,R2   RUNFLAG,R5        SET CHKPT FLAG                      746
         B        KEYINR                                                746
*
*        PROCESS  RESTART KEYIN (!RESTART)
*
KIRESTART  EQU    %
         MTW,1    CNSCKPT                                               746
         B        KEYINR                                                746
         FIN
*
*
*  PROCESS INT KEYIN
*
ENTINT   LI,6     0
         STW,6    J:CCBUF
         LI,6     E:CBK
         REF      LPART
         REF      PLH:SID
         B        KIERROR1
         PAGE
*
*PROCESS OBON-OBOFF KEYINS
*
         REF      SSTAT
KOBF     EQU      %
         MTB,1    SSTAT
         B        KEYINR
KOBN     EQU      %
         LI,R6    0
         STB,R6   SSTAT
         B        KEYINR
         PAGE
         REF      SYSACCT,S:GJOBTBL,S:GJOBACN
*        PROCESS  ABORT KEYIN  (!ABORT OR !X)
*
KIABORT  EQU      %
         LI,6     E:ABRT            ABORT EVENT
         STW,6    J:CCBUF
         B        KIERROR1
*
*
*        PROCESS  ERROR KEYIN  (!ERROR OR  !E)
*
KIERROR  EQU      %
         LI,6     E:ERR             ERROR EVENT
         STW,6    J:CCBUF
KIERROR1 EQU      %
         MTW,1    0,7               REMOVE ':' AS DELIMITER
         MTB,-1   *7
         BAL,11   GKIFLD            GET ID OR GHOST NAME
         BCS,8    KEYERR
         CI,8     '.'               GHOST NAME
         BE       GNAME
         BAL,11   CVSYSID           CONVERT TO HEX IN R2
         BCS,8    KEYERR
*
         MTW,0    J:CCBUF
         BNEZ     KIER15
         LI,7     LPART
KIER12   CH,2     PLH:SID,7
         BE       KIER15
KIER13   BDR,7    KIER12
         REF      MAXG,SB:GJOBUN
*        CHECK FOR GHOST JOB
         LI,7     MAXG
         CB,2     SB:GJOBUN,7
         BE       KIER15
         BDR,7    %-2
         B        KEYERR
KIER15   EQU      %
         CI,2     MING              DONT ZAP KEYN,ALLOCAT,RBBAT
         BL       KEYERR
         LW,9     6
         LW,6     2
         BAL,7    GETUSER#          GET ACTIVE USER #
         B        KEYERR
         LW,6     9
         BAL,11   T:RUE             REPORT ERROR OR ABORT EVENT
         B        KEYINR
GNAME    EQU      %
         LW,12    KPLB,7            GHOST NAME
         LW,13    KPLB+1,7
         SLD,12   -8                MAKE ROOM FOR COUNT
         LW,2     KFL,7             COUNT
         CI,2     7                 GHOST NAMES MUST BE 7 OR LESS
         BG       KEYERR
         STB,2    12                TEXTC
         LD,14    SYSACCT           ASSUME :SYS
         BAL,11   GKIFLD            GET ACCOUNT
         LW,2     KFL,7             COUNT
         BEZ      DEFAULTGACN       USE DEFAULT
         CI,2     8                 ACCOUNT MUST BE 8 OR LESS
         BG       KEYERR
         CI,8     X'15'             CR
         BNE      KEYERR
         LW,14    KPLB,7            ACCOUNT
         LW,15    KPLB+1,7
DEFAULTGACN EQU   %
         LI,2     MAXG              S:GJOBTBL SIZE
         DISABLE
CHKGNAME EQU      %
         CD,12    S:GJOBTBL,2
         BE       CHKGACN           MATCH; CHECK ACCOUNT
CONTUGSRCH EQU    %
         BDR,2    CHKGNAME          NO MATCH; CONTINUE
         ENABLE
         B        KEYERR            NO SUCH GHOST
CHKGACN  EQU      %
         CD,14    S:GJOBACN,2
         BNE      CONTUGSRCH        WRONG ACCOUNT;CONTINUE SEARCH
         LB,2     SB:GJOBUN,2       ID
         ENABLE
         B        KIER15
         PAGE
*
*        PROCESS  WAIT  KEYIN  (!WAIT OR  !W)
*
         DO       WAIT
KIWAIT   EQU      %
         LW,R0    Y8
         B        KISTART2
         FIN
         PAGE
*
*        PROCESS  START KEYIN  (!START AND !S)
*
KISTART  EQU      %
         LI,R0    0
KISTART2 EQU      %
         BAL,11   T:BTSCHED
         B        KEYINR            EXIT
*
         DO       DOFFON
*        PROCESS FORCE QUIESCENT KEYIN (Q)
*
KIQUIES  EQU      %
         MTW,1    QRQD              SET FLAG
         B        KEYINR
         FIN
         PAGE                       THIS CODE PROCESSES THE 'TASK'
*
*        START A GHOST (TASK) JOB - KEYIN FORMAT IS;
*
*        GJOB  NAME.ACCOUNT
*
*        OR
*
*        GJOB  NAME
*
*        OR
*
*        GJOB  NAME.ACCOUNT,RESOURCE
*
*        OR
*
*        GJOB  NAME,RESOURCE
*
*        WHERE THE LACK OF AN ACCOUNT SPECIFIES A :SYS TASK TO BE
*        STARTED. THE RESOURCE NAME WILL BE PASSED TO TTHE TASK
*        IN ITS M:UC DCB SO THAT IT CAN TALK TO THAT RESOURCE
*        WHEN IT COMES INTO CORE.
*
KIGJOB   EQU      %
         MTW,1    0,R7              REMOVE ':' AS DELIMITER
         MTB,-1   *R7
         BAL,11   GKIFLD            GET TASK NAME
KIGJOB1  BCS,8    KEYERR            ERROR RETURN TO USER
*
         LW,10    KFL,7             #
         CI,10    7                 NAME:7
         BG       KEYERR
*
         LW,0     KPLB,7            GET TASK NAME FROM BUFFER
         LW,1     KPLB+1,7
         CD,0     KEYINQ
         REF      OCDCT,T:GJOBR,DOUBLEZERO
         BE       KEYERR            DONT START OURSELF
         SLD,R0   -8                POSITION FOR BYTE
         STB,R10  R0                COUNT INSERTION
         CI,R8    X'15'             FIELD TERMINATE ON NEW LINE
         BE       KIGJOB5           YES - GO START :SYS GJOB
         PUSH     2,R0              SAVE THE GJOB NAME
         CI,R8    '.'               IS THE DELIM A DOT
         BE       KIGJOB4           YEP
         LD,R12   DOUBLEZERO        ZAP ACN FIELD
KIGJOB2  CI,R8    ','               WANTS TO PASS A RESOURCE NAME
         BNE      KEYERR            CANT FIGURE OUT WHAT TO DO HERE..
         BAL,R11  GKIFLD            GET RESOURCCE FIELD
         BCS,8    KEYERR            ERROR
         LW,R10   KPLB,R7           GET RESOURCE NAME
         SAS,R10  -16               POSITION FOR SEARCH
         LI,R2    SV:RSIZ+1
         CH,R10   SH:RNM,R2         FIND NAME IN TABLES
         BE       KIGJOB3
         BDR,R2   %-2
         B        KEYERR            INVALID INPUT
KIGJOB3  EQU      %
         PULL     2,R0              RESTORE GJOB TEXTC NAME FROM STACK
         BAL,R10  T:GJOBR           AND START THE GHOST UP
         BCR,15   KEYINR            NORMAL RETURN
         B        KIGJOB6
*
*        GATHER ACCOUNT NUMBER PASSED
*
KIGJOB4  EQU      %
         BAL,R11  GKIFLD            GET FIELD
         BCS,8    KEYERR            ERROR RETURN
         LCI      2
         LM,R12   KPLB,R7           GET ACCOUNT NUMBER FROM BUFFER
         LI,R2    0                 RESET INDEX FLAG FOR T:OV
         CI,R8    X'15'             FIELD TERMINATE ON NEWLINE
         BE       KIGJOB3           YES - GO START THE GHOST
         B        KIGJOB2           NO - GO EXAMINE FOR RESOUCE NAME
KIGJOB5  EQU      %
         BAL,R10  T:GJOBSTRT        START :SYS GHOST JOB
         BCR,15   KEYINR
KIGJOB6  STCF     R10               SAVE CONDITION CODES FROM T:OV
         LI,R1    GJOBUSY           ASSUMME GHOST ALREADY ACTIVE
         LI,R7    0                 NO DCT TO TYPE OUT
         LC       R10               TEST ASSUMPTION
         BCS,2    KIGJOB7           TRUE
         LI,R1    GJOBWAKE          MAYBE WE WOKE IT UP THEN
         LC       R10               DID WE
         BCS,4    KIGJOB7           YES
         LI,R1    GJOBFULL          ONLY ONE LEFT
         LC       R10               ARE TH TABLES FULL
         BCR,8    KEYINR            DONT KNOW WHAT TO SAY
KIGJOB7  BAL,R11  OCQUEUE           WRITE OUT MESSAGE
         NOP      %
         B        KEYINR
GJOBUSY  EQU      %
         DATA,1   GJOBUC,X'05',X'5C',X'5C'
         TEXT     'TASK CURRENTLY ACTIVE'
GJOBUC   EQU      BA(%)-BA(GJOBUSY)-1
GJOBWAKE EQU      %
         DATA,1   GJOBWC,X'05',X'5C',X'5C'
         TEXT     'TASK AWAKENED'
GJOBWC   EQU      BA(%)-BA(GJOBWAKE)-1
GJOBFULL EQU      %
         DATA,1   GJOBFC,X'05',X'5C',X'5C'
         TEXT     'TASK TABLES FULL'
GJOBFC   EQU      BA(%)-BA(GJOBFULL)-1
         PAGE
*
*        THIS CODE CAUSES A 'GENTLE DOWN' OF UTS BY
*        SETTING THE ITEMS WHICH DETERMINE THE NUMBER OF
*        USERS IN THE SYSTEM TO ZERO (S:OUAIS, S:BUAIS)
*
*
*        THIS CODE FORCES ALL ON-LINE USERS OFF
*
         REF      GOODNGT
KIFDOWN  EQU      %
         LI,5     -2
         STW,5    GOODNGT           ***SAVE SYMB FILES
         LI,5     SMUIS
         LI,6     E:ABRT            ABORT CODE
ZAP10    EQU      %
          LB,0     UB:US,5
         REF      SNULL
         CI,0     SNULL
         BE       ZAP20
*
         CI,5     MING-1            (SMK) CHECK FOR KEYN,ALLOCAT,RBBAT
         BLE      ZAP20             (DON'T WANT TO ZAP EITHER)
*
         PUSH     5
         BAL,11   T:RUE             ABORT HIM
         PULL     5
*
ZAP20    EQU      %
         BDR,5    ZAP10-1
*
KIGDOWN  LI,0     0
         STW,0    S:OUAIS
         STW,0    S:BUAIS
         LI,1     NSCPU
         BEZ      %+3
         LI,3     1
         BAL,0    KXCPU2
         DO       RBCODE            IF RB SYSTEM ZAP INCLUDES IMPLICIT
         LI,3     OFFBIT            RBX.
         BNEZ     KRBX1             :
         FIN                        :
         B        KEYINR            IF NOT EXIT
         PAGE
*
*        THIS CODE STORES THE INPUT VALUE INTO S:OUAIS,
*        # OF ON-LINE USERS ALLOWED IN SYSTEM
*
         REF      J:CCBUF
KIGBUP   EQU      %
         MTW,1    J:CCBUF
         B        KIGB
KIGUP    EQU      %
         LI,R1    COC               SEE IF NON-COC SYSTEM
         BEZ      KEYERR            B/NOT ON-LINE SYSTEM
         LI,1     0
         STW,1    J:CCBUF
KIGB     RES      0
*
         BAL,11   GKIFLD            GET # ON-LINE USERS SPECIFIED
         BCS,8    KEYERR
*
         LW,0     KPLB,7            GET # ON-LINE USERS SPECIFIED
         LI,1     0
         LI,5     -4
DCV20    LB,3     1,5
         AI,3     -X'F0'
         BGEZ     %+4
         AI,3     -X'40'+X'F0'
         BEZ      DCV30+1
         B        KEYERR
         MI,1     10
         AW,1     3
DCV30    BIR,5    DCV20
*
         LW,2     S:BUAIS                TOT BAT AND ON LINE USERS
         MTW,0    J:CCBUF
         BEZ      %+2
         LW,2     S:OUAIS
         AW,2     1                      ALLOWED MAY NOT EXCEED TOTAL
         AW,2     S:GUAIS
         CI,2     SMUIS
         BG       KEYERR
         MTW,0    J:CCBUF
         BEZ      %+3
         STW,1    S:BUAIS
         B        %+2
*
         STW,1    S:OUAIS
         LW,1     3
         B        KEYINR
         PAGE
*        THIS CODE PROCESSES THE 'DIAG' KEYIN. IT MERELY
*        STORES THE USER ID INTO THE DID CELL IN TABLES.
KDIAG    RES      0
         CI,8     ' '               CHECK FOR LEGAL DELIMITER
         BE       KDIAG1            LEGAL
         B        KEYERR            NOT LEGAL, ERROR
KDIAG1   RES      0
         BAL,11   GKIFLD            GET ID
         BCS,8    KEYERR
         BAL,11   CVSYSID           CONVERT TO HEX IN R2
         BCS,8    KEYERR
         LW,R6    R2
         BAL,R7   GETUSER#    ****  GET USER #
         B        KEYERR            ABN RETURN, NO FND
         STW,R5   DID               SAVE O,G,OR B USER #
         REF      DID
         B        KEYINR            NORMAL EXIT
         PAGE
*
*        THIS CODE PROCESSES THE 'SEND' KEYIN. IF PUTS THE
*        INPUT MESSAGE INTO A BUFFER FOR COC WHICH OUTPUTS
*        THE BUFFER AT THE TOP OF THE NEXT PAGE FOR ALL USERS
*
KISEND   EQU      %
         LI,1     COC               SEE IF NON-COC SYSTEM
         BEZ      KEYERR            B/NOT ON-LINE SYSTEM
         CI,8     X'15'             IS DELIMITER IS 'NL',
         BE       SENDNOT           RESET MESSAGE
*
         LW,1     KCCP,7
         CI,8     ','               IS DELIMITER A ,
         BE       KIS100            BR TO SEND MESSAGE TO ONE USER
KIS10    EQU      %
          LB,0     KEYINBUF,1
          CI,0     X'15'
          BE       KIS20
         AI,1      1
          CI,1     80
          BL       KIS10
KIS20     EQU     %
         SW,1     KCCP,7            COMPUTE ACTUAL MESSAGE LENGTH
         BLEZ     KEYERR
*
         CI,1     55                CHECK AGAINST MAX
         BLE      %+2               BRANCH IF OK
         LI,1     55
*
         STB,1    COCMESS
         LI,2     BA(KEYINBUF)      MOVE MESSAGE AND BYTE COUNT
         AW,2     KCCP,7            TO COC BUFFER
         LI,3     BA(COCMESS)+1
         STB,1    3
         MBS,2    0
*
         B        KEYINR
*
*
SENDNOT  EQU      %
         LI,0     0                 BYTE COUNT OF ZERO MEANS
         STB,0    COCMESS           NO MESSAGE OUTPUT
         B        KEYINR
*
KIS100   EQU      %                 ROUTINE TO SENT A MESSAGE TO 1 USER
*
         BAL,11   GKIFLD            GET ID
         BCS,8    KEYERR
         CI,8     X'15'             CHECK DELIMITER = NEW LINE
         BE       KEYINR            RETURN - NO MESSAGE TO SEND
         BAL,11   CVSYSID           CONVERT TO HEX IN R2
         BCS,8    KEYERR            NOT LEGAL ID
         LW,9     7                 SAVE PAINTER TO PARAMETER LIST
         LW,6     2                 USER ID TO R6
         BAL,7    GETUSER#          USER NUMBER RETURNED IN R5
         B        KEYERR
         LW,R7    SR2               PLIST POINTER INTO R7
         LI,SR4   LNOL
         LI,R2    0                 INITIALIZE LINE NUMBER
KIS140   EQU      %
         CB,R5    LB:UN,R2
         BE       KIS160            BRANCH IF LINE NUMBER IS FOUND
         AI,R2    1
         BDR,SR4  KIS140            LOOK FOR USER IN NEXT LINE TABLE
         B        KEYERR            INCORRECT ID
KIS160   EQU      %
         LB,R5    COCTERM,R2
         LH,SR3   COCOTV,R5         TRANSLATION TABLE POINTER IN SR3
         LI,R5    X'0D'
         BAL,SR2  COCSEND2          SEND CR/LF
         BAL,D4   ECHOCR2           UPDATE LINE COUNT
         LW,R1    KCCP,R7           INITIAL MESSAGE POSITION IN R1
         LCW,D4   R1
         AI,D4    81                MAXIMUM MESSAGE SIZE INTO D4
KIS170   EQU      %
         LB,R5    KEYINBUF,R1       PICK-UP NEXT CHARACTER OF MESSAGE
         AI,R1    1
         CI,R5    KCRET
         BE       KIS220            BRANCH IF CARRIAGE RETURN (EOM)
         BAL,SR2  COCSEND2          SEND CHARACTER TO TERMINAL
         BDR,D4   KIS170
KIS220   EQU      %
         SW,R1    KCCP,R7           R1 = NUMBER OF CHARACTERS IN MESSAGE
         LB,D3    CPOS,R2
         SW,D3    R1
         DO       2741CODE=1
         LC       MODE2,R2
         BCR,1    KIS240            BRANCH IF NOT 2741
         AI,D3    19
         DH,D3    Y000A             # OF EXTRA IDLES+1 TO SEND IN D3
         LI,R1    X'16'             SET FOR IDLES AFTER CARRIAGE RETURN
         ELSE
         BGZ      KIS250            BRANCH IF NEW LINE IS UNNECESSARY
         LB,D3    CPOS,R2           # OF BLANKS+1 TO SEND IN D3
         FIN
KIS230   EQU      %
         LI,R5    X'0D'
         BAL,SR2  COCSEND2          SEND CR/LF
         BAL,D4   ECHOCR2           UPDATE LINE COUNT
         DO       2741CODE=1
         LW,R5    R1                SET TO SEND EITHER BLANKS OR IDLES
         BDR,D3   KIS260
         ELSE
         BDR,D3   KIS250
         FIN
         B        KEYINR            RETURN IF NOTHING TO SEND
         DO       2741CODE=1
KIS240   EQU      %
         AI,D3    0
         BGZ      KIS250            BRANCH IF NEW LINE IS UNNECESSARY
         LB,D3    CPOS,R2           # OF BLANKS+1 TO SEND IN D3
         LI,R1    X'40'             SET FOR SENDING BLANKS AFTER CR
         B        KIS230            BRANCH TO SEND CR/LF
         FIN
KIS250   EQU      %
         LI,R5    X'40'             SET TO SEND BLANKS
KIS260   EQU      %
         BAL,SR2  COCSEND2          SEND BLANK OR IDLE TO TERMINAL
         BDR,D3   %-1
         B        KEYINR
*
COCSEND2 EQU      %
         PUSH     7,R9              PUSH R9-R15
         BAL,R13  COCDSABL          DISABLE COC INTERRUPTS
         BAL,R9   COCSENDX          SEND CHARACTER
         BAL,R13  COCENABL          ENABLE COC INTERRUPTS
         PULL     7,R9              PULL R9-R15
         B        *R9               RETURN
         PAGE
*
*        PROCESS SCPU KEYIN - TO START SLAVE CPUS FOR
*           MULTIPROCESSING SYSTEMS
*        IF VALUE IS VALID THEN RESET STOP BIT IN SB:INIT
*           AND SET START BIT IN SB:INIT AND
*           INCREMENT S:MPKYN AND GJOBSTRT MOOSE
*
KSCPU    EQU      %
         LI,11    NSCPU             IS THIS A SLAVE CPU SYSTEM
         BEZ      KEYERR            NO,ERROR
         BAL,11   GKIFLD            GET ID
         BCS,8    KEYERR            ERROR
         LI,11    KSCPU2
KSCPU1   LW,3     KPLB,R7
         SLS,3    -24
         AND,R3   XF
         BEZ      KEYERR
         CI,R3    NSCPU             TOO HIGH
         BG       KEYERR
         B        *11
KSCPU2   MTB,0    SB:STATE,R3       IS THE CPU ACTIVE
         BNEZ     KEYERR            YES
         DISABLE
         LB,11    SB:INIT,R3
         AND,11   XFC               GET ALL BITS BUT START/STOP
         AI,R11   STARTBIT          SET START
         STB,11   SB:INIT,R3        STORE IT
         ENABLE
         MTW,1    S:MPKYN           INCREMENT RE-ENTRANCY COUNTER
         LD,0     TXMOOSE
         BAL,10   T:GJOBSTRT        TRY TO START GHOST
         B        KEYINR
         PAGE
*
*        PROCESS XCPU KEYIN -     STOP A SLAVE CPU FOR
*           MULTIPROCESSING SYSTEMS
*        IF N IS VALID ,THEN SET STOP BIT OF SB:INIT
*           AND RESET START BIT OF SB:INIT
*        INCREMENT S:MPKYN AND GJOBSTRT MOOSE
*
KXCPU    EQU      %
         LI,11    NSCPU             IS THIS A SLAVE CPU SYSTEM
         BEZ      KEYERR            NO,ERROR
         BAL,11   GKIFLD            GET N
         BCS,8    KEYERR            ERROR
         LI,1     1                 SET FOR INCREMENT
         BAL,11   KSCPU1            VALIDATE N
         MTB,0    SB:STATE,R3       IS CPU NOT ACTIVE
         BEZ      KEYERR            YES, ERROR
         LI,0     KEYINR            RETURN ADDRESS
KXCPU2   DISABLE
         LB,11    SB:INIT,R3        GET FLAGS
         AND,R11  XFC               GET ALL BITS BUT START & STOP
         AI,11    STOPBIT           SET STOP BIT
         STB,11   SB:INIT,R3        STORE VALUE
         ENABLE
         AI,R3    1                 INCREMENT INDEX
         BDR,1    KXCPU2            DO MORE THAN 1
         MTW,1    S:MPKYN           SET  RE-ENTRANCY COUNTER
         PUSH     0
         LD,0     TXMOOSE
         BAL,10   T:GJOBSTRT
         PULL     0
         B        *0
         PAGE
*
*        PROCESS  TIME KEYIN   (!TIME OR !T)
*
KITIME   EQU      %
         LI,R0    MAXHRVAL          (R0) = MAX. HOUR VALUE
         BAL,SR4  GDTKIVAL          GET HOUR VALUE
         STH,R2   TIME              STORE HOUR VALUE
*
         LI,R0    MAXMINVAL         (R0) = MAX. MINUTE VALUE
         BAL,SR4  GDTKIVAL          GET MIN. VALUE
         LI,R3    KFFFF
         STS,R2   TIME              STORE MINUTE VALUE
         B        KEYINR
         PAGE
*
*        PROCESS  DATE KEYIN   (!DATE OR !D)
*
KIDATE   EQU      %
         LI,R0    MAXMONVAL         (R0) = MAX. MONTH VALUE
         BAL,SR4  GDTKIVAL          GET MONTH VALUE
         STH,R2   DATE              STORE MONTH VALUE
*
         LI,R0    MAXDAYVAL         (R0) = MAX. DAY VALUE
         BAL,SR4  GDTKIVAL          GET DAY VALUE
         LI,R3    KFFFF
         STS,R2   DATE              STORE DAY VALUE
*
         LI,R0    MAXYRVAL          (R0) = MAX. YEAR VALUE
         BAL,SR4  GDTKIVAL          GET YEAR VALUE
         STW,R2   DATE+1            STORE YEAR
         B        KEYINR            EXIT
         BOUND    8
MAXHRVAL DATA     '00','23'         HOURS
MAXMINVAL DATA    '00','59'         MINUTES
MAXMONVAL DATA    '01','12'         MOUNTHS
MAXDAYVAL DATA    '01','31'         DAYS
MAXYRVAL DATA     '00','99'         YEARS
         PAGE
**********************************************************************
*        GDTKIVAL - GET DATE-TIME KEYIN VALUE                        *
*                 GETS  DATE AND TIME VALUES FROM KEYIN MESSAGE,     *
*                 CHECKS IF LEGAL DECIMAL CHAR AND IF LESS THAN THE  *
*                 MAX VALUE                                          *
*        ENTER WITH                                                  *
*                 (R0) = MAX VALUE                                   *
*                 (R7) = ADR OF KEYIN PARAMETER LIST                 *
*        EXIT WITH (R2) = VALUE IN EBCDIC                            *
**********************************************************************
GDTKIVAL EQU      %
         PUSH     SR4
         PUSH     R0
         BAL,SR4  GKIFLD            GET NEXT FIELD
         BCS,8    GDTKIV3           ILLEGAL FIELD
         PULL     R0
         LW,R2    KPLB,R7           (R2) = 1ST 4 CHAR
         SLS,R2   KN18
         BAL,SR4  DTVALCK           CHECK IF 1ST CHAR IS LEGAL DEC CHAR
         MTW,-1   KFL,R7            DECREMENT FIELD LENGTH COUNT
         BEZ      GDTKIV2           CHECK IF = 0
         LW,R2    KPLB,R7
         SLS,R2   KN10
         BAL,SR4  DTVALCK           CHECK IF 2ND CHAR IS LEGAL DEC CHAR
         MTW,-1   KFL,R7            DECREMENT FIELD LENGTH COUNT
         BNEZ     GDTKIV4           ERROR IF NOT ZERO
GDTKIV1  EQU      %
         LW,R2    KPLB,R7
         SLS,R2   -16               RIGHT JUSTIFY
         CLM,R2   *0                LEGAL VALUE
         BOL      KEYERR
         PULL     SR4
         B        *SR4              NORMAL EXIT ************
*
GDTKIV2  EQU      %
         LW,R3    KPLB,R7           INSERT
         LI,R2    KF0                     LEADING EBCDIC
         SLD,R2   KN8                                   ZERO
         STW,R3   KPLB,R7                                 FOR 1 CHAR
         B        GDTKIV1                                         VALUE
*
GDTKIV3  EQU      %
         PULL     R0
GDTKIV4  EQU      %
         B        KEYERR
*
*        DATE TIME VALUE CHECK
*
DTVALCK  EQU      %
         AND,R2   XFF
         CI,R2    KF0               CHECK IF < F0
         BL       GDTKIV4           ERROR
         CI,R2    KF9               CHECK IF > F9
         BG       GDTKIV4           ERROR
         B        *SR4              EXIT
         PAGE
*
* SIXPACK HASHES A 6 CHARACTER SERIAL # INTO 1 WORD
* R1=BYTE ADDRESS OF SERAL #
* R2=RESULTS
* CALL BAL,SR4    SIXPACK
*
SIXPACK  EQU      %
         PUSH     3,R3
         LI,R5    0
         LI,R4    6
SIXPACK1 EQU      %
         LB,R3    0,R1
         AI,R1    1
         SLS,R3   26
         SLD,R2   2
         SLS,R3   -28
         MI,R5    10
         AW,R5    R3
         BDR,R4   SIXPACK1
         SLS,R2   20
         OR,R2    R5
         PULL     3,R3
         B        *SR4
         PAGE
*
*        PROCESS   SYST KEYIN  (!SYST)
*
SYST     SET      0
         DO       SYST
         CI,SR1   KBLANK            CHECK FOR A BLANK FOLLOWING SYST
         BNE      KEYERR            ERROR IF NO BLANK
*
         BAL,SR4  GKIFLD            GET 1ST FIELD
         BCS,8    KEYERR            CHECK IF ILLEGAL FIELD
         MTW,-2   KFL,R7
         BGZ      KEYERR            CHECK IF FIELD LENGTH <=2 CHAR
*
         LW,R2    KPLB,R7
         SAS,R2   KN10
         BAL,SR4  OPLBTST           CHECK IF LEGAL OPLABEL
         STW,R1   SR3               SAVE OP LABEL POINTER IN SR3
         CI,SR1   KCOMMA            CHECK OFR COMMA FOLLOWING OPLB
         BNE      KEYERR            ERROR IF NO COMMA
*
         BAL,SR4  GKIFLD            GET 2ND FIELD
         BCS,8    KEYERR            CHECK IF ILLEGAL FIELD
*
         LW,R0    KFL,R7
         CI,R0    K2                CHECK IF FIELD < = 2 CHAR
         BG       KISYST2
         LW,R2    KPLB,R7
         SAS,R2   KN10
         BAL,SR4  OPLBTST           CHECK IF LEGAL OP LABEL
         LB,D1    OPLBT4,R1
         CI,R1    K0                CHECK IF NO DEVICE
         BNE      KISYST1           BRANCH IF NOT
         LI,R2    K0
         LW,R1    SR3
         B        KISYST7
KISYST1  EQU      %
         LB,R2    OPLBT3,R1         (R2) = DEV POINTER
         B        KISYST4
KISYST2  EQU      %
         CI,R0    K5                CHECK IF FIELD LENGTH = 5 CHAR
         BNE      KEYERR            ERROR IF NOT
         LW,R2    KPLB,R7
         LW,R3    KPLB+1,R7
         BAL,SR4  DEVCK             CHECK OFR LEGAL DEV AND CONVERT
         BCS,8    KEYERR            ILLEGAL DEVICE
         LW,R3    KPLB,R7                                               746
         SLS,R3   -16                                                   746
         CI,R3    'MT'              CHECK IF MT DEVICE                  746
         BE       KISYST2A                                              746
         CI,R3    '9T'              CHECK IF 9T DEVICE                  746
         BE       KISYST2A                                              746
         CI,R3    '7T'              CHECK IF 7T DEVICE                  746
         BNE      KISYST3                                               746
KISYST2A EQU      %                                                     746
         LW,R3    R2                                                    746
         AI,R3    NBATAPE           ENTRY IN  AVRTBL                    746
         LW,R1    Y8                                                    746
         SLS,R3   1                 CONERT TO WORD ENTRY                746
         STS,R1   AVRTBL,R3         SET USER BIT                        746
KISYST3  EQU      %
         REF      DCT3,OPLBT2,OPLBT3,OPLBT4
         LB,D1    DCT3,R2
KISYST4  EQU      %
         LW,R1    SR3               (R1) = OP LABEL POINTER
         CI,R1    K0
         BEZ      KEYERR            ERROR IF OP LABEL POINTER = 0
         LB,D2    OPLBT4,R1
         SLD,D1   KN6
         CW,D1    D2                CHECK IF IN-OUT MODES AGREE
         BAZ      KEYERR            ERROR IF NOT
KISYST7  EQU      %
         STB,R2   OPLBT3,R1         STORE ASSIGNMENT
          STB,2    OPLBT2,1          CHANGE CURRENT ASSIGNMENT
          B        KEYINR
         FIN
         PAGE
         DO       DOFFON
*
*        PROCESS DISK ON  DON
*        AND DISC OFF  DOFF KEYINS
*
KIDOFF   LI,D2    -1                FLAG FOR OFF
         B        KIDON10
         SPACE    2
KIDON    LI,D2    0                 FLAG FOR ON
KIDON10  BAL,D3   KIMOUNT1A         GET NDD AND CONVERT TO DCT  INDEX
         CI,R2    BATAPE+AVRTBLSIZ
         BL       KEYERR
         CI,R2    BATAPE+AVRTBLNE
         BG       KEYERR
         LB,D1    DCT3,R2
         SLS,D1   -1
         SLD,D1   1
         STB,D1   DCT3,R2           SET ON/OFF BIT
         B        KEYINR
         FIN
         SPACE    5
         PAGE
         PAGE
*                 PUB SERIAL NOU AVR ID SOL VER  EXCL
* PREMOUNT PUBLIC  1    #     1   0  0   0   0     -
* PREMOUNT         0    #     0   0  0   0   0     -
* AVAILABLE        0    0     0   0  0   0   0     -
* SOLICITED       1 0   #     #   0  #   1   1     -
* BEING VERIFIED   -    #     0   0  #   0   1     -
* DISMOUNT(LOCK)   1    #     #   1  -1            -
* PRIVATE          0    #     #   1  #   -   -     1
* SHARE            0    #     #   1  0   0   0     -
* EXCL             -    -     -   1  -   -   -     1
* POST-MOUNT       -    #     0   1  0   0   0     0
* PUBLIC           1    #     #   1  0   0   0     0
*
*
*
*
*
*
*
*
*
*
*
* PROCESS ANS TAPE KEYINS
KIANSS   EQU      %
         LW,SR2   Y2                ANS SCRATCH FLAG
         B        KIMOUNTZ
KIANSM   EQU      %                 ANS MOUNT FLAG
         LW,SR2   Y3
         B        KIMOUNTZ
KIANSO   EQU      %                 ANS  OVER FLAG
         LW,SR2   Y4
         B        KIMOUNTZ
         PAGE
*
*        PROCESS  MOUNT AND SCRATCH KEYINS
*
KIMOUNT  EQU      %
         LI,SR2   0                 NOT SCRATCH
         B        KIMOUNTZ
KISCRTH  EQU      %
         LW,R2    KPLB+1,R7
         CW,R2    L('TCH ')         CHECK IF REALLY SCRATCH KEYIN
         BNE      SKEYIN            NO
         LW,SR2   Y1
KIMOUNTZ RES      0
         PAGE
*        MOUNT        NDD((,REEL #),ID)
*        SCRATCH                   ,PUBLIC
*
         REF      AVRID
         REF      SOLICIT
         REF      AVRNOU
         REF      MSGOUT,E:WU
         REF      Y2,Y08
AVRB     EQU      Y2
VERB     EQU      Y08
PUBB     EQU      Y8
* Y1=SCRATCH
         BAL,D4   NDD               CHECK NDD -OK DCTX  IN R2
         LI,6     0                 ID
         LI,D3    0                 REEL #
         LW,5     R2
         AI,5    NBATAPE
         CI,SR1   '.'               UNIT SWITCH
         BNE      NOUNTSW           NO
         CW,SR2   Y4                MUST NOT BE OVER KEYIN
         BE       KEYERR
         CI,R5    AVRTBLSIZ         MUST BE TAPE UNIT
         BGE      KEYERR
         MTB,0    SOLICIT,R5        MUST BE SOLICITED
         BEZ      KEYERR
         PUSH     R5
         BAL,D4   NDD               GET 2ND UNIT
         LW,R5    R2
         PULL     R3                R3=1ST DCTX
         AI,R5    NBATAPE           R5=2ND UNIT DCTX
         CI,R5    AVRTBLSIZ         MUST BE TAPE UNIT
         BGE      KEYERR
         AI,R3    BATAPE            DCTX
         AI,R5    BATAPE            DCTX
         LB,D1    DCT4,R3           GET DEVICE TYPE
         CB,D1    DCT4,R5           CHECK FOR SWITCH UNIT--IF NOT SAME ERROR
         BNE      KEYERR            TRIED TO SWITCH RESOURCE TYPE
         AI,R3    -BATAPE           AVRX
         AI,R5    -BATAPE           AVRX
         LD,D1    AVRTBL,R5
         CW,D2    YC5FF             MUST BE FREE
         BANZ     KEYERR
         LD,D1    AVRTBL,R3         OLD AVRTBL
         STD,D1   AVRTBL,R5         NEW AVRTBL
         LI,D1    0                 CLEAR SERIAL #
         AND,D2   YFFFF             CLEAR TPOS
         OR,D2    R5                POINTER
         AI,D2    1
         STD,D1   AVRTBL,R3
         LH,D1    AVRID,R3          OLD AVRID
         STH,R6   AVRID,R3          CLEAR AVRID
         STH,D1   AVRID,R5          NEW AVRID
         STB,R6   SOLICIT,R3        CLEAR SOLICIT
         MTB,1    SOLICIT,R5
         LB,D1    ANSFLGS,R3        OLD ANS FLAGS
         STB,6    ANSFLGS,R3        CLEAR ANS FLAGS
         STB,D1   ANSFLGS,R5        NEW ANS FLAGS
         PUSH     R5
         MI,R3    6*4
         MI,R5    6*4
         ANLZ,D1  BAUNIT1           OLD AVRFNMT
         ANLZ,D2  BAUNIT2           NEW AVRFNMT
         OR,D2    Y18               6 WORD TABLE
         MBS,D1   0
         ANLZ,R1  BAUNIT1
         OR,R1    Y18
         MBS,0    BA(X0)            CLEAD AVRFNMT
         PULL     R5
NOUNTSW  EQU      %
         CI,R5    AVRTBLSIZ         PACK | DRIVE
         BGE      GETAVR            PACK
         LB,D1    ANSFLGS,R5        ANS FLAGS
         CW,SR2   Y4                OVER KEYIN
         BNE      NOTOVER           NO
         MTW,0    ANSPRT            MUST BE SEMI-PROTECTIVE MODE
         BG       KEYERR
         CI,D1    X'30'             ERROR FLAGS MUST BE SET
         BAZ      KEYERR            ELSE ERROR
         B        GETAVR
NOTOVER  EQU      %
         AND,D1   XF7               CLEAR KEYIN TYPE
         CW,SR2   Y2                MOUNT | SCRATCH
         BGE      ANSMNTSCR
         MTB,0    SOLICIT,R5        SOLICITED KEYIN
         BEZ      STFLGS
         CI,D1    X'40'             MOUNT | SCRATCH REQUEST
         BANZ     KEYERR            ERROR IF NOT
         B        STFLGS
ANSMNTSCR EQU     %
         MTB,0    SOLICIT,R5        SOLICITED KEYIN
         BEZ      STFLGS-1
         CI,D1    X'40'             ANSMOUNT | ANSSCRATCH REQUEST
         BAZ      KEYERR            ERROR IF NOT
         AI,D1    8                 ANS KEYIN
STFLGS   EQU      %
         CI,5     AVRTBLSIZ         DONT FOR PACKS
         BGE      GETAVR
         STB,D1   ANSFLGS,R5
GETAVR   EQU      %
         CI,5     AVRTBLSIZ
         BL       SCMT2             TAPE
         CW,SR2   Y1                NO SCRATCH ON PACK
         BANZ     KEYERR
SCMT2    RES      0
         LD,D1    AVRTBL,5          REEL + 2ND  WD
         LW,D4    D2                FLAGS
         CW,SR2   Y1                SCRATCH
         BNE      %+2
         STS,9    D4                SET SCRATCH IF PRESENT
         CW,D2    VERB
         BANZ     VERSET            VER SET
CHKSR    CI,SR1   ','
         BNE      NOIDPUB           NO  REEL  SPECIFIED -NO ID  JUST WAK
*
         BAL,SR4  GKIFLD
         BCS,8    KEYERR
         LW,R2    KFL,R7
         CI,R2    3                 POSSIBLE BLP
         BE       CHKBLP
NOTBLP   EQU      %
         CW,SR2   Y4                OVER KEYIN
         BNE      NOTOVER1          NO
         LB,R0    ANSFLGS,R5        ANS FLAGS
         AND,R0   X30
         CI,R0    ANSVOL**4         SERIAL # ILLEGAL IF ANS VOL
         BE       KEYERR
         LC       ANSFLGS,R5
         BCS,4    ANSREEL#
         B        MNTSCR
NOTOVER1 EQU      %
         CW,SR2   Y1
         BLE      MNTSCR            MOUNT OR SCRATCH
         CW,SR2   Y3                MUST BE ANS SCRATCH | OVER
         BE       KEYERR
         MTW,0    ANSPRT            MUST BE SEMI-PROTECTIVE MODE
         BG       KEYERR
ANSREEL# EQU      %
         CI,R2    6                 ANS SERIAL # MUST BE 6 CHARS
         BNE      KEYERR
         ANLZ,R1  REEL#
         SLS,R1   2                 BYTE ADDRESS
         BAL,SR4  SIXPACK
         LW,D3    R2                HASHED SERIAL #
         B        REEL#+1
MNTSCR   EQU      %
         CI,R2    4
         BG       KEYERR
REEL#    EQU      %
         LW,D3    KPLB,R7           REEL  #
*
         CI,SR1   ','
         BNE      PREMOUNT          NO  ID/PUBLIC
         PAGE
*                                   GET PUB/ID
         BAL,SR4  GKIFLD
         BCS,8    KEYERR
         LW,0     KPLB,R7
         CW,0    ='PUBL'
         BE       PUBLK             YES
         CW,0    ='LOCK'
         BE       LOCK
         LW,0     KFL,R7
         CI,0     4
         BG       KEYERR
         LW,6     D4
         BAL,11   CVSYSID            ID  TO HEX
         BCS,8    KEYERR
*                      ASSUME VALID  ID
*
         LW,D4    6
         LW,6     R2                ID
         PAGE
PREMOUNT RES      0                 NOT PUBLIC
         LB,0     SOLICIT,5
         BNEZ     CKANSSERIAL
         CW,D2    YC1FF             BUSY
         BANZ     KEYERR
         LH,0     AVRNOU,5          IN USE
         BNEZ     KEYERR
CKSERIAL CW,D3    D1
         BE       NOIDPUB
         AND,D4   X1000FFFF         REMOVE FLAG BITS EXCEPT SCRATCH
         BAL,0    SRCHAVR           PREMOUNT
         B        KEYINR
         SPACE    2
STSERIAL LI,D4    0                 6=ID,D3=SERIAL, D4=FLAGS=0 -PUB
         LW,1     5                 AVR INDEX
         BAL,0    SETNEW            SET SERIAL #,ID , WAKE UP ,0=SOLICIT
         B        KEYINR
*
*
CKANSSERIAL EQU   %
         CW,SR2   Y1
         BLE      CKSERIAL
         LW,D1    D3
         B        NOIDPUB
         PAGE
VERSET   LB,0     SOLICIT,5
         BNEZ     CHKSR
         B        KEYERR            INUSE
PUBLK    CI,5     AVRTBLSIZ
         BL       KEYERR            TAPE
PUBNSOL  LH,0     AVRID,5
         BNEZ     CKM1              CHK  -1
*                                   NOT EXCLUSIVE
SEP      RES      0
         AI,D2    0
         BLZ      KEYERR            PUBB SET
         CW,D3    D1
         BE       ISPS              # =#
         LH,0     AVRNOU,5
         BNEZ     KEYERR
         LI,R1    AVRTBLNE+AVRTBLNE ANY OTHER DRIVE
         LI,4     AVRTBLSIZ+AVRTBLSIZ
ISPS2    CW,D3    AVRTBL,4          WITH SAME SN
         BNE      ISPS5
         SLS,4    -1
         LH,0     AVRNOU,4
         BNEZ     ISPS3
         LD,R2    AVRTBL,4
         INT,R3   R3                CLEAR OLD, NOT IN USE
         LI,R2    0
         STD,R2   AVRTBL,4
         B        ISPS0
ISPS3    EQU      %
         LW,1     5
         BAL,0    AVRS
         B        KEYINR
ISPS5    AI,4     2
         CW,4     R1
         BL       ISPS2
ISPS0    INT,D4   D2                FLGS FROM AVRENTRY
ISPS     RES      0
         LW,2     5
         PUSH     2,14
         AI,2     BATAPE
         BAL,11   RAT:DCT4          1=RAT
         B        SC31
         LI,14    0                 RESET
         BAL,11   ASPIN             0=BIT,4=SPINX
         BAL,11   HOWALO            LOADS 0 WITH WHO,CLEARS SPIN
         CI,0     SH:RGCU
         BNE      ISPS10
         MTH,0    AVRNOU,5          GHOST OR PREMOUNT
         BEZ      %+2               PREMOUNT
ISPS10   MTH,-1   *0,1              UNCHARGE IT
         MTH,1    SH:RGCU,1         CHARGE IT TO GHOST
         PULL     2,14
         OR,D4    Y8                SET PUBLIC BIT
         MTH,1    AVRNOU,5          INCREMENT USERS
         B        STSERIAL+1        AND GO STORE IN AVR TABLE
NOIDPUB  LH,6     AVRID,5
         REF      YC1FF
         CW,D2    YC1FF             BUSY
         BANZ     KEYERR
         LH,0     AVRNOU,5          IN USE
         BNEZ     KEYERR
         CW,SR2    Y4                  OVER KEYIN ?
         BNE      NOTOVER2          NO
         LB,R0    ANSFLGS,R5
         AND,R0   XCF               CLEAR ERROR FLAGS
         STB,R0   ANSFLGS,R5
NOTOVER2 EQU      %
         CW,SR2   Y2                ANS KEYIN
         BGE      STORED1
         AI,D1    0                 ANYTHING ?
         BEZ      KEYERR            NO
         CI,D1    -1                SCRATCH ?
         BE       KEYERR            YES
STORED1  RES      0
         STD,D1   D3
         B        STSERIAL+1        WAKE-UP USER IF POSSIBLE
CKM1     CI,0     -1                CHECK FOR LOCK
         BNE      KEYERR
*                                   PUBLIC SPECIFIED :ID=0
         STH,6    AVRID,5           CLEAR AVRID -UNLOCK
         B        SEP               SET SPIN ALLOCATION
NDD      BAL,D3   KIMOUNT1A         R2= DCTX
         CI,R2    BATAPE+AVRTBLNE
         BG       KEYERR
         B        *D4
         PAGE
LOCK     LH,0     AVRID,5
         BNEZ     LOCKX
         CW,D3    D1
         BNE      KEYERR
         CW,D2    PUBB              PUBLIC
         BAZ      LOCKSET           NO
         MTH,-1   AVRNOU,5
         BNEZ     LLK               IF STILL IN USE,GHOST WILL
*                                   BE UNCHANGED
         LW,2     5
         AI,2     BATAPE            DCTX
         BAL,11   RAT:DCT4
         B        SC31              NO FIND
         MTH,-1   SH:RGCU,1         DEC GHOST
         STW,5    S:MBSF
LLK      RES      0
LOCKSET  RES      0
         LI,0     -1
         STH,0    AVRID,5
         AND,D2   M31
         B        STORED1
LOCKX    CI,0     -1
         BE       KEYINR            DONE
         B        KEYERR            EXCLUSIVE USE
KIMOUNT1 EQU      %
         LI,D3    KIMOUNT1B
KIMOUNT1A EQU     %                 IS A SUBROUTINE
KIMOUNT1B EQU     %
         BAL,SR4  GKIFLD            GET FIELD
         BCS,8    KEYERR            CHECK IF LEGAL FIELD
         LW,R1    KFL,R7
         CI,R1    3                 CHECK IF FIELD 3 CHAR'S
         BNE      KEYERR            ERROR IF NOT
         LW,R2    KPLB,R7
         LW,R3    KPLB+1,R7
         SLD,R2   -16
         BAL,SR4  DEVCK             CHECK IF LEGAL MAG TAPE
         BCS,8    KEYERR
         B        *D3
CHKBLP   EQU      %
         LW,R2    BLP
         CW,R2    KPLB,R7
         BNE      NOTBLP
         MTW,0    ANSPRT            MUST BE SEMI-PROTECTIVE MODE
         BG       KEYERR
         LB,R2    ANSFLGS,R5
         OR,R2    X2                BLP FLAG
         STB,R2   ANSFLGS,R5
         B        CHKSR
SRCHAVR  LW,1     5                 SEARCH  AVRTABLE FOR MATCH
         LW,D1    D3
         CW,D4    Y1
         BAZ      %+2               NOT SCRATCH
         LI,D3    -1                SEARCH FO -1
         LI,4     0
         LI,D2    AVRTBLSIZ+AVRTBLSIZ END
         CI,1     AVRTBLSIZ         TAPE ?
         BL       CHK
         LI,4     AVRTBLSIZ+AVRTBLSIZ PACK START
         LI,D2    AVRTBLNE+AVRTBLNE END
CHK      CW,D3    AVRTBL,4          REEL : REEL
         BNE      RNE
         SLS,4   -1                 /2
         LD,R2    AVRTBL,4
         CW,3     YC1FF             BUSY
         BANZ     AVRS
         LH,5     AVRNOU,4          IN USE
         BGZ      AVRS              AVRNOU SOMETIMES NEG. FOR TAPE
         LH,6     AVRID,1           WAKE UP OLD  IF ONE
         BAL,11   WAKEUP
         LW,14    12
         LD,12    AVRTBL,4
         INT,13   13     KILL PUB,SCR ETC. , PRESERVE HGP
         LI,12    0
         LH,6     AVRID,4
         STD,D1   AVRTBL,4
         STH,D1   AVRID,4
         STB,D1   SOLICIT,4
         STH,R6   AVRID,R1          SET NEW FORM OLD
*        ENTRY POINT                ENTRY POINT
*        R1 = AVRX
*        R6 = USER #
*        D4 = FLAGS
SETNEW   LI,D2    0
         STB,D2   SOLICIT,1
SETAVRT  RES      0
         STD,D3   AVRTBL,1          SET  NEW  FROM OLD   6=ID
OUT      BAL,11   WAKEUP            NEW -IF ONE
         B        *0                EXIT
         SPACE    2
RNE      RES
         AI,4     2
         CW,4     D2
         BL       CHK                  MORE
*                      NOT IN  TABLE
         LW,14    12
         STH,R6   AVRID,1           ZAAP OR SET AVRID
         AND,D4   X1000FFFF
         B        SETNEW            WAKE UP
         SPACE    2
AVRS     EQU      %
         AI,1     BATAPE            DCTX
         LI,3     1                 PRIORITY
         LI,13    NOTUNIQUE         MESSSAGE ADDRESS
         BAL,5    MSGOUT            TYPE ON OC
         B        *0                GO TO KEYIN
*
NOTUNIQUE TEXTC ' NOT UNIQUE'
         PAGE
*                                   ENTER ON 11
WAKEUP   LW,5     6                 6=ID
         BEZ      *11               NONE
         CI,5     SMUIS
         BG       *11               PREMOUNT
         PUSH     0,5
         DISABLE
         LB,7     UB:US,5
         REF      SW
         CI,7     SW
         BNE      WUX               BAD STATE TO WAKEUP
         LI,6     E:WU              WAKE UP EVENT
         BAL,11   T:RUE             WAKE UP
WUX      ENABLE
         PULL     0,5
         B        *11
         PAGE
*
*        PROCESS   INT  KEYIN
*
         DO       INT
         REF      INTENT
KIINT    EQU      %
         LI,R2    0                                                     746
         CI,SR1   X'15'             CHECK FOR NEW LINE CHAR             746
         BE       KIINT2            YES-BRANCH-NO ID                    746
         CI,SR1   ' '               CHECK FOR BLANK                     746
         BNE      KEYERR            NO-BRANCH-KEYERR                    746
         BAL,SR4  GKIFLD            GET ID                              746
         LI,R2    0                                                     746
         LW,R1    KFL,R7            (R1) = NO. OF CHAR'S IN ID          746
         BEZ      KIINT2            IF ZERO-NO ID-BRANCH                746
         BAL,SR4  CVSYSID           CONVERT ID                          746
         BCS,8    KEYERR            ILLEGAL ID                          746
KIINT2   EQU      %                                                     746
         BAL,SR4  CKSYSID           CK ID                               746
         LW,R1    Y8
         CW,R1    INTENT,R5         CHECK IF M:INT CALL MADE
         BAZ      KEYERR            NO, KEYERR
         SLS,R1   -1
         STS,R1   INTENT,R5         SET INT BIT
         B        KEYINR            EXIT
         FIN
         PAGE
         REF      GMB,QUEUE
KIREQ    RES      0                 REQUEST KEYIN
         BAL,SR4  GKIFLD
         BCS,8    KEYERR
         MTW,-2   KFL,R7
         BNEZ     KIREQNDD          NDD ?
         LI,R1    3                 LATER INDEX
         LW,D3    KPLB,R7
         SLS,D3   -16
         LI,R4   10
         CI,D3    'MT'
         BE       REQTY
         LI,R4    9
         CI,D3    '7T'
         BE       REQTY
         LI,R4    8
         CI,D3    '9T'
         BE      REQTY
         LI,R4    X'B'
         CI,D3    'DP'
         BE       REQTY
         MTH,-1   D3                GETSIGN EXTENDED...
         LI,R2    SV:RSIZ+1
         CH,D3    SH:RNM,R2         TEST FOR RESOURCE TYPR
         BE       REQ%RS            FOUND ONE
         BDR,R2   %-2               TEST AGAIN
         B        KEYERR            NO MATCH-ERROR
*
REQ%RS   LB,R4    SB:RTY,R2         GET DEVICE TYPE
         LC       TB:FLGS,R4        FIND OUT WHAT KIND
         BCR,8    KEYERR            NOT TAPE OR PACK --ERROR
*        CHECK FOR FIRST AVAIL
*        TYPE IN  R4
REQTY    LI,R2    -AVRTBLNE
         LI,R3    BATAPE
REQTY1   CI,R4   10
         BE       REQTY2-1
         LB,D1    DCT4,R3
         CW,D1    R4                TYPE
         BNE      REQTY2
         BAL,5    CKFREE
REQTY2   AI,R3    1
         BIR,R2   REQTY1
         B        KEYERR1           NONE     LATER=R1
         PAGE
CKZERO1  CI,2     AVRTBLSIZ
         BGE      CKZERO3           PACK
         STB,D3   ANSFLGS,R2
         LW,3     2                 AVRX
         MI,3     6*4               AVRFNMTBLX
         ANLZ,1   BAUNIT1           BA AVRFNMTBL
         OR,1     Y18               EACH ENTRY 24 BYTES
         MBS,0    BA(X0)            ZAP
         B        CKZERO2+1
CKZERO2  INT,D4   D2                SAVE HGP
         AI,2     -AVRTBLNE
CKZERO   STD,D3    AVRTBL+AVRTBLNE+AVRTBLNE,2
         WD,0      X'27'
         AI,2      BATAPE+AVRTBLNE
         LW,6     2                 SAVE INDEX
         BAL,SR4  GMB               USES D3,R0,R2,R5
         BEZ      %-1               WAIT
         LW,R1    D3
         LW,8     KIREQ8
         LI,R3    -20
         AW,8     D3                SET DCB IN 8
KIREQFIL LW,D4    KIREQ111+20,R3    MOVE IMAGE TO BUFFER
         STW,D4   0,R1
         AI,R1    1
         BIR,R3   KIREQFIL          0
         AWM,D3   KIREQBF-KIREQ111-20,R1     QBUF SET
         LH,D3    DCT1,R6
         AND,D3   X7FF
         LI,D4    0
         LI,R3    3
KIRCN    SLD,D3   -4
         SLS,D4   -4
         BDR,R3   KIRCN
         AWM,D4   KIREQDD-KIREQ111-20,R1     NDD
         CI,D4    X'80000'
         BCR,4    KIRCN1
         CI,D4    X'60000'
         BCR,4    KIRCN1
         AW,D4    KIRCN2
         STW,D4  KIREQDD-KIREQ111-20,R1
KIRCN1   RES      0
         AI,D1    0
         BEZ      KIRQUE                     SET BYTE COUNT =8
         STW,D1   KIREQT2-KIREQ111-20,R1     REEL NR
         LC       D2
         BCS,1    KIRQUE1
         LCI      3
         LM,D2    KIREQSV
         STM,D2   KIREQT1-KIREQ111-20,R1   'AND SAVE'
         B        KIRQUE1
CKZERO3  PUSH     4,R1
         REF      ACNCFU,BGRCFU,CFUSIZE
         AI,R2    BATAPE+X'3C00'    NEW FORMAT
         LI,15    X'10000'          CFUPRIVBIT
         LI,R4    4                 HA(DCTX)
         LI,R1    BGRCFU
1A2      LC       *R1
         BCS,12   1A1               IT'S IN USE
         CW,15    0,R1
         BAZ      1A1               NOT PRIVATE
         CH,R2    *R1,R4
         BNE      1A1               NO HIT
         STW,R4   2,R1
1A1      AI,R1    CFUSIZE
         CW,R1    ACNCFU+13
         BLE      1A2
         PULL     4,R1
         B        CKZERO2
         PAGE
*
*
KIREQNDD RES      0
         LW,R2    KPLB,R7
         SLD,R2   -16
         BAL,SR4  DEVCK             DEVICE POINTER IN R2
         BCS,8    KEYERR
         LB,R4    DCT4,R2
         LC       TB:FLGS,R4        GET DEVICE TYPE
         BCR,8    KEYERR            NOT TAPE OR PACK
KIREQND6 LI,R1    3                 LATER
         AI,2     -BATAPE-AVRTBLNE
         BAL,R5   CKFREE
         B        KEYERR1           LATER
KIRQUE   LW,D1    KIREQBK
         STW,D1   KIREQBLK-KIREQ111-20,R1
KIRQUE1  BAL,SR4  QUEUE
         B        KEYINR            EXIT
*        CHECK FO R  AVAIL
*        ANSWER   IN  D1 AND D2
CKFREE   LI,D3    0
         LI,D4    0
         WD,0     X'37'             D
         LD,D1     AVRTBL+AVRTBLNE+AVRTBLNE,2
         AI,2     AVRTBLNE          ADJUST OFFSET
         CI,2     AVRTBLSIZ         TAPE
         BGE      CKF7              NO
CKF5     LH,13    AVRID,2           IN USE
         BEZ      CKZERO1           NO
CKF6     AI,2     -AVRTBLNE         ADJUST OFFSET
         B        CKF10             RETURN
CKF7     CW,D2    Y18               VER OR INIT SET
         BANZ     CKF6              YES, CAN'T USE IT NOW
         AI,13    0                 IS IT PUBLIC
         BLZ      CKF8              MAYBE
         MTH,0    AVRNOU,2          IS IT IN USE
         BEZ      CKZERO1           NO, WE CAN DISMOUNT
         B        CKF6              YES, RETURN
CKF8     AI,12    0
         BEZ      CKF6              SYSTEM PACK,RETURN
         LH,SR4   AVRNOU,2          IS PRIV    MARKED PUBLIC
         CI,SR4   1                 IS GHOST THE ONLY USER
         BNE      CKF6              NO, CAN'T HAVE IT
         STH,14   AVRNOU,2          YES, ZAP # USERS
         STH,14   AVRID,2           AND MAYBE LOCK FLAG
         AI,2     BATAPE
         BAL,11   RAT:DCT4
         B        SC31
         MTH,-1   SH:RGCU,1
         STW,SR4  S:MBSF            KICK BATCH SCHEDULER
         AI,2     -BATAPE           AVR INDEX
         B        CKZERO1           AND GO DISMOUNT IT
CKF10    EQU      %
         WD,0     X'27'             E
         B        0,R5              NO
KIREQ111 TEXT     '!!  '
KIREQDD  TEXT     'A00 '
         TEXT     'DISMOUNT'
KIREQT1  TEXT     ' SCRATCH'        4
         TEXT     '    '
KIREQT2  TEXT     '    '            REEL NR
*                                   RELEASE BUFFER
KIREQDCB EQU      %
         DATA     X'00A00003'
         DATA     X'8001'           DCTX
         PZE     0
         PZE     0
         PZE     0
         PZE     0
KIREQBLK  GEN,15,17  32,0
KIREQBF  GEN,8,8,16 1,0,0           FCN,0,QBUF
         PZE     0
KIREQBK  GEN,15,17  8,0
KIREQ8   GEN,8,24 4,KIREQDCB-KIREQ111
KIREQSV  TEXT     ' AND SAVE   '
KIRCN2   DATA     X'C1B7F040'       CONVERSION
         PAGE
*
*        PROCESS  SWITCH KEYIN
*
         DO       SWITCH
         REF      TCBADR,SS
KISWIT   EQU      %
         CI,SR1   ' '               CHECK FOR BLANK
         BNE      KEYERR            ERROR IF NO BLANK
         BAL,SR4  GKIFLD            GET SYSID
         BAL,SR4  CVSYSID
         BAL,SR4  CKSYSID           CHECK IF CORRECT SYSID
         CI,SR1   ','               CHECK FOR COMMA
         BNE      KEYERR            ERROR IF NO COMMA
         LI,D1    0                 SET D1 =0
KISWIT2  EQU      %
         BAL,SR4  NXKICHR           GET NEXT CHAR
         CI,SR1   '('               CHECK IF '('
         BNE      KEYERR            ERROR IF NOT
         BAL,SR4  GKIFLD            GET KEYWORD
         SLD,D3   64
         LW,R2    KPLB,R7
         CW,R2    L('RESE')         CHECK IF  'RESET'
         BE       KISWIT4           YES
         LI,D3    X'3F'                                                 746
         CW,R2    L('SET ')         CHECK IF 'SET'
         BNE      KEYERR            NO, KEY ERROR
KISWIT4  EQU      %
         CI,SR1   ','
         BAL,SR4  GKIFLD
         LW,R2    KPLB,R7
         CW,R2    L('ALL ')         CHECK IF 'ALL' SPECIFIED
         BNE      KISWIT8
         LI,D4    X'3F'                                                 746
         STS,D3   SS,R5                                                 746
KISWIT6  EQU      %
         CI,SR1   ')'               CHECK FOR ')'
         BNE      KEYERR
         BAL,SR4  NXKICHR           GET NEXT CHAR
         CI,SR1   ','               CHECK IF ','
         BE       KISWIT2           YES
         CI,SR1   ' '               CHECK IF BLANK
         BE       KISWIT7           YES
         CI,SR1   X'15'
         BNE      KEYERR            NO
KISWIT7  EQU      %
         LI,D2    X'3F'
         LW,D1    SS,R5
         LW,R2    TCBADR,R5
         CI,R2    X'1FFFF'          CHECK IF TCBADR NON-ZERO
         BAZ      KEYINR            NO
         STS,D1   TCBSS,R2          YES, STORE SS IN TCB
         B        KEYINR            EXIT
*
KISWIT8  EQU      %
         LW,R1    KFL,R7
         CI,R1    1                 CHECK IF VALUE 1 CHAR
         BNE      KEYERR
         LW,R2    KPLB,R7
         LB,R2    R2                (R2) = VALUE CHAR
         AI,R2    -X'F1'
         BLZ      KEYERR            ILLEGAL VALUE
         CI,R2    5
         BG       KEYERR            ILLEGAL VALUE
         LI,D4    X'20'
         LCW,R2   R2
         SLS,D4   0,R2
         STS,D3   SS,R5
         CI,SR1   ','
         BNE      KISWIT6
         BAL,SR4  GKIFLD            GET NEXT FIELD
         B        KISWIT8
         FIN
         PAGE
KEYINB   BDR,R3   KEYINA
*
*        PROCESS  DEVICE  KEYIN  (!YYNDD )
*
DEVKEYIN EQU      %
         LW,R2    KPLB,R7
         LW,R3    KPLB+1,R7
R2       SET      1
         LB,R2    R1
         CI,R2    'S'               CHECK IF SYMBIONT KEYIN
R2       SET      2
         BE       SKIN
         B        KEYERR
         PAGE
*                 PREFER/PREFER RAD
KIRAD1ST RES      0
         LI,D2    1
         CI,SR1   ' '
         BE       %+2
         LI,D2    0
         STW,D2   RAD1ST
         B        KEYINR
SKIN     EQU      %
         LW,R3    KFL,R7
         CI,3     3
         BNE      SKEYIN
         CI,8     ','
         BNE      SKEYIN
         SLS,2    8
         LH,8     2
         LI,2     TYPMNSZ
         CH,8     OH:NM,2
         BE       %+3
         BDR,2    %-2
         B        KEYERR
         LI,4     0
         LB,3     SNDDX
         CB,2     STB:TYP,3
         BE       %+3
SKIN2    BDR,3    %-2
         B        SKIN3
         CI,3     MXSTRM
         BLE      SKIN3
         AI,4     0
         BNEZ     KEYERR
         LB,4     SNDDX,3
         B        SKIN2
SKIN3    EQU      %
         AI,4     0
         BEZ      KEYERR
         LD,2     DCT16,4
         SLD,2    16
         LI,8     ','
         B        SKIN1
         PAGE
*
*        PROCESS  SYMBIONT  KEYIN     (!SYYNDD)
*
SKEYIN   EQU      %
         LW,R2    KPLB,R7
         LW,R3    KPLB+1,R7
SKIN1    EQU      %
         SLD,R2   8
         BAL,SR4  DEVCK             CHECK IF LEGAL DEVICE
         BCS,8    KEYERR
         DO       RBCODE            :
         CLM,R2   RBLIMS            NO RB DEVICES ON SYMBIONT KEYINS
         BCR,9    KEYERR            :
         FIN                        :
         PUSH     R2
         BAL,15   SKFCK
         B        SKFRM
         LW,D1    SR1
         PULL     R2
         BAL,SR4  SYMCOM
         B        KEYINR
SKEYIN2  EQU      %
         PULL     R2
         B        KEYERR
SKFCK    EQU      %
         BAL,11   NXKICHR
         BCS,8    SKEYIN2
         LI,3     3
         CB,8     FKIC,3
         BE       *15
         BDR,3    %-2
         AI,15    1
         B        *15
SKFSET   EQU      %
         BAL,11   NXKICHR
         BCR,8    %+4
         LI,9     0
         STW,9    KPLB,7
         B        *15
         CI,8     ''''
         BNE      SKEYIN2
         BAL,11   GKIFLD
         BCS,8    SKEYIN2
         LI,9     KPLB
         AW,9     7
         LW,1     KFL,7
         AI,1     -1
         BLEZ     SKEYIN2
         CI,1     4
         BG       SKEYIN2
         LB,4     *9,1
         CI,4     ''''
         BNE      SKEYIN2
         LI,4     ' '
         STB,4    *9,1
         B        *15
SKFRM    EQU      %
         LI,12    X'FF'
         LI,13    -1
         LI,14    -1
SKFRM1   B        %,3
         B        SKFF
         B        SKFO
SKFJ     BAL,11   OCPCK
         BAL,15   SKFSET
         LW,0     KPLB,7
         BNEZ     %+3
         LI,12    0
         B        SKF1
         BAL,15   DECONV
         BCS,8    SKEYIN2
         CI,1     33
         BG       SKEYIN2
         LW,12    1
         B        SKF1
SKFF     EQU      %
         BAL,15   SKFSET
         LW,13    KPLB,7
         B        SKF1
SKFO     EQU      %
         BAL,11   OCPCK
         BAL,15   SKFSET
         LW,14    KPLB,7
SKF1     EQU      %
         CI,8     ','
         BNE      SKFRM2
         BAL,15   SKFCK
         B        SKFRM1
         B        SKEYIN2
*        PRE7-0609 LIP 6-4-73
SKFRM2   EQU      %
         PULL     R2
         BAL,11   SYMTABCK
         B        %+2
         B        KEYERR
         SLS,12   8
         AI,12    KFRMGFC
         REF      KFRMGFC
         SLS,3    16
         OR,12    3
KSGCQ    EQU      %
         BAL,4    SGCQ
         B        KEYERR1
         B        KEYINR
FKIC     TEXT     ' FOJ'
OCPCK    EQU      %
         LI,R1    OCPIO
         BEZ      SKEYIN2
         LW,R1    *TSTACK
         LB,R1    DCT4,R1
         CI,R1    OCPTYP
         BNE      SKEYIN2
         B        *11
         SREF     OCPIO,OCPTYP
         PAGE
*
*                 PROCESS START SYMBIONT KEYIN
*
KISTSY   EQU      %
         LI,R4    SNDDX
         BEZ      KEYERR            NON-SYSMBIONT SYSTEM
         LI,R4    0
         LB,R1    SNDDX             NO. OF SYMBIONT DEVICES
KISTSY0  LB,R3    SYMX,R1
         CI,R3    1
         BE       KISTSY2           YES
KISTSY1  BDR,R1   KISTSY0           NO-LOOP
         CI,R4    1                 WAS THERE ONLY 1 INP. SYMB.
         BNE      KEYERR            NO-ERROR
         LD,R2    DCT16,R5          :
         SLD,R2   16
         LI,R1    'S'
         STB,R1   R2                MAKE NAME SYMBIONT
         LI,R1    1
         LI,R4    ',I'
         STH,R4   R3,R1             STORE AS SNAME,I
         LCI      2
         STM,R2   KEYINBUF
         B        KEYIN20           KEYIN WILL DO THE REST
*
KISTSY2  LB,R2    SNDDX,R1          GET DCTX
         DO       RBCODE            :
         CLM,R2   RBLIMS            IF THIS IS AN RB DEVICE SKIP OVER IT
         BCR,9    KISTSY1           AND DON'T COUNT AS A CARD READER
         FIN                        :
         LW,5     2                 :
         AI,R4    1                 BUMP COUNT OF INPUT DCTX'S
         B        KISTSY1
         PAGE
         DO       FRGRND
FKEYIN   EQU      %
         LW,R4    KPLB+2,R7         REMOVE F CHAR
         LB,R4    R4                      FROM NAME
         STB,R4   R2                                AND PACK
         SCD,R2   8                                  NAME
         STD,R2   D1                                     INTO  2 WORDS
         CI,SR1   ','               CHECK FOR COMMA
         BNE      KEYERR
         BAL,SR4  NXKICHR           GET ACTION CHAR
         LI,R1    1
         CI,SR1   'I'               CHECK IF INIATE FUNCTION
         BE       FKEYIN2
         LW,R1    Y008
         CI,SR1   'X'               CHECK IF ABORT FUNCTION
         BE       FKEYIN2
         LW,R1    Y4
         CI,SR1   'S'               CHECK IF SUSPEND FUNCTION
         BE       FKEYIN2
         LI,R1    2
         CI,SR1   'C'               CHECK IF CONTINUE FUNCTION
         BE       FKEYIN2
         LW,R1    Y2
         CI,SR1   'L'               CHECK IF LOCK FUNCTION
         BNE      KEYERR
FKEYIN2  EQU      %
         LI,R2    INTTABLE          (R2) = ADR OF INT. TABLE
         LI,R3    0
         LI,R4    0
FKEYIN4  EQU      %
         CD,D1    *R2
         BNE      FKEYIN10
         CI,R4    0
         BNE      FKEYIN6
         LI,R4    1
         LW,D3    FLAGS,R2
         BGEZ     KEYERR            CHECK IF TASK ACTIVE
         CI,R1    1                 YES, CHECK IF, INITIATE FUNC.
         BE       FKEYI             YES, INITIATE TASK
FKEYIN6  EQU      %
         CI,R1    2                 CHECK IF CONTINUE FUNC.
         BE       FKEYC             YES
         STS,R1   FLAGS,R2          NO, X,S,OR L, SET FLAG
         LI,SR1   3                 NO, X OR S FUNC, SET DISARM CODE
         MTB,2    SR1               SET MONITOR CALLFLAG
FKEYIN8  EQU      %
         PUSH     R1                                                    746
         PUSH     SR4
         BAL,SR4  FKEYINC           PERFORM INT CONTROL FUNC.
         PULL     SR4
         PULL     R1                                                    746
FKEYIN10 EQU      %
         AI,R2    16
         AI,R3    1
         CI,R3    TNINT             CHECK IF AT END OF TABLE
         BL       FKEYIN4           NO
         CI,R4    0                 CHECK IF LEGAL TASK NAME
         BE       FTIME                                                 746
         B        KEYINR
*
FKEYC    EQU      %
         LW,D3    FLAGS,R2
         CW,D3    Y4                CHECK IF TASK SUSPENDED
         BAZ      FKEYCL            NO
         LI,R0    0                 YES
         LW,R1    Y6                CLEAR  S  AND  L FLAGS
         STS,R0   FLAGS,R2
         LI,SR1   4                 SET ARM CODE
         B        FKEYIN8
FKEYCL   EQU      %
         LI,R0    0
         LW,R1    Y2
         STS,R0   FLAGS,R2          CLEAR   L  FLAG
         B        FKEYIN10
*
FKEYI    EQU      %
         CW,D3    Y6                                                    746
         BANZ     KEYERR            YES
         LI,SR1   4                 SET ARM CODE
         MTB,2    SR1               SET MONITOR CALL FLAG
         PUSH     SR4
         BAL,SR4  FKEYINC           PERFORM ARM
         PULL     SR4
         B        KEYINR
*
FKEYINC  EQU      %
         STW,R3   R6
         LW,R1    WDINST,R2
         CI,R1    X'F'              CHECK IF INT. IN GROUP 0
         BANZ     FKEYINC2          NO
         SW,R6    L(NINT)
         AI,R6    CLKBASE           (R6) = ADR OF CLK INTERRUPT
         B        FKEYINC4
FKEYINC2 EQU      %
         AI,R6    INTBASE           (R6) = ADR OF EXT. INT
FKEYINC4 EQU      %
         LI,R7    0
         PUSH     R7
         LW,R7    TSTACK
         PUSH     3,R2
         PUSH     3,SR4
         OBAL     EPRMFRCL,ROOTSEG                                      746
         PULL     3,SR4
         PULL     3,R2
         PULL     R7
         B        *SR4
*                                                                       746
*        CHECK AND PROCESS KEYINS FOR TASKS CONNECTED TO                746
*        MONITOR'S CLOCK                                                746
*                                                                       746
FTIME    EQU      %                                                     746
         CW,R1    L(X'40000001')    CHECK IF INITIATE OR SUSPEND        746
         BAZ      KEYERR            NO                                  746
         LI,D3    NCLKTMRS          CHECK IF ANY CLOCK TASKS            746
         BEZ      KEYERR            NO                                  746
         LI,R6    0                                                     746
         LI,R4    CLKNAMS                                               746
FTIME2   EQU      %                                                     746
         CD,D1    *R4                                                   746
         BE       FTIME4                                                746
         AI,R6    1                                                     746
         AI,R4    4                                                     746
         BDR,D3   FTIME2
         B        KEYERR                                                746
FTIME4   EQU      %                                                     746
         SLD,R2   64                SET (R2-R3) =0                      746
         CI,R1    1                 CHECK IF INITIATE FUNCTION          746
         BAZ      FTIME6            NO, SUSPEND                         746
         AI,R4    2                                                     746
         LD,R2    *R4                                                   746
FTIME6   EQU      %
         STD,R2   CLKTMRS,R6        PERFORM INITIATE OR SUSPEND FUNC.   746
         B        KEYINR                                                746
         PAGE
*
*        PROCESS  ARM AND TRIGGER KEYINS
*
*
KIARM    EQU      %
         LI,R6    0                 SET ARM FLAG
         B        KITRIG2
KITRIG   EQU      %
         LI,R6    1                 SET TRIGGER FLAG
KITRIG2  EQU      %
         BAL,SR4  GKIFLD            GET INTERRUPT LOCATION
         LW,R1    KFL,R7
         CI,R1    2                 CHECK IF 2 CHAR
         BNE      KEYERR            ERROR IF NOT
         LW,R2    KPLB,R7
         SLS,R2   -16
         BAL,D4   HEXCK             CONVERT LOW DIGIT
         B        KEYERR
         STW,R2   R3                SAVE INTERRUPT LEVEL FOR GROUP
         LW,R2    KPLB,R7
         SLS,R2   -24
         BAL,D4   HEXCK+1           CVT 2ND DIGIT
         B        KEYERR
         LCW,R3   R3                COMPLEMENT LEVEL NO.
         LI,R4    X'8000'
         SLS,R4   0,R3              SHIFT LEVEL INDICATOR BIT
         AI,R2    -4                (R2) = GROUP CODE
         CI,R2    1                 CHECK IF GROUP 0
         BNE      %+2               NO
         AI,R2    -1                YES, SET CODE =0
         CI,R6    0                 CHECK IF ARM KEYIN
         BE       KITRIG6           YES
         WD,4     X'1700',R2        NO, TRIGGER INT.
         B        KEYINR
KITRIG6  EQU      %
         WD,4     X'1200',R2        ARM INTTERUPT
         B        KEYINR
         FIN
         DO       RBCODE            :
*                                   *
KRBBCST  EQU      %                 ----------------------------------------
         LI,12    OFFBIT            PUT MESSAGE IN MESSAGE FILE HEADING FOR
         BEZ      KEYERR            ALL RBTS.   ERROR IF NOT RBSYSTEM.  IF NO
         LI,12    BCSTGFC           MESSAGE R14=0  R12 GET GHOST FUNCTION CODE
         CI,8     X'15'             FOR RBBDCST
         BNE      KRBMV
         LI,14    0                 -------------------------------------------
         B        KSGCQ
*                                   ----------------------------------------
KRBSEND  EQU      %                 SEND A MESSAGE TO THE SPECIFIED RBT.
         LW,13    KPLB+1,7
         LB,13    13
         CI,13    'T'
         BE       KRBSET
         CI,13    'N'
         BNE      KEYERR
         LI,12    SNDGFC
KRBSC    EQU      %
         BAL,13   KRBDCT            DCTX IS OBTAINED BY KRBDCT.  IF RBT IS
         MTB,0    RBB:ID,2          NOT LOGGED ON OR IF NO MESSAGE ERROR.
         BEZ      KEYERR
         SLS,2    8
         OR,12    2
         PAGE
*
*        PROCESS "RBSEND" OR "ERSEND" KEYINS
*
KRBMV    LI,4     KRBMV4            FOR RBSEND
KRBMV0   BAL,11   GMB               GO GET A MONITOR BUFFER
         BEZ      KEYERR1           SAY "LATER" IF NONE
         LI,3     1                 ASSUME RBSEND FIRST
         CI,4     KRBMV4            TRUE...
         BE       %+2               YEP
         LI,3     9                 NOPE, MUST BE "ERSEND"
         LW,1     KCCP,7            CURRENT CHARACTER POSITION
KRBMV1   LB,0     KEYINBUF,1        GET NEXT CHAR.
         CI,0     X'15'
         BE       KRBMV2
         CI,3     1
         BNE      %+3
         CI,0     ' '
         BE       %+3
         STB,0    *14,3
         AI,3     1
         AI,1     1
         CI,1     72
         BLE      KRBMV1
KRBMV2   EQU      %
         B        0,4               EXIT OR FALL THRU
KRBMV4   LI,11    KEYERR
         AI,3     -1
         BLEZ     RMB
         CI,3     80
         BG       RMB
         STB,3    *14
         LI,11    KEYERR1
         BAL,4    SGCQ
         B        RMB
         B        KEYINR
         PAGE
*
*        SET UP FOR ERROR MSG TO ERROR LOG
*
         REF      ERRLOG
*
*
ERSEND   EQU      %
         BAL,4    KRBMV0            GET AND MOVE MSG
         LW,4     3                 TOTAL # OF BYTES
         AI,4     -9                DECREMENT # OF BYTES
         LW,6     14                MON BUF ADDRS
         AI,14    2                 POINT TO MSG LOC
         STB,4    *14
         AI,3     3                 ROUND
         SLS,3    -2                TOTOTAL NUMBER OF WORDS
         AI,3     X'2700'           CREATE ERROR MSG HEADER
         SLS,3    16                SHIFT INTO POSITION
         STW,3    0,6               AND PUT INTO PLACE
         LW,3     TIME              TIME
         STW,3    1,6               INTO BUFFER
         BAL,5    ERRLOG            RECORD MSG INTO LOG
         AI,14    -2                POINT TO BEGINNING OF MPOOL
         LI,11    KEYINR            COMPLETION EXIT POINT
         B        RMB               RELEASE MON BUF.
*
*                                   ------------------------------------------
KRBDCT   EQU      %                 GET DCTX FOR WSN OR &RBNDD.
         BAL,11   GKIFLD            :
         BCS,8    KEYERR            IF NO '&' IS PRESENT SEARCH RBD:WSN FOR
         LW,2     KPLB,7            WSN.  IF NOT FOUND ERROR.  IF '&' IS PRESENT
         LW,3     KPLB+1,7          GO TO DEVCK TO GET DCT.  IF NOT REMOTE ERROR
         LB,14    2                 IF EVERYTHING A-OK EXIT WITH DCTX IN R2
         CI,14    '&'
         BNE      KRBWSN
         SLD,2    8
KRBDCK   EQU      %
         BAL,11   DEVCK
         BCS,8    KEYERR
KRBDCT1  CLM,2    RBLIMS
         BCS,9    KEYERR
         B        *R13
KRBWSN   EQU      %
         BAL,11   KRBSPN
         B        KEYERR
         CD,2     RBD:WSN,4
         BNE      KRBSPN1
         MTB,0    RBB:ID,R4
         BEZ      KRBSPN1
         LW,2     4
         B        *13
*
*                                   ------------------------------------------
KRBSPN   EQU      %                 CYCLE THROUGH ALL RB DCT INDEXS(SIC).  FIRST
         AI,11    1                 ENTRY IS TO KRBSPN AND SUCCESSIVE ENTRIES AR
         LW,4     RBLIMS+1          TO KRBSPN1.
KRBSPN2  CW,4     RBLIMS                 BAL,11 KRBSPN
         BGE      *11                    B      ALL CHECKED
         AI,11    -1                     IS THIS THE ONE?
         B        *11                    BNE    KRBSPN1
KRBSPN1  BDR,4    KRBSPN2
*
*                                   --------------------------------------------
KRBX     EQU      %                 DISCONNECT ALL RBTS AND PREVENT NEW CONNECTI
         LI,3     OFFBIT
         BEZ      KEYERR
         CI,R8    X'15'
         BE       KRBX1
         BAL,13   KRBDCT
         LI,R3    OFFBIT
         LI,R5    RBXBIT+OADBIT
         B        KRBDX
KRBX1    EQU      %
         LI,R5    RBXBIT+OADBIT
         BAL,11   KRBSPN
         B        KEYINR
         BAL,1    KRBDS1
         B        KRBSPN1
         B        KRBSPN1
*
*                                   --------------------------------------------
KRBDISC  EQU      %                 DISCONNECT GIVEN RBT.
         BAL,13   KRBDCT
         LW,4     2
         LI,3     0
         LI,5     RBXBIT
KRBDX    EQU      %
         BAL,1    KRBDS1
         B        KEYINR
         B        KEYINR
*
*                                   --------------------------------------------
KRBDS1   EQU      %                 ZAP TERMINALS.
         LI,7     ACTBIT+LIPBIT     :
         DISABLE                    IF THE TERMINAL IS CONNECTED STORE RBXBIT IN
         CW,7     RB:FLAG,4         HIS FLAGS CAUSING HIM TO BE HUNG UP ON THE N
         BANZ     KRBDS2            I/O OPERATION.  IF HE ISNT CONNECTED STORE T
         STS,3    RB:FLAG,4         CONTENTS OR R3 SELECTIVELY INTO HIS FLAGS.
         ENABLE                      BRANCH TO BAL+1 IF NOT CONNECTED,BAL+2 IF
         B        *1                CONNECTED.
KRBDS2   EQU      %
         STS,5    RB:FLAG,4
         ENABLE
         B        1,R1
*
*                                   --------------------------------------------
KRBS     EQU      %                 RESTART RBTS BY ALLOWING NEW CONNECTIONS.
         LI,0     0
         CI,8     X'15'
         BE       KRBS1
         BAL,13   KRBDCT
         LI,0     0
         LI,R1    OFFBIT+OADBIT
         CW,R1    RB:FLAG,R4
         BAZ      KEYERR
KRBSX    EQU      %
         STS,0    RB:FLAG,4
         B        KEYINR
KRBS1    EQU      %
         LI,1     OFFBIT+OADBIT
         BAL,11   KRBSPN
         B        KEYINR
         STS,0    RB:FLAG,4
         B        KRBSPN1
*
*
*                                   --------------------------------------------
KRBSET   B        KEYERR
KRBSWIT  EQU      %
         BAL,11   GKIFLD            BUILD TWO COMBUFS AS FOLLOWS
         BCS,8    KEYERR            :
         LW,5     KPLB,7                 DATA           WA(WSN)
         LW,6     KPLB+1,7          :
         LW,12    KFL,7                  GEN,8,24       LINK,0
         BAL,11   GKIFLD                 TEXT           WSN
         BCS,8    KEYERR
KRBSW1   EQU      %                 SGCQ2 IS A SPECIAL ROUTINE TO HANDLE 2 COMBU
         LW,14    KFL,7
         CI,14    2
         BG       KEYERR
         LW,14    KPLB,7
         SAS,14   -16
KRBSW2   EQU      %
         BAL,11   GKIFLD
         BCS,8    KEYERR
         BAL,11   CVSYSID
         LW,13    2
         LW,15    5
         LW,0     6
         SLS,12   8
         AI,12    SWITGFC
         LI,4     KSGCQ+1
         B        SGCQ2             --------------------------------------------
         SREF     ALBIT,DCBIT,KCOMGFC,OADBIT
KRBLOG   EQU      %
         BAL,11   GKIFLD
         BCS,8    KEYERR
         LW,2     KPLB,7
         LW,3     KPLB+1,7
         BAL,13   KRBDCK
         CI,8     ','
         BE       KRBLSN
         LI,4     0
         LI,12    0
         B        KRBLVN
KRBLSN   EQU      %
         PSW,2    TSTACK
         BAL,11   GKIFLD
         PLW,2    TSTACK
         LW,4     KPLB,7
         LW,5     KPLB+1,7
         LW,12    ALBIT
KRBLVN   EQU      %
         LW,R13   ALBIT
         AW,R13   DCBIT
         LI,1     ACTBIT+LIPBIT
         CW,1     RB:FLAG,2
         BANZ     KEYERR
         STD,4    RBD:WSN,2
         STS,12   RB:FLAG,2
         B        KEYINR
KRBCOM   EQU      %
         LI,12    KCOMGFC
         B        KRBSC
         FIN                        END SAM KEYS C00 UPDATES
         PAGE
*
*        CONVERT  SYSID
*
CVSYSID  EQU      %
         LI,R4    0
         LW,R1    KFL,R7
         BE       CVSYSID3                                              746
         CI,R1    4                 CHECK IF <= 4 CHAR
         BG       CVSYSID4          NO, ERROR
         LW,R3    KPLB,R7           (R3) =  EBCDIC  SYSID
CVSYSID2 EQU      %
         SLS,R4   4                       SYSID
         SLD,R2   8                             TO
         BAL,D4   HEXCK                           HEX
         B        CVSYSID4
         OR,R4    R2
         BDR,R1   CVSYSID2
CVSYSID3 EQU       %                                                    746
         LW,R2    R4
         LCI      0
         B        *SR4              EXIT
CVSYSID4 EQU      %
         LCI      8
         B        *SR4
*
*        CKSYSID - CHECK SYSID
*
         DO       IF%NOT%UTS
         REF      SYSID
CKSYSID  EQU      %
         LI,R3    X'FFFF'
         CS,R2    SYSID,R5          CHECK IF EQUAL TO CUR. SYSID
         BNE      KEYERR            NO, ERROR
         B        *SR4
         FIN
         PAGE
**********************************************************************
*        DEVCK    DEVICE CHECK                                       *
*                 CHECKS IF  YYNDD  IS A LEGAL  DEVICE               *
*        ENTER WITH                                                  *
*                 (R2) = 'YYND'                                      *
*                 (R3) = 'D   '                                      *
*        EXIT WITH                                                   *
*                 (R2) =  DEVICE POINTER AND CC1 =0  IF LEGAL DEV    *
*                 CC1 =1 IF ILLEGAL DEV                              *
**********************************************************************
*WATCH OUT FOR SPECIAL TAPE HANDLING
DEVCK    EQU      %
         SLD,R2   -24
         LI,R4    DCTSIZ
         CI,R2    0
         BE       TAPCK
         LD,0     DCT16,R4          LOOK ONLY AT REAL DEVICE NAME -
         AND,0    M8                NECESSARY BECAUSE RB DEVICES
         CD,0     2                 HAVE DIFFERENT FIRST THREE CHARACTERS
         BE       DEVCK2            :
         BDR,4    %-4               :
DEVCK1   LCI      8
         B        *SR4
DEVCK2   LW,R2    R4
         LCI      0
 B *SR4
TAPCK    LW,R1    R3
TAPCK1   LD,R2    DCT16,R4
         AND,3    M24               :
         CW,R3    R1
         BE       DEVCK2
         BDR,R4   TAPCK1
         B        DEVCK1
         PAGE
**********************************************************************
*        HEXCK    HEX  CHECK                                         *
*                 CHECKS IF EBCDIC CHAR IS A LEGAL HEX CHAR. IF      *
*                 LEGAL,CONV. TO HEX                                 *
*        ENTER WITH                                                  *
*                 (R2) = HEX CHAR                                    *
*        EXIT WITH                                                   *
*                 (R2) = HEX DIGIT AND CC1 =0 IF LEGAL               *
*                 CC1 = 1 IF ILLEGAL                                 *
**********************************************************************
HEXCK    EQU      %
         AND,R2   XFF
         AI,R2    -KF0
         BL       HEXCK2            BRANCH IF NOT
         CI,R2    9
         BLE      HEXCK3            BRANCH IF 0-9
HEXCK1   EQU      %
         B        *D4               EXIT
*
HEXCK2   EQU      %
         AI,R2    KF0-KC1
         BL       HEXCK1            BRANCH IF NOT
         AI,R2    -5
         BG       HEXCK1            BRANCH IF NOT
         AI,R2    KA+5
HEXCK3   EQU      %
         AI,D4    1
         B        *D4
         PAGE
*        THIS ROUTINE CONVERTS EBCDIC # IN R0 AS A DECIMAL #
*        OUTPUT DECIMAL # IN R2
DECONV   EQU      %
         LI,1     0                 ACCUMULATOR
         LI,5     4                 COUNT OF BYTES TO CONVERT
*
DCV20X   EQU      %
         LB,3     0                 GET NEXT BYTE
         CI,3     X'40'
        BE       DCV30X               BR TO OK EXIT IF BLANK
*
         AI,3     -X'F0'            SUBTRACT DECIMAL BIAS
         BLZ      DCV40X            BR IF NOT DEC #
*
         MI,1     10                SHIFT ACCUMULATOR
         AW,1     3                 ADD LOW ORDER DIGIT
         SLS,0    8                 SHIFT INPUT VALUE
         BDR,5    DCV20X            LOOP
*
DCV30X   EQU      %
         LCI      0
         B        *15
*
DCV40X   EQU      %                 DONE
         LCI      8
         B        *15
         PAGE
         DO 0
**********************************************************************
*        OPLBTST    OP LABEL TEST                                    *
*                 TESTS FOR LEGAL OP LABEL OR'NO'DEVICE              *
*                                                                    *
*        ENTER WITH                                                  *
*                 (R2) = OP LABEL                                    *
*                                                                    *
*                 (R1) = OP LABEL POINTER OR ZERO IF 'NO' AND CC1 =0 *
*                 IF SEARCH FAILS,  CC1 =1                           *
*                                                                    *
*                                                                    *
*                                                                    *
*                                                                    *
**********************************************************************
         REF      OPLBTSIZ,OPLBT1
OPLBTST  EQU      %
         LI,R1    OPLBTSIZ          (R1) = SIZE OF OP LABEL TABLE
OPLBTST1 EQU      %
         CH,R2    OPLBT1,R1         CHECK IF EQUAL
         BE       OPLBTST2
         BDR,R1   OPLBTST1
         CI,R2    TXNO              CHECK IF 'NO'
OPLBTST2 BE       *SR4
         B        KEYERR
TXNO     EQU      X'FD5D6'
         FIN
         PAGE
***      SYMTABCK MOVED FROM RESIDENT
***      GETS SYMTABX INTO R3 FROM DCTX IN R2
         DEF      SYMTABCK
SYMTABCK EQU      %
         LB,3     SNDDX
         CB,2     SNDDX,3
         BE       *11
         BDR,3    %-2
         AI,11    1
         B        *11
KEYINSZ  EQU   %-KEYIN
         END      START%KEYIN

