abvmstrm.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

  NumPages := pred(aNewMem + AB_VMSPageSize) div AB_VMSPageSize;
  if (NumPages > AB_VMSMaxPages) then
    NumPages := AB_VMSMaxPages;
  {if the maximum number of pages means we have to shrink the current
   list, do so, tossing out the oldest pages first}
  if (NumPages < vmsPageList.Count) then
    for i := 1 to (vmsPageList.Count - NumPages) do begin
      {find the oldest page}
      vmsFindOldestPage(OldestPageNum, Page);
      {if it is dirty, write it out to the swap file}
      if (Page^.vpDirty <> 0) then begin
        vmsSwapFileWrite(Page);
      end;
      {remove it from the page list}
      vmsPageList.Delete(OldestPageNum);
      {free the page memory}
      Dispose(Page);
    end;
  {remember our new max number of pages}
  vmsMaxPages := NumPages;
  Result := NumPages * AB_VMSPageSize;
end;
{--------}
procedure TAbVirtualMemoryStream.vmsFindOldestPage(var OldestInx : integer;
                                                   var OldestPage: PvmsPage);
var
  OldestLRU : Longint;
  Inx       : integer;
  Page      : PvmsPage;
begin
  OldestInx := -1;
  OldestLRU := LastLRUValue;
  for Inx := 0 to pred(vmsMaxPages) do begin
    Page := PvmsPage(vmsPageList[Inx]);
    if (Page^.vpLRU < OldestLRU) then begin
      OldestInx := Inx;
      OldestLRU := Page^.vpLRU;
      OldestPage := Page;
    end;
  end;
end;
{--------}
function TAbVirtualMemoryStream.vmsGetNextLRU : Longint;
var
  Inx : integer;
begin
  if (vmsLRU = LastLRUValue) then begin
    {reset all LRUs in list}
    for Inx := 0 to pred(vmsPageList.Count) do
      PvmsPage(vmsPageList[Inx])^.vpLRU := 0;
    vmsLRU := 0;
  end;
  inc(vmsLRU);
  Result := vmsLRU;
end;
{--------}
function TAbVirtualMemoryStream.vmsGetPageForOffset(aOffset : Longint) : PvmsPage;
var
  Page     : PvmsPage;
  PageOfs  : Longint;
  L, M, R  : integer;
  OldestPageNum : integer;
  CreatedNewPage: boolean;
begin
  {using a sequential or a binary search (depending on the number of
   pages), try to find the page in the cache; we'll do a sequential
   search if the number of pages is very small, eg less than 4}
  if (vmsPageList.Count < 4) then begin
    L := vmsPageList.Count;
    for M := 0 to pred(vmsPageList.Count) do begin
      Page := PvmsPage(vmsPageList[M]);
      PageOfs := Page^.vpStmOfs;
      if (aOffset < PageOfs) then begin
        L := M;
        Break;
      end;
      if (aOffset = PageOfs) then begin
        Page^.vpLRU := vmsGetNextLRU;
        vmsCachePage := Page;
        Result := Page;
        Exit;
      end;
    end;
  end
  else {we need to do a binary search} begin
    L := 0;
    R := pred(vmsPageList.Count);
    repeat
      M := (L + R) div 2;
      Page := PvmsPage(vmsPageList[M]);
      PageOfs := Page^.vpStmOfs;
      if (aOffset < PageOfs) then
        R := pred(M)
      else if (aOffset > PageOfs) then
        L := succ(M)
      else {aOffset = PageOfs} begin
        Page^.vpLRU := vmsGetNextLRU;
        vmsCachePage := Page;
        Result := Page;
        Exit;
      end;
    until (L > R);
  end;
  {if we get here the page for the offset is not present in the page
   list, and once created/loaded, the page should be inserted at L}

  {enter a try..except block so that if a new page is created and an
   exception occurs, the page is freed}
  CreatedNewPage := false;
  Result := nil;
  try
    {if there is room to insert a new page, create one ready}
    if (vmsPageList.Count < vmsMaxPages) then begin
      New(Page);
      CreatedNewPage := true;
    end
    {otherwise there is no room for the insertion, so find the oldest
     page in the list and discard it}
    else {vmsMaxPages <= vmsPageList.Count} begin
      {find the oldest page}
      vmsFindOldestPage(OldestPageNum, Page);
      {if it is dirty, write it out to the swap file}
      if (Page^.vpDirty <> 0) then begin
        vmsSwapFileWrite(Page);
      end;
      {remove it from the page list}
      vmsPageList.Delete(OldestPageNum);
      {patch up the insertion point, in case the page just deleted was
       before it}
      if (OldestPageNum < L) then
        dec(L);
    end;
    {set all the page fields}
    with Page^ do begin
      vpStmOfs := aOffset;
      vpLRU := vmsGetNextLRU;
      vpDirty := 0;
      vmsSwapFileRead(Page);
    end;
    {insert the page into the correct spot}
    vmsPageList.Insert(L, pointer(Page));
    {return the page, remembering to save it in the cache}
    vmsCachePage := Page;
    Result := Page;
  except
    if CreatedNewPage then
      Dispose(Page);
  end;{try..except}
