; SCCSID = src/dev/kbd/kbdbase.ssc/kbdiocs.asm, kbd, c.basedd 98/01/16
    Page  58,132
    Title   KBDIOCS - IOCTL "Set" Routines
    Name    KBDIOCS

;/*************************************************************************
;*
;* SOURCE FILE NAME = KBDIOCS.ASM
;*
;* DESCRIPTIVE NAME = PKBD IOCTL Set Routines
;*
;* COPYRIGHT    COPYRIGHT IBM CORPORATION, 1991, 1992
;*              Copyright Microsoft Corporation, 1990
;*              LICENSED MATERIAL - PROGRAM PROPERTY OF IBM
;*              REFER TO COPYRIGHT INSTRUCTION FORM#G120-2083
;*              RESTRICTED MATERIALS OF IBM
;*              IBM CONFIDENTIAL
;*
;* VERSION      V2.0
;*
;* DATE         15/03/92
;*
;* DESCRIPTION  This file contains the subroutines that handle the SE
;*              IOCTLs.
;*
;* FUNCTIONS    SetXlateTbl
;*              SetInputMode
;*              SetICFlags
;*              SetShiftState
;*              SetTypa
;*              SetSMHotKey
;*              SetKCB
;*              SetInUseCP
;*              SetReadNotify
;*              SetKbdLEDs
ifdef DBCSKBD
;*              SetKanaLED                                          ;@IBM J-AXKBD11(A)
endif ;DBCSKBD
;*              SetCodePage
;*              CreateKbd
;*
;*
;* NOTES         NOTES:
;*                  DEPENDENCIES:  A valid Request Packet is sent.
;*                  RESTRICTIONS:  Machine must be a 386 or compatible with a 386.
;*
;*
;* STRUCTURES   NONE
;*
;* EXTERNAL REFERENCES
;*
;*              NONE
;*
;* EXTERNAL FUNCTIONS
;*
;*              NONE
;*
;* CHANGE ACTIVITY =
;*   DATE      FLAG        APAR   CHANGE DESCRIPTION
;*   --------  ----------  -----  --------------------------------------
;*   mm/dd/yy  @Vr.mpppxx  xxxxx  xxxxxxx
;*             @V2.0XXX01         B724802   Unknown
;*             @V2.0XXX02         b789021   Pubs are wrong
;*             @V2.0XXX03         J200351
;*   04/12/94  81507              Defect 81507 - Add Sti after Block call
;*                                sequence
;*   06/08/95  121142      PJ18302  No longer rely on stack vars (StkKCBS &
;*             StkKCBO) for kcb addr -> these are being invalidated by
;*             devHelp calls &/or blocks/yields in certain situations
;*             (these values are obtained through a devHelp PhysToVirt;
;*             PhysToVirt values are no longer valid after another devHelp
;*             or a block/yield).
;*   UNKNOWN   J-DBCS001          DBCS enabling  (J-001)
;*   UNKNOWN   J-DBCS002          DBCS enabling  (ms001)
;*   UNKNOWN   J-DBCS003          DBCS enabling  (ss0011)          (S.Sakamoto)
;*   UNKNOWN   J-DBCS004          DBCS enabling  (J-TSO1)             (T.Sobue)
;*   08/12/92  J-AXKBD01   AX-KBD and J3100 KBD support for OEM    (M.Hirosawa)
;*   10/13/92  J-AXKBD11   Use Function DAh to support KANA-LED on AX-KBD instead of 5Ah (M.Hirosawa)
;*   11/17/92              J3100 support for TOSHIBA               (M.Hirosawa)
;*   UNKNOWN   J-MI1103                                                 (M.Ida)
;*   02/26/93  JS05061     JS05061   Add retry in SetInUseCP().         (M.Ida)
;*   08/06/93  J-DCR287    US 101 Keyboard Support on DBCS OS/2        (K.Itoh)
;*   10/28/93  JS06113     JS06113   MIFES/2 trap in SetKCB             (M.Ida)
;*   10/19/94  J-DBCSWARP  Base Code Change for WARP                   (H.Mori)
;*   10/27/94              Remove Toshiba J3100 support code           (H.Mori)
;*   11/07/94  J-AXKBD02   Change 'IF ASCII_KBD' -> 'IFDEF AX_KBD'     (H.Mori)
;*   11/16/94  J-AXKBD03   AX Keyboard LEDs support                    (H.Mori)
;*   11/07/95  JS08511     PJ20939  IMMON isn't loaded in boot if shutdown with
;*                                  OS/2 FS opened. (DCAF support)     (H.Mori)
;*
;*
;**************************************************************************

.286p
.xcref
.sall

     ;* The following files are included, but XLIST'd:

.xlist
  Include basemaca.inc   ; DOS macros.
  Include osmaca.inc     ; Macro file for OS/2 kernel
  CPUMODE 286            ;
  Include struc.inc      ; Structured assembly macros.
  Include devhlp.inc     ; DevHlp & Signal equates, char queue structure.
  Include devsym.inc     ; Device driver header definitions.
  Include singleq.inc    ; Single Queue Device Driver equates.
  Include kbdseg.inc     ; Segment definitions.
  Include kbdxlat.inc    ; Translate table structure definitions/macros.
  Include kbdddr.inc     ; Keyboard Device Driver structures & equates.
  Include kbdaim.inc     ; AIM  Keyboard Device Driver AIM structures & equates.
.list

;/*
;** Set up to use the local variables on the stack.  BP must NOT be
;** altered if these vars. are to be used.
;*/

StkFrameVars                      ; Macro to set up stack variables.

;** External Routines
    EXTRNFAR AccessKCB            ; DCR 652 made these EXTRNFAR Calls @IBM
    EXTRNFAR FreeKCB              ;         THESE
    EXTRNFAR Unlock_CustomCP      ;         ARE
    EXTRNFAR PutInSQB             ;         ALL
    EXTRNFAR PurgeKIB             ;         (CALLABLE FROM KBDCODE OR
    EXTRNFAR DiscardElement       ;         SWAPCODE SEGMENTS.)
    EXTRNFAR Typa_RDCheck         ; DCR 652 made these EXTRNFAR Calls @IBM
    EXTRNFAR SetFilterTypa        ;
    EXTRNFAR TypaControl_Reset    ;

    Extrn DD_Entry                :Far
    Extrn SearchCPCB              :Near
    Extrn FirstReadCheck          :Near
    Extrn MonDispEntry            :Near
    Extrn IOCtlAddrCheck          :Near
    Extrn NLS_Packet              :Near
    Extrn CopyXTable              :Near
    EXTRNFAR UpdStickyTbl         ;
    Extrn CopyCustom              :Near    ;B733926  @IBM

;** External Variables
    Extrn LockupFlags             :Byte     ;DCR1131 @IBM
    Extrn SQDDarea                :Byte
    Extrn HotKeyTable             :Byte
    Extrn HotKeyCount             :Byte
    Extrn MiscFlags               :Byte
    Extrn IntFlagArea             :Byte
    Extrn OtherFlags              :Byte
    Extrn MiscFlags2              :Byte
    Extrn CmdFlags                :Byte
    Extrn MiscFlags3              :Byte
    Extrn VDMFocus                :Byte
ifdef DBCSKBD
    Extrn DIDD_Exist              :Byte                                 ;@IBM J-DBCS002(A)
    Extrn DIDD_Name               :Byte                                 ;@IBM J-DBCS002(A)
    Extrn DIDD_Area               :Byte                                 ;@IBM J-DBCS002(A)

    Extrn KeyPacket1              :Word                                 ;@IBM J-DBCSWARP(A)
endif ;DBCSKBD
    Extrn SwitchPID               :Word
    Extrn PSGPointers             :Word
    Extrn MaxSG                   :Word
    Extrn CBDataSel               :Word
    Extrn KbdHWIDs                :Word
    Extrn SQDDname                :Word
    Extrn SQDDpds                 :Word
ifdef DBCSKBD
    Extrn dbcs_cp                 :Word                                 ;@IBM J-DBCS001(A)
endif ;DBCSKBD
    Extrn KCBSave                 :Dword
    Extrn DeviceHelp              :DWord
    Extrn SQDDpm@                 :Dword
    Extrn AIMFlags                :Word         ;AIM
    Extrn SCCount                 :Byte
    Extrn KeyHistBuf              :Byte
    Extrn IntFlags                :Byte     ; @V2.0XXX01
    Extrn KcbBlockId              :Word     ; @V2.0XXX01
    Extrn IDC_Write               :Word     ; PEN SUPPORT
ifdef DBCSKBD
    Extrn fkey                    :Byte                                  ;@IBM J-DCR287(A)

IFDEF    AX_KBD                                                         ;@IBM J-AXKBD03(A)
    Extrn LED_State               :Byte                                 ;@IBM J-AXKBD03(A)
ENDIF                                                                   ;@IBM J-AXKBD03(A)
endif ;DBCSKBD


BREAK <Kbd IOCTL Processing Note>
;**********************************************************************
;*           IOCTL REQUEST PROCESSING ROUTINES FOLLOW
;**********************************************************************
;* Note, on entry to the following routines, the following regs are:
;*
;*     AX = SG that caller is running in.      DI = PSG address
;*  ES:BX = Ptr to Request Block
;*     DL = Function number being called.
;*     DH = 0 = Read access parm for verification of caller's data
;*          areas
;*     CX = Zero (most likely value for parm list addr validation call)
;*
;*
;* In addition the strategy routine's stack contains the following
;* variables (all variables are prefaced with "Stk" in the code):
;*
;*     - DD's data segment/selector.
;*     - Caller's PSG offset.
;*     - Selector to KIB/CPCB data area
;*     - Caller's KCB selector
;*     - Caller's KCB offset. An LES/LDS instruction can be used here.
;*     - Caller's Request Packet selector/segment.
;*     - Caller's Request Packet offset. An LES/LDS inst. can be used.
;*     - Caller's Process ID.
;*
;* Be sure not to alter BP (without restoring), so that addressability
;* to the stack variables is maintained.
;*
;**********************************************************************

StratCode Segment

  Assume CS:StratCode,DS:DGROUP,ES:Nothing,SS:Nothing


BREAK <IOCTL 50h - Set Translate Table>

