abvmstrm.pas

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbVMStrm.pas 3.05                           *}
{*********************************************************}
{* ABBREVIA: Virtual Memory Stream                       *}
{*********************************************************}

{$I AbDefine.inc}

unit AbVMStrm;

interface

uses
  typesarchive,
  Classes;

const
  AB_VMSPageSize = 4096; {must be a power of two}
  AB_VMSMaxPages = 256;  {makes 1MB with the above value}

type
  PvmsPage = ^TvmsPage;
  TvmsPage = packed record
    vpStmOfs : Longint;  {value will be multiple of AB_VMSPageSize}
    vpLRU    : integer;  {'time' page was last accessed}
    vpDirty  : integer;  {has the page been changed?}
    vpData   : array [0..pred(AB_VMSPageSize)] of byte; {stream data}
  end;

type
  TAbVirtualMemoryStream = class(TStream)
    protected {private}
      vmsCachePage    : PvmsPage;   {the latest page used}
      vmsLRU          : Longint;    {'tick' value}
      vmsMaxMemToUse  : Longint;    {maximum memory to use for data}
      vmsMaxPages     : integer;    {maximum data pages}
      vmsPageList     : TList;      {page array, sorted by offset}
      vmsPosition     : Longint;    {position of stream}
      vmsSize         : Longint;    {size of stream}
      vmsSwapFileDir  : string;     {swap file directory}
      vmsSwapFileName : string;     {swap file name}
      vmsSwapFileSize : Longint;    {size of swap file}
      vmsSwapHandle   : integer;    {swap file handle}
    protected
      procedure vmsSetMaxMemToUse(aNewMem : Longint);

      function vmsAlterPageList(aNewMem : Longint) : Longint;
      procedure vmsFindOldestPage(var OldestInx : integer;
                                  var OldestPage: PvmsPage);
      function vmsGetNextLRU : Longint;
      function vmsGetPageForOffset(aOffset : Longint) : PvmsPage;

      procedure vmsSwapFileCreate;
      procedure vmsSwapFileDestroy;
      procedure vmsSwapFileRead(aPage : PvmsPage);
      procedure vmsSwapFileWrite(aPage : PvmsPage);
    public
      constructor Create;
        {-create the virtual memory stream}
      destructor Destroy; override;
        {-destroy the virtual memory stream}

      function Read(var Buffer; Count : Longint) : Longint; override;
        {-read from the stream into a buffer}
      function Write(const Buffer; Count : Longint) : Longint; override;
        {-write to the stream from a buffer}
      function Seek(Offset : Longint; Origin : Word) : Longint; override;
        {-seek to a particular point in the stream}

      procedure SetSize(NewSize : Longint); {$IFDEF VERSION3} override; {$ENDIF}  
        {-set the stream size}

      property MaxMemToUse : Longint
         read vmsMaxMemToUse write vmsSetMaxMemToUse;
        {-maximum memory to use for data before swapping to disk}
      property SwapFileDirectory : string
        read vmsSwapFileDir write vmsSwapFileDir;
  end;

implementation

uses
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
  {$IFDEF LINUX}
  Libc,
  {$ENDIF}
  SysUtils,
  AbConst,
  AbExcept,                                                            
  AbUtils,
  AbArcTyp;

const
  LastLRUValue = $7FFFFFFF;

{===TAbVirtualMemoryStream===========================================}
constructor TAbVirtualMemoryStream.Create;
var
  Page : PvmsPage;
