'******************************************************************************
'* 
'* KEYBOARD CONTROLLER i8042 v.1.0 (CHIP DEVICE)
'*
'* Was used in 84-key keyboards of PC/AT-class machines
'* Emulation is timed to pass software tests (such as POST)
'*
'* Supported platform/bus: X86
'* 
'* Version history:
'*  - v.1.0 by WadiM (initial emulation)
'*
'****************************************************************************** 

//DEBUG.ON 'uncomment to enable debug messages (can be slow for hi-freq events)

//ISA device interface support
public use object DEVICE_ISA

//device name
DeviceName="KBC i8042"
DebugName="KBC_I8042"

//Modules
protected use module "x86keys\scancode" 'scancode conversion tables

//Constants
const DATA_PENDING_FREQ as word=1000 'delay between two data bytes/IRQs (1 ms)
const KEY_DELAY_FREQ  as word=2   'deley before key autorepeat (1/2=0.5 sec)
const KEY_REPEAT_FREQ as word=20  'key autorepeat time (1/20=0.05 sec)
const MAX_BUFFER_SIZE as word=256 'in reality it is ??, but bigger is better :)

//Keyboard buffers
use object FIFO_STREAM as buffer     'controller buffer
dim dataeventid as dword=0 'eventid of data event

//Keyboard controller registers
dim cmd_value as byte 'last command (writen to CMD_PORT)
dim cmd_byte as byte  'command byte (get/set by commands 20h/60h)
dim state_value as byte 'controller state 
dim last_data as byte 'to preserve last readed value

//Keyboard mode flags (from cmd_byte bits)
function IRQAllowed as boolean 'allowed IRQ when buffer has data
         result=((cmd_byte and 1)<>0) and (DEVPARAM_IRQ>=0) : end
function KEYBEnabled as boolean 'can data be send/receive data by keyboard //TODO
         result=(cmd_byte and 0x10)=0 : end
function XTProtocolMode as boolean 'PC/XT protocol mode (no parity checking) //TODO
         result=(cmd_byte and 0x20)<>0 : end
function XTScancodeMode as boolean 'PC/XT scancode mode (scancode set 1) 
         result=(cmd_byte and 0x40)<>0 : end

//Matrix of virtual key states
dim vkey_state(256) as boolean 'pressed/released currently
dim last_vkey_pressed as byte=VK_NONE 'to autorepeat it

//Variables
dim irq_pending as boolean=false 'unhandled IRQ is pending
dim allow_read_next as boolean=false 'is data port allowed to read next data
dim eventid_repeat as dword=0 'event identifier of autorepeat key events
dim autorepeat_pending as boolean=false 'autorepeat need to be activated
dim i as integer, b as byte, i64 as int64

'--------------------------Internal port decoders -----------------------------

//Input port (from keyboard to controller) value
property input_port(value as byte) : end 'ignored //TODO
function input_port as byte //TODO
     //Bit 0 - keyboard data in pin??
     //Bit 1 - PS/2 mouse in pin??
     //Bit 2-4 - reserved???
     //Bit 5 - loop POST flag (=0 - burn-in mode)
     //Bit 6 - color or mono screen???
     //Bit 7 - keyboard locked (0) or unlocked (1)
     result=0x80 'keyb unlocked 
     result=result or 0x20 'no need loop POST
end

//Output port (from controller to motherboard) value
property output_port(value as byte)  //TODO
     //Bit 0 (reset system??? / 0 - yes)
       if (value and 1)=0 then pc.Restart
     //Bit 1 (A20 gate enable / 1 - yes)
     if (value and 2)<>0 then : cpu.AddressMask=cpu.AddressMask or 0x100000
        ?? DebugPrefix;"A20=on" : else 
        cpu.AddressMask=cpu.AddressMask and (not 0x100000) 
        ?? DebugPrefix;"A20=off" : end if
     //Bit 2 (PS/2 mouse data out)
     //Bit 3 (PS/2 mouse clock signal)
     //Bit 4 (Output buffer if keyb full flag / 1 - yes)
     //Bit 5 (Output buffer of PS/2 mouse full / 1 - yes)
     //Bit 6 (Keyboard clock signal)
     //Bit 7 (Keyboard data out)
end 

