* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize

compiler/cclasses.pas

@@ -369,18 +369,40 @@ implementation
 
 
     procedure tmemdebug.start;
+{$ifdef HASGETHEAPSTATUS}
+      var
+        status : THeapStatus;
+{$endif HASGETHEAPSTATUS}
       begin
+{$ifdef HASGETHEAPSTATUS}
+        GetHeapStatus(status);
+        startmem:=status.CurrHeapUsed;
+{$else HASGETHEAPSTATUS}
         startmem:=memavail;
+{$endif HASGETHEAPSTATUS}
       end;
 
 
     procedure tmemdebug.stop;
+{$ifdef HASGETHEAPSTATUS}
+      var
+        status : THeapStatus;
+{$endif HASGETHEAPSTATUS}
       begin
+{$ifdef HASGETHEAPSTATUS}
+        if startmem<>0 then
+         begin
+           GetHeapStatus(status);
+           inc(TotalMem,startmem-status.CurrHeapUsed);
+           startmem:=0;
+         end;
+{$else HASGETHEAPSTATUS}
         if startmem<>0 then
          begin
            inc(TotalMem,memavail-startmem);
            startmem:=0;
          end;
+{$endif HASGETHEAPSTATUS}
       end;
 
 
@@ -2345,7 +2367,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.39  2004-11-15 23:35:30  peter
+  Revision 1.40  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.39  2004/11/15 23:35:30  peter
     * tparaitem removed, use tparavarsym instead
     * parameter order is now calculated from paranr value in tparavarsym
 

compiler/comphook.pas

@@ -203,19 +203,27 @@ end;
 
 
 function def_status:boolean;
+{$ifdef HASGETHEAPSTATUS}
+var
+  hstatus : THeapStatus;
+{$endif HASGETHEAPSTATUS}
 begin
   def_status:=false; { never stop }
 { Status info?, Called every line }
   if ((status.verbosity and V_Status)<>0) then
    begin
-     if (status.compiledlines=1) then
-       WriteLn(memavail shr 10,' Kb Free');
-     if (status.currentline>0) and (status.currentline mod 100=0) then
-{$ifdef FPC}
-       WriteLn(status.currentline,' ',DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
-{$else}
-       WriteLn(status.currentline,' ',DStr(memavail shr 10),' Kb Free');
-{$endif}
+     if (status.compiledlines=1) or
+        (status.currentline mod 100=0) then
+       begin
+         if status.currentline>0 then
+	   Write(status.currentline,' ');
+{$ifdef HASGETHEAPSTATUS}
+         GetHeapStatus(hstatus);
+         WriteLn(DStr(hstatus.CurrHeapUsed shr 10),'/',DStr(hstatus.CurrHeapSize shr 10),' Kb Used');
+{$else HASGETHEAPSTATUS}
+         WriteLn(DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
+{$endif HASGETHEAPSTATUS}
+       end;
    end
 end;
 
@@ -378,7 +386,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.31  2004-10-15 09:14:16  mazen
+  Revision 1.32  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.31  2004/10/15 09:14:16  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/compiler.pas

@@ -375,6 +375,9 @@ var
 {$ifdef USEEXCEPT}
   recoverpos : jmp_buf;
 {$endif}
+{$ifdef HASGETHEAPSTATUS}
+  hstatus : THeapStatus;
+{$endif HASGETHEAPSTATUS}
 begin
   olddo_stop:=do_stop;
   do_stop:=@minimal_stop;
@@ -430,7 +433,12 @@ begin
 
   DoneVerbose;
 {$ifdef SHOWUSEDMEM}
-  Writeln('Memory used (heapsize): ',DStr(system.Heapsize shr 10),' Kb');
+  {$ifdef HASGETHEAPSTATUS}
+    GetHeapStatus(hstatus);
+    Writeln('Max Memory used/heapsize: ',DStr(hstatus.MaxHeapUsed shr 10),'/',DStr(hstatus.MaxHeapSize shr 10),' Kb');
+  {$else HASGETHEAPSTATUS}
+    Writeln('Memory used (heapsize): ',DStr(system.Heapsize shr 10),' Kb');
+  {$endif HASGETHEAPSTATUS}
 {$endif SHOWUSEDMEM}
 {$ifdef fixLeaksOnError}
   do_stop;
@@ -440,7 +448,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.49  2004-10-15 09:14:16  mazen
+  Revision 1.50  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.49  2004/10/15 09:14:16  mazen
   - remove $IFDEF DELPHI and related code
   - remove $IFDEF FPCPROCVAR and related code
 

compiler/options.pas

@@ -1750,6 +1750,7 @@ begin
   def_symbol('STR_USES_VALINT');
   def_symbol('NOSAVEREGISTERS');
   def_symbol('SHORTSTRCOMPAREINREG');
+  def_symbol('HASGETHEAPSTATUS');
 
 { using a case is pretty useless here (FK) }
 { some stuff for TP compatibility }
@@ -2090,7 +2091,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.153  2004-11-17 22:21:35  peter
+  Revision 1.154  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.153  2004/11/17 22:21:35  peter
   mangledname setting moved to place after the complete proc declaration is read
   import generation moved to place where body is also parsed (still gives problems with win32)
 

ide/fpcompil.pas

@@ -509,6 +509,9 @@ end;
 procedure TCompilerStatusDialog.Update;
 var
   StatusS,KeyS: string;
+{$ifdef HASGETHEAPSTATUS}  
+  hstatus : THeapStatus;
+{$endif HASGETHEAPSTATUS}  
 const
   MaxFileNameSize = 46;
 begin
@@ -567,8 +570,14 @@ begin
   AddFormatParamStr(KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)));
   AddFormatParamInt(Status.CurrentLine);
   AddFormatParamInt(Status.CompiledLines);
