'******************************************************************************
'* 
'* PROGRAMMABLE INTERRUPT CONTROLLER i8259 (CHIP DEVICE)
'*
'* Used to provide IRQ processing
'*
'* Supported platform/bus: X86
'* 
'* Version history:
'*  - 2007-2009 by WadiM (initial emulation and fixes)
'*
'****************************************************************************** 

//DEBUG.ON 'uncomment to enable debug messages (can be slow for hi-freq events)
//DIRECT.OFF 'uncomment to always use scripted implementation (non-internal)

//device interface support
public use object DEVICE

'internal implementation (direct)
public use internal "PIC8259"

//device name
DeviceName="PIC i8259"
DebugName="PIC_I8259"

//Registers
dim IRR as byte=0 'interrupt request register (requested interrupts, if bit set)
dim ISR as byte=0 'interrupt status register (serviced interrupts, if bit set) 
dim IMR as byte=0 'interrupt mask register (masked interrupts, if bit set) 
dim IRRs(8) as dword 'interrupt request counters (count pending requests)

//Initialization Command Words
dim ICW1 as byte=0, ICW2 as byte=0, ICW3 as byte=0, ICW4 as byte=0
dim ICWFlags as byte=0 'flags of ICWs, which need to be programmed

//Operation Command Words
dim OCW1 as byte=0, OCW2 as byte=0, OCW3 as byte=0

//Parameters
dim MaxPriorityIndex as byte=0 'index of irq with highest priority (0-7)
dim IRQ0VectorIndex as byte=0 'index of cpu interrupt for irq0
dim PortReadMode as byte=2 'port0 read mode (2 or 3)

//Work modes
const wmAutoRotate as byte=1 : const wmAutoEOI as byte=2 
const wmSpecialMask as byte=2 : const wmPolling as byte=3
dim WorkMode as byte=0 'work mode flags

'------------------------------- Tools ----------------------------------------

//Get IRQ priority
function GetPriority(Index as byte) as byte
 dim i as integer : for i=0 to 7 
 if Index=MaxPriorityIndex then exit(i) 
 if Index=0 then Index=7 else Index=Index-1 
next i : end

function MaxPriorityIndexFromISR(byref Index as byte) as boolean
 dim i as integer : result=false : if ISR<>0 then
 Index=MaxPriorityIndex : for i=0 to 7
 if (ISR and shl(1,Index))=0 then : Index=Index+1
 if Index>7 then Index=0 : else : exit(true) : end if 
next i : end if : end

function MaxPriorityIndexFromIRR(byref Index as byte) as boolean
 dim i as integer, b as byte
 //pending=requested-masked-serviced
 result=false : b=IRR and (not IMR) and (not ISR) 
 if (b=0) or (ICWFlags<>0) or ((WorkMode and wmPolling)<>0) then exit //TOCHECK
 //scan pending interrupts
 Index=MaxPriorityIndex : for i=0 to 7
   //if interrupt found, then search completed
   if (b and shl(1,Index))<>0 then : result=true : exit for : end if
   //else rotate index
   Index=Index+1 : if Index>7 then Index=0
 next i
 //check obtained interrupt (must have more priority then serviced)
 if (result) and ((WorkMode and wmSpecialMask)=0) and _
    (MaxPriorityIndexFromISR(b)) and (GetPriority(b)<GetPriority(Index)) _
    then result=false //can not process this interrupt currently
end

'-------------------------------- ICWs ----------------------------------------

//ICW1
procedure SetICW1(value as byte)
 ICW1=Value : ICW2=0 : ICW3=0 : ICW4=0
 ISR=0 : IMR=0 : IRR=0 : ERASE IRRs
 IRQ0VectorIndex=0 : WorkMode=0 : PortReadMode=2 //IRR
 MaxPriorityIndex=0 : ICWFlags=1 'ICW2 needed always
 if (ICW1 and 2)=0 then ICWFlags=ICWFlags or 2 'need ICW3 (cascading)
 if (ICW1 and 1)<>0 then ICWFlags=ICWFlags or 4 'need ICW4
 ?? DebugPrefix;">ICW1=";Hex(Value,2);"h"
end

//ICW2
procedure SetICW2(value as byte)
 ICWFlags=ICWFlags and (not 1) 'no more ICW2 needed
 ICW2=Value : IRQ0VectorIndex=Value and 0xF8 //TOCHECK
 ?? DebugPrefix;">ICW2=";Hex(Value,2);"h"
end

