'******************************************************************************
'* 
'* UART/COM (SERIAL PROTOCOL DEVICE) i8250 v.1.0 (CHIP DEVICE)
'*
'* Version history:
'*  - 03.01.2009 - initial emulation by WadiM
'*
'****************************************************************************** 

//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="COM i8250"
DebugName="COM_I8250"

protected const MAX_BUFFER_SIZE=1024 'max size of buffers (in bytes)

//Constants
const MCR_LOOPBACK_ENABLED as byte=0x10 'loopback enabled if not zero
const LSR_TRANSMIT_EMPTY as byte=0x40 'transmitter empty
const LSR_TRANSMIT_REG_EMPTY as byte=0x20 'transmit holding register empty
const LSR_RECEIVER_REG_FULL as byte=0x01 'receiver buffer register full
const LSR_OVERRUN_ERROR as byte=0x02 'old symbol lost
const IER_RECEIVE_INTR as byte=0x01 'allow interrupt after data received
const IER_TRANSMIT_INTR as byte=0x02 'allow interrupt after data transmited

//Settings
protected dim Loopback as boolean=false 'loopback/diagnostic mode enabled (LME)
protected dim AllowDataLosses as boolean=true 'if new data arrived

//Register values
protected dim THR_Value as byte, RBR_Value as byte, IER_Value as byte, FCR_Value as byte
protected dim IIR_Value as byte, LCR_Value as byte, MCR_Value as byte, LSR_Value as byte
protected dim MSR_Value as byte, SCR_Value as byte, DLL_Value as byte, DLM_Value as byte

//Buffers of received/transmitted values 
protected use object FIFO_STREAM as receive_buffer
protected use object FIFO_STREAM as transmit_buffer

'-------------------------- Receive/Transmit Events ---------------------------

//Receive data byte event 
dim receive_eventid as dword=0 'deprecated event flag
function ReceiveEvent(freq as integer,eventid as dword) as boolean
 if eventid<>receive_eventid then : result=false 'deprecated event
 elseif receive_buffer.size=0 then : result=true
 else //receive new data byte from buffer
  if (LSR_Value and LSR_RECEIVER_REG_FULL)=0 then
     LSR_Value=LSR_Value or LSR_RECEIVER_REG_FULL 'receiver data ready
  else
     if not AllowDataLosses then : result=true : exit : end
     LSR_Value=LSR_Value or LSR_OVERRUN_ERROR 'old data byte lost
  end if
  RBR_Value=receive_buffer.PopByte 
  ?? DebugPrefix;"Receive Event ";Hex(RBR_Value,2)
  'raise interrupt if allowed
  if ((IER_Value and IER_RECEIVE_INTR)<>0) and (DEVPARAM_IRQ>=0) then
     pc.SetIRQ(DEVPARAM_IRQ,false) 'stop previous IRQ request (if it exists)
     IIR_Value=(IIR_Value and 0xF8) or 4 'kind of IRQ (data received)
     pc.SetIRQ(DEVPARAM_IRQ,true) 'raise new IRQ request
     ?? DebugPrefix;"Receive IRQ";DEVPARAM_IRQ;" raised"
  end if
//  dbg.Break
 result=true : end if
end

//Transmit data byte event 
dim transmit_eventid as dword=0 'deprecated event flag
function TransmitEvent(freq as integer,eventid as dword) as boolean
 if eventid<>transmit_eventid then : result=false 'deprecated event
 else //transmit new data byte from buffer
  if transmit_buffer.size>0 then
     dim b as byte=transmit_buffer.PopByte
     if Loopback then 'return sent value
        ?? DebugPrefix;"Transmit Event (Loopback) ";Hex(b,2)
        if receive_buffer.size<MAX_BUFFER_SIZE then receive_buffer.PushByte(b)
     else
        'simply skip it - until some COM-port-connected device emulation
        ?? DebugPrefix;"Transmit Event (Skip) ";Hex(b,2)
     end if
  end if
  //check value in transmit register
  if (LSR_Value and LSR_TRANSMIT_REG_EMPTY)=0 then 
     if transmit_buffer.size<MAX_BUFFER_SIZE then transmit_buffer.PushByte(THR_Value)
     LSR_Value=LSR_Value or LSR_TRANSMIT_REG_EMPTY
     'raise interrupt if allowed
     if ((IER_Value and IER_TRANSMIT_INTR)<>0) and (DEVPARAM_IRQ>=0) then
       pc.SetIRQ(DEVPARAM_IRQ,false) 'stop previous IRQ request (if it exists)
       IIR_Value=(IIR_Value and 0xF8) or 2 'kind of IRQ (data transmitted)
       pc.SetIRQ(DEVPARAM_IRQ,true) 'raise new IRQ request
       ?? DebugPrefix;"Transmit IRQ";DEVPARAM_IRQ;" raised"
     end if
     ?? DebugPrefix;"Transmit Event (Push) ";Hex(THR_Value,2)
  end if
  //check is transit buffer is empty
  if transmit_buffer.size=0 then
     LSR_Value=LSR_Value or LSR_TRANSMIT_REG_EMPTY or LSR_TRANSMIT_EMPTY
  end if
   //dbg.Break
 result=true : end if
