unit ide;
{$IFDEF FPC}{$CALLING oldfpccall}{$ELSE}{$F+}{$ENDIF}


interface

type
TIDE_info = array[0..255] of word;
PIDE_info = ^TIDE_info;


Pide_atapi_dev = ^Tide_atapi_dev;
Tide_atapi_dev = object
    available:boolean;
    my_port:word;
    my_master:boolean;
    is_atapi:boolean;
    dev_info:PIDE_info;

    {soukrome}
    Constructor Init;

    {soukrome/verejne}
    Destructor Done;
    Procedure Nastav(iport:word;imaster:boolean);

    {verejne}
    Function Vrat_Oznaceni_Modelu:string;
    Function Vrat_Seriove_Cislo:string;
    Function Vrat_Firmvare_Ver:string;
    Function Vrat_Seriove_Cislo_Media:string;
    Function IS_LBA48:boolean;
    Function IS_SMART:boolean;
    Function Bajtu_na_sektor:longint;
    Function Pocet_Sektoru:real; {zkusi podle LBA48, kdyz neuspeje, tak LBA28}
    end;

var IDE_ATAPI:array[0..4] of TIde_atapi_dev;
    {Seznam mych slotu potencialne nesoucich IDE/ATAPI zarizeni. Je automaticky}
    {inicializovan (nulovan, nikoliv naplnen daty) pri startu jednotky.
    Naplneni daty probehne az po zavolani procedury "Nacti_ide_atapi_konfiguraci"}

{Co lze doplnit: Nyni predpoklada pouze standardni IDE rozhrani na portech
    1F0h (primarni kanal) a 170h (sekundarni kanal)

    Ve skutecnosti ale mohou byt dalsi IDE zarizeni pripojena skrz kartu
    SoundBlaster, jejiz nektere modely obsahuji IDE radic.
    Ten nabizi jeden nebo dva kanaly na portech 1E8h a 168h}



const
    idePRIM = true;
    ideSEKU = false;
    ideMASTER = true;
    ideSLAVE = false;

Procedure Info_z_IDE(idep:word;idem,cd_mode:boolean;data:pointer);
Function IDE_Dev(radic{idePRIM/ideSEKU},mas_sla{ideMASTER/ideSLAVE}:boolean):byte;

Procedure Nacti_ide_atapi_konfiguraci;
{Toto (nebo manualni ekvivalent) musi predchazet vsem volanim metod
 objektu TIDE_ATAPI_DEV. Duvod, proc se toto nevola automaticky hned pri
 inicializaci jednotky je to, ze muzeme chtit napred pres PCI BIOS zkontrolovat,
 jestli vubec mame IDE radic, nez zacneme pristupovat na IDE porty.
 }


implementation
uses disk{$IFDEF FPC},Ports {$ENDIF};


Function FromTimer:longint;
begin
FromTimer:=MemL[Seg0040:$6c];
end;


Function poll_status(base_port:word;mask:byte;state:boolean):boolean;
var t1,t2:longint;
    i:byte;
    ide_stat_reg:byte;
    res:boolean;

begin
i:=0;
res:=false;
t1:=FromTimer;
repeat
t2:=FromTimer;
if abs(t2-t1)>18 then
   begin
   t1:=FromTimer;
   inc(i);
   end;

if i>5 then begin poll_status:=false;Exit;end;
ide_stat_reg := Port[base_port+7];
if state=true
   then res:=(mask and ide_stat_reg)=mask
   else res:=(mask and ide_stat_reg)<>mask;
until res;
poll_status:=true;
end;


Procedure Wait400ns;
var a,b:longint;
begin
for a:=1 to 100000 do b:=a;
end;


Function swap_bytes(w:word):word;
var b1,b2:byte;
begin
b1:=w shr 8;
b2:=w - (b1 shl 8);
swap_bytes:=(b2 shl 8)+b1;
end;


Function Prohod_Endianitu_Retezce(s:string):string;
{prohodi 1.znak s druhym, 3.znak se ctvrtym, 5.znak s sestym, a tak dale}
var a,b:byte;
    c:char;
begin
for a:=1 to Length(s) div 2 do
    begin
    b:=a*2;
    c:=s[b-1];
    s[b-1]:=s[b];
    s[b]:=c;
    end;
Prohod_Endianitu_Retezce:=s;
end;


