* getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)

compiler/cclasses.pas

@@ -371,11 +371,11 @@ implementation
     procedure tmemdebug.start;
 {$ifdef HASGETHEAPSTATUS}
       var
-        status : THeapStatus;
+        status : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
       begin
 {$ifdef HASGETHEAPSTATUS}
-        GetHeapStatus(status);
+        status:=GetFPCHeapStatus;
         startmem:=status.CurrHeapUsed;
 {$else HASGETHEAPSTATUS}
         startmem:=memavail;
@@ -386,13 +386,13 @@ implementation
     procedure tmemdebug.stop;
 {$ifdef HASGETHEAPSTATUS}
       var
-        status : THeapStatus;
+        status : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
       begin
 {$ifdef HASGETHEAPSTATUS}
         if startmem<>0 then
          begin
-           GetHeapStatus(status);
+           status:=GetFPCHeapStatus;
            inc(TotalMem,startmem-status.CurrHeapUsed);
            startmem:=0;
          end;
@@ -2367,7 +2367,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.41  2005-02-14 17:13:06  peter
+  Revision 1.42  2005-02-28 15:38:38  marco
+   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+  Revision 1.41  2005/02/14 17:13:06  peter
     * truncate log
 
 }

compiler/comphook.pas

@@ -205,7 +205,7 @@ end;
 function def_status:boolean;
 {$ifdef HASGETHEAPSTATUS}
 var
-  hstatus : THeapStatus;
+  hstatus : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
 begin
   def_status:=false; { never stop }
@@ -218,7 +218,7 @@ begin
          if status.currentline>0 then
            Write(status.currentline,' ');
 {$ifdef HASGETHEAPSTATUS}
-         GetHeapStatus(hstatus);
+         hstatus:=GetFPCHeapStatus;
          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');
@@ -398,7 +398,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.36  2005-02-14 17:13:06  peter
+  Revision 1.37  2005-02-28 15:38:38  marco
+   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+  Revision 1.36  2005/02/14 17:13:06  peter
     * truncate log
 
   Revision 1.35  2005/01/24 18:12:17  olle

compiler/compiler.pas

@@ -367,7 +367,7 @@ function Compile(const cmd:string):longint;
 var
   starttime  : real;
 {$ifdef HASGETHEAPSTATUS}
-  hstatus : THeapStatus;
+  hstatus : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
 begin
   try
@@ -424,7 +424,7 @@ begin
   end;
 {$ifdef SHOWUSEDMEM}
   {$ifdef HASGETHEAPSTATUS}
-      GetHeapStatus(hstatus);
+      hstatus:=GetFPCHeapStatus;
       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');
@@ -441,7 +441,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.57  2005-02-15 19:15:45  peter
+  Revision 1.58  2005-02-28 15:38:38  marco
+   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+  Revision 1.57  2005/02/15 19:15:45  peter
     * Handle Control-C exception more cleanly
 
   Revision 1.56  2005/02/14 17:13:06  peter

fv/gadgets.pas

@@ -182,11 +182,11 @@ end;
 PROCEDURE THeapView.Update;
 {$ifdef HASGETHEAPSTATUS}
 var
-  status : THeapStatus;
+  status : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
 BEGIN
 {$ifdef HASGETHEAPSTATUS}
-   GetHeapStatus(status);
+   status:=GetFPCHeapStatus;
    If (OldMem <> status.CurrHeapUsed) Then Begin                 { Memory differs }
      OldMem := status.CurrHeapUsed;                              { Hold memory avail }
      DrawView;                                        { Now redraw }
@@ -316,7 +316,10 @@ END;
 END.
 {
  $Log$
- Revision 1.10  2005-02-14 17:13:18  peter
+ Revision 1.11  2005-02-28 15:38:38  marco
+  * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+ Revision 1.10  2005/02/14 17:13:18  peter
    * truncate log
 
 }

ide/fpcompil.pas

@@ -511,7 +511,7 @@ procedure TCompilerStatusDialog.Update;
 var
   StatusS,KeyS: string;
 {$ifdef HASGETHEAPSTATUS}
-  hstatus : THeapStatus;
+  hstatus : TFPCHeapStatus;
 {$endif HASGETHEAPSTATUS}
 const
   MaxFileNameSize = 46;
@@ -572,7 +572,7 @@ begin
   AddFormatParamInt(Status.CurrentLine);
   AddFormatParamInt(Status.CompiledLines);
 {$ifdef HASGETHEAPSTATUS}
