'******************************************************************************
'* 
'* HARD DISK CONTROLLER IDE/ATA v.1.0 (CHIP DEVICE)
'*
'* Supported platform/bus: X86
'*
'* Based on information from:
'*  - IDE-Hardware Reference & Information Document (Alex T.Ivopol, 1994)
'*  - Ralph Brown's Interrupt List ("ports.lst" by Wim Osterholt etc.)
'*  - testing various software, which works with HDD directly (via ports)
'* 
'* Version history:
'*  - 25.06.2008 - 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="HDC_IDE"
DebugName="HDC_IDE" 

//Controlled disks
const MAX_DISK_COUNT as byte=2
dim hard_disks(MAX_DISK_COUNT) as object
use object FIFO_STREAM as buffer 'data buffer (to read or write to disk)
dim DiskModelNumber as string 'model number of current disk (40 chars) 
dim DiskSerialNumber as string 'serial number of current disk (20 chars)
dim DiskFirmwareRevision as string 'firmware revision of current disk (8 chars)

//Current disk parameters
dim Disk as object         'current disk
dim HasDisk as boolean     'disk non-empty and valid
dim Cylinders as dword=0   'cylinders count
dim Heads as dword=0       'heads count
dim Sectors as dword=0     'sectors count
dim SectorSize as dword=0  'sector size in bytes
dim StartOffset as dword=0 'data starto offser

//Parameters
dim Busy as boolean  'controller/drive busy flag
dim Ready as boolean 'controller/drive ready flag
dim Reading as boolean 'reading from disk is active
dim Writing as boolean 'writing to disk is active
dim VerifyOnly as boolean  'verification only
dim BusyAfterBufferEmpty as boolean 'set busy state after buffer was emptied
dim IRQeventid as dword=0 'eventid of irq event
dim IRQactive as boolean 'irq activity
dim IRQunbusy as boolean 'remove busy state after irq passing to pc
dim STATEeventid as dword=0 'eventid of state event
use object FIFO_STREAM as STATEmasks 'AND and OR bitmasks for state event 
dim cmd_step as dword 'controller command step counter 

//State value flags
dim FLAG_STATE_BUSY      =0x80 'controller busy (ports not available)
dim FLAG_STATE_READY     =0x40 'drive ready (can accept commands)
dim FLAG_STATE_WRITEFAULT=0x20 'error in drive or incorrect write cmd params
dim FLAG_STATE_SEEK_DONE =0x10 'drive seek completed (head placed on track)
dim FLAG_STATE_DATAREQ   =0x08 'data request (to write or read from buffer)
dim FLAG_STATE_ECC       =0x04 'indicated, that data was corrected with ECC
dim FLAG_STATE_ROTATION  =0x02 'rotation flag (after each disk rotation)
dim FLAG_STATE_ERROR     =0x01 'error flag (after command execution)

//Error value flags
dim FLAG_ERROR_BADBLOCK  =0x80 'bad block mark in ID field
dim FLAG_ERROR_FATALDATA =0x40 'uncorrectable ECC error in data
dim FLAG_ERROR_ID_ECC    =0x10 'cyl, head, sector not found or ECC error in ID
dim FLAG_ERROR_COMMAND   =0x04 'write fault, seek error, not ready, unknown cmd
dim FLAG_ERROR_TRACK0    =0x02 'track 0 not found
dim FLAG_ERROR_ADDRMARK  =0x01 'data address mark not found

//Error codes after disgnostic
dim DIAG_ERROR_NOERROR    =0x01 'no error (successefull diagnostic)
dim DIAG_ERROR_CONTROLLER =0x02 'microcontroller error 
dim DIAG_ERROR_BUFFER     =0x03 'error in buffer RAM 
dim DIAG_ERROR_ECC        =0x04 'hardware control code error
dim DIAG_ERROR_PROCESSOR  =0x05 'microprocessor error 

//Port values
dim CmdIndex as byte=0 'index of command to execute
dim StateValue as byte=0 'state value
dim ErrorValue as byte=0 'error value
dim DataValue as byte=0 'last r/w data byte
dim DriveHeadValue as byte=0xA0 'drive/head register value
dim SectorCount as byte=0 'count of sectors to read/write (if=0, then 256)
dim SectorIndex as byte=0 'sector index 
dim CylinderIndex as word=0 'cylinder index
dim HeadIndex as byte=0 'head index (0..15)
dim DriveIndex as byte=0 'drive index (0..1)

