NetNews Usenet Archive 1992 #18/NN_1992_18.iso/spool/comp/lang/pascal/4890

Internet Message Format | 1992-08-17 | 10.3 KB

Path: sparky!uunet!munnari.oz.au!yoyo.aarnet.edu.au!dstos3.dsto.gov.au!zodiac.dsto.oz.au!st_waldman
From: [e-mail]
Newsgroups: comp.lang.pascal
Subject: Re: Arrays > 64K -- New source code
Message-ID: <[e-mail]>
Date: 18 Aug 92 02:01:57 GMT
Organization: D.S.T.O. Aeronautical Research Laboratory
Lines: 396
Nntp-Posting-Host: zodiac.dsto.gov.au

Hi,

I have also written some memory allocation routines that allow me to
create arrays larger than 64KB. They handle Turbo Pascal REAL, DOUBLE,
SINGLE and INTEGER arrays, of one or two dimensions.

The source code is provided below, and can be used freely by anyone who
is interested. A small test program is also provided, and was compiled
and run under Turbo Pascal 6.0. As 5 x 60000 = 300000 bytes of memory is
allocated, you may not be able to run the test program from within TP's
IDE. I did add some comments here, though, so hopefully it will still work.

As written, the array indexing is assumed to start from 0, as this was
the most convenient definition for my work. It is possible to change this
to suit your needs by modifying some TYPE declarations in the MATMEM unit.

You will also note that the upper bound of the array type in the TYPE
declaration is set to the maximum possible. If you use a smaller range,
then there may be the risk of errors as range checking will not be
effective. Again, these limits can be changed to something smaller if
required.

The array referencing is fairly intuitive (at least I think so!). For
example:

     A[I,J]    is referenced as   A^[I]^[J]

so existing code can be easily converted, particularly if your editor has
a macro facility so that you can do some repetitive editing.

My routines use the standard GetMem and FreeMem procedures, so they
may even be portable to Turbo Pascal For Windows. If someone would
like to try my code in that environment, please let me know how you go.

Regards...

Witold Waldman

[e-mail]




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

{ Test program for trying out one of the matrix memory allocation routines }
{ contained in the MATMEM unit.                                            }

Program TestMATMEM(Input,Output);

Uses Crt,MATMEM;

var
  I,J   : integer;   { Loop counters                                  }
  NRmax : word;      { Maximum number of rows in 2D array             }
  NCmax : word;      { Maximum number of columns in 2D array          }
  A     : pArraySS;  { Pointer to 2D array of single precision values }

begin

  NRmax :=     5;
  NCmax := 15000;    { 15000*4 bytes = 60000 bytes per row }

  Writeln('Memory on heap before array allocation = ',MemAvail,' bytes');

  A := NewArraySS(NRmax,NCmax);

  Writeln('Memory on heap after  array allocation = ',MemAvail,' bytes');

  If A = nil then
    begin
    Writeln;
    Writeln('NewArray memory allocation request failed.');
    Halt;
    end;

  { Place some simple numbers in the array we have created }

  For I := 1 to NRmax do
    For J := 1 to NCmax do
      begin
      A^[I]^[J] := I + J;
      end;

  Writeln;
  Writeln('Print out of value in first and last elements:');
  Writeln;

  I := 1;
  J := 1;

  Writeln(I:10,J:10,A^[I]^[J]:15:2);

  I := NRmax;
  J := NCmax;

  Writeln(I:10,J:10,A^[I]^[J]:15:2);

  { Do the right thing: clean up your own rubbish }

  A := DisposeArraySS(A,NRmax,NCmax);

end.

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

{ Source code for MATMEM unit }

UNIT MATMEM;

INTERFACE

const
  PtrSize         = SizeOf(Pointer);
  MaxSegmentSize  = 65535;
  MaxSizeArrayPtr = MaxSegmentSize div PtrSize;
  MaxSizeArrayR   = MaxSegmentSize div SizeOf(Real);
  MaxSizeArrayS   = MaxSegmentSize div SizeOf(Single);
  MaxSizeArrayD   = MaxSegmentSize div SizeOf(Double);
  MaxSizeArrayI   = MaxSegmentSize div SizeOf(Integer);

