 {
 ****************************************************************************
 CRW32 project
 Copyright (C) by Kuryakin Alexey, Sarov, Russia, 2001, <kouriakine@mail.ru>
 Dynamic arrays and storages with protection.
 Modifications:
 20011222 - Creation
 20020124 - TxxVector, TxxMatrix
 20030216 - Exceptions property is now derived from TMasterObject
 20030328 - Struggle for safety (add some try/except checks)...
 ****************************************************************************
 }

unit _dynar;

{$I _sysdef}

interface

uses
 sysutils, windows, math, _alloc, _fpu, _fifo, _str;

 {
 ****************************************************************
 TObjectStorage, collection of objects. Thread safety and simple.
 ****************************************************************
 }
const
 DefaultTObjectStorageCapacity = 0;
 DefaultTObjectStorageStep     = 1024;

type
 TObjectStorageForEachAction = procedure(Index      : LongInt;
                                   const aObject    : TObject;
                                     var Terminate  : Boolean;
                                         CustomData : Pointer );

type
 EObjectStorage = class(ESoftException);
 TObjectStorage = class(TLatch)
 private
  myItems   : PPointerArray;
  myCount   : LongInt;
  myStep    : LongInt;
  myOwns    : Boolean;
  function    GetStep:LongInt;
  procedure   SetStep(NewStep:LongInt);
  function    GetCount:LongInt;
  procedure   SetCount(NewCount:LongInt);
  function    GetCapacity:LongInt;
  procedure   SetCapacity(NewCapacity:LongInt);
  function    GetOwns:Boolean;
  procedure   SetOwns(aOwns:Boolean);
  function    GetItem(Num:LongInt):TObject;
  procedure   PutItem(Num:LongInt; aItem:TObject);
  procedure   KillItem(Num:LongInt);
 protected
  function    CheckOk:Boolean; override;
  procedure   ErrorFound(E:Exception; const Note:LongString=''); override;
 public
  constructor Create(aOwnsObjects : Boolean = true;
                     aCapacity    : LongInt = DefaultTObjectStorageCapacity;
                     aStep        : LongInt = DefaultTObjectStorageStep);
  destructor  Destroy; override;
  procedure   Delete(Num:LongInt);
  procedure   Insert(Num:LongInt; aItem:TObject);
  function    Remove(aItem:TObject):LongInt;
  procedure   Add(aItem:TObject);
  procedure   ForEach(Action:TObjectStorageForEachAction; CustomData:Pointer; Backward:Boolean=false);
  function    IndexOf(aItem:TObject):LongInt;
  procedure   Clear;
  procedure   Pack;
 public
  property    OwnsObjects      : Boolean     read GetOwns     write SetOwns;
  property    Step             : LongInt     read GetStep     write SetStep;
  property    Count            : LongInt     read GetCount    write SetCount;
  property    Capacity         : LongInt     read GetCapacity write SetCapacity;
  property    Items[i:LongInt] : TObject     read GetItem     write PutItem; default;
 end;

function  NewObjectStorage(aOwnsObjects : Boolean = true;
                           aCapacity    : LongInt = DefaultTObjectStorageCapacity;
                           aStep        : LongInt = DefaultTObjectStorageStep
                                      ) : TObjectStorage;
procedure Kill(var TheObject:TObjectStorage); overload;

 {
 *******************************************************************************
 Vector & matrix classes, dynamic one-dimension & two-dimension arrays.
 Thread safety and out of index range protection.
 *******************************************************************************
 }
type
 EMatrixFailure = class(ESoftException);
 TAbstractArray = class(TLatch)
 private
  myData       : Pointer;
  myRows       : LongInt;
  myColumns    : LongInt;
  myItemSize   : LongInt;
  myOrigin     : LongInt;
  function    SetDimension(aRows,aColumns:LongInt):Boolean;
  function    GetRows:LongInt;
  procedure   SetRows(aRows:LongInt);
  function    GetColumns:LongInt;
  procedure   SetColumns(aColumns:LongInt);
  function    GetItemSize:LongInt;
  function    GetOrigin:LongInt;
  procedure   SetOrigin(aOrigin:LongInt);
  function    Get1DItemPtr(aIndex:LongInt):Pointer;
  function    Get2DItemPtr(aRow,aColumn:LongInt):Pointer;
 protected
  function    CheckOk:Boolean; override;
  procedure   ErrorFound(E:Exception; const Note:LongString=''); override;
 public
  constructor Create(aRows,aColumns,aItemSize,aOrigin:LongInt);
  destructor  Destroy; override;
 public
  property    ItemSize:LongInt             read GetItemSize;
  property    Origin:LongInt               read GetOrigin     write SetOrigin;
 end;