end;
{--------}
procedure TAbVirtualMemoryStream.vmsSetMaxMemToUse(aNewMem : Longint);
begin
  vmsMaxMemToUse := vmsAlterPageList(aNewMem);
end;
{--------}
procedure TAbVirtualMemoryStream.vmsSwapFileCreate;
begin
  if (vmsSwapHandle = 0) then begin
    vmsSwapFileName := AbCreateTempFile(vmsSwapFileDir);
    vmsSwapHandle := FileOpen(vmsSwapFileName, fmOpenReadWrite);
    if (vmsSwapHandle <= 0) then begin
      vmsSwapHandle := 0;
      DeleteFile(vmsSwapFileName);
      raise EAbVMSErrorOpenSwap.Create( vmsSwapFileName );             
    end;
    vmsSwapFileSize := 0;
  end;
end;
{--------}
procedure TAbVirtualMemoryStream.vmsSwapFileDestroy;
begin
  if (vmsSwapHandle <> 0) then begin
    FileClose(vmsSwapHandle);
    DeleteFile(vmsSwapFileName);
    vmsSwapHandle := 0;
  end;
end;
{--------}
procedure TAbVirtualMemoryStream.vmsSwapFileRead(aPage : PvmsPage);
var
  BytesRead : Longint;
  SeekResult: Longint;
begin
  if (vmsSwapHandle = 0) or (aPage^.vpStmOfs >= vmsSwapFileSize) then begin
    {there is nothing to be read from the disk (either the swap file
     doesn't exist or it's too small) so zero out the page data}
    FillChar(aPage^.vpData, AB_VMSPageSize, 0)
  end
  else {there is something to be read from the swap file} begin
    SeekResult := FileSeek(vmsSwapHandle, aPage^.vpStmOfs, 0);
    if (SeekResult = -1) then
      raise EAbVMSSeekFail.Create( vmsSwapFileName );                  
    BytesRead := FileRead(vmsSwapHandle, aPage^.vpData, AB_VMSPageSize);
    if (BytesRead <> AB_VMSPageSize) then
      raise EAbVMSReadFail.Create( AB_VMSPageSize, vmsSwapFileName );  
  end;
end;
{--------}
procedure TAbVirtualMemoryStream.vmsSwapFileWrite(aPage : PvmsPage);
var
  NewPos : Longint;
  BytesWrit : Longint;
  SeekResult: Longint;
begin
  if (vmsSwapHandle = 0) then
    vmsSwapFileCreate;
  SeekResult := FileSeek(vmsSwapHandle, aPage^.vpStmOfs, 0);
  if (SeekResult = -1) then
    raise EAbVMSSeekFail.Create( vmsSwapFileName );                    
  BytesWrit := FileWrite(vmsSwapHandle, aPage^.vpData, AB_VMSPageSize);
  if BytesWrit <> AB_VMSPageSize then
    raise EAbVMSWriteFail.Create( AB_VMSPageSize, vmsSwapFileName );   
  NewPos := aPage^.vpStmOfs + AB_VMSPageSize;
  if (NewPos > vmsSwapFileSize) then
    vmsSwapFileSize := NewPos;
end;
{--------}
function TAbVirtualMemoryStream.Write(const Buffer; Count : Longint) : Longint;
var
  BufAsBytes  : TByteArray absolute Buffer;
  BufInx      : Longint;
  Page        : PvmsPage;
  PageDataInx : integer;
  Posn        : Longint;
  BytesToGo   : Longint;
  BytesToWrite: integer;
  StartOfs    : Longint;
begin
  {writing is complicated by the fact we can only write in chunks of
   AB_VMSPageSize: we need to partition out the overall write into a
   write to a partial page, zero or more writes to complete pages and
   then a possible write to a partial page}

  {initialise some variables, note that the complex calc in the
   expression for PageDataInx is the offset of the start of the page
   where Posn is found.}
  BufInx := 0;
  Posn := vmsPosition;
  PageDataInx := Posn - (Posn and (not pred(AB_VMSPageSize)));
  BytesToWrite := AB_VMSPageSize - PageDataInx;
  {calculate the actual number of bytes to write}
  BytesToGo := Count;
  Result := BytesToGo;

  {while we have bytes to write, write them}
  while (BytesToGo <> 0) do begin
    if (BytesToWrite > BytesToGo) then
      BytesToWrite := BytesToGo;
    StartOfs := Posn and (not pred(AB_VMSPageSize));
    if (vmsCachePage^.vpStmOfs = StartOfs) then
      Page := vmsCachePage
    else
      Page := vmsGetPageForOffset(StartOfs);
    Move(BufAsBytes[BufInx], Page^.vpData[PageDataInx], BytesToWrite);
    Page^.vpDirty := 1;
    dec(BytesToGo, BytesToWrite);
    inc(Posn, BytesToWrite);
    inc(BufInx, BytesToWrite);
    PageDataInx := 0;
    BytesToWrite := AB_VMSPageSize;
  end;
  {remember our new position}
  vmsPosition := Posn;
  {if we've grown the stream, make a note of it}
  if (vmsPosition > vmsSize) then
    vmsSize := vmsPosition;
end;
{====================================================================}

end.