;**********************************************************************
;*
;* FUNCTION NAME  = SetXlateTbl
;*
;* DESCRIPTION    = Copy Code Page from Strategy caller's data area
;*                  to the device driver's data area.
;*
;*                  The Code Page defined by the caller of the IOCTL is
;*                  loaded into the area pointed to by the zeroeth entry
;*                  in the Code Page Control Block (i.e., the "hardware
;*                  default" Code Page).
;*
;* NOTES          = The keyboard is disabled during the transfer of
;*                  data, and enabled upon completion.
;*
;*                  Always called in protect mode.
;*
;*
;* INPUT          =
;*
;*                  REGISTERS:
;*
;*                    ES:BX = Ptr to Request Block
;*                       DL = Function number being called.
;*
;*                  The Request Block parm list pointer is actually a pointer
;*                  to the table to be copied.
;*
;* RETURN-NORMAL: Return to subroutine caller.
;*
;* RETURN-ERROR :  see NORMAL above.
;*
;* EFFECTS:     The "hardware default" code page is overwritten with
;*              the IOCTL caller's code page (i.e., translate table).
;*
;*              AX, SI are not preserved.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*              None
;*
;************************************************************************

Public SetXlateTbl
SetXlateTbl Proc Far

                                        ; PTM 3829: @IBM
  Mov  CX,XTLen                         ; Set length of table for parm check.
  Xor  SI,SI                            ; No data buffer parm checking.
  Call IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  Push 2222h                            ; Var2 (Not used for this call)
  Push 1111h                            ; Var1 (Not used for this call)
  Push DD_Cmd_Disable                   ; Function
  Call DD_Entry                         ; Device Independent Entry Point
                                        ; @V2.0XXX02
                                        ; parm packet having pointer to Xtable)
  LDS  SI,ES:[BX+ParmListPtr]           ; Get parm list address as source.
                                        ; @V2.0XXX02

  Mov  ES, StkCBData                    ; Point to memory containing the CPCB
  Mov  DI, CPCBOFFSET                   ; (we'll be at the 0th entry).

  ;*
  ;* DS:SI -> Caller's memory containing translate table to copy.
  ;* ES:DI -> CPCB (zeroeth entry).
  ;*

  Mov DX, [SI].XT_CP                    ; Get the code page value of the new
                                        ; translate table.
  Mov ES, Word Ptr ES:[DI].CPVAddr      ; @V2.0PTM01 Point to the table alreadyin
  Xor DI, DI                            ; memory, assumed zero offset.

  ;* ES:DI -> Default translate table already in system.

  Cld                                   ; Be sure not to decrement.
                                        ; (CX already set to table size above)
  Test CX, 1                            ; Check whether size is even or odd.
 .If < z >                              ; If it's even, then MOVe String Word.
    ShR CX,1                            ; Change byte count to word count.
    Rep MovSW                           ; Move the table.
 .Else                                  ; Else the table size is odd-numbered.
    Rep MovSB                           ; Perform a MOVe String Byte.
 .Endif

  Mov ES, StkCBData                     ; Point to memory containing the CPCB
  Mov DI, CPCBOFFSET                    ;  (we'll be at the 0th entry).

  Mov ES:[DI].CPValue, DX               ; Save CP value in CPCB[0].

  Mov DS, StkDS                         ; Restore DD's data segment.
  LES BX, Dword Ptr StkRPO              ; Restore request packet address.

  Push 2222h                            ; Var2 (Not used for this call)
  Push 1111h                            ; Var1 (Not used for this call)
  Push DD_Cmd_Enable                    ; Function
  Call DD_Entry                         ; Device Independent Entry Point

                                        ; DCR 408 Begin @IBM
 .IF <bit MiscFlags nz MLayerMode>      ; If Multi Layer CP is supported
      Mov  AX, 50h                      ; Set Ioctl parm
      Mov  CX, DX                       ; Set CX = DX which has the CP value
      Mov  BX, Index0                   ; Set index made active
      Call NLS_Packet                   ; Send NLS Notify pkt down mon chain
 .Endif                                 ; End if Multi Layer CP supported
  LDS DI, Dword Ptr StkPSG              ; Restore callers psg addresses
  LES BX, Dword Ptr StkRPO              ; Restore request packet address.
                                        ; DCR 408 End @IBM

  Ret

SetXlateTbl Endp

BREAK <IOCTL 51h - Set Input Mode>

;*********************************************************************
;*
;* FUNCTION NAME SetInputMode
;*
;* DESCRIPTION  Put the IOCTL caller's desired input mode into
;*              the session's KCB for use during keystroke
;*              translation.
;*
;* FUNCTION:    This routine obtains from the IOCTL caller a byte
;*              indicating the desired input mode (i.e., ASCII,
;*              Binary, or Shift Report), and places it into the
;*              device driver's KCB for the session. The routine
;*              checks if the Shift Report bit AND the ASCII bit are
;*              both turned on.  If both are set the routine returns
;*              an invalid parm error.
;*
;*              Single Queue mode can also be enabled/disabled,
;*              provided that the thread is in the Winthorn session.
;*              The Single Queue bit in the input mode byte is masked
;*              off before storage into the KCB.
;*
;* NOTES       ;DCR 75 @IBM
;*              made changes to the way Single Queue mode is
;*              handled in this routine.  Now any one session is
;*              allowed to be in Single Queue mode. A global flag
;*              indicates whether any session is in SQ mode.  If
;*              another session requests SQ mode then an error is
;*              flagged.  If a session that is already in SQ mode
;*              requests to turn SQ on, no error will be flagged.
;*
;*
;* INPUT:
;*   REGISTERS:
;*
;*     ES:BX = Ptr to Request Block
;*        DI = PSDA address
;*
;*        The Request Block contains a pointer to the byte to be
;*        copied into the Per session Data Area.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The Per session
;*              Data Area is modified.
;*
;* RETURN-ERROR  :
;*              An "Invalid Parameter" error code is set if Single
;*              Queue mode is desired but the thread is not in the
;*              Winthorn session.
;*              The "General Failure" error code is also returned
;*              if the DevHlp_AttachDD fails.
;*
;* EFFECTS:     AH, CX, DL, SI are not preserved.
;*              The Input Status byte in the KCB for the current
;*              session is changed.
;*              Single Queue mode is enabled/disabled.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (AttachDD)
;*              Indirect FAR Call to the Single Queue Device Driver
;*              Begin/End Entry Point.
;*
;***********************************************************************

Public SetInputMode
SetInputMode Proc Far

SQBSize Equ (KeyPacketLen+Que_Header_Size)*SQDRcount    ; Size of Single
                                                        ; Queue Buffer for
                                                        ; the keyboard,
                                                        ; includes header.

                                        ; PTM 3829:  @IBM
  Mov CX,1                              ; Set length of table for parm check.
  Xor SI,SI                             ; No data buffer parm checking.
  Call IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES SI,ES:[BX+ParmListPtr]            ; Get address of parm list.
  Mov AH,ES:[SI]                        ; Get passed mode flags byte.
                                        ; PTM 667 - Begin   @IBM
  Test AH,MODERESMASK                   ; Check if any reserved bits set
 .If <nz> OR                            ; If they are OR
                                        ; PTM 667 - End    @IBM
  Test AH, SHIFTREPORT                  ; Is Shift Report desired?
 .If < nz >  AND                        ; If so, then is the mode also
  Test AH, INPUTMODE                    ;  ASCII (i.e., bit 7 = 0)?
 .If < z >                              ; Specifying both Shift Report
    LES BX, Dword Ptr StkRPO            ; Restore request packet address.
    Mov ES:[BX+PktStatus],ParmError     ; Indicate invalid parameter in RP
    Ret                                 ; Get Out Now.
 .Endif                                 ; End Shift report/ASCII check.
                                        ; DCR 8 BEGIN @IBM
  Test AX, SQMODE                       ; Check if single input mode
 .If < nz > NEAR                        ;  is desired using WORD equate.
                                        ; DCR 75 : BEGIN  @IBM
    Test MiscFlags3,SQon                ; SQ Mode desired, determine
                                        ;  if it is already on in any SG.
   .If < z >  NEAR                      ; If this is the correct session,
                                        ;  set up to enable SQ mode.
        Lea  BX, SQDDname               ; Set desired device name offset.
        Lea  DI, SQDDarea               ; Set data area offset.
        Mov  DL, DevHlp_AttachDD        ; Set desired DevHlp routine.
        Call DeviceHelp                 ; SQDDdata filled in or carry set.
        Mov DI, StkPSG                  ; Restore PSG offset.
       .If < c >                        ; If AttachDD failed,
          LES BX, Dword Ptr StkRPO      ; Restore request packet address.
          Mov ES:[BX+PktStatus],GenError; Indicate invalid parameter in RP
          Ret                           ; Get Out Now.
       .Endif                           ; End if AttachDD failed.
        Push AX                         ; Save input mode.

        Push DS                         ; Save DD's data seg.
        Push DI                         ; Save PSG offset.
        Mov  DH, ES_DI                  ; Indicate receiving registers
                                        ;  for next call.
        CALLFAR AccessKCB               ; Get KCB for this session
        Mov  AX,ES:[DI].KCBIxOffCP      ; Get the index into the CP
        Push ES                         ; Save Req Block seg.
        Mov  ES,CBDataSel               ; Get selector for KIB/CPCB area.
        Mov  DI,CPCBOFFSET              ; Set up zero offset into CPCB
        Mov  CX,CPCBEntrySize           ; Get size of CPCB
        IMul CX                         ; Compute offset into CPCB based on
                                        ; index from the KCB
        Add DI,AX                       ; Add the offset into CPCB to beginning
                                        ; offset
        Mov DS, Word Ptr ES:[DI].CPVAddr; Get custom code page virt. addr.
        Xor SI,SI                       ; Set zero offset for selector.
        Mov DL, DevHlp_VirtToPhys       ; Set DevHlp function.
        Pop ES                          ; Restore Req. data seg.
        Call ES:[DeviceHelp]            ; AX:BX will = Physical address
                                        ;  of translate table.
        Mov DX, AX                      ; Put translate table's
        Mov CX, BX                      ; physical address in CX:DX
        Pop DI                          ; Restore PSG offset.

        Mov AX, 0100h                   ; Caller = keyboard device driver.
        Mov BX, 0001h                   ; FIFO queue, Function = Init.
  ;     Mov CX, SQBSize                 ; CX used for XT address.
        Pop DS                          ; Restore DD's data seg.
                                        ; Size of desired SQ buffer not used
        Mov  ES, SQDDpds                ; SQ DD's protect mode data selector
        Call SQDDpm@                    ; Call SQ DD to initialize for kbd.
        Or   AX, AX                     ; Check SQ DD return code.
        Pop AX                          ; Restore input mode.
       .If < nz >                       ; SQDD RC != 0 indicates error,
          LES BX, Dword Ptr StkRPO      ; Restore request packet address.
          Mov ES:[BX+PktStatus],GenError; Indicate invalid parameter in RP
          Ret                           ; Get Out Now.
       .Endif

        ;*
        ;* At this point the SQDD has returned good, so flush the current
        ;* normal KIB and mark this PSG as being in SQ Mode.
        ;*

        Cli                             ; Disable interrupts for a bit.
        Push AX                         ; PTR B789221 Begin, Save AX @IBM
        Xor AX,AX                       ; Indicate to Access the KCB
        CALLFAR PurgeKIB                ; Flush KIB
        Pop AX                          ; PTR B789221 End, Restore AX
        Or [DI].PSGFlags, SQMODE        ; Indicate Single Queue mode is
                                        ;  enabled for this session.
        Or MiscFlags3, SQon             ; DCR 75: set a global flag also.@IBM
        Sti                             ; Interrupts back on.

       .If < <Word Ptr [DI].EventID> ne 0 >     ; Non-zero event ID means
                                                ;  a thread is blocked on
                                                ;  a read.
          Push AX                               ; Save input mode.
          Mov  AX, Word Ptr [DI].EventID + 2    ; Get Event ID
          Mov  BX, Word Ptr [DI].EventID        ;  value.
          Mov  DL, DevHlp_ProcRun               ; Set DevHlp function.
          Call DeviceHelp                       ; Wake up the blocked thread so
                                                ;  that it will exit the read.
          Mov Word Ptr [DI].EventID + 2, 0      ; Clear out the Event ID
          Mov Word Ptr [DI].EventID, 0          ;  variable.
          Pop AX                        ; Restore input mode.
       .Endif                           ; End if thread waiting for char.
   .Else                                ; Not in correct session,
      Test [DI].PSGFlags, SQMODE        ; DCR 75: If the requesting session @IBM
     .If <z>                            ; is not already in SQ mode then
                                        ; flag an error and get out.
         LES BX, Dword Ptr StkRPO       ; Restore request packet address.
         Mov ES:[BX+PktStatus],ParmError; Indicate invalid parameter in RP
         Ret                            ; Get Out Now.
     .Endif
   .Endif                               ; End session check.
 .Else                                  ; Single Queue mode not desired.
    Test [DI].PSGFlags, SQMODE          ; If Single Queue mode is enabled,
   .If < nz >                           ; Single Queue mode enabled,
      Push AX                           ; Save desired input mode.
      Mov  AX, 0100h                    ; Caller = keyboard device driver.
      Mov  BX, 0003h                    ; Function = End Single Queue.
      Mov  ES, SQDDpds                  ; SQ DD's protect mode data selector
      Call SQDDpm@                      ; Call SQ DD to end SQ mode.
      Pop  AX                           ; Restore desired input mode.
      And  [DI].PSGFlags, Not SQMODE    ; Indicate SQ mode is disabled.
      And  MiscFlags3, Not SQon         ; DCR 75: Reset the global flag. @IBM
   .Endif                               ; End if SQ mode enabled.
 .Endif                                 ; End Single Queue Mode check.
                                        ; DCR 8 END  @IBM

  ;*
  ;* Making it this far means no parm errors.  Store the desired input
  ;* mode in the caller's KCB.
  ;*

; --  Do not rely on stack variables - get kcb address ourselves        ;121142
;121142  LES SI, Dword Ptr StkKCBO             ; Get the caller's KCB.
  Push DX                               ;save regs                      ;121142
  Push DI                               ;                               ;121142
  Mov DH,ES_DI                          ;retn kcb slctr/offset in es/di ;121142
  CALLFAR AccessKCB                     ;get  kcb address               ;121142
  Mov SI,DI                             ;put offset in si               ;121142
  Pop DI                                ;                               ;121142
  Pop DX                                ;restore regs                   ;121142

  And AX, Not SQMODE                    ; Ensure SQMODE bit is off before
                                        ;  saving.
  Mov ES:[SI].KCBInpMode,AH             ; Put passed mode byte in KCB.

  LES BX, Dword Ptr StkRPO              ; Restore request packet addr.

  Ret

SetInputMode Endp

BREAK <IOCTL 52h - Set Interim Character (DBCS) Flags>


;************************************************************************
;*
;* FUNCTION NAME SetICFlags
;*
;* DESCRIPTION   Set the Interim Character Flags in the KCB.
;*
;*              This routine obtains the Interim Character flag
;*              byte (via a pointer in the Request Packet), and
;*              updates the KCB for this session.
;*
;*              An invalid parm error is returned if any reserved
;*              bits are set.
;*
;*
;* INPUT:
;*   REGISTERS:
;*
;*     ES:BX = Ptr to Request Block
;*        DI = PSDA address
;*
;*        The Request Packet contains a pointer to the byte to be
;*        copied into the current KCB.
;*
;* RETURN-NORMAL: Return to main Strategy processing.  The current KCB
;*              is modified.
;*
;* RETURN-ERROR :  None.  All exits are through NORMAL, above.
;*
;* EFFECTS:     SI, AL are not preserved.
;*              The KCB Interim Character byte is updated.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES: None.
;*
;**************************************************************************

Public SetICFlags
SetICFlags Proc Far

                                        ; PTM 3829:  @IBM
  Mov CX,1                              ; Set length of table for parm check.
  Xor SI,SI                             ; No data buffer parm checking.
  Call IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES   SI,ES:[BX+ParmListPtr]          ; Get address of parm list.
  Mov   AL,ES:[SI]                      ; Get passed IC flags byte.

; --  Do not rely on stack variables - get kcb address ourselves        ;121142
;121142  LES   SI, Dword Ptr StkKCBO           ; Get the caller's KCB address
  Push DX                               ;save regs                      ;121142
  Push DI                               ;                               ;121142
  Mov DH,ES_DI                          ;retn kcb slctr/offset in es/di ;121142
  CALLFAR AccessKCB                     ;get  kcb address               ;121142
  Mov SI,DI                             ;put offset in si               ;121142
  Pop DI                                ;                               ;121142
  Pop DX                                ;restore regs                   ;121142

  Test  AL, ICResMask                   ; PTM 3115/3377:  Check if user @IBM
 .If < nz >                             ; set reserved bits.  If so,
    LES   BX, Dword Ptr StkRPO          ; Restore request packet address.
    Mov   ES:[BX+PktStatus],ParmError   ; Indicate invalid parameter in RP
 .Else                                  ; Else reserved bit okay.
    Or  AL, DefaultDBCS                 ; PTM 3115: Ensure final char.   @IBM
                                        ;  flag is set in the IC byte.
    Mov ES:[SI].KCBDBCSFl, AL           ; Put interim character byte
                                        ;  (i.e, the DBCS flags) in
                                        ;  the KCB.
ifdef DBCSKBD
    Mov DH,AL                           ; set DH= status                ;@IBM J-DBCS001(A)
    Test DH,20H                                                         ;@IBM J-DBCS001(A)
   .If <nz>                                                             ;@IBM J-DBCS001(A)
      And ES:[SI].KCBDBCSSh,Not kanji_mode                              ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
    Mov AX,ES:[SI].KCBShift             ; Set current shift             ;@IBM J-DBCS001(A)
    Mov DL,ES:[SI].KCBDBCSSh            ; Set current shift             ;@IBM J-DBCS001(A)
    Push 2222h                          ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
    Push 1111h                          ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
    Push DD_Cmd_Disable                 ; Function                      ;@IBM J-DBCS001(A)
    Call DD_Entry                       ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
    Call inform_mon                                                     ;@IBM J-DBCS001(A)
   .If <c>                              ; MON dispatcher accept packet? ;@IBM J-DBCS001(A)
      LES BX, Dword Ptr StkRPO          ; Restore request packet address;@IBM J-DBCS001(A)
      Mov ES:[BX+PktStatus],GenError    ; Set General command error     ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
    Push 2222h                          ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
    Push 1111h                          ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
    Push DD_Cmd_Enable                  ; Function                      ;@IBM J-DBCS001(A)
    Call DD_Entry                       ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
endif ;DBCSKBD

    Mov ES, StkRPS                      ; Restore request packet seg.
 .Endif                                 ; PTM 3377: End reserved bits    @IBM
                                        ;  check.
  Ret

SetICFlags Endp

BREAK <IOCTL 53h - Set Shift State>
Public SetShiftState
SetShiftState Proc Far

;***********************************************************************
;*
;* SUBROUTINE NAME: SetShiftState
;*
;*
;* DESCRIPTIVE NAME: Set the Shift and DBCS Shift states for the
;*              current KCB, and update the Keyboard LEDs.
;*
;* FUNCTION:    This routine obtains the desired Shift and DBCS Shift
;*              states (via a pointer in the Request Packet), and
;*              updates the caller's KCB. The Keyboard LEDs
;*              will be updated if the current PSG is the active
;*              session.
;*
;*
;* ENTRY POINT: SetShiftState
;*
;*    LINKAGE:  NEAR
;*
;* INPUT:
;*   REGISTERS:
;*
;*     ES:BX = Ptr to Request Block
;*        DI = PSDA address
;*
;*        The Request Packet contains a pointer to the parm list to
;*        be used to copy the shift flags into the KCB.
;*
;* RETURN-NORMAL: Return to main Strategy processing.  The caller's
;*              KCB is modified. The Keyboard LEDs are updated, if
;*              the current session is the active session.
;*
;* RETURN-ERROR :  None.  All exits are through NORMAL, above.
;*
;* EFFECTS:     SI, AX, DX are not preserved.
;*              The Shift and DBCS Shift flags for the current KCB
;*              in the caller's session are updated.
;*              The Keyboard LEDs may be updated.
;*
;*              AIM Sticky Keys will be turned off
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES: None.
;*
;*************************************************************************
;*
;* PSEUDOCODE
;*
;* Call IOCtlAddrCheck to verify access to table
;* If error
;*   Ret to caller
;* Endif
;* Get address of parm list
;* Get passed Shift flags word
;* Get passed DBCS shift flags
;* Get the caller's KCB address
;* Put shift flags in the KCB
;* Put the DBCS shift flags in the KCB
;*
;* If this is the active SG update LEDs
;*   Update the LEDs by putting the shift flags in the PSGs area
;*   Call UpdStickyTbl to turn off Sticky Keys
;*   If not in the PM Screen Group
;*     Set up parms to update LED's
;*     Call DD_Cmd_Entry to do it
;*   Endif
;* Endif
;*
;* Ret
;********************************************************************

  Mov  CX,3                             ; Set length of table for parm check.
  Xor  SI,SI                            ; No data buffer parm checking.
  Call IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES   SI,ES:[BX+ParmListPtr]          ; Get address of parm list.
  Mov   AX,ES:[SI]                      ; Get passed Shift flags word.
  Mov   DL, ES:[SI+2]                   ; Get passed DBCS shift flags.

; --  Do not rely on stack variables - get kcb address ourselves        ;121142
;121142  LES   SI, Dword Ptr StkKCBO           ; Get the caller's KCB address
  Push DX                               ;save regs                      ;121142
  Push DI                               ;                               ;121142
  Mov DH,ES_DI                          ;retn kcb slctr/offset in es/di ;121142
  CALLFAR AccessKCB                     ;get  kcb address               ;121142
  Mov SI,DI                             ;put offset in si               ;121142
  Pop DI                                ;                               ;121142
  Pop DX                                ;restore regs                   ;121142

  Mov   ES:[SI].KCBShift, AX            ; Put shift flags in the KCB.
  Mov   ES:[SI].KCBDBCSSh, DL           ; Put the DBCS shift flags in
                                        ;  the KCB.
ifdef DBCSKBD
IFDEF    AX_KBD                                                         ;@IBM J-AXKBD02(A)
  Push  DX                              ; Save DBCS shift flags         ;@IBM J-AXKBD01(A)
ENDIF                                                                   ;@IBM J-AXKBD01(A)

  Mov   DH,ES:[SI].KCBDBCSFl            ; Put interim character byte    ;@IBM J-DBCS001(A)
  Push  2222h                           ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
  Push  1111h                           ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
  Push  DD_Cmd_Disable                  ; Function                      ;@IBM J-DBCS001(A)
  Call  DD_Entry                        ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
  Call  inform_mon                                                      ;@IBM J-DBCS001(A)

IFDEF    AX_KBD                                                         ;@IBM J-AXKBD02(A)
  Pop   DX                              ; DX = DBCS shift flags         ;@IBM J-AXKBD01(A)
ENDIF                                                                   ;@IBM J-AXKBD01(A)

 .If <c>                                ; MON dispatcher accept packet? ;@IBM J-DBCS001(A)
    Push    2222h                       ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
    Push    1111h                       ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
    Push    DD_Cmd_Enable               ; Function                      ;@IBM J-DBCS001(A)
    Call    DD_Entry                    ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
    LES     BX, Dword Ptr StkRPO        ; Restore request packet address;@IBM J-DBCS001(A)
    Mov     ES:[BX+PktStatus],GenError  ; Set General command error     ;@IBM J-DBCS001(A)
    Ret                                                                 ;@IBM J-DBCS001(A)
 .Endif                                                                 ;@IBM J-DBCS001(A)
  Push   2222h                          ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
  Push   1111h                          ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
  Push   DD_Cmd_Enable                  ; Function                      ;@IBM J-DBCS001(A)
  Call   DD_Entry                       ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
endif ;DBCSKBD

  Mov ES, StkRPS                        ; Restore request packet segment.

 .If <bit [DI].PSGFlags nz ActiveSG>    ; If this is the active SG update LEDs

    Mov   [DI].ShiftFlags, AX           ; Put shift flags in PSGs area
    Or    AIMFlags, UnStickAll          ; AIM Set flag for resetting Sticky Keys
    CALLFAR UpdStickyTbl                ; AIM Reset the Sticky Key Routine

                                        ; PTR B724103  @IBM
   .If <bit AIMFlags nz AIMActive>      ; If AIM is active
      Mov  SCCount,0                    ; Clear out SCCount since breaks not seen
      Mov  KeyHistBuf, 0                ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+1,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+2,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+3,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+4,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+5,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+6,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+7,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+8,0               ; Clear out the KeyHistBuf
      Mov  KeyHistBuf+9,0               ; Clear out the KeyHistBuf
   .Endif                               ; Endif

   .If <bit [DI].PSGFlags z SQMODE>     ; DCR106: Check if we are in PM SG. @IBM
      Shr  AX,4                         ; Move LED bits to low nibble
      And  AX,7                         ; Turn off all unwanted bits

ifdef DBCSKBD
ifdef AX_KBD
      Test DL, KATAKANA                                                 ;@IBM J-AXKBD01(A)
     .If <nz>                   ; If KATAKANA set Bit 3                 ;@IBM J-AXKBD01(A)
        Or AX,8                 ; for KANA LED                          ;@IBM J-AXKBD01(A)
     .Endif                                                             ;@IBM J-AXKBD01(A)
endif ;AX_KBD
endif ;DBCSKBD

      Push 2222h                        ; Var2 (Not used for this call)
      Push AX                           ; Var1 (LED state)
      Push DD_Cmd_Indicators            ; Function
      Call DD_Entry                     ; Device Independent Entry Point
   .Endif                               ;

 .Endif

  Ret

SetShiftState Endp

BREAK <IOCTL 54h - Set Typematic Rate/Delay>
Public SetTypa
SetTypa Proc Far

;************************************************************************
;*
;* FUNCTION NAME   SetTypa
;*
;* DESCRIPTION     Calculate the desired typematic rate and delay
;*                 and command the keyboard accordingly.
;*
;*
;*                 This routine obtains the IOCTL caller's desired
;*                 rate and delay parms (via a pointer in the Request
;*                 packet) and converts them into the appropriate format
;*                 for the keyboard.  The change in keyboard rate/delay
;*                 is system-wide.
;*
;*
;* INPUT
;*           REGISTERS:
;*
;*             ES:BX = Ptr to Request Block
;*
;*                 The Request Packet contains a pointer to the parm list to
;*                 be used to set the rate and delay.
;*
;* RETURN-NORMAL :     Return to main Strategy processing.  The keyboard
;*                 reflects the desired rate and delay changes.
;*
;* RETURN-NORMAL :      None.  All exits are through NORMAL, above.
;*
;* EFFECTS         SI, AX, and DL are not preserved.
;*                 The Keyboard typematic rate and delay are changed.
;*
;*
;*************************************************************************

  Mov   CX,4                            ; Set length of table for parm check.
  Xor   SI,SI                           ; No data buffer parm checking.
  Call  IOCtlAddrCheck                  ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES   SI,ES:[BX+ParmListPtr]          ; Get address of parm list.
  Mov   AX,ES:[SI]                      ; Get delay value.
  Mov   SI,ES:[SI+2]                    ; Get rate value.

  CALLFAR Typa_RDCheck                  ; Returns with AX bits set
  Test AIMFlags,TYPACONTROL_CALLING
 .if <nz>
     Push 2222h                         ; Var2 (Not used for this call)
     Push AX                            ; Var1 (Rate and Delay)
     Push DD_Cmd_Typematic              ; Function
     Call DD_Entry                      ; Device Independent Entry Point
 .Else
     CALLFAR SetFilterTypa              ; Track the typa rates
     Test AIMFlags,AIMACTIVE
    .if <z>
        Push 2222h                      ; Var2 (Not used for this call)
        Push AX                         ; Var1 (Rate and Delay)
        Push DD_Cmd_Typematic           ; Function
        Call DD_Entry                   ; Device Independent Entry Point
    .Else
        CALLFAR TypaControl_Reset
    .Endif
 .Endif
  Ret

SetTypa Endp

BREAK <IOCTL 56h - Set Session Manager Hot Key>

;**********************************************************************
;*
;* FUNCTION NAME = SetSMHotKey
;*
;* DESCRIPTION   = Indicate to the device driver the scan code and
;*              shift state to be used as a session Manager "hot
;*              key".
;*
;*              This routine obtains the IOCTL caller's desired
;*              hit key ID and searches a hot key table for a match
;*              on this value.  If a match was made, then the
;*              existing hot key entry with the matching ID is over-
;*              written with the caller's data.  If no ID match was
;*              made, or there were no entries in the table, then
;*              a new entry is made in the table.
;*
;*              A check is made of the IOCTL caller's PID.  If the
;*              PID is not the same as that which was saved on the
;*              first Set Current Foreground session IOCTL call, then
;*              an Unknown Command Error is returned.
;*
;*              An invalid parameter error is returned to the caller
;*              if any reserved bits are set in the hot key shift
;*              state.
;*
;*    NOTE:
;*              The SGController routine must be invoked prior to
;*              a call to this routine, else the Command error will
;*              be returned.
;*
;*
;* INPUT:
;*              REGISTERS:
;*
;*                 ES:BX = Ptr to Request Block
;*
;*        The Request Packet contains a pointer to the parm list to
;*        be used which contains the hot key data to be copied.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The device
;*              driver will recognize the new hot key and pass its
;*              associated ID to DevHlp (reference the int. handler).
;*
;* RETURN-NORMAL :   CmdError bit is set for the following:
;*                - Caller's PID is invalid (see NOTE above).
;*                - No entries left to add caller's hot key data.
;*
;* EFFECTS:     SI, AX, and CX are not preserved.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              None
;************************************************************************

Public SetSMHotKey
SetSMHotKey Proc Far

                                        ; PTM 3829:  @IBM
  Mov  CX, HKEntrySize                  ; Set length of table for parm check.
  Xor  SI,SI                            ; No data buffer parm checking.
  Call IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  Cli                                   ; Don't allow an interrupt until changed.
  LES  DI,ES:[BX+ParmListPtr]           ; Get address of parm list.

  ;* PTM 3115/3377:   @IBM
  ;* Check the reserved bits in the desired shift state
  ;* and return an error if any are set.                                @IBM

  Mov  BX, ES:[DI].HotKeyShift          ; Get the hot key shift state.
  Test BX, HKResMask                    ; PTM 3115/3377:  Check reserved @IBM
                                        ;  bits for desired shift state.
 .If < nz > NEAR                        ; If any reserved bits set,
    LES BX, Dword Ptr StkRPO            ; Restore request packet address.
    Mov ES:[BX+PktStatus],ParmError     ; Indicate invalid parameter in RP

 .Else NEAR                             ; Reserved bits okay, continue
    Mov SI, Offset HotKeyTable          ; Point to the first entry in
                                        ;  the hot key table.
    Mov AX, ES:[DI].HotKeyID            ; Get caller's hot key ID.

   .If <AX eq 0ffffh>                   ;DCR1131 If special HotKeyID @IBM
       Test LockupFlags,Lockup          ;DCR1131                     @IBM
      .If <z>                           ;DCR1131                     @IBM
          Or   LockupFlags,Lockup       ;DCR1131                     @IBM
      .Else                             ;DCR1131                     @IBM
          And  LockupFlags,Not Lockup   ;DCR1131                     @IBM
      .Endif                            ;DCR1131                     @IBM

       ;** PEN SUPPORT                     ;Notify PEN of status
       pusha
       push   ds
       push   es
       mov    ax, 01
       mov    dl, LockupFlags
       lea    bx, IDC_Write
       push   ds
       pop    es
      .if < es:[bx].sinfo_service_ds ne 0 >  ;if non-zero, read enable occurred
         mov  ds,es:[bx].sinfo_service_ds
         call es:[bx].sinfo_service_rtn
      .endif
       pop   es
       pop   ds
       popa

   .Else
       Push  AX
      ;** PTR B711847 changed this logic  @IBM

       Mov   AX, StkPID                 ; Get caller's Process ID.
      .If <SwitchPID eq 0>              ; Is this the first SetSMHotKey caller?
        Mov  SwitchPID, AX              ; Yes, save caller's PID.
      .Endif                            ;
      .If <AX ne [SwitchPID]>           ; Is this the PID of SetSMHotKey 1st caller?
         LES  BX, Dword Ptr StkRPO      ; Restore request packet address.
         Mov  ES:[BX+PktStatus],CmdError; Indicate invalid parameter in RP
         Pop  AX
         Ret
      .EndIf
       Pop AX
   .Endif                               ;DCR1131   @IBM

    Xor CL, CL                          ; Clear indexing variable for
                                        ; below.

    ;*
    ;* If entries already exist, then we must search them to see if the
    ;* hot key id has been previously defined.
    ;*

   .If <AX ne 0ffffh>                     ; If NOT special HotKeyID ;@V2.0XXX03
     .If < HotKeyCount a 0 >              ; If count indicates entries
                                          ;  exist,
        Inc CL                            ; First entry now looked at.
       .While < CL na HotKeyCount > AND   ; Loop on each existing entry
       .While < [SI].HotKeyID ne AX >     ;  while there is NO ID match.
          Add SI, HKEntrySize             ; Next entry.
          Inc CL                          ; Bump index.
       .EndWhile                          ; End While entries remain or
                                          ;  ID's don't match.
       .If < CL a MaxHotKeyCt >           ; If index is above the max.
                                          ;  number allowed, then no
                                          ;  more entries are available.
          LES BX, Dword Ptr StkRPO        ; Restore request packet address.
          Mov ES:[BX+PktStatus],ParmError ; Indicate invalid parameter in RP
          Ret                             ; GET OUT NOW.
       .Endif                             ; End if beyond last entry.
     .Endif                               ; End if entries exist.

    ;*
    ;* At this point, DS:SI points to either a free hot key entry or an
    ;* entry that contains a matching hot key ID (which will be
    ;* overwritten). AX still contains the caller's hot key ID.
    ;*

      Mov  [SI].HotKeyID, AX              ; Ensure the ID is set.
      Mov  [SI].HotKeyShift, BX           ; Put shift state in the table
      Mov  AX, Word Ptr ES:[DI].HotKeyMake; Get BOTH scan code bytes
      Mov  Word Ptr [SI].HotKeyMake, AX   ;  for hot key and store in
                                          ;  the table.

     .If < CL e 0 > OR                    ; If the new entry is the 1st
     .If < CL a HotKeyCount >             ; or it's a new entry,
        Inc HotKeyCount                   ; Bump the count of entries.
     .Endif                               ; End if count needs to be
                                          ;  adjusted.

   .Endif                                 ; Endif AX ne FFFF

    And [OtherFlags],NOT (HotKeyDown+MHotKeyDown)    ;Clear down status.
    Sti                                   ; Allow interrupts now.
    Mov DI, StkPSG                        ; Restore PSG offset.
    LES BX, Dword Ptr StkRPO              ; Restore request packet addr.

 .Endif                                   ; PTM 3377:  End reserved bits @IBM
                                          ; check.
  Ret

SetSMHotKey Endp

BREAK <IOCTL 57h - Set Keyboard Control Block>
Public SetKCB
SetKCB Proc Far

;**********************************************************************
;*
;* FUNCTION NAME SetKCB
;*
;* DESCRIPTION   Determine which Keyboard Control Block (KCB)
;*               will be utilized by the current session.
;*
;*              This routine will switch KCBs for the IOCTL caller's
;*              session.  The new KCB's memory segment is locked.
;*              The search arguments to find the new KCB to use
;*              are the current PID and the handle specified
;*              by the IOCTL caller.
;*
;*
;* INPUT:
;*        REGISTERS:
;*
;*           AX = session caller is running in.
;*        ES:BX = Ptr to Request Block               DI = PSG address
;*
;*        The Request Packet contains the handle of the KCB to which
;*        to switch.
;*
;*        Local storage on the stack contains various saved segments
;*        and offsets.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The device
;*              driver will now utilize the desired KCB for the
;*              session.
;*
;* RETURN-NORMAL :
;*
;* EFFECTS:     AX, CX, DX, SI, DI are altered.  PSG variables are
;*              set.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (PhysToVirt, UnPhysToVirt)
;*
;***********************************************************************

  Test [DI].PSGFlags, SQMODE            ; DCR 8:   @IBM
 .If < nz >                             ; If in Single Queue Mode, indicate unknown
    LES   BX, Dword Ptr StkRPO          ; Restore request packet address.
    Mov   ES:[BX+PktStatus],CmdError    ; Indicate invalid parameter in RP
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if in Single Queue mode.

;*
;* The following makes sure there is enough time for breaks to be seen in
;* the same KCB as the makes were seen in before switching between other KCBs
;* without this block the ALT key was getting stuck down when exiting the TE2
;* emulator
;*

  Push  AX                              ; save original ax
  Cli                                   ; Start of ptr B724802   @IBM
  Mov  AX, [DI].Shiftflags              ; need to modify shiftflags
  And  AX, NOT (InsTogl+CapsTogl+NumTogl+ScrollTogl) ;clear LEDs toggle bits
  .While <AX ne 0>                      ; ptr B724802  While shift flags set @IBM

                                        ; want to block until enough time for
                                        ; for breaks in previous KCB to be seen
    Or IntFlags, KcbBlockSet            ; Set flag
    Pusha                               ; Save regs
    Mov   BX,offset KcbBlockId          ; Get Block ID
    Mov   KcbBlockId, BX                ; Save it
    Mov   AX,DS                         ; Get Block ID
    Mov   [KcbBlockId+2], AX            ; Save it
    Mov   CX,-1                         ; Indicate to...
    Mov   DI,CX                         ; ...never timeout.
    Xor   DH,DH                         ; Indicate okay to interrupt.
    Mov   DL,DevHlp_ProcBlock           ; Set ProcBlock DevHlp function.
    Call  [DeviceHelp]                 ; Go block the caller.
    Cli
    Popa                                ; Restore regs
    And IntFlags, NOT KcbBlockSet       ; Clear flag
    Mov AX, [DI].Shiftflags             ; use new state of shiftflags
    And AX, NOT (InsTogl+CapsTogl+NumTogl+ScrollTogl) ;clear LEDs toggle bits
  .EndWhile
  Sti
  Pop AX                                ; restore original ax END B724802   @IBM
                                        ; PTM 3829: @IBM
  Mov   CX,2                            ; Set length of table for parm check.
  Xor   SI,SI                           ; No data buffer parm checking.
  Call  IOCtlAddrCheck                  ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES  BX, ES:[BX+ParmListPtr]          ; Point to parm list area.
  Push Word Ptr ES:[BX]                 ; Save desired KCB handle a sec.

  Push 2222h                            ; Var2 (Not used for this call)
  Push 1111h                            ; Var1 (Not used for this call)
  Push DD_Cmd_Disable                   ; Function
  Call DD_Entry                         ; Device Independent Entry Point

  Mov SI, DI                            ; Put PSG offset in other index
                                        ;  register for this routine.
  Pop DX                                ; DX = Desired KCB handle.

 .If < DX e 0 > NEAR                    ; If the caller's handle = 0,
    Mov Word Ptr [SI].KCBAddress, 0     ; Indicate that the default KCB
                                        ; is to be used.
    Push DS                             ; Make ES:DI point to the sel:off
    Pop  ES                             ; of the default KCB,
    Mov  DI, SI                         ; for common
    Add  DI, DKCB                       ; processing later.

ifdef DBCSKBD
    ; Send logical keyboard change monitor packet                         ;@IBM JS06113(A)
    ;          (  not wait until packet is returned from monitor )        ;@IBM JS06113(A)
    ; Now KBD is disabled.                                                ;@IBM JS06113(A)
                                                                          ;@IBM JS06113(A)
    Mov SI,StkPSG                                                         ;@IBM JS06113(A)
   .If <[SI].MonsInstalled gt 0>    ;If mons registered try to pass key.  ;@IBM JS06113(A)
      Push SI                       ; save PSG                            ;@IBM JS06113(A)
      Push DI                       ; save KCB                            ;@IBM JS06113(A)
      Push CX                                                             ;@IBM JS06113(A)
      Push DX                                                             ;@IBM JS06113(A)
      Push AX                                                             ;@IBM JS06113(A)
      Mov  CX,ES:[DI].KCBShift                                            ;@IBM JS06113(A)
      Mov  AX,Word Ptr ES:[DI].KCBDBCSFl                                  ;@IBM JS06113(A)
      Mov  DI,SI                    ; set DI<-PSG                         ;@IBM JS06113(A)
      Mov SI,Offset DGROUP:KeyPacket1              ;Point to Key Packet   ;@IBM JS06113(A)
      Mov [SI].DDFlags,FocusChg                    ; set Focus Change     ;@IBM JS06113(A)
      Mov Word Ptr[SI].Key.XChar,DX                ; set handle           ;@IBM JS06113(A)
      Mov Word Ptr[SI].key.Status,00H              ; set active flag      ;@IBM JS06113(A)
      Mov Word Ptr[SI].key.Shift,CX                                       ;@IBM JS06113(A)
      Mov [SI].KPacketLen,0                        ; clear MonFlag        ;@IBM JS06113(A)
      Mov AX,[DI].MonHandle           ;Get monitor chain handle.          ;@IBM JS06113(A)
      ; Address of Key Packet already in SI, as required by DevHlp call   ;@IBM JS06113(A)
      Mov CX,KeyPacketLen             ;Set length of packet.              ;@IBM JS06113(A)
      Mov DH,1                        ;Don't wait for it to accept packet.;@IBM JS06113(A)
      Mov DL,DevHlp_MonWrite                                              ;@IBM JS06113(A)
      Call [DeviceHelp]                                                   ;@IBM JS06113(A)
      Pop AX                                                              ;@IBM JS06113(A)
      Pop DX                                                              ;@IBM JS06113(A)
      Pop CX                                                              ;@IBM JS06113(A)
      Pop DI                                                              ;@IBM JS06113(A)
      Pop SI                                                              ;@IBM JS06113(A)
     .If <c>                              ;Mon dispatcher accept packet?  ;@IBM JS06113(A)
        LES BX, Dword Ptr StkRPO          ;Restore request packet address.;@IBM JS06113(A)
        Mov ES:[BX+PktStatus],GenError    ;Set General command error      ;@IBM JS06113(A)
     .Endif                                                               ;@IBM JS06113(A)
   .Endif                                                                 ;@IBM JS06113(A)
endif ;DBCSKBD


 .ElseIf < <Word Ptr [SI].KCBFirst+2> ne 00h > NEAR ; If a KCB chain PTR 709460 @IBM
                                                    ; exists for this
                                                    ; session,

    ;* Search the chain for a match on the desired handle.

    Mov   BX, Word Ptr [SI].KCBFirst    ; Get the first KCB's address,
    Mov   AX, Word Ptr [SI].KCBFirst+2  ; and put in the needed regs.
                                        ; for upcoming PhysToVirts.

    And  MiscFlags2, Not KCB_FOUND2     ; Clear search flag.
    Test MiscFlags2, KCB_FOUND2         ; Clear zero flag for loop.

   .While < z > AND NEAR                ; While KCB not found, AND
   .While < AX ne 0 >                   ; PTR 709460 While not end of KCB chain, @IBM
      Push AX                           ; Save the Physical Address of
      Push BX                           ;  of the KCB on the stack.
      Push DX                           ; Save desired handle, too.
      Mov  CX, KCBSIZE                  ; Specify size of KCB for DevHlp.
      Mov  DH, ES_DI                    ; Specify receiving registers.
      Mov  DL, DevHlp_PhysToVirt        ; Specify DevHlp function.
      Call [DeviceHelp]                 ; ES:DI will contain address of
                                        ;  a KCB in the chain.
      Pop DX                            ; Restore desired handle.
     .If < ES:[DI].KCBHandle eq DX > AND  ;If this KCB has the desired
                                          ; handle, AND
      Mov AX, StkPID                    ; the Process ID's match, then
     .If < AX eq ES:[DI].KCBPID >       ;  we've found the desired KCB.
        Or MiscFlags2, KCB_FOUND2       ; Set the loop exit condition.
                                        ; NOTE: The stack contains
                                        ;  the physical address of the
                                        ;  matching KCB.
     .Else                              ; Handles do not match, so
        Pop BX                          ; Pop this KCB's physical
        Pop AX                          ;  address off the stack.
        Mov BX, Word Ptr ES:[DI].KCBNext        ; Get the physical address
        Mov AX, Word Ptr ES:[DI].KCBNext+2      ; of the next KCB to
                                                ; check.
        Mov SI, StkPSG                  ;Get PSG offset.
     .Endif
     Test MiscFlags2, KCB_FOUND2        ; Ready z flag for loop check.
   .EndWhile                            ; End search KCB for match.

    Mov SI, StkPSG                      ; Ensure SI = PSG offset.
                                        ; PTM 5627:  @IBM
    UnPhysToVirt                        ; Macro to undo PhysToVirts.

    Test MiscFlags2, KCB_FOUND2         ; Was the search successful?
   .If < nz > NEAR                      ; Yes, so                           ;@IBM JS06113(A) add NEAR
      Pop Word Ptr [SI].KCBAddress      ; Pop the matching KCB's
      Pop Word Ptr [SI].KCBAddress+2    ; physical address from the
                                        ; stack into the PSG for this
                                        ; session.
ifdef DBCSKBD
      ; Send logical keyboard change monitor packet                         ;@IBM JS06113(A)
      ;          (  not wait until packet is returned from monitor )        ;@IBM JS06113(A)
      ; Now KBD is disabled.                                                ;@IBM JS06113(A)
                                                                            ;@IBM JS06113(A)
      Mov SI,StkPSG                                                         ;@IBM JS06113(A)
     .If <[SI].MonsInstalled gt 0>    ;If mons registered try to pass key.  ;@IBM JS06113(A)
        Push SI                       ; save PSG                            ;@IBM JS06113(A)
        Push DI                       ; save KCB                            ;@IBM JS06113(A)
        Push CX                                                             ;@IBM JS06113(A)
        Push DX                                                             ;@IBM JS06113(A)
        Push AX                                                             ;@IBM JS06113(A)
        Mov  CX,ES:[DI].KCBShift                                            ;@IBM JS06113(A)
        Mov  AX,Word Ptr ES:[DI].KCBDBCSFl                                  ;@IBM JS06113(A)
        Mov  DI,SI                    ; set DI<-PSG                         ;@IBM JS06113(A)
        Mov SI,Offset DGROUP:KeyPacket1              ;Point to Key Packet   ;@IBM JS06113(A)
        Mov [SI].DDFlags,FocusChg                    ; set Focus Change     ;@IBM JS06113(A)
        Mov Word Ptr[SI].Key.XChar,DX                ; set handle           ;@IBM JS06113(A)
        Mov Word Ptr[SI].key.Status,00H              ; set active flag      ;@IBM JS06113(A)
        Mov Word Ptr[SI].key.Shift,CX                                       ;@IBM JS06113(A)
        Mov [SI].KPacketLen,0                        ; clear MonFlag        ;@IBM JS06113(A)
        Mov AX,[DI].MonHandle           ;Get monitor chain handle.          ;@IBM JS06113(A)
        ; Address of Key Packet already in SI, as required by DevHlp call   ;@IBM JS06113(A)
        Mov CX,KeyPacketLen             ;Set length of packet.              ;@IBM JS06113(A)
        Mov DH,1                        ;Don't wait for it to accept packet.;@IBM JS06113(A)
        Mov DL,DevHlp_MonWrite                                              ;@IBM JS06113(A)
        Call [DeviceHelp]                                                   ;@IBM JS06113(A)
        Pop AX                                                              ;@IBM JS06113(A)
        Pop DX                                                              ;@IBM JS06113(A)
        Pop CX                                                              ;@IBM JS06113(A)
        Pop DI                                                              ;@IBM JS06113(A)
        Pop SI                                                              ;@IBM JS06113(A)
       .If <c>                              ;Mon dispatcher accept packet?  ;@IBM JS06113(A)
          LES BX, Dword Ptr StkRPO          ;Restore request packet address.;@IBM JS06113(A)
          Mov ES:[BX+PktStatus],GenError    ;Set General command error      ;@IBM JS06113(A)
       .Endif                                                               ;@IBM JS06113(A)
     .Endif                                                                 ;@IBM JS06113(A)
endif ;DBCSKBD

      Push AX                           ; start PB732917  @IBM
      .If <bit [SI].PSGFlags z SQMODE>  ; DCR106: Check if we are in PM SG.
         Mov AX, ES:[DI].KCBShift       ; Put shift flags in AX
         Shr AX,4                       ; Move LED bits to low nibble
         And AX,7                       ; Turn off all unwanted bits

ifdef DBCSKBD
ifdef AX_KBD
         Test ES:[DI].KCBDBCSSh, KATAKANA                               ;@IBM J-AXKBD01(A)
        .If <nz>                ; If KATAKANA set Bit 3                 ;@IBM J-AXKBD01(A)
           Or AX,8              ; for KANA LED                          ;@IBM J-AXKBD01(A)
        .Endif                                                          ;@IBM J-AXKBD01(A)
endif ;AX_KBD
endif ;DBCSKBD

         Push 2222h                     ; Var2 (Not used for this call)
         Push AX                        ; Var1 (LED state)
         Push DD_Cmd_Indicators         ; Function
         Call DD_Entry                  ; Device Independent Entry Point
      .Endif                            ;
      Pop AX                            ; end pb732917      @IBM
   .Else                                ; Else no handle found, so
                                        ; PTR B706018 start  @IBM
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.
      Push 2222h                        ; Var2 (Not used for this call)
      Push 1111h                        ; Var1 (Not used for this call)
      Push DD_Cmd_Enable                ; Function
      Call DD_Entry                     ; Device Independent Entry Point
                                        ; PTR B706018 end   @IBM
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.
      Mov ES:[BX+PktStatus],GenError    ; Indicate invalid parameter in RP
      Ret                               ; Get Out Now.
                                        ; NOT RETURN.
   .Endif                               ; End successful search check.
 .Else                                  ; Default KCB didn't match, and
                                        ; there is no KCB Chain, so
                                        ; PTR B706018 start  @IBM
    LES  BX, Dword Ptr StkRPO           ; Restore request packet address.
    Push 2222h                          ; Var2 (Not used for this call)
    Push 1111h                          ; Var1 (Not used for this call)
    Push DD_Cmd_Enable                  ; Function
    Call DD_Entry                       ; Device Independent Entry Point
                                        ; PTR B706018 end @IBM
    LES  BX, Dword Ptr StkRPO           ; Restore request packet address.
    Mov  ES:[BX+PktStatus],GenError     ; Indicate invalid parameter in RP
    Ret                                 ; Get Out Now.
                                        ; NOT RETURN.
 .Endif                                 ; End various handle cases.

  Mov    DS, StkDS                      ; Restore DD's data segment.
  LES    BX, Dword Ptr StkRPO           ; Restore request packet address.
  Push   2222h                          ; Var2 (Not used for this call)
  Push   1111h                          ; Var1 (Not used for this call)
  Push   DD_Cmd_Enable                  ; Function
  Call   DD_Entry                       ; Device Independent Entry Point
  Ret

SetKCB Endp

BREAK <IOCTL 58h - Set In Use Code Page>

;********************************************************************
;*
;* FUNCTION NAME  SetInUseCP
;*
;* DESCRIPTION  Set the value of the code page index to be used
;*              by the caller's KCB.
;*
;*              This routine obtains the desired code page value from
;*              the caller, and searches the CPCB for a match.  The
;*              index of the matching entry then replaces the current
;*              CPCB index in the caller's KCB.
;*
;*
;* INPUT:
;*   REGISTERS:
;*
;*     ES:BX = Ptr to Request Block
;*        DI = PSG address
;*
;*        The PSG points to a KCB area which contains the code page
;*        index value to be used.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.
;*
;* RETURN-NORMAL :   A general error code is returned in the request
;*              packet if the desired code page cannot be found
;*              or if no optional code pages are available.
;*
;* EFFECTS:     AX, CX, DX, SI, DI altered.
;*              The IOCTL caller's parm list area is updated.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              UnLock_CustomCP         IOCtlAddrCheck
;*              SearchCPCB              AccessKCB
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (PhysToVirt, UnPhysToVirt)
;*
;**************************************************************************

Public SetInUseCP
SetInUseCP Proc Far

                                        ; PTM 3829:  @IBM
  Mov    CX,2                           ; Set length of table for parm check.
  Xor    SI,SI                          ; No data buffer parm checking.
  Call   IOCtlAddrCheck                 ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES   BX, ES:[BX+ParmListPtr]         ; Get caller's parm list.
  Mov   AX, ES:[BX]                     ; Get caller's code page value
  Mov   BX, ES:[BX+2]                   ; Save codepage layer value
  Test  CmdFlags, CP_ENABLED            ; This IOCTL is only valid if
 .If < nz > OR NEAR                     ; optional code pages exist, or
  .If < AX e 0 > NEAR                   ; caller specified HW default XT

   .If < AX e 0 > NEAR                  ; Caller specified default
      Mov CX, AX                        ; translate table, set register.
   .Else NEAR                           ; Caller did NOT specify default
                                        ; translate table, so

      ;Search the CPCB for a match on the desired code page value.

      Mov   ES,CBDataSel                ; Get selector for KIB/CPCB area.
      Mov   DI,CPCBOFFSET               ; Set up zero offset into CPCB

      Push  BX                          ; Save codepage layer value
      Call  SearchCPCB                  ; Search CPCB for match on desired
                                        ; code page in AX, ret'd in CX.
      Pop   BX                          ; Restore codepage layer value
     .If < c >                          ; Carry set if parm not found,
        Ret                             ; parm error already set. Get Out.
     .Endif

   .Endif                               ; End default XT check.

    ;*
    ;* At this point, CX contains the index of the desired CPCB entry.
    ;* BX contains the codepage layer value, CX may be adjusted below
    ;*

                                        ; DCR 408 Begin @IBM
   .If <BX eq Secondary>            ; If CP layer to use is secondary

      .If <bit MiscFlags nz MLayerMode> ;If Multi Layer CPis supported AND
         .If <CX eq Index1>         ; CP value is in in CPCB entry 1
             Mov CX, Index3         ; Bump CX to index 3
         .Else
             Mov CX, Index4         ; Bump CX to index 4
         .Endif
      .Endif                        ; End if CP layer to use is secondary
   .Endif                           ; Endif
                                    ; DCR 408 End @IBM

    Mov   DI, StkPSG                ; DI = PSG offset.
    Mov   DH, ES_DI                 ; Specify receiving registers.
    CALLFAR AccessKCB               ; ES:DI = caller's KCB.
    Mov   ES:[DI].KCBIxOffCP, CX        ; Place CPCB index in KCB.

ifdef DBCSKBD
    Push SI                                                             ;@IBM J-DBCS001(A)
    Push AX                             ; set caller's KbdHandle        ;@IBM J-DBCS001(A)
    Mov SI,Offset DGROUP:KeyPacket1     ; for monitor packet            ;@IBM J-DBCS001(A)
    Mov Word Ptr [SI].Key.Status,AX     ; AX= CP                        ;@IBM J-DBCS001(A)
    Mov AX,ES:[DI].KCBHandle            ; AX= keyboard handle           ;@IBM J-DBCS001(A)
    Mov Word Ptr [SI].Key.XChar,AX                                      ;@IBM J-DBCS001(A)
    Pop  AX                                                             ;@IBM J-DBCS001(A)
    Pop  SI                                                             ;@IBM J-DBCS001(A)
endif ;DBCSKBD

    Push  AX                            ; DCR 408, Save codepage value @IBM
    CALLFAR Unlock_CustomCP             ; Free custom code page for KCB,
    Pop   AX                            ; DCR 408, Restore codepage value @IBM
                                        ; if necessary. CF set if error.
   .If < c >                            ; CF=1 at this point means the
                                        ; unlock failed.
      Mov DI, StkPSG                    ; Restore PSG offset.
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.
      Mov ES:[BX+PktStatus],GenError    ; Indicate invalid parameter in RP
      Ret                               ; Get Out Now.
   .Endif                               ; End if unlock failed.

                                        ; DCR 408 Begin  @IBM
   .If <bit MiscFlags nz MLayerMode>    ; If Multi Layer codepage is supported
        Mov BX, CX                      ; Set BX to CX,it has index made active
        Mov CX, AX                      ; Set CX to AX,it has the codepage value
        Mov AX, 58h                     ; Set Ioctl parm
        Call NLS_Packet        ; Send NLS Notification packet down monitor chain
   .Endif                      ; End if Multi Layer codepage is supported
                                        ; DCR 408 End   @IBM

    LDS   DI, Dword Ptr StkPSG          ; 408 Restore callers psg addresses @IBM

ifdef DBCSKBD
    ; Send code page change monitor packet                              ;@IBM J-DBCS001(A)
    ;          (  not wait until packet is returned from monitor )      ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
   .If <[DI].MonsInstalled gt 0>  ;If mons registered try to pass key.  ;@IBM J-DBCS001(A)
        Push 2222h                      ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
        Push 1111h                      ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
        Push DD_Cmd_Disable             ; Function                      ;@IBM J-DBCS001(A)
        Call DD_Entry                   ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
        Push SI                                                         ;@IBM J-DBCS001(A)
        Push DI                                                         ;@IBM J-DBCS001(A)
        Push CX                                                         ;@IBM J-DBCS001(A)
        Push DX                                                         ;@IBM J-DBCS001(A)
        Push AX                                                         ;@IBM J-DBCS001(A)
;@IBM JS08511(D)        mov     cx,3                                            ;@IBM JS05061(A)
;@IBM JS08511(D)RetryMonWrite:                                                  ;@IBM JS05061(A)
;@IBM JS08511(D)        push    cx                                              ;@IBM JS05061(A)
        Test [DI].PSGFlags, Flushing    ;Check is this monitor is flushing  ;@IBM JS08511(A)
       .If <nz>                         ;                                   ;@IBM JS08511(A)
             Push DI                    ;Save PSG offset                    ;@IBM JS08511(A)
             Lea  BX, [DI].MonBlockID_F ;Get Blocker value...               ;@IBM JS08511(A)
             Mov  AX, DS                ;for use as Blocked Event           ;@IBM JS08511(A)
             Mov  CX, 1000              ;Timeout after 1000ms (DI:CX)       ;@IBM JS08511(A)
             Mov  DI, 0                 ;                                   ;@IBM JS08511(A)
             Mov  DH, 0                 ;DH = 0 = Interruptible block,      ;@IBM JS08511(A)
             Mov  DL, DevHlp_ProcBlock  ;DL = DevHlp function.              ;@IBM JS08511(A)
             Call [DeviceHelp]          ;Go block the monitor chain         ;@IBM JS08511(A)
             Pop DI                     ;Restore PSG offset                 ;@IBM JS08511(A)
       .Endif                           ;                                   ;@IBM JS08511(A)
        Mov SI,Offset DGROUP:KeyPacket1 ; Point to Key Packet.          ;@IBM J-DBCS001(A)
        Mov [SI].DDFlags,CPChg          ; set Focus Change              ;@IBM J-DBCS001(A)
        Mov [SI].KPacketLen,0           ; clear MonFlag                 ;@IBM J-DBCS001(A)
        Mov AX,[DI].MonHandle           ; Get monitor chain handle.     ;@IBM J-DBCS001(A)
        ;Address of Key Packet already in SI, as required by DevHlp call;@IBM J-DBCS001(A)
        Mov CX,KeyPacketLen             ; Set length of packet.         ;@IBM J-DBCS001(A)
        Mov DH,1                ; Don't wait for it to accept packet.   ;@IBM J-DBCS001(A)
        Mov DL,DevHlp_MonWrite  ; Set Monitor Write function.           ;@IBM J-DBCS001(A)
        Call [DeviceHelp]       ; Go pass Key to monitor dispatcher.    ;@IBM J-DBCS001(A)
;@IBM JS08511(D)        pop     cx                                              ;@IBM JS05061(A)
;@IBM JS08511(D)        .if <c>                                                 ;@IBM JS05061(A)
;@IBM JS08511(D)        mov     dl,DevHlp_TCYield                               ;@IBM JS05061(A)
;@IBM JS08511(D)        call    [DeviceHelp]                                    ;@IBM JS05061(A)
;@IBM JS08511(D)        loop    RetryMonWrite                                   ;@IBM JS05061(A)
;@IBM JS08511(D)        .endif                                                  ;@IBM JS05061(A)
        Pop AX                                                          ;@IBM J-DBCS001(A)
        Pop DX                                                          ;@IBM J-DBCS001(A)
        Pop CX                                                          ;@IBM J-DBCS001(A)
        Pop DI                                                          ;@IBM J-DBCS001(A)
        Pop SI                                                          ;@IBM J-DBCS001(A)
       .If <c>                  ; Did monitor dispatcher accept packet? ;@IBM J-DBCS001(A)
          LES BX, Dword Ptr StkRPO      ;Restore request packet address.;@IBM J-DBCS001(A)
          Mov ES:[BX+PktStatus],GenError;Set General command error      ;@IBM J-DBCS001(A)
       .Endif                                                           ;@IBM J-DBCS001(A)
        Push 2222h                      ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
        Push 1111h                      ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
        Push DD_Cmd_Enable              ; Function                      ;@IBM J-DBCS001(A)
        Call DD_Entry                   ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
endif ;DBCSKBD
    LES   BX, Dword Ptr StkRPO          ; Restore request packet address.

 .Else                                  ; Only the "hardware default"
                                        ; table exists at this time,
    LES   BX, Dword Ptr StkRPO          ; Restore request packet address.
    Mov   ES:[BX+PktStatus],ParmError   ; Indicate invalid parameter in RP
 .Endif                                 ; End optional code page check.

  Ret
SetInUseCP Endp


BREAK <IOCTL 59h - Set Read or Peek Notification>

;***********************************************************************
;*
;* FUNCTION NAME    SetReadNotify    (59H)   Cat. 4
;*
;* DESCRIPTION      Set Read/Peek Notification Flag
;*
;*        This IOCTL sets the Keyboard Device Driver Flags (DDFlags)
;*        to begin Read or Peek Notification along the monitor
;*        chain.  Read/Peek Notification is enabled only for the
;*        screen group of the caller.   The KBDD saves the PID of
;*        the first caller of this IOCTL in each screen group.
;*        The original caller will have to disable using this IOCTL
;*        to release control of the Read/Peek Not.   Until this is done
;*        all other PIDs calling this IOCTL will receive a BAD COMMAND
;*        error.
;*
;*
;* INPUT
;*         REGISTERS:
;*
;*         ES:BX = Ptr to Request Packet
;*
;*         The Request Packet contains 2 words.  The first indicating
;*         the screen group to be effected and the second a word of
;*         flags with the  following format:
;*
;*             Bit#   Meaning:
;*             ----   --------
;*             15-1   Reserved, set to 0.
;*
;*             0     Mask indicating whether to enable or disable
;*                   read notification:
;*                           0 = Disable read/peek notification.
;*                           1 = Enable read/peek notification.
;*
;* RETURN-NORMAL : Return to main Strategy processing.
;*
;* RETURN-NORMAL :  CmdError bit is set for the following:
;*                - Caller's PID is invalid.
;*                - Caller tried to enable or disable for SG 2.
;*
;* EFFECTS     registers and flags preserved.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              None
;*********************************************************************

Public SetReadNotify
SetReadNotify Proc Far

  Mov  CX,4                               ; Set parm list length.
  Xor  SI,SI                              ; No data buffer check.
  Call IOCtlAddrCheck                     ; Verify access to caller's areas
 .If < nc > NEAR                          ; If access is allowed
    LES   BX, ES:[BX+ParmListPtr]         ; Get address of parm list.
    Mov   AX, ES:[BX]                     ; Get the desired SG number.
   .If <AX lt 0> OR                       ; Make sure that the desired user
   .If <AX gt MaxSG> OR                   ; SG is within legal range.
   .If <AX eq Dos3xBoxSG>                 ; If SG is a VDM
      LES   BX, Dword Ptr StkRPO          ; Restore request packet address.
      Mov   ES:[BX+PktStatus],CmdError    ; Indicate invalid parameter in RP
   .Else                                  ; Else if this is not a VDM
      Mov   SI, AX                        ; Get the desired SG number.
      Shl   SI, 1                         ; Make it an offset.
      Mov   SI, [SI+PSGPointers]          ; Point to PSG for that SG.
      Mov   AX, StkPID                    ; Get caller's process ID.
      Test  [SI].NotifyFlags, SGEnabled   ; Check if Notification on for SG.
     .If <z>                              ; If it is NOT
         Mov   CX, ES:[BX+2]              ; Get user specified flags.
         Test  CX, Reserv0                ; Check if reserved bits are set.
        .If <z>                           ; If they are NOT, then we're OK.
            Mov [SI].NotifyPID, AX        ; Save caller's PID and
            Mov AX, ES:[BX+2]             ; notification flags in the PSG
            Mov Word Ptr DS:[SI].NotifyFlags, AX ; of the desired SG.
        .Else                             ; Else reserved bits are set
            LES BX, Dword Ptr StkRPO      ; Restore request packet address.
            Mov ES:[BX+PktStatus],ParmError ; Indicate invalid parameter in RP
        .Endif                            ; Endif reserved bits set.
     .Else                                ; Else Notification is already on
        Cmp AX, Word Ptr DS:[SI].NotifyPID; If caller's PID does NOT
       .If < nz >
            LES BX, Dword Ptr StkRPO      ; Restore request packet address.
            Mov ES:[BX+PktStatus],CmdError; Indicate invalid parameter in RP
       .Else                              ; Else caller's PID matched,so
            Mov CX, ES:[BX+2]             ; Get user specified flags.
            Test CX, Reserv0              ; Check if reserved bits are set.
           .If <z>                        ; If they are NOT, then we're OK.
               Mov AX, ES:[BX+2]          ; Save not. flags in the PSG
               Mov Word Ptr DS:[SI].NotifyFlags, AX  ; of desired SG.
           .Else                          ; Else reserved bits are set.
              LES BX, Dword Ptr StkRPO    ; Restore request packet address.
              Mov ES:[BX+PktStatus],ParmError ; Indicate invalid parameter in RP
           .Endif                         ; Endif reserved bits are set.
       .Endif
     .Endif                            ; Endif PIDs matched.
   .Endif                              ; Endif desired SG is a VDM.
 .Endif                                ; Endif access is allowed.
  Ret

SetReadNotify Endp

BREAK <IOCTL 5Ah - SetKbdLEDs>
Public SetKbdLEDs
SetKbdLEDs Proc Far

;**********************************************************************
;*
;* FUNCTION NAME   SetKbdLEDs     (5AH)   Cat. 4
;*
;* DESCRIPTION     Set Keyboard LED(s)
;*
;*             This IOCTL allows the Presentation Manager to alter the
;*             keyboard LED(s) without changing the operational state
;*             of the keyboard's mode of scan code.
;*
;* NOTES
;*             Since it is not possible to separate the keyboard's LED
;*             and operational state for the Ferrari P keyboard the
;*             Keyboard Device Driver will perform a functional no-op
;*             for IOCTL requests received when the Ferrari P is the
;*             attached system keyboard.  OS/2 supported keyboards
;*             which do not have LED(s) will be sent the appropriate
;*             LED state since the hardware does remember the logical
;*             LED state.
;*
;* INPUT
;*             REGISTERS:
;*
;*             ParmList Ptr field = input structure
;*
;*             The input structure contains 1 word.  The word is a bit
;*             mask indicating the new state for which each modified LED
;*             will be set to.
;*
;*                 Bit#   Meaning:
;*                 ----   --------
;*                 15-3   Reserved, set to 0.
;*
;*                 2      if set, Caps Lock LED turned on,
;*                        if clear, Caps Lock LED turned off
;*                 1      if set, Num Lock LED turned on,
;*                        if clear, Num Lock LED turned off
;*                 0      if set, Scroll Lock LED turned on,
;*                        if clear, Scroll Lock LED turned off
;*
;*                 note:  If any of the reserved bits are set an INVALID
;*                        PARAMETER error will be returned.
;*
;* RETURN-NORMAL :   Return to main Strategy processing.
;*
;* RETURN-NORMAL :    NONE
;*
;* EFFECTS:     registers are preserved.
;*              flags are preserved.
;*
;************************************************************************

  .if <VDMFocus eq 0>

    .If <bit [DI].PSGFlags nz SQMODE>      ; If in Single Queue Mode
;*       Mov   AX, Word Ptr KbdHWIDs         ; Get Keyboard ID bytes
;*       Ror   AX,8                          ; Swap AX
;*
;*
;*  PTR B720345 Removed check for Ferrari_p keyboard, to support ALOHA kbd @IBM
;* .If < AX ne FERRARI_P >            ;## Is this not a Ferrari-P Keyboard?@IBM
;*                                                                         @IBM

         Mov   CX, 2                     ; Set length of table for parm check.
         Xor   SI,SI                     ; No data buffer parm checking.
         Call  IOCtlAddrCheck            ; Verify read access to table.
        .If < nc >                       ; Carry set = access denied.
           LES   SI,ES:[BX+ParmListPtr]  ; Get address of parm list.
           Mov   AX,ES:[SI]              ; Get passed Shift flags word.
           Push  AX                      ; Save LED values for now.
           And   AX,0FFF8h               ; Check upper 5 bits for zeros.
          .If < AX ne 0 >                ; If invalid bit pattern in
             Pop AX                      ; Restore LED values
             LES BX, Dword Ptr StkRPO    ; Restore request packet address.
             Mov ES:[BX+PktStatus],ParmError ; Indicate invalid parameter in RP
             Ret                         ; Get Out Now.
          .Endif                         ; End if invalid parameter.
           Pop   AX                      ; Restore LED values
           Mov   ES, StkRPS              ; Restore request packet segment.
           Test  [DI].PSGFlags,ActiveSG  ; Check if this is the active SG.
          .If <nz>                       ; If so, update LEDs.
ifdef DBCSKBD
ifdef AX_KBD
             Mov LED_State,AL            ; get current LED state       ;@IBM J-AXKBD03(A)
endif ;AX_KBD
endif ;DBCSKBD
             Push 2222h                  ; Var2 (Not used for this call)
             Push AX                     ; Var1 (LED state)
             Push DD_Cmd_Indicators      ; Function
             Call DD_Entry               ; Device Independent Entry Point
          .Endif                         ; Misc. Request Block.
        .Endif                           ; End if no carry.
;     .Endif                             ; End if Ferrari Keyboard
    .Else                                ; Else we are NOT in SQ mode.
      LES BX, Dword Ptr StkRPO           ; Restore request packet address.
      Mov ES:[BX+PktStatus],CmdError     ; Indicate invalid parameter in RP
    .Endif                               ; End if not in Single Queue mode.

  .endif

  Ret

SetKbdLEDs Endp

ifdef DBCSKBD
ifdef AX_KBD
BREAK <IOCTL DAh - SetKanaLED>                                          ;@IBM J-AXKBD11(A)
Public SetKanaLED                                                       ;@IBM J-AXKBD11(A)
SetKanaLED Proc Far                                                     ;@IBM J-AXKBD11(A)
;******************************************************************     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* SUBROUTINE NAME:      SetKanaLED     (DAH)   Cat. 4            *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* DESCRIPTIVE NAME:     Set Kana LED                             *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* FUNCTION:                                                      *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*  This IOCTL allows the Presentation Manager to alter the       *     ;@IBM J-AXKBD11(A)
;*  KANA LED without changing the operational state               *     ;@IBM J-AXKBD11(A)
;*  of the keyboard's mode of scan code.                          *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* NOTES:                                                         *     ;@IBM J-AXKBD11(A)
;*  - Since it is not possible to separate the keyboard's LED     *     ;@IBM J-AXKBD11(A)
;*    and operational state for the Ferrari P keyboard the        *     ;@IBM J-AXKBD11(A)
;*    Keyboard Device Driver will perform a functional no-op      *     ;@IBM J-AXKBD11(A)
;*    for IOCTL requests received when the Ferrari P is the       *     ;@IBM J-AXKBD11(A)
;*    attached system keyboard.  OS/2 supported keyboards         *     ;@IBM J-AXKBD11(A)
;*    which do not have LED(s) will be sent the appropriate       *     ;@IBM J-AXKBD11(A)
;*    LED state since the hardware does remember the logical      *     ;@IBM J-AXKBD11(A)
;*    LED state.                                                  *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* ENTRY POINT: SetKanaLED    LINKAGE:   Far                      *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* INPUT:                                                         *     ;@IBM J-AXKBD11(A)
;*   REGISTERS:                                                   *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*   ParmList Ptr field = input structure                         *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*   The input structure contains 1 word.  The word is a bit      *     ;@IBM J-AXKBD11(A)
;*   mask indicating the new state for which each modified LED    *     ;@IBM J-AXKBD11(A)
;*   will be set to.                                              *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*       Bit#   Meaning:                                          *     ;@IBM J-AXKBD11(A)
;*       ----   --------                                          *     ;@IBM J-AXKBD11(A)
;*       15-4   Reserved, set to 0.                               *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*       3      if set, Katakan Lock LED turned on,               *     ;@IBM J-AXKBD11(A)
;*              if clear, Katakana Lock LED turned off            *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*       2-0    Reserved, set to 0.                               *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;*       note:  If any of the reserved bits are set an INVALID    *     ;@IBM J-AXKBD11(A)
;*              PARAMETER error will be returned.                 *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* EXIT-NORMAL: Return to main Strategy processing.               *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* EXIT-ERROR:                                                    *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* EFFECTS:     registers are preserved.                          *     ;@IBM J-AXKBD11(A)
;*              flags are preserved.                              *     ;@IBM J-AXKBD11(A)
;* INTERNAL REFERENCES:                                           *     ;@IBM J-AXKBD11(A)
;*    ROUTINES:                                                   *     ;@IBM J-AXKBD11(A)
;*                                                                *     ;@IBM J-AXKBD11(A)
;* EXTERNAL REFERENCES:                                           *     ;@IBM J-AXKBD11(A)
;*    ROUTINES:                                                   *     ;@IBM J-AXKBD11(A)
;*              None                                              *     ;@IBM J-AXKBD11(A)
;*************** END OF SPECIFICATIONS ****************************     ;@IBM J-AXKBD11(A)

  .if <VDMFocus eq 0>                                                                ;@IBM J-AXKBD11(A)
                                                                                     ;@IBM J-AXKBD11(A)
    .If <bit [DI].PSGFlags nz SQMODE>      ; If in Single Queue Mode                 ;@IBM J-AXKBD11(A)
;*       Mov   AX, Word Ptr KbdHWIDs         ; Get Keyboard ID bytes                 ;@IBM J-AXKBD11(A)
;*       Ror   AX,8                          ; Swap AX                               ;@IBM J-AXKBD11(A)
;*                                                                                   ;@IBM J-AXKBD11(A)
;*                                                                                   ;@IBM J-AXKBD11(A)
;*  PTR B720345 Removed check for Ferrari_p keyboard, to support ALOHA kbd @IBM      ;@IBM J-AXKBD11(A)
;* .If < AX ne FERRARI_P >            ;## Is this not a Ferrari-P Keyboard?@IBM      ;@IBM J-AXKBD11(A)
;*                                                                         @IBM      ;@IBM J-AXKBD11(A)

         Mov   CX, 2                     ; Set length of table for parm check.       ;@IBM J-AXKBD11(A)
         Xor   SI,SI                     ; No data buffer parm checking.             ;@IBM J-AXKBD11(A)
         Call  IOCtlAddrCheck            ; Verify read access to table.              ;@IBM J-AXKBD11(A)
        .If < nc >                       ; Carry set = access denied.                ;@IBM J-AXKBD11(A)
           LES   SI,ES:[BX+ParmListPtr]  ; Get address of parm list.                 ;@IBM J-AXKBD11(A)
           Mov   AX,ES:[SI]              ; Get passed Shift flags word.              ;@IBM J-AXKBD11(A)
           Push  AX                      ; Save LED values for now.                  ;@IBM J-AXKBD11(A)
           And   AX,0FFF7h               ; Check upper 4 bits and lower 3 bits  for zeros. ;@IBM J-AXKBD11(A)
          .If < AX ne 0 >                ; If invalid bit pattern in                 ;@IBM J-AXKBD11(A)
             Pop AX                      ; Restore LED values                        ;@IBM J-AXKBD11(A)
             LES BX, Dword Ptr StkRPO    ; Restore request packet address.           ;@IBM J-AXKBD11(A)
             Mov ES:[BX+PktStatus],ParmError ; Indicate invalid parameter in RP      ;@IBM J-AXKBD11(A)
             Ret                         ; Get Out Now.                              ;@IBM J-AXKBD11(A)
          .Endif                         ; End if invalid parameter.                 ;@IBM J-AXKBD11(A)
           Pop   AX                      ; Restore LED values                        ;@IBM J-AXKBD11(A)
           Mov   ES, StkRPS              ; Restore request packet segment.           ;@IBM J-AXKBD11(A)
           Test  [DI].PSGFlags,ActiveSG  ; Check if this is the active SG.           ;@IBM J-AXKBD11(A)
          .If <nz>                       ; If so, update LEDs.                       ;@IBM J-AXKBD11(A)
;          Push  AX
;          Mov   AX,ES:[SI]              ; Get passed Shift flags word.
;          Mov   CL,AL
;          Pop   AX
              Mov CL,LED_State                                                       ;@IBM J-AXKBD03(A)
              And CL,07h                  ; Mask for Num & Caps & Scrl LED bits.     ;@IBM J-AXKBD03(A)
              Or  AL,CL                                                              ;@IBM J-AXKBD03(A)
             Push 2222h                  ; Var2 (Not used for this call)             ;@IBM J-AXKBD11(A)
             Push AX                     ; Var1 (LED state)                          ;@IBM J-AXKBD11(A)
             Push DD_Cmd_Indicators      ; Function                                  ;@IBM J-AXKBD11(A)
             Call DD_Entry               ; Device Independent Entry Point            ;@IBM J-AXKBD11(A)
          .Endif                         ; Misc. Request Block.                      ;@IBM J-AXKBD11(A)
        .Endif                           ; End if no carry.                          ;@IBM J-AXKBD11(A)
;     .Endif                             ; End if Ferrari Keyboard                   ;@IBM J-AXKBD11(A)
    .Else                                ; Else we are NOT in SQ mode.               ;@IBM J-AXKBD11(A)
      LES BX, Dword Ptr StkRPO           ; Restore request packet address.           ;@IBM J-AXKBD11(A)
      Mov ES:[BX+PktStatus],CmdError     ; Indicate invalid parameter in RP          ;@IBM J-AXKBD11(A)
    .Endif                               ; End if not in Single Queue mode.          ;@IBM J-AXKBD11(A)
  .endif                                                                             ;@IBM J-AXKBD11(A)
  Ret                                                                                ;@IBM J-AXKBD11(A)
SetKanaLED Endp                                                                      ;@IBM J-AXKBD11(A)
endif ;AX_KBD
endif ;DBCSKBD

BREAK <IOCTL 5Ch - Set Code Page>

;**********************************************************************
;*
;* FUNCTIONNAME SetCodePage
;*
;* DESCRIPTION  Copy the IOCTL caller's code page into the
;*              appropriate code page area of the device driver.
;*
;*              The IOCTL caller provides a desired code page number
;*              and the code page to replace the existing one.       *
;*              The routine obtains this data (via a Request Packet
;*              parm list pointer), indexes into the CPCB which
;*              contains the desired code page, and copies the
;*              desired code page number into the CPCB (if the field
;*              is zero)
;*
;*              A desired code page number of -1 indicates that the
;*              code page to be used is a custom (as opposed to
;*              optional) code page.  In this case, the caller's
;*              data area is locked, a flag is set in the KCB to
;*              indicate a custom code page is being used, and the
;*              address of the translate table is saved in the KCB.
;*
;*     NOTE     This routine only replaces the optional code page
;*              data areas and NOT the "hardware default" code page,
;*              which is replaced with IOCTL 50h (Set Translate
;*              Table).
;*
;*
;* INPUT:
;*         REGISTERS:
;*
;*              AX = session caller is running in.
;*           ES:BX = Ptr to Request Block               DI = PSG offset
;*
;*              The Request Packet contains the following, in order:
;*
;*                - Selector:Offset of the translate table to be copied.
;*                - Word containing the code page number of the table.
;*                - Word containing the index into the CPCB.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The device
;*              driver will now utilize the new code page for
;*              translation as needed.
;*
;* RETURN-NORMAL :   NONE
;*
;* EFFECTS:     The appropriate entry of the CPCB is altered.  The
;*              code page that the CPCB entry points to is updated
;*              with the new table.
;*
;*              The KCB CPCB index is possibly changed.
;*
;*              The address areas used by the interrupt handler are
;*              possibly updated.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              AccessKCB
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (Lock, UnLock, VirtToPhys, PhysToVirt,
;*              UnPhysToVirt, VerifyAccess)
;*
;************************************************************************

Public SetCodePage
SetCodePage Proc Far

  Mov   CX,8                             ; Set length of table for parm check.
  Xor   SI,SI                            ; No data buffer parm checking.
  Call  IOCtlAddrCheck                   ; Verify read access to table.
 .If < c >                               ; Carry set = access denied.
    Ret                                  ; Get Out Now.
 .Endif                                  ; End if access denied.

  LES   BX,ES:[BX+ParmListPtr]           ; Get address of parm list.
  Mov   CX,ES:[BX+4]                     ; Get caller's code page value
  Mov   SI,ES:[BX+6]                     ; Get CPCB index of code page
  Mov   DI,Word Ptr ES:[BX]              ; Save the address of the
  Mov   StkTmpL, DI                      ; caller's translate
  Mov   AX, Word Ptr ES:[BX+2]           ; table in
  Mov   StkTmpH, AX                      ; local storage.

  ;*
  ;* DCR 1546  @IBM
  ;* First verify we can read XTLen (1251) bytes of the translation table.
  ;*

  Push CX                                ; Save desired code page value.
  Mov  CX, XTLen                         ; Use default translation table size
  Mov  DH, 0                             ; Read access desired.
  Mov  DL, DevHlp_VerifyAccess           ; Set DevHlp function.
  Call DeviceHelp                        ; Go verify access to table.
  Pop  CX                                ; Restore desired CP value.
 .If < c >                               ; Carry set from DevHlp = access
    LES BX, Dword Ptr StkRPO             ; Restore request packet address.
    Mov ES:[BX+PktStatus],ParmError      ; Indicate invalid parameter in RP
    Ret                                  ; Get Out Now.
 .Endif                                  ; End if access denied.

  ;*
  ;* DCR 1546   @IBM
  ;* Now we know 1251 bytes are readable.  If this is a extended translation
  ;* table we must verify access to its larger length.  Note we now know that
  ;* we can read this information from callers address but couldn't do this
  ;* until we did a verifyaccess above.  "catch 22".
  ;*

  Push  CX                               ; Save desired code page value.
  Push  SI                               ; Save CPCB index
  LES   SI, Dword Ptr StkTmpL            ; Get caller's sel/off from
  Mov   cx, ES:[SI].XTLength             ; Get the length, may be > 1251
 .If < cx gt XTLen >                     ; If length greater than 1251 bytes
                                         ; We have xtended table,verify access
    Mov DH, 0                            ; Read access desired.
    Mov DL, DevHlp_VerifyAccess          ; Set DevHlp function.
    Call DeviceHelp                      ; Go verify access to table.
   .If < c >                             ; Carry set from DevHlp = access
      Pop CX                             ; Clean up stack, I hate when
      Pop SI                             ; this happens......
      LES BX, Dword Ptr StkRPO           ; Restore request packet address.
      Mov ES:[BX+PktStatus],ParmError    ; Indicate invalid parameter in RP
      Ret                                ; Get Out Now.
   .Endif                                ; End if access denied.
 .Endif                                  ; Endif
  Pop SI                                 ; Get CPCB index
  Pop CX                                 ; Restore desired CP value.

  ;Lock the caller's translate table, since we may yield (DCR002).

 .If < SI ne -1 >                        ; If NOT a custom code page,
    Xor BX, BX                           ; BH = Short-term lock.
                                         ; BL = Block till locked.
 .Else                                   ; A custom code page is desired,
    Mov BX, 0100h                        ; BH = Long-term lock.
                                         ; BL = Block till locked.
 .Endif                                  ; End custom code page check.
                                         ; (AX already set above)
  Push AX                                ; PTM 3892: Save segment for locking.@IBM
  Push SI                                ; PTM 3892: Save register for error  @IBM
                                         ; checking.
  Mov DL, DevHlp_Lock                    ; Set DevHlp function.
  Call [DeviceHelp]                      ; AX:BX = Lock handle.
  Pop SI                                 ; PTM 3892: BEGIN @IBM
  Pop DX                                 ; Pop off saved segment or selector.
 .If < c >                               ; If there was an error
    .If < SI e -1 >                      ; If the previous call was long term.
                                         ; then try to do a short term LOCK.
        Clc                              ; Clear the carry flag for next call.
        Mov AX, DX                       ; Restore segment for another try.
        Xor BX, BX                       ; BH = Short-term lock.
                                         ; BL = Block till locked.
        Mov DL, DevHlp_Lock              ; Set DevHlp function.
        Call [DeviceHelp]                ; AX:BX = Lock handle.
       .If < c >                         ; Carry indicates error.
          LES BX, Dword Ptr StkRPO       ; Restore request packet address.
          Mov ES:[BX+PktStatus],GenError ; Indicate invalid parameter in RP
          Ret                            ; Get Out Now.
       .Endif                            ; Endif the short term LOCK failed.
    .Else                                ; Else there was an error on the
                                         ; the initial short term lock,
       LES BX, Dword Ptr StkRPO          ; Restore request packet address.
       Mov ES:[BX+PktStatus],GenError    ; Indicate invalid parameter in RP
       Ret                               ; Get Out Now.
    .Endif                               ; Endif previous call was for custom.
 .Endif                                  ; PTM 3892: END. @IBM

  Push    AX                             ; Save the lock handle on the
  Push    BX                             ; stack. It will be popped in
                                         ; any path taken below.
  LDS     DI, Dword Ptr StkPSG           ; Restore caller's PSG address.
  Push    2222h                          ; Var2 (Not used for this call)
  Push    1111h                          ; Var1 (Not used for this call)
  Push    DD_Cmd_Disable                 ; Function
  Call    DD_Entry                       ; Device Independent Entry Point

 .If < SI ne -1 > NEAR                   ; NOT custom code page?

   .If < SI ae EntryCount > OR           ; Is the index value invalid?
   .If < SI eq Index0>                   ; DCR 408, If default CPCB index @IBM
      Jmp SetCPFailed                    ; Restore stack and get out.
   .Endif                                ; End if index value is invalid.

ifdef DBCSKBD
    ; Save the this system's DBCS Code Page Value in dbcs_cp            ;@IBM J-DBCS001(A)
   .If <dbcs_cp e 0>                    ;ONLY 1st time !!!              ;@IBM J-DBCS001(A)
     .If <cx e CP_TAIWAN> OR                                            ;@IBM J-DBCS001(A)
     .If <cx e CP_TAIWAN_2>                                             ;@IBM J-DBCS001(A)
        mov dbcs_cp,CP_TAIWAN                                           ;@IBM J-DBCS001(A)
     .Endif                                                             ;@IBM J-DBCS001(A)
     .If <cx e CP_KOREA> OR                                             ;@IBM J-DBCS001(A)
     .If <cx e CP_KOREA_2>                                              ;@IBM J-DBCS001(A)
        mov dbcs_cp,CP_KOREA                                            ;@IBM J-DBCS001(A)
     .Endif                                                             ;@IBM J-DBCS001(A)
     .If <cx e CP_JAPAN> OR                                             ;@IBM J-DBCS001(A)
     .If <cx e CP_JAPAN_2>                                              ;@IBM J-DBCS001(A)
        mov dbcs_cp,CP_JAPAN                                            ;@IBM J-DBCS001(A)
     .Endif                                                             ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
endif ;DBCSKBD

                                         ; DCR 408 Begin     @IBM
    LES    BX, Dword Ptr StkTmpL         ; Get sel/off of translate table
                                         ; Now check index & XTable Header
Public Tables
Tables:

   .If <bit ES:[BX].XTFlags1 nz LayeredCP>   ; If a double layer codepage AND
     .If <bit ES:[BX].XTFlags1 nz LayeredTbl>; If codepage secondary layer
        .If <SI eq Index2> OR              ; If index to load is 2  OR
        .If <SI eq Index3> OR              ; If index to load is 3  OR
        .If <SI eq Index4>                 ; If index to load is 4
           Call CopyXTable                 ; Copy in the Caller's Xlation Table.
          .If < c >                        ; If carry set
             jmp VMFailure                 ; We had a Virtual Memory Failure
          .Endif                           ; Endif
        .Else                              ; Else error.
           Jmp SetCPFailed                 ; Restore stack and get out.
        .Endif                             ; Endif index to load is 3
     .Else                                 ; Else primary layer
        .If <SI eq Index1> OR              ; If index to load is 1 OR
        .If <SI eq Index2>                 ; If index to load is 2
           Call CopyXTable                 ; Copy in the Caller's Xlation Table
          .If < c >                        ; If carry set
             jmp VMFailure                 ; We had a Virtual Memory Failure
          .Endif                           ; Endif
        .Else                              ; Else error.
           Jmp SetCPFailed                 ; Restore stack and get out.
        .Endif                             ; Endif index to load is 1
     .Endif                                ;
     .If <c>                               ; If carry set
         Pop BX                            ; Restore the lock handle of
         Pop AX                            ; the caller's table.
         Mov DL, DevHlp_UnLock             ; Set DevHlp function
         Call DeviceHelp                   ; Unlock the caller's table.
         LDS DI, Dword Ptr StkPSG          ; Restore caller's PSG addresss.
         Push 2222h                        ; Var2 (Not used for this call)
         Push 1111h                        ; Var1 (Not used for this call)
         Push DD_Cmd_Enable                ; Function
         Call DD_Entry                     ; Device Independent Entry Point
         LES BX, Dword Ptr StkRPO          ; Restore request packet address.
         Mov ES:[BX+PktStatus],GenError    ; Indicate general error
         Ret                               ; Get Out Now.
     .Endif                                ; Endif carry set
   .Else                                   ; Else non-layered codepage.
     .If <SI eq Index1> OR                 ; If index to load is 1 OR
     .If <SI eq Index2>                    ; If index to load is 2
           Call CopyXTable                 ; Copy in the Caller's Xlation Table
          .If < c >                        ; If carry set
             jmp VMFailure                 ; We had a Virtual Memory Failure
          .Endif                           ; Endif
     .Else                                 ; Else error.
        Jmp SetCPFailed                    ; Restore stack and get out.
     .Endif                                ; Endif non-layered codepage.
   .Endif                                  ; Endif
                                           ; DCR 408 End   @IBM

     Pop   BX                              ; Restore Lock handle.
     Pop   AX                              ; Restore Lock handle.
     Mov   DL, DevHlp_UnLock               ; Set DevHelp function.
     Call  [DeviceHelp]                    ; go do it.

                                           ; DCR 408 Begin @IBM
    Mov   ES, CBDataSel                    ; Get Sel of CPCB
    Mov   DI, CPCBOffset + CPCBEntrySize   ; Get offset of CPCB[1]
    Push  ES                               ; Save sel of CPCB
    Push  DI                               ; Save offset of CPCB[1]
    Mov   ES, Word Ptr ES:[DI].CPVaddr     ; Get Selector of XTable
    Xor   DI,DI                            ; Clear offset to 0
    Test  ES:[DI].XTFlags1, LayeredCP      ; Test if XTable has DLayered codepage
    Pop   DI                               ; Restore offset of CPCB[1]
    Pop   ES                               ; Restore sel of CPCB
   .If <nz>                                ; If codepage is Double Layered
      Add DI, CPCBEntrySize                ; Get offset of...
      Add DI, CPCBEntrySize                ; ....... CPCB[3].
     .If <<Word Ptr ES:[DI].CPVaddr> ne 0> ; If XTable memory has been allocated
         Mov ES, Word Ptr ES:[DI].CPVAddr  ; Get XTable selector
         Xor DI,DI                         ; Clear offset to 0
         Test ES:[DI].XTFlags1, LayeredCP  ; Test if XTable has DLayered codepage
        .If <nz>                           ; If codepage is Double Layered
           Or MiscFlags, MLayerMode        ; Multi Layer codepage is supported
        .Endif                             ; Endif
     .Endif                                ; Endif XTable memory allocated
   .Else                                   ; Else
        And MiscFlags, Not MLayerMode      ; MLayer codepage is NOT supported
   .Endif                                  ; Endif codepage is layered
                                           ; DCR 408 End     @IBM
 .Else NEAR

    Mov SI, DI                             ; Put PSG offset in other index
                                           ; register.

    ;Get KCB for caller's session.

    Mov DH, ES_DI                          ; Specify receiving registers.
    CALLFAR AccessKCB                      ; ES:DI will point to the
                                           ; caller's KCB.
    Or ES:[DI].KCBFlags, CUSTOMCP          ; Indicate in the KCB that a
                                           ; custom table is being used.

  ;*********** REMOVED FOR B733926  ***********************  @IBM
  ; ;* Copy virtual address to caller's KCB.  The caller's table address
  ; ;* has already been locked (long-term) and saved in local storage.
  ;
  ; Mov    AX, StkTmpL                      ; Get offset of caller's table
  ; Mov    Word Ptr ES:[DI].KCBIxOffCP, AX  ; and save in KCB.
  ; Mov    AX, StkTmpH                      ; Do the same with the
  ; Mov    Word Ptr ES:[DI].KCBCustSel, AX  ; selector value.
  ;
  ; ;* Save Lock Handle in caller's KCB. Lock Handle was pushed before
  ; ;* entrance to the IF block.
  ;
  ; Pop    Word Ptr ES:[DI].KCBCustCPLH     ;Save low lock handle in KCB.
  ; Pop    Word Ptr ES:[DI].KCBCustCPLH+2   ;Save hi lock handle in KCB.
  ;
  ;                                         ; PTR B708333 removed test.@IBM
  ; Mov    ES, StkDS                        ; ES = DD's data segment.
  ; LDS    SI, Dword Ptr StkTmpL            ; Get custom code page virt. addr
  ; Mov    DL, DevHlp_VirtToPhys            ; Set DevHlp function.
  ; Call   ES:[DeviceHelp]                  ; AX:BX will = Physical address
  ;                                         ; of caller's translate table.
  ; Mov    DS, StkDS                        ; Restore DD's data seg.
  ;.If < c >                                ; Carry set = error,
  ;                                         ; Unlock segment ???
  ;    LES BX, Dword Ptr StkRPO             ; Restore request packet address.
  ;    Mov ES:[BX+PktStatus],GenError       ; Indicate invalid parameter in RP
  ;    Ret                                  ; Get Out Now.
  ;.Endif                                   ; End if VirtToPhys error.
  ; Push   AX                               ; Save the physical address
  ; Push   BX                               ; for a bit.
  ; Mov    DH, ES_DI                        ; Set receiving regs. for DevHlp.
  ; Mov    DI, StkPSG                       ; Put PSG offset in position.
  ; CALLFAR AccessKCB                       ; ES:DI = caller's KCB.
  ; Pop Word Ptr ES:[DI].KCBCPPhysAddr      ; Put saved physical address
  ; Pop Word Ptr ES:[DI].KCBCPPhysAddr+2    ; in the caller's KCB.
  ; UnPhysToVirt                            ; Invoke macro per spec.
  ;
  ;********* REMOVE FOR B733926  **************************

  ;******** BEGIN B733926 ***************************************** @IBM
    Call   CopyCustom                     ; Load custom translate table
    Pop    BX                             ; Restore Lock handle.
    Pop    AX                             ; Restore Lock handle.
    Mov    DL, DevHlp_UnLock              ; Set DevHelp function.
    Call   [DeviceHelp]                   ; Unlock the callers memory
  ;******** END  B733926 ****************************************** @IBM
 .Endif                                  ; End custom translate table check.

                                         ; DCR 408 Begin   @IBM
  LES   BX, Dword Ptr StkRPO             ; Restore request packet address.
  LES   BX,ES:[BX+ParmListPtr]           ; Get address of parm list.
 .IF <bit MiscFlags nz MLayerMode>       ; If Multi Layer codepage is supported
      Mov  AX, 5Ch                       ; Set Ioctl parm
      Mov  CX, ES:[BX+4]                 ; Set codepage value
      Mov  BX, ES:[BX+6]                 ; Set index made active
      Call NLS_Packet                    ; Send NLS Notification packet down monitor chain
 .Endif                                  ; End if Multi Layer codepage is supported
                                         ; DCR 408 End      @IBM

  LDS    DI, Dword Ptr StkPSG            ; Restore caller's PSG addresss.
  Push   2222h                           ; Var2 (Not used for this call)
  Push   1111h                           ; Var1 (Not used for this call)
  Push   DD_Cmd_Enable                   ; Function
  Call   DD_Entry                        ; Device Independent Entry Point
  LES    BX, Dword Ptr StkRPO            ; Restore request packet offset.

  Ret                                    ; End non-error path SetCodePage.


SetCPFailed:                             ; Jumped to if something erred.
  Pop    BX                              ; Restore the lock handle of
  Pop    AX                              ; the caller's table.
  Mov    DL, DevHlp_UnLock               ; Set DevHlp function
  Call   DeviceHelp                      ; Unlock the caller's table.
                                         ; DCR 408 Begin   @IBM
  LDS DI, Dword Ptr StkPSG               ; Restore caller's PSG addresss.
  Push 2222h                             ; Var2 (Not used for this call)
  Push 1111h                             ; Var1 (Not used for this call)
  Push DD_Cmd_Enable                     ; Function
  Call DD_Entry                          ; Device Independent Entry Point
  LES BX, Dword Ptr StkRPO               ; Restore request packet offset.
  Mov ES:[BX+PktStatus],ParmError        ; Indicate invalid parameter in RP
                                         ; DCR 408 End  @IBM
  Ret                                    ; Get Out Now.

Public VMFailure                         ; DCR 1546         @IBM
VMFailure:                               ; Jumped to if something erred.
  Pop   BX                               ; Restore the lock handle of
  Pop   AX                               ;  the caller's table.
  Mov   DL, DevHlp_UnLock                ; Set DevHlp function
  Call  DeviceHelp                       ; Unlock the caller's table.
  LDS   DI, Dword Ptr StkPSG             ; Restore caller's PSG addresss.
  Push  2222h                            ; Var2 (Not used for this call)
  Push  1111h                            ; Var1 (Not used for this call)
  Push  DD_Cmd_Enable                    ; Function
  Call  DD_Entry                         ; Device Independent Entry Point
  LES   BX, Dword Ptr StkRPO             ; Restore request packet offset.
  Mov   ES:[BX+PktStatus],GenError       ; VMFree or VMAlloc General error
  Ret                                    ; Get Out.

SetCodePage Endp


BREAK <IOCTL 5Dh - Create Keyboard>

;************************************************************************
;*
;* FUNCTION NAME   CreateKbd
;*
;* DESCRIPTION     Allocate memory for a logical keyboard.
;*
;*                 This routine obtains physical memory for a new
;*                 logical keyboard (i.e., a KCB).  It is placed into
;*                 a linked list, and the PSG for this session is
;*                 updated, if necessary.  The caller PID and a handle
;*                 passed by the caller is stored in the KCB for use
;*                 later by the Set KCB IOCTL (57h).
;*
;* NOTE            A KCB is NOT created if the desired handle is ZERO.
;*                 This routine is only called in protect mode.
;*
;*
;* INPUT:
;*          REGISTERS:
;*
;*            ES:BX = Ptr to Request Block
;*               DI = PSG address
;*
;*               The Request Block contains the handle to be saved into
;*               the newly created KCB, and the code page value to which
;*               to set the KCB (PTM 269).
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The Per session
;*              Data Area is modified.  Physical memory is allocated.
;*              Other existing KCB link pointers are updated.
;*
;* RETURN-ERROR :  NONE
;*
;* EFFECTS:     AX, CX, DX, SI, DI altered.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              IOCtlAddrCheck  SearchCPCB
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (VMAlloc, PhysToVirt, UnPhysToVirt)
;*
;**************************************************************************

Public CreateKbd
CreateKbd Proc Far
.386p
  Push ECX                                  ;PB732916    @IBM
.286p

  Test [DI].PSGFlags, SQMODE                ; if in Single Queue ;DCR 8 @IBM
 .If < nz >                                 ; Mode, indicate unknown
    LES BX, Dword Ptr StkRPO                ; Restore request packet address.
    Mov ES:[BX+PktStatus],CmdError          ; Indicate invalid parameter in RP
.386p
    Pop ECX                                 ;PB732916   @IBM
.286p
    Ret                                     ; Get Out Now.
 .Endif                                     ; End if in Single Queue mode.

                                            ; PTM 3829:  @IBM
                                            ; PTM 269:   @IBM
  Mov   CX,4                                ; Set length for parms check.
  Xor   SI,SI                               ; No data buffer parm checking.
  Call  IOCtlAddrCheck                      ; Verify read access to table.
 .If < c >                                  ; Carry set = access denied.
.386p
    Pop ECX                                 ; PB732916   @IBM
.286p
    Ret                                     ; Get Out Now.
 .Endif                                     ; End if access denied.

  LES   BX, ES:[BX+ParmListPtr]             ; Get the caller's parm list address.
  Mov   AX, ES:[BX]                         ; Get the desired handle.

 .If < AX e 0 >                             ; If the caller is attempting to create
    LES BX, Dword Ptr StkRPO                ; Restore request packet address.
    Mov ES:[BX+PktStatus],ParmError         ; Indicate invalid parameter in RP
 .Else NEAR                                 ; Else desired handle is non-zero.
.386p
    Push EAX                                ; ptr B729565 @IBM
.286p

    Push AX                     ; Save the specified handle.

                                ; PTM 269 BEGIN    @IBM
    Mov AX, ES:[BX+2]           ; Get the code page to be set as the
                                ; default for the new KCB.
    Xor CX, CX                  ; Assume no code pages at first.
    Test CmdFlags, CP_ENABLED   ; If code pages have been
   .If < nz >                   ; prepared, search for a match on
                                ; the desired code page.
      Mov ES, CBDataSel         ; Set up the selector to the CPCB.
      Call SearchCPCB           ; Returns CX = CPCB index for code page
                                ; value in AX.
     .If < c >                  ; Carry = code page value not found,
        Pop AX                  ; (Fix stack and)
.386p
        Pop EAX                 ; ptr B729565  @IBM
        Pop ECX                 ; PB732196     @IBM
.286p
        Ret                     ; Get Out Now. Parm error code has already
     .Endif                     ;  been set in the Request Packet.
   .Endif                       ; End if code pages are prepared.

    Push CX                     ; Save index into CPCB for KCB
                                ;  initialization later on.
                                ; PTM 269 END.  @IBM

    ;* Allocate memory for the new KCB.

;## PTR B712571  @IBM
.386p
       Mov    EAX, VMDHA_FIXED + VMDHA_16M + VMDHA_SELMAP ; Fixed memory requested
       Push   EDI
       Mov    EDI, NO_PHYSADDR              ; Not Used
       XOR    ECX, ECX                      ; Clear ECX
       Mov    CX, KCBSIZE                   ; Size of memory to allocate
       Mov    DL, DevHlp_VMAlloc            ; Indicate desired DevHelp.
       Call   [DeviceHelp]                  ; Go do it.
  .If <c>                                   ; Carry flag set means error.
        Pop EDI
        Pop CX                              ; Pop the index before exiting NR
        Pop AX                              ; Pop the handle back.
        LES BX, Dword Ptr StkRPO            ; Restore request packet address.
        Mov ES:[BX+PktStatus],GenError      ; Indicate invalid parameter in RP
        Pop EAX                             ; ptr B729565   @IBM
        Pop ECX                             ; PB732916      @IBM
        Ret                                 ; Get Out Now.
  .Endif                                    ; Endif Carry flag set.
       Pop    EDI
       Mov    SI,CX                         ; Hold the KCB offset
       SHR    ECX, 16                       ; Move selector to CX
       Push   DS                            ; Mov PSG selector to
       Pop    ES                            ; ES.
       Mov    DS,CX                         ; DS:SI KCB selector:offset
       Mov    DS:[SI].KCBLinearAddr, EAX    ; Lug around till KCB destroyed.
       Mov    CX,ES                         ; Save PSG selector.
       Mov    DI,SI                         ; DI holds the KCB offset.
       Mov    DL, DevHlp_VirtToPhys         ; Indicate desired DevHelp.
       Call   ES:[DeviceHelp]               ; Go do it.
       Push   DS                            ; Move the KCB selector.
       Pop    ES                            ; ES holds the KCB selector
       Mov    DS,CX                         ; Restore PSG selector.
       Mov    SI, StkPSG                    ; Restore PSG offset.
.286p                                       ;
;end  B712571  @IBM                         ; Returns AX:BX physical address of KCB

    ;* Everything should be back to normal.
    ;*
    ;* DS:SI = PSG address.
    ;* ES:DI = Virtual address of the new KCB.
    ;* AX:BX = Physical address of the new KCB.
    ;*

   .If < <Word Ptr [SI].KCBFirst> eq 00h > AND NEAR ;@@ KCB linked list empty?
   .If < <Word Ptr [SI].KCBFirst+2> eq 00h >; KCB linked list empty? PTRB709460 @IBM
      Mov Word Ptr [SI].KCBFirst+2, AX      ; Yes, make this KCB the
                                            ;  first one in the linked
      Mov Word Ptr [SI].KCBFirst, BX        ;  the linked list for this
                                            ; PSG.
      Mov Word Ptr [SI].KCBLast+2, AX       ; Also make this KCB the
      Mov Word Ptr [SI].KCBLast, BX         ; last one in the linked
                                            ; list for this PSG.

      Mov Word Ptr ES:[DI].KCBNext, 00h     ; Indicate in new KCB that
      Mov Word Ptr ES:[DI].KCBNext+2, 00h   ; PTR 709460   @IBM
      Mov Word Ptr ES:[DI].KCBPrev, 00h     ;  it's the first AND last
      Mov Word Ptr ES:[DI].KCBPrev+2, 00h   ; PTR 709460   @IBM
                                            ;  in the list.

   .Else      ;* The KCB linked list is not empty.

       ;*
       ;* Get the previous end of list KCB and mark it as pointing to
       ;* the new KCB as the next one.
       ;*

       Push    AX                           ; Save (hi) KCB phys. address again.
       Push    BX                           ; Save (lo) KCB phys. address again.
       Mov     BX, Word Ptr [SI].KCBLast    ; Get the phys. address of the
       Mov     AX, Word Ptr [SI].KCBLast+2  ;  last KCB in the list.
       Mov     CX, KCBSIZE                  ; Specify the size of a KCB.
       Mov     DH, ES_DI                    ; Specify receiving registers.
       Mov     DL, DevHlp_PhysToVirt        ; Specify desired function.
       Call    [DeviceHelp]                 ; ES:DI will contain virtual address
                                            ;  of last KCB in the list.
       Pop     BX                           ; Restore the physical address of
       Pop     AX                           ;  the new KCB.
       Mov     Word Ptr ES:[DI].KCBNext+2, AX       ; Make the current end
       Mov     Word Ptr ES:[DI].KCBNext, BX         ;  of list KCB point
                                                    ;  to the new KCB.

       Mov     DX, Word Ptr [SI].KCBLast+2  ; Get the physical address
       Mov     Word Ptr KCBSave+2, DX       ;  of the last item
       Mov     DX, Word Ptr [SI].KCBLast    ;  in the list and
       Mov     Word Ptr KCBSave, DX         ;  save it away.

       Mov     Word Ptr [SI].KCBLast+2, AX  ; Make the new KCB the last
       Mov     Word Ptr [SI].KCBLast, BX    ;  one in the linked list.

       ;*
       ;* Get addressability to the new KCB again and make the former
       ;* end of list KCB the new KCB's previous item.
       ;*

       Mov     CX, KCBSIZE                  ; Specify size of the KCB.
       Mov     DH, ES_DI                    ; Specify receiving registers.
       Mov     DL, DevHlp_PhysToVirt        ; Specify desired function.
       Call    [DeviceHelp]                 ; ES:DI will contain virtual address
                                            ;  of new KCB.
       Mov     DX, Word Ptr KCBSave+2          ; Make the new KCB
       Mov     Word Ptr ES:[DI].KCBPrev+2, DX  ;  point to the old
       Mov     DX, Word Ptr KCBSave            ;  last item as its
       Mov     Word Ptr ES:[DI].KCBPrev, DX    ;  previous KCB.
       Mov     Word Ptr ES:[DI].KCBNext, 00h   ; Mark this KCB as the
       Mov     Word Ptr ES:[DI].KCBNext+2, 00h ; PTR 709460  @IBM

                                           ;  end of the chain of
   .Endif                                  ; End check for empty KCB chain.

    ;*
    ;* Initialize necessary fields in the new KCB.  Other fields
    ;* will be set when the Set KCB occurs.
    ;*

    ;*
    ;* DS:SI = PSG Offset.
    ;* ES:DI = Virtual address of new KCB to be initialized.
    ;*

                                    ; PTM 269: @IBM
    Pop     AX                      ; Restore saved index into CPCB.
    Mov ES:[DI].KCBIxOffCP, AX      ; Save CPCB CP Index in KCB.

    Pop     AX                      ; Restore the handle saved at start.
    Mov     ES:[DI].KCBHandle, AX   ; Put ndle in new KCB.
    Mov     AX, StkPID              ; Get the caller's Process ID.
    Mov     ES:[DI].KCBPID, AX      ; Save the PID in the KCB.
    Xor     AX, AX                  ; Clear a reg for init'ing to zero.
    Mov     ES:[DI].KCBFlags, AX    ; Indicate no custom code page.
    Mov     ES:[DI].KCBQueueCt, AX  ; No KIB used yet, of course.
                                                    ; PTM 5841: @IBM
    Mov     Word Ptr ES:[DI].KCBBufferSem, AX       ; Zero buffer serialization
    Mov     Word Ptr ES:[DI].KCBBufferSem+2, AX     ;  semaphore.
    Mov     ES:[DI].KCBDBCSSh, AL   ; Clear DBCS shift state and set input
    Mov     ES:[DI].KCBInpMode, AL  ;  mode to ASCII + no shift report.
    Dec     AX                      ; Now make AX = -1
    Mov     ES:[DI].KCBInPtr, AX    ; Indicate no KIB Tail, and therefore
    Mov     ES:[DI].KCBOutPtr, AX   ;  no KIB Head.
    Mov     AX, [SI].ShiftFlags     ; Get the PSG's shift state, and


    ;* pb732917 set leds clear in setkcb and restore org in destroykbd

    And     AX, NOT(CapsTogl+NumTogl+InsTogl+ScrollTogl) ; Clear bits (PTM 6832)@IBM
    Mov     ES:[DI].KCBShift, AX            ;  put it in the new KCB.
    Mov     ES:[DI].KCBDBCSFl, DefaultDBCS  ; Set default DBCS status.
ifdef DBCSKBD
    Mov     ES:[DI].KCBRes1, 00h            ; Set default DBCS key down.              ;@IBM J-MI1103(A)
endif ;DBCSKBD
                                            ; PTM 5627:  @IBM
    UnPhysToVirt                ; Macro to undo PhysToVirt

.386p
  Pop EAX                       ; ptr B729565 restore EAX before leaving @IBM
  Pop ECX                       ; PB732916 @IBM
.286p

 .Endif                         ; End handle zero check.

  LES BX, Dword Ptr StkRPO      ; Restore request packet address.

  Ret                           ; End IOCTL 5Dh.
CreateKbd Endp


BREAK <IOCTL 5Eh - Destroy Keyboard>

;*********************************************************************
;*
;* FUNCTION NAME DestroyKbd
;*
;* DESCRIPTION   Free memory for a logical keyboard.
;*
;*              This routine searches for a given handle/PID
;*              combination (provided by the IOCTL caller) and frees
;*              the physical memory associated with the logical
;*              keyboard, or KCB.
;*
;* NOTE         Not action is taken if the handle specified is ZERO.
;*              This routine is only called in protect mode.
;*
;*
;* INPUT:
;*           REGISTERS:
;*
;*             ES:BX = Ptr to Request Block
;*                DI = PSDA address
;*
;*                The Request Block contains the handle to be used to search
;*                for the correct KCB.
;*
;* RETURN-NORMAL :  Return to main Strategy processing.  The PSG
;*              data area is modified.  Physical memory is freed.
;*              Other existing KCB link pointers are updated.
;*
;* RETURN-NORMAL :   "Invalid Parameter" code is set in the request packet
;*              if the search for the handle/PID combination fails.
;*              CmdError bit is set if Single Queue is enabled.
;*
;* EFFECTS:     AX, CX, DX, SI are altered.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*                              UnLock_CustomCP
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (FreePhys, PhysToVirt, UnPhysToVirt)
;*
;***********************************************************************
Public DestroyKbd
DestroyKbd Proc Far

  Test [DI].PSGFlags, SQMODE            ;  If in Single Queue
 .If < nz >                             ;  Mode, indicate unknown
    LES    BX, Dword Ptr StkRPO         ; Restore request packet address.
    Mov    ES:[BX+PktStatus],CmdError   ; Indicate invalid parameter in RP
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if in Single Queue mode.

                                        ; PTM 3829:   @IBM
  Mov    CX,2                           ; Set length of table for parm check.
  Xor    SI,SI                          ; No data buffer parm checking.
  Call   IOCtlAddrCheck                 ; Verify read access to table.
 .If < c >                              ; Carry set = access denied.
    Ret                                 ; Get Out Now.
 .Endif                                 ; End if access denied.

  LES    BX, ES:[BX+ParmListPtr]        ; Get the caller's parm list address.
  Mov    DX, ES:[BX]                    ; Get the desired handle.

  ;* Do not destroy the default KCB for this session.

 .If < DX ne 0 > NEAR                           ; If handle is NOT zero,
    Push  BP                                    ; Save the local storage ptr.

                                                ; was Call DISABLEKBD ptr B789221
  Push   2222h                                  ; Var2 (Not used for this call)
  Push   1111h                                  ; Var1 (Not used for this call)
  Push   DD_Cmd_Disable                         ; Function
  Call   DD_Entry                               ; Device Independent Entry Point

ifdef DBCSKBD
  ; Send logical keyboard change monitor packet for destroy             ;@IBM J-DBCS001(A)
  ;          (  not wait until packet is returned from monitor )        ;@IBM J-DBCS001(A)
   .If <[DI].MonsInstalled gt 0>        ;If monitor is installed        ;@IBM J-DBCS001(A)
        Push SI                         ; Save PSG                      ;@IBM J-DBCS001(A)
        Push DI                         ; Save KCB                      ;@IBM J-DBCS001(A)
        Push CX                                                         ;@IBM J-DBCS001(A)
        Push DX                                                         ;@IBM J-DBCS001(A)
        Push AX                                                         ;@IBM J-DBCS001(A)
        Mov SI,Offset DGROUP:KeyPacket1         ;Point to Key Packet.   ;@IBM J-DBCS001(A)
        Mov [SI].DDFlags,FocusChg               ; set Focus Change      ;@IBM J-DBCS001(A)
        Mov Word Ptr[SI].Key.XChar,DX           ; set handle            ;@IBM J-DBCS001(A)
        Mov Word Ptr[SI].key.Status,0FFH        ; flag for destroy      ;@IBM J-DBCS001(A)
        Mov Word Ptr[SI].key.Shift,00H          ;                       ;@IBM J-DBCS001(A)
        Mov [SI].KPacketLen,0                   ; clear MonFlag         ;@IBM J-DBCS001(A)
        Mov AX,[DI].MonHandle           ;Get monitor chain handle.      ;@IBM J-DBCS001(A)
        ;Address of Key Packet already in SI, as required by DevHlp call;@IBM J-DBCS001(A)
        Mov CX,KeyPacketLen                     ;Set length of packet.  ;@IBM J-DBCS001(A)
        Mov DH,1                ;Don't wait for it to accept packet.    ;@IBM J-DBCS001(A)
        Mov DL,DevHlp_MonWrite  ;Set Monitor Write function.            ;@IBM J-DBCS001(A)
        Call [DeviceHelp]       ;Go pass Key to monitor dispatcher.     ;@IBM J-DBCS001(A)
        Pop AX                                                          ;@IBM J-DBCS001(A)
        Pop DX                                                          ;@IBM J-DBCS001(A)
        Pop CX                                                          ;@IBM J-DBCS001(A)
        Pop DI                                                          ;@IBM J-DBCS001(A)
        Pop SI                                                          ;@IBM J-DBCS001(A)
       .If <c>                  ;Did monitor dispatcher accept packet?  ;@IBM J-DBCS001(A)
          Push 2222h                    ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
          Push 1111h                    ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
          Push DD_Cmd_Enable            ; Function                      ;@IBM J-DBCS001(A)
          Call DD_Entry                 ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
          Pop BP                                                        ;@IBM J-DBCS001(A)
          LES BX, Dword Ptr StkRPO      ;Restore request packet address.;@IBM J-DBCS001(A)
          Mov ES:[BX+PktStatus],GenError ;Set General command error     ;@IBM J-DBCS001(A)
          Ret                                                           ;@IBM J-DBCS001(A)
       .Endif                                                           ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
endif ;DBCSKBD

    ;* Search linked list for KCB to free.

    And   MiscFlags2, Not KCB_FOUND              ; Initialize search flag.
    Mov   BX, Word Ptr [DI].KCBFirst             ; Save (lo) Physical address

    ;* PTM 5627: Fix bug where user tries to destroy nonexistent KCB. @IBM

    Mov AX, -1                                   ; Set AX to special value for
                                                 ;  later check.
                                                 ; PTR B709460 BEGIN  @IBM
   .If < <Word Ptr [DI].KCBFirst+2> ne 00h > OR  ; Ensure KCB exists (sel) OR
   .If < <Word Ptr [DI].KCBFirst> ne 00h >       ; Ensure KCB exists (offset)
                                                 ; PTR B709460 END      @IBM
      Mov   Word Ptr KCBSave, BX                 ;  of first KCB in list.
      Mov   AX, Word Ptr [DI].KCBFirst+2         ; Save (hi) Physical address
      Mov   Word Ptr KCBSave+2, AX               ;  of first KCB in list.

      Mov   SI, DI                               ; Switch regs. for PSG offset.
                                                 ; PTM 5992 - Begin  @IBM
      Push  DX                                   ; Save the handle for a bit.
     .Repeat                                     ; Search for match on desired
                                                 ;  handle.
        Push DX                                  ; Save the handle for a bit.

        ;@@ (AX:BX set up before/in loop)

        Mov    CX, KCBSIZE                      ; Specify size for DevHlp.
        Mov    DH, ES_DI                        ; Specify receiving registers.
        Mov    DL, DevHlp_PhysToVirt            ; Specify desired function.
        Call   [DeviceHelp]                     ; ES:DI will contain the Vaddr
                                                ;  of the KCB.
        Pop    DX                               ; Restore handle for checking.
        Mov    CX, StkPID                       ; Get caller's process ID.
       .If < CX eq ES:[DI].KCBPID >             ; Do PIDs match?
         .If < DX eq ES:[DI].KCBHandle >        ; Do handle values match?
            Or MiscFlags2, KCB_FOUND            ; Yes, desired KCB was found.
            CALLFAR FreeKCB                     ; Go fix ptrs and free mem
         .Else                                  ; Else KCB handle doesn't
                                                ; match
            Mov AX, Word Ptr ES:[DI].KCBNext+2  ; Save the physical address
            Mov BX, Word Ptr ES:[DI].KCBNext    ; of the next KCB in chain
           .If <DX eq -1>                       ; If we should free all
                                                ; KCBs for this PID
              Push AX                           ; Save the physical address
              Push BX                           ; of the next KCB in chain
              CALLFAR FreeKCB                   ; Go fix ptrs and free mem
              Pop  BX                           ; Restore the physical address
              Pop  AX                           ; of the next KCB in chain
           .Endif
            Mov Word Ptr KCBSave, BX            ; Save the physical address
            Mov Word Ptr KCBSave+2, AX          ; of the next KCB in chain
         .Endif                                 ; End if handles match.
       .Else                                    ; Else PIDs didn't match
          Mov BX, Word Ptr ES:[DI].KCBNext      ; Save the
          Mov Word Ptr KCBSave, BX              ;  physical address
          Mov AX, Word Ptr ES:[DI].KCBNext+2    ;  of the next
          Mov Word Ptr KCBSave+2, AX            ;  KCB in the chain.
       .Endif
        Test MiscFlags2, KCB_FOUND          ; Set up for loop check.
     .Until < nz >  OR                      ; Loop till match made OR
     .Until < <Word Ptr KCBSave+2> eq 00h > ; PTR 709460  all KCBs are processed. @IBM
                                            ; PTM 5627:  @IBM
      Pop DX                                ; Restore handle
   .Endif                                   ; End "KCB chain exists" check.
;* Begin fix for PTR B789221   @IBM

    Mov    DI, StkPSG               ; Restore the PSG offset.
    Mov    DS, StkDS                ; Point back to our data segment.
    Lea    BX,[DI].MonBlockID       ; Get ID that monitors may be blocked on
    Mov    AX,DS                    ;
    Mov    DL,DevHlp_ProcRun        ; Set ProcRun DevHlp function.
    Call   [DeviceHelp]             ; Go run any blocked monitor threads

ifdef DBCSKBD
                                    ;@IBM JC20-JS01808 Begin (MSKK)     ;@IBM J-DBCS003(A)
    Push AX                         ; save AX                           ;@IBM J-DBCS003(A)
    Xor AX,AX                       ; indicate to Access the KCB        ;@IBM J-DBCS003(A)
    CALLFAR  PurgeKIB               ; now purge KIB.                    ;@IBM J-DBCS003(A)
    Pop AX                          ; restore AX                        ;@IBM J-DBCS003(A)
                                    ;@IBM JC20-JS01808 End (MSKK)       ;@IBM J-DBCS003(A)
endif ;DBCSKBD

   .If <[DI].MonsInstalled a 0>     ; Are any monitors installed?
      Mov    AX,[DI].MonHandle   ; Yes, get handle for this PSG's monitor chain
      Mov    DL,DevHlp_MonFlush     ; Set DevHlp function.
      Call   [DeviceHelp]           ; Go flush
   .Endif

                                    ; was Call EnableKbd  ptrb789221 @IBM
  Push   2222h                      ; Var2 (Not used for this call)
  Push   1111h                      ; Var1 (Not used for this call)
  Push   DD_Cmd_Enable              ; Function
  Call   DD_Entry                   ; Device Independent Entry Point

;* End fix for PTR B789221     @IBM

    Pop BP                              ; Restore local storage ptr.
    Test MiscFlags2, KCB_FOUND          ; Did we find a match?
   .If < z > AND                        ; No,
                                        ; Did not find match on handle,
   .If <DX ne -1> OR                    ; But weren't trying to OR
   .If <AX eq -1>                       ; if no KCB chain exists
                                        ; PTM 5992 - End   @IBM
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.
      Mov ES:[BX+PktStatus],GenError    ; Indicate invalid parameter in RP
      Ret                               ; Get Out Now.
   .Endif                               ; End if handle matched check.

 .Endif                                 ; End if not handle zero.

  Mov DI, StkPSG                        ; Restore PSG offset.
  LES BX, Dword Ptr StkRPO              ; Restore request packet addr.

  Push AX                               ; start PB732917       @IBM
  .If <bit [DI].PSGFlags z SQMODE>      ; DCR106: Check if we are in PM SG. @IBM
     Mov   AX, [DI].ShiftFlags          ; Put shift flags in AX
     Shr   AX,4                         ; Move LED bits to low nibble
     And   AX,7                         ; Turn off all unwanted bits

ifdef DBCSKBD
ifdef AX_KBD
     Test byte ptr [DI].DBCSShift, KATAKANA                             ;@IBM J-AXKBD01(A)
    .If <nz>                  ; If KATAKANA set Bit 3                   ;@IBM J-AXKBD01(A)
        Or AX,8               ; for KANA LED                            ;@IBM J-AXKBD01(A)
    .Endif                                                              ;@IBM J-AXKBD01(A)
endif ;AX_KBD
endif ;DBCSKBD

     Push  2222h                        ; Var2 (Not used for this call)
     Push  AX                           ; Var1 (LED state)
     Push  DD_Cmd_Indicators            ; Function
     Call  DD_Entry                     ; Device Independent Entry Point
  .Endif                                ;
  Pop AX                                ; end pb732917 @IBM
  Ret
DestroyKbd Endp


BREAK <IOCTL 5Fh - WriteKbdString>

;***********************************************************************
;*
;* FUNCTION NAME  WriteKbdString
;*
;* DESCRIPTION    Write one or more bytes to the keyboard.
;*
;*                Routine sends data to the keyboard hardware.
;*
;* NOTE           This IOCTl is for use with Intelligent keyboards
;*                which will recognize the data sent to it.  The
;*                data sent may NOT be part of the set of commands
;*                supported by the standard 101 Enhanced Keyboard.
;*
;*
;* INPUT:
;*
;*               ES:BX = Ptr to Request Block which has a pointer to:
;*
;*               Parameter Packet
;*               Field                         Length
;*               ------------------------------------
;*               Parm Packet Length             WORD
;*               Data String Count              BYTE
;*               Keyboard Data String Pointer   DWORD
;*
;* RETURN-NORMAL :   Return to main Strategy processing.
;*
;* RETURN-ERROR  :    "Invalid Parameter" code is set in the request packet
;*
;* EFFECTS:     Keyboard will act on data sent to it.
;*
;* INTERNAL REFERENCES:
;*    ROUTINES:
;*              DD_Cmd_WriteKbdStr
;*              IOCtlAddrCheck
;*
;* EXTERNAL REFERENCES:
;*    ROUTINES:
;*              DevHlp (VerifyAccess)
;*
;*************************************************************************

Public WriteKbdStrg
WriteKbdStrg Proc Far

  Mov   CX, 7                             ; Set length of table for parm check.
  Xor   SI, SI                            ; No data buffer parm checking.
  Call  IOCtlAddrCheck                    ; Verify read access to parms
 .If < c >                                ; Carry set = access denied.
    Ret                                   ; Get Out Now.
 .Endif                                   ; End if access denied.

                                          ; We MUST lock down the memory!
  LES   BX,ES:[BX+ParmListPtr]            ; Get address of parm list.
  Mov   AX, Word Ptr ES:[BX+5]            ; Get Sel
  Mov   BX, 0100h                         ; BH=Longterm, BL=Block till available
  Mov   DL, DevHlp_Lock                   ; Set DevHlp function.
  Call  [DeviceHelp]                      ; Call Dev help to Lock
 .If < c >                                ; If there was an error
    LES   BX, Dword Ptr StkRPO            ; Restore request packet address.
    Mov   ES:[BX+PktStatus],ParmError     ; Indicate invalid parameter in RP
    Ret                                   ; Get Out Now.
 .Endif                                   ; Endif fail
  Push   AX                               ; Save the LOCK HANDLE returned
  Push   BX                               ; Save the LOCK HANDLE returned

  LES   BX, Dword Ptr StkRPO              ; Restore request packet address.
  LES   BX,ES:[BX+ParmListPtr]            ; Get address of parm list
  Push  DI                                ; Save PSG offset
  Mov   DI,Word Ptr ES:[BX+3]             ; Get Offset (for verify access)
  Mov   AX, Word Ptr ES:[BX+5]            ; Get Sel again, lost above
  Xor   CX, CX                            ; Clear out
  Mov   CL, byte ptr ES:[BX+2]            ; Get count of bytes to send
 .If < CL eq 0 >                          ; If there was a count = 0  ;B727769 @IBM
    Pop DI                                ; Restore PSG offset
    Jmp WriteKbdFail                      ; Go UNLOCK and FAIL.
 .Endif                                   ; Endif 0 count  end of B727769 @IBM
  Mov   DH, 0                             ; Read access desired.
  Mov   DL, DevHlp_VerifyAccess           ; Set DevHlp function.
  Call  DeviceHelp                        ; Go verify access to data
 .If < c >   OR                           ; If carry (error)  OR
 .If < <byte ptr ES:[BX]> ne 7 >          ; If user specified length isn't 7 bytes
    Pop DI                                ; Restore PSG offset
    Jmp WriteKbdFail                      ; Go UNLOCK and FAIL.
 .Endif                                   ; End if access denied.
  Pop   DI                                ; Restore PSG offset


  LES BX,ES:[BX+3]                        ; Get pointer to data byte(s)
 .While < CL ne 0 >                       ; While we have not checked each byte
   .If < <byte ptr ES:[BX]> ge 0d0h > AND ; Range check to make sure the
   .If < <byte ptr ES:[BX]> le 0dfh >     ; value is between d0 and df hex!
      Inc BX                              ; Inc data pointer
      Dec CL                              ; Dec data count
   .Else                                  ; Else out of range data was found
      Jmp WriteKbdFail                    ; Go UNLOCK and FAIL.
   .Endif
 .Endwhile

                                          ; We finally got here, do the function!
  LES BX, Dword Ptr StkRPO                ; Restore request packet address.
  LES BX,ES:[BX+ParmListPtr]              ; Get address of parm list.
  Push ES                                 ; push selector
  Push BX                                 ; push offset
  Push DD_Cmd_WriteKbdStr                 ; ABIOS Write KBD String command
  Call DD_Entry                           ; Device Independent Entry Point


  Pop BX                                  ; Get the LOCK HANDLE
  Pop AX                                  ; Get the LOCK HANDLE
  Mov DL, DevHlp_UnLock                   ; Set desired function.
  Call [DeviceHelp]                       ; Unlock the user memory
  LES BX, Dword Ptr StkRPO                ; Restore request packet address.
  Ret                                     ; Outta here!


WriteKbdFail:                             ; We have a wipe out...hang on tight.
  Pop BX                                  ; Get the LOCK HANDLE
  Pop AX                                  ; Get the LOCK HANDLE
  Mov DL, DevHlp_UnLock                   ; Set desired function.
  Call [DeviceHelp]                       ; Unlock the user memory
  LES BX, Dword Ptr StkRPO                ; Restore request packet address.
  Mov ES:[BX+PktStatus],ParmError         ; Indicate invalid parameter in RP
  Ret                                     ; Get Out Now, Wipe out.

WriteKbdStrg Endp


ifdef DBCSKBD
BREAK <IOCTL 5Bh - Set Keyboard Control>                                ;@IBM J-DBCS004(A)
Public SetKbdCTL                                                        ;@IBM J-DBCS004(A)
SetKbdCTL Proc  Far                                                     ;@IBM J-DBCS004(A)
;*************** START OF SPECIFICATIONS ****************************** ;@IBM J-DBCS004(A)
;* SUBROUTINE NAME: SetKbdCTL                                         * ;@IBM J-DBCS004(A)
;* DESCRIPTIVE NAME:                                                  * ;@IBM J-DBCS004(A)
;* FUNCTION:                                                          * ;@IBM J-DBCS004(A)
;* NOTES:                                                             * ;@IBM J-DBCS004(A)
;*              Always called in protect mode.                        * ;@IBM J-DBCS004(A)
;* ENTRY POINT: SetKbdCTL                                             * ;@IBM J-DBCS004(A)
;*    LINKAGE:  NEAR                                                  * ;@IBM J-DBCS004(A)
;* INPUT:                                                             * ;@IBM J-DBCS004(A)
;*   REGISTERS:                                                       * ;@IBM J-DBCS004(A)
;*     ES:BX = Ptr to Request Block                                   * ;@IBM J-DBCS004(A)
;*        DI = PSDA address                                           * ;@IBM J-DBCS004(A)
;*        DL = Function number being called.                          * ;@IBM J-DBCS004(A)
;*                                                                    * ;@IBM J-DBCS004(A)
;*        The Request Block contains a pointer to the keyboard        * ;@IBM J-DBCS004(A)
;*        control.                                                    * ;@IBM J-DBCS004(A)
;*                                                                    * ;@IBM J-DBCS004(A)
;* EXIT-NORMAL: Return to subroutine caller.                          * ;@IBM J-DBCS004(A)
;* EXIT-ERROR:  see NORMAL above.                                     * ;@IBM J-DBCS004(A)
;* EFFECTS:                                                           * ;@IBM J-DBCS004(A)
;*              AX, SI are not preserved.                             * ;@IBM J-DBCS004(A)
;* INTERNAL REFERENCES:                                               * ;@IBM J-DBCS004(A)
;*    ROUTINES:                                                       * ;@IBM J-DBCS004(A)
;*              DisableKbd        EnableKbd                           * ;@IBM J-DBCS004(A)
;* EXTERNAL REFERENCES:                                               * ;@IBM J-DBCS004(A)
;*              DevHlp (Send_Event)                                   * ;@IBM J-DBCS004(A)
;*************** END OF SPECIFICATIONS ******************************** ;@IBM J-DBCS004(A)
                                ;I have to check Sub-function & #SG     ;@IBM J-DBCS001(A)
  mov cx, 4                     ;set length of table for parm check     ;@IBM J-DBCS001(A)
  mov si, 0                     ;no data buffer parm checking           ;@IBM J-DBCS001(A)
  call IOCtlAddrCheck           ;Verify read access to table            ;@IBM J-DBCS001(A)
 .If < c >                      ;if access denied                       ;@IBM J-DBCS001(A)
    ret                         ;get out now                            ;@IBM J-DBCS001(A)
 .Endif                                                                 ;@IBM J-DBCS001(A)

  Push ES                                                                  ;@IBM J-DBCS004(A)
  LES SI,ES:[BX+ParmListPtr]        ;Get the caller's parm list address.   ;@IBM J-DBCS004(A)
  Mov AX,ES:[SI]                    ; Get Subcommand in word.              ;@IBM J-DBCS004(A)
  Mov DX,ES:[SI+2]                  ; Get Requested #SG.                   ;@IBM J-DBCS004(A)
  Pop  es                                                                  ;@IBM J-DBCS004(A)

 .IF <AX eq -1> NEAR                    ; Is this request from window ?    ;@IBM J-DBCS004(A)
                                                                           ;@IBM J-DBCS004(A)
if W_KBD_ESC                                                               ;@IBM J-DBCS004(A)
  LES SI,ES:[BX+DataBfrPtr]             ; Get address of Data list.        ;@IBM J-DBCS004(A)
  Mov AX,ES:[SI+2]                      ; Get Function in requested Data.  ;@IBM J-DBCS004(A)
  Mov BX,ES:[SI]                        ; Get Argment in requested Data.   ;@IBM J-DBCS004(A)
 .IF <AX eq 4> AND  ; Argment = Activete ?                                 ;@IBM J-DBCS004(A)
 .IF <BX eq 1>      ; Function = "Ctrl+ESC" ?   ;Send Signal "Ctrl+ESC".   ;@IBM J-DBCS004(A)
    Push 2222h                          ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
    Push 1111h                          ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
    Push DD_Cmd_Disable                 ; Function                      ;@IBM J-DBCS001(A)
    Call DD_Entry                       ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
    Xor AX,AX                                                              ;@IBM J-DBCS004(A)
    Mov BX,1     ;FoundHKID ; same as "Ctrl+ESC"   ; Get the hot key ID.   ;@IBM J-DBCS004(A)
    Mov AH,event_SM_Kbd                 ; Yes, so get event name to signal.;@IBM J-DBCS004(A)
    Mov DL,DevHlp_SendEvent             ; Indicate Signal.                 ;@IBM J-DBCS004(A)
    Call [DeviceHelp]                   ; Go do it.                        ;@IBM J-DBCS004(A)
    Push 2222h                          ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
    Push 1111h                          ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
    Push DD_Cmd_Enable                  ; Function                      ;@IBM J-DBCS001(A)
    Call DD_Entry                       ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
    Jmp  KbdCtl_End_Function                                               ;@IBM J-DBCS004(A)

 .ENDIF                                                                    ;@IBM J-DBCS004(A)
                                                                           ;@IBM J-DBCS004(A)
    Mov SI,DX                           ; Get requested session number.    ;@IBM J-DBCS004(A)
    Shl SI,1                            ; Make it an offset, and point     ;@IBM J-DBCS004(A)
    Mov SI,[SI + PSGPointers]           ; to the requested PSG.            ;@IBM J-DBCS004(A)
                                                                           ;@IBM J-DBCS004(A)
    Push AX                                                                ;@IBM J-DBCS004(A)
    Push BX                                                                ;@IBM J-DBCS004(A)
    And  BX,000000000001B                                                  ;@IBM J-DBCS004(A)
 .IF <BX ne 0>                          ; "Ctrl+ESC" request               ;@IBM J-DBCS004(A)
   .IF <AX eq 1>                        ; Disable function request         ;@IBM J-DBCS004(A)
     And DS:[SI+W_KbdCtlStatus],1111111111111110B                          ;@IBM J-DBCS004(A)
   .ELSEIF<AX eq 2>                     ; Enable function request          ;@IBM J-DBCS004(A)
     Or  DS:[SI+W_KbdCtlStatus],0000000000000001B                          ;@IBM J-DBCS004(A)
   .ENDIF                                                                  ;@IBM J-DBCS004(A)
 .ENDIF                                                                    ;@IBM J-DBCS004(A)
    Pop  BX                                                                ;@IBM J-DBCS004(A)
    Pop  AX                                                                ;@IBM J-DBCS004(A)
    Push AX                                                                ;@IBM J-DBCS004(A)
    Push BX                                                                ;@IBM J-DBCS004(A)
    And  BX,000000000010B                                                  ;@IBM J-DBCS004(A)
 .IF <BX ne 0>                         ; "Alt+ESC" request                 ;@IBM J-DBCS004(A)
   .IF <AX eq 1>                       ; Disable function request          ;@IBM J-DBCS004(A)
     And DS:[SI+W_KbdCtlStatus],1111111111111101B                          ;@IBM J-DBCS004(A)
   .ELSEIF<AX eq 2>                    ; Enable function request           ;@IBM J-DBCS004(A)
     Or  DS:[SI+W_KbdCtlStatus],0000000000000010B                          ;@IBM J-DBCS004(A)
   .ENDIF                                                                  ;@IBM J-DBCS004(A)
 .ENDIF                                                                    ;@IBM J-DBCS004(A)
    Pop  BX                                                                ;@IBM J-DBCS004(A)
    Pop  AX                                                                ;@IBM J-DBCS004(A)
    Push AX                                                                ;@IBM J-DBCS004(A)
    Push BX                                                                ;@IBM J-DBCS004(A)
    And  BX,000000000100B                                                  ;@IBM J-DBCS004(A)
 .IF <BX ne 0>                         ; "PAUSE" request                   ;@IBM J-DBCS004(A)
   .IF <AX eq 1>                       ; Disable function request          ;@IBM J-DBCS004(A)
     And DS:[SI+W_KbdCtlStatus],1111111111111011B                          ;@IBM J-DBCS004(A)
   .ELSEIF<AX eq 2>                    ; Enable function request           ;@IBM J-DBCS004(A)
     Or  DS:[SI+W_KbdCtlStatus],0000000000000100B                          ;@IBM J-DBCS004(A)
   .ENDIF                                                                  ;@IBM J-DBCS004(A)
 .ENDIF                                                                    ;@IBM J-DBCS004(A)
    Pop  BX                                                                ;@IBM J-DBCS004(A)
    Pop  AX                                                                ;@IBM J-DBCS004(A)
KbdCtl_End_Function:                                                       ;@IBM J-DBCS004(A)
                                                                           ;@IBM J-DBCS004(A)
endif                                                                      ;@IBM J-DBCS004(A)

 ; Does not support SetRealModeShiftState any more.
 ; Does not support GetRealModeShiftState any more.

 ;                                                                      ;@IBM J-DBCS001(A)
 ; SetShiftState With Mask                                              ;@IBM J-DBCS001(A)
 ;                                                                      ;@IBM J-DBCS001(A)
public  setshiftwithmask                                                ;@IBM J-DBCS001(A)
setshiftwithmask:                                                       ;@IBM J-DBCS001(A)
 .ElseIf <AX eq SetSftWithMsk> NEAR                                     ;@IBM J-DBCS001(A)
  mov cx, 8                     ; set length of table for parm check    ;@IBM J-DBCS001(A)
  mov si, 0                     ; no data buffer parm checking          ;@IBM J-DBCS001(A)
  call IOCtlAddrCheck           ; Verify read access to table           ;@IBM J-DBCS001(A)
 .If < c >                      ; if access denied                      ;@IBM J-DBCS001(A)
    ret                         ; get out now                           ;@IBM J-DBCS001(A)
 .Endif                         ;                                       ;@IBM J-DBCS001(A)
  les si,es:[bx+ParmListPtr]    ; Get the caller's parm list address.   ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  Push 2222h                            ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
  Push 1111h                            ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
  Push DD_Cmd_Disable                   ; Function                      ;@IBM J-DBCS001(A)
  Call DD_Entry                         ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
  mov ax,es:[si+2]                      ; Get required Shift            ;@IBM J-DBCS001(A)
  mov cx,es:[si+5]                      ; Get Shift mask                ;@IBM J-DBCS001(A)
  mov dl,es:[si+4]                      ; Get required NLS              ;@IBM J-DBCS001(A)
  mov dh,es:[si+7]                      ; Get NLS mask                  ;@IBM J-DBCS001(A)
  LES SI, Dword Ptr StkKCBO             ; Get the caller's KCB address  ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  and ax,cx                             ; Change only required Shift    ;@IBM J-DBCS001(A)
  not cx                                ;                     & NLS     ;@IBM J-DBCS001(A)
  and word ptr es:[si].KCBShift,cx                                      ;@IBM J-DBCS001(A)
  or  es:[si].KCBShift,ax                                               ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  and dl,dh                                                             ;@IBM J-DBCS001(A)
  not dh                                                                ;@IBM J-DBCS001(A)
  and byte ptr es:[si].KCBDBCSSh,dh                                     ;@IBM J-DBCS001(A)
  or  es:[si].KCBDBCSSh,dl                                              ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  mov ax,es:[si].KCBShift               ; AX = New Shift                ;@IBM J-DBCS001(A)
  mov dl,es:[si].KCBDBCSSh              ; DL = New DBCS Shift           ;@IBM J-DBCS001(A)
  mov dh,es:[si].KCBDBCSFl              ; Put interim character byte    ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  call inform_mon               ; Send shift change packet to KBD MON   ;@IBM J-DBCS001(A)
 .If <c>                        ; error ?                               ;@IBM J-DBCS001(A)
    LES BX, Dword Ptr StkRPO            ; Restore request packet address;@IBM J-DBCS001(A)
    Mov ES:[BX+PktStatus],GenError      ; Set General command error     ;@IBM J-DBCS001(A)
 .Endif                                                                 ;@IBM J-DBCS001(A)
  Push 2222h                            ; Var2(Not used for this call)  ;@IBM J-DBCS001(A)
  Push 1111h                            ; Var1(Not used for this call)  ;@IBM J-DBCS001(A)
  Push DD_Cmd_Enable                    ; Function                      ;@IBM J-DBCS001(A)
  Call DD_Entry                         ; Dev Independent Entry Point   ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)

;*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=                       ;@IBM J-DCR287(A)
; Subfunction 03H - Scan Code Generator Control                         ;@IBM J-DCR287(A)
;*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=                       ;@IBM J-DCR287(A)
 .ElseIf <AX eq 3> NEAR                                                 ;@IBM J-DCR287(A)
    Push ES                                                             ;@IBM J-DCR287(A)
    LES SI,ES:[BX+ParmListPtr]          ; Get the  parm list address.   ;@IBM J-DCR287(A)
    Mov DX,ES:[SI+2]                    ; Get control code              ;@IBM J-DCR287(A)
    .If <DX eq 0>                                                       ;@IBM J-DCR287(A)
      Or fkey,inhibit_xlate             ; Disable all function of SCG   ;@IBM J-DCR287(A)
      Or fkey,inhibit_shift_conv        ; Disable ShiftConv             ;@IBM J-DCR287(A)
    .ElseIf <DX eq 1>                                                   ;@IBM J-DCR287(A)
      And fkey, not inhibit_xlate       ; Enable all function of SCG    ;@IBM J-DCR287(A)
      And fkey, not inhibit_shift_conv  ; Enable ShiftConv              ;@IBM J-DCR287(A)
    .ElseIf <DX eq 2>                                                   ;@IBM J-DCR287(A)
      .If <bit fkey z inhibit_xlate>                                    ;@IBM J-DCR287(A)
        Or fkey,inhibit_shift_conv      ; Disable ShiftConv             ;@IBM J-DCR287(A)
      .Else                                                             ;@IBM J-DCR287(A)
        LES BX, Dword Ptr StkRPO                                        ;@IBM J-DCR287(A)
        Mov ES:[BX+PktStatus],ParmError                                 ;@IBM J-DCR287(A)
        Pop ES                                                          ;@IBM J-DCR287(A)
        Ret                                                             ;@IBM J-DCR287(A)
      .Endif                                                            ;@IBM J-DCR287(A)
    .Elseif <DX eq 3>                                                   ;@IBM J-DCR287(A)
      .If <bit fkey z inhibit_xlate>                                    ;@IBM J-DCR287(A)
        And fkey, not inhibit_shift_conv; Enable ShiftConv              ;@IBM J-DCR287(A)
      .Else                                                             ;@IBM J-DCR287(A)
        LES BX, Dword Ptr StkRPO                                        ;@IBM J-DCR287(A)
        Mov ES:[BX+PktStatus],ParmError                                 ;@IBM J-DCR287(A)
        Pop ES                                                          ;@IBM J-DCR287(A)
        Ret                                                             ;@IBM J-DCR287(A)
      .Endif                                                            ;@IBM J-DCR287(A)
    .Else                                                               ;@IBM J-DCR287(A)
      LES BX, Dword Ptr StkRPO                                          ;@IBM J-DCR287(A)
      Mov ES:[BX+PktStatus],ParmError                                   ;@IBM J-DCR287(A)
      Pop ES                                                            ;@IBM J-DCR287(A)
      Ret                                                               ;@IBM J-DCR287(A)
    .Endif                                                              ;@IBM J-DCR287(A)
    Pop ES                                                              ;@IBM J-DCR287(A)
;*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=                       ;@IBM J-DCR287(A)
; Subfunction 04H - Scan Code Generator Status                          ;@IBM J-DCR287(A)
;*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=                       ;@IBM J-DCR287(A)
 .ElseIf <AX eq 4> NEAR                                                 ;@IBM J-DCR287(A)
    Push ES                                                             ;@IBM J-DCR287(A)
    LES SI,ES:[BX+ParmListPtr]          ; Get the parm list address.    ;@IBM J-DCR287(A)
    Mov DX,0                                                            ;@IBM J-DCR287(A)
    .If <bit fkey nz inhibit_xlate>                                     ;@IBM J-DCR287(A)
      Mov word ptr ES:[SI+2],0          ; Save status code, all disable ;@IBM J-DCR287(A)
    .ElseIf <bit fkey z inhibit_shift_conv>                             ;@IBM J-DCR287(A)
      Mov word ptr ES:[SI+2],1          ; Save status code, all enable  ;@IBM J-DCR287(A)
    .Else                                                               ;@IBM J-DCR287(A)
      Mov word ptr ES:[SI+2],2          ; Save SC, ShitConv disable     ;@IBM J-DCR287(A)
    .Endif                                                              ;@IBM J-DCR287(A)
    Pop ES                                                              ;@IBM J-DCR287(A)
;
;-----------------------------------------------------------------------;@IBM J-DBCS002(A)
;  SubFunction: 0008H                                                   ;@IBM J-DBCS002(A)
;-----------------------------------------------------------------------;@IBM J-DBCS002(A)
public  InstallDependDD                                                 ;@IBM J-DBCS002(A)
InstallDependDD:                                                        ;@IBM J-DBCS002(A)
 .ElseIf <AX eq InstDependDD> NEAR                                      ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Push ES                                                             ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    LES SI,ES:[BX+ParmListPtr]          ; Get the  parm list address.   ;@IBM J-DBCS002(A)
    Mov DX,ES:[SI+2]                    ; Get D/D Type                  ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .If <DX ne 0 >                       ; If D/D type is 0, then        ;@IBM J-DBCS002(A)
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.;@IBM J-DBCS002(A)
      Mov ES:[BX+PktStatus],GenError    ; Set General command error     ;@IBM J-DBCS002(A)
      Pop ES                                                            ;@IBM J-DBCS002(A)
      Ret                                                               ;@IBM J-DBCS002(A)
   .Endif                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Lea BX,ES:[SI+4]                    ; D/D Name                      ;@IBM J-DBCS002(A)
    Xor DI,DI                           ; Check D/D Name length         ;@IBM J-DBCS002(A)
   .While < <byte ptr ES:[BX+DI]> ne 0 >                                ;@IBM J-DBCS002(A)
      Inc DI                                                            ;@IBM J-DBCS002(A)
   .Endwhile                                                            ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .If <DI g 8>                         ; If Name is long, do nothing   ;@IBM J-DBCS002(A)
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.;@IBM J-DBCS002(A)
      Mov ES:[BX+PktStatus],GenError    ; Set General command error     ;@IBM J-DBCS002(A)
      Pop ES                                                            ;@IBM J-DBCS002(A)
      Ret                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .Else                                                                ;@IBM J-DBCS002(A)
      Inc DI                                                            ;@IBM J-DBCS002(A)
      Lea BX,DIDD_Name                  ; D/D Name Buffer               ;@IBM J-DBCS002(A)
     .While < DI ne 0 >                 ; Copy D/D Name to buffer       ;@IBM J-DBCS002(A)
        Mov AL, ES:[SI+4]                                               ;@IBM J-DBCS002(A)
        Mov [BX], AL                                                    ;@IBM J-DBCS002(A)
        Inc SI                                                          ;@IBM J-DBCS002(A)
        Inc BX                                                          ;@IBM J-DBCS002(A)
        Dec DI                                                          ;@IBM J-DBCS002(A)
     .Endwhile                                                          ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .Endif                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Pop ES                                                              ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Lea BX, DIDD_Name                                                   ;@IBM J-DBCS002(A)
    Lea DI, DIDD_Area                                                   ;@IBM J-DBCS002(A)
    Mov DL, DevHlp_AttachDD                                             ;@IBM J-DBCS002(A)
    Call DeviceHelp                                                     ;@IBM J-DBCS002(A)
   .If <c>                                                              ;@IBM J-DBCS002(A)
      mov DIDD_Exist, 0                                                 ;@IBM J-DBCS002(A)
      LES BX, Dword Ptr StkRPO         ; Restore request packet address.;@IBM J-DBCS002(A)
      Mov ES:[BX+PktStatus],GenError   ; Set General command error      ;@IBM J-DBCS002(A)
      Ret                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .Else                                                                ;@IBM J-DBCS002(A)
      mov DIDD_Exist, 1                                                 ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .Endif                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)

