omcdrv.~pas

pipe类 pipe类 pipe类 pipe类 pipe类

//----------------------------------------------------------------------------//
//     This unit is a part of an OpenSource project OverSoft CPU Informer     //
//     OMCDrv.pas - interface unit to IO driver access                        //
//                                                                            //
//                                                                            //
//   Written by Dmitriy Arekhta(Daemon) [e-mail] (c) 2005-2006  //
//   OverSoft Team (c) 2005-2006                                              //
//----------------------------------------------------------------------------//
unit OMCDrv;

interface

uses
  Windows, SysUtils, WinVer, CmnTnC, hPCI;

type
  IPortIO = interface
  ['{E380552D-63E6-4FFA-B28C-2725F72EFB76}']
    function ReadPortB(index: word): byte;
    function ReadPortW(index: word): word;
    function ReadPortL(index: word): longint;

    procedure WritePortW(index: word; value: word);
    procedure WritePortB(index: word; value: byte);
    procedure WritePortL(index: word; value: longint);

    property B[index: word]: byte read ReadPortB write WritePortB;
    property W[index: word]: word read ReadPortW write WritePortW;
    property L[index: word]: longint read ReadPortL write WritePortL;
  end;

  tPortIO = class(TInterfacedObject, IPortIO)
  private
    function ReadPortB(index: word): byte;
    function ReadPortW(index: word): word;
    function ReadPortL(index: word): longint;

    procedure WritePortB(index: word; value: byte);
    procedure WritePortW(index: word; value: word);
    procedure WritePortL(index: word; value: longint);
  end;

  IMSRIO = interface
  ['{3154B75E-5482-40A4-9B9D-91C048C28ABE}']
    function ReadMSR(msr_num: DWord; var msr: tmsr): boolean;
    function WriteMSR(msr_num: DWord; const msr: tmsr): boolean;
  end;

  tMSRIO = class(TInterfacedObject, IMSRIO)
    function ReadMSR(msr_num: DWord; var msr: tmsr): boolean;
    function WriteMSR(msr_num: DWord; const msr: tmsr): boolean;
  end;

  IPCIIO = interface
  ['{37A80C14-2570-47B8-BC00-A973D368D079}']
    procedure GetPCIRDWord(dwBus, dwDev, dwFunc, offs: byte; var pdata: DWord);
    procedure SetPCIRDWord(dwBus, dwDev, dwFunc, offs: byte; pdata: DWord);
    procedure GetPCIRWord(dwBus, dwDev, dwFunc, offs: byte; var pdata: Word);
    procedure GetPCIRByte(dwBus, dwDev, dwFunc, offs: byte; var pdata: byte);
    procedure SetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata: byte);
    function  ProbeDevice(dwBus, dwDev: byte): boolean;
    procedure FindDevice(VendorID, DeviceID: Dword; var fPCIDevice: tPCIDevice);
  end;

  tPCIIO = class(TInterfacedObject, IPCIIO)
  private
    FIPortIORef: IPortIO;
    procedure GetPCIRDWord(dwBus, dwDev, dwFunc, offs: Byte; var pdata: DWord);
    procedure SetPCIRDWord(dwBus, dwDev, dwFunc, offs: Byte; pdata: DWord);
    procedure GetPCIRWord(dwBus, dwDev, dwFunc, offs: Byte; var pdata: Word);
    procedure GetPCIRByte(dwBus, dwDev, dwFunc, offs: Byte; var pdata: Byte);
    procedure SetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata: Byte);
    function  ProbeDevice(dwBus, dwDev: Byte): boolean;
    procedure FindDevice(VendorID, DeviceID: DWord; var fPCIDevice: tPCIDevice);
  public
    constructor Create(const IPortIORef: IPortIO);
    destructor Destroy; override;
  end;

  tOMCDrv = class(TInterfacedObject, IPortIO, IMSRIO, IPCIIO)
  private
    FIPortIO: IPortIO;
    FIMSRIO: IMSRIO;
    FIPCIIO: IPCIIO;
  public
    isLoad: boolean;

    constructor Create(debug: boolean = false);
    destructor Destroy; override;

    function LoadDriver: boolean;
    function UnloadDriver: boolean;

    procedure ISAPortOut(PortNo: Word; Data: Byte);
    function  ISAPortIn(PortNo: Word): Byte;

    function MemReadLong(Addr: DWord): DWord;
    function MemReadShort(Addr: DWord): Word;
    function MemReadChar(Addr: DWord): Byte;

    property IPortIORef: IPortIO read FIPortIO implements IPortIO;
    property IMSRIORef: IMSRIO read FIMSRIO implements IMSRIO;
    property IPCIIORef: IPCIIO read FIPCIIO implements IPCIIO;
  end;

