fm_vsync1.pas

在Windows NT使用I/O端口,包括装载,开始,卸载驱动程序的函数.

unit fm_VSync1;
{ PortTest program  Vertical Sync Test form

Revisions
---------
98-06-01 GW Original

Copyright info: see main form unit
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Stopwch1;

type
  Tfm_VSync = class(TForm)
    GroupBox1: TGroupBox;
    bt_Setup: TButton;
    bt_VSyncs: TButton;
    lb_Result: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    bt_Enable_Ports: TButton;
    bt_Disable_Ports: TButton;
    procedure bt_SetupClick(Sender: TObject);
    procedure bt_VSyncsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bt_Enable_PortsClick(Sender: TObject);
    procedure bt_Disable_PortsClick(Sender: TObject);
  private
    { Private declarations }
    MySW: TStopWatch;

    function ResultOK(DriverResult: DWORD): Boolean;
  public
    { Public declarations }
  end;

var
  fm_VSync: Tfm_VSync;

//---------------------------
implementation
//---------------------------
uses gwportio, gwiopm, gwutil_1;

{$R *.DFM}

//----------------------------------------------
procedure Tfm_VSync.FormCreate(Sender: TObject);
//----------------------------------------------
begin
  MySW := TStopwatch.Create;
end;

{----------------------------------------------------------------
                      Vertical IRQ Management
-----------------------------------------------------------------}
{
Notes
-----
Does not actually use IRQ. Instead, uses the IRQ-Clear and IRQ-pending
features. So IRQ detection requires polling the IRQ-pending bit, but
eliminates the necessity to poll the actual Vertical-retrace bit, which
does not latch, and hence can be missed if polling is not frequent enough.

Notes:
-------------------------
Vertical IRQ may not be implemented very consistently on all video cards,
so:
1) Don't actually use IRQ, just the clear-pending mechanism.
2) Do we need to disable IRQ 9 at Slave 8259? Hopefully not.
}

Type
  WordAsBytes = record
    L: byte;
    H: byte;
  end;

Const
  VGAInStatReg0          = $3C2;
  VGAIntCtlReg           = $3D4;
  PIC8259MasterBaseReg   =  $20;
  PIC8259MasterMaskReg   =  $21;
  PIC8259SlaveBaseReg    =  $A0;
  PIC8259SlaveMaskReg    =  $A1;
  VREndRegNum            =  $11;
  IRQClearAND            =  $EF;
  IRQClearOR             =  $10;

Var
  InitialSetupDone: Boolean;
  VREnd:             word;    { storage for contents of VREnd VGA reg }

{-----------------------------------}
procedure   VSync_Init;
Begin
  InitialSetupDone   := false;
  VREnd              := 0;
  // SaveSlave8259Mask  := 0;
  // Slave8259MaskSave;
end;

{-----------------------------------}
procedure    VSync_Done;
Begin
  // Slave8259MaskRestore;
end;

{-----------------------------------}
procedure    VSync_Setup;
// Var
//   SlaveIRQMask: byte;
Label L51, L52;
Begin

  {------------------------------
    Setup VGA Card for VIRQs
  -------------------------------}

  VREnd := VREndRegNum;

  asm {----------------------------------}

  { assume it's a VGA, so skip all the checking }
  mov   dx,VGAIntCtlReg

  { get default Vert Retrace End Reg }
  mov   al,VREndRegNum
  out   dx,al
  inc   dx
  in    al,dx
  mov   WordAsBytes(VREnd).H,al  { save it }

  { enable vert ints }
  mov   dx, VGAIntCtlReg
  mov   ax, VREnd
  { and   ah,11001111b  { clear 5&4 }
  and   ah,IRQClearAND  { clear (4) VI Latch, not IRQ }
  out   dx,ax
  jmp   L51
L51:
  or    ah,IRQClearOR  { set 4 }
  out   dx,ax
  jmp   L52
L52:
  xor   ax,ax

  end; {--------------asm--------------}

  InitialSetupDone := True;
end;

{-----------------------------------}
procedure VSync_IRQReset;
Label L1;
begin
  If Not InitialSetupDone then VSync_Setup;

  asm
  mov   dx, VGAIntCtlReg
  in    al,dx
  mov   ax,VREnd
  and   ah,IRQClearAND      { clear IRQ-pending latch }
  out   dx,ax
  jmp   L1
L1:
  or    ah,IRQClearOR       { finish clear of IRQ latch }
  out   dx,ax

  end; { end asm }
end;

{-----------------------------------}
function VSync_IRQPending: Boolean;
Var
  B: byte;
Begin
  B := PortIn(VGAInStatReg0);
  result := (B and $80) <> 0;
end;

{-----------------------------------}
procedure VSync_IRQWaitNext;
Begin
  VSync_IRQReset;
  Repeat
  Until VSync_IRQPending;
end;

(*********************************
{-----------------------------------}
procedure TXFVIRQMgr.Slave8259MaskSave;
Begin
  If SaveSlave8259Mask = 0 then
    SaveSlave8259Mask := Port[PIC8259SlaveMaskReg];
end;

{-----------------------------------}
procedure TXFVIRQMgr.Slave8259MaskRestore;
Begin
  Port[PIC8259SlaveMaskReg] := SaveSlave8259Mask;
  SaveSlave8259Mask := 0;
end;
********************************)

//----------------------------------------------
procedure Tfm_VSync.bt_SetupClick(Sender: TObject);
//----------------------------------------------
begin
  VSync_Setup;
end;

//----------------------------------------------
procedure Tfm_VSync.bt_VSyncsClick(Sender: TObject);
//----------------------------------------------
Var
  N: integer;
  VSyncCount: integer;
  Elapsedms: integer;
begin
  MySW.Reset;
  lb_Result.Caption := 'Starting';
  lb_Result.Refresh;
  VSyncCount := 0;
  VSync_IRQReset;
  Elapsedms := 0;

  While Elapsedms < 1000 do
  Begin
    If VSync_IRQPending then
    Begin
      VSync_IRQReset;
      Inc(VSyncCount);
    end;
    // Application.HandleMessage;
    Elapsedms := MySW.ElapsedTimems;
  end; { while }

  lb_Result.Caption := 'VSyncs/sec: '+IntToStr(VSyncCount);
end;

//---------------------------------
function Tfm_VSync.ResultOK(DriverResult: DWORD): Boolean;
//---------------------------------
Begin
  If DriverResult <> ERROR_SUCCESS then
  Begin
    lb_Result.Caption := GWIOPM_Driver.ErrorLookup(DriverResult);
  end;
  result := (DriverResult = ERROR_SUCCESS);
end;

//---------------------------------
procedure Tfm_VSync.bt_Enable_PortsClick(Sender: TObject);
//---------------------------------
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($3C2, $3C3, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($3D4, $3D5, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

//---------------------------------
procedure Tfm_VSync.bt_Disable_PortsClick(Sender: TObject);
//---------------------------------
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($3C2, $3C3, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($3D4, $3D5, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

end.