'------------------------------- Events ---------------------------------------

//State event (timed event of state port value changes)
function STATEEvent(freq as integer, eventid as dword) as boolean
 if eventid=STATEeventid then //event not deprecated
    StateValue=(StateValue and STATEmasks.PopByte) or STATEmasks.PopByte
    Busy=(StateValue and FLAG_STATE_BUSY)<>0
    Ready=(StateValue and FLAG_STATE_READY)<>0
    //dbg.break
end if : result=false : end

//IRQ event (periodically trying to pass IRQ request to pc)
function IRQEvent(freq as integer, eventid as dword) as boolean
  ?? ">IRQEvnt"
 if eventid<>IRQeventid then //discard deprecated IRQ
   if IRQactive then 
      pc.SetIRQ(DEVPARAM_IRQ,false) : result=false 
      IRQactive=false
   end if
 else //set IRQ
   result=not(pc.SetIRQ(DEVPARAM_IRQ,true))
   if IRQunbusy then 
      StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false
   end if
   ?? "IRQEvnt"
end : end

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

//State port value change (deleyed if needed, 0.5 ms by default)
procedure SetSTATE(AndMask as byte, OrMask as byte, Timeout as integer=2000)
 if Timeout<0 then 'immediatly (no timeout)
    StateValue=(StateValue and AndMask) or OrMask
    Busy=(StateValue and FLAG_STATE_BUSY)<>0
    Ready=(StateValue and FLAG_STATE_READY)<>0
 else 'user-defined timeout (>0) or min possible timeout (=0)
    STATEmasks.Push(AndMask) : STATEmasks.PushByte(OrMask)
    pc.NewFreqEvent(Timeout,STATEeventid)=STATEEvent 
end if : end

//Set (or reset) IRQ request
procedure SetIRQ(Flag as boolean=true,Unbusy as boolean=false,Timeout as integer=-1)
 ?? DebugPrefix;"SetIRQ(";Flag;",";Unbusy;",";Timeout;")=";
 if DEVPARAM_IRQ>=0 then 'IRQ index valid
 if IRQactive then 'deactivate old IRQ request
    IRQeventid=IRQeventid+1 : pc.SetIRQ(DEVPARAM_IRQ,false)
    IRQactive=false
 end if
 'set new IRQ request if needed
 if Flag then : IRQactive=true
    if (Timeout<0) and (pc.SetIRQ(DEVPARAM_IRQ,true)) then 
       ?? "immed.IRQ"
       if Unbusy then : StateValue=StateValue and (not FLAG_STATE_BUSY) 
          Busy=false : end if
    else 
       ?? "delayed IRQ"
       if Timeout<0 then Timeout=0 'min available
       IRQunbusy=Unbusy : pc.NewFreqEvent(Timeout,IRQeventid)=IRQevent 
    end if
 else : ?? "ok" : end if 
 else 'IRQ index not valid
   ?? "invalid IRQ"
   if Unbusy then : StateValue=StateValue and (not FLAG_STATE_BUSY) 
      Busy=false : end if
 end if 
end