type
 TAbstractVector = class(TAbstractArray)
 public
  constructor Create(aLength,aItemSize,aOrigin:LongInt);
 public
  property    Length:LongInt               read GetColumns    write SetColumns;
  property    ItemPtr[i:LongInt]:Pointer   read Get1DItemPtr;
 end;

type
 TAbstractMatrix = class(TAbstractArray)
 public
  constructor Create(aRows,aColumns,aItemSize,aOrigin:LongInt);
 public
  property    Rows:LongInt                 read GetRows       write SetRows;
  property    Columns:LongInt              read GetColumns    write SetColumns;
  property    ItemPtr[i,j:LongInt]:Pointer read Get2DItemPtr;
 end;

 {
 *******************************************************************************
 LongInt vector and matrix
 *******************************************************************************
 }
type
 TLongIntVector = class(TAbstractVector)
 private
  function  GetItem(aIndex:LongInt):LongInt;
  procedure SetItem(aIndex:LongInt; const aValue:LongInt);
 public
  constructor Create(aLength:LongInt; aOrigin:LongInt=0);
  property    Item[i:LongInt]:LongInt read GetItem write SetItem; default;
 end;

function  NewLongIntVector(aLength:LongInt; aOrigin:LongInt=0):TLongIntVector;
procedure Kill(var TheObject:TLongIntVector); overload;

type
 TLongIntMatrix = class(TAbstractMatrix)
 private
  function  GetItem(aRow,aColumn:LongInt):LongInt;
  procedure SetItem(aRow,aColumn:LongInt; const aValue:LongInt);
 public
  constructor Create(aRows,aColumns:LongInt; aOrigin:LongInt=0);
  property    Item[i,j:LongInt]:LongInt read GetItem write SetItem; default;
 end;

function  NewLongIntMatrix(aRows,aColumns:LongInt; aOrigin:LongInt=0):TLongIntMatrix;
procedure Kill(var TheObject:TLongIntMatrix); overload;

 {
 *******************************************************************************
 Double vector and matrix
 *******************************************************************************
 }
type
 TDoubleVector = class(TAbstractVector)
 private
  function  GetItem(aIndex:LongInt):Double;
  procedure SetItem(aIndex:LongInt; const aValue:Double);
 public
  constructor Create(aLength:LongInt; aOrigin:LongInt=0);
  property    Item[i:LongInt]:Double read GetItem write SetItem; default;
 end;

function  NewDoubleVector(aLength:LongInt; aOrigin:LongInt=0):TDoubleVector;
procedure Kill(var TheObject:TDoubleVector); overload;

type
 TDoubleMatrix = class(TAbstractMatrix)
 private
  function  GetItem(aRow,aColumn:LongInt):Double;
  procedure SetItem(aRow,aColumn:LongInt; const aValue:Double);
 public
  constructor Create(aRows,aColumns:LongInt; aOrigin:LongInt=0);
  property    Item[i,j:LongInt]:Double read GetItem write SetItem; default;
 end;

function  NewDoubleMatrix(aRows,aColumns:LongInt; aOrigin:LongInt=0):TDoubleMatrix;
procedure Kill(var TheObject:TDoubleMatrix); overload;

implementation

 {
 ****************************************************************
 TObjectStorage, collection of objects. Thread safety and simple.
 ****************************************************************
 }
constructor TObjectStorage.Create(aOwnsObjects : Boolean = true;
                                  aCapacity    : LongInt = DefaultTObjectStorageCapacity;
                                  aStep        : LongInt = DefaultTObjectStorageStep);
begin
 inherited Create;
 myItems:=nil;
 myCount:=0;
 myStep:=max(1,aStep);
 myOwns:=aOwnsObjects;
 Capacity:=aCapacity;
 Exceptions:=false;
end;

destructor TObjectStorage.Destroy;
begin
 Capacity:=0;
 inherited Destroy;
end;