Function Trim(s:string):string;
{usekne pocatecni a koncove mezery}
var a,b:byte;
begin
for a:=1 to Length(s) do
    if not (s[a] in [' ',#0]) then
       begin
       delete(s,1,a-1);
       for b:=Length(s) downto 1 do
           if not (s[b] in [' ',#0]) then
              begin
              delete(s,b+1,255);
              Trim:=s;
              Exit;
              end;
       end;
Trim:='';
end;


function send_ide_cmd(ide:word; master:boolean; opcode:byte;wait_after:boolean):boolean;
var ret:boolean;   {Used for various return values}
    b:byte;
    s:string;
begin
ret:=poll_status(ide, $80, false);   {pocka, az nebude busy}
ret:=poll_status(ide, $8,false);     {pocka, az nebude DRQ}

asm cli end;    {zakaze preruseni}

if master then Port[ide+6]:={ $0} $0A0   {nastavi master}
          else Port[ide+6]:={ $10;} $0B0; {nastavi slave}

Port[ide+207]:=$0a;   {zakaze hardwarove preruseni}

Port[ide+2]:=0;       {vynulujeme parametry zadosti}
Port[ide+3]:=0;       {ktere se}
Port[ide+4]:=0;       {v jinych pripadech}
Port[ide+5]:=0;       {pouzivaji ke specifikaci LBA adresy}

Port[ide+7]:=opcode;  {vysle kod zadosti}
Wait400ns;                    {Chvili pocka}
b:=Port[ide+7];
if b=0 then      {tato situace znamena, ze jednotka neexistuje}
   begin
   send_ide_cmd:=false;
   exit;
   end;
send_ide_cmd:=true;
if not wait_after then begin asm sti end; Exit;end;
Wait400ns;                    {Chvili pocka}
ret:=poll_status(ide, $80, false);
asm sti end
end;



Procedure Info_z_IDE(idep:word;idem,cd_mode:boolean;data:pointer);
var i,j:byte;
    dd:PIDE_info;
    g:boolean;

begin
dd:=data;
if cd_mode then j:=$a1 else j:=$ec;
g:=Send_ide_cmd(idep,idem,j,true);    {zadost o informace}

if g=false then FillChar(dd^,512,255)
   else
     for i:=0 to 255 do                   {cteni informaci}
         begin
         dd^[i]:=PortW[idep+0];
         end;
end;


Function Pritomnost_IDE_zarizeni(iport:word;imaster:boolean;var iatapi:boolean;buf:PIDE_Info):boolean;
var newbuf:TIDE_Info;
begin
iatapi:=false;

if (iport<>$1F0) and (iport<>$170) then
   begin Pritomnost_IDE_zarizeni:=false;Exit;end;

Info_z_IDE(iport,imaster,true,buf); {test na ATAPI}
if ((buf^[0] and {128}32768 {bit 15})<>0) and ((buf^[0] and {64}16384 {bit 14})=0) then
   begin   {Nasli jsme ATAPI zarizeni.}
   iatapi:=true;
   Pritomnost_IDE_zarizeni:=true;
   exit;
   end;

Info_z_IDE(iport,imaster,false,buf); {test na IDE/ATA}
if (buf^[0] and {128}32768 {bit 15})=0 then
   begin   {Nasli jsme IDE/ATA zarizeni.}
   Pritomnost_IDE_zarizeni:=true;
   exit;
   end;


Pritomnost_IDE_zarizeni:=false;
end;


Function IDE_Dev(radic{idePRIM/ideSEKU},mas_sla{ideMASTER/ideSLAVE}:boolean):byte;
{v poli preddefinovane promenne IDE_ATAPI najde zarizeni pozadovane konfigurace
 v rozmerech primar/sekundar a master/slave. Pokud takove zarizeni nemame, tak
 vrati 0}
var w:word;
    m:boolean;
    i:byte;
begin
if radic=true then w:=$1F0 else w:=$170;
m:=mas_sla;

for i:=1 to 4 do
    if (IDE_ATAPI[i].my_port=w) and (IDE_ATAPI[i].my_master=m) then
       begin
       IDE_Dev:=i;
       exit;
       end;
IDE_Dev:=0;
end;


Constructor Tide_atapi_dev.Init;
begin
dev_info:=nil;
my_port:=0;
my_master:=false;
is_atapi:=false;
available:=false;
end;


Procedure Tide_atapi_dev.Nastav(iport:word;imaster:boolean);
var iatapi:boolean;
begin
if dev_info=nil then New(dev_info);
available:=Pritomnost_IDE_zarizeni(iport,imaster,iatapi,dev_info);
if available then
   begin
   my_port:=iport;
   my_master:=imaster;
   is_atapi:=iatapi;
   end
   else begin
   my_port:=0;
   my_master:=false;
   iS_atapi:=false;
   Dispose(dev_info);
   dev_info:=nil;
   end;
end;


Function Tide_atapi_dev.Vrat_Oznaceni_Modelu:string;
var s:string;
begin
if not available then begin Vrat_Oznaceni_Modelu:='';exit;end;
s[0]:=#40;
Move(dev_info^[27],s[1],40);
s:=Prohod_Endianitu_Retezce(s);
Vrat_Oznaceni_Modelu:=Trim(s);
end;


Function Tide_atapi_dev.Vrat_Seriove_Cislo:string;
var s:string;
begin
if not available then begin Vrat_Seriove_Cislo:='';exit;end;
s[0]:=#20;
Move(dev_info^[10],s[1],20);
s:=Prohod_Endianitu_Retezce(s);
Vrat_Seriove_Cislo:=Trim(s);
end;


Function Tide_atapi_dev.Vrat_Seriove_Cislo_Media:string;
var s:string;
begin
if not available then begin Vrat_Seriove_Cislo_Media:='';exit;end;
s[0]:=#60;
Move(dev_info^[176],s[1],60);
s:=Prohod_Endianitu_Retezce(s);
Vrat_Seriove_Cislo_Media:=Trim(s);
end;


Function Tide_atapi_dev.Vrat_Firmvare_Ver:string;
var s:string;
begin
if not available then begin Vrat_Firmvare_Ver:='';exit;end;
s[0]:=#8;
Move(dev_info^[23],s[1],8);
s:=Prohod_Endianitu_Retezce(s);
Vrat_Firmvare_Ver:=Trim(s);
end;


Function Tide_atapi_dev.IS_LBA48:boolean;
begin
if not available then begin IS_LBA48:=false;exit;end;
IS_LBA48:=((dev_info^[83] and 1024) <> 0);
end;


Function Tide_atapi_dev.IS_SMART:boolean;
begin
if not available then begin IS_SMART:=false;exit;end;
IS_SMART:=((dev_info^[82] and 1) <> 0);
end;



Function Tide_atapi_dev.Bajtu_na_sektor:longint;
var l1,l2:longint;
begin
if not available then begin Bajtu_na_sektor:=0;exit;end;

if (dev_info^[106] and 32768 = 0) and (dev_info^[106] and 16384 <> 0)
   then begin
   if dev_info^[106] and 12 = 0
      then begin Bajtu_na_sektor:=512;exit;end
      else begin
           l1:=dev_info^[117];
           l2:=dev_info^[118];
           Bajtu_na_sektor:=(l1+l2*65536) * 2;
           end;
   end
   else Bajtu_na_sektor:=0;
end;


Function Tide_atapi_dev.Pocet_Sektoru:real; {zkusi podle LBA48, kdyz neuspeje, tak LBA28}
var r,r1,r2,r3,r4:real;
begin
if not available then begin Pocet_sektoru:=0;Exit;end;
if is_lba48 then
   begin
   r1:=dev_info^[100];
   r2:=dev_info^[101];
   r3:=dev_info^[102];
   r4:=dev_info^[103];
   r:=r1+r2*65536+r3*65536*65536+r4*65536*65536*65536;
   end
   else begin
   r1:=dev_info^[60];
   r2:=dev_info^[61];
   r:=r1+r2*65536;
   end;
Pocet_Sektoru:=r;
end;


Destructor Tide_atapi_dev.Done;
begin
if dev_info<>nil then Dispose(dev_info);
end;


Procedure Nacti_ide_atapi_konfiguraci;
begin
IDE_ATAPI[1].Nastav($1F0,true);
IDE_ATAPI[2].Nastav($1F0,false);
IDE_ATAPI[3].Nastav($170,true);
IDE_ATAPI[4].Nastav($170,false);
end;


Procedure Registruj_Unit;
begin
{Upravime chovani nekolika procedur v jednotce DISK, aby pouzivaly sluzeb
 teto jednotky}

{$IFDEF FPC}
Proc_Info_z_IDE:=@Info_z_IDE;
{$ELSE}
Proc_Info_z_IDE:=Info_z_IDE;
{$ENDIF}
end;

begin
{inicializacni cast jednotky}
Registruj_unit;
IDE_ATAPI[0].Init;



{podle nekterych zdroju mohou mit nektera PC dalsi 2 IDE sbernice na
 zakladnich portech $1E8 a $168}
end.