function output_port as byte //TODO
     result=1 'no reset system
     result=result or iif((cpu.AddressMask and 0x100000)=0,0,2) //A20 gate flag
     if buffer.size>=MAX_BUFFER_SIZE then result=result or 0x10 //buff.full???
end

'---------------------------- Reset procedures --------------------------------

//Clear buffer
procedure ClearBuffer
 buffer.size=0 : dataeventid=dataeventid+1 : irq_pending=false
 state_value=state_value and (not 1) : allow_read_next=false
end

//Reset to default values
procedure ResetToDefaults 
 ClearBuffer : eventid_repeat=eventid_repeat+1 : cmd_value=0 : irq_pending=false
 state_value=0x14 : input_port=0x82 
 output_port=(output_port and 2) or 0xB1 //FreeDos A20 check insists to not touch A20 line here???
 cmd_byte=0x01 or 0x20 or 0x40 //Enabled, IRQ, XT Modes
 last_data=0xFF
end

'------------------------------ Buffer processing -----------------------------

//Raise IRQ and/or change data flag, when data byte arrived or readed
procedure UpdateIRQ
 if buffer.size=0 then 'clear flag
   state_value=state_value and (not 1) 
 else 'set flag and raise IRQ
   state_value=state_value or 1
   irq_pending=(IRQAllowed) and (DEVPARAM_IRQ>=0) and _
               (not pc.SetIRQ(DEVPARAM_IRQ,true))
end if 
 ?? DebugPrefix;"UpdateIRQ: pending=";irq_pending
end

//New data byte event (initiated after writing new data to emprty buffer)
function NewEvent(freq as integer,eventid as dword) as boolean
 if eventid<>dataeventid then : result=false : exit : end 'deprecated event
 ?? DebugPrefix;"NewEvent(";freq;",";eventid;")"
 result=(cmd_byte and 0x10)<>0
 state_value=state_value or 1 'new data pending
 if not(result) then 'keyboard enabled
   UpdateIRQ 'update IRQ and data flag state
   allow_read_next=true
 end if
end

//Write data to output buffer
function WriteBuf(value as int64, size as byte=1) as boolean
 ?? DebugPrefix;"WriteBuf(";Hex(Value,shl(size,1));",";size;")"
 if buffer.size+size>MAX_BUFFER_SIZE then 
    result=false 'TODO - noisy beep
 else 'writing to buffer 
   dim i as integer
   for i=1 to size : buffer.PushByte(value) : value=shr(value,8) : next
   if buffer.size=size then 'if buffer was empty before
      dataeventid=dataeventid+1 'disable old event
      pc.NewFreqEvent(DATA_PENDING_FREQ,dataeventid)=NewEvent 'register event
      allow_read_next=false 'need to wait timed event
   end if
   result=true
end if : end

'-------------------------------- H/W Interface -------------------------------

//Write command port
public property CMD_PORT(Value as byte)
// dbg.Break
 ?? DebugPrefix;">CmdPort=";Hex(Value,2);"h"
 if (state_value and 2)<>0 then : ?? ,"kbc busy, command skipped!" : exit : end
 state_value=state_value or 8 //writing to command port state flag
 cmd_value=0 //no need additional data via DATA_PORT (by default)
 select case Value 'process command
 case 0x20 : ClearBuffer : WriteBuf(cmd_byte) //get command byte
 case 0x60 : cmd_value=Value //set command byte
 case 0xA1 : ClearBuffer : WriteBuf(0x10) //kbc firmware version //TOCHECK
 case 0xA4 : ClearBuffer : WriteBuf(0xF1) //has password (no) //TODO
// case 0xA5 : cmd_value=Value //set new password //TODO
// case 0xA6 : //verify password //TODO
// case 0xA7 : //disable mouse //TODO
// case 0xA8 : //enable mouse //TODO
// case 0xA9 : ClearBuffer : WriteBuf(0x00) //test mouse //TODO
 case 0xAA : ClearBuffer : WriteBuf(0x55) //: state_value=state_value or 4 //test kbc
 case 0xAB : ClearBuffer : WriteBuf(0x00) //test keyboard (clock and data lines) //TOCHECK
// case 0xAC //diagnostic dump //TODO
 case 0xAD : cmd_byte=cmd_byte or 0x10 //disable keyboard
 case 0xAE : cmd_byte=cmd_byte and (not 0x10) //enable keyboard
 case 0xAF : ClearBuffer : WriteBuf(0x10) //version???
 case 0xC0 : ClearBuffer : WriteBuf(input_port)  'read input port