;-----------------------------------------------------------------------;@IBM J-DBCS002(A)
;  SubFunction: 0009H                                                   ;@IBM J-DBCS002(A)
;-----------------------------------------------------------------------;@IBM J-DBCS002(A)
public  DeinstallDependDD                                               ;@IBM J-DBCS002(A)
DeinstallDependDD:                                                      ;@IBM J-DBCS002(A)
 .ElseIf <AX eq DeinstDependDD> NEAR                                    ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Push ES                                                             ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    LES SI,ES:[BX+ParmListPtr]          ; Get the  parm list address.   ;@IBM J-DBCS002(A)
    Mov DX,ES:[SI+2]                    ; Get D/D Type                  ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .If <DX ne 0 >                       ; If D/D type is 0, then        ;@IBM J-DBCS002(A)
      LES BX, Dword Ptr StkRPO          ; Restore request packet address.;@IBM J-DBCS002(A)
      Mov ES:[BX+PktStatus],GenError    ; Set General command error     ;@IBM J-DBCS002(A)
      Pop ES                                                            ;@IBM J-DBCS002(A)
      Ret                                                               ;@IBM J-DBCS002(A)
   .Endif                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .If <DIDD_Exist eq 1>                                                ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
      Lea SI, [SI+4]                    ; D/D Name in Param             ;@IBM J-DBCS002(A)
      Lea BX, DIDD_Name                 ; D/D Name in regist buffer     ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
      Mov AL, [BX]                      ; check if D/D name is same     ;@IBM J-DBCS002(A)
      Mov AH, ES:[SI]                                                   ;@IBM J-DBCS002(A)
     .While <AL ne 0> AND                                               ;@IBM J-DBCS002(A)
     .While <AH ne 0>                                                   ;@IBM J-DBCS002(A)
       .If <AH ne AL>                                                   ;@IBM J-DBCS002(A)
          LES BX, Dword Ptr StkRPO      ;Restore request packet addr    ;@IBM J-DBCS002(A)
          Mov ES:[BX+PktStatus],GenError    ;Set General command error  ;@IBM J-DBCS002(A)
          Pop ES                                                        ;@IBM J-DBCS002(A)
          Ret                                                           ;@IBM J-DBCS002(A)
       .Endif                                                           ;@IBM J-DBCS002(A)
        Inc SI                                                          ;@IBM J-DBCS002(A)
        Inc BX                                                          ;@IBM J-DBCS002(A)
        Mov AH, ES:[SI]                                                 ;@IBM J-DBCS002(A)
        Mov AL, [BX]                                                    ;@IBM J-DBCS002(A)
     .Endwhile                                                          ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
      mov DIDD_Exist, 0                                                 ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
   .Endif                                                               ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)
    Pop ES                                                              ;@IBM J-DBCS002(A)
                                                                        ;@IBM J-DBCS002(A)

 .ELSE                                                                  ;@IBM J-DBCS001(A)
    LES BX, Dword Ptr StkRPO            ; Restore request packet address;@IBM J-DBCS001(A)
    Mov ES:[BX+PktStatus],GenError      ; Set General command error     ;@IBM J-DBCS001(A)
 .ENDIF                                                                 ;@IBM J-DBCS001(A)
                                                                        ;@IBM J-DBCS001(A)
  LDS DI, Dword Ptr StkPSG      ; 408 Restore callers psg addresses     ;@IBM J-DBCS001(A)
  LES BX, Dword Ptr StkRPO      ; Restore request packet addr.          ;@IBM J-DBCS001(A)
  Ret                           ; This is RETURN FAR                    ;@IBM J-DBCS004(A)