type
  ArrayPtr = array [0..MaxSizeArrayPtr-1] of Pointer;
  ArrayR   = array [0..MaxSizeArrayR-1  ] of Real;
  ArrayS   = array [0..MaxSizeArrayS-1  ] of Single;
  ArrayD   = array [0..MaxSizeArrayD-1  ] of Double;
  ArrayI   = array [0..MaxSizeArrayI-1  ] of Integer;

  ArrayRR  = array [0..MaxSizeArrayPtr-1] of ^ArrayR;
  ArraySS  = array [0..MaxSizeArrayPtr-1] of ^ArrayS;
  ArrayDD  = array [0..MaxSizeArrayPtr-1] of ^ArrayD;
  ArrayII  = array [0..MaxSizeArrayPtr-1] of ^ArrayI;

  pArrayR  = ^ArrayR;
  pArrayS  = ^ArrayS;
  pArrayD  = ^ArrayD;
  pArrayI  = ^ArrayI;

  pArrayRR = ^ArrayRR;
  pArraySS = ^ArraySS;
  pArrayDD = ^ArrayDD;
  pArrayII = ^ArrayII;

function DisposeArrayS(A:Pointer; Nmax:Word):Pointer;

function NewArrayS(Nmax:Word):Pointer;

function DisposeArrayD(A:Pointer; Nmax:Word):Pointer;

function NewArrayD(Nmax:Word):Pointer;

function DisposeArrayI(A:Pointer; Nmax:Word):Pointer;

function NewArrayI(Nmax:Word):Pointer;

function DisposeArrayR(A:Pointer; Nmax:Word):Pointer;

function NewArrayR(Nmax:Word):Pointer;

function DisposeArraySS(A:Pointer; NRmax,NCmax:Word):Pointer;

function NewArraySS(NRmax,NCmax:Word):Pointer;

function DisposeArrayDD(A:Pointer; NRmax,NCmax:Word):Pointer;

function NewArrayDD(NRmax,NCmax:Word):Pointer;

function DisposeArrayII(A:Pointer; NRmax,NCmax:Word):Pointer;

function NewArrayII(NRmax,NCmax:Word):Pointer;

function DisposeArrayRR(A:Pointer; NRmax,NCmax:Word):Pointer;

function NewArrayRR(NRmax,NCmax:Word):Pointer;

IMPLEMENTATION

{==============================================================================}

function DisposeArray1D(A:Pointer; Nmax:Word; DataSize:Integer):Pointer;

begin
  If A <> nil then
    begin
    FreeMem(A,(Nmax+1)*DataSize);
    DisposeArray1D := nil;
    end;
end;

{==============================================================================}

function NewArray1D(Nmax:Word; DataSize:Integer):Pointer;

var
  MemP : Word;
  P    : Pointer;

begin
  MemP := (Nmax+1)*DataSize;
  If MaxAvail >= MemP then
    GetMem(P,MemP)
  else
    P := nil;
  NewArray1D := P;
end;

{==============================================================================}

function DisposeArray2D(A:Pointer; NRmax,NCmax:Word; DataSize:Integer):Pointer;

var
  I : Word;
  Q : ^ArrayPtr;

begin
  If A <> nil then
    begin
    Q := A;
    For I := 0 to NRmax do
      begin
      If Q^[I] <> nil then
        FreeMem(Q^[I],(NCmax+1)*DataSize);
      end;
    FreeMem(A,(NRmax+1)*PtrSize);
    DisposeArray2D := nil;
    end;
end;

{==============================================================================}

function NewArray2D(NRmax,NCmax:Word; DataSize:Integer):Pointer;

var
  Error : Boolean;
  I     : Word;
  MemP  : Word;        { Memory for pointers to each row of data }
  MemR  : Word;        { Memory for row of data                  }
  P     : ^ArrayPtr;