//Update info of currently selected disk
procedure UpdateDiskInfo
 buffer.size=0 : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
 disk=hard_disks(DriveIndex) 
 if (not IsNothing(disk)) and (disk.Detected or DetectHardDisk(disk)) then
    ?? DebugPrefix;"Disk";DriveIndex;" is successfully recognized!!!"
    HasDisk=true : Cylinders=disk.CylinderCount : Heads=disk.HeadCount 
    Sectors=disk.SectorCount : SectorSize=disk.SectorSize 
    StartOffset=disk.StartOffset : StateValue=StateValue or FLAG_STATE_READY
    DiskModelNumber="SPC_DISK_IMAGE_"+Str(round(disk.Size/(1024*1024)))+"MB"
    if Length(DiskModelNumber)<40 then 
       DiskModelNumber=DiskModelNumber+Space(40-Length(DiskModelNumber)) : end 
    DiskSerialNumber=Str(disk.Size)
    if Length(DiskSerialNumber)<20 then 
       DiskSerialNumber=DiskSerialNumber+Space(20-Length(DiskSerialNumber)) : end
    DiskFirmwareRevision="25-06-08"
    Ready=true
 else //Bochs BIOS need some ATA reporting to work even if no disk available :(
    ?? DebugPrefix;"Disk";DriveIndex;" is not recognized or empty!!!"
    HasDisk=true : Cylinders=0 : Heads=0 : Sectors=0 : SectorSize=0
    StartOffset=0 : //StateValue=StateValue and (not FLAG_STATE_READY)
    StateValue=StateValue or FLAG_STATE_READY
    DiskModelNumber="unknown" : DiskSerialNumber="unknown" 
    if Length(DiskModelNumber)<40 then 
       DiskModelNumber=DiskModelNumber+Space(40-Length(DiskModelNumber)) : end 
    if Length(DiskSerialNumber)<20 then 
       DiskSerialNumber=DiskSerialNumber+Space(20-Length(DiskSerialNumber)) : end
    DiskFirmwareRevision="00-00-00" : Ready=true
 end if
end

//Reset constroller
procedure ResetController
 CmdIndex=0 : StateValue=FLAG_STATE_READY or FLAG_STATE_SEEK_DONE
 DataValue=0 : ErrorValue=DIAG_ERROR_NOERROR
 DriveHeadValue=0xA0 : SectorCount=1 : SectorIndex=1 : CylinderIndex=0 
 HeadIndex=0 : DriveIndex=0 
 Busy=(StateValue and FLAG_STATE_BUSY)<>0
 Ready=(StateValue and FLAG_STATE_READY)<>0
 Writing=false : SetIRQ(false) 'discard old IRQ event
 STATEeventid=STATEeventid+1 : STATEmasks.Size=0 'clear state changes
 UpdateDiskInfo : buffer.Size=0
 BusyAfterBufferEmpty=false
end

'------------------------------ Commands --------------------------------------

//Reset controller (at startup)
function CMD_Reset(freq as integer, eventid as dword) as boolean
 select case cmd_step
 case 0 to 999 //wait 0.5*1000=500 ms
 case else //finish execution
      ResetController : Result=false : exit 'completed
 end select : cmd_step=cmd_step+1 : result=true 'need next step
end

//90h - Diagnose both controlled drives
function CMD_DrivesDiagnostic(freq as integer, eventid as dword) as boolean
 select case cmd_step
 case 0 to 199 //wait 0.5*200=100 ms
 case else //finish execution
      ErrorValue=DIAG_ERROR_NOERROR 'no error on both drives
      StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false
      StateValue=StateValue or FLAG_STATE_READY : Ready=true
      SetIRQ(true) : Result=false : exit 'completed
 end select : cmd_step=cmd_step+1 : result=true 'need next step
end

//91h - Initialize device parameters (try to set logical desired translation)
function CMD_InitializeParams(freq as integer, eventid as dword) as boolean
 result=false 'no more need to call
 if (SectorCount=Sectors) and ((HeadIndex+1)=Heads) then 'translation supported
    SetIRQ(true) 
 else 'translation not supported
    StateValue=StateValue or FLAG_STATE_ERROR
    ErrorValue=ErrorValue or FLAG_ERROR_COMMAND
 end if
 StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false
end