function TObjectStorage.CheckOk:Boolean;
begin
 Lock;
 Result:=LongWord(myCount)<=LongWord(AllocSize(myItems) div sizeof(myItems[0]));
 Unlock;
end;

procedure TObjectStorage.ErrorFound(E:Exception; const Note:LongString);
begin
 if Exceptions then begin
  if E is Exception
  then RAISE EObjectStorage.Create(E.Message)
  else RAISE EObjectStorage.Create(Note);
 end else ErrorReport(E,Note);
end;

function TObjectStorage.GetStep:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myStep;
  Unlock;
 end;
end;

procedure TObjectStorage.SetStep(NewStep:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myStep:=max(1,NewStep);
  Unlock;
 end;
end;

function TObjectStorage.GetCount:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=myCount;
  Unlock;
 end;
end;

procedure TObjectStorage.SetCount(NewCount:LongInt);
var i:LongInt;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   NewCount:=max(0,NewCount);
   for i:=NewCount to myCount-1 do KillItem(i);
   for i:=myCount to Capacity-1 do myItems[i]:=nil;
   if NewCount>Capacity then Capacity:=AdjustBufferSize(NewCount,myStep);
   myCount:=min(NewCount,Capacity);
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TObjectStorage.GetCapacity:LongInt;
begin
 Result:=0;
 if Assigned(Self) then begin
  Lock;
  Result:=AllocSize(myItems) div sizeof(myItems[0]);
  Unlock;
 end;
end;

procedure TObjectStorage.SetCapacity(NewCapacity:LongInt);
var
 NewCount : LongInt;
 i        : LongInt;
begin
 if Assigned(Self) then
 try
  Lock;
  try
   NewCapacity:=max(NewCapacity,0);
   NewCapacity:=min(NewCapacity,High(NewCapacity) div sizeof(myItems[0]));
   if NewCapacity<>Capacity then begin
    NewCount:=min(myCount,NewCapacity);
    for i:=NewCount to myCount-1 do KillItem(i);
    for i:=myCount to Capacity-1 do myItems[i]:=nil;
    Reallocate(Pointer(myItems),NewCapacity*sizeof(myItems[0]));
    myCount:=min(NewCount,Capacity);
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

function TObjectStorage.GetOwns:Boolean;
begin
 Result:=false;
 if Assigned(Self) then begin
  Lock;
  Result:=myOwns;
  Unlock;
 end;
end;

procedure TObjectStorage.SetOwns(aOwns:Boolean);
begin
 if Assigned(Self) then begin
  Lock;
  myOwns:=aOwns;
  Unlock;
 end;
end;

function TObjectStorage.GetItem(Num:LongInt):TObject;
begin
 Result:=nil;
 if Assigned(Self) then begin
  Lock;
  if LongWord(Num)<LongWord(myCount) then Result:=myItems[Num];
  Unlock;
 end;
end;

procedure TObjectStorage.PutItem(Num:LongInt; aItem:TObject);
begin
 if Assigned(Self) then begin
  Lock;
  if Num=myCount then Insert(Num,aItem) else
  if LongWord(Num)<LongWord(myCount) then begin
   KillItem(Num);
   myItems[Num]:=aItem;
  end;
  Unlock;
 end;
end;

procedure TObjectStorage.KillItem(Num:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  if LongWord(Num)<LongWord(myCount) then begin
   if myOwns then Kill(TObject(myItems[Num])) else myItems[Num]:=nil;
  end;
  Unlock;
 end;
end;

procedure TObjectStorage.Delete(Num:LongInt);
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if LongWord(Num)<LongWord(myCount) then begin
   KillItem(Num);
   Tail:=myCount-Num-1;
   SafeMove(myItems[Num+1], myItems[Num], Tail*sizeof(myItems[0]));
   myItems[myCount-1]:=nil;
   dec(myCount);
  end;
  Unlock;
 end;
end;

procedure TObjectStorage.Insert(Num:LongInt; aItem:TObject);
var Tail:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  if LongWord(Num)<=LongWord(myCount) then begin
   Capacity:=max(Capacity,AdjustBufferSize(myCount+1,myStep));
   if Capacity>myCount then begin
    Tail:=myCount-Num;
    SafeMove(myItems[Num], myItems[Num+1], Tail*sizeof(myItems[0]));
    myItems[Num]:=aItem;
    inc(myCount);
   end;
  end;
  Unlock;
 end;
end;

function TObjectStorage.Remove(aItem:TObject):LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=IndexOf(aItem);
  if Result>=0 then Delete(Result);
  Unlock;
 end else Result:=-1;
end;

procedure TObjectStorage.Add(aItem:TObject);
begin
 if Assigned(Self) then begin
  Lock;
  Insert(myCount,aItem);
  Unlock;
 end;
end;

procedure TObjectStorage.ForEach(Action:TObjectStorageForEachAction; CustomData:Pointer; Backward:Boolean=false);
var
 Index      : LongInt;
 Terminated : Boolean;
begin
 if Assigned(Self) and Assigned(Action) then
 try
  Lock;
  try
   Terminated:=false;
   if Backward then begin
    Index:=Count-1;
    while (Index>=0) and not Terminated do begin
     Action(Index,Items[Index],Terminated,CustomData);
     dec(Index);
    end;
   end else begin
    Index:=0;
    while (Index<Count) and not Terminated do begin
     Action(Index,Items[Index],Terminated,CustomData);
     inc(Index);
    end;
   end;
  finally
   Unlock;
  end;
 except
  on E:Exception do ErrorFound(E);
 end;
end;

type
 TFindItemRec = packed record Index:LongInt; Item:TObject; end;

procedure aFindItem(aIndex:LongInt; const aItem:TObject; var Terminate:boolean; CustomData:Pointer);
begin
 with TFindItemRec(CustomData^) do
 if Assigned(aItem) and (Pointer(aItem)=Pointer(Item)) then begin
  Index:=aIndex;
  Terminate:=true;
 end;
end;

function TObjectStorage.IndexOf(aItem:TObject):LongInt;
var FindItemRec:TFindItemRec;
begin
 FindItemRec.Index:=-1;
 FindItemRec.Item:=aItem;
 ForEach(aFindItem,@FindItemRec);
 Result:=FindItemRec.Index;
end;

procedure TObjectStorage.Clear;
begin
 if Assigned(Self) then Count:=0;
end;

procedure TObjectStorage.Pack;
var Index:Integer;
begin
 if Assigned(Self) then begin
  Lock;
  for Index:=Count-1 downto 0 do if Items[Index]=nil then Delete(Index);
  Unlock;
 end;
end;

function  NewObjectStorage(aOwnsObjects : Boolean = true;
                           aCapacity    : LongInt = DefaultTObjectStorageCapacity;
                           aStep        : LongInt = DefaultTObjectStorageStep):TObjectStorage;
begin
 Result:=nil;
 try
  Result:=TObjectStorage.Create(aOwnsObjects,aCapacity,aStep);
  if not Result.Ok then Kill(Result);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TObjectStorage); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end;
end;

 {
 *******************************************************************************
 TAbstractArray implementation
 *******************************************************************************
 }
function TAbstractArray.CheckOk:Boolean;
begin
 Result:=AllocSize(myData)>=myRows*myColumns*myItemSize;
end;

procedure TAbstractArray.ErrorFound(E:Exception; const Note:LongString);
begin
 if Exceptions then begin
  if E is Exception
  then RAISE EMatrixFailure.Create(E.Message)
  else RAISE EMatrixFailure.Create(Note);
 end else ErrorReport(E,Note);
end;

function TAbstractArray.SetDimension(aRows,aColumns:LongInt):Boolean;
var Save:record Rows,Columns:LongInt; Data:Pointer; end; Src,Dst:PChar; i:LongInt;
begin
 Result:=false;
 if Assigned(Self) then begin
  if (aRows>=0) and (aColumns>=0) then
  try
   Lock;
   try
    if (aRows<>myRows) or (aColumns<>myColumns) then begin
     Save.Rows:=myRows;
     Save.Columns:=myColumns;
     Save.Data:=myData;
     myRows:=aRows;
     myColumns:=aColumns;
     myData:=Allocate(myRows*myColumns*myItemSize);
     if Ok then begin
      Src:=Save.Data;
      Dst:=myData;
      for i:=0 to min(Save.Rows,myRows)-1 do begin
       SafeMove(Src[0], Dst[0], myItemSize * min(Save.Columns, myColumns));
       inc(Src, myItemSize * Save.Columns);
       inc(Dst, myItemSize * myColumns);
      end;
      Deallocate(Save.Data);
      Result:=true;
     end else begin
      Deallocate(myData);
      myRows:=Save.Rows;
      myColumns:=Save.Columns;
      myData:=Save.Data;
     end;
    end else Result:=true;
   finally
    Unlock;
    if not Result then ErrorReport(nil,'Out of memory.');
   end;
  except
   on E:Exception do ErrorFound(E);
  end else ErrorFound(nil,Format('Invalid matrix dimension [%d,%d].',[aRows,aColumns]));
 end;
end;

function TAbstractArray.GetRows:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myRows;
  Unlock;
 end else Result:=0;
end;

procedure TAbstractArray.SetRows(aRows:LongInt);
begin
 if Assigned(Self) then SetDimension(aRows,myColumns);
end;

function TAbstractArray.GetColumns:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myColumns;
  Unlock;
 end else Result:=0;
end;

procedure TAbstractArray.SetColumns(aColumns:LongInt);
begin
 if Assigned(Self) then SetDimension(myRows,aColumns);
end;

function TAbstractArray.GetItemSize:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myItemSize;
  Unlock;
 end else Result:=0;
end;

function TAbstractArray.GetOrigin:LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  Result:=myOrigin;
  Unlock;
 end else Result:=0;
end;

procedure TAbstractArray.SetOrigin(aOrigin:LongInt);
begin
 if Assigned(Self) then begin
  Lock;
  myOrigin:=aOrigin;
  Unlock;
 end;
end;

function TAbstractArray.Get1DItemPtr(aIndex:LongInt):Pointer;
begin
 if Assigned(Self) then begin
  Lock;
  dec(aIndex,myOrigin);
  if (Cardinal(aIndex)<Cardinal(myRows*myColumns))
  then Result:=@(PChar(myData)[myItemSize*aIndex])
  else Result:=nil;
  Unlock;
  if not Assigned(Result)
  then ErrorFound(nil,Format('Vector index %d out of range [%d,%d].',
                             [aIndex+myOrigin, myOrigin, myOrigin+myRows*myColumns-1]));
 end else Result:=nil;
end;

function TAbstractArray.Get2DItemPtr(aRow,aColumn:LongInt):Pointer;
begin
 if Assigned(Self) then begin
  Lock;
  dec(aRow,myOrigin);
  dec(aColumn,myOrigin);
  if (Cardinal(aRow)<Cardinal(myRows)) and (Cardinal(aColumn)<Cardinal(myColumns))
  then Result:=@(PChar(myData)[myItemSize*(aRow*myColumns+aColumn)])
  else Result:=nil;
  Unlock;
  if not Assigned(Result)
  then ErrorFound(nil,Format('Matrix index %d,%d out of range [[%d,%d],[%d,%d]].',
                             [aRow+myOrigin, aColumn+myOrigin, myOrigin,
                             myOrigin+myRows-1, myOrigin, myOrigin+myColumns-1]));
 end else Result:=nil;
end;

constructor TAbstractArray.Create(aRows,aColumns,aItemSize,aOrigin:LongInt);
begin
 inherited Create;
 myData:=nil;
 myRows:=0;
 myColumns:=0;
 myItemSize:=aItemSize;
 myOrigin:=aOrigin;
 Exceptions:=false;
 SetDimension(aRows,aColumns);
 Exceptions:=true;
end;

destructor  TAbstractArray.Destroy;
begin
 Lock;
 try
  myRows:=0;
  myColumns:=0;
  Deallocate(myData);
 finally
  Unlock;
 end;
 inherited Destroy;
end;

 {
 *******************************************************************************
 TAbstractVector & TAbstractMatrix implementation
 *******************************************************************************
 }
constructor TAbstractVector.Create(aLength,aItemSize,aOrigin:LongInt);
begin
 inherited Create(1,aLength,aItemSize,aOrigin);
end;

constructor TAbstractMatrix.Create(aRows,aColumns,aItemSize,aOrigin:LongInt);
begin
 inherited Create(aRows,aColumns,aItemSize,aOrigin);
end;

 {
 *******************************************************************************
 TLongIntVector & TLongIntMatrix implementation
 *******************************************************************************
 }
function TLongIntVector.GetItem(aIndex:LongInt):LongInt;
var Temp:^LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aIndex];
   if Assigned(Temp) then Result:=Temp^ else Result:=0;
  finally
   Unlock;
  end;
 end else Result:=0;