begin
  inherited Create;
  {create the page array}
  vmsPageList := TList.Create;
  {create the first page}
  New(Page);
  with Page^ do begin
    vpStmOfs := 0;
    vpLRU := vmsGetNextLRU;
    vpDirty := 0;
    FillChar(vpData, AB_VMSPageSize, 0);
  end;
  vmsPageList.Insert(0, pointer(Page));
  {prime the cache, from now on the cache will never be nil}
  vmsCachePage := Page;
  {assume we shall use at least 100K for data, we're already using 4K}
  MaxMemToUse := 100 * 1024;
end;
{--------}
destructor TAbVirtualMemoryStream.Destroy;
var
  Inx : integer;
  P : PvmsPage;
  
begin
  {destroy the swap file}
  vmsSwapFileDestroy;
  {throw away all pages in the list}
  if (vmsPageList <> nil) then begin
    for Inx := 0 to pred(vmsPageList.Count) do
      begin
      P:=PvmsPage(vmsPageList[Inx]);
      Dispose(P);
      end;
    vmsPageList.Destroy;
  end;
  {let our ancestor clean up}
  inherited Destroy;
end;
{--------}
function TAbVirtualMemoryStream.Read(var Buffer; Count : Longint) : Longint;
var
  BufAsBytes  : TByteArray absolute Buffer;
  BufInx      : Longint;
  Page        : PvmsPage;
  PageDataInx : integer;
  Posn        : Longint;
  BytesToGo   : Longint;
  BytesToRead : integer;
  StartOfs    : Longint;
begin
  {reading is complicated by the fact we can only read in chunks of
   AB_VMSPageSize: we need to partition out the overall read into a read
   from a partial page, zero or more reads from complete pages and
   then a possible read from 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)));
  BytesToRead := AB_VMSPageSize - PageDataInx;
  {calculate the actual number of bytes to read - this depends on the
   current position and size of the stream}
  BytesToGo := Count;
  if (vmsSize < (vmsPosition + Count)) then
    BytesToGo := vmsSize - vmsPosition;
  if (BytesToGo < 0) then
    BytesToGo := 0;
  Result := BytesToGo;

  {while we have bytes to read, read them}
  while (BytesToGo <> 0) do begin
    if (BytesToRead > BytesToGo) then
      BytesToRead := BytesToGo;
    StartOfs := Posn and (not pred(AB_VMSPageSize));
    if (vmsCachePage^.vpStmOfs = StartOfs) then
      Page := vmsCachePage
    else
      Page := vmsGetPageForOffset(StartOfs);
    Move(Page^.vpData[PageDataInx], BufAsBytes[BufInx], BytesToRead);
    dec(BytesToGo, BytesToRead);
    inc(Posn, BytesToRead);
    inc(BufInx, BytesToRead);
    PageDataInx := 0;
    BytesToRead := AB_VMSPageSize;
  end;
  {remember our new position}
  vmsPosition := Posn;
end;
{--------}
function TAbVirtualMemoryStream.Seek( Offset : Longint;
                                      Origin : Word) : Longint;
begin
  case Origin of
    soFromBeginning : vmsPosition := Offset;
    soFromCurrent   : inc(vmsPosition, Offset);
    soFromEnd       : vmsPosition := vmsSize + Offset;
  else
    raise EAbVMSInvalidOrigin.Create( Origin, 0 );              
  end;
  Result := vmsPosition;
end;
{--------}
procedure TAbVirtualMemoryStream.SetSize(NewSize : Longint);
var
  Page : PvmsPage;
  Inx  : integer;
  NewFileSize : Longint;
begin
  if (NewSize < vmsSize) then begin
    {go through the page list discarding pages whose offset is greater
     than our new size; don't bother saving any data from them since
     it be beyond the end of the stream anyway}
    for Inx := pred(vmsPageList.Count) downto 0 do begin
      Page := PvmsPage(vmsPageList[Inx]);
      if (Page^.vpStmOfs >= NewSize) then
        Dispose(Page)
      else if (Page^.vpStmOfs < NewSize) then begin
        if (succ(Inx) < vmsPageList.Count) then
          vmsPageList.Count := succ(Inx);
        Break;
      end;
    end;
    {force the swap file file size in range, it'll be a multiple of
     AB_VMSPageSize}
    NewFileSize := pred(NewSize + AB_VMSPageSize) and
                   (not pred(AB_VMSPageSize));
    if (NewFileSize < vmsSwapFileSize) then
      vmsSwapFileSize := NewFileSize;
    {ignore the swap file itself}
  end;
  vmsSize := NewSize;
  if (vmsPosition > NewSize) then
    vmsPosition := NewSize;
end;
{--------}
function TAbVirtualMemoryStream.vmsAlterPageList(aNewMem : Longint) : Longint;
var
  NumPages : Longint;
  Page     : PvmsPage;
  i        : integer;
  OldestPageNum : integer;
begin
  {calculate the max number of pages required}