{$IFDEF FPC}
  {$DEFINE bit32}
  {$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
  {$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
  {$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}
{$ENDIF}
{$IFDEF TMT}
  {DEFINE bit32}
{$ENDIF}


unit BIOS;
interface


{$IFNDEF bit32}
type dword = longint;
{$ENDIF}


const
PCI_successful           = 0;
PCI_unsupported_f        = $81;
PCI_bad_vendorID         = $83;
PCI_device_not_found     = $86;
PCI_bad_register_number  = $87;


number_of_pci_devices:word = 0;

{$I bios1.inc}

type

pci_device_s = packed record
    device_name:pchar;  { string }
    vendor_id:word;
    device_id:word;
    end;

pci_config_s = packed record
    {0}bBus:byte;
    {1}bDev:byte;
    {2}bFunc:byte;
    {3}vendor_ID:word;
    {5}device_ID:word;
    {7}vendor_name:pchar;
    {11}device_name:pchar;  { string }
    end;


i2c_regs = packed array [0..6] of byte;



Function IF_PCI_BIOS:boolean;
Function IF_device_exist(device_ID,vendor_ID:word):boolean;
Function IF_device_exist_plus(device_ID,vendor_ID:word;var ppkey:pci_config_s):boolean;
Function Scan_PCI_devices(devices:array of pci_device_s;var ppkey:pci_config_s):byte;
Function Read_PCI_cfg_byte(ppkey:pci_config_s;povel:word):byte;
Function Read_PCI_cfg_word(ppkey:pci_config_s;povel:word):word;
Function Read_PCI_cfg_dword(ppkey:pci_config_s;povel:word):dword;

Procedure Write_PCI_cfg_byte(ppkey:pci_config_s;povel:word;b:byte);
Procedure Write_PCI_cfg_word(ppkey:pci_config_s;povel:word;w:word);
Procedure Write_PCI_cfg_dword(ppkey:pci_config_s;povel:word;d:dword);

Procedure Enable_PCI_bus_master(ppkey:pci_config_s);
Procedure Enable_PCI_memory_access(ppkey:pci_config_s);
Procedure Enable_PCI_io_access(ppkey:pci_config_s);

Function Find_PCI_class_code(class:dword;index:word;var ppkey:pci_config_s):boolean;  { serves to "Identify_device_class" }
Procedure Identify_device(class:dword; index:word; var ppkey:pci_config_s);

Function Find_SMBUS_baseport:word;
Function Test_SMBUS_device(SMBUS_baseport:word;dev:byte):boolean;
Function Scan_SMBUS_devices(SMBUS_baseport:word;in_hex:boolean):string;
Function Read_SMBUS_byte_protocol(SMBUS_baseport:word;slave_adr,data_adr,readbyte_cmd:byte):byte;
Procedure Write_SMBUS_byte_protocol(SMBUS_baseport:word;slave_adr,data_adr,value,writebyte_cmd:byte);

Procedure Enable_SMBUS_on_PCI;
Procedure Disable_SMBUS_on_PCI;

var my_pci_devices:array[0..200] of pci_device_s;

implementation
uses Dos;

const HexaNum : string[16] = '0123456789ABCDEF';
var regs:registers;

Function IF_PCI_BIOS:boolean;
begin
regs.ax:=$b101;
regs.di:=0;
Intr($1a,regs);
IF_PCI_BIOS:=regs.dx=$4350; {edx=$20494350}
end;


Function IF_device_exist_plus(device_ID,vendor_id:word;var ppkey:pci_config_s):boolean;
begin
with regs do begin
  ax:=$b102;
  cx:=device_id;
  dx:=vendor_id;
  si:=0;
end;
Intr($1a,regs);
if regs.ah=0 then
   begin
   ppkey.bbus:=regs.bh;
   ppkey.bdev:=regs.bl shr 3;
   ppkey.bfunc:=regs.bl and 7;
   ppkey.vendor_id:=vendor_id;
   ppkey.device_id:=device_id;
   end;
If_device_exist_plus:=regs.ah=0;
end;


Function IF_device_exist(device_ID,vendor_id:word):boolean;
var dummy:pci_config_s;
begin
IF_device_exist:=IF_device_exist_plus(device_ID,vendor_ID,dummy);
end;



Function Scan_PCI_devices(devices:array of pci_device_s;var ppkey:pci_config_s):byte;
var i:word;
begin
if If_PCI_BIOS then
   begin
   i:=0;
   while devices[i].vendor_ID<>0 do
      begin
      if IF_device_exist_plus(devices[i].device_id,devices[i].vendor_id,ppkey) then
         begin
         ppkey.device_name:=devices[i].device_name;
         Scan_PCI_devices:=PCI_successful;
         Exit;
         end;
      inc(i);
      end;
   end;
Scan_PCI_devices:=PCI_DEVICE_NOT_FOUND;
end;


Function Read_PCI_cfg_byte(ppkey:pci_config_s;povel:word):byte;
begin
regs.ax:=$0b108;
regs.bh:=ppkey.bBus;
regs.bl:=(ppkey.bDev shl 3) or ppkey.bFunc;
regs.di:=povel;
intr($1a,regs);
Read_PCI_cfg_byte:=regs.cl;
end;


Function Read_PCI_cfg_word(ppkey:pci_config_s;povel:word):word;
begin
regs.ax:=$0b109;
regs.bh:=ppkey.bBus;
regs.bl:=(ppkey.bDev shl 3) or ppkey.bFunc;
regs.di:=povel;
intr($1a,regs);
Read_PCI_cfg_word:=regs.cx;
end;


Function Read_PCI_cfg_dword(ppkey:pci_config_s;povel:word):dword;
var d:dword;
    ppkey_bbus,
    ppkey_bdev,
    ppkey_bfunc:byte;
begin
ppkey_bbus:=ppkey.bBus;    {Obejiti omezeni Freepascalu 2.x.y a 3.x.y}
ppkey_bdev:=ppkey.bdev;
ppkey_bfunc:=ppkey.bfunc;
asm
mov ax,0b10ah
mov bh,ppkey_bBus
mov bl,ppkey_bDev;shl bl,3;add bl,ppkey_bFunc
mov di,povel
int 1ah
{$IFDEF bit32}mov d,ecx{$ELSE}db 66h;mov d.word,cx{$ENDIF}
end;
Read_PCI_cfg_dword:=d;
end;


Procedure Write_PCI_cfg_byte(ppkey:pci_config_s;povel:word;b:byte);
var ppkey_bbus,
    ppkey_bdev,
    ppkey_bfunc:byte;
begin
ppkey_bbus:=ppkey.bBus;    {Obejiti omezeni Freepascalu 2.x.y a 3.x.y}
ppkey_bdev:=ppkey.bdev;
ppkey_bfunc:=ppkey.bfunc;
asm
mov ax,0b10Bh
mov bh,ppkey_bbus
mov bl,ppkey_bdev
shl bl,3
or bl,ppkey_bFunc
mov cl,b
mov di,povel
int 1ah
end;
end;


Procedure Write_PCI_cfg_word(ppkey:pci_config_s;povel:word;w:word);
var ppkey_bbus,
    ppkey_bdev,
    ppkey_bfunc:byte;
begin
ppkey_bbus:=ppkey.bBus;    {Obejiti omezeni Freepascalu 2.x.y a 3.x.y}
ppkey_bdev:=ppkey.bdev;
ppkey_bfunc:=ppkey.bfunc;
asm
mov ax,0b10Ch
mov bh,ppkey_bbus
mov bl,ppkey_bdev
shl bl,3
or bl,ppkey_bFunc
mov cx,w
mov di,povel
int 1ah
end;
end;


Procedure Write_PCI_cfg_dword(ppkey:pci_config_s;povel:word;d:dword);
var ppkey_bbus,
    ppkey_bdev,
    ppkey_bfunc:byte;
begin
ppkey_bbus:=ppkey.bBus;    {Obejiti omezeni Freepascalu 2.x.y a 3.x.y}
ppkey_bdev:=ppkey.bdev;
ppkey_bfunc:=ppkey.bfunc;
asm
mov ax,0b10Dh
mov bh,ppkey_bbus
mov bl,ppkey_bdev
shl bl,3;
or bl,ppkey_bFunc
{$IFNDEF bit32}db 66h;mov cx,d.word{$ELSE}mov ecx,d{$ENDIF}
mov di,povel
int 1ah
end;
end;


Function Find_PCI_class_code(class:dword;index:word;var ppkey:pci_config_s):boolean;
var r:registers;
    b:boolean;
    _bl,_bh:byte;
begin
asm
mov b,1
mov ax,0b103h
mov si,index
{$IFDEF bit32}mov ecx,class {$ELSE}db 66h;mov cx,class.word{$ENDIF}
int 1ah

jc @konec
@ok:
cmp ah,86h
jz @konec
mov b,0
mov _bh,bh
mov _bl,bl
@konec:
end;

if B then begin Find_PCI_class_code:=false;Exit;end;
ppkey.bBus:=_bh;
ppkey.bDev:=_bl shr 3;
ppkey.bFunc:=_bl and 7;
Find_PCI_class_code:=true;
end;


Procedure Identify_device(class:dword; index:word; var ppkey:pci_config_s);
begin
if Find_PCI_class_code(class,index,ppkey) then
   begin
   ppkey.vendor_id:=Read_PCI_cfg_word(ppkey,0);  { registers 0,1 --> Vendor ID }
   ppkey.device_id:=Read_PCI_cfg_word(ppkey,2);  { registers 2,3 --> Device ID }
   end else
   begin ppkey.vendor_id:=0;ppkey.device_id:=0;ppkey.bBus:=0;ppkey.bDev:=0;ppkey.bFunc:=0;end;
end;


Procedure Set_PCI_hardware_interrupt(ppkey:pci_config_s;int_pin:byte;irq:byte);
begin
regs.ax:=$b10f;
regs.bh:=ppkey.bBus;
regs.bl:=(ppkey.bDev shl 3) or ppkey.bFunc;
regs.cl:=int_pin;
regs.ch:=irq;
regs.ds:=$F000;
Intr($1a,regs);
Write_PCI_cfg_byte(ppkey,$3c,irq);
end;


Procedure Enable_PCI_io_access(ppkey:pci_config_s);
var w:word;
begin
w:=read_pci_cfg_word(ppkey,4);
w:=w or 1;
write_pci_cfg_word(ppkey,4,w);
end;


Procedure Enable_PCI_memory_access(ppkey:pci_config_s);
var w:word;
begin
w:=read_pci_cfg_word(ppkey,4);
w:=w or 2;
write_pci_cfg_word(ppkey,4,w);
end;


Procedure Enable_PCI_bus_master(ppkey:pci_config_s);
var w:word;
begin
w:=read_pci_cfg_word(ppkey,4);
w:=w or 4;
write_pci_cfg_word(ppkey,4,w);
end;

{===========================================================================}
{A ted kod pro ovladani podsbernice SMbus}
{===========================================================================}

Function Find_SMBUS_baseport:word;
var class,n:dword;
    pp:pci_config_s;

begin
if not if_pci_bios then begin Find_SMBUS_baseport:=0;Exit;end;
class:=pci_serial_bus_controller + z_SMBUS;  {kod sbernice SMBUS}

if not Find_PCI_class_code(class,0,pp) then  {zkus najit SMBUS}
   begin Find_SMBUS_baseport:=0;Exit;end;
{nalezeno, budeme tedy pokracovat dale}
n:=Read_PCI_cfg_dword(pp,$20) and $fff0; {mozna radeji and FFFC nebo FFFE?}
Find_SMBUS_baseport:=word(n);
end;


Procedure Enable_SMBUS_on_PCI;
{Adaptovano z nejakeho kodu pro cipy ICHx}
var class:dword;
    pp:pci_config_s;
    b:byte;
begin
if not if_pci_bios then Exit;
if not Find_PCI_class_code(class,0,pp) then Exit;

{nalezeno, budeme tedy pokracovat dale}
b:=Read_PCI_cfg_byte(pp,$40);
b:=b or 1;
if (b and 4)<>0 then b:=b and (not 4);
Write_PCI_cfg_byte(pp,$40,b);
end;


Procedure Disable_SMBUS_on_PCI;
{Adaptovano z nejakeho kodu pro cipy ICHx}
var class:dword;
    pp:pci_config_s;
    b:byte;
begin
if not if_pci_bios then Exit;
if not Find_PCI_class_code(class,0,pp) then Exit;
b:=Read_PCI_cfg_byte(pp,$40);
b:=b and $0fa;   {vymaze bity 0 a 2}
Write_PCI_cfg_byte(pp,$40,b);
end;


Procedure Get_SMBUS_regs(SMBUS_baseport:word;var smbus_regs:i2c_regs);
var w:word;
    r0,r1,r2,r3,r4,r5,r6:byte;
begin
if SMBUS_baseport=0 then Exit;
w:=SMBUS_baseport;
asm
xor ax,ax
mov dx,w
in al,dx         {HST_STS}
mov r0,al

add dx,2
in al,dx         {HST_CNT}
mov r2,al

add dx,1
in al,dx         {HST_CMD}
mov r3,al

add dx,1
in al,dx
mov r4,al        {XMIT_SLVA}

add dx,1
in al,dx
mov r5,al        {HST_D0}

add dx,1
in al,dx
mov r6,al        {HST_D1}
end;

smbus_regs[0]:=r0;
smbus_regs[2]:=r2;
smbus_regs[3]:=r3;
smbus_regs[4]:=r4;
smbus_regs[5]:=r5;
smbus_regs[6]:=r6;
end;


Procedure Delay1us(usecs:word);
var real_ticks:real;
    ticks:word;
begin
real_ticks:=0.596590*(usecs+1);
ticks:=word(round(real_ticks));
if ticks=0 then Exit;
asm
mov cx,ticks
mov bx,2
@waittrig:
in   al,41h
and  al,02h
cmp  al,bl
jz   @waittrig
xor  bl,02h
loop @waittrig
end; {asm}
end;


Procedure DelayMicro;
begin
Port[$00eb]:=0;
end;


Function Read_SMBUS_byte_protocol(SMBUS_baseport:word;slave_adr,data_adr,readbyte_cmd:byte):byte;
{Prikaz pro cteni bajtu bohuzel neni pro vsechna zarizeni stejny.
 Vetsinu jsem se ve zdrojacich setkal s hodnotou 48h}

var b:byte;
    timeout:word;
begin
Port[SMBUS_baseport+i2c__HST_STS]:=$1f;
{"host status": vymazeme nechane stavove bity}

Port[SMBUS_baseport+i2c__HST_CMD]:=data_adr;
{"host command": zapiseme do radice data_adr (datovy index)}

Port[SMBUS_baseport+i2c__XMIT_SLVA]:=(slave_adr shl 1) or 1;
{"transmit slave address": urcime slave zarizeni se kterym se budeme
 bavit. Krome toho bit 0 nastavim na 1, protoze to znamena <byte read>}

Port[SMBUS_baseport+i2c__HST_CNT]:=readbyte_cmd; {nejcasteji snad 48h}
{"host control": chceme funkci pro cteni jednoho bajtu)}

timeout:=0;
repeat
   Delay1us(5 {10});
   b:=Port[SMBUS_baseport+i2c__HST_STS];
   if (b and 1)=0 then Break else inc(timeout);
until timeout>1000;

if timeout>1000 then begin Read_SMBUS_byte_protocol:=$ff;Exit;end;


if (b and $1c)=0
   then Read_SMBUS_byte_protocol:=Port[SMBUS_baseport+i2c__HST_D0]
   else Read_SMBUS_byte_protocol:=$ff;

Port[SMBUS_baseport+i2c__HST_STS]:=$ff; {uklidi status}
end;



Procedure Write_SMBUS_byte_protocol(SMBUS_baseport:word;slave_adr,data_adr,value,writebyte_cmd:byte);
{Prikaz pro zapis bajtu bohuzel neni pro vsechna zarizeni stejny.
 Vetsinu jsem se ve zdrojacich setkal s hodnotou 48h}
var status,b:byte;
    timeout:word;
begin

status:=Port[SMBUS_baseport+i2c__HST_STS];  {provedeme...}
Port[SMBUS_baseport+i2c__HST_STS]:=status;  {...reset    }

Port[SMBUS_baseport+i2c__XMIT_SLVA]:=(slave_adr shl 1) and $fe;
{urcime slave zarizeni, se kterym se budeme bavit. Je dulezite, aby byl
 bit c.0 vynulovany - to je nutne pro zapisove funkce}

Port[SMBUS_baseport+i2c__HST_CMD]:=data_adr;
{Zadame do radice datovy index}

Port[SMBUS_baseport+i2c__HST_D0]:=value;
{A nakonec hodnotu, kterou tam chceme zapsat}

Port[SMBUS_baseport+i2c__HST_CNT]:=writebyte_cmd;
{"host control": chceme funkci pro zapis jednoho bajtu)}