end;

procedure TLongIntVector.SetItem(aIndex:LongInt; const aValue:LongInt);
var Temp:^LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aIndex];
   if Assigned(Temp) then Temp^:=aValue;
  finally
   Unlock;
  end;
 end;
end;

constructor TLongIntVector.Create(aLength:LongInt; aOrigin:LongInt=0);
begin
 inherited Create(aLength,sizeof(LongInt),aOrigin);
end;

function NewLongIntVector(aLength:LongInt; aOrigin:LongInt=0):TLongIntVector;
begin
 Result:=nil;
 try
  Result:=TLongIntVector.Create(aLength,aOrigin);
  if not Result.Ok then Kill(Result);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TLongIntVector); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end;
end;

function TLongIntMatrix.GetItem(aRow,aColumn:LongInt):LongInt;
var Temp:^LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aRow,aColumn];
   if Assigned(Temp) then Result:=Temp^ else Result:=0;
  finally
   Unlock;
  end;
 end else Result:=0;
end;

procedure TLongIntMatrix.SetItem(aRow,aColumn:LongInt; const aValue:LongInt);
var Temp:^LongInt;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aRow,aColumn];
   if Assigned(Temp) then Temp^:=aValue;
  finally
   Unlock;
  end;
 end;
end;

constructor TLongIntMatrix.Create(aRows,aColumns:LongInt; aOrigin:LongInt=0);
begin
 inherited Create(aRows,aColumns,sizeof(LongInt),aOrigin);
