*M*      KEYN DRIVER MODULE FOR KEYIN OVERLAY
*
         DEF      KEYN:             PATCHING DF
KEYN:    RES
***********************************************************************
*P*      NAME:    KEYN
*P*
*P*      PURPOSE: TO PROVIDE A DRIVER FOR ALL OPERATOR KEYINS.
*P*
*P*      DESCRIPTION:  THE KEYIN LOAD MODULE (OF WHICH KEYN IS THE MAIN
*P*               MODULE) EXISTS AS A MONITOR OVERLAY ALTHOUGH IT
*P*               EXECUTES AS A GHOST JOB (USER #1).  DEPRESSING THE
*P*               OPERATOR'S CONSOLE INTERRUPT GENERATES A X'5D'
*P*               INTERRUPT.  CONTROL PASSES TO OCINT (IN IOQ) WHERE A
*P*               WRITE REQUEST IS QUEUED FOR THE OPERATOR'S CONSOLE
*P*               CONSISTING OF TWO CHARACTERS:  'N/L','!'.  THIS IS
*P*               FOLLOWED BY A READ REQUEST OF 72 CHARACTERS INTO
*P*               KEYINBUF WITH END-ACTION.  AN I/O INTERRUPT IS
*P*               GENERATED WHEN THE OPERATOR TERMINIATES HIS INPUT WITH
*P*               A 'N/L' CHARACTER.  THE END-ACTION ROUTINE THEN CALLS
*P*               T:GJOBSTRT FOR KEYIN ON ALL OPERATOR KEYINS EXCEPT
*P*               THOSE OF THE FORM:  YYNDD,X (THESE ARE HANDLED DIRECT-
*P*               LY BY IOQ).
*P*
*P*               KEYIN ALSO HANDLES TAPE AND PACK AVR'ING. THIS IS
*P*               INDICATED BY IOQ PUTTING THE DCT INDEX OF THE INTERRUPTING
*P*               DRIVE IN AVRDCT (IN TABLES).
*P*
*P*               THE KEYIN GHOST JOB BEGINS EXECUTION  (MASTER/MAPPED)
*P*               AT T:OV WITH A REQUEST TO ASSOCIATE THE KEYIN OVERLAY
*P*               AS THE RESUULT OF SPECIAL PROCESSING IN THE SWAPPER
*P*               WHICH SETS UP KEYIN'S INITIAL TSTACK ENVIRONMENT.
*P*
*P*               ALL KEYINS ARE HANDLED IN THE KEYN MODULE EXCEPT THE
*P*               FOLLOWING:
*P*                                 DELETE     HANDLED BY DELPRI
*P*                                 PRIO       HANDLED BY DELPRI
*P*                                 FORM       HANDLED BY DELPRI
*P*                                 DISPLAY    HANDLED BY DISPLAY
*P*
*P*      REFERENCE:  CP-V OPERATIONS REFERENCE MANUAL
***********************************************************************
*
ANSPROC  SET      1
MPBITS   SET      1
BITS     SET      1
         SYSTEM   UTS
         B        START%KEYIN
       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
RBCODE   SET      1                 SET TO ZERO FOR NO RB CODE
         PAGE
         DEF      GKIFLD            SUBR TO ACQUIRE NEXT KEYIN FIELD
         DEF      KEYERR            COMMON KEYIN ERROR EXIT
         DEF      KEYINR            COMMON KEYIN NORMAL EXIT
         DEF      KFL               DISPLACEMENT TO FIELD LENGTH IN KPL
         DEF      KPLB              DISPLACEMENT TO BUFFER IN KPL
         DEF      KSGCQ             COMMON ROUTINE TO INTERFACE TO SGCQ
         DEF      NXKICHR           SUBR TO OBTAIN NEXT CHAR IN KEYINBUF
         DEF      TXMOOSE           TEXTC 'MOOSE'
         PAGE
         REF      ACNCFU            TO DERIVE PACK STATUS (REQUEST)
         REF      ANSFLGS           FOR 'ANSM'/'ANSS' KEYINS
         REF      ANSPRT            FOR 'ANSM'/'ANSS' KEYINS
         REF      ASPIN             RESOURCE ALLOCATION FOR PUBLIC MOUNT
         REF      AVRDCT            DCT INDEX FOR AVR PROCESS
         REF      AVRFLGS           SET CODE CONVERSION IN AVR
         REF      AVRFNMT           FOR 'ANSM'/'ANSS' KEYINS
         REF      AVRID             USER ID FOR MOUNT PROCESS
         REF      AVRNOU            DEVICE USAGE FOR MOUNT PROCESS
         REF      AVRTBL            DATA FOR MOUNT PROCESS
         REF      AVRTBLSIZ         DATA FOR MOUNT PROCESS
         REF      AVRTBLNE          DATA FOR MOUNT PROCESS
         REF      BATAPE            TO CONVERT DCTX TO AVR INDEX
         REF      BGRCFU            TO DERIVE PACK STATUS (REQUEST)
         REF      BLANK             ZAPPER FOR KIPL BUFFER
         REF      C:MSM             INITIALIZED BY 'TIME' KEYIN
         REF      CFUSIZE           TO DERIVE PACK STATUS (REQUEST)
         SREF     COC               TO DETERMINE IF T/S SYSTEM
         SREF     COCMESS           ADMIN. MESSAGE FOR TERMINAL USERS
         SREF     OPMESS            OPERATOR MESSAGE (DEFERRED)
         REF      CTRIG             TO RETRY A KEYIN
         REF      CVSYSID           TO COVERT EBCDIC SYSID TO HEX
         REF      DATE              INITIALIZED BY 'DATE' KEYIN
         REF      DCTSIZ            TO SCAN DCT TABLES
         REF      DCT1              DATA FOR DISMOUNT MESSAGE
         REF      DCT16             TO DERIVE/VALIDATE 'YYNDD' ADDRESSES
         REF      DCT21             TIO STATUS
         REF      DCT3              TO CHECK FOR PARTITIONED RB DEVICE
         REF      DCT4              FOR VARIOUS DEVICE-TYPE CHECKS
         REF      DECONV            TO CONVERT EBCDIC # TO BINARY
         REF      DEVCK             TO CONVERT DEV ADR TO DCTX
         REF      DID               INITIALIZED BY 'DIAG' KEYIN
         REF      DOUBLEZERO        USED AS ZAPPER
         REF      E:ABRT            EVENT REPORTED VIA 'X' KEYIN
         REF      E:CBK             EVENT REPORTED VIA 'INT' KEYIN
         REF      E:ERR             EVENT REPORTED VIA 'E' KEYIN
         REF      ECBGBLK           GET ECB/COC BUFFER
         SREF     COCGFLG           FOR 'ON' KEYIN
         REF      ERRLOG            CALLED VIA 'ERSEND' KEYIN
         REF      FCMC              SET CODE CONVERSION ORDER CODE
         REF      GETUSER#          TO DERIVE USER # GIVEN A SYSID
         REF      GMB               TO OBTAIN MISC BUFFERS
         REF      GOODNGT           INITIALIZED VIA 'ZAP' KEYIN
         REF      HEXCK             TO CONVERT EBCDIC CHARACTER TO HEX
         REF      HOWALO            RESOURCE ALLOCATION FOR PUBLIC MOUNTS
         REF      J:BASE            BUFFER FOR AVR READS
         REF      J:CCBUF           USED AS TEMP DATA AREA BY AVR
         REF      J:JIT             START OF JIT
         REF      KEYINBUF          LOCATION OF OPERATOR'S KEYIN
         REF      KEYINEA           END ACTION SUBR FOR AVR ACTION
         REF      KFLUSH            GHOST FUNCTION CODE: FLUSH OUTPUT
         REF      KFRMCG            CALLED TO PROCESS SYMBIONT FORM-CHG
         REF      KFRMGFC           GHOST FUNCTION CODE : FORMS CHG
         REF      KIDEL             TO PROCESS 'DELETE' KEYIN
         REF      KIDIS             TO PROCESS 'DISPLAY' KEYIN
         REF      KIPRI             TO PROCESS 'PRIORITY' KEYIN
         REF      KOSTOP            GHOST FUNCTION CODE : OUTPUT STOP
         REF      LPART             TO DERIVE # OF BATCH PARTITIONS
         REF      LSERIAL           MOUNT RESOURCE/EXCLUSIVE CHECK
         REF      MAXG              TO DERIVE # OF POSSIBLE ACT GHOSTS
         REF      MBSOP#            MOUNT 'PUBLIC' EXCLUSIVE CHECK
         REF      MING              TO PROTECT KEYIN, ALLOCAT, & RBBAT
         REF      MXSTRM            FOR SCANNING SYMBIONT TABLES
         REF      NDD               TO DERIVE DCTX
         REF      NEWQ              USED BY 'MCSEND' & AVR PROCESS
         SREF     OCPIO             TO DETERMINE IF OCP SUPPORT IS INCLUDED
         SREF     OCPTYP            DCT4 VALIDATION FOR OCP DEVICES
         REF      OCQUEUE           KEYIN'S INTERFACE TO THE OC
         REF      OH:NM             TO DECODE 'SYY' FORM OF SYMB KEYIN
         REF      PIGHEAD           PIGEONS CHAIN FOR SEND KEYIN
         REF      PLB:MIN           MOUNT 'PUBLIC' EXCLUSIVE CHECK
         REF      PLH:SID           TO VALIDATE A BATCH SYSID
         REF      QUEUE             USED TO RESPOND TO 'REQUEST' KEYIN
         REF      RAD1ST            INITIALIZED BY 'PREFER' KEYIN
         SREF     RAS:DOL           MASK FOR RAS DCTX
         REF      RAT:DCT4          RESOURCE ALLOCATION FOR PUBLIC MOUNTS
         REF      RMB               TO RELEASE MISC BUFFERS
         REF      RSERIAL           MOUNT RESOURCE/EXCLUSIVE CHECK
         REF      S:BUAIS           INITIALIZED BY 'ONB'/'ZAP' KEYINS
         REF      S:CUN             FIND PHYSICAL JIT
         REF      S:GJOBACN         TO FIND GHOST IN TABLES (E/X/INT)
         REF      S:GJOBTBL         TO FIND GHOST IN TABLES (E/X/INT)
         REF      S:GUAIS           TO CALCULATE MAX POSSIBLE USERS
         REF      S:MBSF            TO GOOSE RBBAT
         SREF     S:MPKYN           MP RE-ENTRANCY COUNTER
         REF      S:OPTION          FOR 'FAST AVR' CAPABILITY
         REF      S:OUAIS           TO CALCULATE MAX POSSIBLE USERS
         REF      SB:GJOBUN         TO FIND GHOST IN TABLES (E/X/INT)
         SREF     SB:INIT           CPU START/STOP FLAGS
         REF      SB:RTY            TO DERIVE DEVICE TYPE FOR 'REQUEST'
         SREF     SB:STATE          SLAVE CPU STATE
         REF      SCNTXT            TO VALIDATE 'FLUSH' KEYIN
         REF      SCSVDGI           TO VALIDATE 'FLUSH' KEYIN
         REF      SGCQ              USED TO PASS GFC'S TO RBBAT
         REF      SH:RBCU           MOUNT 'PUBLIC' SPINDLE ALLOCATION
         REF      SH:RGCU           MOUNT 'PUBLIC' SPINDLE ALLOCATION
         REF      SH:RNM            TO PASS RESOURCE TO GHOST VIA 'GJOB' KEYIN
         REF      SH:ROCU           MOUNT 'PUBLIC' SPINDLE ALLOCATION
         REF      SH:RTOT           MOUNT 'PUBLIC' SPINDLE ALLOCATION
         REF      SIXPACK           TO PACK A 6-CHARACTER SERIAL #
         REF      SMUIS             TO CALCULATE MAX POSSIBLE USERS
         REF      SNDDX             USED BY SYMBIONT KEYINS
         REF      SNULL             TO SKIP INACTIVE USERS DURING 'ZAP'
         REF      SOLICIT           TO DETERMINE PREMOUNT STATUS
         REF      SSTAT             INITIALIZED BY 'OBOFF' KEYIN
         REF      STB:TYP           TO DECODE 'SYY' FORM OF SYMB KEYIN
         REF      SV:RSIZ           MAX INDEX FOR ACCESS TO RESOURCE TBLS
         REF      SYMCOM            TO PROCESS SYMBIONT-TYPE KEYINS
         REF      SYMTABCK          TO CONVERT DCTX TO SYMTAB INDEX
         REF      SYMX              USED TO VALIDATE 'SS' KEYIN
         REF      SYSACCT           DEFAULT GHOST ACCT FOR E/X/INT KEYINS
         REF      SYSTRT            SLAVE START LOCATION
         REF      T:BTSCHED         CALLED VIA 'S' KEYIN
         REF      T:DELUS           KEYIN'S EXIT
         REF      T:GJOBR           INITIATE GJOB WITH RESOURCES
         REF      T:GJOBSTRT        CALLED VIA 'GJOB' KEYIN
         REF      T:RUE             CALLED VIA 'E'/'X'/'INT' KEYINS
         REF      TB:FLGS1          TEST CODE CONVERSION CAPABILITY IN AVR
         REF      TB:FLGS           TO VALIDATE DEVICE-TYPE FOR 'REQUEST'
         REF      TIME              INITIALIZED BY 'TIME' KEYIN
         REF      TSERIAL           MOUNT RESOURCE/EXCLUSIVE CHECK
         REF      TYPMNSZ           INDEX FOR DEVICE-TYPE CHK (SYM KEYIN)
         REF      UB:US             SCAN USERS' STATES ON 'ZAP' KEYIN
         REF      UH:FLG2           X'80' BIT SET BY 'OUTPUT STOP'
         REF      UX:JIT            FIND PHYSICAL JIT
         REF      WAKEUP            WAKEUP USER DURING MOUNT/AVR PROCESS
         REF      XFC               MASK
         REF      X0                ZAPPER
         REF      X1000FFFF         MASK
         REF      YFFFF             MASK
         REF      Y000A             MASK
         REF      Y06               MASK
         REF      Y07               MASK
         REF      Y18               MASK
         REF      Y3                MASK
         REF      1MIN              USED TO CALCULATE C:MSM
*
*
*
         DO       RBCODE
         SREF     ACTBIT            STATUS BITS FOR 'RBDISC'/'RBSWITCH'
         SREF     ALBIT             STATUS BIT FOR 'RBSWITCH' KEYIN
         REF      BCSTGFC           GHOST FUNCTION CODE : 'RBBCST' KEYIN
         SREF     DCBIT             BIT FOR 'RBSWITCH' KEYIN
         REF      DCT24             'DOWN'-BIT : RB DEVICE VALIDATION
         SREF     KCOMGFC           GHOST FUNCTION CODE : 'RBDISC'/'RBSWITCH'
         SREF     LIPBIT            STATUS BIT FOR 'RBDISC'/'RBSWITCH'
         SREF     OADBIT            STATUS BIT FOR 'RBX'/'RBS' KEYIN
         SREF     OFFBIT            STATUS BIT SENT VIA 'RBX' KEYIN
         SREF     RB:FLAG           USED TO COMMUNICATE KEYINS TO RBBAT
         REF      RBB:ID            USED TO DETERMINE IF LINE IS LOGGED-ON
         SREF     RBD:WSN           USED BY 'RBBDCST'/'RBSWITCH' KEYINS
         REF      RBLIMS            USED TO VALIDATE DCTX FOR RB DEVICES
         SREF     RBXBIT            STATUS BIT FOR 'RBX'/'RBDISC' KEYIN
         REF      SGCQ2             USED TO PASS GHOST FCN CODES TO RBBAT
         REF      SNDGFC            GHOST FUNCTION CODE : 'RBSEND' KEYIN
         REF      SWITGFC           GHOST FUNCTION CODE : 'RBSWITCH'
         FIN
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K5       EQU      X'5'
K8       EQU      X'8'
KA       EQU      10
KC1      EQU      X'C1'
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'
KBLANK   EQU      ' '
KCRET    EQU      X'15'
KCOMMA   EQU      ','
KEOB     EQU      X'26'
         PAGE
YC1FF    DATA     X'C1FF0000'
VERB     EQU      Y08
XF       EQU      MASKS+4
XFF      EQU      MASKS+8
X7FF     EQU      MASKS+11
X30      DATA     X'30'
YC5FF    DATA     X'C5FF0000'
XCF      DATA     X'CF'
XF7      DATA     X'F7'
BLP      TEXT     'BLP '
BAUNIT1  MTB,0    AVRFNMT,R3
BAUNIT2  MTB,0    AVRFNMT,R5
NOBRANCH B        SYSTRT            REFLEXIVE BRANCH FOR STORING
         BOUND    8
KEYINQ   TEXT     'KEYIN'
TXMOOSE  TEXTC    'MOOSE'
TXTSTOP  TEXT     'STOP'
TXTGO    TEXT     'GO  '
         PAGE
***********************************************************************
*K*      KEYIN-PARAMETER-LIST AN 8-WORD DATA BLOCK WHICH IS BUILT
*,*               DYNAMICALLY IN TSTACK EACH TIME KEYIN IS ENTERED:
*,*             ----------------------------------------
*,*      WORD 0 |# DELIMITERS|  BA(KEYIN DELIMITERS)   |
*,*           1 |     CURRENT CHARACTER POSITION (KCCP)|
*,*           2 |     BLANK ACTIVE FLAG (KFLAGS)       |
*,*           3 |     ADR. OF KEYIN BUFFER (KBUF)      |
*,*           4 |     FIELD LENGTH (KFL)               |
*,*           5 |     *                                |
*,*           6 |     * 12-CHAR FIELD BUFFER (KPLB)    |
*,*           7 |     *                                |
*,*             ----------------------------------------
***********************************************************************
*
*        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                 BUFFER ADDRESS
KFL      EQU      4                 FIELD LENGTH
KPLB     EQU      5                 FIELD BUFFER
KMAXKIFL EQU      12                MAX. KEYIN FIELD LENGTH
BAKPLB   EQU      4*KPLB
         BOUND    4
         PAGE
LOC      EQU      %
         DEF      KITBL             CSECT BIAS FOR POSSIBLE PATCHING
         DEF      KIJMPTBL          CSECT BIAS FOR POSSIBLE PATCHING
KITBL    CSECT    0
KIJMPTBL CSECT    0
*
*
*
X        SET      0
KITV     CNAME
         PROC
Y        SET      NUM(AF)<2|S:NUMC(AF(1))>4
         ERROR,1,Y   'ILLEGAL/MISSING AGRUMENT FIELD'
         GOTO,Y   %PEND
         USECT    KITBL
LF       TEXT     AF(1)
         USECT    KIJMPTBL
         B        AF(2)
X        SET      X+1
%PEND    PEND
*
*
*----------------------------------------------------------------------*
*                  NAME**RECEIVER                                      *
*----------------------------------------------------------------------*
*
         KITV     '    ',KEYERR
         KITV     'ABOR',KIABORT    ABORT
         KITV     'ANSM',KIANSM     ANSMOUNT
         KITV     'ANSS',KIANSS     ANSSCRATCH
         KITV     'D   ',KIDATE     D
         KITV     'DATE',KIDATE     DATE
         KITV     'DELE',KIDEL      DELETE
         KITV     'DELT',KIDELT     DELTA
         KITV     'DIAG',KDIAG      DIAG
         KITV     'DISP',KIDIS      DISPLAY
         KITV     'DI  ',KIDIS      ABBREVIATED 'DISP'
         KITV     'E   ',KIERROR    E
         KITV     'ERRO',KIERROR    ERROR
         KITV     'ERSE',ERSEND     ERSEND
         KITV     'FLUS',KIFLUSH    FLUSH
         KITV     'FORM',KFRMCG     FORM
GJOBTXT  KITV     'GJOB',KIGJOB     GJOB
         KITV     'HEAD',KIHEAD     HEADING
         KITV     'INT ',ENTINT     INT
         KITV     'MCSE',KMCSEND    MCSEND
         KITV     'MOUN',KIMOUNT    MOUNT
         KITV     'M   ',KIMOUNT    ABBREVIATED 'MOUNT'
         KITV     'OBOF',KOBF       OBOFF
         KITV     'OBON',KOBN       OBON
         KITV     'OFF ',KIGDOWN    OFF
         KITV     'ON  ',KIGUP      ON
         KITV     'ONB ',KIGBUP     ONB
         KITV     'OUTP',KIOUTPUT   OUTPUT
         KITV     'OVER',KIANSO     OVER
         KITV     'PREF',KIRAD1ST   PREFER
         KITV     'PRIO',KIPRI      PRIORITY
         KITV     'READ',KIREAD     READ
         KITV     'REQU',KIREQ      REQUEST
         KITV     'S   ',KISTART    S
         KITV     'SCPU',KSCPU      SCPU
         KITV     'SCRA',KISCRTH    SCRATCH/SCRA03(SYYNDD)
         KITV     'SEND',KISEND     SEND
         KITV     'SS  ',KISTSY     SS
         KITV     'STAR',KISTART    START
         KITV     'T   ',KITIME     T
         KITV     'TIME',KITIME     TIME
         KITV     'X   ',KIABORT    X
         KITV     'XCPU',KXCPU      XCPU
         KITV     'ZAP ',KIFDOWN    ZAP
*
*
*
         DO       RBCODE
         KITV     'RBBD',KRBBCST    RBBDCST
         KITV     'RBCO',KRBCOM     RBCOM
         KITV     'RBDI',KRBDISC    RBDISC
         KITV     'RBLO',KRBLOG     RBLOG
         KITV     'RBS ',KRBS       RBS
         KITV     'RBSE',KRBSEND    RBSEND
         KITV     'RBSW',KRBSWIT    RBSWITCH
         KITV     'RBX ',KRBX       RBX
         FIN
NKEYINS  EQU      X-1
         USECT    LOC
         PAGE
START%KEYIN RES   0
***********************************************************************
*F*      NAME:    START%KEYIN
*F*
*F*      PURPOSE: KEYIN'S START ADDRESS
*F*
*F*      DESCRIPTION:  GOES DIRECTLY TO AVR-PROCESSING IF AVRDCT IS NON-
*F*               ZERO, OTHERWISE IT BUILDS SKELETON KEYIN PARAMETER
*F*               LIST IN TSTACK, ACQUIRES FIRST FIELD OF THE KEYIN
*F*               BUFFER AND TRANSFERS CONTROL TO THE APPROPRIATE
*F*               HANDLER.
***********************************************************************
*D*      NAME:    START%KEYIN
*D*
*D*      CALL:    OVERLAY CALL AS THE RESULT OF OPERATOR KEYIN END-
*D*               ACTION OR I/O INTERRUPT FROM AVR.
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  TRANSFERS CONTROL TO APPROPRIATE HANDLER DEPENDING
*D*               UPON SERVICE REQUIRED (KEYIN OR AVR).
*D*
*D*      INPUT:   AVRDCT = 0     IMPLIES OPERATOR KEYIN
*D*                      /=0     IMPLIES AVR
*D*               KEYINBUF       OPERATOR'S KEYIN TEXT
*D*
*D*      OUTPUT:  R1 = FIRST 4 CHARACTERS OF KEYIN
*D*               R7 = ADR OF KEYIN PARAMETER LIST
*D*               AVRDCT IS ZEROED
*D*
*D*      DESCRIPTION:  GOES DIRECTLY TO AVR-PROCESSING IF AVRDCT IS NON-
*D*               ZERO, OTHERWISE IT BUILDS SKELETON KEYIN PARAMETER
*D*               LIST IN TSTACK, ACQUIRES FIRST FIELD OF THE KEYIN
*D*               BUFFER AND TRANSFERS CONTROL TO THE APPROPRIATE
*D*               HANDLER.
***********************************************************************
*
         LI,7     0                 IF AVR, DO IT AND RESET FLAG
         XW,7     AVRDCT
         BNEZ     AVR
         LI,1     KCRET
         CB,1     KEYINBUF
         BE       KEYINR
         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
         BE       KIJMPTBL,R3       GO TO APPROPRIATE ROUTINE
         BDR,R3   KEYINA
         LW,R2    KPLB,R7
         LW,R3    KPLB+1,R7
         LB,R1    R1                CHECK IF SYMBIONT KEYIN
         CI,R1    'S'
         BE       SKIN
         B        KEYERR
         PAGE
GKIFLD1  STB,SR1  *R7,R2            CHAR TO BFR
         CI,SR1   ''''              IF APOSTROPHE, TOGGLE STRINGMODE SWITCH
         BNE      %+4
         LCW,SR1  KFLAGS,R7
         AI,SR1   -1
         STW,SR1  KFLAGS,R7
         STS,R7   KFLAGS,R7         ANYWAY SET FLAGS NONZERO
         AI,R2    K1
NXKICHR  EQU      %
***********************************************************************
*F*      NAME:    NXKICHR
*F*
*F*      PURPOSE: TO OBTAIN THE NEXT CHARACTER OF KEYIN INPUT,
*F*               CONDITIONALLY SKIPPING BLANKS, AND TO FLAG
*F*               DELIMITERS.
*F*
*F*      DESCRIPTION:  RETURNS TO THE CALLER THE NEXT CHARACTER IN THE
*F*               KEYIN BUFFER AND INCREMENTS THE CURRENT CHARACTER
*F*               POSITION IN THE KEYIN PARAMETER LIST.
***********************************************************************
*D*      NAME:    NXKICHR
*D*
*D*      CALL:    BAL,SR4(R11)
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  SR1(R8) = NEXT CHARACTER FROM KEYIN BUFFER (KEYINBUF)
*D*               CC1 = 1     IF THE CHARACTER IS A DELIMITER
*D*               CURRENT CHARACTER POSITION (KCCP) IS INCREMENTED
*D*
*D*      REGISTERS:  R3 & R4 ARE VULNERABLE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  RETURNS TO THE CALLER THE NEXT CHARACTER IN THE
*D*               KEYIN BUFFER AND INCREMENTS THE CURRENT CHARACTER
*D*               POSITION (KCCP) IN THE KEYIN PARAMETER LIST.  BLANK
*D*               CHARACTERS WILL BE SKIPPED IF KFLAGS IS ZERO.
***********************************************************************
*
         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
         MTW,0    KFLAGS,R7         IF STRINGMODE, JUST GOBBLE
         BLZ      NXKICHR32
         CI,SR1   KBLANK            CHECK IF CHAR IS A BLANK
         BNE      NXKICHR2
         LW,R3    KFLAGS,R7         CHECK IF BLANK IS ACTIVE
         BEZ      NXKICHR
*
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   EQU      %
***********************************************************************
*F*      NAME:    GKIFLD
*F*
*F*      PURPOSE: TO ACQUIRE THE NEXT FIELD FROM THE KEYIN BUFFER.
*F*
*F*      DESCRIPTION:  MOVES THE NEXT FIELD (<= 12 CHARACTERS) FROM THE
*F*               KEYIN BUFFER TO THE FIELD BUFFER OF THE KEYIN
*F*               PARAMETER LIST AND INITIALIZES THE FIELD LENGTH IN THE
*F*               KEYIN PARAMETER LIST.
***********************************************************************
*D*      NAME:    GKIFLD
*D*
*D*      CALL:    BAL,SR4(R11)
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  SR1(R8) = DELIMITER CHARACTER THAT TERMINATES FIELD
*D*               CC1 = 1   IF 1 > FIELD LENGTH > 12
*D*               KFL = FIELD LENGTH
*D*               KPLB= NEXT FIELD FROM KEYINBUF, LEFT-JUSTIFIED WITH
*D*                     TRAILING BLANKS
*D*
*D*      REGISTERS:  R0 THRU R2 ARE VULNERABLE
*D*
*D*      INTERFACE:  NXKICHR
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  MOVES THE NEXT FIELD (<= 12 CHARACTERS) FROM THE
*D*               KEYIN BUFFER TO THE FIELD BUFFER OF THE KEYIN
*D*               PARAMETER LIST (KPLB) AND INITIALIZES THE FIELD LENGTH
*D*               IN THE KEYIN PARAMETER LIST (KFL).  LEADING BLANKS ARE
*D*               SUPPRESSED BY SETTING KFLAGS TO ZERO PRIOR TO CALLING
*D*               NXKICHR.
***********************************************************************
*
         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
         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
KEYERR   EQU      %
***********************************************************************
*F*      NAME:    KEYERR
*F*
*F*      PURPOSE: TO OUTPUT AN ERROR MESSAGE ON OC, RE-TRIGGER THE
*F*               CONTROL TASK, AND EXIT.
*F*
*F*      DESCRIPTION:  OUTPUTS EITHER 'EH' (IF CALL IS TO KEYERR) OR
*F*               'LATER' (IF CALL IS TO  KEYERR1), RE-TRIGGERS THE
*F*               CONTROL TASK SO THE KEYIN MAY BE RE-TRIED, AND EXITS
*F*               (KEYINR) TO STEP VIA T:DELUS.
***********************************************************************
*D*      NAME:    KEYERR
*D*
*D*      ENTRY:   KEYERR1,KEYINR
*D*
*D*      CALL:    DIRECT BRANCH FOR EXIT FROM KEYIN OVERLAY
*D*
*D*      INTERFACE:  OCQUEUE, CTRIG, T:DELUS
*D*
*D*      DESCRIPTION:  OUTPUTS EITHER OF TWO MESSAGES VIA OCQUEUE:
*D*               'EH' (IF CALL IS TO KEYERR) OR 'LATER' (IF CALL IS TO
*D*               KEYERR1);  THE CONTROL TASK IS RETRIGGERED VIA A CALL
*D*               TO CTRIG (SO THE KEYIN MAY BE RE-TRIED);  FINALLY,
*D*               EXIT IS MADE BY CALLING T:DELUS.
******************************************************************************
*
         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
***********************************************************************
*O*      MESSAGE: EH
*O*
*O*      MEANING: UNRECOGNIZED OPERATOR KEYIN SYNTAX
*O*
*O*      ACTION:  RE-TRY THE KEYIN
*O*********************************************************************
*O*      MESSAGE: LATER
*O*
*O*      MEANING: EITHER THE SYSTEM IS UNABLE TO PROCESS THE OPERATOR
*O*               KEYIN AT THIS TIME OR, IN RESPONSE TO A 'REQUEST'
*O*               KEYIN, THE REQUESTED UNIT IS IN USE.
*O*
*O*      ACTION:  RE-TRY THE KEYIN (SPECIFYING A DIFFERENT UNIT IF THIS
*O*               WAS A 'REQUEST' KEYIN).
***************************************************************************
*
         LW,8     Y01               TRIGGER ANOTHER COPY
         BAL,11   CTRIG             OF KEYIN
*
KEYINR   EQU      %
         B        T:DELUS           EXIT TO STEP LOGS SELF OFF
         PAGE
KOBF     EQU      %
***********************************************************************
*F*      NAME:    KOBF
*F*
*F*      PURPOSE: TO PROCESS THE 'OBOFF' KEYIN.
*F*
*F*      DESCRIPTION:  INCREMENTS SSTAT.
************************************************************************
*
         MTB,1    SSTAT
         B        KEYINR
*
*
*
KOBN     EQU      %
***********************************************************************
*F*      NAME:    KOBN
*F*
*F*      PURPOSE: TO PROCESS THE 'OBON' KEYIN.
*F*
*F*      DESCRIPTION:  ZEROES SSTAT.
************************************************************************
*
         LI,R6    0
         STB,R6   SSTAT
         B        KEYINR
         PAGE
ENTINT   EQU      %
***********************************************************************
*F*      NAME:    ENTINT
*F*
*F*      PURPOSE: TO PROCESS THE 'INT' KEYIN.
*F*
*F*      DESCRIPTION:  VALIDATES SPECIFIED SYSID OR GHOST JOB NAME/
*F*               ACCOUNT AND REPORTS AN E:CBK EVENT ON THE USER.
************************************************************************
*
         LI,6     0
         STW,6    J:CCBUF
         LI,6     E:CBK
         B        KIERROR1
*
*
*
KIABORT  EQU      %
***********************************************************************
*F*      NAME:    KIABORT
*F*
*F*      PURPOSE: TO PROCESS THE 'ABORT' AND 'X' KEYINS.
*F*
*F*      DESCRIPTION:  VALIDATES SPECIFIED SYSID OR GHOST JOB NAME/
*F*               ACCOUNT AND REPORTS AN E:ABRT EVENT ON THE USER.
************************************************************************
*
         LI,6     E:ABRT            ABORT EVENT
         STW,6    J:CCBUF
         B        KIERROR1
*
*
*
KIERROR  EQU      %
***********************************************************************
*F*      NAME:    KIERROR
*F*
*F*      PURPOSE: TO PROCESS THE 'ERROR' AND 'E' KEYINS.
*F*
*F*      DESCRIPTION:  VALIDATES SPECIFIED SYSID OR GHOST JOB NAME/
*F*               ACCOUNT AND REPORTS AN E:ERR EVENT ON THE USER.
***********************************************************************
*D*      NAME:    KIERROR
*D*
*D*      ENTRY:   KIABORT, ENTINT
*D*
*D*      CALL:    KEYIN FORMAT:  --     --
*D*                              |-     -|
*D*                              ||ERROR||
*D*                              ||E    || --          --
*D*                              |-     -| |SYSID       |
*D*                              |-     -|,|NAME.       |
*D*                              ||ABORT|| |NAME.ACCOUNT|
*D*                              ||X    || --          --
*D*                              |-     -|
*D*                              | INT   |
*D*                              --     --
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               PLH:SID
*D*               S:GJOBTBL
*D*               S:GJOBACN
*D*               SB:GJOBUN
*D*
*D*      OUTPUT:  NONE
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, CVSYSID, GETUSER#, T:RUE
*D*
*D*      ENVIRNOMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  GKIFLD IS CALLED TO OBTAIN THE SPECIFIED SYSID
*D*               OR GHOST JOB NAME.  IF A SYSID WAS SPECIFIED, CVSYSID
*D*               IS CALLED TO CONVERT IT TO HEX.  IF THIS IS AN 'INT'
*D*               KEYIN THE PARTITION TABLES AND GHOST JOB TABLES
*D*               ARE SCANNED TO VERIFY THAT THE SYSID BELONGS TO AN
*D*               ACTIVE BATCH OR GHOST JOB.  IF A GHOST JOB NAME WAS
*D*               SPECIFIED (IE., DELIMITER IS A '.'), GKIFLD IS CALLED
*D*               AGAIN TO OBTAIN THE ACCOUNT (IF SPECIFIED) AND THE
*D*               NAME/ACCOUNT IS VALIDATED VIA THE GHOST JOB TABLES.
*D*               IN EITHER CASE, GETUSER# IS CALLED TO CONVERT THE
*D*               SYSID TO A USER # AND T:RUE IS CALLED TO REPORT ONE OF
*D*               THE FOLLOWING EVENTS:
*D*                    E:ERR   (IF 'ERROR'/'E' KEYIN)
*D*                    E:ABRT  (IF 'ABORT'/'X' KEYIN)
*D*                    E:CBK   (IF 'INT' KEYIN)
***********************************************************************
*
         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
*                                   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
KISTART  EQU      %
***********************************************************************
*F*      NAME:    KISTART
*F*
*F*      PURPOSE: TO PROCESS THE 'START' AND 'S' KEYINS.
*F*
*F*      DESCRIPTION:  CALLS T:BTSCHED TO GOOSE RBBAT.
***********************************************************************
*
         LI,R0    0
         BAL,11   T:BTSCHED
         B        KEYINR            EXIT
         PAGE
KIDELT   EQU      %
***********************************************************************
*F*      NAME:    KIDELT
*F*
*F*      PURPOSE: TO DRIVE TO EXECUTIVE DELTA VIA AN OPERATOR KEYIN
*F*
*F*      DESCRIPTION:  SIMULATES AN EXU OF X'4E' WITH THE RETURN GOING
*F*               TO KEYINR.
***********************************************************************
*
         LD,R8    DLTPSD
         STD,R8   *X'4E'            SIMULATE AN XPSD INSTRUCTION
*                                   SINCE DELTA WILL TAMPER WITH IT
         LI,R1    1
         LPSD,8   *X'4E',R1         ***GO TO DELTA***
*
*
*
         BOUND    8
DLTPSD   :PSD     (IA,KEYINR+1),(WK,1),MAP,MASTER   DELTA WILL DECREMENT
*                                                   INSTRUCTION ADR
         PAGE                       THIS CODE PROCESSES THE 'TASK'
KIGJOB   EQU      %
***********************************************************************
*F*      NAME:    KIGJOB
*F*
*F*      PURPOSE: TO PROCESS THE 'GJOB' KEYIN.
*F*
*F*      DESCRIPTION:  VALIDATES THE GHOST JOB NAME/ACCOUNT/RESOURCE AS
*F*               SPECIFIED AND CALLS T:GJOBSTRT OR T:GJOBR DEPENDING
*F*               UPON THE FORMAT OF THE KEYIN.
***********************************************************************
*D*      NAME:    KIGJOB
*D*                                       --      ----            --
*D*      CALL:    KEYIN FORMAT:  GJOB NAME|.ACCOUNT||,RESOURCE-NAME|
*D*                                       --      ----            --
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               SV:RSIZ
*D*               SH:RNM
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, T:GJOBR, T:GJOBSTRT, OCQUEUE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  GKIFLD IS CALLED TO OBTAIN THE NAME (MUST BE <=
*D*               7 CHARACTERS AND /= 'KEYIN').  IF THE NAME'S DELIMITER
*D*               IS A CARRIAGE RETURN, T:GJOBSTRT IS CALLED.  OTHERWISE
*D*               GKIFLD IS CALLED TO OBTAIN THE ACCOUNT AND/OR RESOURCE
*D*               AND T:GJOBR IS CALLED.  IF THE GHOST JOB WAS ALREADY
*D*               ACTIVE, OR WE WOKE HIM UP, OR THE GHOST JOB TABLES
*D*               WERE FULL, AN APPROPRIATE MESSAGE IS SENT TO THE
*D*               OPERATOR VIA OCQUEUE.
***********************************************************************
*
         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
         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
         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
***********************************************************************
*O*      MESSAGE: GHOST CURRENTLY ACTIVE
*O*
*O*      MEANING: GJOB KEYIN REFERENCED A CURRENTLY-ACTIVE GHOST JOB
*O*
*O*      ACTION:  NONE
*O*********************************************************************
*O*      MESSAGE: GHOST AWAKENED
*O*
*O*      MEANING: GJOB KEYIN REFERENCED A SLEEPING GHOST JOB
*O*
*O*      ACTION:  NONE
*O*********************************************************************
*O*      MESSAGE: GHOST TABLES FULL
*O*
*O*      MEANING: GJOB KEYIN ATTEMPTED WHEN THE MAXIMUM POSSIBLE #
*O*               OF GHOST JOBS WERE ALREADY ACTIVE.
*O*
*O*      ACTION:  RE-TRY THE KEYIN LATER
***********************************************************************
*
         B        KEYINR
GJOBUSY  EQU      %
         DATA,1   GJOBUC,X'15',X'05',X'5C'
         TEXT     '*GHOST CURRENTLY ACTIVE'
GJOBUC   EQU      BA(%)-BA(GJOBUSY)-1
GJOBWAKE EQU      %
         DATA,1   GJOBWC,X'15',X'05',X'5C'
         TEXT     '*GHOST AWAKENED'
GJOBWC   EQU      BA(%)-BA(GJOBWAKE)-1
GJOBFULL EQU      %
         DATA,1   GJOBFC,X'15',X'05',X'5C'
         TEXT     '*GHOST TABLES FULL'
GJOBFC   EQU      BA(%)-BA(GJOBFULL)-1
         PAGE
KIFDOWN  EQU      %
***********************************************************************
*F*      NAME:    KIFDOWN
*F*
*F*      PURPOSE: TO PROCESS THE 'ZAP' KEYIN.
*F*
*F*      DESCRIPTION:  FORCES ALL USERS OFF BY REPORTING AN E:ABRT EVENT
*F*               ON EACH ACTIVE USER (EXCEPT SYSTEM GHOSTS); SETS
*F*               S:OUAIS AND S:BUAIS  TO ZERO; SIMULATES AN 'RBX' KEYIN
*F*               IF REMOTE BATCH IS ACTIVE AND SIMULATES AN 'XCPU'
*F*               KEYIN IF THIS IS A MULTI-PROCESSING SYSTEM.
***********************************************************************
*
         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
         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
*        B        KIGDOWN           FALL THRU TO 'OFF' KEYIN
KIGDOWN  EQU      %
***********************************************************************
*F*      NAME:    KIGDOWN
*F*
*F*      PURPOSE: TO PROCESS THE 'OFF' KEYIN.
*F*
*F*      DESCRIPTION:  ZEROES S:OUAIS AND S:BUAIS; SIMULATES AN 'RBX'
*F*               KEYIN IF REMOTE BATCH IS ACTIVE AND SIMULATES AN
*F*               'XCPU' KEYIN IF THIS IS A MULTI-PROCESSING SYSTEM.
************************************************************************
*D*      NAME:    KIGDOWN
*D*
*D*      ENTRY:   KIFDOWN
*D*
*D*      CALL:    KEYIN FORMAT:  OFF     (KIGDOWN)
*D*                              ZAP     (KIFDOWN)
*D*
*D*      OUTPUT:  S:OUAIS = 0
*D*               S:BUAIS = 0
*D*               GOODNGT = -2 (IF 'ZAP')
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  T:RUE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  S:OUAIS & S:BUAIS ARE SET TO ZERO; 'RBX' AND
*D*               'XCPU' KEYINS ARE SIMULATED IF APPROPRIATE;
*D*               ADDITIONALLY, IF WE ARE PROCESSING A 'ZAP' KEYIN,
*D*               ALL USERS ARE ABORTED VIA T:RUE  (E:ABRT), AND
*D*               GOODNGT IS SET TO '-2' AS A FLAG FOR SCHED TO
*D*               SCREECH AS SOON AS ALL USERS EXCEPT ALLOCAT & RBBAT
*D*               ARE OFF AND ALL SYMBIONT FILES HAVE BEEN PROCESSED.
***********************************************************************
*
         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
KIGBUP   EQU      %
***********************************************************************
*F*      NAME:    KIGBUP
*F*
*F*      PURPOSE: TO PROCESS THE 'ONB' KEYIN
*F*
*F*      DESCRIPTION:  SETS S:BUAIS TO KEYED-IN VALUE AS LONG AS IT
*F*               DOES NOT CAUSE S:OUAIS+S:BUAIS+S:GUAIS TO EXCEED SMUIS
***********************************************************************
*
         MTW,1    J:CCBUF
         B        KIGB
*
*
*
KIGUP    EQU      %
***********************************************************************
*F*      NAME:    KIGUP
*F*
*F*      PURPOSE: TO PROCESS THE 'ON' KEYIN
*F*
*F*      DESCRIPTION:  VERIFIES THAT COC IS PRESENT THEN SETS S:OUAIS TO
*F*               KEYED-IN VALUE AS LONG AS IT DOES NOT CAUSE
*F*               S:OUAIS+S:BUAIS+S:GUAIS TO EXCEED SMUIS
************************************************************************
*D*      NAME:    KIGUP
*D*
*D*      ENTRY:   KIGBUP
*D*                              -- --
*D*      CALL:    KEYIN FORMAT:  |ON | X     (X = DECIMAL VALUE)
*D*                              |ONB|
*D*                              -- --
*D*
*D*      INPUT    R7 = ADR OF KEYIN PARAMETER LIST
*D*               S:BUAIS, S:OUAIS, S:GUAIS
*D*
*D*      OUTPUT:  S:BUAIS = X   (IF ONB)
*D*               S:OUAIS = X   (IF ON)
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  VERIFIES THAT COC IS PRESENT ('ON' ONLY) AND
*D*               THEN SETS S:BUAIS (IF 'ONB') OR S:OUAIS (IF 'ON')
*D*               TO THE SPECIFIED VALUE.
***********************************************************************
*
         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      KIG1
         CI,1     LPART
         BG       KEYERR
         STW,1    S:BUAIS
         B        KEYINR
KIG1     CW,R1    S:OUAIS           C/NEW # W/CURRENT #
         STW,R1   S:OUAIS           S/NEW #
         BLE      KEYINR            B/NEW # .LE. OLD #
         LI,R1    X'1000'           L/INCREASED-ONLINE-USER-MAX FLAG
         STS,R1   COCGFLG           S/FLAG IN COCG FLAGS; COCG
*                                   .. MAY TELL HARDWIRED LINE USERS
         B        KEYINR
         PAGE
KDIAG    RES      0
***********************************************************************
*F*      NAME:    KDIAG
*F*
*F*      PURPOSE: TO PROCESS THE 'DIAG' KEYIN
*F*
*F*      DESCRIPTION:  STORES THE USER # ASSOCIATED WITH THE SPECIFIED
*F*               SYSID INTO DID
***********************************************************************
*D*      NAME:    KDIAG
*D*
*D*      CALL:    KEYIN FORMAT:  DIAG SYSID
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  DID = USER # OF SPECIFIED USER
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, CVSYSID, GETUSER#
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS GKIFLD TO GET THE SPECIFIED SYSID; CALLS
*D*               CVSYSID TO CONVERT IT FROM EBCDIC TO HEX; CALLS
*D*               GETUSER# TO GET CORRESPONDING USER #, AND FINALLY
*D*               STORES USER # INTO THE DIAGNOSTIC ID CELL (DID).
***********************************************************************
*
         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
          MTW,0    DID                 IS THERE ALREADY A DIAG USER
          BNEZ     KEYERR1
         STW,R5   DID               SAVE O,G,OR B USER #
         B        KEYINR            NORMAL EXIT
         PAGE
KISEND   EQU      %
***********************************************************************
*F*      NAME:    KISEND
*F*
*F*      PURPOSE: TO PROCESS THE 'SEND' KEYIN
*F*
*F*      DESCRIPTION:  INITIATES THE PIGEON GHOST WHICH WILL TRANSMIT
*F*               THE MESSAGE TO ALL USERS OR TO A SPECIFIC USER AS
*F*               INDICATED.
***********************************************************************
*D*      NAME:    KISEND
*D*                                   -   -
*D*      CALL:    KEYIN FORMAT:  SEND,|ID | MESSAGE
*D*                                   |ALL|
*D*                                   -   -
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               COC
*D*
*D*      OUTPUT:  PUTS THE PIGEON GHOST INTO EXECUTION IF THERE IS ANY
*D*               MESSAGE TO TRANSMIT; IF 'ALL' WAS SPECIFIED, THE
*D*               DEFERRED-MESSAGE BUFFER IS UPDATED.
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, T:GJOBSTRT, KINOHDR, KIMVHDR
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  IF THIS IS A TIME-SHARING SYSTEM, AND A MESSAGE
*D*               WAS SPECIFIED, T:GJOBSTRT IS CALLED TO INITIATE THE
*D*               PIGEON.  ADDITIONALLY, IF 'ALL' WAS SPECIFIED, KIMVHDR
*D*               UPDATES THE DEFERRED-MESSAGE BUFFER.
***********************************************************************
*
         LI,R1    COC               IS THIS A T/S SYSTEM?
         BEZ      KEYERR            NO
         CI,R8    C','              CHECK SYNTAX
         BNE      KEYERR            ERROR
         BAL,R11  GKIFLD            GET ID/'ALL'
         BCS,8    KEYERR
         LW,R10   KPLB,R7           GET ID/ALL
         LI,R4    0                 INITIALIZE FLAG
         CW,R10   =C'ALL '          WAS IT 'ALL'?
         BNE      KIS1              NO-->BRANCH
         LI,R4    1                 YES --> SET FLAG = 1
*
KIS1     EQU      %
         CI,R8    X'15'             IS DELIMITER A 'CR'
         BE       KISTV1,R4         YES --> BRANCH TO PROPER ROUTINE
         LI,R3    1                 SET TYPE TO ONE
         LI,R6    0                 SET USER # TO ZERO
         BAL,R11  BUILD:PIG:MSG     GO BUILD THE PIGEON MESSAGE
         LI,D3    OPMESS            SET UP TO CHANGE DEFERRED MSG
         LI,R5    79                79 BYTES IN DEFERRED MSG
         B        KISTV2,R4         CONTINUE
*
*
*
KISTV1   EQU      %
         B        KEYINR            IF ID...MERELY EXIT
         B        KINODEF           IF 'ALL'...ZAP OPMESS
*
KISTV2   EQU      %
         B        KEYINR            IF ID...EXIT
         B        KIMVHDR           IF 'ALL'...MOVE MESSAGE TO COCMESS
*
BUILD:PIG:MSG EQU %
*
*        R3 = TYPE
*        R6 = USER #
*        R10 = MSG PREFIX OR 'ALL' OR 'ID'
*
         PUSH     16,R0             SAVE EVERYTHING
*
*        GET MPOOL  USES:  R2, R1  RETURNS WITH MPOOL ADR IN D3
*
         BAL,SR4  GMB               GET MPOOL FOR THE MESSAGE
         BEZ      %-1               LOOP UNTIL  WE GET ONE
         LI,R5    80                MAX TO SEND TO USERS
         LI,R2    1                 START AT THE 1TH BYTE IN BUFFER
         BAL,SR4  MOVE:MSG          MOVE THE MESSAGE
         LI,R2    1                 INDEX OF 1ST BYTE IN MESSAGE
         LI,R1    X'07'             GET A BELL CHARACTER
         STB,R1   *D3,R2            STORE BELL AS FIRST CHAR. SENT
*
*        GET COC BUF  USES:  R1 R2  RETURNS WITH COC BUF ADR IN R2
*
         BAL,R1   ECBGBLK           GET AN ECB BLOCK
         BEZ      %-1               LOOP UNTIL WE GET A COC BUF
         STW,R6   1,R2              STORE AWAY THE USER #
         LI,R1    4                 GET TYPE OF BLOCK INDEX
         STB,R3   *R2,R1            IN THE BUFFER
         STW,R10  2,R2              STORE AWAY THE MSG OR 'ALL'
         STW,D3   3,R2              STORE AWAY THE REAL MSG
*
*        CHAIN BLOCK ON PIGEONS CHAIN
*
         LI,R1    PIGHEAD           GET THE HEAD ADDRESS
         DISABLE                    **  DISABLE  **
KIS5     EQU      %
         LW,R3    0,R1              GET THE FOWARD LINK
         BEZ      KIS10             NON-->BRANCH
         LW,R1    R3                SET UP FOR THE LOOP
         B        KIS5              LOOP UNTIL FIND END OF CHAIN
KIS10    EQU      %
         STW,R2   0,R1              MAKE BLOCK NOW THE LAST ONE
         ENABLE                     **  ENABLE  **
         LD,R0    TPIGEON           GET TEXTC 'PIGEON'
         BAL,R10  T:GJOBSTRT        START IT UP
         PULL     16,R0             RESTORE ALL REGS
         B        *R11              RETURN
*
*
         BOUND    8
TPIGEON  TEXTC    'PIGEON'
         PAGE
KIHEAD   EQU      %
***********************************************************************
*F*      NAME:    KIHEAD
*F*
*F*      PURPOSE: TO PROCESS THE 'HEADING' KEYIN
*F*
*F*      DESCRIPTION:  MOVES THE MESSAGE TEXT TO COCMES FOR SUBSEQUENT
*F*               TRANSMITTAL TO ALL ONLINE USERS BY THE COC ROUTINES IN
*F*               THE TOP OF PAGE HEADING.
************************************************************************
*D*      NAME:    KIHEAD
*D*
*D*      CALL:    KEYIN FORMAT:  HEADING (MESSAGE)
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               COC, KEYINBUF
*D*
*D*      OUTPUT:  COCMESS
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  IF NO MESSAGE WAS PROVIDED, BYTE 0 OF COCMESS
*D*               IS SET TO 0; OTHERWISE, UP TO 55 CHARACTERS OF THE
*D*               MESSAGE ARE MOVED FROM KEYINBUF TO COCMESS WITH BYTE
*D*               0 OF COCMESS SET AS THE BYTE COUNT.
***********************************************************************
*
         LI,R1    COC               IS THIS A T/S SYSTEM?
         BEZ      KEYERR            NO
         CI,R8    X'15'             IS DELIMITER A 'CR'?
         BE       KINOHDR           YES...ZAP COCMESS
         LI,D3    COCMESS           SET UP TO CHANGE HEADING
         LI,R5    55                55 BYTES IN ADM. HEADER
KIMVHDR  EQU      %                 COME HERE FROM 'SEND' KEYIN ALSO
         LI,R2    0                 START AT ZERO'TH BYTE
         BAL,SR4  MOVE:MSG          MOVE IN THE MESSAGE
         B        KEYINR            EXIT
*
*        MOVE:MSG
*
MOVE:MSG EQU      %
         LW,R1    KCCP,R7           GET CURRENT POSITION IN KEYINBUF
MOVE:MSG:10 EQU   %
         LB,R0    KEYINBUF,R1       GET CHARACTER FROM MESSAGE
         CI,R0    X'15'             IS IT 'CR'
         BE       MOVE:MSG:20       CR-->BRANCH
         AI,R2    1                 COUNT UP FOR THE GOOD CHAR
         AI,R1    1                 POINT TO THE NEXT CHAR
         STB,R0   *D3,R2            PUT IT AWAY IN THE BUFFER
         CW,R2    R5                SEE IF AT END OF BUFFER
         BL       MOVE:MSG:10       LOOP UNTIL WE FIND THE END
MOVE:MSG:20 EQU   %
         STB,R2   *D3               MOVE IN THE BYTE COUNT
         CW,R2    R5
         BL       *SR4              RETURN IF IT FITS
         CI,R5    79                DOING OPMESS PART OF !SEND,ALL?
         BE       *SR4              IF SO DON'T COMPLAIN, 'CAUSE WE
*                                   ALREADY DID SO DURING MPOOL PART.
         LCI      0
         PSM,R0   TSTACK            SAVE EVERYTHING
         LI,R1    15                'MESSAGE TRUNCATED' CODE
         LI,R7    0                 NO DCT INDEX
         BAL,R11  OCQUEUE           GRIPE ABOUT THE MESSAGE
         LCI      0
         PLM,R0   TSTACK            RESTORE EVERYTHING
         B        *SR4
*
*
*
*
*
KINOHDR  ;                          DELETE CURRENT MESSAGE
         LI,R0    0
         STB,R0   COCMESS           ZAP BYTE 0
         B        KEYINR
*
*
*
KINODEF  ;
         LI,R0    0
         STB,R0   OPMESS            ZAP DEFERRED MESSAGE
         B        KEYINR
         PAGE
KMCSEND  EQU      %
***********************************************************************
*F*      NAME:    KMCSEND
*F*
*F*      PURPOSE: TO PROCESS THE 'MCSEND' KEYIN
*F*
*F*      DESCRIPTION:  USES NEWQ TO SEND THE MESSAGE TO THE R.A.S.
***********************************************************************
*D*      NAME:    KMCSEND
*D*
*D*      CALL:    KEYIN FORMAT:  MCSEND TEXT
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               KEYINBUF
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  NEWQ
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  AFTER VERIFYING THAT WE ARE RUNNING ON A XEROX-
*D*               560, A CALL TO NEWQ IS MADE TO TRANSMIT THE MESSAGE
*D*               IN KEYINBUF TO THE REMOTE ASSIST STATION.
***********************************************************************
*
         BIF,S7S9 KEYERR
         LI,12    X'FF'             DCT MASK
         AND,12   RAS:DOL           DCTX
         OR,12    =X'1FF0A00'       FC,PRI,NRT
         LI,13    BA(KEYINBUF)      BUF
         AW,13    KCCP,R7           CURRENT POSITION
         LW,R4    KCCP,R7           CURRENT POSITION
KMCSEND1 EQU      %
         LB,R0    KEYINBUF,R4
         CI,R0    X'15'             CR
         BE       KMCSEND2
         AI,R4    1
         B        KMCSEND1
KMCSEND2 EQU      %
         SW,R4    KCCP,R7           MSG SIZE
         AI,4     2
         LW,14    4                 SIZE
         LI,15    0
         LW,R5    KCCP,R7
         AI,R5    -1
         STB,R0   KEYINBUF,R5
         LI,0     0                 NO END ACTION
         BAL,11   NEWQ
         NOP
         B        KEYINR
         PAGE
KSCPU    EQU      %
***********************************************************************
*F*      NAME:    KSCPU
*F*
*F*      PURPOSE: TO PROCESS THE 'SCPU' KEYIN.
*F*
*F*      DESCRIPTION:  IN A MULTI-PROCESSING SYSTEM, A SLAVE CPU IS
*F*               STARTED:  THE STOP-BIT IS RESET AND THE START-BIT SET
*F*               IN SB:INIT; S:MPKYN IS INCREMENTED (RE-ENTRANCY
*F*               COUNTER) AND THE MOOSE IS GOOSED.
***********************************************************************
*D*      NAME:    KSCPU
*D*
*D*      CALL:    KEYIN FORMAT:  SCPU ID
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  SB:INIT, S:MPKYN
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, T:GJOBSTRT
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  IN A MULTI-PROCESSING SYSTEM A SLAVE CPU IS
*D*               STARTED BY SETTING THE START-BIT IN SB:INIT FOR THE
*D*               SPECIFIED CPU AND CALLING T:GJOBSTRT TO INITIATE
*D*               THE MOOSE GHOST JOB.
***********************************************************************
*
         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   EQU      %
         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
KXCPU    EQU      %
***********************************************************************
*F*      NAME:    KXCPU
*F*
*F*      PURPOSE: TO PROCESS THE 'XCPU' KEYIN.
*F*
*F*      DESCRIPTION:  IN A MULTI-PROCESSING SYSTEM, A SLAVE CPU IS
*F*               STOPPED:  THE START-BIT IS RESET AND THE STOP-BIT SET
*F*               IN SB:INIT; S:MPKYN IS INCREMENTED (RE-ENTRANCY
*F*               COUNTER) AND THE MOOSE IS GOOSED.
***********************************************************************
*D*      NAME:    KXCPU
*D*
*D*      CALL:    KEYIN FORMAT:  XCPU ID
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  SB:INIT, S:MPKYN
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, T:GJOBSTRT
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  IN A MULTI-PROCESSING SYSTEM A SLAVE CPU IS
*D*               STOPPED BY SETTING THE STOP-BIT IN
*D*               SB:INIT AND CALLING T:GJOBSTRT TO INITIATE THE MOOSE
*D*               GHOST JOB.
***********************************************************************
*
         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
         LI,0     KEYINR            RETURN ADDRESS
KXCPU2   LW,11    NOBRANCH          GET REFLEXIVE BRANCH
         STW,11   SYSTRT            STORE IN SYSTRT
KXCPU3   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    KXCPU3            DO MORE THAN ONE
         MTW,1    S:MPKYN           SET  RE-ENTRANCY COUNTER
         PUSH     0
         LD,0     TXMOOSE
         BAL,10   T:GJOBSTRT
         PULL     0
         B        *0
         PAGE
KITIME   EQU      %
***********************************************************************
*F*      NAME:    KITIME
*F*
*F*      PURPOSE: TO PROCESS THE 'TIME' AND 'T' KEYINS.
*F*
*F*      DESCRIPTION:  VALIDATES INPUT AND STORES 'HHMM' (IN EBCDIC)
*F*               INTO THE 1-WD LOCATION 'TIME' & UPDATES C:MSM
***********************************************************************
*D*      NAME:    KITIME
*D*
*D*      CALL:    KEYIN FORMAT:  TIME HH:MM
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               1MIN
*D*
*D*      OUTPUT:  TIME, C:MSM
*D*
*D*      DATA:    MAXHRVAL, MAXMINVAL, MSMDAT
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GDTKIVAL
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS GDTKIVAL TO VALIDATE HH & MM INPUT FIELDS;
*D*               THE CELL TIME IS RESET TO THE HHMM VALUES SPECIFIED
*D*               (IN EBCDIC).  THIS VALUE IS THEN USED TO CALCULATE
*D*               THE NEW VALUE FOR C:MSM (2-MS TICS SINCE MIDNIGHT).
************************************************************************
*
         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
         LI,R3    0                 INITIALIZE ACCUMULATOR
         LI,R2    -4                SET UP LOOP
         DISABLE
T1       LB,R0    TIME+1,R2         TIME = 'HHMM'
         AI,R0    -'0'              CONVERT
         AW,R3    R0                ACCUMULATE
         MH,R3    MSMDAT+2,R2       CONVERT TO TICS
         BIR,R2   T1                LOOP
         LI,R5    50                CALCULATE DISPL INTO CURRENT MINUTE
         SW,R5    1MIN              *
         MI,R5    600               CONVERT TO TICS
         AW,R3    R5                ACCUMULATE
         STW,R3   C:MSM             UPDATE TICS SINCE MIDNIGHT
         ENABLE
         B        KEYINR
*
*
*
MSMDAT   GEN,16,16,16,16   10,6,10,30000
         PAGE
KIDATE   EQU      %
***********************************************************************
*F*      NAME:    KIDATE
*F*
*F*      PURPOSE: TO PROCESS THE 'DATE' AND 'D' KEYINS.
*F*
*F*      DESCRIPTION:  VALIDATES INPUT AND STORES 'MMDD' (IN EBCDIC)
*F*               INTO LOCATION DATE, AND '  YY' (IN EBCDIC) INTO
*F*               LOCATION DATE+1.
************************************************************************
*D*      NAME:    KIDATE
*D*
*D*      CALL:    KEYIN FORMAT:  DATA MM/DD/YY
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  DATE
*D*
*D*      DATA:    MAXMONVAL, MAXDAYVAL, MAXYRVAL
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GDTKIVAL
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS GDTKIVAL TO VALIDATE MM, DD, & YY INPUT
*D*               FIELDS; THE DOUBLEWORD CELL DATE IS RESET TO THE
*D*               EBCDIC VALUES SPECIFIED (MMDD  YY)
************************************************************************
*
         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 EQU      %
***********************************************************************
*F*      NAME:    GDTKIVAL
*F*
*F*      PURPOSE: SUBROUTINE TO GET AND VALIDATE DATE/TIME VALUES.
*F*
*F*      DESCRIPTION:  OBTAINS NEXT FIELD FROM KEYINBUF, INSURES THAT
*F*               IT IS A VALID DECIMAL CHARACTER, AND THAT IT IS WITHIN
*F*               A CALLER-SPECIFIED RANGE.
***********************************************************************
*D*      NAME:    GDTKIVAL
*D*
*D*      CALL:    BAL,SR4(R11)
*D*
*D*      INPUT:   R0 = POINTER TO A DOUBLEWORD CONTAINING THE VALID
*D*                    EBCDIC LIMITS.
*D*               R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  R2 = THE NEXT EBCDIC/DECIMAL CHARACTERS FROM KEYINBUF
*D*                    (RIGHT-JUSTIFIED)
*D*
*D*      REGISTERS:  R1 & R3 ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS GKIFLD TO OBTAIN THE NEXT FIELD FROM
*D*               KEYINBUF; CHECKS THE FIRST CHARACTER FOR A VALID
*D*               DECIMAL CHARACTER; IF ONLY 1 CHARACTER WAS SPECIFIED
*D*               A LEADING EBCDIC ZERO IS SUPPLIED; OTHERWISE THE
*D*               SECOND CHARACTER IS CHECKED FOR A VALID DECIMAL
*D*               CHARACTER; AN ERROR OCCURS IF MORE THAN 2 CHARACTERS
*D*               WERE OBTAINED BY GKIFLD.  THE SPECIFIED CHARACTERS ARE
*D*               THEN VALIDATED AGAINST THE CALLED-SUPPLIED LIMITS AND,
*D*               IF OK, THE CHARACTERS ARE RETURNED TO THE CALLER
*D*               (RIGHT-JUSTIFIED).
************************************************************************
*
         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
********************************************************************* *
*                 AVRTBL FLAG-BIT COMBINATIONS                        *
********************************************************************* *
*                 PUB SERIAL NOU AVR ID SOL VER                       *
* PREMOUNT PUBLIC  1    #     1   0  0   0   0                        *
* PREMOUNT         0    #     0   0  -   0   0                        *
* AVAILABLE        0    0     0   0  0   0   0                        *
* SOLICITED        0    #     0   0  #   1   1                        *
* BEING VERIFIED   -    #     0   0  -   0   1                        *
* DISMOUNT(LOCK)   -    #     #   1  -1  0   0                        *
* PRIVATE(EXCL)    0    #     #   1  #   0   0                        *
* SHARE            0    #     #   1  0   0   0                        *
* PUBLIC           1    #    #+1  1  0   0   0                        *
********************************************************************* *
*
KIANSS   EQU      %
***********************************************************************
*F*      NAME:    KIANSS
*F*
*F*      PURPOSE: TO PROCESS THE 'ANSS(CRATCH)' KEYIN.
*F*
*F*      DESCRIPTION:  SETS R9 = Y2 AND CALLS KIMOUNTZ.
***********************************************************************
*
         LW,SR2   Y2                ANS SCRATCH FLAG
         B        KIMOUNTZ
*
*
*
KIANSM   EQU      %                 ANS MOUNT FLAG
***********************************************************************
*F*      NAME:    KIANSM
*F*
*F*      PURPOSE: TO PROCESS THE 'ANSM(OUNT)' KEYIN.
*F*
*F*      DESCRIPTION:  SETS R9 = Y3 AND CALLS KIMOUNTZ.
***********************************************************************
*
         LW,SR2   Y3
         B        KIMOUNTZ
*
*
*
KIANSO   EQU      %                 ANS  OVER FLAG
***********************************************************************
*F*      NAME:    KIANSO
*F*
*F*      PURPOSE: TO PROCESS THE 'OVER' KEYIN.
*F*
*F*      DESCRIPTION:  SETS R9 = Y4 AND CALLS KIMOUNTZ.
***********************************************************************
*
         LW,SR2   Y4
         B        KIMOUNTZ
*
*
*
KIREAD   EQU      %
*************************************************************************
*F*      NAME:    KIREAD
*F*
*F*      PURPOSE: TO PROCESS THE 'READ' KEYIN
*F*
*F*      DESCRIPTION:  SETS R9 TO Y5 AND CALLS KIMOUNTZ.
***********************************************************************
*
         LW,SR2   Y4
         OR,SR2   Y1
         B        KIMOUNTZ
*
*
*
KIMOUNT  EQU      %
***********************************************************************
*F*      NAME:    KIMOUNT
*F*
*F*      PURPOSE: TO PROCESS THE 'MOUNT' KEYIN.
*F*
*F*      DESCRIPTION:  SETS R9 = 0 AND CALLS KIMOUNTZ.
***********************************************************************
*
         LI,SR2   0                 NOT SCRATCH
         B        KIMOUNTZ
*
*
*
KISCRTH  EQU      %
***********************************************************************
*F*      NAME:    KISCRTH
*F*
*F*      PURPOSE: TO PROCESS THE 'SCRATCH' KEYIN.
*F*
*F*      DESCRIPTION:  VALIDATES COMMAND, SETS R9 = Y1 AND FALLS THRU
*F*               TO KIMOUNTZ.
***********************************************************************
*
         LW,R2    KPLB+1,R7
         CW,R2    L('TCH ')         CHECK IF REALLY SCRATCH KEYIN
         BNE      SKEYIN            NO
         LW,SR2   Y1
*        B        KIMOUNTZ          FALL THRU TO KIMOUNTZ
*
*
*
KIMOUNTZ RES      0
***********************************************************************
*F*      NAME:    KIMOUNTZ
*F*
*F*      PURPOSE: COMMON HANDLER FOR THE FOLLOWING KEYINS:
*F*                      ANSS, ANSM, OVER, READ, MOUNT & SCRATCH
*F*
*F*      DESCRIPTION:  PROCESS THE VARIOUS TAPE AND PACK-RELATED KEYINS.
***********************************************************************
*D*      NAME:    KIMOUNTZ
*D*
*D*      ENTRY:   KISCRTH, KIMOUNT, KIANSO, KIANSM, KIANSS
*D*
*D*      CALL:    KEYIN FORMATS:
*D*                                               ID
*D*               MOUNT NDD(.NDD)(,BLP)(,SERIAL#(,PUBLIC))
*D*                                               LOCK
*D*
*D*               SCRATCH NDD(.NDD)(,BLP),SERIAL#
*D*
*D*               ANSMOUNT NDD(.NDD)(,BLP)
*D*
*D*               ANSSCRATCH NDD(.NDD)(,BLP)(,SERIAL#)
*D*
*D*               OVER NDD(,SERIAL#)
*D*               READ NDD(,SERIAL#)
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               SOLICIT, AVRTBL, AVRID, ANSFLGS, ANSPRT, DCT4
*D*               TSERIAL, LSERIAL, RSERIAL, SH:RTOT, SH:ROCU
*D*               SH:RBCU, SH:RGCU
*D*
*D*      OUTPUT:  AVR TABLES SET TO REFLECT PRESENCE OF TAPE OR PACK
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  NDD, SIXPACK, RAT:DCT4, ASPIN, HOWALO, KIREQND6
*D*                  WAKEUP
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  EACH OF THE SPECIFIED ENTRY POINTS SETS A UNIQUE
*D*               FLAG IN SR2(R9) TO INDICATE THE TYPE OF MOUNT KEYIN.
*D*               KIMOUNTZ IS THE COMMON HANDLER FOR THESE KEYINS.
*D*               THROUGHOUT THE MOUNTING PROCESS THE FOLLOWING REGISTER
*D*               CONVENTIONS ARE UTILIZED:
*D*                  R5 (BYTE 0) = 0 OR DCTX OF ORIGINALLY REQUESTED
*D*                                DRIVE IF A UNIT SWITCH WAS INDICATED
*D*                     (BYTE 3) = AVR INDEX OF DRIVE TO BE MOUNTED
*D*                  R10 = POSITIVE VALUE IF WE ARE WORKING WITH A PACK
*D*                        NEGATIVE VALUE IF WE ARE WORKING WITH A TAPE
*D*                  R12/R13(D1/D2) = ORIGINAL CONTENTS OF THE AVRTBL OF
*D*                                   THE DRIVE ACTUALLY BEING MOUNTED
*D*                  R14/R15(D3/D4) = INITIALLY A COPY OF R12/R13
*D*                                   (UNLESS A UNIT SWITCH HAS BEEN
*D*                                   INDICATED IN WHICH CASE R14/R15
*D*                                   ARE THE CONTENTS OF THE ORIGINALLY
*D*                                   REQUESTED DRIVE'S AVRTBL); R14/R15
*D*                                   ARE UPDATED AS THE KEYIN IS PARSED
*D*                                   AND EVENTUALLY BECOME THE NEW
*D*                                   AVRTBL CONTENTS.
*D*               THE 1ST FUNCTION TO BE PERFORMED IS VALIDATION OF THE
*D*               SPECIFIED DEVICE OR DEVICES (NDD FIELDS).  A UNIT
*D*               SWITCH MUST BE FOR A SOLICITED DRIVE AND NOT DURING AN
*D*               'OVER' OR 'READ' KEYIN OR AN ERROR IS RETURNED.
*D*
***********************************************************************
*
         BAL,D4   NDD               CHECK NDD -OK DCTX  IN R2
         LC       DCT3,R2           CHECK DEVICE PARTITIONED
         BCS,2    KEYERR
         LC       DCT24,R2          CHECK DEVICE DOWN
         BCS,4    KEYERR
         LI,6     0                 ID
         LW,10    *%                SET TAPE/PACK FLAG
         CI,5     AVRTBLSIZ         IS IT RIGHT
         BL       %+4               YES
         LW,10    %                 NO, SET POSITIVE
         LC       SR2               NOTHING BUT MOUNT FOR PACKS
         BCS,15   KEYERR
         LC       ANSFLGS,R5        IF RESPONSE TO ERROR MSG,
         BCR,3    %+4               ONLY MOUNT, OVER, READ LEGA
         LC       SR2
         BCS,4    %+2               OVER/READDD
         BCS,15   KEYERR
         CI,SR1   '.'               UNIT SWITCH
         BNE      NOUNTSW           NO
         CW,SR2   Y4                MUST NOT BE OVER KEYIN
         BANZ     KEYERR
         LC       ANSFLGS,R5        NO ERROR RESPONSES
         BCS,3    KEYERR
         MTB,0    SOLICIT,R5        MUST BE SOLICITED
         BEZ      KEYERR
         PUSH     R5                SAVE AVRX
         BAL,D4   NDD               GET 2ND UNIT
         PULL     R3                R3=1ST DCTX
         LD,D1    AVRTBL,R5
         LD,D3    AVRTBL,R3         NEW VALUES, IF NOT MODIFIED
         LH,R6    AVRID,R3
         AI,3     BATAPE            MAKE DCT INDEX
         STB,R3   R5                SET FLAG FOR SRCHAVR
         LW,D4    D2                GET FLAGS
         B        GETAVR1           REENTER LOGIC
NOUNTSW  EQU      %
***********************************************************************
*D*               THE SECOND FUNCTION IS TO CHECK THE LEGALITY OF THE
*D*               KEYIN.  AN 'OVER' OR 'READ' KEYIN IS LEGAL ONLY IF THE
*D*               SYSTEM IS ANS-SEMI-PROTECTED AND THE ERR FLAGS (OF
*D*               ANSFLGS) ARE SET.  'BLP' MAY BE SPECIFIED FOR TAPES
*D*               ONLY IF THE SYSTEM IS ANS-SEMI-PROTECTED.
***********************************************************************
*
         BDR,10   GETAVR            PACK
         CW,SR2   Y4                OVER KEYIN
         BL       GETAVR            NO, NOT READ EITHER
         BG       %+3               READ OK IN ANY SUSTEM
         MTW,0    ANSPRT            MUST BE SEMI-PROTECTIVE MODE
         BG       KEYERR
         LC       ANSFLGS,5         ERROR FLAGS MUST BE SET
         BCR,3    KEYERR
GETAVR   EQU      %
         LD,D1    AVRTBL,5          REEL + 2ND  WD
         LD,D3    D1                SN AND FLAGS
GETAVR1  RES                        ENTRY FOR UNIT SWITCH
***********************************************************************
*D*               GETAVR1 IS THE ENTRY POINT INTO MOUNT-PROCESSING FOR
*D*               THE AVR ROUTINE.
***********************************************************************
         BDR,10   %+7               NO SCRATCH FOR PACK.
         LC       SR2               NO SCRATCH IF NOT MOUNT
         BCS,X'E' %+5                 OR SCRATCH.
*
         AND,D4   =X'EFFFFFFF'      ASSUME SCRATCH.
         CW,SR2   Y1                SCRATCH
         BNE      %+2
         STS,9    D4                SET SCRATCH IF PRESENT
         CW,D2    VERB
         BAZ      CHKSR             NOT VER
         MTB,0    SOLICIT,5         MUST BE SOLICITED
         BEZ      KEYERR
CHKSR    CI,SR1   ','
         BE       CHKSR1
         CW,SR2   Y1                IS THIS A SCRATCH REQUEST
         BE       KEYERR            YES
         CW,SR2   Y4                NO, IS OVER KEYIN
         BNE      REEL#+1           NO
         LC       ANSFLGS,5         YES, IS IT NOT ANS
         BCR,2    KEYERR            WHICH REQUIRES SERIAL NUMMER (YES)
         B        REEL#+1           NO, ISSOK
CHKSR1   ;
         BAL,SR4  GKIFLD
         BCS,8    KEYERR
         BDR,10   MNTSCR            NO BLP FOR PACKS
         LW,R2    KPLB,R7
         CW,R2    BLP
         BE       CHKBLP
NOTBLP   EQU      %
***********************************************************************
*D*               THE KEYIN IS CHECKED FOR A SERIAL NUMBER; SERIAL
*D*               NUMBERS ARE ILLEGAL UNDER THE FOLLOWING CONDITIONS:
*D*                  > ANSMOUNT KEYIN
*D*                  > ANSSCRATCH KEYIN IN A PROTECTED SYSTEM
*D*                  > ANS SERIAL# NOT 6 CHARACTERS; CP-V LABEL >4 CHARS
*D*                  > OVER/READ KEYIN REFERENCING AN ANS VOLUME
*D*               FOR PACKS, THE SPECIFIED SERIAL# IS CHECKED AGAINST
*D*               THE MBS SERIAL# TABLES AND, IF FOUND, ITS DEVICE-TYPE
*D*               IS VALIDATED AGAINST THAT SPECIFIED IN THE KEYIN.
***********************************************************************
*
         CW,SR2   Y2                CHECK TYPE
         BANZ     AMNTSCR           ANS MOUNT/SCRATCH
         BL       MNTSCR            MOUNT/SCRATCH
         LB,R0    ANSFLGS,R5        ANS FLAGS
         AND,R0   X30
         CI,R0    ANSVOL**4         SERIAL # ILLEGAL IF ANS VOL
         BE       KEYERR
         LC       ANSFLGS,R5
         BCR,4    MNTSCR
AMNTSCR  RES
         MTW,-6   KFL,R7            ANS SERIAL# MUST BE 6 CHARS
         BG       KEYERR
         ANLZ,R1  REEL#
         SLS,R1   2                 BYTE ADDRESS
         BAL,SR4  SIXPACK
         LW,D3    R2                HASHED SERIAL #
         B        REEL#+1
MNTSCR   EQU      %
         MTW,-4   KFL,R7            MAX 4 CHARS
         BG       KEYERR
REEL#    EQU      %
         LW,D3    KPLB,R7           REEL  #
         BIR,10   CHKID             NO RES CHK FOR TAPES
         LI,11    CHKID             SET RETURN
REST     LW,1     TSERIAL           IF IN BATCH SNS, MUST BE RIGHT RES.TYPE
         ANLZ,2   DCTX
         LB,4     DCT4,2
REST10   CW,D3    TSERIAL,R1
         BNE      REST20
         LI,3     0                 CHECK THAT ENTRY IS ACTIVE
         LB,3     LSERIAL,3
         BEZ      REST30
         CW,1     3
         BNE      %-3
REST20   BDR,1    REST10
         B        *11
REST30   CB,4     RSERIAL,1
         BE       *11
TYPERR   BAL,1    AVRS+1            TYPE ON OC
         TEXTC    ' WRONG TYPE'
***********************************************************************
*O*      MESSAGE:  YYNDD WRONG TYPE
*O*
*O*      MEANING:  THE SPECIFIED DISK PACK THAT WAS JUST MOUNTED IS OF
*O*               THE WRONG RESOURCE TYPE.
*O*
*O*      ACTION:  MOUNT THE PACK ON A DRIVE OF THE CORRECT RESOURCE
*O*               TYPE AND RE-TRY THE 'MOUNT' KEYIN.
***********************************************************************
*
*
*
CHKBLP   EQU      %
         CW,SR2   Y4                NOT GOOD IF OVER OR READ
         BANZ     KEYERR
         MTW,0    ANSPRT            MUST BE SEMI-PROTECTIVE MODE
         BG       KEYERR
         OR,5     Y008              SET BLP FLAG
         B        CHKSR
         PAGE
CHKID    RES
***********************************************************************
*D*               THE LAST KEYIN FIELD IS CHECKED AND CVSYSID IS CALLED
*D*               TO VALIDATE THE SPECIFIED USER ID OR THE APPROPRIATE
*D*               ROUTINE IS CALLED TO PROCESS THE 'LOCK' OR 'PUBLIC'
*D*               OPTIONS.  THE 'PUBLIC' OPTION IS ILLEGAL UNDER THE
*D*               FOLLOWING CONDITIONS:
*D*                  > THE SPECIFIED UNIT IS NOT A DISK PACK
*D*                  > THE UNIT IS IN EXCL USE
*D*                  > THE UNIT IS ALREADY MARKED 'PUBLIC'
*D*                  > THE SERIAL# IN THE AVRTBL DOESN'T MATCH THAT OF
*D*                    THE KEYIN AND THE DRIVE IS IN USE (AVRNOU>0)
*D*                  > ANOTHER DRIVE WITH THE SAME SERIAL# IS MOUNTED
*D*                    AND IS CURRENTLY IN USE
*D*               TO MAKE THE DRIVE PUBLIC, A USER (BATCH OR ON-LINE) IS
*D*               UNCHARGED FOR THE UNIT (VIA ASPIN AND HOWALO ROUTINES
*D*               IF THE SPECIFIED DRIVE IS CURRENTLY IN USE)
*D*               AND THE DRIVE IS CHARGED TO SH:RGCU.  THE 'PUB' BIT IN
*D*               R15 IS SET, AVRNOU IS INCREMENTED AND CONTROL PASSES
*D*               TO THE FINAL FUNCTION, THAT OF STORING AWAY THE AVRTBL
*D*               INFORMATION (SEE BELOW).  THE 'LOCK' OPTION IS ILLEGAL
*D*               IF THE DRIVE IS CURRENTLY IN EXCLUSIVE USE OR THE
*D*               SERIAL# IN THE EXISTING AVRTBL ENTRY DOES NOT MATCH
*D*               THE KEYIN.  IF THERE ARE NO USERS ASSOCIATED WITH THE
*D*               PACK, KIREQND6 IS CALLED TO DISMOUNT THE DRIVE; OTHER-
*D*               WISE, AVRID IS SET TO -1 TO INDICATE 'LOCKED' TO PRE-
*D*               VENT NEW USERS FROM ACCESSING THE DRIVE (EXCEPTION:
*D*               AVRNOU = 1 IMPLIES THE 'GHOST USER' THAT WAS CHARGED
*D*               FOR THE 'PRIV DRIVE MARKED PUBLIC' IN WHICH CASE THE
*D*               AVRNOU IS SET TO ZERO, THE 'LOCKED' FLAG IN AVRID IS
*D*               ZEROED AND THE RESOURCE IS RETURNED TO THE SYSTEM).
*D*
*************************************************************************
*
         CI,SR1   ','
         BNE      PREMOUNT          NO  ID/PUBLIC
         CW,SR2   Y4                NO ID FOR OVER
         BANZ     KEYERR
         BAL,SR4  GKIFLD
         BCS,8    KEYERR
         BIR,10   CHKID1            NO PUBLIC, LOCK FOR TAPE
         LW,0     KPLB,R7
         CW,0    ='PUBL'
         BE       PUBLK             YES
         CW,0    ='LOCK'
         BE       LOCK
CHKID1   RES
         LW,6     D4
         BAL,11   CVSYSID            ID  TO HEX
         BCS,8    KEYERR
*                      ASSUME VALID  ID
*
         LW,D4    6
         LW,6     R2                ID
*
*
*
PREMOUNT RES      0                 NOT PUBLIC
***********************************************************************
*D*               THE THIRD FUNCTION IS TO CHECK THE AVAILABILITY OF THE
*D*               SPECIFIED DRIVE.  ON ANY MOUNT, A DRIVE IS CONSIDERED
*D*               AVAILABLE IF ALL OF THE AVRTBL FLAG BITS ARE RE-SET
*D*               (IGNORING AVR AND SCR/INIT) AND AVRNOU=0.
*D*
**************************************************************************
*
         LC       ANSFLGS,5         IF ERROR, BUSY IS OK
         BCS,3    %+5
         CW,D2    YC1FF             BUSY
         BANZ     KEYERR
         LH,0     AVRNOU,5          IN USE
         BNEZ     KEYERR
         CW,SR2   Y4                CHECK THAT OVER AND READ
         BAZ      CKSERIAL          ARE BEING USED PROPERLY
         LB,0     ANSFLGS,5
         LI,1     4                 THE READ-ONLY FLAG (SET FOR RING)
         SLD,0    26                POSITION TO Y1
         CS,0     SR2
         BNE      KEYERR            DONT MATCH
         B        NOIDPUB
CKSERIAL CW,D3    D1
         BNE      %+3               DIFFERENT, MUST SEARCH
         MTB,0    5                 TEST UNIT SWITCH
         BE       NOIDPUB
         AND,D4   X1000FFFF         REMOVE FLAG BITS EXCEPT SCRATCH
         B        SRCHAVR           PREMOUNT
         PAGE
PUBLK    RES
         LI,1     MBSOP#+LPART      CHECK AGAINST RUNNING EXCL'S
SEP10    LB,2     PLB:MIN,1         HEAD OF EXCL CHAIN
         BEZ      SEP20
         CW,14    TSERIAL,2
         BE       KEYERR            NO CAN DO
         LB,2     LSERIAL,2
         BNEZ     %-3
SEP20    AI,1     -SV:RSIZ          TO NEXT ENTRY
         BDR,1    SEP10
         ANLZ,2   DCTX              GET DCTX
         BAL,11   RAT:DCT4          GET RES TYPE
         AI,D2    0
         BLZ      KEYERR            PUBLIC ALREADY
         LH,0     AVRNOU,5          IS IT IN USE
         BNEZ     ISPS              YES, MUST BE SAME SN
         LI,4     AVRTBLNE
ISPS5    AI,4     -1
         CI,4     AVRTBLSIZ
         BL       ISPS3
ISPS2    CLM,D3   AVRTBL,4          IS THERE OTHER DRIVE W. SAME SN
         BNE      ISPS5
         LH,R2    AVRNOU,4          IF IN USE
         BNEZ     AVRS              GIVE NOT UNIQUE MSG
         LB,0     SOLICIT,4         SAVE WHETHER SOLICITED
         CW,4     5                 OF EITHER IF BOTH THE SAME OR NOT
         BE       ISPS5             KEEP LOOKING IF SAME
ISPS3    AI,0     0                 MUST HAVE RESOURCE FOR UNSOLICITED MOUNT
         BNEZ     ISPS0
*        IF SOLICITED, USER WILL GIVE BACK ONE WHEN HE WAKES UP
         LH,0     SH:RTOT,1         CHECK THAT IT IS POSSIBLE
         SH,0     SH:ROCU,1
         SH,0     SH:RBCU,1
         SH,0     SH:RGCU,1
         BLEZ     KEYERR
         B        ISPS0
DCTX     LW,0     BATAPE,5          FOR LW,2 5 .. AI,2 BATAPE
ISPS     CW,D1    D3
         BNE      KEYERR
         PUSH     2,14
         LI,14    0                 RESET
         BAL,11   ASPIN             0=BIT,4=SPINX
         BAL,11   HOWALO            LOADS 0 WITH WHO,CLEARS SPIN
         PULL     2,14
         MTH,0    AVRNOU,5          GHOST OR PREMOUNT
         BEZ      %+2               PREMOUNT
         MTH,-1   *0,1              UNCHARGE IT
ISPS0    MTH,1    SH:RGCU,1         CHARGE IT TO GHOST
         OR,D4    Y8                SET PUBLIC BIT
         MTH,1    AVRNOU,5          INCREMENT USERS
         CI,4     AVRTBLSIZ         IF THERE IS ANOTHER,
         BGE      CHK1              SWITCH THEM
         B        SETNEW            ELSE GO STORE IN TABLES
         PAGE
NOIDPUB  LH,6     AVRID,5
         CI,D1    -1                LOOK AT ORIGINAL SN.
         BAZ      ZEROSN
         BNE      SETNEW            OK IF SOMETHING THERE.
*
         LB,SR4   ANSFLGS,R5        SCRATCH SN (-1) OK IF
         AI,SR4   -X'41'              ANS DCB AND SCRATCH.
         CI,SR4   X'41'
         BANZ     KEYERR
*
ZEROSN   CW,SR2   Y4                ZERO OR SCRATCH SN OK IF
         BE       %+3                 OVER OR
         CW,SR2   Y2                  ANS TYPE MOUNT.
         BAZ      KEYERR
*
         MTB,0    SOLICIT,R5        FINALLY, PREVIOUS CONDITIONS
         BNEZ     SETNEW              OK ONLY IF SOLICITED.
         B        KEYERR
         PAGE
LOCK     RES      0
         LI,0     -1                CHECK AVRID
         CH,0     AVRID,5
         BE       %+2               ALREADY LOCKED, CHECK FOR DISMOUNT
         BANZ     KEYERR            EXCLUSIVE
         CW,D1    D3                MUST BE SAME SN
         BNE      KEYERR
         ANLZ,R2  DCTX              GET DCTX FOR REQU
         LH,12    AVRNOU,5
         BEZ      KIREQND6
         BAL,11   REST              IS IT NEEDED FOR RUNNING BATCH
         AI,1     0
         BNEZ     KEYERR            YES.
         BDR,12   %+2               >1 JUST SET AVRID
         BIR,D2   KIREQND6          1 AND PUBLIC, REQU
         STH,0    AVRID,5           SET LOCKED
         B        KEYINR
         PAGE
**********************************************************************
*D*               THE FOURTH (& FINAL) FUNCTION IS TO STORE AWAY R14/R15
*D*               INTO THE APPROPRIATE AVRTBL ENTRY TO REFLECT THE
*D*               KEYIN.  TWO ROUTINES ARE USED:  SRCHAVR LOOKS FOR A
*D*               MATCHING    AVRTBL ENTRY WHEN THE SERIAL# SPECIFIED IN
*D*               THE KEYIN (REPRESENTED IN R14) DOES NOT MATCH THAT
*D*               ALREADY IN THE AVR TABLE (REPRESENTED IN R12).  THIS
*D*               OCCURS WHEN A UNIT SWITCH IS EMPLOYED, WHEN A USER
*D*               HAS REQUESTED THIS SERIAL# ON A DIFFERENT DRIVE, OR IF
*D*               THE SERIAL# WAS PREVIOUSLY MOUNTED ON A DIFFERENT
*D*               DRIVE.  IF A MATCH IS FOUND, AND DOES NOT CHANGE TAPE
*D*               RESOURCE-TYPE OR CAUSE CONFUSION BY BEING IN USE, ITS
*D*               USER IS AWAKENED, THE ANS FILENAME IS MOVED TO THE
*D*               NEW ENTRY AND THE OLD ENTRY IS CLEARED.  SETNEW STORES
*D*               AWAY R14/R15 INTO AVRTBL, ZEROES SOLICIT, WAKES UP THE
*D*               USER ASSOCIATED WITH THE AVR ENTRY (AVRID) IF
*D*               APPROPRIATE, RESETS ALL ANSFLGS EXCEPT 'BLP' AND
*D*               'MS' (IF TAPE MOUNT) AND SETS THE 'AK' BIT (IF AN ANS
*D*               KEYIN  .
***********************************************************************
*
SRCHAVR  RES                        SEARCH AVRTBL FOR MATCH
         ANLZ,4   DCTX              GET DEVICE TYPE
         LB,2     DCT4,4            FOR TAPES
         LB,4     5                 IF SWITCH, WE KNOW WHERE IT GOES
         BGZ      CHK0
         LW,D1    D3
         CW,D4    Y1
         BAZ      %+2               NOT SCRATCH
         LI,D1    -1                SEACRCH FOR -1
         LI,4     BATAPE            START DCTX FOR TAPE
         LI,D2    AVRTBLSIZ         #ENTRIES
         BIR,10   CHK               TAPE
         AI,4     AVRTBLSIZ         PACK START
         LI,D2    AVRTBLNE-AVRTBLSIZ #ENTRIES
CHK      CLM,D1   AVRTBL-BATAPE-BATAPE,4 TEST SN
         BE       CHK0
         AI,4     1                 NO TRY NEXT
         BDR,D2   CHK
         B        SETNEW            NOT THERE, JUST PUT IN THIS ONE
CHK0     RES
         BDR,10   %+3               RESOURCE SWITCH O.K. FOR PACKS
         CB,2     DCT4,4
         BNE      TYPERR
         AI,4     -BATAPE
         LD,R2    AVRTBL,4
         CW,3     YC1FF             BUSY
         BANZ     %+3               COULD BE A PROBLEM
         MTH,0    AVRNOU,4
         BEZ      CHK1              ALL IS O.K.
         BDR,10   AVRS              ONLY ONE PACK PER SN
         AI,6     0                 OR UNATTACHED TAPE
         BEZ      AVRS
         AI,4     BATAPE
         B        CHK+2
CHK1     RES
         BAL,11   WAKEUP
         LD,12    AVRTBL,4
         INT,13   13     KILL PUB,SCR ETC. , PRESERVE HGP
         LI,12    0
         STD,D1   AVRTBL,4
         LH,R1    AVRID,R4          SAVE USER ID
         STH,D1   AVRID,4
         LB,R2    SOLICIT,R4        SAVE SOLICIT BYTE
         STB,D1   SOLICIT,4
         XW,R6    R1                USER ID
         BAL,R11  CHK:FOR:MSG       SEE IF NEED TO SEND ANYTHING TO PIGEON
         LW,R6    R1                RESTORE USER ID
         BDR,10   SETNEW            DONE IF PACK
         LB,2     ANSFLGS,4         MOVE ANSFLGS
         STB,D1   ANSFLGS,4         MOVE ANSFN FOR TAPES
         STB,2    ANSFLGS,5
         LD,2     4
         AD,2     2
         AD,2     4
         AD,2     2                 MULTIPLY BY 6
         AI,2     AVRFNMT+6         POINT TO END OF ENTRY
         AI,3     AVRFNMT+6
         LI,4     -6
         LI,D1    0
         XW,D1    *2,4
         STW,D1   *3,4
         BIR,4    %-3
SETNEW   LI,D2    0
         LB,R2    SOLICIT,R5        SAVE THE SOLICIT FLAG
         STB,D2   SOLICIT,5
         STD,D3   AVRTBL,5          SET ENTRY
         LW,4     5                 SET FOR WAKEUP
         BAL,11   WAKEUP
         STH,6    AVRID,5           SET ID
         BAL,R11  CHK:FOR:MSG       SEE IF NEED TO SEND TO PIGEON
         BDR,10   KEYINR            DONE IF PACK
         LB,D1    ANSFLGS,5         SET PROPER ANS FLGS IF TAPE
         LB,4     9                 GET THE PROPER MASK
         SLS,4    -4
         LB,4     AVRFLGMSK,4
         CW,5     Y008              IS BLP TO BE SET
         BAZ      %+2
         OR,D1    X2
         OR,D1    X8                SET ANSSCRATCH KEYN FLG
         AND,D1   4                 TO BE ANDED OFF IF NOT TRUE
         STB,D1   ANSFLGS,5
         B        KEYINR
CHK:FOR:MSG EQU   %
         CI,R2    2                 SEE IF CNTRL Y WAS ON
         BNE      *R11              NO-->BRANCH
         PUSH     2,R10             SAVE 10 AND 11
         LI,R3    0                 SET KEYN BUFFER INDEX TO 0
         STW,R3   KCCP,R7           SO WE GET FULL MESSAGE
         LI,R3    5                 SET TYPE TO 5
         LW,R10   TEXTC:O           LOAD 'O: '
         BAL,R11  BUILD:PIG:MSG     BUILD THE PIGEON MSG
         PULL     2,R10             RESTORE 10 AND 11
         B        *R11              RETURN
*
TEXTC:O  TEXTC    'O: '
*
AVRFLGMSK DATA,1  X'F3',X'F3',X'FB',X'F3',X'C3',X'C7',0,0
*
*
AVRS     LI,1     NOTUNIQUE
         ANLZ,7   DCTX              GET DCTX
         LI,11    KEYINR            TYPE ON OC
         B        OCQUEUE           LIKE SYMBIONT MESSAGE
*
NOTUNIQUE TEXTC ' NOT UNIQUE'
***********************************************************************
*O*      MESSAGE:  YYNDD NOT UNIQUE
*O*
*O*      MEANING:  SERIAL NUMBER CONFLICT HAS OCCURRED; ONLY ONE DISK
*O*               PACK WITH A GIVEN SERIAL # MAY BE ACTIVE AT ANY POINT
*O*               IN TIME; ONLY ONE PRE-MOUNTED TAPE OF A GIVEN SERIAL
*O*               # MAY BE MOUNTED AT ANY POINT IN TIME.
*O*
*O*      ACTION:  DISPLAY VOLUME SERIAL NUMBERS AND GO FROM THERE.
***********************************************************************
         PAGE
AVR      RES
***********************************************************************
*F*      NAME:    AVR
*F*
*F*      PURPOSE: AUTOMATIC VOLUME SERIAL NUMBER RECOGNITION FOR
*F*               TAPES AND PRIVATE PACKS.
*F*
*F*      DESCRIPTION: READS LABEL FROM DEVICE, DETERMINES WHETHER ANS OR
*F*               XEROX OR PACK, AND TRUNDLES INTO MOUNT LOGIC AS IF
*F*               A MOUNT NDD,SN OR ANSMOUNT NDD,SNNNNN HAD BEEN KEYINED.
***********************************************************************
*D*      NAME:    AVR
*D*      REGISTERS: ALL VOLATILE
*D*      CALL:    KEYIN BRANCHES TO AVR, WHICH RETURNS TO KEYINR.
*D*      INTERFACE: NEWQ
*,*      INPUT    R7=DCTX OF DRIVE TO USE
*,*      OUTPUT   AVR TABLES SET TO REFLECT PRESENCE OF TAPE OR PACK.
*,*      DESCRIPTION AVR ENTRY IS CHECKED TO ASSURE OPERATION WILL NOT
*D*               DISTURB THE WRONG DRIVE. IF DRIVE IS A PACK, THE VTOC
*D*               IS READ AND IF VALID, THE SN IS USED.  IF TAPE, THE
*,*               TAPE IS REWOUND. THE FIRST RECORD IS READ AND CHECKED
*,*               FOR 'VOL1' IN EBCDIC OR ASCII. IF ASCII THE TAPE IS
*,*               REWOUND AGAIN, ASCII MODE SET AND THE PROCESS REPEATED.
*,*               IF NOT 'VOL1', A SPACE FILE FORWARD, SPACE FILE BACK,
*,*               BACK 2 RECORDS, AND READ ONE RECORD SEQUENCE IS DONE
*,*               TO ATTEMPT TO READ THE :LBL RECORD. IF NOT FOUND,
*,*               THE TAPE IS REJECTED WITH AN 'AVR ERR' MESSAGE.
*,*               THIS MESSAGE IS ALSO OUTPUT IF THERE IS AN I/O ERROR OR
*,*               IF THE RECORD READ IS LESS THAN 12 BYTES.
*,*               IF ANS, THE AVR ENTRY IS CHECKED TO ASSURE THAT IT
*,*               DOES NOT ALREADY BELONG TO SOMEONE ELSE, WAKING THAT
*,*               USER IF SO. THE LABELS ARE THEN EXAMINED AND THE AVR
*,*               TABLES SET WITH ALL PERTINENT DATA. THE ASSOCIATED USER,
*,*               IF ANY, IS THEN WOKE IF ASLEEP, AND THE ROUTINE EXITS.
*,*               FOR XEROX LABELS, THE SRCHAVR ROUTINE IS USED TO
*,*               LOCATE THE TAPE OR ANY DUPLICATES THEREOF AND PROCESS
*,*               THE TAPE IN A MANNER ANALOGOUS TO ANS, ABOVE.
***********************************************************************
*
         LW,R5    R7
         AI,R5    -BATAPE           AVRX
         BLZ      AVRBZERR
         MTB,0    SOLICIT,R5        AVR SOLICITED
         BNEZ     AVR1
         LD,D3    AVRTBL,R5
         CW,D4    YC1FF
         BANZ     AVRBZERR          BUSY-IGNORE
         LH,D4    AVRNOU,R5
         BNEZ     AVRBZERR          BUSY ALSO
AVR1     EQU      %
         LW,SR3   %                 SET PACK FLAG
         OR,R7    XFF0A00
         CI,R5    AVRTBLSIZ         IF PACK, JUST READ VTOC
         BGE      RD:LBL
         LW,SR3   *%                SET TAPE FLAG
         LI,R0    0
         STB,0    AVRFLGS,5         INITIALIZE AVRFLGS
REAVR    EQU      %
         LW,R12   Y08               REWIND
         BAL,SR1  POSTAPE
         BAL,SR4  GETFLG1
         BCR,4    NOCC              NO CODE CONVERSION ON DRIVE
*                     SET CODE CONVERSION MODE
         LW,R12   MCFC
         LW,R15   Y08               EBCDIC
         LC       AVRFLGS,R5
         BAZ      %+2
         LW,R15   Y1                ASCII
         BAL,SR1  POSTAPE1
NOCC     EQU      %
         LI,R12   0                 READ TAPE
         LI,R14   10                COUNT
         BAL,SR1  READTAPE
         LW,12    J:BASE            SENTINEL TYPE
         CW,12    VOL1              ANS TAPE
         BNE      NOTVOL1           NOT ANS
         LI,R1    BA(J:BASE)+4
         BAL,SR4  SIXPACK
         LW,SR2   Y3                ANSMOUNT FLAG
         LW,D3    R2
         LI,SR4   X'80'             SET ANSTAPE FLAG
         STB,SR4  ANSFLGS,R5
         B        DOSRCH
NOTVOL1  EQU      %
         CW,12    ASCVOL1
         BNE      CHK:LBL           NOT ANS-CHECK XEROX LABEL
         BAL,SR4  GETFLG1
         BAZ      CCERR             ASCII TAPE ON NON-ASCII DRIVE
         LB,14    AVRFLGS,R5
         AI,14    X'40'             SET ASCII
         STB,R14  AVRFLGS,R5
         B        REAVR
CHK:LBL  RES      0
         LW,R12   S:OPTION          PATCHABLE OPTIONS
         CI,R12   X'4'              'FAST AVR' BIT SET?
         BANZ     COMP:LBL          IF SO SKIP TAPE MOVES
         LW,R12   Y07               POSITION THE TAPE FORWARD
         BAL,SR1  POSTAPE            OVER A TAPE MARK, THEN
         LW,R12   Y06                 BACKWARD OVER THE MARK, THEN
         BAL,SR1  POSTAPE              BACK OVER THE ASSUMED
         LW,R12   Y04                   :ACN SENTINAL AND THE
         BAL,SR1  POSTAPE                :LBL SENTINAL.
         LW,R12   Y04
         BAL,SR1  POSTAPE
*
*        TAPE IS NOW POSITIONED JUST BEFORE THE :LBL
*        IF IT IS A XEROX LABELED TAPE
*
RD:LBL   LI,12    0
         LI,14    12                BYTES IN :LBL SENTINAL
         LI,15    0                 SEEK ADDRESS
         BAL,SR1  READTAPE
         CW,R0    M16               LOST DATA?
         BANZ     AVRLBERR          YEP, NOT :LBL SENTINAL
COMP:LBL RES      0                 COME HERE FOR FAST AVR
         LW,12    J:BASE            OK, PICK UP WHAT WE READ
         CW,12    :LBL              GOT WHAT WE WANTED?
         BNE      AVRLBERR          NOT LABELED
         LW,D3    J:BASE+1          FETCH SN
         LI,SR2   0                 MOUN KEYIN
DOSRCH   STW,D3   J:BASE+6          SAVE SN
         LW,SR1   MSGT
         LC       SR2               MAKE MESSAGE
         BCR,15   %+2
         MTB,2    SR1               ANSSN 6 BYTES
         STW,SR1  J:BASE
         LI,1     J:BASE
         BAL,11   OCQUEUE
         LW,D3    J:BASE+6          RESTORE SN
         LI,R6    0                 NO ID
         LD,D1    AVRTBL,R5         OLD AVRTBL
         LW,D4    D2                FLAGS
         PSW,SR3  TSTACK
         LB,SR3   J:BASE
         LI,SR4   BA(KEYINBUF+2)
         STB,SR3  SR4
         LI,SR3   BA(J:BASE)+1      POINT TO REEL ID
         MBS,SR3  0                 MOVE ', #NNNNNN' TO KEYINBUF
         AND,R7   XFF
         LD,SR3   DCT16,R7          GET '>TAB<  YYNDD'
         LCI      2
         STM,SR3  KEYINBUF          STORE '>TAB<  YYNDD' IN KEYINBUF
         LI,SR3   ' '
         STB,SR3  KEYINBUF          WIPE OUT >TAB<
         LB,R7    J:BASE
         AI,R7    8                 FIX UP BYTE COUNT
         LI,SR3   X'15'             GET A N/L CHARACTER
         STB,SR3  KEYINBUF,R7       PUT IT AFTER THE TEXT
         AI,R7    1                 BUMP PAST IT
         STW,R7   J:BASE            AND SAVE IT WHERE WE CAN FIND IT
         LI,R7    J:BASE-1          FAKE OUT MOVE:MSG A LITTLE
         PLW,SR3  TSTACK            GET DISK/TAPE FLAG BACK
         B        GETAVR1           TRUNDLE INTO MOUNT LOGIC
MSGT     GEN,8,24 7,', #'
         PAGE
GETFLG1  EQU      %
***********************************************************************
*D*      NAME:    GETFLG1
*,*      DESCRIPTION SETS THE CONDITION CODES FROM THE TB:FLGS1 ENTRY
*,*               FOR THE TAPE DRIVE WHOSE AVRX IS IN R5.
***********************************************************************
         ANLZ,R1  DCTX              COMPUTE DCT INDEX
         LB,1     DCT4,1
         LC       TB:FLGS1,1
         B        *SR4
         PAGE
***********************************************************************
*O*      MESSAGE: YYNDD AVR I/O ERROR
*O*      MEANING: I/O ERROR OCCURRED TRYING TO READ THE LABEL
*O*      ACTION:  TRY A DIFFERENT DRIVE OR GIVE UP.
***********************************************************************
AVRIOERR BAL,1    AVRS+1
         TEXTC    ' AVR I/O ERROR'
***********************************************************************
*O*      MESSAGE: YYNDD UNLABELED TAPE
*O*      MEANING: NO RECOGNIZABLE LABEL COULD BE FOUND
*O*      ACTION:  USE MOUNT KEYIN OR GIVE UP
***********************************************************************
AVRLBERR CI,R5    AVRTBLSIZ         IS IT A DISK PACK?
         BGE      AVRPAKERR         IF SO THE VTOC ISN'T GOOD
         LW,R12   Y08               'REWIND' CODE
         BAL,SR1  POSTAPE           REWIND THE UNLABELED TAPE
         BAL,R1   AVRS+1            REPORT TO OPERATOR
         TEXTC    ' UNLABELED TAPE'
         SPACE    2
**********************************************************************
*O*      MESSAGE: YYNDD VTOC LABEL BAD
*O*      MEANING: PACK'S VTOC LABEL IS INVALID
*O*      ACTION:  TRY TO MOUNT THE PACK WITH THE !MOUNT COMMAND.
*0*               IF THAT FAILS, THE PACK'S VTOC HAS BEEN
*O*               DESTROYED, AND THE PACK WILL HAVE TO BE
*O*               RE-INITIALIZED WITH VOLINIT.
**********************************************************************
AVRPAKERR BAL,R1  AVRS+1
         TEXTC    ' VTOC LABEL BAD'
***********************************************************************
*O*      MESSAGE: YYNDD AVR DRIVE BUSY
*O*      MEANING: DRIVE IS NOT TAPE OR PACK OR IS IN USE ALREADY.
*O*      ACTION:  REQUEST DRIVE AND TRY AGAIN OR GIVE UP
***********************************************************************
AVRBZERR BAL,1    AVRS+1
         TEXTC    ' AVR DRIVE BUSY'
         PAGE
POSTAPE  EQU      %
***********************************************************************
*D*      NAME:    POSTAPE
*,*      ENTRY:   POSTAPE1, READTAPE
*,*      DESCRIPTION ROUTINE SETS UP AND PERFORMS TAPE I/O OPERATIONS
*,*               VIA NEWQ. POSTAPE ENTRY FORCES 1 RECORD, SIZE 0,
*,*               POSTAPE1 FORCES SIZE ZERO, READTAPE FORCES NEITHER.
***********************************************************************
         LI,R15   0                 #RECORDS
POSTAPE1 EQU      %
         LI,R14   0                 -,SIZE
READTAPE EQU      %
*                                   STATUS WILL BE PUT IN J:BASE
         LW,R1    S:CUN             FIND IT PHYSICALLY
         LOAD,R1  UX:JIT,R1
         SLS,R1   9
         AI,1     J:BASE-J:JIT+4
         LI,13    BA(J:BASE)        BUFFER ADDRESS
         OR,R12   R7
         LI,0     KEYINEA           END ACTION CODE IN IORT
         BAL,SR4  NEWQ
         B        DEVICEDOWN
         LW,R0    J:BASE+4          GET END ACTION INFO
         CW,R0    Y08               I/O ERROR?
         BGE      AVRIOERR          YEP
         B        *SR1
*
         PAGE
CCERR    EQU      %
***********************************************************************
*O*      MESSAGE: YYNDD ASCII TAPE
*O*      ACTION   REMOUNT ON DRIVE WITH ASCII OPTION, OR ABORT JOB
*,*      MEANING  TAPE IS IN ASCII CODE AND CAN BE READ ONLY ON NS TAPE
*,*               DRIVES WITH THE CODE CONVERSION OPTION.
***********************************************************************
         BAL,1    AVRS+1
         TEXTC    ' ASCII TAPE'
DEVICEDOWN EQU    %
***********************************************************************
*O*      MESSAGE: YYNDD DEVICE DOWN
*,*      ACTION   USE ANOTHER DRIVE
*,*      MEANING  DEVICE CURRENTLY PARTITIONED OUT OF SYSTEM
***********************************************************************
         BAL,1    AVRS+1
         TEXTC    ' DEVICE DOWN'
         SPACE    3
*
MCFC     GEN,8,24 FCMC,0
ASCVOL1   DATA    X'564F4C31'       ASCII VOL1
VOL1     TEXT     'VOL1'
:LBL     TEXT     ':LBL'
XFF0A00  DATA     X'FF0A00'
X88      DATA     X'88'
         PAGE
KIREQ    RES      0                 REQUEST KEYIN
***********************************************************************
*F*      NAME:    KIREQ
*F*
*F*      PURPOSE: TO PROCESS THE 'REQUEST RT' (RESOURCE-TYPE) FORM OF
*F*               THE 'REQUEST' KEYIN.
*F*
*F*      DESCRIPTION:  SCANS THE AVR TABLES FOR AN AVAILABLE RESOURCE
*F*               OF THE TYPE SPECIFIED; THE OPERATOR IS THEN NOTIFIED
*F*               OF ITS AVAILABILITY OR OF THE NEED TO DISMOUNT A
*F*               VOLUME.
***********************************************************************
*D*      NAME:    KIREQ
*D*
*D*      ENTRY:   KIREQNDD
*D*                                      --           --
*D*      CALL:    KEYIN FORMAT:  REQUEST |RESOURCE-TYPE|
*D*                                      |NDD          |
*D*                                      --           --
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               SH:RNM, SB:RTY, TB:FLGS, DCT4
*D*
*D*      INTERFACE:  GKIFLD, CKFREE, QUEUE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  GKIFLD IS CALLED TO OBTAIN THE RESOURCE-TYPE
*D*               OR DEVICE ADDRESS.  IF A 2-CHARACTER OPTION IS
*D*               PRESENT, IT IS ASSUMED TO BE A RESOURCE-TYPE AND
*D*               SH:RNM IS SEARCHED FOR A MATCH.  SB:RTY IS THEN
*D*               PICKED UP AND DCT4 IS SCANNED FOR A DEVICE-TYPE
*D*               MATCH.  FOR EACH MATCH, CKFREE IS CALLED TO
*D*               DETERMINE IF THE DEVICE IS AVAILABLE.  IF A DEVICE
*D*               ADDRESS WAS SPECIFIED, DEVCK IS CALLED TO OBTAIN THE
*D*               DCT INDEX OF THE DEVICE, TB:FLGS IS CHECKED TO INSURE
*D*               THAT THE DEVICE IS A TAPE OR PACK, AND CKFREE IS
*D*               CALLED TO DETERMINE IF THE DEVICE IS AVAILABLE.  WHEN
*D*               THE SPECIFIED DEVICE OR A DEVICE OF THE SAME RESOURCE
*D*               TYPE SPECIFIED IS FOUND TO BE AVAILABLE, AN
*D*               APPROPRIATE MESSAGE IS SENT TO THE OPERATOR:
*D*                    NDD       (IF THE DEVICE IS READY)
*D*                    NDD DISMOUNT SCRATCH REEL #
*D*                    NDD DISMOUNT AND SAVE REEL #
*D*               OTHERWISE THE OPERATOR IS TOLD TO TRY 'LATER'.
************************************************************************
*
         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    X'B'
         CI,D3    'DP'
         BE       REQTY
         MTH,-1   D3                GETSIGN EXTENDED...
         LI,R2    SV:RSIZ
         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
KIREQNDD RES      0
***********************************************************************
*F*      NAME:    KIREQNDD
*F*
*F*      PURPOSE: TO PROCESS THE 'REQUEST NDD' FORM OF THE 'REQUEST'
*F*               KEYIN.
*F*
*F*      DESCRIPTION:  THE DEVICE ADDRESS IS VALIDATED AND THE
*F*               APPROPRIATE AVR TABLE ENTRIES ARE CHECKED TO SEE IF
*F*               THE DEVICE IS AVAILABLE; THE OPER. IS THEN NOTIFIED
*F*               APPROPRIATELY.
************************************************************************
*
         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
***********************************************************************
*O*      MESSAGE: NDD
*O*
*O*      MEANING: THE REQUESTED UNIT IS EMPTY
*O*
*O*      ACTION:  NONE
*O*********************************************************************
*O*      MESSAGE: NDD DISMOUNT SCRATCH REEL #
*O*
*O*      MEANING: THE SCRATCH TAPE ON TAPE DRIVE 'NDD' IS NO LONGER
*O*               NEEDED.
*O*
*O*      ACTION:  DISMOUNT TAPE SPECIFIED BY 'REEL #' IF THE TAPE DRIVE
*O*               IS NEEDED.
*O*********************************************************************
*O*      MESSAGE: NDD DISMOUNT AND SAVE REEL #
*O*
*O*      MEANING: THE TAPE ON TAPE DRIVE 'NDD' IS NO LONGER NEEDED.
*O*
*O*      ACTION:  DISMOUNT TAPE SPECIFIED BY 'REEL #' AND SAVE.
***********************************************************************
         B        KEYINR            EXIT
         PAGE
CKFREE   EQU      %
***********************************************************************
*F*      NAME:    CKFREE
*F*
*F*      PURPOSE: SUBROUTINE TO DETERMINE IF A SPECIFIED TAPE OR PACK
*F*               IS FREE.
*F*
*F*      DESCRIPTION:  SEE 'D' REPORT
***********************************************************************
*D*      NAME:    CKFREE
*D*
*D*      CALL:    BAL,R5            (SEE DESCRIPTION BELOW)
*D*
*D*      INPUT:   R2 = X-BATAPE-AVRTBLNE
*D*                    (WHERE X = DCTX OF DEVICE TO BE CHECKED)
*D*               AVRTBL, AVRNOU, AVRID
*D*
*D*      OUTPUT:  ANSFLGS, AVRFNMT
*D*
*D*      REGISTERS:  ONLY R2 AND R3 ARE PRESERVED
*D*
*D*      INTERFACE:  RAT:DCT4, GMB
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  THE AVR TABLES (AVRTBL, AVRNOU, AVRID) ARE
*D*               SCANNED TO DETERMINE IF THE SPECIFIED DEVICE IS IN
*D*               USE.  IF IN USE, RETURN IS MADE TO BAL+1; IF NOT IN
*D*               USE, MISCELLANEOUS AVR TABLES ARE ZEROED (ANSFLGS,
*D*               AVRFNMT), GMB IS CALLED TO OBTAIN A BUFFER, AN
*D*               APPROPRIATE MESSAGE IS FORMATTED AND CKFREE EXITS TO
*D*               KIRQUE (IN KIREQNDD) TO ISSUE THE MESSAGE.
***********************************************************************
*
         LI,D3    0
         LI,D4    0
         AI,R2    BATAPE+AVRTBLNE   GET DCT INDEX
         LC       DCT3,R2
         BCS,2    CKFDOWN           CHECK DEVICE PARTITIONED
         LC       DCT24,R2
         BCS,4    CKFDOWN
         AI,R2    -(BATAPE+AVRTBLNE) RESTORE INDEX
         WD,0     X'37'             D
         LD,D1     AVRTBL+AVRTBLNE+AVRTBLNE,2
         AI,2     AVRTBLNE          ADJUST OFFSET
         CI,2     AVRTBLSIZ         TAPE
         BGE      CKF7              NO
         CW,D2    YC1FF             ANY FLAGS SET?
         BANZ     CKF6              IF SO IT'S BUSY
         MTB,0    SOLICIT,2         IS IT BEING SOLICITED?
         BNEZ     CKF6              IF SO, CAN'T REQUEST IT.
         MTH,0    AVRNOU,2          ANY USERS?
         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
         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
CKFDOWN  AI,R2    -(BATAPE+AVRTBLNE) RESTORE INDEX
         B        0,R5
KIREQ111 DATA     X'15054040'
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'FFC70000'       CONVERT DEV ADD. TO TEXT
*
*
*
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
         AI,2     AVRTBLNE
         LI,6     0
         STH,6    AVRID,2
         WD,0      X'27'
         AI,2     BATAPE
         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
         AW,D4    KIREQDD-KIREQ111-20,R1 ADD TEXT BASE
         CI,D4    X'80000'
         BAZ      KIRCN0            NOT A-F
         CI,D4    X'60000'
         BAZ      KIRCN0            NOT A-F
         AW,D4    KIRCN2
KIRCN0   CI,D4    X'800'            TEST THIRD DIGIT
         BAZ      KIRCN1            NOT A-F
         CI,D4    X'600'
         BAZ      KIRCN1            NOT A-F
         AI,D4    X'FC700'          CONVERT THIRD DIGIT
KIRCN1   STW,D4   KIREQDD-KIREQ111-20,R1
         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
         LI,R3    =X'3F'            MASK FOR PRIVATE ID DCTX.
         AI,R2    BATAPE            MAKE INTO DCTX
         SLD,R2   16                  AND SHIFT FOR COMPARE.
         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
         CS,R2    2,R1              SAME DCTX?
         BNE      1A1               NO HIT
         STW,R4   2,R1
1A1      AI,R1    CFUSIZE
         CW,R1    ACNCFU+13
         BLE      1A2
         PULL     4,R1
         B        CKZERO2
         PAGE
KIRAD1ST RES      0
***********************************************************************
*F*      NAME:    KIRAD1ST
*F*
*F*      PURPOSE: TO PROCESS THE 'PREFER' KEYIN.
*F*
*F*      DESCRIPTION:  INITIALIZES THE CELL RAD1ST (0 MEANS 'PREFER
*F*               DP'; 1 MEANS 'PREFER RAD').
***********************************************************************
*
         LI,D2    1
         CI,SR1   ' '
         BE       %+2
         LI,D2    0
         STW,D2   RAD1ST
         B        KEYINR
         PAGE
SKIN     EQU      %
***********************************************************************
*F*      NAME:    SKIN
*F*
*F*      PURPOSE: TO PROCESS THE 'SYY,OPTION' FORM OF THE SYMBIONT KEYIN
*F*
*F*      DESCRIPTION:  FINDS AN APPROPRIATE SYMBIONT BASED ON THE
*F*               SPECIFIED DEVICE-TYPE (YY) AND MERGES INTO THE SKEYIN
*F*               ROUTINE.
***********************************************************************
*D*      NAME:    SKIN
*D*
*D*      ENTRY:   SKEYIN
*D*                                 -- --
*D*      CALL:    KEYIN FORMAT:  SYY|NDD|,OPTION
*D*                                 -- --
*D*      INPUT:   R2/R3 = FIRST FIELD OF KEYIN
*D*               R7 = ADR OF KEYIN PARAMETER LIST
*D*               OH:NM, SNDDX, STB:TYP, MXSTRM, RBLIMS, DCT16
*D*
*D*      OUTPUT:  R7 = ADR OF KEYIN PARAMETER LIST
*D*               R2 = DCT INDEX OF SYMBIONT DEVICE
*D*               D1(R12) = OPTION CHARACTER
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  DEVCK, SYMCOM, GKIFLD, NXKICHR, KSGCQ
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  IF THE ABBREVIATED FORM OF THE KEYIN WAS USED
*D*               (SYY), OH:NM IS SCANNED FOR A MATCH AGAINST YY;
*D*               STB:TYP AND SNDDX ARE USED TO VERIFY   THAT SUCH A
*D*               DEVICE-TYPE IS A SYMBIONT DEVICE, AND REGISTERS ARE
*D*               LOADED FROM DCT16 TO SIMULATE THE SYYNDD FORM OF THE
*D*               KEYIN.  FOR EITHER FORM OF THE KEYIN, DEVCK VERIFIES
*D*               THE DEVICE ADDRESS, REMOTE BATCH TERMINALS ARE EX-
*D*               CLUDED, AND, IF THE OPTION IS ANYTHING OTHER THAN
*D*               'F', SYMCOM IS CALLED TO PROCESS IT.  THE 'F' OPTION
*D*               CAUSES A KFRMGFC GHOST FUNCTION CODE TO BE PASSED TO
*D*               RBBAT VIA KSGCQ.
***********************************************************************
*
         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
SKEYIN   EQU      %
***********************************************************************
*F*      NAME:    SKEYIN
*F*
*F*      PURPOSE: TO PROCESS THE 'SYYNDD,OPTION' FORM OF THE SYMBIONT
*F*               KEYIN.
*F*
*F*      DESCRIPTION:  VERIFIES DEVICE ADDRESS (YYNDD) AND EITHER
*F*               PROCESSES THE F/O/J OPTIONS WITHIN SKEYIN OR CALLS
*F*               THE SYMCOM ROUTINE IN THE KEYSUB MODULE TO PROCESS
*F*               ALL OTHERS.
***********************************************************************
*
         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
         MTW,-1   KCCP,R7
         BAL,11   GKIFLD
         BCS,8    SKEYIN2
         LI,9     KPLB
         AW,9     7
         LW,1     KFL,7
         AI,1     -1
         BLEZ     SKEYIN2
         CI,1     5
         BG       SKEYIN2
         LB,4     *9,1
         CI,4     ''''
         BNE      SKEYIN2
         CB,4     *9                FIRST IS ASTERISK TOO
         BNE      SKEYIN2
         LI,4     ' '
         STB,4    *9,1
         LI,1     4
         LB,4     *9,1              NOW PUT IT IN ONE WORD
         STB,4    *9
         LW,1     *9
         SCS,1    8
         STW,1    *9
         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
SKFRM2   EQU      %
         PULL     R2
         BAL,11   SYMTABCK
         B        %+2
         B        KEYERR
         SLS,12   8
         AI,12    KFRMGFC
         SLS,3    16
         OR,12    3
*        B        KSGCQ             FALL THRU TO KSGCQ
         PAGE
KSGCQ    EQU      %
***********************************************************************
*F*      NAME:    KSGCQ
*F*
*F*      PURPOSE: TO PROVIDE A KEYIN INTERFACE TO THE SGCQ ROUTINE IN
*F*               COOP.
*F*
*F*      DESCRIPTION:  BALS TO SGCQ WITH THE NORMAL RETURN GOING TO
*F*               KEYINR (KEYIN EXIT) AND THE ERROR RETURN
*F*               GOING TO KEYERR1 ('LATER' MESSAGE AND EXIT).
***********************************************************************
*
         BAL,4    SGCQ
         B        KEYERR1
         B        KEYINR
         SPACE    5
FKIC     TEXT     ' FOJ'
OCPCK    EQU      %
         LI,R1    OCPIO
         BEZ      SKEYIN2
         LW,R1    *TSTACK
         LB,R1    DCT4,R1
         CI,R1    OCPTYP
         BNE      SKEYIN2
         B        *11
         PAGE
KISTSY   EQU      %
***********************************************************************
*F*      NAME:    KISTSY
*F*
*F*      PURPOSE: TO PROCESS THE 'SS' (START SYMBIONT) KEYIN.
*F*
*F*      DESCRIPTION:  IF ONLY 1 LOCAL INPUT SYMBIONT EXISTS, AN
*F*               'SYYNDD,I' KEYIN IS SIMULATED TO GET IT GOING.
************************************************************************
*D*      NAME:    KISTSY
*D*
*D*      CALL:    KEYIN FORMAT:  SS
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  SNDDX IS SCANNED AND IF ONLY 1 INPUT SYMBIONT
*D*               IS PRESENT, A 'SYYNDD,I' KEYIN IS SIMULATED FOR THAT
*D*               SYMBIONT ('SYYNDD,I' IS PLACED IN KEYINBUF) AND KEYIN
*D*               IS RE-ENTERED AT THE TOP.
************************************************************************
*
         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
ERSEND   EQU      %
***********************************************************************
*F*      NAME:    ERSEND
*F*
*F*      PURPOSE: TO PROCESS THE 'ERSEND' KEYIN.
*F*
*F*      DESCRIPTION:  CAUSES SPECIFIED MESSAGE TO BE PUT INTO THE
*F*               ERRORLOG AS A TYPE-27 ENTRY.
***********************************************************************
*D*      NAME:    ERSEND
*D*
*D*      CALL:    KEYIN FORMAT:  ERSEND TEXT
*D*
*D*      INTERFACE:  KRBMV0, ERRLOG, RMB
*D*
*D*      ENVIORNMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS KRBMV0 TO ACQUIRE AN MPOOL BUFFER AND MOVE
*D*               THE MESSAGE TEXT FROM KEYINBUF TO THE BUFFER.  ERSEND
*D*               THEN FORMATS THE BUFFER AS A TYPE-27 ERROR LOG ENTRY
*D*               AND CALLS ERRLOG.  RMB IS CALLED TO RELEASE THE
*D*               MPOOL BUFFER.
***********************************************************************
*
         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.
         PAGE
         DO       RBCODE            :
*                                   *
KRBBCST  EQU      %                 ----------------------------------------
***********************************************************************
*F*      NAME:    KRBBCST
*F*
*F*      PURPOSE: TO PROCESS THE 'RBBDCST' KEYIN.
*F*
*F*      DESCRIPTION:  CAUSES THE SPECIFIED MESSAGE TO BE PASSED TO
*F*               RBBAT VIA A SYMBIONT GHOST COMMUNICATION BUFFER;
*F*               THIS MESSAGE WILL THEN BE BROADCAST TO ALL REMOTE
*F*               TERMINAL OPERATORS.
***********************************************************************
*
         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
*                                   ----------------------------------------
***********************************************************************
*F*      NAME:    KRBCOM
*F*
*F*      PURPOSE: TO PROCESS THE 'RBCOM' KEYIN
*F*
*F*      DESCRIPTION:  PASSES RBBAT A KCOMGFC GHOST FUNCTION CODE FOR
*F*               PROCESSOR TO PROCESSOR COMMUNICATION.
***********************************************************************
*
         LI,12    KCOMGFC
         B        KRBSC
*
KRBSEND  EQU      %                 SEND A MESSAGE TO THE SPECIFIED RBT.
***********************************************************************
*F*      NAME:    KRBSEND
*F*
*F*      PURPOSE: TO PROCESS THE 'RBSEND' KEYIN.
*F*
*F*      DESCRIPTION:  CAUSES THE SPECIFIED MESSAGE TO BE PASSED TO
*F*               RBBAT VIA A SYMBIONT GHOST COMMUNICATION BUFFER;
*F*               THIS MESSAGE WILL THEN BE SENT AS THE NEXT PRINT FILE
*F*               TO THE SPECIFIED DEVICE OR WORK STATION.
***********************************************************************
*D*      NAME:    KRBSEND
*D*
*D*      ENTRY:   KRBBCST, KRBCOM
*D*                               --     --
*D*      CALL:    KEYIN FORMATS:  |RBBDCST|
*D*                               |RBSEND | TEXT
*D*                               |RBCOM  |
*D*                               --     --
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  KRBMV0
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  VERIFIES THAT REMOTE PROCESSING IS INCLUDED IN
*D*               THE SYSTEM (IF RBBDCST) OR THAT THE SPECIFIED STATION
*D*               IS ACTIVE (IF RBSEND OR RBCOM) AND CALLS KRBMV0 TO
*D*               MOVE THE MESSAGE FROM KEYINBUF TO AN MPOOL BLOCK WHICH
*D*               WILL THEN BE PASSED TO RBBAT WITH AN APPROPRIATE GHOST
*D*               FUNCTION CODE (BCSTGFC IF RBBDCST; SNDGFC IF RBSEND;
*D*               KCOMGFC IF RBCOM) VIA THE KSGCQ ROUTINE.
*****************************************************************************
*
         LW,13    KPLB+1,7
         LB,13    13
         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
KRBMV    LI,4     KRBMV4            FOR RBSEND
*        B        KRBMV0            FALL THRU TO KRBMV0
         FIN
         PAGE
KRBMV0   EQU      %
***********************************************************************
*F*      NAME:    KRBMV0
*F*
*F*      PURPOSE: SUBROUTINE TO MANIPULATE A KEYIN MESSAGE SUPPLIED VIA
*F*               RBBCST/RBSEND/RBCOM/ERSEND KEYINS.
*F*
*F*      DESCRIPTION:  ACQUIRES AN MPOOL BUFFER AND MOVES THE CURRENT
*F*               MESSAGE IN KEYINBUF INTO THE BUFFER.
***********************************************************************
*D*      NAME:    KRBMV0
*D*
*D*      CALL:    BAL,R4            (SEE DESCRIPTION BELOW)
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               KEYINBUF
*D*
*D*      OUTPUT:  R14 = MPOOL BUFFER ADDRESS
*D*               R3 = NEXT AVAILABLE (BYTE) POSITION IN MPOOL BUFFER
*D*
*D*      REGISTERS:  R0, R1, R3 & R11 ARE VULNERABLE
*D*
*D*      INTERFACE:  GMB, RMB, KSGCQ
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  ACQUIRES AN MPOOL BUFFER VIA GMB AND MOVES UP TO
*D*               72 CHARACTERS (IGNORING LEADING BLANKS) INTO THE
*D*               BUFFER.  IF CALLED BY KRBBCST OR KRBSEND, RETURN IS
*D*               MADE IN SUCH A WAY AS TO CALL SGCQ, RELEASE THE BUFFER
*D*               VIA RMB AND EXIT;  IF CALLED BY ERSEND, RETURN IS TO
*D*               BAL+1.
*D*********************************************************************
*
         BAL,11   GMB
         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
         DO       RBCODE
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
         BNEZ     KRBWSN1           ID PRESENT  - OK
         CI,R13   KRBSBAL+1         IF CALLED FROM KRBS THEN
         BNE      KRBSPN1           NO ID PRESENT IS OK ALSO
KRBWSN1  EQU      %
         LW,2     4
         B        *13
*
KRBDNCK  EQU      %
         LC       DCT3,4
         BCS,2    *13
         LC       DCT24,4
         BCS,4    *13
         AI,13    1
         STS,0    RB:FLAG,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
         PAGE
KRBX     EQU      %                 DISCONNECT ALL RBTS AND PREVENT NEW CONNECTI
************************************************************************
*F*      NAME:    KRBX
*F*
*F*      PURPOSE: TO PROCESS THE 'RBX' KEYIN
*F*
*F*      DESCRIPTION:  DESCONNECTS AND DISALLOWS CONNECTION OF ONE OR
*F*               ALL REMOTE PROCESSING TERMINALS.
***********************************************************************
*D*      NAME:    KRBX
*D*
*D*      ENTRY:   KRBDISC, KRBS
*D*                               --    -- --    --
*D*      CALL:    KEYIN FORMATS:  |RBX   | |&RBNDD|
*D*                               |RBDISC| |WSN   |
*D*                               |RBS   | --    --
*D*                               --    --
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               RBLIMS, RBD:WSN, RBB:ID, RB:FLAG
*D*
*D*      OUTPUT:  RB:FLAG
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, DEVCK
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  3 HANDLERS AND A SET OF COMMON SUBROUTINES ALLOW
*D*               THE OPERATOR TO CONNECT (RBS) OR DISCONNECT (RBX/
*D*               RBDISC) REMOTE PROCESSING TERMINALS OR WORK STATIONS
*D*               BY VALIDATING THE RBNDD/WSN INPUT PARAMETER AND
*D*               SETTING APPROPRIATE BITS IN RB:FLAG FOR RBBAT.
***********************************************************************
*
         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
         PAGE
KRBDISC  EQU      %                 DISCONNECT GIVEN RBT.
***********************************************************************
*F*      NAME:    KRBDISC
*F*
*F*      PURPOSE: TO PROCESS THE 'RBDISC' KEYIN
*F*
*F*      DESCRIPTION:  DISCONNECTS A REMOTE PROCESSING TERMINAL
************************************************************************
*
         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
         PAGE
KRBS     EQU      %                 RESTART RBTS BY ALLOWING NEW CONNECTIONS.
***********************************************************************
*F*      NAME:    KRBS
*F*
*F*      PURPOSE: TO PROCESS THE 'RBS' KEYIN
*F*
*F*      DESCRIPTION:  ALLOWS CONNECTION OF ONE OR ALL REMOTE PROCESSING
*F*               TERMINALS
***********************************************************************
*
         LI,0     0
         CI,8     X'15'
         BE       KRBS1
KRBSBAL  BAL,R13  KRBDCT            KRBDCT WILL TEST R13 TO SEE IF
*                                   CALL CAME FROM HERE
         LI,0     0
         LI,R1    OFFBIT+OADBIT
         CW,R1    RB:FLAG,R4
         BAZ      KEYERR
         BAL,13   KRBDNCK
         B        KEYERR
         B        KEYINR
KRBS1    EQU      %
         LI,1     OFFBIT+OADBIT
         BAL,11   KRBSPN
         B        KEYINR
         BAL,13   KRBDNCK
         B        KRBSPN1
         B        KRBSPN1
         PAGE
KRBSWIT  EQU      %
***********************************************************************
*F*      NAME:    KRBSWIT
*F*
*F*      PURPOSE: TO PROCESS THE 'RBSWITCH' KEYIN
*F*
*F*      DESCRIPTION:  SWITCHES OUTPUT FILES FROM ONE WORKSTATION
*F*               TO ANOTHER.
***********************************************************************
*D*      NAME:    KRBSWIT
*D*
*D*      CALL:    KEYIN FORMAT:  RBSWITCH WSN,DEVICE-TYPE,USER
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  R5/R6 = WORKSTATION NAME
*D*               R12 = LENGTH OF WSN (BITS 16-23); SWITGFC (BITS 24-31)
*D*               R13 = CONVERTED SYSID (HEX)
*D*               R14 = DEVICE-TYPE (LEFT-JUSTIFIED; EBCDIC)
*D*               R15/R0 = WORKSTATION NAME
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, CVSYSID, SGCQ2
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  CALLS GKIFLD AND CVSYSID TO FORMAT THE REGISTERS
*D*               AS INDICATED ABOVE; THEN CALLS SGCQ2 WITH A GHOST
*D*               FUNCTION CODE = SWITGFC TO PASS THE DATA TO RBBAT.
***********************************************************************
*
         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
         LW,14    KFL,7
         CI,14    2
         BG       KEYERR
         LW,14    KPLB,7
         SAS,14   -16
         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             --------------------------------------------
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
**************************************************************
*F*      NAME:    KIOUTPUT
*F*
*F*      PURPOSE: TO PROCESS THE 'OUTPUT STOP,YYNDD' AND
*F*               'OUTPUT GO,ID' KEYINS.
*F*
*F*      DESCRIPTION: SETS UP A GHOST COMMUNICATION BUFFER FOR
*F*               'OUTPUT STOP', AND SETS THE X'80' BIT OF UH:FLG2
*F*               FOR 'OUTPUT GO'.
***************************************************************
*D*      NAME:    KIOUTPUT
*D*                                     --        --
*D*      CALL:    KEYIN FORMAT:  OUTPUT |STOP,YYNDD|
*D*                                     |GO,ID     |
*D*                                     --        --
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*
*D*      OUTPUT:  UH:FLG2 (IF GO)
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, CVSYSID, GETUSER#, DEVCK, SYMTABCK, KSGCQ
*D*
*D*      ENVIRONMENT:  MASTER/MAPPED
*D*
*D*      DESCRIPTION:  GKIFLD IS CALLED TO GET THE STOP/GO OPTION; IF
*D*               STOP, YYNDD IS OBTAINED BY GKIFLD, DEVCK VERIFIES
*D*               THE DEVICE, SYMTABCK OBTAINS THE SYMTAB INDEX AND A
*D*               KOSTOP GHOST FUNCTION CODE IS PASSED TO RBBAT VIA
*D*               KSGCQ.  IF GO, THE SYSID IS OBTAINED BY GKIFLD,
*D*               CONVERTED TO HEX BY CVSYSID, VERIFIED BY GETUSER#,
*D*               AND THE X80 BIT OF UH:FLG2 IS SET.
****************************************************************************
*
KIOUTPUT EQU      %
         BAL,11   GKIFLD
         BCS,8    KEYERR
         LW,2     KPLB,7            GET FUNCTION (STOP OR GO)
         CW,2     TXTSTOP
         BE       KOUTSTOP
         CW,2     TXTGO
         BNE      KEYERR
         BAL,11   GKIFLD            GET SYSID
         BCS,8    KEYERR            NO GOOD
         BAL,11   CVSYSID           CONVERT TO HEX IN R2
         BCS,8    KEYERR
         LW,6     2                 USER ID TO R6
         BAL,7    GETUSER#          RETURN USER NUMBER IN R5
         B        KEYERR
         DISABLE
         LH,2     UH:FLG2,R5        GET USER FLGS
         OR,R2    X80               SET COMODE FLAG FOR USER
         STH,2    UH:FLG2,R5
         ENABLE
         B        KEYINR
*
*
KOUTSTOP EQU      %
         BAL,11   GKIFLD            WHAT ARE WE HALTING COMODE ON?
         BCS,8    KEYERR            WHATEVER IT WAS, IT WEREN'T NO GOOD
         LW,2     KPLB,7            GET YYNDD INTO R2-R3
         LW,3     KPLB+1,7
         BAL,11   DEVCK             RETURN DCTX IN R2
         BCS,8    KEYERR            DEVICE NO GOOD
         BAL,11   SYMTABCK          GET SYMTABX IN R3
         B        %+2               SCREWBALL RETURN IF OK
         B        KEYERR            NOT SYMB DEVICE
         LW,12    3
         SLS,12   16                ALIGN FOR SGCQ
         AI,12    KOSTOP            GFC FOR 'OUTPUT STOP'
         LI,13    0
         LI,14    0
         B        KSGCQ             GO SETUP RBBAT COMM. BUFFER
         PAGE
KIFLUSH  EQU      %
***********************************************************************
*F*      NAME:    KIFLUSH
*F*
*F*      PURPOSE: TO PROCESS THE 'FLUSH' KEYIN
*F
*F*      DESCRIPTION:  SETS UP A GHOST COMMUNICATION BUFFER FOR 'FLUSH
*F*               OUTPUT'.
***********************************************************************
*D*      NAME:    KIFLUSH
*D*
*D*      CALL:    KEYIN FORMAT:  FLUSH YYNDD,SYSID
*D*
*D*      INPUT:   R7 = ADR OF KEYIN PARAMETER LIST
*D*               DCT4, SCNTXT, SYMX, SCSVDGI
*D*
*D*      REGISTERS:  ALL ARE VULNERABLE
*D*
*D*      INTERFACE:  GKIFLD, DEVCK, SYMTABCK, CVSYSID
*D*
*D*      ENVIRONMENT: MASTER/MAPPED
*D*
*D*      DESCRIPTION: DEVCK IS CALLED TO VALIDATE 'YYNDD' FIELD OF THE
*D*               KEYIN; SYMTABCK IS CALLED TO CONVERT THE DCT INDEX
*D*               TO A SYMTAB INDEX; IF THE SPECIFIED DEVICE IS
*D*               CURRENTLY PRINTING/PUNCHING THE SPECIFIED USER'S
*D*               OUTPUT, A GHOST COMMUNICATION BUFFER (KFLUSH) IS
*D*               PASSED TO RBBAT VIA KSGCQ.
***********************************************************************
*
         BAL,R11  GKIFLD            MOVE YYNDD TO KPL FIELD BUFFER
         BCS,8    KEYERR
         LW,R2    KPLB,R7           MOVE YYNDD TO REGISTERS
         LW,R3    KPLB+1,R7
         BAL,R11  DEVCK             VALIDATE IT; RETURNS DCTX IN R2
         BCS,8    KEYERR
         BAL,R11  SYMTABCK          GET SYMTAB INDEX IN R3
         B        KIF1              NORMAL RETURN
         B        KEYERR            ERROR RETURN
KIF1     ;
         LB,R12   DCT4,R2           GET DEV-TYPE
         SLS,R12  8
         STH,R3   R12
         AI,R12   KFLUSH            SET UP R12 FOR SGCOM
         BAL,R11  GKIFLD            MOVE SYSID TO KPL FIELD BUFFER
         BCS,8    KEYERR
         BAL,R11  CVSYSID           CONVERT IT TO HEX IN R2
         BCS,8    KEYERR
         LW,R13   R2                SYSID IN HEX TO R13 FOR SGCOM
         LH,R3    R12               GET SYMX AGAIN
         LB,R1    SYMX,R3
         CI,R1    2                 IS IT 'OUTPUT'?
         BAZ      KEYERR            NO
         LH,R1    SCNTXT,R3         IS THERE A CONTEXT BLOCK?
         BEZ      KEYERR            NO
         SLS,R1   1                 CONVERT TO WA
         LI,R3    MASKS+16
         CS,R2    SCSVDGI,R1        DOES SYSID MATCH?
         BNE      KEYERR            NO
         B        KSGCQ             PASS COM-BUF TO RBBAT
         END      START%KEYIN