timeout:=0;
repeat
   Delay1us(5 {10});
   b:=Port[SMBUS_baseport+i2c__HST_STS];
   if (b and 1)=0 then Break else inc(timeout);
until timeout>1000;

if timeout>1000 then Exit;

Port[SMBUS_baseport+i2c__HST_STS]:=$ff; {uklidi status}
end;



Function Test_SMBUS_device(SMBUS_baseport:word;dev:byte):boolean;
const command_for_test = $48; {= 01001000b = 72d}
var b:byte;
    timeout:word;
begin
Port[SMBUS_baseport+i2c__XMIT_SLVA]:=(dev shl 1) or 1;
{Chceme zarizeni DEV a bude funkce "cteni" (proto to "or 1")}
DelayMicro;
Port[SMBUS_baseport+i2c__HST_CMD]:=0;
DelayMicro;
{Budeme pristupovat k registru 0}
Port[SMBUS_baseport+i2c__HST_CNT]:=command_for_test;
{"host control": chceme funkci pro zapis jednoho bajtu)}

timeout:=0;
repeat
   {DelayMicro;}
   Delay1us(5 {10});  {zajimave - kdyz se da moc male zdrzeni, tak vraci...}
                      {...zvlastne nepresne vysledky}
   b:=Port[SMBUS_baseport+i2c__HST_STS];
   if (b and 2)<>0 then Break else inc(timeout);
