{*********************************************************}
{*                   VMM.IN3 1.00                        *}
{*********************************************************}

  procedure ErrorExit(Code : Word);
    {-Make some housekeeping before halting program}
  var
    i : Byte;
    P : VMMPtr;
  begin
    {if critical error, program will free all allocated Ems handles before exit}
    for i := 0 to Pred(VmmInstances.GetValidElems) do begin
      VmmInstances.GetElem(i, P);
      P^.Done;
    end;
    RunError(Code);
  end;

  {---------------------------------------------------------------------}

  {+++ VMM public methods +++}

  constructor VMM.Init(SwapFName : PathStr);
    {-Create a new virtual memory manager with default options}
  var
    DefEmsToKeep : Word;
    PagesAVail   : Word;
  begin
    {Evaluate how much EMS memory is available - Keep 10% free}
    if VmmEmsInstalled then begin
      PagesAvail := EmsPagesAvail;
      if PagesAvail <> EmsErrorCode then
        DefEmsToKeep := PagesAvail div 10;     {10% not used by VMM}
    end
    else
      DefEmsToKeep := NoEms; {Prevent VMM from using Ems}

    if not VMM.InitCustom(MaxHeapAlloc,          {65521 bytes}
                          DefIncr,               {128 bytes}
                          DefFreeEntries div 2,  {1024 entries = 4096 bytes}
                          DefFreeEntries,        {2048 entries = 8192 bytes}
                          DefQueueEntries,       {512-1 entries}
                          DefEmsToKeep,          {10% of Ems pages avail.}
                          DefDskToKeep,          {1meg}
                          SwapFName) then
      Fail;
  end;

  constructor VMM.InitCustom(RamSize : LongInt;
                             Incr, MaxVmmEntries,
                             MaxFreeEntries, VmmQueueEntries,
                             EmsPagesToKeep : Word;
                             DskToKeep : LongInt;
                             SwapFName : PathStr);
    {-Create a new virtual memory manager with custom options}
  var
    Err : Word;
    P   : Pointer;
  begin
    if (not Root.init) then
      Fail;

    {Initialize VMM data objects}
    if   (not vmRamFreeList.Init(MaxFreeEntries, Incr))
      or (VmmEmsInstalled
          and (not vmEmsFreeList.Init(MaxFreeEntries, Incr)))
          {if Ems not present doesn't initialize EmsFreeList}
      or (not vmDskFreeList.Init(MaxFreeEntries, Incr))
      or (not vmDescTable.Init(MaxVmmEntries, SizeOf(VmmDescriptor), Incr)
      or (not vmLruQueue.Init(VmmQueueEntries*SizeOf(VmmHandle),
                              SizeOf(VmmHandle), true)))
      then begin
        Done;
        Fail;
        {InitStatus has been loaded by FreeList or Queue constructor}
      end;

    {Initialize Ram area - may be greater than 64k if the user-defined}
    { UserGetMem function provides this capability}
    if not UserGetMem(vmRamArea, RamSize) then begin
      Done;
      InitStatus := epFatal+ecOutOfMemory;
      Fail;
    end
    else begin
      vmRamAreaSize := RamSize;
      {Create a free entry for the whole Ram area}
      { so there is no need for a heap pointer}
      with vmRamFreeList do
        if AddFreeEntry(vmRamArea, vmRamAreaSize) <> vmRamAreaSize then begin
          Done;
          InitStatus := epFatal+ecOutOfRamEntries;
          Fail;
        end;
    end;

    {Initialize options}
    vmOptions := DefVmmOptions;
    vmStatus := 0;

    {Process disk related information}
    vmSwapFName := SwapFname;
    if vmSwapFName = '' then
      vmOptionsOff(vmUseDsk)
    else begin
      vmDskToKeep := DskToKeep;
      vmEofPtr := 0;
      {Open swap file}
      vmSwapFName := FExpand(vmSwapFName);
      Assign(vmF, vmSwapFName);
      Rewrite(vmF, 1);          {This way we can write blocks of any size}
      Err := IoResult;
      if Err <> 0 then begin
        Done;
        InitStatus := epFatal+Err;
        Fail;
      end;
    end;

    {Process Ems related information}
    vmEmsToKeep := EmsPagesToKeep;
    if (not VmmEmsInstalled)
    or (vmEmsToKeep = NoEms) then
      if vmOptionsAreOn(vmUseDsk) then
        vmOptionsOff(vmUseEms)
      else begin
        {No resources for virtual memory}
        Done;
        InitStatus := epFatal+ecNoResources;
        Fail;
      end
    else begin
      P := EmsPageFramePtr;
      vmEmsBaseSeg := VmmPtrRec(P).Seg;
      {Offset part of returned pointer is always 0}
    end;

    {Increment VmmInstances number of elements by one and store pointer}
    P := @Self;
    with VmmInstances do
      SetElem(GetValidElems, P);
    {Prevent deadlocks by keeping at least 3*vmRamAreaSize bytes}
    { free on both virtual media}
    Inc(VmmRamAreaSizeGlb, vmRamAreaSize*3);
  end;

  destructor VMM.Done;
    {-Destroy a virtual memory manager}
  var
    Err : Word;
  begin
    vmRamFreeList.Done;
    if VmmEmsInstalled then
      vmEmsFreeList.Done;
    vmDskFreeList.Done;
    vmDescTable.Done;
    UserFreeMem(vmRamArea, vmRamAreaSize);
    if vmOptionsAreOn(vmUseDsk) then
      Close(vmF);
    if vmOptionsAreOn(vmDeleteSwap) then
      Erase(vmF);
    Err := IoResult;
    Dec(VmmRamAreaSizeGlb, vmRamAreaSize*3);
    Root.Done;
  end;

  function VMM.PeekStatus : Word;
    {-Return VMM status}
  begin
    PeekStatus := vmStatus;
  end;

  function VMM.GetStatus : Word;
    {-Return and reset VMM status}
  begin
    GetStatus := vmStatus;
    vmStatus := 0;
  end;

  procedure VMM.Error(Code : Word);
    {-Assign error code}
  begin
    vmStatus := Code;
  end;

  procedure VMM.LinkToDerefHandler;
    {-Instruct the dereference interrupt handler to refer to THIS manager}
  begin
    VmmActiveMgr := @Self;
  end;

  function VMM.Lock(var Pt; Lockit : Boolean) : Boolean;
    {-Lock or Unlock a VMM block in Ram}
  var
    H : Word;
    P : Pointer absolute Pt;
    D : VmmDescriptor;
  begin
    Lock := false;
    if P = nil then
      Exit;
    H := VmmPtrRec(P).Seg;
    {Get descriptor in descriptor table}
    vmDescTable.GetElem(H, D);
    if vmDescTable.GetStatus <> 0 then
      exit;

    if Lockit then begin
      SetByteFlag(D.Location, vmLocked);       {lock it}
      vmLruQueue.Remove(H); {Cannot be paged out any more}
    end
    else begin
      ClearByteFlag(D.Location, vmLocked);     {unlock it}
      vmLruQueue.Remove(H);
      vmLruQueue.PushTail(H); {Now can be paged out again}
    end;
    {Update descriptor table entry}
    vmDescTable.SetElem(H, D);
    Lock := vmDescTable.GetStatus = 0;
  end;

  procedure VMM.GetMemV(var Pt; BlkSize : Word);
    {-Allocate a memory block and return a Vmm "pointer" in P}
  var
    H : Word;
    D : VmmDescriptor;
    P : Pointer absolute Pt;
  begin
   if  (BlkSize <= MaxHeapAlloc)
   and (BlkSize > 0)
   and ((RamMaxAvail >= BlkSize)
         or
         (((EmsPagesAvail*EmsPage-VmmRamAreaSizeGlb >= BlkSize)
            or
           (DskMaxAvail-VmmRamAreaSizeGlb >= BlkSize))
          and
          (PageOut(BlkSize)))) then begin
   {Scan RamFreeList for a free block or allocate a new one...}
   { or page out until enough room is available}
   { Don't allocate if there isn't enough room in Ems or on disk}
   { to securely page out entire RamArea of all VMMs - prevent dead lock}
     P := vmRamFreeList.GetFreeEntry(BlkSize); {Result cannot be nil}
     {Convert to a VMM pointer and create new entry in descriptor table}
     H := GetHandle;
     if H = OutOfHandles then begin         {Descriptor table out of entries}
       P := nil;
       Exit;
     end;
     D.Location := vmInRam;                 {All other values are null}
     D.RamPtr := P;                         {Point to block in Ram area}
     D.Size := BlkSize;
     vmDescTable.SetElem(H, D);             {Update descriptor table}
     VmmPtrRec(P).Seg := H;                 {Handle goes in segment part of P}
     VmmPtrRec(P).Ofs := VmmMark;           {Offset of VMMptr is always $FFFF}
     vmLruQueue.Remove(H);
     vmLruQueue.PushTail(H);                {Add the handle to the LRU queue}
   end
   else begin
   {No space to allocate in Ram and PageOut failed}
   { not enough memory or too many locked blocks}
       P := nil;
       Exit;
   end;
  end;

  procedure VMM.FreeMemV(var Pt);
    {-Free a block and set P to nil}
  var
    H : Word;
    P : Pointer absolute Pt;
    D : VmmDescriptor;
  begin
    if VmmPtrRec(P).Ofs = VmmMark then begin
      vmDescTable.GetElem(VmmPtrRec(P).Seg, D);
      H := VmmPtrRec(P).Seg;
      if vmDescTable.GetStatus = 0 then begin
        case D.Location and vmLocation of
          vmInRam : if vmRamFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
                      Error(epNonFatal+ecOutOfRamEntries);
          vmInEms : if vmEmsFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
                      Error(epNonFatal+ecOutOfEmsEntries);
          vmOnDsk : if vmDskFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
                      Error(epNonFatal+ecOutOfDskEntries);
          else ErrorExit(204); {Invalid pointer operation}
        end;
        P := nil;
        {Indicate that this handle is free}
        FillChar(D, SizeOf(D), 0);
        vmDescTable.SetElem(H, D);
        {Remove it from the LRU queue}
        vmLruQueue.Remove(H);
      end
      else
        ErrorExit(213);
    end
    else
      ErrorExit(204); {Invalid pointer operation}
  end;

  function VMM.GetSize(var Pt) : Word;
    {-Return size of block pointed to by Pt}
  var
    P : Pointer absolute Pt;
    D : VmmDescriptor;
  begin
    vmDescTable.GetElem(VmmPtrRec(P).Seg, D);
    if vmDescTable.GetStatus = 0 then
      GetSize := D.Size
    else
      GetSize := 0;
  end;

  function VMM.ClearRamArea : Boolean;
    {-Page out all blocks unless they are locked}
  begin
    if RamMaxAvail < vmRamAreaSize then
      ClearRamArea := PageOut(vmRamAreaSize)
      {May fail if blocks are locked}
    else
      ClearRamArea := true;
  end;

  function VMM.RamMaxAvail : LongInt;
    {-Return size of the largest block available in RAM area}
  begin
    RamMaxAvail := vmRamFreeList.MaxFree;
  end;

  function VMM.EmsMaxAvail : LongInt;
    {-Return amount of memory available in Ems}
  var
    PagesFree   : LongInt;
  begin
    if not vmOptionsAreOn(vmUseEms) or (vmEmsToKeep = NoEms) then begin
      EmsMaxAvail := 0;
      Exit;
    end;
    PagesFree := EmsPagesAvail;
    if (PagesFree <> EmsErrorCode) and (PagesFree >= vmEmsToKeep+4) then
      EmsMaxAvail := MaxEmsBlock
    else
      EmsMaxAvail := vmEmsFreeList.MaxFree;
  end;

  function VMM.DskMaxAvail : LongInt;
    {-Return amount of space available on disk for VMM}
  var
    S : LongInt;
    R : Registers;
  begin
    if not vmOptionsAreOn(vmUseDsk) or (vmSwapFName = '') then begin
      DskMaxAvail := 0;
      Exit;
    end;
    with R do begin
      AX := $3600;
      DX := Ord(Upcase(vmSwapFName[1]))-64;
      MsDos(R);
      if (BX = 0) or (AX = $FFFF) then
        DskMaxAvail := 0
      else begin
        S := LongInt(AX)*LongInt(BX)*LongInt(CX)-vmDskToKeep;
        DskMaxAvail := MaxLong(S, vmDskFreeList.MaxFree);
      end;
    end;
  end;

  procedure VMM.vmOptionsOn(OptionFlags : Word);
    {-Activate multiple options}
  begin
    SetFlag(vmOptions, OptionFlags and not BadVmmOptions);
  end;

  procedure VMM.vmOptionsOff(OptionFlags : Word);
    {-Deactivate multiple options}
  var
    SaveOptions : Word;
  begin
    SaveOptions := vmOptions and (vmUseDsk+vmUseEms);
    ClearFlag(vmOptions, OptionFlags and not BadVmmOptions);
    {Cannot clear both vmUseEms and vmUseDsk flags}
    if vmOptions and (vmUseDsk+vmUseEms) = 0 then
      vmOptions := vmOptions or SaveOptions;
  end;

  function VMM.vmOptionsAreOn(OptionFlags : Word) : Boolean;
    {-Return true if all specified options are on}
  begin
    vmOptionsAreOn := (vmOptions and OptionFlags = OptionFlags);
  end;