end;

function NewLongIntMatrix(aRows,aColumns:LongInt; aOrigin:LongInt=0):TLongIntMatrix;
begin
 Result:=nil;
 try
  Result:=TLongIntMatrix.Create(aRows,aColumns,aOrigin);
  if not Result.Ok then Kill(Result);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TLongIntMatrix); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end;
end;

 {
 *******************************************************************************
 TDoubleVector & TDoubleMatrix implementation
 *******************************************************************************
 }
function TDoubleVector.GetItem(aIndex:LongInt):Double;
var Temp:^Double;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aIndex];
   if Assigned(Temp) then Result:=Temp^ else Result:=0;
  finally
   Unlock;
  end;
 end else Result:=0;
end;

procedure TDoubleVector.SetItem(aIndex:LongInt; const aValue:Double);
var Temp:^Double;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aIndex];
   if Assigned(Temp) then Temp^:=aValue;
  finally
   Unlock;
  end;
 end;
end;

constructor TDoubleVector.Create(aLength:LongInt; aOrigin:LongInt=0);
begin
 inherited Create(aLength,sizeof(Double),aOrigin);
end;

function NewDoubleVector(aLength:LongInt; aOrigin:LongInt=0):TDoubleVector;
begin
 Result:=nil;
 try
  Result:=TDoubleVector.Create(aLength,aOrigin);
  if not Result.Ok then Kill(Result);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TDoubleVector); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end; 