until timeout>1000;

if timeout>1000 then
   begin
   Port[SMBUS_baseport+i2c__HST_CNT]:=2;  {???}
   b:=Port[SMBUS_baseport+i2c__HST_STS];
   end;

DelayMicro;
Port[SMBUS_baseport+i2c__HST_STS]:=b;
b:=b and 2;
Test_SMBUS_device:=b<>0;

{Test_SMBUS_device:=Read_SMBUS_byte(SMBUS_baseport,dev,0,$48)<>$ff;}
end;


Function ToStr(a:longint):string;
var s:string;
begin
str(a,s);
ToStr:=s;
end;

function HexaStr(D:Dword;L:Byte):string;
var I:Byte;
    S:string;
begin
S:='';
for I:=L-1 downto 0 do S:=S+HexaNum[(D shr (I*4) and $0F) + 1];
HexaStr:=S;
end;



Function Scan_SMBUS_devices(SMBUS_baseport:word;in_hex:boolean):string;
var s,t:string;
    a:byte;
    b:boolean;

begin
s:='';
for a:=127 downto 0 do
   begin
   b:=Test_SMBUS_device(SMBUS_baseport,a);
   if B then
      begin
      if in_hex
         then t:=Hexastr(a,2)+'h,'
         else t:=ToStr(a)+',';
      s:=s+t;
      end;


   end;
if s<>'' then dec(s[0]);
Scan_SMBUS_devices:=s;
end;

end.