//20h..21h - Read sectors (1..256 of them)
function CMD_ReadSectors(freq as integer, eventid as dword) as boolean
 result=true : if buffer.size=0 then 'buffer empty - send next sector
 if (CylinderIndex>=Cylinders) or (HeadIndex>=Heads) or _
    (SectorIndex=0) or (SectorIndex>Sectors) then
    StateValue=StateValue or FLAG_STATE_ERROR
    ErrorValue=ErrorValue or FLAG_ERROR_ID_ECC
    ?? DebugPrefix;"Error reading sector"
    result=false //: SetIRQ(true) 
 else //transfer next sector
   dim pos as int64 'calc sector position on disk
   pos=CylinderIndex*Heads+HeadIndex 'absolute cylinder index
   pos=pos*Sectors+SectorIndex-1 'absolute sector index
   pos=StartOffset+pos*SectorSize 'sector offset from disk start
   buffer.pos=0 : disk.pos=pos : if not VerifyOnly then buffer.Copy(disk.Object,SectorSize)
   ?? DebugPrefix;"Sector prepeared to read (pos=";pos;", size=";buffer.size;")"
   SectorCount=SectorCount-1
   if SectorCount=0 then 
      result=false 'all sectors transferred
      BusyAfterBufferEmpty=false
      if VerifyOnly then SetIRQ(true) 
   else 
      BusyAfterBufferEmpty=true 
      SectorIndex=SectorIndex+1
      if SectorIndex>Sectors then  //no more sectors on track
         SectorIndex=1 : HeadIndex=HeadIndex+1 
         if HeadIndex>=Heads then : HeadIndex=0 : CylinderIndex=CylinderIndex+1 : end if 
         DriveHeadValue=(DriveHeadValue and 0xF0) or (HeadIndex and 0x0F)
   end if : end if
   if not VerifyOnly then : StateValue=StateValue or FLAG_STATE_DATAREQ : SetIRQ(true) : end if
 end if : StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false : end if
end

//30h..31h - Write sectors (1..256 of them)
function CMD_WriteSectors(freq as integer, eventid as dword) as boolean
 result=true : if (VerifyOnly) or (buffer.size>=512) then 'buffer full - send next sector
 if (CylinderIndex>=Cylinders) or (HeadIndex>=Heads) or _
    (SectorIndex=0) or (SectorIndex>Sectors) then
    StateValue=StateValue or FLAG_STATE_ERROR
    ErrorValue=ErrorValue or FLAG_ERROR_ID_ECC
    ?? DebugPrefix;"Error writing sector"
    result=false //: SetIRQ(true) 
 else //transfer next sector
   dim pos as int64 'calc sector position on disk
   pos=CylinderIndex*Heads+HeadIndex 'absolute cylinder index
   pos=pos*Sectors+SectorIndex-1 'absolute sector index
   pos=StartOffset+pos*SectorSize 'sector offset from disk start
   buffer.pos=0 : disk.pos=pos : if not VerifyOnly then 
   disk.Copy(buffer.Object,SectorSize)
   ?? DebugPrefix;"Sector is written (pos=";pos;", size=";buffer.size;")"
   buffer.Size=0 : end if
   SectorCount=SectorCount-1
   if SectorCount=0 then 
      result=false 'all sectors transferred
      BusyAfterBufferEmpty=false
      //if VerifyOnly then SetIRQ(true) 
   else 
      BusyAfterBufferEmpty=true 
      SectorIndex=SectorIndex+1
      if SectorIndex>Sectors then  //no more sectors on track
         SectorIndex=1 : HeadIndex=HeadIndex+1 
         if HeadIndex>=Heads then : HeadIndex=0 : CylinderIndex=CylinderIndex+1 : end if 
         DriveHeadValue=(DriveHeadValue and 0xF0) or (HeadIndex and 0x0F)
      end if 
      if not VerifyOnly then : StateValue=StateValue or FLAG_STATE_DATAREQ : end if
   end if
   SetIRQ(true{,false,0}) //TOCHECK - need timeout by some OS-es? what min. value?
 end if : StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false : end if
end

//10h..1Fh - Recalibrate drive (positioning to beginning of disk)
function CMD_Recalibrate(freq as integer, eventid as dword) as boolean
 result=false 'no more need to call
 CylinderIndex=0 : HeadIndex=0 : DriveHeadValue=DriveHeadValue and 0xF0
 SectorIndex=0 : StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false
 SetIRQ(true) 
end