//ICW3
procedure SetICW3(value as byte)
 ICWFlags=ICWFlags and (not 2) 'no more ICW3 needed
 ICW3=Value //TODO - cascading
 ?? DebugPrefix;">ICW3=";Hex(Value,2);"h"
end

//ICW4
procedure SetICW4(value as byte)
 ICW4=Value : ICWFlags=ICWFlags and (not 4) 'no more ICW4 needed
 //interrupt auto-finishing mode (auto EOI)
 if (ICW4 and 2)<>0 then : WorkMode=WorkMode or wmAutoEOI
    else WorkMode=WorkMode and (not wmAutoEOI) : end if
 ?? DebugPrefix;">ICW4=";Hex(Value,2);"h"
end

'-------------------------------- OCWs ----------------------------------------

//OCW1
procedure SetOCW1(value as byte)
 OCW1=Value : IMR=Value 'interrupt mask
 ?? DebugPrefix;">OCW1(IMR)=";Hex(Value,2);"h"
 //dbg.Break
end

//OCW2
procedure SetOCW2(value as byte)
 ?? DebugPrefix;">OCW2=";Hex(Value,2);"h"
 OCW2=Value 
 Select Case Value and 0xF8
   Case 0x20 //finish highest-priority interrupt and set priority
     WorkMode=WorkMode and (not wmPolling) //TOCHECK
     if MaxPriorityIndexFromISR(Value) then 
        ISR=ISR and (not shl(1,Value and 7)) //clear flag
        if (WorkMode and wmAutoRotate)<>0 then : MaxPriorityIndex=Value+1 
           if MaxPriorityIndex>7 then MaxPriorityIndex=0 : end if : end if
   Case 0x60 //finish specified interrupt
     ISR=ISR and (not shl(1,Value and 7)) //clear flag
     if (WorkMode and wmAutoRotate)<>0 then : MaxPriorityIndex=(Value and 7)+1 
        if MaxPriorityIndex>7 then MaxPriorityIndex=0 : end if 
   Case 0xA0 //finish highest-priority interrupt and rotate priority
     WorkMode=WorkMode and (not wmPolling) //TOCHECK
     if MaxPriorityIndexFromISR(Value) then 
        ISR=ISR and (not shl(1,Value and 7)) //clear flag
     end if
     MaxPriorityIndex=MaxPriorityIndex+1  
     if MaxPriorityIndex>7 then MaxPriorityIndex=0
   Case 0xE0 //finish specified interrupt and set priority
     ISR=ISR and (not shl(1,Value and 7)) : MaxPriorityIndex=(Value and 7)+1 
     if MaxPriorityIndex>7 then MaxPriorityIndex=0
   Case 0x80 //set autorotate mode
     WorkMode=WorkMode or wmAutoRotate
   Case 0 //clear autorotate mode
     WorkMode=WorkMode and (not wmAutoRotate)
   Case 0xC0 //set priority
     MaxPriorityIndex=(Value and 7)+1
     if MaxPriorityIndex>7 then MaxPriorityIndex=0
End Select : end

procedure SetOCW3(value as byte)
 ?? DebugPrefix;">OCW3=";Hex(Value,2);"h"
 OCW3=Value :  select case (Value and 7)
 case 4 to 7: WorkMode=WorkMode or wmPolling //polling mode
 case 2 to 3: PortReadMode=Value and 7 //port0 read mode 
 end select
 //special mask mode
 if (Value and 0x40)<>0 then : if (Value and 0x20)<>0 then 
 WorkMode=WorkMode or wmSpecialMask : else 
 WorkMode=WorkMode and (not wmSpecialMask) : end if : end if
end

'-------------------------------- S/W Interface -------------------------------

//Has IRQ (service function - used to check specific IRQ request)
public function HasIRQ(Index as byte) as boolean
 result=(IRR and shl (1,Index))<>0
end direct HasIRQ

//Has IRQs (service function - used to check IRQ requests)
public function HasIRQs as boolean
 result=IRR<>0
end direct HasIRQs

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

//Real PIC can register only one interrupt request of some level (in IRR). 
//But in emulation better to register bigger number of requests, because in
//other case some of them could be lost by various reasons (especially in case
//of massive flood of interrupts from various high-frequency timers). So the 
//next parameter can be used to configure amount of registered interrupts.
//But this number must not be too big, because CPU may be simply disabled 
//interrupt processing at this moment, and when it finally enabled it, big 
//number of pending requests of various priorities can cause a mess
//(overflow stack, block current important interrupts, etc.)
public dim MaxRegisteredIRQs as integer=16 'for each IRQ index

