vmemutil.pas

Turbo Pascal 6.0编译器源码

unit VMemUtil;

{$O+,F+,S-}

interface

function GetFromVMem(var Buf; Size: Word): Word;
function PutToVMem(var Buf; Size: Word): Word;

implementation

uses Objects, Memory, VMem;

type

  PList = ^TList;
  TList = record
    H: HMem;
    Next: PList;
  end;

const

  Head: PList = nil;
  Tail: PList = nil;

var

  InPtr: Word;
  OutPtr: Word;

function GetPage: Boolean;
var
  P: PList;
begin
  GetPage := False;
  P := MemAlloc(SizeOf(TList));
  if P = nil then
    Exit;
  P^.H := GetVMem(VMemPageSize);
  if P^.H = nil then
    Exit;
  P^.Next := nil;
  if Tail <> nil then
    Tail^.Next := P;
  Tail := P;
  if Head = nil then
  begin
    Head := Tail;
    InPtr := 0;
  end;
  GetPage := true;
end;

procedure DisposePage;
var
  P: PList;
begin
  P := Head^.Next;
  FreeVMem(Head^.H);
  Dispose(Head);
  Head := P;
  if P = nil then
  begin
    Tail := nil;
    OutPtr := 0;
  end;
end;

function PutToVMem(var Buf; Size: Word): Word;
var
  Count, I: Word;
begin
  Count := 0;
  if Tail = nil then
  begin
    if not GetPage then
    begin
      PutToVMem := 0;
      Exit;
    end;
    OutPtr := 0;
  end;
  while Count < Size do
  begin
    if Size - Count < VMemPageSize - OutPtr then
      I := Size - Count
    else
      I := VMemPageSize - OutPtr;
    with Tail^ do
      Move(PByteArray(@Buf)^[Count], PByteArray(UseHandle(H))^[OutPtr], I);
    Inc(Count, I);
    PutToVMem := Count;
    Inc(OutPtr, I);
    if OutPtr >= VMemPageSize then
    begin
      OutPtr := 0;
      if not GetPage then
        Exit;
    end;
  end;
end;

function GetFromVMem(var Buf; Size: Word): Word;
var
  Count, I, N: Word;
begin
  Count := 0;
  while Count < Size do
  begin
    if Head = nil then
    begin
      GetFromVMem := Count;
      Exit;
    end;
    if Head = Tail then
      N := OutPtr
    else
      N := VMemPageSize;
    if Size - Count < N - InPtr then
      I := Size - Count
    else
      I := N - InPtr;
    Move(PByteArray(UseHandle(Head^.H))^[InPtr], PByteArray(@Buf)^[Count], I);
    Inc(Count, I);
    Inc(InPtr, I);
    if InPtr >= N then
    begin
      InPtr := 0;
      DisposePage;
    end;
  end;
  GetFromVMem := Count;
end;

end.