[Back to POINTERS SWAG index]  [Back to Main SWAG index]  [Original]


I have a unit which many people might find very handy.  It allows you to
use dynamic arrays in pascal so you can create new arrays, resize
arrays, and delete arrays.  The usage is a little different, and always
need a variable to store a value into, and access is a bit slower than
normal arrays, but it gets the job done.  I think the main slow down is
the function calls, as the speed is comparable to a normal array access
if you call a function that accesses the array.

Here's dynarray.pas:
-----------------------cut here-------------------------------
unit dynarray;

{ dynarray - a unit to allow use of dynamic arrays written by
  Jonathan Anderson.  I release this to the public domain, so
  use it for whatever you want, but please give me credit for
  my work.  Thanks. }

(*************************************************************)
INTERFACE
(*************************************************************)

function getsize(var arr) : word;
   { Returns the number of elements in arr }

function getesize(var arr) : word;
   { Returns the size of an element in arr }

function getmemsize(var arr) : word;
   { Returns the total memory space taken up by arr (not including
     the four bytes for the pointer) }

procedure initarray(var arr : pointer; size : word; esize : word);
   { Initializes a dynamic array arr with size elements of esize
     bytes each.  Arr will be null if there is not enough memory. }

function resizearray(var arr : pointer; size : word) : boolean;
   { Resizes a dynamic array arr to size number of elements.
     When an array is enlarged, it retains all old data plus new
     uninitialized elements.  (These may not be zero)
     When an array is shortened, elements are truncated off the end
     while the remaining elements are intact.
     resizearray returns true if successful, false if otherwise. }

procedure donearray(var arr : pointer);
   { Frees the memory used by arr }

procedure setval(var arr; index : word; var value);
   { Copies value into the element at index in arr.  Value must be
     a variable.  Sorry, but I couldn't figure out how to do it
     otherwise with variable length elements. }

function getval(var arr; index : word; var value) : pointer;
   { Copies the element at index in arr to value.  Returns a pointer
     to value so it can be used as a function.  Example:
        writeln(integer(getval(arr^, index, x)^));
     This will store the at index in arr into x and write it to the
     screen.  Typecasting is needed to tell writeln that what getval
     points to is an integer.  This also assumes that values stored
     in arr are 2 bytes long. }

(*************************************************************)
IMPLEMENTATION
(*************************************************************)

procedure setsize(var arr; size : word); assembler;
asm
   mov ax, word ptr (arr+2)         { set ax to the segment of arr }
   mov es, ax
   mov di, word ptr arr             { set di to the offset of arr }
   mov ax, size
   mov word ptr [es:di], ax         { set the 1st word of arr to its
size }
end;

procedure setesize(var arr; esize : word); assembler;
asm
   mov ax, word ptr (arr+2)         { set ax to the segment of arr }
   mov es, ax
   mov di, word ptr arr             { set di to the offset of arr }
   mov ax, esize
   mov word ptr [es:di+2], ax       { set the 2nd word of arr to the }
end;                                { element size }

function getsize(var arr) : word; assembler;
asm
   mov ax, word ptr (arr+2)         { set ax to the segment of arr }
   mov es, ax
   mov di, word ptr arr             { set di to the offset of arr }
   mov ax, word ptr [es:di]         { return 1st word in arr (size) }
end;

function getesize(var arr) : word; assembler;
asm
   mov ax, word ptr (arr+2)         { set ax to the segment of arr }
   mov es, ax
   mov di, word ptr arr             { set di to the offset of arr }
   mov ax, word ptr [es:di+2]       { return 2nd word in arr (e. size) }
end;

function getmemsize(var arr) : word;
begin
   getmemsize := getsize(arr)*getesize(arr)+4;
        { (number of elements)x(element size) + (four bytes for storing
           size and element size) }
end;

procedure initarray(var arr : pointer; size : word; esize : word);
begin
   if (MaxAvail >= size*esize+4) and (longint(size)*esize+4 <= 65535)
then
   { make sure there's enough memory and the array isn't larger than 64K
}
      begin
         getmem(arr, size*esize+4);    { allocate the memory }
         setsize(arr^, size);          { set the array size }
         setesize(arr^, esize);        { set the element size }
      end
   else     { if array too big or not enough memory, set arr to nil }
      arr := nil;
end;

function resizearray(var arr : pointer; size : word) : boolean;
var
   p, q : pointer;       { temporary variables for intermediate storage
}
   x : word;             { temporary variable }
begin
   if (MaxAvail >= size*getesize(arr^)+4) and
      (longint(size)*getesize(arr^)+4 <= 65535) then
        { if there's enough memory and new array < 64K }
      begin
         getmem(p, size*getesize(arr^)+4);  { allocate memory for new
array }
         setsize(p^, size);                 { set new size }
         setesize(p^, getesize(arr^));      { set new element size }
         x := getmemsize(arr^);             { set x to old mem size }
         if getmemsize(p^) < x then         { if new array is smaller, }
            x := getmemsize(p^);            { set x to new mem size }
         move(arr^, p^, x);                 { copy x elements to new
array }
         setsize(p^, size);              { set new size (destroyed in
copy) }
         freemem(arr, getmemsize(arr^));    { free mem from old array }
         arr := p;                         { set arr to new array }
         resizearray := true;              { return true on success }
      end
   else
   { array too big or not enough memory, return false but leave arr
intact }
      resizearray := false;
end;

procedure donearray(var arr : pointer);
begin
   freemem(arr, getmemsize(arr^));      { free memory from arr }
end;

procedure setval(var arr; index : word; var value);
begin
   move(value, ptr(seg(arr),ofs(arr)+index*getesize(arr)+4)^,
getesize(arr));
   { copy value to array element.  Pascal is strong typed, so we have
     to access specific element periphrastically. }
end;

function getval(var arr; index : word; var value) : pointer;
begin
   move(ptr(seg(arr),ofs(arr)+index*getesize(arr)+4)^, value,
getesize(arr));
   { copy array element to value.  Pascal is strong typed, so we have
     to access specific element periphrastically. }
   getval := @value;     { return pointer to value }
end;

end.
--------------------cut here--------------------------

And here's a program to show how to use it:
--------------------cut here--------------------------
program testarray;

uses dynarray;

var
   array1 : pointer;
   x : byte;

procedure getit(var a; size:word);
var
   i:word;
   b:byte;
begin
   for i:=0 to size-1 do
      begin
         write('Enter value ',i,': ');
         readln(b);
         setval(a,i,b);
      end;
end;

procedure showit(var a; size : word);
var
  i:word;
  b:byte;
begin
   for i:=0 to size-1 do
      writeln('Value ',i,': ', byte(getval(a,i,b)^));
end;

begin
   write('Enter number of elements: ');
   readln(x);
   initarray(array1, x, 1);  { initializes array1 as an array[0..x-1] of
}
                             { byte sized elements }
   getit(array1^, getsize(array1^));
   showit(array1^, getsize(array1^));
   donearray(array1);
end.
--------------------cut here----------------------

I hope you enjoy it.
--
Jonathan Anderson
sarlok@geocities.com

[Back to POINTERS SWAG index]  [Back to Main SWAG index]  [Original]