SetKbdCTL Endp                                                          ;@IBM J-DBCS004(A)


;-----------------------------------------------------------------------;@IBM J-DBCS001(A)
;Function:      Send shift change packet to KBD monitor                 ;@IBM J-DBCS001(A)
;INPUT: DI = PSDA address                                               ;@IBM J-DBCS001(A)
;       AX = Shift                                                      ;@IBM J-DBCS001(A)
;       DH = Status                                                     ;@IBM J-DBCS001(A)
;       DL = Dshift                                                     ;@IBM J-DBCS001(A)
;OUTPUT:                                                                ;@IBM J-DBCS001(A)
;       NC : MonWrite is OK                                             ;@IBM J-DBCS001(A)
;       CY : MonWrite Error                                             ;@IBM J-DBCS001(A)
;Brocken Reg.                                                           ;@IBM J-DBCS001(A)
;       None                                                            ;@IBM J-DBCS001(A)
;-----------------------------------------------------------------------;@IBM J-DBCS001(A)
inform_mon      proc    near                                            ;@IBM J-DBCS001(A)
 .If <[DI].MonsInstalled gt 0>          ;If mons is registered          ;@IBM J-DBCS001(A)
    Push AX                                                             ;@IBM J-DBCS001(A)
    Push CX                                                             ;@IBM J-DBCS001(A)
    Push DX                                                             ;@IBM J-DBCS001(A)
    Push SI                                                             ;@IBM J-DBCS001(A)
    Push DI                     ; for TimeOut HighWord                  ;@IBM J-DBCS003(A)
    Push BX                     ; for TimeOut LowWord                   ;@IBM J-DBCS003(A)

