{
/* Copyright 1998-2011 Research Foundation State University of New York */

/* This file is part of QuB.                                            */

/* QuB is free software; you can redistribute it and/or modify          */
/* it under the terms of the GNU General Public License as published by */
/* the Free Software Foundation, either version 3 of the License, or    */
/* (at your option) any later version.                                  */

/* QuB is distributed in the hope that it will be useful,               */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of       */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        */
/* GNU General Public License for more details.                         */

/* You should have received a copy of the GNU General Public License,   */
/* named LICENSE.txt, in the QuB program directory.  If not, see        */
/* <http://www.gnu.org/licenses/>.                                      */
}
unit Alloc;

// begin_html
// See also:
// <ul>
// <li><a href="maxill_iface.pas.html">maxill_iface.pas</a></li>
// <li><a href="Maxill_Utils.pas.html">Maxill_Utils.pas</a></li>
// <li><a href="AllocTypes.pas.html">AllocTypes.pas</a></li>
// </ul>
// <b>Up:</b> <a href="index.html">Index</a>
// end_html  

interface


uses


SysUtils, Windows, AllocTypes;


function Alloc1(Size :Integer; DataSize :Integer) :Pointer;
function ByteAlloc1(Size :Integer) :TPAByte;
function SmAlloc1(Size :Integer) :TPASmall;
function WAlloc1(Size :Integer) :TPAWord;
function IAlloc1(Size :Integer) :TPAInteger;
function SAlloc1(Size :Integer) :TPASingle;
function DAlloc1(Size :Integer) :TPADouble;
function EAlloc1(Size :Integer) :TPAExtended;
function CAlloc1(Size :Integer) :TPAChar;
function PointAlloc1(Size :Integer) :TPAPoint;
function PAlloc1(Size :Integer) :TPAPointer;
function BoolAlloc1(Size :Integer) :TPABoolean;
function SXYAlloc1(Size :Integer) :TPASingleXY;
function DXYAlloc1(Size :Integer) :TPADoubleXY;

function Alloc2(row, col :Integer; DataSize :Integer) :Pointer;
function WAlloc2(row, col :Integer) :TPMWord;
function SmAlloc2(row, col :Integer) :TPMSmall;
function IAlloc2(row, col :Integer) :TPMInteger;
function SAlloc2(row, col :Integer) :TPMSingle;
function DAlloc2(row, col :Integer) :TPMDouble;
function EAlloc2(row, col :Integer) :TPMExtended;
function CAlloc2(row, col :Integer) :TPMChar;
function PointAlloc2(row, col :Integer) :TPMPoint;
function PAlloc2(row, col :Integer) :TPMPointer;
function TBAlloc2(row, col :Integer) :TPMThreeBytes;
function BoolAlloc2(row, col :Integer) :TPMBoolean;
function SXYAlloc2(row, col :Integer) :TPMSingleXY;
function DXYAlloc2(row, col :Integer) :TPMDoubleXY;

procedure Free2(p :TPMChar);

function AllocMatrixInteger(row, col :Integer) :TPMatrixInteger;
function AllocMPXBufferInteger(row, col :Integer) :TPMPXBufferInteger;
procedure FreeMatrixInteger(m :TPMatrixInteger);
procedure FreeMPXBufferInteger(b :TPMPXBufferInteger);

type

TQUB_DBuf2_Double             = class
public
  Buf                         :TPMDouble;
  Alt                         :TPMDouble;
  RowCount                    :Integer;
  ColCount                    :Integer;

  constructor Create(NR, NC :Integer);
  destructor Destroy; override;

  procedure Swap;
end;


implementation


//Memory allocation


const


MEM_ALLOC_ERROR = 'Memory allocation error';


function Alloc1(Size :Integer; DataSize :Integer) :Pointer;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*DataSize);
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function ByteAlloc1(Size :Integer) :TPAByte;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Byte));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function SmAlloc1(Size :Integer) :TPASmall;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(SmallInt));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function WAlloc1(Size :Integer) :TPAWord;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Word));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function IAlloc1(Size :Integer) :TPAInteger;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Integer));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function SAlloc1(Size :Integer) :TPASingle;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Single));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function DAlloc1(Size :Integer) :TPADouble;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Double));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function EAlloc1(Size :Integer) :TPAExtended;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Extended));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function CAlloc1(Size :Integer) :TPAChar;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Char));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function PointAlloc1(Size :Integer) :TPAPoint;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(TPoint));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function PAlloc1(Size :Integer) :TPAPointer;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Pointer));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function BoolAlloc1(Size :Integer) :TPABoolean;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(Boolean));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function SXYAlloc1(Size :Integer) :TPASingleXY;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(TSingleXY));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;

