[comp.lang.pascal] Shrinking Heap Size

derek@philmds.UUCP (derek) (10/05/89)

In article <1756@draken.nada.kth.se> d88-eli@nada.kth.se (Erik Liljencrantz) writes:
>... If your program needs any heap space, you will have to decide how
>much at compile time (and experiment with the z & y numbers too). There is no
>easy way to change this at runtime (though it's possible to shrink the heap,
>then Exec, and then restore the heap...)
>
So the question is, 'is there a simple way to do this?' I'm using the heap
a lot, and also Exec, so there is always a conflict of interests - there is
never enough memory, is there?
 

Regards Derek.

d88-eli@nada.kth.se (Erik Liljencrantz) (10/07/89)

In article <1090@philmds.UUCP> derek@sundts.UUCP (Derek Carr) writes:
>In article <1756@draken.nada.kth.se> d88-eli@nada.kth.se (Erik Liljencrantz) writes:
>>... If your program needs any heap space, you will have to decide how
>>much at compile time (and experiment with the z & y numbers too). There is no
>>easy way to change this at runtime (though it's possible to shrink the heap,
>>then Exec, and then restore the heap...)
>>
>So the question is, 'is there a simple way to do this?' I'm using the heap
>a lot, and also Exec, so there is always a conflict of interests - there is
>never enough memory, is there?

Below is a routine that deallocates the heap (returns the free memory to
DOS). This is done with DOS INT 21h/function 4Ah: Modify allocated memory
block. The idea is to shrink the program segment, load and execute then
reclaim the memory (also done with function 4Ah).

I think the routines included will handle fragmented heaps too, as long as
there is a large block of free memory at the top of the heap!

Here it is (but please: USE WITH CARE):

{$M 16384,0,655360}       { FULL heap size }
USES
  Dos;

FUNCTION RunProgram(Prog,Args:STRING):INTEGER;
{ Result is DosError. If 0 then examine DosExitCode. }
TYPE
  FreeRec=RECORD              { Structures defined but not realy used. }
    OrgPtr,EndPtr:POINTER;
  END;
  FreeList=ARRAY[0..8190] OF FreeRec;
  FreeListP=^FreeList;
VAR
  FreePtr:FreeListP ABSOLUTE System.FreePtr;
  Regs8086:Registers;

  PROCEDURE LeaveHeapToDos;
  VAR
    FreeCount:INTEGER;
  BEGIN
    FreeCount:=(8192-Ofs(FreePtr^) DIV 8) MOD 8192;
    IF FreeCount>0 THEN BEGIN
      Move(FreePtr^[0],HeapPtr^,FreeCount*8);
      FreePtr:=Ptr(Seg(HeapPtr^),Ofs(HeapPtr^)+FreeCount*8);
    END ELSE FreePtr:=HeapPtr;
    Regs8086.AH:=$4A;           { Modify memory block }
    Regs8086.ES:=PrefixSeg;     { This block. New size in BX }
    Regs8086.BX:=Seg(FreePtr^)+Succ(Ofs(FreePtr^) SHR 4)-PrefixSeg;
    MsDos(Regs8086);
  END;

  PROCEDURE RestoreHeap;
  VAR
    TmpSeg,FreeCount:WORD;
  BEGIN
    Regs8086.AH:=$4A;         { Modify memory block }
    Regs8086.ES:=PrefixSeg;   { This block }
    Regs8086.BX:=$FFFF;       { Max value = all of memory }
    MsDos(Regs8086);
    Regs8086.AH:=$4A;
    Regs8086.ES:=PrefixSeg;
    TmpSeg:=PrefixSeg+Regs8086.BX-$1000;
    MsDos(Regs8086);
    FreeCount:=((Ofs(FreePtr^)-Ofs(HeapPtr^)) DIV 8) MOD 8192;
    FreePtr:=Ptr(TmpSeg,$10000-(FreeCount*8));
    IF FreeCount>0 THEN
      Move(HeapPtr^,FreePtr^[0],FreeCount*8);
  END;

BEGIN
  LeaveHeapToDos;
  SwapVectors;
  Exec(Prog,Args);
  SwapVectors;
  RestoreHeap;
  RunProgram:=DosError;
END;

Simple example of usage:

VAR
  Result:INTEGER;
BEGIN
  Result:=RunProgram('SOMEPROG.EXE','');
END.

That's it... No warranty or guarantee that it will work (but it does on
several systems I have tried...) Use it as you like!

> 
>
>Regards Derek.


-- 
Erik Liljencrantz     | "No silly quotes!!"
d88-eli@nada.kth.se   |  Embraquel D. Tuta