;@IBM   Push DS                 ;                                       ;@IBM J-DBCS003(A)
;@IBM   Push BX                 ;                                       ;@IBM J-DBCS003(A)
;@IBM   Mov DS, StkDS           ;   Point back to our data segment.     ;@IBM J-DBCS003(A)
;@IBM   Lea BX,[DI].MonBlockID  ;   Get ID that monitors may be blocked ;@IBM J-DBCS003(A)
;@IBM   Mov AX,DS               ;                                       ;@IBM J-DBCS003(A)
;@IBM   Mov DL,DevHlp_ProcRun   ;   Set ProcRun DevHlp function.        ;@IBM J-DBCS003(A)
;@IBM   Call [DeviceHelp]       ;   Go run any blocked monitor threads  ;@IBM J-DBCS003(A)
;@IBM   Pop BX                  ;                                       ;@IBM J-DBCS003(A)
;@IBM   Pop DS                  ;                                       ;@IBM J-DBCS003(A)

    Or [DI].PSGJFlags,Changing          ; Indicate now changing.        ;@IBM J-DBCS001(A)
    Mov SI,Offset DGROUP:KeyPacket1     ; Point to Key Packet.          ;@IBM J-DBCS001(A)
    Mov [SI].DDFlags,StatusChg          ; set status change ID          ;@IBM J-DBCS001(A)
    Mov [SI].Key.Scan,0                 ; set scan, char =0             ;@IBM J-DBCS001(A)
    Mov [SI].Key.XChar,0                                                ;@IBM J-DBCS001(A)
    Mov [SI].Key.Shift,AX               ; set requested shift           ;@IBM J-DBCS001(A)
    Mov [SI].Key.Status,DH                                              ;@IBM J-DBCS001(A)
    Or  [SI].Key.Status,1               ; set report bit                ;@IBM J-DBCS001(A)
    Mov [SI].Key.Dshift,DL              ; set reuqested Jshift          ;@IBM J-DBCS001(A)
    Mov [SI].KPacketLen,0               ; clear MonFlag&rawSC           ;@IBM J-DBCS001(A)
    Or Byte Ptr [SI].KPacketLen,NotInserted ;Key isn't monitor inserted.;@IBM J-DBCS001(A)
    Mov AX,[DI].MonHandle               ; get monitor chain handle.     ;@IBM J-DBCS001(A)
    ;--- Address of Key Packet already in SI ---;                       ;@IBM J-DBCS001(A)
    Mov CX,KeyPacketLen                 ; set length of packet.         ;@IBM J-DBCS001(A)
    Xor DI,DI                           ; set TimeOut to 0.1sec.        ;@IBM J-DBCS003(A)
    Mov BX,100                          ; set TimoOut to 0.1sec.(100msec);@IBM J-DBCS003(A)