//ECh - Identify current drive
function CMD_IdentifyDrive(freq as integer, eventid as dword) as boolean
 dim i as integer
 select case cmd_step
 case 0 to 19 //wait 0.5*20=10 ms
 case else //finish execution
      StateValue=StateValue and (not FLAG_STATE_BUSY) : Busy=false
      StateValue=StateValue or FLAG_STATE_DATAREQ 'data ready to read
      //StateValue=StateValue or FLAG_STATE_READY : Ready=true
      buffer.PushWord(2 or 0x40 or 0x100) 'general configuration
      buffer.PushWord(Cylinders) 'number of logical cylinders
      buffer.PushWord(0) 'reserved
      buffer.PushWord(Heads) 'number of logical heads
      buffer.PushWord(512*Sectors) 'unformated bytes per logical track
      buffer.PushWord(512) 'unformated bytes per sector
      buffer.PushWord(Sectors) 'logical sectors per track
      buffer.PushWord(0) 'vendor-specific
      buffer.PushWord(0) 'vendor-specific
      buffer.PushWord(0) 'count of vendor status words
      for i=1 to 19 step 2 //byte-swapped words
        buffer.PushByte(Asc(Mid(DiskSerialNumber,i+1,1))) 
        buffer.PushByte(Asc(Mid(DiskSerialNumber,i,1))) 
      next
      buffer.PushWord(1) 'buffer type (single, PIO1)
      buffer.PushWord(1) 'buffer size in 512 byte sectors
      buffer.PushWord(0) 'number of ECC bytes in long R/W ops
      for i=1 to 7 step 2 //byte-swapped words
        buffer.PushByte(Asc(Mid(DiskFirmwareRevision,i+1,1))) 
        buffer.PushByte(Asc(Mid(DiskFirmwareRevision,i,1))) 
      next
      for i=1 to 39 step 2 //byte-swapped words
        buffer.PushByte(Asc(Mid(DiskModelNumber,i+1,1))) 
        buffer.PushByte(Asc(Mid(DiskModelNumber,i,1))) 
      next
      buffer.PushWord(0) 'max sectors per IRQ transfered in multiple R/W
      buffer.PushWord(1) 'dword I/O transfer supported

      buffer.PushWord(0) 'capabilities (no DMA, no LBA, no IORDY)
      buffer.PushWord(0) 'security mode (no password supported)
      buffer.PushWord(5) 'minimum PIO data transfer cycle time, ns
      buffer.PushWord(0) 'minimum DMA data transfer cycle time, ns 
      buffer.PushWord(0) 'support of other configuration cells (no more)
      for i=buffer.Size to 511 : buffer.PushByte(0) : next 'reserved words
      SetIRQ(true) : Result=false : exit 'completed
 end select : cmd_step=cmd_step+1 : result=true 'need next step
end

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

//Set disk objects
public property Disks(Index as byte, Value as object) 
 if Index>=MAX_DISK_COUNT then Error(DEVPARAM_NAME+" not supported more then "+ _
    Str(MAX_DISK_COUNT)+" disks") 
 hard_disks(Index)=Value : if DriveIndex=Index then UpdateDiskInfo
 ?? DebugPrefix;"Disk";Index;"=";iif(IsNothing(Value),"0",round(Value.Size/1024));"Kb"
end

//Get disk objects
public function Disks(Index as byte) as object
 if Index>=MAX_DISK_COUNT then Error(DEVPARAM_NAME+" not supported more then "+ _
    Str(MAX_DISK_COUNT)+" disks") 
 result=hard_disks(Index)
end

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

//1F0h - Write 8-bit to data register
public property DATA_PORT8(Value as byte)
 ?? DebugPrefix;">DATA_PORT8=";Hex(Value,2);"h"
 if not(Busy) then 
    buffer.PushByte(Value)
    if buffer.Size>=512 then
       StateValue=StateValue and (not FLAG_STATE_DATAREQ)
       if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
       Busy=true : end if : end if
 end if
end

//1F0h - Write 16-bit to data register
public property DATA_PORT16(Value as word)
 ?? DebugPrefix;">DATA_PORT16=";Hex(Value,4);"h"
 if not(Busy) then 
    buffer.PushWord(Value)
    if buffer.Size>=512 then
       StateValue=StateValue and (not FLAG_STATE_DATAREQ)
       if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
       Busy=true : end if : end if
 end if
end

//1F0h - Write 32-bit to data register
public property DATA_PORT32(Value as dword)
 ?? DebugPrefix;">DATA_PORT32=";Hex(Value,8);"h"
 if not(Busy) then 
    buffer.PushDword(Value)
    if buffer.Size>=512 then
       StateValue=StateValue and (not FLAG_STATE_DATAREQ)
       if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
       Busy=true : end if : end if
 end if
end

//1F0h - Read 8-bit from data register
public function DATA_PORT8 as byte
 if Busy then : result=StateValue 
 elseif buffer.Size>0 then
   result=buffer.PopByte
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 else : result=StateValue : end if
// ?? DebugPrefix;"<DATA_PORT8=";Hex(result,2);"h (buffer size=";buffer.Size;"B)"
end