function DXYAlloc1(Size :Integer) :TPADoubleXY;
begin
  Result := nil;
  if Size > 0 then begin
    GetMem(Result, Size*SizeOf(TDoubleXY));
    if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  end;
end;


//******************************************************************************
function Alloc2(row, col :Integer; DataSize :Integer) :Pointer;
var
  Buffer :TPMPointer;
  i :Integer;
begin
  raise EOutOfMemory.Create('Don''t use this function ! It is defective - must fix');
  GetMem(Buffer, row*SizeOf(Pointer));
  if Buffer = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Buffer[0], row*col*DataSize);
  if Buffer[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Buffer[i] := @(Buffer[0][i*col]);
  Result := Buffer;
end;

function SmAlloc2(row, col :Integer) :TPMSmall;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPASmall));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(SmallInt));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function WAlloc2(row, col :Integer) :TPMWord;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAWord));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Word));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function IAlloc2(row, col :Integer) :TPMInteger;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAInteger));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
   GetMem(Result[0], row*col*SizeOf(Integer));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function SAlloc2(row, col :Integer) :TPMSingle;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPASingle));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Single));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function DAlloc2(row, col :Integer) :TPMDouble;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPADouble));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Double));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;
(*
function DAlloc2(row, col :Integer) :TPMDouble;
var
  i :Integer;
begin
  Result := SysGetMem(row*SizeOf(TPADouble));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  Result[0] := SysGetMem(row*col*SizeOf(Double));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;
*)
function EAlloc2(row, col :Integer) :TPMExtended;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAExtended));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Extended));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function CAlloc2(row, col :Integer) :TPMChar;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAChar));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Char));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function PointAlloc2(row, col :Integer) :TPMPoint;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAPoint));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(TPoint));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function BoolAlloc2(row, col :Integer) :TPMBoolean;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPABoolean));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Boolean));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function PAlloc2(row, col :Integer) :TPMPointer;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAPointer));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(Pointer));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function TBAlloc2(row, col :Integer) :TPMThreeBytes;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPAThreeBytes));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(TThreeBytes));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function SXYAlloc2(row, col :Integer) :TPMSingleXY;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPASingleXY));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(TSingleXY));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function DXYAlloc2(row, col :Integer) :TPMDoubleXY;
var
  i :Integer;
begin
  GetMem(Result, row*SizeOf(TPADoubleXY));
  if Result = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  GetMem(Result[0], row*col*SizeOf(TDoubleXY));
  if Result[0] = nil then raise EOutOfMemory.Create(MEM_ALLOC_ERROR);
  for i := 1 to row - 1 do Result[i] := @(Result[0][i*col]);
end;

function AllocMatrixInteger(row, col :Integer) :TPMatrixInteger;
begin
   GetMem(Result, SizeOf(TMatrixInteger));
   Result.Data := IAlloc2(row, col);
   Result.RowCount := row;
   Result.ColCount := col;
end;

procedure FreeMatrixInteger(m :TPMatrixInteger);
begin
  if m <> nil then begin
    Free2(TPMChar(m.Data));
    FreeMem(m);
  end;
end;

function AllocMPXBufferInteger(row, col :Integer) :TPMPXBufferInteger;
begin
   GetMem(Result, SizeOf(TMatrixInteger));
   Result.Buffer := IAlloc1(row*col);
   Result.BufferCount := row;
   Result.ElemCount   := col;
end;

procedure FreeMPXBufferInteger(b :TPMPXBufferInteger);
begin
  if b <> nil then begin
    FreeMem(b.Buffer);
    FreeMem(b);
  end;
end;

//Memory release
procedure Free2(p :TPMChar);
begin
  if p <> nil then begin
    FreeMem(p[0]);
    FreeMem(p);
  end;
end;


constructor TQUB_DBuf2_Double.Create(NR, NC :Integer);
begin
  RowCount      := NR;
  ColCount      := NC;
  Buf           := DAlloc2(NR, NC);
  Alt           := DAlloc2(NR, NC);
end;

destructor TQUB_DBuf2_Double.Destroy;
begin
  try
    Free2(TPMChar(Buf));
    Free2(TPMChar(Alt));
  finally
    inherited;
  end;
end;

procedure TQUB_DBuf2_Double.Swap;
var
  Tmp       :TPMDouble;
begin
  Tmp       := Buf;
  Buf       := Alt;
  Alt       := Tmp;
end;


//******************************************************************************
end.