[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]