//1F0h - Read 16-bit from data register
public function DATA_PORT16 as word
 if Busy then : result=StateValue 
 else : select case buffer.Size
 case 0 : result=StateValue
 case 1 : result=buffer.PopByte
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 case else : result=buffer.PopWord
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 end select : end if
// ?? DebugPrefix;"<DATA_PORT16=";Hex(result,4);"h (buffer size=";buffer.Size;"B)"
end

//1F0h - Read 32-bit from data register
public function DATA_PORT32 as dword
 if Busy then : result=StateValue 
 else : select case buffer.Size
 case 0 : result=StateValue
 case 1 : result=buffer.PopByte
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 case 2 : result=buffer.PopWord
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 case 3 : result=buffer.PopByte or shl(buffer.PopWord,8)
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 case else : result=buffer.PopDword
   if buffer.Size=0 then : StateValue=StateValue and (not FLAG_STATE_DATAREQ)
      if BusyAfterBufferEmpty then : StateValue=StateValue or FLAG_STATE_BUSY
      Busy=true : end if : end if
 end select : end if
// ?? DebugPrefix;"<DATA_PORT16=";Hex(result,4);"h (buffer size=";buffer.Size;"B)"
end

//1F1h - Write precompensation register (ignored by drive)
public property PRECOMP_PORT(Value as byte)
 ?? DebugPrefix;">PRECOMP_PORT=";Hex(Value,2);"h"
end

//1F1h - Read error register (error of last command execution - if was any)
public function ERROR_PORT as byte
 if Busy then result=StateValue else result=ErrorValue
 ?? DebugPrefix;"<ERROR_PORT=";Hex(result,2);"h ";
 ?? "(MarkErr=";result and 1; //data address mark not found
 ?? ",Trk0Err=";shr(result,1) and 1; //track 0 not found after recalibration
 ?? ",CmdAbort=";shr(result,2) and 1; //command was aborted (state err or inv.cmd)
 ?? ",SectNotFnd=";shr(result,4) and 1; //sector ID field not found
 ?? ",DataErr=";shr(result,6) and 1; //uncorrectable data error
 ?? ",BadBlock=";shr(result,7) and 1; //bad block detected in sector ID field
 ??
end

//1F2h - Write sector count register (if 0, then 256 sectors)
public property SECTOR_COUNT_PORT(Value as byte)
 ?? DebugPrefix;">SECTOR_COUNT_PORT=";Hex(Value,2);"h ";
 if not(Busy) then SectorCount=Value
 ?? "(sectors count=";iif(Value=0,256,Value);")"
end

//1F2h - Read sector count register
public function SECTOR_COUNT_PORT as byte
 if Busy then result=StateValue else result=SectorCount
 ?? DebugPrefix;"<SECTOR_COUNT_PORT=";Hex(result,2);"h"
end

//1F3h - Write sector index register 
public property SECTOR_INDEX_PORT(Value as byte)
 if not(Busy) then SectorIndex=Value
 ?? DebugPrefix;">SECTOR_INDEX_PORT=";Hex(Value,2);"h"
end

//1F3h - Read sector index register
public function SECTOR_INDEX_PORT as byte
 if Busy then result=StateValue else result=SectorIndex
 ?? DebugPrefix;"<SECTOR_INDEX_PORT=";Hex(result,2);"h"
end

//1F4h - Write cylinder index low byte register
public property CYLINDER_INDEXL_PORT(Value as byte)
 if not(Busy) then CylinderIndex=(CylinderIndex and 0xFF00) or Value
 ?? DebugPrefix;">CYLINDER_INDEX_LOW_PORT=";Hex(Value,2);"h ";
 ?? "(cylinder=";CylinderIndex;")"
end

//1F4h - Read cylinder index low byte register
public function CYLINDER_INDEXL_PORT as byte
 if Busy then result=StateValue else result=CylinderIndex and 0xFF
 ?? DebugPrefix;"<CYLINDER_INDEX_LOW_PORT=";Hex(result,2);"h"
end