-  GetHeapStatus(hstatus);
+  hstatus:=GetFPCHeapStatus;
   AddFormatParamInt(hstatus.CurrHeapUsed div 1024);
   AddFormatParamInt(hstatus.CurrHeapSize div 1024);
 {$else}
@@ -1277,7 +1277,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.36  2005-02-14 17:13:18  peter
+  Revision 1.37  2005-02-28 15:38:38  marco
+   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+  Revision 1.36  2005/02/14 17:13:18  peter
     * truncate log
 
   Revision 1.35  2005/02/10 20:57:02  peter

rtl/inc/cmem.pp

@@ -150,10 +150,19 @@ begin
   CMemSize:=pptrint(p-sizeof(ptrint))^;
 end;
 
-Procedure CGetHeapStatus(var status:THeapStatus);
+function CGetHeapStatus:THeapStatus;
+
+var res: THeapStatus;
+
+begin
+  fillchar(res,sizeof(res),0);
+  CGetHeapStatus:=res;
+end;
+
+function CGetFPCHeapStatus:TFPCHeapStatus;
 
 begin
-  fillchar(status,sizeof(status),0);
+  fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
 end;
 
 
@@ -168,6 +177,7 @@ Const
       ReallocMem : @CReAllocMem;
       MemSize : @CMemSize;
       GetHeapStatus : @CGetHeapStatus;
+      GetFPCHeapStatus: @CGetFPCHeapStatus;	
     );
 
 Var
@@ -183,7 +193,10 @@ end.
 
 {
  $Log$
- Revision 1.12  2005-02-14 17:13:22  peter
+ 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
    * truncate log
 
 }

rtl/inc/heap.inc

@@ -128,7 +128,7 @@ type
   pfreelists   = ^tfreelists;
 
 var
-  internal_status : THeapStatus;
+  internal_status : TFPCHeapStatus;
 
   freelists_fixed    : tfreelists;
   freelist_var       : pmemchunk_var;
@@ -259,24 +259,43 @@ begin
 end;
 
 
-procedure GetHeapStatus(var status:THeapStatus);
+function GetHeapStatus:THeapStatus;
 begin
   if IsMultiThread and MemoryManager.NeedLock then
    begin
      try
        MemoryMutexManager.MutexLock;
-       MemoryManager.GetHeapStatus(status);
+       result:=MemoryManager.GetHeapStatus();
      finally
        MemoryMutexManager.MutexUnlock;
      end;
    end
   else
    begin
-     MemoryManager.GetHeapStatus(status);
+     result:=MemoryManager.GetHeapStatus();
    end;
 end;
 
 
+function GetFPCHeapStatus:TFPCHeapStatus;
+begin
+  if IsMultiThread and MemoryManager.NeedLock then
+   begin
+     try
+       MemoryMutexManager.MutexLock;
+       result:=MemoryManager.GetFPCHeapStatus();
+     finally
+       MemoryMutexManager.MutexUnlock;
+     end;
+   end
+  else
+   begin
+     Result:=MemoryManager.GetFPCHeapStatus();
+   end;
+end;
+
+
+
 function MemSize(p:pointer):ptrint;
 begin
   if IsMultiThread and MemoryManager.NeedLock then
@@ -466,10 +485,26 @@ end;
                                GetHeapStatus
 *****************************************************************************}
 
-procedure SysGetHeapStatus(var status:THeapStatus);
+function SysFPCGetHeapStatus:TFPCHeapStatus;
 begin
   internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
-  status:=internal_status;
+  result:=internal_status;
+end;
+
+function SysGetHeapStatus :THeapStatus;
+
+begin
+  internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
+  result.TotalAllocated   :=internal_status.CurrHeapUsed;
+  result.TotalFree        :=internal_status.CurrHeapFree;
+  result.TotalAddrSpace   :=0;
+  result.TotalUncommitted :=0;
+  result.TotalCommitted   :=0;
+  result.FreeSmall 	  :=0;
+  result.FreeBig 	  :=0;
+  result.Unused 	  :=0;
+  result.Overhead 	  :=0;
+  result.HeapErrorCode    :=0;
 end;
 
 