type
  tGetPCIRDWord = procedure (dwBus, dwDev, dwFunc, offs: Byte; var pdata: DWord); stdcall;
  tSetPCIRDWord = procedure (dwBus, dwDev, dwFunc, offs: Byte; pdata: DWord); stdcall;
  tGetPCIRWord = procedure (dwBus, dwDev, dwFunc, offs: Byte; var pdata: Word); stdcall;
  tGetPCIRByte = procedure (dwBus, dwDev, dwFunc, offs: Byte; var pdata: Byte); stdcall;
  tSetPCIRByte = procedure (dwBus, dwDev, dwFunc, offs, pdata: Byte); stdcall;
  tProbeDevice = function (dwBus, dwDev: Byte): boolean; stdcall;
  tFindDevice = procedure (VendorID, DeviceID: DWord; var fPCIDevice: tPCIDevice); stdcall;

  tPCIIOWrapper = record
    GetPCIRDWord: tGetPCIRDWord;
    SetPCIRDWord: tSetPCIRDWord;
    GetPCIRWord: tGetPCIRWord;
    GetPCIRByte: tGetPCIRByte;
    SetPCIRByte: tSetPCIRByte;
    ProbeDevice: tProbeDevice;
    FindDevice: tFindDevice;
  end;

//Singleton
function GetInstance(): tOMCDrv;

procedure AddToLog(Mes: string);

var
  fDebug: boolean;
  PCIIOWrapper: tPCIIOWrapper;

implementation

uses DrvInterface;

var
  fDrvIface: cDrvIface = nil;
  dbgfile: TextFile;
  dbgfn: PAnsiChar;
  this_: tOMCDrv;

function GetInstance(): tOMCDrv;
begin
  if (not Assigned(this_)) then this_ := tOMCDrv.Create(false);
  result := this_;
end;

procedure AddToLog(Mes: string);
var
  Time: TSystemTime;
begin
  try
  AssignFile(dbgfile, dbgfn);
  if FileExists(dbgfn) then begin Reset(dbgfile); Append(dbgfile); end
                       else Rewrite(dbgfile);
  GetLocalTime(Time);
  writeln(dbgfile, FormatFloat('00', Time.wHour)+':'+FormatFloat('00', Time.wMinute)+':'+FormatFloat('00', Time.wSecond)+': '+Mes);
  CloseFile(dbgfile);
  except
  end;
end;


constructor tOMCDrv.Create(debug: boolean = false);
begin
  inherited Create;
  FIPortIO := tPortIO.Create;
  FIMSRIO := tMSRIO.Create;
  FIPCIIO := tPCIIO.Create(FIPortIO);
  fDebug:=debug;
  SetCurrentDir(ExtractFilePath(ParamSTR(0)));
  if fDebug then
    begin
      dbgfn:='drvdebug.nfo';
      AddToLog('Creating low level driver class');
      AddToLog('IOCTL_PCI_READ_PORT_ULONG = 9C406408h');
      AddToLog('IOCTL_PCI_READ_PORT_USHORT = 9C406404h');
      AddToLog('IOCTL_PCI_READ_PORT_UCHAR = 9C406400h');
      AddToLog('IOCTL_PCI_WRITE_PORT_ULONG = 9C40A448h');
      AddToLog('IOCTL_PCI_WRITE_PORT_USHORT = 9C40A444h');
      AddToLog('IOCTL_PCI_WRITE_PORT_UCHAR  = 9C40A440h');
      AddToLog('IOCTL_READ_MSR = 9C402604h');
      AddToLog('IOCTL_WRITE_MSR = 9C402608h');
    end;
end;

destructor tOMCDrv.Destroy;
begin
  FIPCIIO := nil;
  FIPortIO := nil;
  FIMSRIO := nil;
  if fDebug then AddToLog('Destroying low level driver class');
  inherited Destroy;
end;

function tOMCDrv.LoadDriver: boolean;
begin
  result := false;
  try
    fDrvIface := cDrvIface.Create;
    result := fDrvIface.isLoad;
    isLoad:=result;
  except
  end;
end;


function tOMCDrv.UnloadDriver: boolean;
begin
  result := false;
  if fDrvIface <> nil then
  begin
    fDrvIface.Destroy;
    result := true;
  end;
end;