//1F5h - Write cylinder index high byte register
public property CYLINDER_INDEXH_PORT(Value as byte)
 if not(Busy) then CylinderIndex=(CylinderIndex and 0xFF) or shl(Value,8)
 ?? DebugPrefix;">CYLINDER_INDEX_HIGH_PORT=";Hex(Value,2);"h ";
 ?? "(cylinder=";CylinderIndex;")"
end

//1F5h - Read cylinder index high byte register
public function CYLINDER_INDEXH_PORT as byte
 if Busy then result=StateValue else result=shr(CylinderIndex,8) and 0xFF
 ?? DebugPrefix;"<CYLINDER_INDEX_HIGH_PORT=";Hex(result,2);"h"
end

//1F6h - Write drive/head register
public property DRIVE_HEAD_PORT(Value as byte)
 if not(Busy) then 
    DriveHeadValue=Value
    HeadIndex=Value and 0xF //bits 0..3
    if DriveIndex<>(shr(Value,4) and 1) then //bit 4
       DriveIndex=shr(Value,4) and 1 'select other drive
       UpdateDiskInfo 'detect it
       if HasDisk then //delayed seek on track completion
          StateValue=StateValue or FLAG_STATE_BUSY : Busy=true
          StateValue=StateValue and (not FLAG_STATE_SEEK_DONE)
          SetState(0xFF,FLAG_STATE_SEEK_DONE,2000)
          SetState(not FLAG_STATE_BUSY,0,1900)
       end if
    else 'select other head
          StateValue=StateValue or FLAG_STATE_SEEK_DONE
    end if
 end if
 ?? DebugPrefix;">DRIVE_HEAD_PORT=";Hex(Value,2);"h ";
 ?? "(drive=";DriveIndex;", head=";HeadIndex;")"
end

//1F6h - Read drive/head register
public function DRIVE_HEAD_PORT as byte
 if Busy then result=StateValue else result=DriveHeadValue
 ?? DebugPrefix;"<DRIVE_HEAD_PORT=";Hex(result,2);"h"
end

//1F7h - Write command register
public property CMD_PORT(Value as byte)
 ?? DebugPrefix;">CMD_PORT=";Hex(Value,2);"h ";
      //dbg.break
 if Busy or (not Ready) then 
    ?? "(busy or non-ready!!!)" 
 elseif (not HasDisk) or (not Ready) then 
    ?? "(but drive not available!!!)"
    StateValue=StateValue and (not FLAG_STATE_READY)
    StateValue=StateValue or FLAG_STATE_ERROR
    ErrorValue=FLAG_ERROR_COMMAND
 else //try to decode and execute command
 buffer.Size=0 'clear buffer
 StateValue=StateValue or FLAG_STATE_BUSY
 //StateValue=StateValue and (not FLAG_STATE_READY)
 StateValue=StateValue and (not FLAG_STATE_ERROR)
 CmdIndex=Value : cmd_step=0
 select case CmdIndex
 case 0x90 : ?? "(drives diagnostic)"
      pc.NewFreqEvent(2000)=CMD_DrivesDiagnostic '0.5 ms
 case 0x91 : ?? "(initialize device parameters)"
      pc.NewFreqEvent(2000)=CMD_InitializeParams '0.5 ms
 case 0xEC : ?? "(identify drive)"
      pc.NewFreqEvent(2000)=CMD_IdentifyDrive '0.5 ms
 case 0x10 to 0x1F : ?? "(recalibrate)"
      pc.NewFreqEvent(2000)=CMD_Recalibrate '0.5 ms
 case 0x20 to 0x21 : ?? "(read sectors)"
      VerifyOnly=false
      pc.NewFreqEvent(2000)=CMD_ReadSectors '0.5 ms
 case 0x40 to 0x41 : ?? "(read verify sectors)"
      VerifyOnly=true
      pc.NewFreqEvent(2000)=CMD_ReadSectors '0.5 ms
 case 0x30 to 0x31 : ?? "(write sectors)"
      VerifyOnly=false
      pc.NewFreqEvent(2000)=CMD_WriteSectors '0.5 ms
      StateValue=StateValue and (not FLAG_STATE_BUSY)
      StateValue=StateValue or FLAG_STATE_DATAREQ
 case 0x3C : ?? "(write verify sectors)"
      VerifyOnly=true
      pc.NewFreqEvent(2000)=CMD_WriteSectors '0.5 ms
      StateValue=StateValue or FLAG_STATE_BUSY
      StateValue=StateValue and (not FLAG_STATE_DATAREQ)
