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

    {
    Here are the routines I wrote.  The PtrToLong routine is from TurboPower's
    OPINLINE unit; it just converts a pointer to a linear address, using
    16*seg + ofs (in longint arithmetic, of course).  Other than that, I think
    everything should be obvious.

    From: dmurdoch@mast.queensu.ca (Duncan Murdoch)
    }

    {$ifndef dpmi}

    type
      PFreeRec = ^TFreeRec;
      TFreeRec = record
        next: PFreeRec;
        size: Pointer;
      end;

    procedure GetMemHuge(var p:HugePtr;size:Longint);
    const
      blocksize = $FFF0;
    var
      prev,free : PFreeRec;
      save,temp : pointer;
      block : word;
    begin
      { Handle the easy cases first }
      if size > maxavail then
        p := nil
      else if size < 65521 then
        getmem(p,size)
      else
      begin
    {$ifndef ver60}
       {$ifndef ver70}
        The code below is extremely version specific to the TP 6/7 heap manager!!
       {$endif}
    {$endif}
        { Find the block that has enough space }
        prev := PFreeRec(@freeList);
        free := prev^.next;
        while (free <> heapptr) and (PtrToLong(free^.size) < size) do
        begin
          prev := free;
          free := prev^.next;
        end;

        { Now free points to a region with enough space; make it the first one
          and multiple allocations will be contiguous. }

        save := freelist;
        freelist := free;
        { In TP 6, this works; check against other heap managers }
        while size > 0 do
        begin
          block := minlong(blocksize,size);
          dec(size,block);
          getmem(temp,block);
        end;

        { We've got what we want now; just sort things out and restore the
          free list to normal }

        p := free;
        if prev^.next <> freelist then
        begin
          prev^.next := freelist;
          freelist := save;
        end;
      end;
    end;

    procedure FreeMemHuge(var p:HugePtr;size : longint);
    const
      blocksize = $FFF0;
    var
      block : word;
    begin
      while size > 0 do
      begin
        block := minlong(blocksize,size);
        dec(size,block);
        freemem(p,block);
        p := Normalized(AddWordToPtr(p,block));
      end;
    end;
    {$else}

    Procedure GetMemHuge(var p : HugePtr; Size: LongInt);
    begin
      if Size < 65521 then
        GetMem(p,size)
      else
        p := GlobalAllocPtr(gmem_moveable,Size);
    end;

    Procedure FreeMemHuge(var p : HugePtr; Size: Longint);
    var
      h : THandle;
    begin
      if Size < 65521 then
        Freemem(p,size)
      else
        h := GlobalFreePtr(p);
    end;

    {$endif}

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