//case 0xC1 'combine part of input port with status port to read both //TODO
//case 0xC2 'combine part of input port with status port to read both //TODO
 case 0xD0 : ClearBuffer : WriteBuf(output_port) 'read output port 
 case 0xD1 : cmd_value=Value //write output port
 case 0xE0 : ClearBuffer : WriteBuf(0x00) //read test port //TODO
 case 0xEE : ClearBuffer : WriteBuf(0xEE) //echo
 case 0xFF : ResetToDefaults : WriteBuf(0xAAFA,2) //reset keyboard //TOCHECK
 case 0xF6 : ResetToDefaults : WriteBuf(0xFA,1) //reset to defaults
 case 0xF5 : ResetToDefaults : WriteBuf(0xFA,1) //reset to defaults and disable keyb //TOCHECK
      cmd_byte=cmd_byte or 0x10 
 case 0xF4 : ClearBuffer //enable keyboard and clear buffer
      cmd_byte=cmd_byte and (not 0x10) : WriteBuf(0xFA,1)
 case 0xF3 : ClearBuffer : WriteBuf(0xFA,1) : cmd_value=Value //keyrate //TODO
 case 0xED : ClearBuffer : WriteBuf(0xFA,1) : cmd_value=Value //leds //TODO
 case /*0xF2,*/0xFE,0xFC : cpu.Reset : state_value=state_value or 4 //reset CPU
 case 0xF7 to 0xFD, 0xEF to 0xF2 : ClearBuffer : WriteBuf(0xFA,1) //NOP
 case 0x00 : ClearBuffer : WriteBuf(0xFA,1) //some soft need it //TOCHECK
 case else
  ?? DebugPrefix;">Unknown command =";Hex(Value,2);"h"
  ClearBuffer : WriteBuf(0xFA,1) 'asknowledge unknown command
 end select
end

//Read state port 
public function STATE_PORT as byte
 //Bit 0 (outgoing data pending flag)
   //if buffer.size>0 then : state_value=state_value or 1 
   //  else : state_value=state_value and (not 1) : end if
 //Bit 1 (incoming data processed flag)
   state_value=state_value and (not 2) 'controller has read all incoming data
 //Bit 2 (system flag, set/reset by commands)
 //Bit 3 (cmd/data flag - if target port was CMD_POR = 1, if DATA_PORT = 0)
 //Bit 4 (inhibit flag - ??? //TODO)
   state_value=state_value or 0x10 'System unit keylock, by BIOS????
 //Bit 5 (transmit time-out - set to 1 if error)
   state_value=state_value and (not 0x20) 'no error
 //Bit 6 (receive time-out - set to 1 if error)
   state_value=state_value and (not 0x40) //TODO - used when testing KBC ?
 //Bit 7 (odd/even transmision parity - set to 1 if last byte had even parity)
   state_value=state_value and (not 0x80) //TODO - used when testing KBC ?
 //Make result
 result=state_value
 //?? DebugPrefix;"<StatePort=";Hex(result,2);"h"
end

//Write data port
public property DATA_PORT(Value as byte)
 ?? DebugPrefix;">DataPort=";Hex(Value,2);"h"
 //if no command, then data value is really command value??
 if cmd_value=0 then : CMD_PORT=value : exit : end
 state_value=state_value and (not 8) //writing to data state port flag
 select case cmd_value 'processing command
 case 0xED //leds
   cmd_value=0 : ClearBuffer : WriteBuf(0xFA,1) //TODO
 case 0xF3 //keyrate
   cmd_value=0 : ClearBuffer : WriteBuf(0xFA,1) //TODO
 case 0x60 //command byte //TOCHECK
      cmd_value=0 
      cmd_byte=Value //set command byte
      state_value=(state_value and (not 4)) or (Value and 4) 'system flag
      if (value and 8)<>0 then 'inhibit override //TOCHECK - correct???
         state_value=state_value and (not 0x10) : end if 'no inhibited
      ?? ,"IRQAllowed=";IRQAllowed;" KeybEnabled=";KeybEnabled;
      ?? ,"XTProtocol=";XTProtocolMode;" XTScancodes=";XTScancodeMode
 case 0xA5 //new password
  if Value=0 then cmd_value=0 //TODO
 case 0xD1 //write to out port
  cmd_value=0 : output_port=Value  //TOCHECK
  //if (Value and 0x10)<>0 then irq_count=irq_count+1
 case else
  if cmd_value<>0 then ?? DebugPrefix;">Unknown command =";Hex(cmd_value,2);"h"
  cmd_value=0
 end select