procedure tOMCDrv.ISAPortOut(PortNo: Word; Data: Byte);
begin
  FIPortIO.WritePortB(PortNo, Data);
end;


function tOMCDrv.ISAPortIn(PortNo: Word): Byte;
begin
  result := FIPortIO.ReadPortB(PortNo);
end;

function tOMCDrv.MemReadLong(Addr: DWord): DWord;
begin
  result:=fDrvIface.MemReadDWord(Addr);
end;

function tOMCDrv.MemReadShort(Addr: DWord): Word;
begin
  result:=fDrvIface.MemReadWord(Addr);
end;

function tOMCDrv.MemReadChar(Addr: DWord): Byte;
begin
  result:=fDrvIface.MemReadByte(Addr);
end;

function tPortIO.ReadPortB(index: word): byte;
begin
  result:=0;
  if fDrvIface <> nil then
    result := fDrvIface.B[index];
end;

function tPortIO.ReadPortW(index: word): word;
begin
  result:=0;
  if fDrvIface <> nil then
    result := fDrvIface.W[index];
end;

function tPortIO.ReadPortL(index: word): longint;
begin
  result:=0;
  if fDrvIface <> nil then
    result := fDrvIface.L[index];
end;

procedure tPortIO.WritePortB(index: word; value: byte);
begin
  if fDrvIface <> nil then
    fDrvIface.B[index] := value;
end;

procedure tPortIO.WritePortW(index: word; value: word);
begin
  if fDrvIface <> nil then
    fDrvIface.W[index] := value;
end;

procedure tPortIO.WritePortL(index: word; value: longint);
begin
  if fDrvIface <> nil then
    fDrvIface.L[index] := value;
end;

const
  PCRAddress = $0cf8;
  PCRData    = $0cfc;

constructor tPCIIO.Create(const IPortIORef: IPortIO);
begin
  inherited Create;
  FIPortIORef := IPortIORef;
end;

destructor tPCIIO.Destroy;
begin
  FIPortIORef := nil;
  inherited Destroy;
end;

procedure tPCIIO.GetPCIRDWord( dwBus, dwDev, dwFunc, offs : byte; var pdata:DWord );
begin
  FIPortIORef.WritePortL(PCRAddress,$80000000 or (longint(dwBus) shl 16) or ((longint(dwDev) and $1f) shl 11) or
            ((longint(dwFunc) and $07 ) shl 8) or (offs and $fc));
  pdata := FIPortIORef.ReadPortL(PCRData);
end;

procedure tPCIIO.SetPCIRDWord(dwBus, dwDev, dwFunc, offs:byte; pdata:DWord);
//var IPort: IPortIO;
begin
  //IPort := oHWIO.IPortIORef;
  FIPortIORef.WritePortL(PCRAddress,$80000000 or (longint(dwBus) shl 16) or ((longint(dwDev) and $1f) shl 11) or
              ((longint(dwFunc) and $07) shl 8) or (offs and $fc));
  FIPortIORef.WritePortL(PCRData, pdata);
end;

procedure tPCIIO.GetPCIRWord(dwBus, dwDev, dwFunc, offs:byte; var pdata: Word);
var
  temp : longint;
  pcrreg : longint;
begin
  PCRReg :=$80000000 or (longint(dwBus) shl 16) or ((longint(dwDev) and $1f) shl 11) or
  ((longint(dwFunc) and $07) shl 8) or (offs and $fc);
  FIPortIORef.WritePortL(PCRAddress, PCRReg);
  Temp := FIPortIORef.ReadPortL(PCRData);
  pdata := (Temp shr ((offs mod 2) shl 3));
end;

procedure tPCIIO.GetPCIRByte(dwBus, dwDev, dwFunc, offs:byte; var pdata:byte);
var
  temp : longint;
  pcrreg : longint;
begin
  PCRReg :=$80000000 or (longint(dwBus) shl 16) or ((longint(dwDev) and $1f) shl 11) or
  ((longint(dwFunc) and $07) shl 8) or (offs and $fc);
  FIPortIORef.WritePortL(PCRAddress, PCRReg);
  Temp := FIPortIORef.ReadPortL(PCRData);
  pdata := (Temp shr ((offs mod 4) shl 3));
end;

procedure tPCIIO.SetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata:byte);
var
  temp   : longword;
  pcrreg : longint;