@@ -1286,7 +1321,10 @@ end;
 
 {
   $Log$
-  Revision 1.43  2005-02-14 17:13:22  peter
+  Revision 1.44  2005-02-28 15:38:38  marco
+   * getFPCheapstatus  (no, FPC HEAP, not FP CHEAP!)
+
+  Revision 1.43  2005/02/14 17:13:22  peter
     * truncate log
 
   Revision 1.42  2005/01/30 11:56:29  peter

rtl/inc/heaph.inc

@@ -16,30 +16,46 @@
 
 { Memorymanager }
 type
-  THeapStatus = record
+  TFPCHeapStatus = record
     MaxHeapSize,
     MaxHeapUsed,
     CurrHeapSize,
     CurrHeapUsed,
     CurrHeapFree  : ptrint;
   end;
+  THeapStatus = record
+    TotalAddrSpace: Cardinal;
+    TotalUncommitted: Cardinal;
+    TotalCommitted: Cardinal;
+    TotalAllocated: Cardinal;
+    TotalFree: Cardinal;
+    FreeSmall: Cardinal;
+    FreeBig: Cardinal;
+    Unused: Cardinal;
+    Overhead: Cardinal;
+    HeapErrorCode: Cardinal;
+  end;
+
   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 : procedure(var status: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;
+    GetHeapStatus 	: function :THeapStatus;
+    GetFPCHeapStatus    : function :TFPCHeapStatus;
   end;
+
   TMemoryMutexManager = record
     MutexInit : procedure;
     MutexDone : procedure;
     MutexLock : procedure;
     MutexUnlock : procedure;
   end;
+
 procedure GetMemoryManager(var MemMgr: TMemoryManager);
 procedure SetMemoryManager(const MemMgr: TMemoryManager);
 function  IsMemoryManagerSet: Boolean;
@@ -61,7 +77,8 @@ 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;
-procedure SysGetHeapStatus(var status:THeapStatus);
+function  SysGetHeapStatus:THeapStatus;
+function  SysFPCGetHeapStatus:TFPCHeapStatus;
 
 { Tp7 functions }
 Procedure Getmem(Var p:pointer;Size:ptrint);
@@ -80,7 +97,8 @@ 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;
-procedure GetHeapStatus(var status:THeapStatus);
+function GetHeapStatus:THeapStatus;
+function GetFPCHeapStatus:TFPCHeapStatus;
 
 {$ifndef ValueGetmem}
 { Needed to solve overloading problem with call from assembler (PFV) }
@@ -99,7 +117,10 @@ Function  Heapsize:ptrint;
 
 {
   $Log$
-  Revision 1.13  2005-02-14 17:13:22  peter
+  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
     * truncate log
 
 }

rtl/inc/heaptrc.pp

@@ -854,14 +854,14 @@ var
   pp : pheap_mem_info;
   i : ptrint;
   ExpectedHeapFree : ptrint;
-  status : THeapStatus;
+  status : TFPCHeapStatus;
 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);
-  SysGetHeapStatus(status);
+  status:=SysFPCGetHeapStatus;
   Write(ptext^,'True heap size : ',status.CurrHeapSize);
   if EntryMemUsed > 0 then
     Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
@@ -938,9 +938,14 @@ end;
                             No specific tracing calls
 *****************************************************************************}
 
-procedure TraceGetHeapStatus(var status:THeapStatus);
+function TraceGetHeapStatus:THeapStatus;
 begin
-  SysGetHeapStatus(status);
+  TraceGetHeapStatus:=SysGetHeapStatus;
+end;
+
+function TraceGetFPCHeapStatus:TFPCHeapStatus;
+begin
+    TraceGetFPCHeapStatus:=SysFPCGetHeapStatus;
 end;
 
 
@@ -993,14 +998,15 @@ const
     ReAllocMem : @TraceReAllocMem;
     MemSize : @TraceMemSize;
     GetHeapStatus : @TraceGetHeapStatus;
+    GetFPCHeapStatus : @TraceGetFPCHeapStatus;
   );
 
 
 procedure TraceInit;
 var
-  initheapstatus : THeapStatus;
+  initheapstatus : TFPCHeapStatus;
 begin
-  SysGetHeapStatus(initheapstatus);
+  initheapstatus:=SysFPCGetHeapStatus;
   EntryMemUsed:=initheapstatus.CurrHeapUsed;
   MakeCRC32Tbl;
   SetMemoryManager(TraceManager);
@@ -1145,7 +1151,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.39  2005-02-14 17:13:22  peter
+  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
     * truncate log
 
   Revision 1.38  2005/01/21 15:56:32  peter