Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/DYRA.ZIP/DYARRAYS.PAS

Pascal/Delphi Source File | 1993-01-04 | 4.8 KB | 195 lines

UNIT DyArrays;

{------------------ DARRAY ---- Version 4.0 -- 88/04/14 ---------------}
{
     Implements Dynamic Arrays using the Heap.


     THIS SOFTWARE IS DONATED TO THE PUBLIC DOMAIN.


       Author: Mike Babulic
               3827 Charleswood Dr. N.W.
               Calgary, Alberta
               CANADA
               T2L 2C7

       Compuserve: 72307,314

       Also reachable on a friend's Fido BBS:  1:134/1

}

INTERFACE

type

     DyArray = Pointer;          {Dynamic Array Type}

     DyHeader = ^DyArrayHeader;

     DyArrayHeader = record
       size,                     { # of array elements }
       max,                      { max. size before more heapspace needed}
       mul,                      { length of an array element }
       inc : LongInt;            { after "growing";  max := size + inc }
     end;


procedure DyOpen(var ra; ra_size,ra_mul,ra_inc:LongInt);
   {Initialize a Dynamic Array:    size := ra_size;
                                   mul  := ra_mul;
                                   inc  := ra_inc;
                                   max  := size + inc;
   }

procedure DyClose(var ra);
   {Close a Dynamic Array}

function DySize(var ra):LongInt;
   {Returns the number of array elements}

procedure DyResize(var ra; newSize:LongInt);
   {Change size of array to newSize *ELEMENTS*}

procedure DyGrow(var ra; increment:LongInt);
   {Add increment  *ELEMENTS* to the array}

procedure DyClone(a:DyArray; var clone);
   {Make a copy of the array}

procedure DyCopy(a:DyArray; var destination);
   {Copy a's contents into the destination}

function Dy(a:DyArray; n:LongInt): Pointer;
   {Return pointer element # n}

function DyInfo(a:DyArray): DyHeader;
   {Return pointer to Header info for DyArray}

procedure PtrInc(var p:Pointer; n: Longint);
   {Increment pointer by n bytes}


IMPLEMENTATION


{$R-} {Turn range checking off so this executes faster/properly}

procedure DyOpen(var ra; ra_size,ra_mul,ra_inc:LongInt);
  var b: DyHeader  absolute  ra;
      a: DyArrayHeader;
  begin
    if ra_size < 0 then ra_size :=  0;
    if ra_inc  < 1 then ra_inc  := 15;
    if ra_mul  < 1 then begin
        writeln('Can''t DyOpen(ra,',ra_size,',',ra_mul,',',ra_inc,')');
        HALT;
    end;
    with a do begin
      size := ra_size;      max  := ra_size + ra_inc;
      mul   := ra_mul;      inc  := ra_inc;
      GetMem(b, mul * max + SizeOf(DyArrayHeader));
      if b = NIL then begin
        writeln('   GetMem failed! ');
        writeln('Can''t DyOpen(ra,',size,',',ra_mul,',',ra_inc,')');
        HALT;
      end;
    end;
    b^ := a;
    PtrInc(Pointer(b),SizeOf(DyArrayHeader));  {Point after the Header}
  end;


procedure DyClose(var ra);
  var a: DyHeader  absolute  ra;
  begin
    if a<>NIL then begin
      PtrInc(Pointer(a),-SizeOf(DyArrayHeader)); {Point to the Header}
      with a^ do
        FreeMem(a, mul * max + SizeOf(DyArrayHeader));
      a := NIL;
    end
  end;


function DySize(var ra):LongInt;
  begin
    DySize := DyInfo(DyArray(ra))^.size;
  end;


procedure DyResize(var ra; newSize:LongInt);
  var a: DyHeader  absolute  ra;
      newMax: LongInt;
      newRa: DyHeader;
      s : LongInt;
  begin  if a<>NIL then begin
    if newSize < 0 then newSize := 0;
    with DyInfo(a)^ do begin
      if (newSize > max)  or  (newSize+inc+inc < max) then begin
        DyOpen(newRa,newSize,mul,inc);
        if size < newSize then
          move(a^,newRa^, size * mul)
        else
          move(a^,newRa^, newSize * mul);
        DyClose(ra);
        a := newRa;
        end
      else
        size := newSize;
    end;
  end  end;


procedure DyGrow(var ra; increment:LongInt);
  var a: DyArray  absolute  ra;
  begin
    DyResize(ra, DyInfo(a)^.size + increment);
  end;

procedure DyClone(a:DyArray; var clone);
  var b : DyArray   ABSOLUTE   clone;
  begin
    With DyInfo(a)^ do begin
      DyOpen(b,size,mul,inc);
      move(a^,b^,mul * size);
    end;
  end;

procedure DyCopy(a:DyArray; var destination);
  var b : DyArray   ABSOLUTE   destination;
  begin
    With DyInfo(a)^ do begin
      DyResize(b,size);
      move(a^,b^,mul * size);
    end;
  end;


function Dy(a:DyArray; n:LongInt): Pointer;
  begin
    PtrInc( a, (n-1) * DyInfo(a)^.mul );
    Dy := a;
  end;


function DyInfo(a:DyArray): DyHeader;   {Return pointer to Header info for DyArray}
  begin
    PtrInc( a, -SizeOf(DyArrayHeader)); {Point to the Header}
    DyInfo :=  DyHeader(a);
  end;

procedure PtrInc(var p:Pointer; n: Longint);   {Increment pointer by n}
  type pointr = record  lo,hi: word  end;
  var
     pt : pointr   absolute  p;
     c  : pointr   absolute  n;
  begin
    n := pt.lo + n;
    pt.hi := pt.hi + n shr 4;
    pt.lo := c.lo and $F;
  end;


end. {UNIT}