// case 0x50 : ?? "(format track)"
// case 0x20 : ?? "(read sectors with retry)"
// case 0x21 : ?? "(read sectors withount retry)"
// case 0x22 : ?? "(read long with retry)"
// case 0x23 : ?? "(read long without retry)"
// case 0x30 : ?? "(write sectors with retry)"
// case 0x31 : ?? "(write sectors withount retry)"
// case 0x32 : ?? "(write long with retry)"
// case 0x33 : ?? "(write long without retry)"
 case else : ?? "(unknown command)"
      StateValue=StateValue and (not FLAG_STATE_BUSY)
      //StateValue=StateValue or FLAG_STATE_READY
      StateValue=StateValue or FLAG_STATE_ERROR
      ErrorValue=FLAG_ERROR_COMMAND
      //dbg.break
 end select
 Busy=(StateValue and FLAG_STATE_BUSY)<>0 
 //Ready=(StateValue and FLAG_STATE_READY)<>0
end if : end

//1F7h - Read state register (with interrupt acknowledge)
public function STATE_PORT as byte
 //StateValue=(StateValue and (not FLAG_STATE_ROTATION)) or _
 //           ((not StateValue) and FLAG_STATE_ROTATION) 'disk rotation flag
 result=StateValue
 ?? DebugPrefix;"<STATE_PORT=";Hex(result,2);"h ";
 ?? "(Err=";result and 1; //error after command execution
 ?? ",Cor=";shr(result,2) and 1; //data read corrected
 ?? ",Dat=";shr(result,3) and 1; //sector data buffer need servicing
 ?? ",SeekRdy=";shr(result,4) and 1; //seek completed
 ?? ",WrtFault=";shr(result,5) and 1; //write fault
 ?? ",Ready=";(result and FLAG_STATE_READY)<>0; //drive is ready
 ?? ",Busy=";(result and FLAG_STATE_BUSY)<>0; //controller is busy
 ??
 SetIRQ(false) 'acknowledge interrupt
end

//3F6h - Read alternate state register (without interrupt acknowledge)
public function ALT_STATE_PORT as byte
 //StateValue=(StateValue and (not FLAG_STATE_ROTATION)) or _
 //           ((not StateValue) and FLAG_STATE_ROTATION) 'disk rotation flag
 result=StateValue
 ?? DebugPrefix;"<ALT_STATE_PORT=";Hex(result,2);"h ";
 ?? "(Err=";result and 1; //error after command execution
 ?? ",Cor=";shr(result,2) and 1; //data read corrected
 ?? ",Dat=";shr(result,3) and 1; //sector data buffer need servicing
 ?? ",SeekRdy=";shr(result,4) and 1; //seek completed
 ?? ",WrtFault=";shr(result,5) and 1; //write fault
 ?? ",Ready=";(result and FLAG_STATE_READY)<>0; //drive is ready
 ?? ",Busy=";(result and FLAG_STATE_BUSY)<>0; //controller is busy
 ??
end

//3F6h - Write device control register //TODO
public property CONTROL_PORT(Value as byte)
 ?? DebugPrefix;">CONTROL_PORT=";Hex(Value,2);"h "
 if not(Busy) then 
    if (Value and 2)=0 then 'raise interrupt after 0.5 ms if not set
//       SetIRQ(true,true,2000) : Busy=true
//       StateValue=StateValue or FLAG_STATE_BUSY 
     end if
 end if
end

//3F7h - Read drive address register
public function DRIVE_ADDRESS_PORT as byte
 result=shl(HeadIndex and 0xF,2) or shl(1,DriveIndex and 1) or iif(Writing,0x40,0)
 ?? DebugPrefix;"<DRIVE_ADDRESS_PORT=";Hex(result,2);"h"
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

 //initial power up and reset controller
 StateValue=StateValue or FLAG_STATE_BUSY
 pc.NewFreqEvent(2000)=CMD_Reset '0.5 ms

 //success
 result=true

end 


//Device finalization
public procedure DEV_DONE(stream as object)

 //parent call
 DEV_DONE(stream)

end

