* fix getheapstatus bootstrapping

rtl/inc/cmem.pp

@@ -150,6 +150,7 @@ begin
   CMemSize:=pptrint(p-sizeof(ptrint))^;
 end;
 
+{$ifdef HASGETFPCHEAPSTATUS}  
 function CGetHeapStatus:THeapStatus;
 
 var res: THeapStatus;
@@ -164,6 +165,13 @@ function CGetFPCHeapStatus:TFPCHeapStatus;
 begin
   fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
 end;
+{$else HASGETFPCHEAPSTATUS}  
+Procedure CGetHeapStatus(var status:THeapStatus);
+
+begin
+  fillchar(status,sizeof(status),0);
+end;
+{$endif HASGETFPCHEAPSTATUS}  
 
 
 Const
@@ -177,7 +185,9 @@ Const
       ReallocMem : @CReAllocMem;
       MemSize : @CMemSize;
       GetHeapStatus : @CGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}  
       GetFPCHeapStatus: @CGetFPCHeapStatus;	
+{$endif HASGETFPCHEAPSTATUS}  
     );
 
 Var
@@ -193,7 +203,10 @@ end.
 
 {
  $Log$
- Revision 1.13  2005-02-28 15:38:38  marco
+ Revision 1.14  2005-03-04 16:49:34  peter
+   * fix getheapstatus bootstrapping
+
+ Revision 1.13  2005/02/28 15:38:38  marco
   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
 
  Revision 1.12  2005/02/14 17:13:22  peter

rtl/inc/heap.inc

@@ -71,7 +71,9 @@ const
     ReAllocMem: @SysReAllocMem;
     MemSize: @SysMemSize;
     GetHeapStatus: @SysGetHeapStatus;
-    GetFPCHeapStatus: @SysFPCGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}
+    GetFPCHeapStatus: @SysGetFPCHeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
   );
 
   MemoryMutexManager: TMemoryMutexManager = (
@@ -129,7 +131,11 @@ type
   pfreelists   = ^tfreelists;
 
 var
+{$ifdef HASGETFPCHEAPSTATUS}
   internal_status : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+  internal_status : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}
 
   freelists_fixed    : tfreelists;
   freelist_var       : pmemchunk_var;
@@ -260,6 +266,7 @@ begin
 end;
 
 
+{$ifdef HASGETFPCHEAPSTATUS}
 function GetHeapStatus:THeapStatus;
 begin
   if IsMultiThread and MemoryManager.NeedLock then
@@ -294,6 +301,24 @@ begin
      Result:=MemoryManager.GetFPCHeapStatus();
    end;
 end;
+{$else HASGETFPCHEAPSTATUS}
+procedure GetHeapStatus(var status:THeapStatus);
+begin
+  if IsMultiThread and MemoryManager.NeedLock then
+   begin
+     try
+       MemoryMutexManager.MutexLock;
+       MemoryManager.GetHeapStatus(status);
+     finally
+       MemoryMutexManager.MutexUnlock;
+     end;
+   end
+  else
+   begin
+     MemoryManager.GetHeapStatus(status);
+   end;
+end;
+{$endif HASGETFPCHEAPSTATUS}
 
 
 
@@ -486,7 +511,8 @@ end;
                                GetHeapStatus
 *****************************************************************************}
 
-function SysFPCGetHeapStatus:TFPCHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}
+function SysGetFPCHeapStatus:TFPCHeapStatus;
 begin
   internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
   result:=internal_status;
@@ -501,12 +527,19 @@ begin
   result.TotalAddrSpace   :=0;
   result.TotalUncommitted :=0;
   result.TotalCommitted   :=0;
-  result.FreeSmall 	  :=0;
-  result.FreeBig 	  :=0;
-  result.Unused 	  :=0;
-  result.Overhead 	  :=0;
+  result.FreeSmall        :=0;
+  result.FreeBig          :=0;
+  result.Unused           :=0;
+  result.Overhead         :=0;
   result.HeapErrorCode    :=0;
 end;
+{$else}
+procedure SysGetHeapStatus(var status:THeapStatus);
+begin
+  internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+  status:=internal_status;
+end;
+{$endif HASGETFPCHEAPSTATUS}
 
 
 
@@ -1322,7 +1355,10 @@ end;
 
 {
   $Log$
-  Revision 1.46  2005-03-02 14:25:19  marco
+  Revision 1.47  2005-03-04 16:49:34  peter
+    * fix getheapstatus bootstrapping
+
+  Revision 1.46  2005/03/02 14:25:19  marco
    * small typo fix on last commit
 
   Revision 1.45  2005/03/02 10:46:10  marco

rtl/inc/heaph.inc

@@ -16,6 +16,7 @@
 
 { Memorymanager }
 type
+{$ifdef HASGETFPCHEAPSTATUS}
   TFPCHeapStatus = record
     MaxHeapSize,
     MaxHeapUsed,
@@ -35,18 +36,31 @@ type
     Overhead: Cardinal;
     HeapErrorCode: Cardinal;
   end;
+{$else HASGETFPCHEAPSTATUS}
+  THeapStatus = record
+    MaxHeapSize,
+    MaxHeapUsed,
+    CurrHeapSize,
+    CurrHeapUsed,
+    CurrHeapFree  : ptrint;
+  end;
+{$endif HASGETFPCHEAPSTATUS}
 
   PMemoryManager = ^TMemoryManager;
   TMemoryManager = record
-    NeedLock    	: boolean;
-    Getmem      	: Function(Size:ptrint):Pointer;
-    Freemem     	: Function(p:pointer):ptrint;
-    FreememSize 	: Function(p:pointer;Size:ptrint):ptrint;
-    AllocMem   	 	: Function(Size:ptrint):Pointer;
-    ReAllocMem  	: Function(var p:pointer;Size:ptrint):Pointer;
-    MemSize     	: function(p:pointer):ptrint;
-    GetHeapStatus 	: function :THeapStatus;
+    NeedLock            : boolean;
+    Getmem              : Function(Size:ptrint):Pointer;
+    Freemem             : Function(p:pointer):ptrint;
+    FreememSize         : Function(p:pointer;Size:ptrint):ptrint;
+    AllocMem            : Function(Size:ptrint):Pointer;
+    ReAllocMem          : Function(var p:pointer;Size:ptrint):Pointer;
+    MemSize             : function(p:pointer):ptrint;
+{$ifdef HASGETFPCHEAPSTATUS}
+    GetHeapStatus       : function :THeapStatus;
     GetFPCHeapStatus    : function :TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}
