Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TAVRAM.ZIP/TAVRAM.PAS

Pascal/Delphi Source File | 1989-06-01 | 23.1 KB | 809 lines

(***************************************************************************)
(***************************************************************************)
(**                                                                       **)
(**            TaVram.PAS - Ta Virtual Ram - Turbo Pascal Unit            **)
(**                                                                       **)
(**                              Version 1.0                              **)
(**                                                                       **)
(**                   (written under version 5.0 of TP)                   **)
(**                                                                       **)
(**                                                                       **)
(**                                                                       **)
(**         Copyright 1989 - By Thomas Astin - All rights reserved.       **)
(**                                                                       **)
(**         Thomas Astin  (Compuserve  73407,3427)                        **)
(**         3451 Vinton Ave.  #9                                          **)
(**         L.A.,   CA   90034                                            **)
(**                                                                       **)
(** Description:  Virtual heap manager for Turbo Pascal.                  **)
(**                                                                       **)
(** Revision history:                                                     **)
(**                                                                       **)
(***************************************************************************)
(***************************************************************************)

{ $DEFINE DEBUG}     {-Debug mode}
{$DEFINE ERRORMSG}   {-Include error messages}
{$DEFINE USEINLINE}  {-Use Inline code for VRamHandleOnHeap}
{$DEFINE HIDDEN}     {-Use for hidden Vram/Vfree files}
{ $DEFINE USELONG}   {-Use LongInt for TimesUsed}

{$IFDEF USEINLINE}
{$UNDEF USELONG}     {-Cannot use LongInt w/Inline}
{$ENDIF}

{$IFDEF DEBUG}
{$UNDEF HIDDEN}
{$R-,S-}
{$ELSE}
{$R+,S+}
{$ENDIF}

Unit TaVRam;
Interface
uses
  Dos,
  GrabHeap;
const
  DeRefIntVect = $66;
  MaxVRamBuffer = 4096;
  VRamNil = 0;
  VRamSegSig = $FFFF; {-Signature indicates a VRam pointer}
  VRamHeapFilename = 'VRAM.$$$';
  VRamFreeFilename = 'VFREE.$$$';
type
  VRamBufferPtr = ^VRamBufferArray;
  VRamBufferArray = Array[1..MaxVRamBuffer] of byte;
  VRamFreeRecord = Record
    StartBlock,
    EndBlock : Word;
  end;
  VRamBlockSizeRecord = Record
    BSize : Word;
    Fill  : Array[1..16-SizeOf(Word)] of Byte;
  end;
  VRamHeapDescRecPtr = ^VRamHeapDescRec;
  VRamHeapDescRec = Record
    PrevHeapRecP,
    NextHeapRecP : VRamHeapDescRecPtr;
    TimesUsed :
      {$IFDEF USELONG}
      Longint; {-count of times dereferenced}
      {$ELSE}
      Word;
      {$ENDIF}
    RealP : Pointer; {-pointer to VRam block on heap}
    VRamHandle : Word;
    DataSize : Word;
    Locked : Boolean;
  end;
  IntRegisterRecord = Record
    BP, ES, DS, DI, SI, DX, CX, BX, AX, IP, CS, Flags : Word;
  end;
var
  AdjustHeapPtrAfterFreeMem : Boolean;
  UseVRam : Boolean;
  PageVRam : Boolean;
  VRamMaxHeapToUse : LongInt;
  VRamHeapUsed : LongInt;

function VRamPageOutOldest : Boolean;
procedure VRamPageOutFreeMem(Size : Word);
procedure VRamGetMem(var P: Pointer; Size: Word);
procedure VRamFreeMem(var P : Pointer; Size: Word);

{-Make life easier for the programmer}
procedure VRamOn;
Inline(
  $C6/$06/>USEVRAM/$01);{            mov    BYTE PTR [>UseVRam],1}

procedure VRamOff;
Inline(
  $C6/$06/>USEVRAM/$00);{            mov    BYTE PTR [>UseVRam],0}

procedure VRamPageOn;
Inline(
  $C6/$06/>PAGEVRAM/$01);{           mov    BYTE PTR [>PageVRam],1}

procedure VRamPageOff;
Inline(
  $C6/$06/>PAGEVRAM/$00);{           mov    BYTE PTR [>PageVRam],0}

Implementation
const
  MaxVRamError = 4;
type
  VRamMsgStr = String[80];
  VRamMsgArray = Array[1..MaxVRamError] of VRamMsgStr;
const
  VRamDeallocError   = 1;
  VRamPageoutError   = 2;
  VRamAllocError     = 3;
  VRamAllocFreeError = 4;
  {$IFDEF ERRORMSG}
  VRamMessage : VRamMsgArray = ('Attempt to deallocate bad virtual heap descriptor.',
                                'Attempt to page out when nothing to page.',
                                'Not able allocate a virtual pointer.',
                                'Not able to allocate a virtual free list entry.');
  {$ENDIF}
var
  VRamFreePtr : LongInt;
  VRamHeapPtr : LongInt;
  VRamDescListHead : VRamHeapDescRecPtr;
  VRamDescListTail : VRamHeapDescRecPtr;
  VRamHeapFile : File;
  VRamFreeFile : File of VRamFreeRecord;
  SaveExitProc : Pointer;
  SaveDeRefIntVect : Pointer;

procedure IntsOn;
inline($FB);

procedure IntsOff;
inline($FA);

procedure HaltProg(Msg: String; EC : Byte);
 {-Generic halt program routine}
begin
  writeln;
  writeln('VRam error : ',Msg);
  writeln('Program aborted.');
  Halt(EC);
end;

procedure Abort(VRamErrorNum : Byte);
 {-Abort program with number (with or w/o messages)}
{$IFNDEF ERRORMSG}
var
  NStr : String[3];
{$ENDIF}
begin
  {$IFNDEF ERRORMSG}
  Str(VRamErrorNum:2,NStr);
  {$ENDIF}
  HaltProg( {$IFDEF ERRORMSG}
            VRamMessage[VRamErrorNum]
            {$ELSE}
            NStr
            {$ENDIF}
            ,VRamErrorNum);
end;

procedure VRamClose;
 {-Close and Erase files VRam files}
begin
  Close(VRamHeapFile);
  Close(VRamFreeFile);
  {$IFNDEF DEBUG}
  Erase(VRamHeapFile);
  Erase(VRamFreeFile);
  {$ENDIF}
end;

{$F+}
procedure VRamExitProc;
 {-VRam exit proc: close files and return int vect}
begin
  ExitProc:=SaveExitProc;
  SetIntVec(DeRefIntVect,SaveDeRefIntVect);
  VRamClose;
end;
{$F-}

procedure OrigGetMem(var P : Pointer; Size : Word);
 {-Temporarily return TP's normal heap routines and do a GetMem}
begin
  SystemHeapControl;
  GetMem(P, Size);
  CustomHeapControl(@VRamGetMem, @VRamFreeMem);
end;

procedure OrigFreeMem(var P : Pointer; Size : Word);
 {-Temporarily return TP's normal heap routines and do a FreeMem}
begin
  SystemHeapControl;
  FreeMem(P, Size);
  CustomHeapControl(@VRamGetMem, @VRamFreeMem);
end;

procedure InsertRealHeapRecord(var RealHP : VRamHeapDescRecPtr);
 {-Insert VRam Heap Description record into the linked list}
begin
  if VRamDescListHead=nil then begin
    VRamDescListHead:=RealHP;
    VRamDescListTail:=RealHP;
    with RealHP^ do begin
      NextHeapRecP:=nil;
      PrevHeapRecP:=nil;
    end;
  end
  else
    with RealHP^ do begin
      NextHeapRecP:=VRamDescListTail;
      PrevHeapRecP:=nil;
      VRamDescListTail^.PrevHeapRecP:=RealHP;
      VRamDescListTail:=RealHP;
    end;
end;


procedure VRamDeallocateRealHeap(RealHP : VRamHeapDescRecPtr);
 {-Remove a VRamHeapDescRec from the linked list}
 {-Free the memory associated with it}
begin
  if RealHP=nil then
    Exit;
  {Remove RealHP from the linked list}
  if RealHP^.NextHeapRecP=nil then
    VRamDescListHead:=RealHP^.PrevHeapRecP
  else
    RealHP^.NextHeapRecP^.PrevHeapRecP:=RealHP^.PrevHeapRecP;
  if RealHP^.PrevHeapRecP=nil then
    VRamDescListTail:=RealHP^.NextHeapRecP
  else
    RealHP^.PrevHeapRecP^.NextHeapRecP:=RealHP^.NextHeapRecP;

  {Free it from the heap real heap}
  With RealHP^ do begin
    OrigFreeMem(RealP,DataSize);
    Dec(VRamHeapUsed,DataSize);
  end;

  {Now free the actual description record}
  OrigFreeMem(Pointer(RealHP),SizeOf(VRamHeapDescRec));
  Dec(VRamHeapUsed,SizeOf(VRamHeapDescRec));
end;

function VRamSaveRealHeapData(RealHP : VRamHeapDescRecPtr) : Boolean;
 {-Save the data buffer contents from Real Heap to VRamHeapFile}
begin
  VRamSaveRealHeapData:=False;
  if RealHP<>nil then
    with RealHP^ do begin
      {-seek & skip status block}
      Seek(VRamHeapFile,VRamHandle+1);
      {-write data on heap}
      BlockWrite(VRamHeapFile,RealP^,DataSize div 16);
      VRamSaveRealHeapData:=True;
    end;
end;

function VRamPageOutOldest : Boolean;
 {-if unlocked page(s) exist then page out the least used}
var
  CurHP,
  LowestHP : VRamHeapDescRecPtr;
begin
  VRamPageOutOldest:=False;

  {if there is nothing there then exit}
  if VRamDescListHead=nil then
    Exit;

  {LowestHP will hold the lowest so far}
  LowestHP:=VRamDescListHead;

  {Make sure lowest is not locked}
  while (LowestHP^.Locked) and (LowestHP^.PrevHeapRecP<>nil) do
    LowestHP:=LowestHP^.PrevHeapRecP;
  if LowestHP^.Locked then
    Exit;

  {CurHP holds the current one being checked}
  CurHP:=LowestHP^.PrevHeapRecP;

  {while the current one is not nil do ...}
  while CurHP<>nil do begin

    {if the current one has been used less than the lowest, then lowest=current}
    if (CurHP^.TimesUsed<LowestHP^.TimesUsed) and (not CurHP^.Locked) then
      LowestHP:=CurHP;

    {check the next one in the chain}
    CurHP:=CurHP^.PrevHeapRecP;
  end;

  {Page out the lowest in the list. Abort if failure.}
  if not VRamSaveRealHeapData(LowestHP) then
    Abort(VRamDeallocError);

  {Now deallocate real heap space}
  VRamDeallocateRealHeap(LowestHP);

  {return success to the caller}
  VRamPageOutOldest:=True;
end;

procedure VRamPageOutFreeMem(Size : Word);
 {-A governed page out routine.  Page out until Size byte free on Real Heap}
begin
  while ((VRamHeapUsed+Size>VRamMaxHeapToUse) or (MaxAvail<Size)) and PageVRam do
    if not VRamPageOutOldest then
      Abort(VRamPageoutError);
end;

function VRamAllocateRealHeap(Handle : Word; HeapSize : Word) : VRamHeapDescRecPtr;
 {-Allocate a Real Heap data area and VRamHeapDescRec}
 {-Insert the VRamHeapDescRec into the linked list, set it up, and return it}
var
  NewVRamRecP : VRamHeapDescRecPtr;
begin
  VRamAllocateRealHeap:=nil;
  {Allocate memory on real heap for P}
  {First, page out until there is enough heap space}
  VRamPageOutFreeMem(SizeOf(VRamHeapDescRec));

  {Now that there is enough heap, allocate the description record}
  OrigGetMem(Pointer(NewVRamRecP),SizeOf(VRamHeapDescRec));
  Inc(VRamHeapUsed,SizeOf(VRamHeapDescRec));


  {now do the same for the actual data}
  VRamPageOutFreeMem(HeapSize);

  {Insert it into the linked list}
  InsertRealHeapRecord(NewVRamRecP);

  {Setup heap description record, allocate the data area on real heap}
  with NewVRamRecP^ do begin
    OrigGetMem(RealP,HeapSize);
    Inc(VRamHeapUsed,HeapSize);
    TimesUsed:=0;
    DataSize:=HeapSize;
    Locked:=False;
    {the handle is the start data block number in VRamHeapFile}
    VRamHandle:=Handle;
  end;
  VRamAllocateRealHeap:=NewVRamRecP;
end;

function VRamHandleOnHeap(H : Word) : VRamHeapDescRecPtr;
 {-If the passed handle is on the Real Heap then return a pointer to}
 {-its decsription block.}
var
  VRamDescP : VRamHeapDescRecPtr;
  X : Word;
begin
  VRamHandleOnHeap:=nil;
  VRamDescP:=VRamDescListHead;

{$IFNDEF USEINLINE}
  while VRamDescP<>nil do
    if VRamDescP^.VRamHandle<>H then
      VRamDescP:=VRamDescP^.PrevHeapRecP
    else begin
      Inc(VRamDescP^.TimesUsed);
      VRamHandleOnHeap:=VRamDescP;
      Exit;
    end;

{$ELSE}

  Inline(
                           {While:}
    $8B/$7E/<VRAMDESCP/    {              mov     di,[bp+<VRamDescP]}
    $0B/$46/<VRAMDESCP+2/  {              or      ax,[bp+<VRamDescP+2]}
    $74/$25/               {              jz      DescPNil                 ;is VRamDescP=nil?}
    $8E/$46/<VRAMDESCP+2/  {              mov     es,[bp+<VRamDescP+2]}
    $26/                   {              es:}
    $8B/$45/$0E/           {              mov     ax,[di+$0e]}
    $3B/$46/<H/            {              cmp     ax,[bp+<H]}
    $74/$0D/               {              je      FoundHandle}
    $26/                   {              es:}
    $C4/$05/               {              les     ax,[di]}
    $8C/$C2/               {              mov     dx,es}
    $89/$46/<VRAMDESCP/    {              mov     [bp+<VRamDescP],ax}
    $89/$56/<VRAMDESCP+2/  {              mov     [bp+<VRamDescP+2],dx}
    $EB/$DF/               {              jmp     While}
                           {FoundHandle:}
    $26/                   {              es:}
    $FF/$45/$08/           {              inc     word ptr [di+$08]}
    $8C/$C2/               {              mov     dx,es}
    $89/$7E/<VRAMHANDLEONHEAP/ {              mov     [bp+<VRamHandleOnHeap],di}
    $89/$56/<VRAMHANDLEONHEAP+2);{              mov     [bp+<VRamHandleOnHeap+2],dx}
                           {DescPNil:}

{$ENDIF}
end;

function VRamPageIn(Handle : Word) : Pointer;
 {-Page in data (if necessary) associated with handle and return a}
 {-Pointer to the data (NOT the VRamHeapDescRec)}
var
  VBSizeRec : VRamBlockSizeRecord;
  VRamDescP : VRamHeapDescRecPtr;
  ActRead  : Word;
begin
  VRamPageIn:=nil;
  VRamDescP:=VRamHandleOnHeap(Handle);
  if VRamDescP=nil then begin
    Seek(VRamHeapFile,Handle);
    BlockRead(VRamHeapFile,VBSizeRec,1);
    with VBSizeRec do begin
      VRamDescP:=VRamAllocateRealHeap(Handle,BSize);
      Seek(VRamHeapFile,Handle+1);
      BlockRead(VRamHeapFile,VRamDescP^.RealP^,BSize div 16,ActRead);
      if (BSize div 16)=ActRead then
        VRamPageIn:=VRamDescP^.RealP;
    end;
  end
  else
    VRamPageIn:=VRamDescP^.RealP;
end;

function VRamFreeBlockSize(VFR : VRamFreeRecord) : Word;
 {-Return the size of the free block described in VFR}
begin
  With VFR do
    VRamFreeBlockSize:=(EndBlock-StartBlock+1)*16;
end;

function VRamFreeBlockAvail(BSize : Word) : Word;
 {-Return free record number of a size that is usable, 0 if none}
var
  R : Word;
  VFR : VRamFreeRecord;
begin
  VRamFreeBlockAvail:=VRamNil;

  {if the free list has entries then check it}
  if VRamFreePtr<>0 then begin
    R:=0;
    Seek(VRamFreeFile,R);
    While (R<=VRamFreePtr) do begin

      {get free entry}
      Read(VRamFreeFile,VFR);

      {is it >= needed size?}
      if VRamFreeBlockSize(VFR)>=BSize then begin

        {yes, so return it to the caller}
        VRamFreeBlockAvail:=R;
        Exit;
      end;
      Inc(R);
    end;
  end;
end;

function VRamAllocateFreeBlock(FileAllocateSize : Word) : Word;
 {-Allocate a free block. Return VRamNil (0) if not successful.}
 {-Otherwise, return the starting block number}
var
  FB : Word;
  VFR : VRamFreeRecord;
  VBSizeRec : VRamBlockSizeRecord;
begin
  VRamAllocateFreeBlock:=VRamNil;

  {get a free block entry or return nil}
  FB:=VRamFreeBlockAvail(FileAllocateSize);

  {if there was one then...}
  if FB<>VRamNil then
    With VFR do begin

      {Get free block}
      Seek(VRamFreeFile,FB);
      Read(VRamFreeFile,VFR);

      {Return the start of space in VRamHeapFile to the caller}
      VRamAllocateFreeBlock:=StartBlock;

      {-Mark file with block size }
      VBSizeRec.BSize:=FileAllocateSize;
      Seek(VRamHeapFile,StartBlock);
      BlockWrite(VRamHeapFile,VBSizeRec,1);

      {Adjust free block to reflect new size, close block if all used}
      {add to the StartBlock the size of the block allocated, and...}
      Inc(StartBlock,(FileAllocateSize div 16)+1);

      {if its greater then close the free entry (all used)}
      if StartBlock>EndBlock then

        {block all used, so make this free entry available for use in future}
        FillChar(VFR,SizeOf(VFR),0);

      {Write changes of free entry to VRamFreeFile}
      Seek(VRamFreeFile,FB);
      Write(VRamFreeFile,VFR);
    end;
end;

function VRamAllocateBlock(FileAllocateSize : Word) : Word;
 {-Allocate block of VRamHeapFile}
var
  VBSizeRec : VRamBlockSizeRecord;
begin
  {-Mark file with block size (including size block) }
  VBSizeRec.BSize:=FileAllocateSize;
  Seek(VRamHeapFile,VRamHeapPtr);
  BlockWrite(VRamHeapFile,VBSizeRec,1);

  {-Return block number and inc VRamHeapPtr}
  VRamAllocateBlock:=VRamHeapPtr;
  {Plus one for BSize block}
  Inc(VRamHeapPtr,(FileAllocateSize Div 16)+1);
end;

{$F+}
procedure VRamGetMem(var P: Pointer; Size: Word);
 {-Replacement for TP's GetMem.  If UseVRam then allocate a spot in the}
 {-VRamHeapFile either by appending or using a "free spot."}
 {-In the case of UseVRam=False return a normal TP pointer to a spot on}
 {-the real heap.  If UseVRam=True return a special VRam Pointer w/handle.}
var
  Handle : Word;
  HeapSize : Word;
  NewVRamRecP : VRamHeapDescRecPtr;
begin
  if UseVRam then begin

    HeapSize:=((Size div 16)+1) * 16;

    {Try to find a free entry that meets our BSize...}
      {add 16 for the status record}
    Handle:=VRamAllocateFreeBlock(HeapSize);

    {if no space was available then allocate a new block on the VRamHeap}
    if Handle=VRamNil then
      { Try to allocate a new spot}
      Handle:=VRamAllocateBlock(HeapSize);

    {if nothing was found all together then abort}
    if Handle=VRamNil then
      Abort(VRamAllocError);

    NewVRamRecP:=VRamAllocateRealHeap(Handle,HeapSize);
    P:=Ptr(VRamSegSig,Handle);
  end
  else begin
    if (MaxAvail<Size) and (VRamHeapUsed>=Size) then
      VRamPageOutFreeMem(Size);
    OrigGetMem(P, Size);
  end;
end;
{$F-}

function AllocateFreelistEntry(S, E : Word) : boolean;
 {-Insert a new free record or update an existing one to mark avail space}
var
  VFRec : VRamFreeRecord;
  R : Word;
begin
  AllocateFreeListEntry:=False;

  {First see if the list is empty}
  if VRamFreePtr<>VRamNil then begin

    {scan free list for an adjacent entry}
    R:=0;
    Seek(VRamFreeFile,R);
    while R<VRamFreePtr do begin
      Read(VRamFreeFile,VFRec);

      {is this entry 'behind' our free block?}
      if (VFRec.EndBlock+1)=S then begin

        {yes, so extend the existing block forwards}
        VFRec.EndBlock:=E;
        Seek(VRamFreeFile,R);
        Write(VRamFreeFile,VFRec);
        AllocateFreeListEntry:=True;
        Exit;
      end
      else

        {not 'behind', so is it in 'front' of our free block?}
        if E=(VFRec.StartBlock-1) then begin

          {yes, so extend the existing block backwards}
          VFRec.StartBlock:=S;
          Seek(VRamFreeFile,R);
          Write(VRamFreeFile,VFRec);
          AllocateFreeListEntry:=True;
          Exit;
        end;
      Inc(R);
    end;
  end;

  {we haven't exited so we must allocate a new entry}
  with VFRec do begin
    StartBlock:=S;
    EndBlock:=E;
  end;
  Seek(VRamFreeFile,VRamFreePtr);
  Write(VRamFreeFile,VFRec);
  Inc(VRamFreePtr);
  AllocateFreeListEntry:=True;
end;

procedure VRamAdjustHeapPtrFreeList;
 {-Remove free space just below VRamHeapPtr and decrement VRamHeapPtr}
var
  R : Word;
  VFR : VRamFreeRecord;
  FoundOne : Boolean;
begin
  {if there are free entries then...}
  If VRamFreePtr<>VRamNil then
    repeat
      FoundOne:=False;
      R:=0;
      Seek(VRamFreeFile,R);
      while R<VRamFreePtr do begin
        Read(VRamFreeFile,VFR);
        with VFR do

          {if this free entry is in use and the EndBlock+1=VRamHeapPtr then...}
          if (StartBlock<>VRamNil) and (EndBlock+1=VRamHeapPtr) then begin

            {Adjust heap ptr and clear the free record (not in use)}
            VRamHeapPtr:=StartBlock;
            FillChar(VFR,SizeOf(VFR),0);
            Seek(VRamFreeFile,R);
            Write(VRamFreeFile,VFR);

            {yes, we FoundOne, so search from beginning again}
            FoundOne:=True;
          end;
        Inc(R);
      end;
    Until not FoundOne;
end;


{$F+}
procedure VRamFreeMem(var P : Pointer; Size: Word);
 {-Replacement for FreeMem.  Check first to see if P is a special VRam}
 {-Pointer or if it is a normal TP pointer.  If special, then call our}
 {-special routines to deallocate it, otherwise just do a normal FreeMem}
var
  VBSizeRec : VRamBlockSizeRecord;
  Handle,
  EndBlock : Word;
begin
  {Check for VRam signature}
  if Seg(P^)=VRamSegSig then begin

    {get data size record number (handle) from offset}
    Handle:=Ofs(P^);
    VRamDeallocateRealHeap(VRamHandleOnHeap(Handle));


    {Get data size. (the data follows the data size record)}
    Seek(VRamHeapFile,Handle);
    BlockRead(VRamHeapFile,VBSizeRec,1);

    {Compute end block}
    EndBlock:=Handle+(VBSizeRec.BSize Div 16);

    {Compare it against the HeapPtr }
    if EndBlock+1>=VRamHeapPtr then begin

      {This free spot is JUST below the heap so just decrement HeapPtr}
      VRamHeapPtr:=Handle;


  {if FreeBlocks exist below the HeapPtr then adjust accordingly}
      if AdjustHeapPtrAfterFreeMem then
        VRamAdjustHeapPtrFreeList;
    end
    else

      {-The block is in the middle of the Heap so add a free entry}
      if not AllocateFreeListEntry(Handle,EndBlock) then
        Abort(VRamAllocFreeError);

  end
  else
    OrigFreeMem(P, Size);
  P:=nil;
end;
{$F-}

{$F+}
procedure VRamInterruptProc(BP : Word); interrupt;
 {-This routine gets called whenever a pointer is dereferenced (^).}
 {-This feature will only work when the program is compiled with }
 {-a patched TPC.EXE compiler and the $P+ directive is in effect}
 {-For more information download HEAP.ARC from CIS}
var
  IntRegs : IntRegisterRecord absolute BP;
  DeRefPtr : Pointer;
begin
  IntsOn;
  with IntRegs do
    {Is a VRam ptr being dereferenced?}
    if IntRegs.ES=VRamSegSig then begin
      DeRefPtr:=VRamPageIn(DI);
      ES:=Seg(DeRefPtr^);
      DI:=Ofs(DeRefPtr^);
    end;
end;
{$F-}

function VRamLock(P : Pointer) : Boolean;
 {-Lock a VRam pointer from leaving the real heap (if it is currently there)}
var
  VRamDescP : VRamHeapDescRecPtr;
begin
  VRamLock:=False;
  if Seg(P)=VRamSegSig then begin
    VRamDescP:=VRamHandleOnHeap(Ofs(P));
    if VRamDescP<>nil then begin
      VRamDescP^.Locked:=True;
      VRamLock:=True;
    end;
  end;
end;

function VRamUnLock(P : Pointer) : Boolean;
 {-Unlock a previously locked VRam pointer}
var
  VRamDescP : VRamHeapDescRecPtr;
begin
  VRamUnLock:=False;
  if Seg(P)=VRamSegSig then begin
    VRamDescP:=VRamHandleOnHeap(Ofs(P));
    if VRamDescP<>nil then begin
      VRamDescP^.Locked:=False;
      VRamUnLock:=True;
    end;
  end;
end;

procedure InitVRam;
 {-Initialization called before program start}
begin
  {-Allocate VRAM }
  Assign(VRamHeapFile,VRamHeapFilename);

  {$IFDEF HIDDEN}
  Rewrite(VRamHeapFile);
  Close(VRamHeapFile);
  SetFAttr(VRamHeapFile,Hidden);
  Reset(VRamHeapFile,16);
  {$ELSE}
  Rewrite(VRamHeapFile,16);
  {$ENDIF}

  {-Allocate VFREE (freelist) buffer}
  Assign(VRamFreeFile,VRamFreeFilename);

  {$IFDEF HIDDEN}
  Rewrite(VRamFreeFile);
  Close(VRamFreeFile);
  SetFAttr(VRamFreeFile,Hidden);
  Reset(VRamFreeFile);
  {$ELSE}
  Rewrite(VRamFreeFile);
  {$ENDIF}

  {-Setup our custom heap control}
  CustomHeapControl(@VRamGetMem,@VRamFreeMem);

  {-Setup DeRef int vector}
  GetIntVec(DeRefIntVect,SaveDeRefIntVect);
  SetIntVec(DeRefIntVect,@VRamInterruptProc);
  SaveExitProc:=ExitProc;
  ExitProc:=@VRamExitProc;

  VRamDescListHead:= nil;
  VRamDescListTail:= nil;
  VRamFreePtr:=0;
  VRamHeapPtr:=1;
  AdjustHeapPtrAfterFreeMem:=True;
  UseVRam:=False;
  PageVRam:=True;
  VRamMaxHeapToUse:=700000; {all}
  VRamHeapUsed:=0;
end;

begin
  InitVRam;
end.