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

    {
    > Protected mode has the WinAPI unit that lets you deal with
    > huge memory blocks and other stuff. That is what is needed.

    > In real mode all you can do is:

    Here's some stuff from a huge memory block unit I'm working on.  It isn't fully
    debugged yet, but I think these parts work.  However, use at your own risk.
    There are a few routines called which I don't include; you should be able to
    figure those ones out, or pull them out of a standard library.  "LH" is a
    record with fields L and H for pulling the low and high words out of a pointer
    or longint.

     { This part works in both real and protected mode. }

     procedure IncPtr(var p:pointer;count:word);
     { Increments pointer }
     begin
       inc(LH(p).L,count);
       if LH(p).L < count then
         inc(LH(p).H,SelectorInc);
     end;

     procedure DecPtr(var p:pointer;count:word);
     { decrements pointer }
     begin
       if count > LH(p).L then
         dec(LH(p).H,SelectorInc);
       dec(LH(p).L,Count);
     end;

     procedure IncPtrLong(var p:pointer;count:longint);
     { Increments pointer; assumes count > 0 }
     begin
       inc(LH(p).H,SelectorInc*LH(count).H);
       inc(LH(p).L,LH(Count).L);
       if LH(p).L < LH(count).L then
         inc(LH(p).H,SelectorInc);
     end;

     procedure DecPtrLong(var p:pointer;count:longint);
     { Decrements pointer; assumes count > 0 }
     begin
       if LH(count).L > LH(p).L then
         dec(LH(p).H,SelectorInc);
       dec(LH(p).L,LH(Count).L);
       dec(LH(p).H,SelectorInc*LH(Count).H);
     end;
     { The next section is for real mode only }

    {$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);
         IncPtr(p,block);
         p := Normalized(p);
       end;
     end;

    { The next section is the protected mode part }

     {$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;

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