+    GetHeapStatus : procedure(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
   end;
 
   TMemoryMutexManager = record
@@ -77,8 +91,12 @@ 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;
+{$ifdef HASGETFPCHEAPSTATUS}
 function  SysGetHeapStatus:THeapStatus;
-function  SysFPCGetHeapStatus:TFPCHeapStatus;
+function  SysGetFPCHeapStatus:TFPCHeapStatus;
+{$else}
+procedure SysGetHeapStatus(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
 
 { Tp7 functions }
 Procedure Getmem(Var p:pointer;Size:ptrint);
@@ -97,8 +115,12 @@ 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;
+{$ifdef HASGETFPCHEAPSTATUS}
 function GetHeapStatus:THeapStatus;
 function GetFPCHeapStatus:TFPCHeapStatus;
+{$else}
+procedure GetHeapStatus(var status:THeapStatus);
+{$endif HASGETFPCHEAPSTATUS}
 
 {$ifndef ValueGetmem}
 { Needed to solve overloading problem with call from assembler (PFV) }
@@ -117,7 +139,10 @@ Function  Heapsize:ptrint;
 
 {
   $Log$
-  Revision 1.14  2005-02-28 15:38:38  marco
+  Revision 1.15  2005-03-04 16:49:34  peter
+    * fix getheapstatus bootstrapping
+
+  Revision 1.14  2005/02/28 15:38:38  marco
    * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
 
   Revision 1.13  2005/02/14 17:13:22  peter

rtl/inc/heaptrc.pp

@@ -854,14 +854,22 @@ var
   pp : pheap_mem_info;
   i : ptrint;
   ExpectedHeapFree : ptrint;
+{$ifdef HASGETFPCHEAPSTATUS}  
   status : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}  
+  status : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}  
 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);
-  status:=SysFPCGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}  
+  status:=SysGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}  
+  SysGetHeapStatus(status);
+{$endif HASGETFPCHEAPSTATUS}  
   Write(ptext^,'True heap size : ',status.CurrHeapSize);
   if EntryMemUsed > 0 then
     Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
@@ -938,6 +946,7 @@ end;
                             No specific tracing calls
 *****************************************************************************}
 
+{$ifdef HASGETFPCHEAPSTATUS}  
 function TraceGetHeapStatus:THeapStatus;
 begin
   TraceGetHeapStatus:=SysGetHeapStatus;
@@ -945,8 +954,14 @@ end;
 
 function TraceGetFPCHeapStatus:TFPCHeapStatus;
 begin
-    TraceGetFPCHeapStatus:=SysFPCGetHeapStatus;
+    TraceGetFPCHeapStatus:=SysGetFPCHeapStatus;
 end;
+{$else HASGETFPCHEAPSTATUS}  
+procedure TraceGetHeapStatus(var status:THeapStatus);
+begin
+  SysGetHeapStatus(status);
+end;
+{$endif HASGETFPCHEAPSTATUS}  
 
 
 {*****************************************************************************
@@ -997,16 +1012,28 @@ const
     AllocMem : @TraceAllocMem;
     ReAllocMem : @TraceReAllocMem;
     MemSize : @TraceMemSize;
+{$ifdef HASGETFPCHEAPSTATUS}  
     GetHeapStatus : @TraceGetHeapStatus;
     GetFPCHeapStatus : @TraceGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}  
+    GetHeapStatus : @TraceGetHeapStatus;
+{$endif HASGETFPCHEAPSTATUS}  
   );
 
 
 procedure TraceInit;
 var
+{$ifdef HASGETFPCHEAPSTATUS}  
   initheapstatus : TFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}  
+  initheapstatus : THeapStatus;
+{$endif HASGETFPCHEAPSTATUS}  
 begin
-  initheapstatus:=SysFPCGetHeapStatus;
+{$ifdef HASGETFPCHEAPSTATUS}  
+  initheapstatus:=SysGetFPCHeapStatus;
+{$else HASGETFPCHEAPSTATUS}  
+  SysGetHeapStatus(initheapstatus);
+{$endif HASGETFPCHEAPSTATUS}  
   EntryMemUsed:=initheapstatus.CurrHeapUsed;
   MakeCRC32Tbl;
   SetMemoryManager(TraceManager);
@@ -1151,7 +1178,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.40  2005-02-28 15:38:38  marco
+  Revision 1.41  2005-03-04 16:49:34  peter
+    * fix getheapstatus bootstrapping
+
+  Revision 1.40  2005/02/28 15:38:38  marco
    * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
 
   Revision 1.39  2005/02/14 17:13:22  peter