end

//Reset device state
procedure ResetDevice
 receive_eventid=receive_eventid+1 : transmit_eventid=transmit_eventid+1
 receive_buffer.size=0 : transmit_buffer.size=0 : RBR_Value=0xFF
 LSR_Value=LSR_TRANSMIT_REG_EMPTY or LSR_TRANSMIT_EMPTY
 IIR_Value=1 'no interrupt
 pc.NewFreqEvent(2000,receive_eventid)=ReceiveEvent
 pc.NewFreqEvent(2000,transmit_eventid)=TransmitEvent
end

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

//0H - Transmit Holding Register (write only)
public property THR_PORT(Value as byte)
 if (LSR_Value and LSR_TRANSMIT_REG_EMPTY)<>0 then
    THR_Value=Value 
    LSR_Value=LSR_Value and (not(LSR_TRANSMIT_REG_EMPTY or LSR_TRANSMIT_EMPTY))
 end if    
 IIR_Value=1 'clear IRQ request
 ?? DebugPrefix;">TRANSMIT_PORT(0)=";Hex(value,2)
end

//0H - Receiver Buffer Register (read only)
public function RBR_PORT as byte 
 result=RBR_Value
 if (LSR_Value and LSR_RECEIVER_REG_FULL)<>0 then
    //result=RBR_Value
    LSR_Value=LSR_Value and (not LSR_RECEIVER_REG_FULL)
// else : result=0xFF : end if
 end if

 IIR_Value=1 'clear IRQ request
 ?? DebugPrefix;"<RECEIVE_PORT(0)=";Hex(result,2)
 //?? "MEM=";Hex(mem.Byte(0x46C),2)
end

//1H - Interrupt Enable Register (read/write)
public property IER_PORT(Value as byte )
 IER_Value=Value and 0xF
 IIR_Value=IER_Value //TOCHECK - why Bochs BIOS want it to detect COM port??? 
 ?? DebugPrefix;">INTR_MASK_PORT(1)=";Hex(value,2)
end

//1H - Interrupt Enable Register (read/write)
public function IER_PORT as byte 
 result=IER_Value
 ?? DebugPrefix;"<INTR_MASK_PORT(1)=";Hex(result,2)
end

//2H - FIFO Control Register (write only)
public property FCR_PORT(Value as byte)
 FCR_Value=Value
 ?? DebugPrefix;">FIFO_CTRL_PORT(2)=";Hex(value,2)
end

//2H - Interrupt Identification Register (read only)
public function IIR_PORT as byte 
 result=IIR_Value
 ?? DebugPrefix;"<INTR_IDENT_PORT(2)=";Hex(result,2)
end

//3H - Line Control Register (read/write)
public property LCR_PORT(Value as byte)
 LCR_Value=Value
 if (LCR_Value and 0x80)<>0 then ResetDevice
 ?? DebugPrefix;">LINE_CTRL_PORT(3)=";Hex(value,2)
end

//3H - Line Control Register (read/write)
public function LCR_PORT as byte 
 result=LCR_Value
 ?? DebugPrefix;"<LINE_CTRL_PORT(3)=";Hex(result,2)
end

//4H - Modem Control Register (read/write)
public property MCR_PORT(Value as byte)
 MCR_Value=Value and 0x1F
 Loopback=(Value and MCR_LOOPBACK_ENABLED)<>0
 if Loopback then
    //MCR_Value=(MCR_Value and 0xF) or (Value and 0xF0)
    MSR_Value=MSR_Value and 0x0F
    MSR_Value=MSR_Value or shl(Value and 1,5)
    MSR_Value=MSR_Value or shl(Value and 2,3)
    MSR_Value=MSR_Value or shl(Value and 0xC,4)
 //else : MCR_Value=Value 
 end if
 ?? DebugPrefix;">MODEM_CTRL_PORT(4)=";Hex(value,2)