+{$ifdef HASGETHEAPSTATUS}  
+  GetHeapStatus(hstatus);
+  AddFormatParamInt(hstatus.CurrHeapUsed div 1024);
+  AddFormatParamInt(hstatus.CurrHeapSize div 1024);
+{$else}
   AddFormatParamInt((Heapsize-MemAvail) div 1024);
   AddFormatParamInt(Heapsize div 1024);
+{$endif}  
   AddFormatParamInt(Status.ErrorCount);
   ST^.SetText(
    FormatStrF(
@@ -1256,7 +1265,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.32  2004-11-20 14:21:19  florian
+  Revision 1.33  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.32  2004/11/20 14:21:19  florian
     * implemented reload menu item
     * increased file history to 9 files
 

rtl/inc/cmem.pp

@@ -150,22 +150,10 @@ begin
   CMemSize:=pptrint(p-sizeof(ptrint))^;
 end;
 
-Function CMemAvail : ptrint;
+Procedure CGetHeapStatus(var status:THeapStatus);
 
 begin
-  CMemAvail:=0;
-end;
-
-Function CMaxAvail: ptrint;
-
-begin
-  CMaxAvail:=0;
-end;
-
-Function CHeapSize : ptrint;
-
-begin
-  CHeapSize:=0;
+  fillchar(status,sizeof(status),0);
 end;
 
 
@@ -179,9 +167,7 @@ Const
       AllocMem : @CAllocMem;
       ReallocMem : @CReAllocMem;
       MemSize : @CMemSize;
-      MemAvail : @CMemAvail;
-      MaxAvail : @CMaxAvail;
-      HeapSize : @CHeapSize;
+      GetHeapStatus : @CGetHeapStatus;
     );
 
 Var
@@ -197,7 +183,10 @@ end.
 
 {
  $Log$
- Revision 1.10  2004-11-21 21:14:14  peter
+ Revision 1.11  2004-11-22 19:34:58  peter
+   * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+ Revision 1.10  2004/11/21 21:14:14  peter
    * Freemem(p,0) does nothing
 
  Revision 1.9  2004/09/19 19:04:11  olle

rtl/inc/heap.inc

@@ -70,9 +70,7 @@ const
     AllocMem: @SysAllocMem;
     ReAllocMem: @SysReAllocMem;
     MemSize: @SysMemSize;
-    MemAvail: @SysMemAvail;
-    MaxAvail: @SysMaxAvail;
-    HeapSize: @SysHeapSize;
+    GetHeapStatus: @GetHeapStatus;
   );
 
   MemoryMutexManager: TMemoryMutexManager = (
@@ -130,8 +128,8 @@ type
   pfreelists   = ^tfreelists;
 
 var
-  internal_memavail  : ptrint;
-  internal_heapsize  : ptrint;
+  internal_status : THeapStatus;
+
   freelists_fixed    : tfreelists;
   freelist_var       : pmemchunk_var;
   freeoslist         : poschunk;
@@ -254,62 +252,27 @@ begin
    end;
 end;
 
+
 procedure FreeMemory(p:pointer;Size:ptrint);
 begin
   FreeMem(p,size);
 end;
 
-function MaxAvail:ptrint;
-begin
-  if IsMultiThread and MemoryManager.NeedLock then
-   begin
-     try
-       MemoryMutexManager.MutexLock;
-       MaxAvail := MemoryManager.MaxAvail();
-     finally
-       MemoryMutexManager.MutexUnlock;
-     end;
-   end
-  else
-   begin
-     MaxAvail := MemoryManager.MaxAvail();
-   end;
-end;
-
-
-function MemAvail:ptrint;
-begin
-  if IsMultiThread and MemoryManager.NeedLock then
-   begin
-     try
-       MemoryMutexManager.MutexLock;
-       MemAvail := MemoryManager.MemAvail();
-     finally
-       MemoryMutexManager.MutexUnlock;
-     end;
-   end
-  else
-   begin
-     MemAvail := MemoryManager.MemAvail();
-   end;
-end;
-
 
-{ FPC Additions }
-function HeapSize:ptrint;
+procedure GetHeapStatus(var status:THeapStatus);
 begin
   if IsMultiThread and MemoryManager.NeedLock then
    begin
      try
        MemoryMutexManager.MutexLock;
-       HeapSize := MemoryManager.HeapSize();
+       MemoryManager.GetHeapStatus(status);
      finally
        MemoryMutexManager.MutexUnlock;
      end;
    end
   else
    begin
-     HeapSize := MemoryManager.HeapSize();
+     MemoryManager.GetHeapStatus(status);
    end;
 end;
 
@@ -483,47 +446,34 @@ end;
 {$endif ValueFreemem}
 
 
-{*****************************************************************************
-                         Heapsize,Memavail,MaxAvail
-*****************************************************************************}
-
-function SysHeapsize : ptrint;
+{ Bootstrapping }
+{$ifndef HASGETHEAPSTATUS}
+Function  Memavail:ptrint;
 begin
-  Sysheapsize := internal_heapsize;
-end;
-
-
-function SysMemavail : ptrint;
+  result:=0;
+end;  
+Function  Maxavail:ptrint;
 begin
-  Sysmemavail := internal_memavail;
-end;
+  result:=0;
+end;  
+Function  Heapsize:ptrint;
+begin
+  result:=0;
+end;  
+{$endif HASGETHEAPSTATUS}
 
+{*****************************************************************************
+                               GetHeapStatus
+*****************************************************************************}
 
-function SysMaxavail: ptrint;
-var
-  pmc : pmemchunk_var;
-  i: longint;
+procedure SysGetHeapStatus(var status:THeapStatus);
 begin
-  pmc := freelist_var;
-  sysmaxavail := 0;
-  while assigned(pmc) do
-    begin
-      if pmc^.size>sysmaxavail then
-        sysmaxavail := pmc^.size;
-      pmc := pmc^.next_var;
-    end;
-  if sysmaxavail = 0 then
-    begin
-      for i := maxblockindex downto 1 do
-        if assigned(freelists_fixed[i]) then
-          begin
-            sysmaxavail := i shl blockshr;
-            exit;
-          end;
-    end;
+  internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+  status:=internal_status;
 end;
 
 
+
 {$ifdef DUMPBLOCKS}   // TODO
 procedure DumpBlocks;
 var
@@ -626,8 +576,7 @@ begin
 {$ifdef HAS_SYSOSFREE}
   if freeoslistcount >= 3 then
     begin
-      dec(internal_heapsize, poc^.size);
-      dec(internal_memavail, poc^.size);
+      dec(internal_status.currheapsize, poc^.size);
       SysOSFree(poc, poc^.size);
     end
   else
@@ -841,8 +790,9 @@ begin
         end;
     end;
     { set the total new heap size }
-    inc(internal_memavail,size);
-    inc(internal_heapsize,size);
+    inc(internal_status.currheapsize,size);
+    if internal_status.currheapsize>internal_status.maxheapsize then
+      internal_status.maxheapsize:=internal_status.currheapsize;
   end;
   { initialize os-block }
   poschunk(result)^.used := 0;
@@ -1008,7 +958,9 @@ begin
       size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
       sysgetmem := sysgetmem_var(size);
     end;
-  dec(internal_memavail,size);
+  inc(internal_status.currheapused,size);
+  if internal_status.currheapused>internal_status.maxheapused then
+    internal_status.maxheapused:=internal_status.currheapused;
 end;
 
 
@@ -1025,7 +977,7 @@ begin
   pcurrsize := pcurr^.size and fixedsizemask;
   if size<>pcurrsize then
    HandleError(204);
-  inc(internal_memavail,pcurrsize);
+  dec(internal_status.currheapused,pcurrsize);
   { insert the block in it's freelist }
   pcurr^.size := pcurr^.size and (not usedflag);
   blockindex := pcurrsize shr blockshr;
@@ -1054,7 +1006,7 @@ begin
   pcurrsize := pcurr^.size and sizemask;
   if size<>pcurrsize then
     HandleError(204);
-  inc(internal_memavail,pcurrsize);
+  inc(internal_status.currheapused,pcurrsize);
   { insert the block in it's freelist }
   pcurr^.size := pcurr^.size and (not usedflag);
   append_to_list_var(pcurr);
@@ -1226,7 +1178,7 @@ begin
     split_block(pcurr, size);
     SysTryResizeMem := true;
    end;
-  dec(internal_memavail,size-oldsize);
+  inc(internal_status.currheapused,size-oldsize);
 {$ifdef TestFreeLists}
   if test_each then
     TestFreeLists;
@@ -1273,21 +1225,6 @@ begin
 end;
 
 
-{*****************************************************************************
-                                Mark/Release
-*****************************************************************************}
-
-procedure release(var p : pointer);
-begin
-end;
-
-
-procedure mark(var p : pointer);
-begin
-end;
-
-
-
 {*****************************************************************************
                        MemoryMutexManager default hooks
 *****************************************************************************}
@@ -1329,13 +1266,15 @@ begin
   freelist_var := nil;
   freeoslist := nil;
   freeoslistcount := 0;
-  internal_heapsize := 0;
-  internal_memavail := 0;
+  fillchar(internal_status,sizeof(internal_status),0);
 end;
 
 {
   $Log$
-  Revision 1.37  2004-10-25 15:38:59  peter
+  Revision 1.38  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.37  2004/10/25 15:38:59  peter
     * compiler defined HEAP and HEAPSIZE removed
 
   Revision 1.36  2004/08/10 18:58:36  jonas

rtl/inc/heaph.inc

@@ -16,6 +16,13 @@
 
 { Memorymanager }
 type
+  THeapStatus = record
+    MaxHeapSize,
+    MaxHeapUsed,
+    CurrHeapSize,
+    CurrHeapUsed,
+    CurrHeapFree  : ptrint;
+  end;
   PMemoryManager = ^TMemoryManager;
   TMemoryManager = record
     NeedLock    : boolean;
@@ -25,9 +32,7 @@ type
     AllocMem    : Function(Size:ptrint):Pointer;
     ReAllocMem  : Function(var p:pointer;Size:ptrint):Pointer;
     MemSize     : function(p:pointer):ptrint;
-    MemAvail    : Function:ptrint;
-    MaxAvail    : Function:ptrint;
-    HeapSize    : Function:ptrint;
+    GetHeapStatus : procedure(var status:THeapStatus);
   end;
   TMemoryMutexManager = record
     MutexInit : procedure;
@@ -56,21 +61,16 @@ Function  SysMemSize(p:pointer):ptrint;
 Function  SysAllocMem(size:ptrint):Pointer;
 function  SysTryResizeMem(var p:pointer;size : ptrint):boolean;
 Function  SysReAllocMem(var p:pointer;size:ptrint):Pointer;
-Function  Sysmemavail:ptrint;
-Function  Sysmaxavail:ptrint;
-Function  Sysheapsize:ptrint;
+procedure SysGetHeapStatus(var status:THeapStatus);
 
 { Tp7 functions }
 Procedure Getmem(Var p:pointer;Size:ptrint);
 Procedure Getmemory(Var p:pointer;Size:ptrint);
 Procedure Freemem(p:pointer;Size:ptrint);
 Procedure Freememory(p:pointer;Size:ptrint);
-Function  memavail:ptrint;
-Function  maxavail:ptrint;
 
 { FPC additions }
 Function  MemSize(p:pointer):ptrint;
-Function  heapsize:ptrint;
 
 { Delphi functions }
 function GetMem(size:ptrint):pointer;
@@ -80,10 +80,7 @@ function Freememory(p:pointer):ptrint;
 function AllocMem(Size:ptrint):pointer;
 function ReAllocMem(var p:pointer;Size:ptrint):pointer;
 function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
-
-{ Do nothing functions, are only here for tp7 compat }
-Procedure mark(var p : pointer);
-Procedure release(var p : pointer);
+procedure GetHeapStatus(var status:THeapStatus);
 
 {$ifndef ValueGetmem}
 { Needed to solve overloading problem with call from assembler (PFV) }
@@ -93,9 +90,19 @@ Procedure AsmGetmem(var p:pointer;size:ptrint);
 Procedure AsmFreemem(var p:pointer);
 {$endif ValueFreemem}
 
+{ Bootstrapping }
+{$ifndef HASGETHEAPSTATUS}
+Function  Memavail:ptrint;
+Function  Maxavail:ptrint;
+Function  Heapsize:ptrint;
+{$endif HASGETHEAPSTATUS}
+
 {
   $Log$
-  Revision 1.11  2004-06-29 20:50:32  peter
+  Revision 1.12  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.11  2004/06/29 20:50:32  peter
     * readded support for ReturnIfGrowHeapFails
 
   Revision 1.10  2004/06/20 09:24:40  peter

rtl/inc/heaptrc.pp

@@ -852,23 +852,25 @@ procedure dumpheap;
 var
   pp : pheap_mem_info;
   i : ptrint;
-  ExpectedMemAvail : ptrint;
+  ExpectedHeapFree : ptrint;
+  status : THeapStatus;
 begin
   pp:=heap_mem_root;
   Writeln(ptext^,'Heap dump by heaptrc unit');
   Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
   Writeln(ptext^,freemem_cnt,' memory blocks freed     : ',freemem_size,'/',freemem8_size);
   Writeln(ptext^,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size);
-  Write(ptext^,'True heap size : ',system.HeapSize);
+  SysGetHeapStatus(status);
+  Write(ptext^,'True heap size : ',status.CurrHeapSize);
   if EntryMemUsed > 0 then
     Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
   else
     Writeln(ptext^);
-  Writeln(ptext^,'True free heap : ',MemAvail);
-  ExpectedMemAvail:=system.HeapSize-(getmem8_size-freemem8_size)-
+  Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
+  ExpectedHeapFree:=status.CurrHeapSize-(getmem8_size-freemem8_size)-
     (getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
-  If ExpectedMemAvail<>MemAvail then
-    Writeln(ptext^,'Should be : ',ExpectedMemAvail);
+  If ExpectedHeapFree<>status.CurrHeapFree then
+    Writeln(ptext^,'Should be : ',ExpectedHeapFree);
   i:=getmem_cnt-freemem_cnt;
   while pp<>nil do
    begin
@@ -935,19 +937,9 @@ end;
                             No specific tracing calls
 *****************************************************************************}
 
-function TraceMemAvail:ptrint;
+procedure TraceGetHeapStatus(var status:THeapStatus);
 begin
-  TraceMemAvail:=SysMemAvail;
-end;
-
-function TraceMaxAvail:ptrint;
-begin
-  TraceMaxAvail:=SysMaxAvail;
-end;
-
-function TraceHeapSize:ptrint;
-begin
-  TraceHeapSize:=SysHeapSize;
+  SysGetHeapStatus(status);
 end;
 
 
@@ -999,15 +991,16 @@ const
     AllocMem : @TraceAllocMem;
     ReAllocMem : @TraceReAllocMem;
     MemSize : @TraceMemSize;
-    MemAvail : @TraceMemAvail;
-    MaxAvail : @TraceMaxAvail;
-    HeapSize : @TraceHeapsize;
+    GetHeapStatus : @TraceGetHeapStatus;
   );
 
 
 procedure TraceInit;
+var
+  initheapstatus : THeapStatus;
 begin
-  EntryMemUsed:=System.HeapSize-MemAvail;
+  SysGetHeapStatus(initheapstatus);
+  EntryMemUsed:=initheapstatus.CurrHeapUsed;
   MakeCRC32Tbl;
   SetMemoryManager(TraceManager);
   ptext:=@stderr;
@@ -1151,7 +1144,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.36  2004-10-25 17:04:07  peter
+  Revision 1.37  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.36  2004/10/25 17:04:07  peter
     * fix for non-i386
 
   Revision 1.35  2004/10/25 15:38:59  peter

rtl/inc/objects.pp

@@ -1860,7 +1860,7 @@ END;
 {---------------------------------------------------------------------------}
 FUNCTION TMemoryStream.ChangeListSize (ALimit: Longint): Boolean;
 VAR
-  I, W: Longint;
+  W: Longint;
   Li: LongInt;
   P: PPointerArray;
 BEGIN
@@ -1869,14 +1869,8 @@ BEGIN
      If (ALimit > MaxPtrs) Then Exit;                 { To many blocks req }
      If (ALimit <> 0) Then Begin                      { Create segment list }
        Li := ALimit * SizeOf(Pointer);                { Block array size }
-       If (MaxAvail > Li) Then Begin
-         GetMem(P, Li);                               { Allocate memory }
-         FillChar(P^, Li, #0);                        { Clear the memory }
-       End Else Begin
-         GetMem(P,Li);
-         If P = Nil Then Exit;
-         FillChar(P^, Li, #0);                        { Clear the memory }
-       End;                           { Insufficient memory }
+       GetMem(P, Li);                               { Allocate memory }
+       FillChar(P^, Li, #0);                        { Clear the memory }
        If (BlkCount <> 0) AND (BlkList <> Nil) Then   { Current list valid }
          If (BlkCount <= ALimit) Then Move(BlkList^,
            P^, BlkCount * SizeOf(Pointer)) Else       { Move whole old list }
@@ -1887,15 +1881,7 @@ BEGIN
          FreeMem(BlkList^[W], BlkSize);               { Release memory block }
      If (P <> Nil) AND (ALimit > BlkCount) Then Begin { Expand stream size }
        For W := BlkCount To ALimit-1 Do Begin
-         If (MaxAvail < BlkSize) Then Begin           { Check enough memory }
-           GetMem(P^[W],BlkSize);
-           If P = Nil Then Begin
-             For I := BlkCount To W-1 Do
-               FreeMem(P^[I], BlkSize);                 { Free mem allocated }
-             FreeMem(P, Li);                            { Release memory }
-             Exit;
-           End                      { Now exit }
-         End Else GetMem(P^[W], BlkSize);             { Allocate memory }
+         GetMem(P^[W], BlkSize);             { Allocate memory }
        End;
      End;
      If (BlkCount <> 0) AND (BlkList<>Nil) Then
@@ -3019,7 +3005,10 @@ BEGIN
 END.
 {
   $Log$
-  Revision 1.35  2004-11-02 23:53:19  peter
+  Revision 1.36  2004-11-22 19:34:58  peter
+    * GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
+
+  Revision 1.35  2004/11/02 23:53:19  peter
     * fixed crashes with ide and 1.9.x
 
   Revision 1.34  2004/10/03 17:43:47  florian