begin
  PCRReg := $80000000 or (longint(dwBus) shl 16) or ((longint(dwDev) and $1f) shl 11) or
  ((longint(dwFunc) and $07) shl 8) or (offs and $fc);

  FIPortIORef.WritePortL(PCRAddress, PCRReg);
  Temp := FIPortIORef.ReadPortL(PCRData) and NOT(($ff shl ((offs and 3) * 8))) or
                        (pdata shl ((offs and 3) * 8));
  FIPortIORef.WritePortL(PCRData, Temp);
end;

function tPCIIO.ProbeDevice(dwBus, dwDev: byte): boolean;
const InvalidDevice = $FFFFFFFF;
var VenDevID: longword;
begin
  GetPCIRDWord(dwBus, dwDev, 0, 0, VenDevID);
  result := ((VenDevID <> InvalidDevice) and (VenDevID <> 0));
end;

procedure tPCIIO.FindDevice(VendorID, DeviceID: DWord; var fPCIDevice: tPCIDevice);
var
  DevID, VenID: DWord;
  pdata: DWord;
  dwBus, dwDev, dwFunc: byte;
begin
  FillChar(fPCIDevice, SizeOf(fPCIDevice), 0);
  for dwBus:=0 to 255 do
    for dwDev:=0 to 31 do
      begin
        if not ProbeDevice(dwBus, dwDev) then continue;
        for dwFunc:=0 to 7 do
          begin
            GetPCIRDWord(dwBus, dwDev, dwFunc, 0, pdata);
            DevID:=Word(pdata shr 16);
            VenID:=Word(pdata);
            if (DevID=DeviceID) and (VenID=VendorID) then
                                begin
                                  fPCIDevice.Detected:=true;
                                  fPCIDevice.dwBus:=dwBus;
                                  fPCIDevice.dwDev:=dwDev;
                                  fPCIDevice.dwFunc:=dwFunc;
                                  exit;
                                end;
          end;
      end;
end;


function tMSRIO.ReadMSR(msr_num: DWord; var msr: tMSR): boolean;
begin
  result:=false;
  if fDrvIface <> nil then
    result := fDrvIface.ReadMSR(msr_num, msr);
end;


function tMSRIO.WriteMSR(msr_num: DWord; const msr: tMSR): boolean;
begin
  result:=false;
  if fDrvIface <> nil then
    result := fDrvIface.WriteMSR(msr_num, msr);
end;

//-----------------------------Wrapper functions----------------------------

procedure GetPCIRDWord(dwBus, dwDev, dwFunc, offs: byte; var pdata: DWord); stdcall;
begin
  GetInstance.IPCIIORef.GetPCIRDWord(dwBus, dwDev, dwFunc, offs, pdata);
end;

procedure SetPCIRDWord(dwBus, dwDev, dwFunc, offs: byte; pdata: DWord); stdcall;
begin
  GetInstance.IPCIIORef.SetPCIRDWord(dwBus, dwDev, dwFunc, offs,pdata);
end;

procedure GetPCIRWord(dwBus, dwDev, dwFunc, offs: byte; var pdata: Word); stdcall;
begin
  GetInstance.IPCIIORef.GetPCIRWord(dwBus, dwDev, dwFunc, offs, pdata);
end;

procedure GetPCIRByte(dwBus, dwDev, dwFunc, offs: byte; var pdata: byte); stdcall;
begin
  GetInstance.IPCIIORef.GetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata);
end;

procedure SetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata: byte); stdcall;
begin
  GetInstance.IPCIIORef.SetPCIRByte(dwBus, dwDev, dwFunc, offs, pdata);
end;

function  ProbeDevice(dwBus, dwDev: byte): boolean; stdcall;
begin
  result := GetInstance.IPCIIORef.ProbeDevice(dwBus, dwDev);
end;

procedure FindDevice(VendorID, DeviceID: Dword; var fPCIDevice: tPCIDevice); stdcall;
begin
  GetInstance.IPCIIORef.FindDevice(VendorID, DeviceID, fPCIDevice);
end;

procedure InitPCIIOWrapper();
begin
    PCIIOWrapper.GetPCIRDWord := GetPCIRDWord;
    PCIIOWrapper.SetPCIRDWord := SetPCIRDWord;
    PCIIOWrapper.GetPCIRWord := GetPCIRWord;
    PCIIOWrapper.GetPCIRByte := GetPCIRByte;
    PCIIOWrapper.SetPCIRByte := SetPCIRByte;
    PCIIOWrapper.ProbeDevice := ProbeDevice;
    PCIIOWrapper.FindDevice := FindDevice;
end;

initialization
  this_ := nil;
  InitPCIIOWrapper();

finalization
  this_.UnloadDriver;
  this_.Free;

end.