;@IBM  Mov DH,0                         ; wait for it to accept packet. ;@IBM J-DBCS001(A)
;@IBM  Mov DH,1                         ; wait for it to accept packet. ;@IBM J-DBCS003(A)
    Mov DH,2                            ; wait for it until 1sec.       ;@IBM J-DBCS003(A)
    Mov DL,DevHlp_MonWrite              ; set Monitor Write function.   ;@IBM J-DBCS001(A)
    Call [DeviceHelp]                   ; go pass packet                ;@IBM J-DBCS001(A)
    Pop BX                              ; restore                       ;@IBM J-DBCS003(A)
    Pop DI                              ; restore PSDA address          ;@IBM J-DBCS003(A)
   .If <c>                              ; error ?                       ;@IBM J-DBCS001(A)
      And [DI].PSGJFlags, Not Changing                                  ;@IBM J-DBCS001(A)
   .Endif                                                               ;@IBM J-DBCS001(A)
    Pop SI                                                              ;@IBM J-DBCS001(A)
    Pop DX                                                              ;@IBM J-DBCS001(A)
    Pop CX                                                              ;@IBM J-DBCS001(A)
    Pop AX                                                              ;@IBM J-DBCS001(A)
 .Endif                                                                 ;@IBM J-DBCS001(A)
  ret                                                                   ;@IBM J-DBCS001(A)
inform_mon      endp                                                    ;@IBM J-DBCS001(A)

endif ;DBCSKBD

StratCode Ends
     End