begin
  MemP := (NRmax+1)*PtrSize;
  If MaxAvail >= MemP then
    GetMem(P,MemP)
  else
    P := nil;
  If P <> nil then
    begin
    Error := false;
    MemR  := (NCmax+1)*DataSize;
    For I := 0 to NRmax do
      begin
      If MaxAvail >= MemR then
        GetMem(P^[I],MemR)
      else
        begin
        Error := true;
        P^[I] := nil;
        end;
      end;
    If Error then
      begin
      P := DisposeArray2D(P,NRmax,NCmax,DataSize);
      end;
    end;
  NewArray2D := P;
end;

{==============================================================================}

function DisposeArrayS(A:Pointer; Nmax:Word):Pointer;

begin
  DisposeArrayS := DisposeArray1D(A,Nmax,SizeOf(Single));
end;

{==============================================================================}

function NewArrayS(Nmax:Word):Pointer;

begin
  NewArrayS := NewArray1D(Nmax,SizeOf(Single));
end;

{==============================================================================}

function DisposeArrayD(A:Pointer; Nmax:Word):Pointer;

begin
  DisposeArrayD := DisposeArray1D(A,Nmax,SizeOf(Double));
end;

{==============================================================================}

function NewArrayD(Nmax:Word):Pointer;

begin
  NewArrayD := NewArray1D(Nmax,SizeOf(Double));
end;

{==============================================================================}

function DisposeArrayI(A:Pointer; Nmax:Word):Pointer;

begin
  DisposeArrayI := DisposeArray1D(A,Nmax,SizeOf(Integer));
end;

{==============================================================================}

function NewArrayI(Nmax:Word):Pointer;

begin
  NewArrayI := NewArray1D(Nmax,SizeOf(Integer));
end;

{==============================================================================}

function DisposeArrayR(A:Pointer; Nmax:Word):Pointer;

begin
  DisposeArrayR := DisposeArray1D(A,Nmax,SizeOf(Real));
end;

{==============================================================================}

function NewArrayR(Nmax:Word):Pointer;

begin
  NewArrayR := NewArray1D(Nmax,SizeOf(Real));
end;

{==============================================================================}

function DisposeArraySS(A:Pointer; NRmax,NCmax:Word):Pointer;

begin
  DisposeArraySS := DisposeArray2D(A,NRmax,NCmax,SizeOf(Single));
end;

{==============================================================================}

function NewArraySS(NRmax,NCmax:Word):Pointer;

begin
  NewArraySS := NewArray2D(NRmax,NCmax,SizeOf(Single));
end;

{==============================================================================}

function DisposeArrayDD(A:Pointer; NRmax,NCmax:Word):Pointer;

begin
  DisposeArrayDD := DisposeArray2D(A,NRmax,NCmax,SizeOf(Double));
end;

{==============================================================================}

function NewArrayDD(NRmax,NCmax:Word):Pointer;

begin
  NewArrayDD := NewArray2D(NRmax,NCmax,SizeOf(Double));
end;

{==============================================================================}

function DisposeArrayII(A:Pointer; NRmax,NCmax:Word):Pointer;

begin
  DisposeArrayII := DisposeArray2D(A,NRmax,NCmax,SizeOf(Integer));
end;

{==============================================================================}

function NewArrayII(NRmax,NCmax:Word):Pointer;

begin
  NewArrayII := NewArray2D(NRmax,NCmax,SizeOf(Integer));
end;

{==============================================================================}

function DisposeArrayRR(A:Pointer; NRmax,NCmax:Word):Pointer;

begin
  DisposeArrayRR := DisposeArray2D(A,NRmax,NCmax,SizeOf(Real));
end;

{==============================================================================}

function NewArrayRR(NRmax,NCmax:Word):Pointer;

begin
  NewArrayRR := NewArray2D(NRmax,NCmax,SizeOf(Real));
end;

END.