end

//Next data byte event (initiated after reading old data byte)
function NextEvent(freq as integer,eventid as dword) as boolean
 if eventid<>dataeventid then : result=false : exit : end 'deprecated event
 ?? DebugPrefix;"NextEvent(";freq;",";eventid;")"
 result=(cmd_byte and 0x10)<>0
 if not(result) then 'keyboard enabled
   if buffer.size>0 then last_data=buffer.PopByte 'remove old data from buffer
   UpdateIRQ 'update IRQ and data flag state
   allow_read_next=true
 end if
end

//Read data port
public function DATA_PORT as byte
 if buffer.size=0 then 'buffer empty
    result=last_data  
 else 'read data from buffer
    if allow_read_next then
     dataeventid=dataeventid+1 'disable old event
     pc.NewFreqEvent(DATA_PENDING_FREQ,dataeventid)=NextEvent 'register event
     allow_read_next=false
    end if
    result=buffer.PopByte(false) 'read, but not remove yet
    state_value=state_value and (not 1) 'no new data pending
 end if
 ?? DebugPrefix;"<DataPort=";Hex(result,2);"h"
end

//Handle key from emulator (convert to scancode and place to buffer)
public procedure HandleKey(vkey as byte, pressed as boolean)
 ?? DebugPrefix;">VKey=";Hex(vkey,2);"h (";iif(pressed,"DOWN","UP");")";
 dim can_autorepeat as boolean=last_vkey_pressed<>vkey
 last_vkey_pressed=VK_NONE : autorepeat_pending=false 
 dim scode as int64, scode_size as byte
 scode=iif(pressed,ATKeyDown(vkey,0),ATKeyUp(vkey,0))
 scode_size=iif(pressed,ATKeyDown(vkey,1),ATKeyUp(vkey,1))
 if scode_size>0 then //known key/scancode
   if pressed then 'key pressed
      last_vkey_pressed=vkey 
      if can_autorepeat then 'init autorepeat event
         autorepeat_pending=true
         eventid_repeat=eventid_repeat+1 'to discard old events
      end if
   end if
   WriteBuf(scode,scode_size) 'write to buffer
   ?? " (ScanCode=";Hex(scode,2*scode_size);"h)";
 end if
 ?? 'finish printed string
end

//Autorepeat event (initiated by delay event)
function RepeatEvent(freq as integer,eventid as dword) as boolean
 if (last_vkey_pressed<>VK_NONE) and (eventid=eventid_repeat) then //make event
   HandleKey(last_vkey_pressed,true) 'emulate virtual key pressing
   result=true
 else
  result=false 'no need next event
 end
end

//Autorepeat delay event (initiated by irq processing event)
function DelayEvent(freq as integer,eventid as dword) as boolean
 result=false 'no need next event
 if (last_vkey_pressed<>VK_NONE) and (eventid=eventid_repeat) then //make event
   pc.NewFreqEvent(KEY_REPEAT_FREQ,eventid)=RepeatEvent //register event
 end if
end

//Unhandled IRQ's processing event
function IRQEvent(freq as integer,eventid as dword) as boolean
 result=true 'need next event
 if autorepeat_pending then 'activate autorepeat delay event
    autorepeat_pending=false
    eventid_repeat=eventid_repeat+1 'to discard old events (safer to duplicate)
    pc.NewFreqEvent(KEY_DELAY_FREQ,eventid_repeat)=DelayEvent //register event
 end
 if irq_pending then irq_pending=not(pc.SetIRQ(DEVPARAM_IRQ,true))
end

'---------------------------- DEVICE Interface --------------------------------

//Device initialization
public function DEV_INIT(stream as object,byref EventFreq as integer) as boolean

 'parent call
 if not DEV_INIT(stream,EventFreq) then exit(false)
 if EventFreq<2000 then EventFreq=2000

 'set initial data
 ResetToDefaults

 //register events
 pc.NewFreqEvent(50)=IRQEvent '50HZ - sufficient for keyboard

 //success
 result=true

end 

       