//Write port 0
public property Port0(Value as byte)
 ?? DebugPrefix;">Port0=";Hex(Value,2);"h"
 Select Case Value and 0x18
   Case 0x0  : SetOCW2(Value) //bits 3 and 4 cleared
   Case 0x8  : SetOCW3(Value) //bit 3 set, bit 4 cleared
   Case Else : SetICW1(Value) //bit 4 set
 End Select 
 //?? "IMR=";Hex(IMR,2)
end direct Port0

//Read port 0
public function Port0 as byte
 if (WorkMode and wmPolling)<>0 then //polling mode
    WorkMode=WorkMode and (not wmPolling) //TOCHECK
    if MaxPriorityIndexFromIRR(result) then 
       SetOCW2(0x20) : result=0x80 or result //clear interrupt
       else : result=0 : end if
 elseif PortReadMode=2 then : result=IRR
 elseif PortReadMode=3 then : result=ISR
 else result=0 : end if
 ?? DebugPrefix;"<Port0=";Hex(result,2);"h"
 //dbg.Break
end direct Port0

//Write port 1
public property Port1(Value as byte)
 ?? DebugPrefix;">Port1=";Hex(Value,2);"h"
 if (ICWFlags and 7)<>0 then 
       if (ICWFlags and 1)<>0 then : SetICW2(Value)
   elseif (ICWFlags and 2)<>0 then : SetICW3(Value)
   elseif (ICWFlags and 4)<>0 then : SetICW4(Value) : end if
 else : SetOCW1(Value) : end if
 //dbg.Break
// ?? "IMR=";Hex(IMR,2)
end direct Port1

//Read port 1
public function Port1 as byte
 result=IMR //TOCHECK 
 ?? DebugPrefix;"<Port1=";Hex(result,2);"h"
end direct Port1

//Set IRQ
public function SetIRQ(Index as integer, State as boolean) as boolean
// ?? DebugPrefix;"SetIRQ(";Hex(Index,2);"h, ";State;")"
 if (Index<0) or (Index>7) then //TODO - cascading
    result=false
 else :  dim dw as dword=IRRs(Index) 
  if not(State) then //unregister IRQ
     if dw=0 then : result=false : else : result=true
        IRRs(Index)=dw-1 : if dw=1 then IRR=IRR and (not shl(1,Index)) 
     end if
  elseif dw>=MaxRegisteredIRQs then //can not register IRQ
     result=false
  else //register IRQ
     IRRs(Index)=dw+1 : if dw=0 then IRR=IRR or shl(1,Index)
     result=true 
   end if : end if
end direct SetIRQ

//Get IRQ
public function GetIRQ(Process as boolean,byref Address as dword) as integer
 dim Index as byte  
 //?? DebugPrefix;"GetIRQ(";Process;") IRR=";Hex(IRR,2);" IMR=";Hex(IMR,2);" ISR=";Hex(ISR,2)
 if (IRR=0) or (not MaxPriorityIndexFromIRR(Index)) then 
    //?? "EXIT(-1)"
    exit(-1) //no interrupts 
 end if
 //address and irq calculation
 if (ICW4 and 1)=0 then //i8080 mode
    result=Index : Address=shl(IRQ0VectorIndex,8) or (ICW1 and 0xE0) 'interrupt table
    Address=Address+iif((ICW1 and 4)<>0,4*Index,8*Index) 'interrupt address
 else //i8086 mode
    result=IRQ0VectorIndex+Index : Address=result*4 'interrupt address
 end if
 //processing if needed
 if Process then
    dim dw as dword=IRRs(Index) : IRRs(Index)=dw-1 //remove IRQ request
    if dw=1 then IRR=IRR and (not shl(1,Index)) 
    if (WorkMode and wmAutoEOI)<>0 then  //auto-finishing interrupt
       if (WorkMode and wmAutoRotate)<>0 then : MaxPriorityIndex=Index+1 //TOCHECK
          if MaxPriorityIndex>7 then MaxPriorityIndex=0 : end if
    else : ISR=ISR or shl(1,Index) : end if
 end if    
// ?? DebugPrefix;"GetIRQ(";Process;")=";result;"  IRQ0VectorIndex=";IRQ0VectorIndex
end direct GetIRQ

//Get base interrupt index (which form interrupt by summation with IRQ)
public function IRQ0Index as byte 
 result=IRQ0VectorIndex
end direct IRQ0Index