end;

function TDoubleMatrix.GetItem(aRow,aColumn:LongInt):Double;
var Temp:^Double;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aRow,aColumn];
   if Assigned(Temp) then Result:=Temp^ else Result:=0;
  finally
   Unlock;
  end;
 end else Result:=0;
end;

procedure TDoubleMatrix.SetItem(aRow,aColumn:LongInt; const aValue:Double);
var Temp:^Double;
begin
 if Assigned(Self) then begin
  Lock;
  try
   Temp:=ItemPtr[aRow,aColumn];
   if Assigned(Temp) then Temp^:=aValue;
  finally
   Unlock;
  end;
 end;
end;

constructor TDoubleMatrix.Create(aRows,aColumns:LongInt; aOrigin:LongInt=0);
begin
 inherited Create(aRows,aColumns,sizeof(Double),aOrigin);
end;

function NewDoubleMatrix(aRows,aColumns:LongInt; aOrigin:LongInt=0):TDoubleMatrix;
begin
 Result:=nil;
 try
  Result:=TDoubleMatrix.Create(aRows,aColumns,aOrigin);
  if not Result.Ok then Kill(Result);
 except
  on E:Exception do BugReport(E);
 end;
end;

procedure Kill(var TheObject:TDoubleMatrix); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E);
 end; 
end;

initialization

finalization

end.