end

//4H - Modem Control Register (read/write)
public function MCR_PORT as byte 
 result=MCR_Value
 ?? DebugPrefix;"<MODEM_CTRL_PORT(4)=";Hex(result,2)
end

//5H - Line Status Register (read/write)
public property LSR_PORT(Value as byte)
 LSR_Value=Value
 ?? DebugPrefix;">LINE_STS_PORT(5)=";Hex(value,2)
end

//5H - Line Status Register (read/write)
public function LSR_PORT as byte 
 result=LSR_Value : LSR_Value=LSR_Value and (not 0x1E) 'clear errors
 ?? DebugPrefix;"<LINE_STS_PORT(5)=";Hex(result,2)
end

//6H - Modem Status Register (read/write)
public property MSR_PORT(Value as byte)
 if Loopback then
    MSR_Value=(MSR_Value and 0xF0) or (Value and 0xF)
 else
    MSR_Value=Value
 end
 ?? DebugPrefix;">MODEM_STS_PORT(6)=";Hex(value,2)
end

//6H - Modem Status Register (read/write)
public function MSR_PORT as byte 
 result=MSR_Value
 ?? DebugPrefix;"<MODEM_STS_PORT(6)=";Hex(result,2)
end

//7H - Scratch Pad Register (read/write)
public property SCR_PORT(Value as byte)
 SCR_Value=Value
 ?? DebugPrefix;">SCRATCH_STS_PORT(7)=";Hex(value,2)
end

//7H - Scratch Pad Register (read/write)
public function SCR_PORT as byte 
 result=SCR_Value
 ?? DebugPrefix;"<SCRATCH_PORT(7)=";Hex(result,2)
end

//0H+ - Divisor Latch LSB (read/write)
public property DLL_PORT(Value as byte)
 DLL_Value=Value
 ?? DebugPrefix;">DIV_LSB_PORT(0)=";Hex(value,2)
end

//0H+ - Divisor Latch LSB (read/write)
public function DLL_PORT as byte 
 result=DLL_Value
 ?? DebugPrefix;"<DIV_LSB_PORT(0)=";Hex(result,2)
end

//1H+ - Divisor Latch MSB (read/write)
public property DLM_PORT(Value as byte )
 DLM_Value=Value
 ?? DebugPrefix;">DIV_MSB_PORT(1)=";Hex(value,2)
end

//1H+ - Divisor Latch MSB (read/write)
public function DLM_PORT as byte 
 result=DLM_Value
 ?? DebugPrefix;"<DIV_MSB_PORT(1)=";Hex(result,2)
end

'---------------------------- H/W All I/O Ports -------------------------------

'Write all standard ports
public property PORTS(Index as word, Value as byte)
  select case Index-DEVPARAM_PORT
  case 0 : if (LCR_Value and 0x80)=0 then THR_PORT=Value else DLL_PORT=Value
  case 1 : if (LCR_Value and 0x80)=0 then IER_PORT=Value else DLM_PORT=Value
  case 2 : FCR_PORT=Value
  case 3 : LCR_PORT=Value
  case 4 : MCR_PORT=Value
  case 5 : LSR_PORT=Value
  case 6 : MSR_PORT=Value
  case 7 : SCR_PORT=Value
  case else : ?? DebugPrefix;">UNKNOWN_PORT(";Index-DEVPARAM_PORT;")=";Hex(value,2)
 end select
end

'Read all standard ports
public function PORTS(Index as word) as byte
 select case Index-DEVPARAM_PORT
  case 0 : if (LCR_Value and 0x80)=0 then result=RBR_PORT else result=DLL_PORT
  case 1 : if (LCR_Value and 0x80)=0 then result=IER_PORT else result=DLM_PORT
  case 2 : result=IIR_PORT
  case 3 : result=LCR_PORT
  case 4 : result=MCR_PORT
  case 5 : result=LSR_PORT
  case 6 : result=MSR_PORT
  case 7 : result=SCR_PORT
  case else : result=0xFF
       ?? DebugPrefix;"<UNKNOWN_PORT(";Index-DEVPARAM_PORT;")=";Hex(result,2)
 end select
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

 ResetDevice

 //success
 result=true
end

