+ new heap manager supporting delphi freemem(pointer)

rtl/i386/i386.inc

@@ -254,12 +254,10 @@ asm
         { get vmt address in eax }
         movl    (%esi,%edi,1),%eax
         movl    %esi,12(%ebp)
-        { push object size }
-        pushl   (%eax)
         { push object position }
         leal    12(%ebp),%eax
         pushl   %eax
-        call    FreeMem
+        call    AsmFreeMem
         { set both object places to zero }
         xorl    %esi,%esi
         movl    %esi,12(%ebp)
@@ -293,12 +291,10 @@ asm
       { temporary Variable }
         subl    $4,%esp
         movl    %esp,%edi
-      { And put size on the Stack }
-        pushl   (%ebx)
       { SELF }
         movl    %eax,(%edi)
         pushl   %edi
-        call    FreeMem
+        call    AsmFreeMem
         addl    $4,%esp
 .LHD_3:
         popal
@@ -873,7 +869,10 @@ end;
 
 {
   $Log$
-  Revision 1.54  1999-09-15 13:04:04  jonas
+  Revision 1.55  1999-09-17 17:14:11  peter
+    + new heap manager supporting delphi freemem(pointer)
+
+  Revision 1.54  1999/09/15 13:04:04  jonas
     * added dummy local var to boundcheck to force stackframe generation
 
   Revision 1.53  1999/08/19 12:50:08  pierre

rtl/inc/heaph.inc

@@ -19,25 +19,32 @@ type
   PMemoryManager = ^TMemoryManager;
   TMemoryManager = record
     Getmem  : procedure(Var p:pointer;Size:Longint);
-    Freemem : procedure(Var p:pointer;Size:Longint);
+    Freemem : procedure(Var p:pointer);
+    FreememSize : procedure(Var p:pointer;Size:Longint);
+    MemSize : function(p:pointer):Longint;
   end;
 procedure GetMemoryManager(var MemMgr: TMemoryManager);
 procedure SetMemoryManager(const MemMgr: TMemoryManager);
 function  IsMemoryManagerSet: Boolean;
 
 Procedure SysGetmem(Var p:pointer;Size:Longint);
-Procedure SysFreemem(Var p:pointer;Size:Longint);
+Procedure SysFreemem(Var p:pointer);
+Procedure SysFreememSize(Var p:pointer;Size:Longint);
+Function  SysMemSize(p:pointer):Longint;
 
 { Variables }
 const
-  heapblocks    : boolean=true;
   growheapsize1 : longint=256*1024;  { < 256k will grow with 256k }
   growheapsize2 : longint=1024*1024; { > 256k will grow with 1m }
 var
   heaporg,heapptr,heapend,heaperror,freelist : pointer;
 
-{ Basic (TP7) functions }
+{ Needed to some overloading problem with call from assembler (PFV) }
+Procedure AsmFreemem(Var p:pointer);
+
+{ Basic (TP7,Delphi) functions }
 Procedure getmem(Var p:pointer;Size:Longint);
+Procedure freemem(Var p:pointer);
 Procedure freemem(Var p:pointer;Size:Longint);
 Function  memavail:Longint;
 Function  maxavail:Longint;
@@ -46,26 +53,13 @@ Procedure release(var p : pointer);
 
 { Fpc Functions }
 Function  heapsize : longint;
-Procedure markheap(var oldfreelist,oldheapptr : pointer);
-Procedure releaseheap(oldfreelist,oldheapptr : pointer);
-
-{$ifdef TEMPHEAP}
-{ Temp Heap Functions }
-  const
-    allow_special : boolean =true;
-
-  Procedure split_heap;
-  Procedure unsplit_heap;
-  Procedure switch_to_base_heap;
-  Procedure switch_to_temp_heap;
-  Procedure switch_heap;
-  Procedure releasetempheap;
-  Procedure gettempmem(var p : pointer;size : longint);
-{$endif TEMPHEAP}
 
 {
   $Log$
-  Revision 1.9  1999-05-31 20:36:35  peter
+  Revision 1.10  1999-09-17 17:14:12  peter
+    + new heap manager supporting delphi freemem(pointer)
+
+  Revision 1.9  1999/05/31 20:36:35  peter
     * growing is now 256k or 1mb
 
   Revision 1.8  1999/02/08 09:31:40  florian

rtl/inc/heaptrc.pp

@@ -384,7 +384,7 @@ end;
                                TraceFreeMem
 *****************************************************************************}
 
-procedure TraceFreeMem(var p:pointer;size:longint);
+procedure TraceFreeMemSize(var p:pointer;size:longint);
 
   var i,bp, ppsize : longint;
   pp : pheap_mem_info;
@@ -486,7 +486,38 @@ begin
        exit;
 {$endif EXTRA}
     end;
-  SysFreeMem(p,ppsize);
+  SysFreeMemSize(p,ppsize);
+end;
+
+
+function TraceMemSize(p:pointer):Longint;
+var
+  l : longint;
+begin
+  l:=SysMemSize(p-sizeof(theap_mem_info)+extra_info_size);
+  dec(l,sizeof(theap_mem_info)+extra_info_size);
+  if add_tail then
+   dec(l,sizeof(longint));
+  TraceMemSize:=l;
+end;
+
+
+procedure TraceFreeMem(var p:pointer);
+var
+  size : longint;
+  pp : pheap_mem_info;
+begin
+  pp:=pheap_mem_info(pointer(p)-sizeof(theap_mem_info)+extra_info_size);
+  size:=TraceMemSize(p);
+  { this can never happend normaly }
+  if pp^.size>size then
+   begin
+     dump_wrong_size(pp,size,ptext^);
+{$ifdef EXTRA}
+     dump_wrong_size(pp,size,error_file);
+{$endif EXTRA}
+   end;
+  TraceFreeMemSize(p,pp^.size);
 end;
 
 
@@ -682,7 +713,9 @@ end;
 const
   TraceManager:TMemoryManager=(
     Getmem  : TraceGetMem;
-    Freemem : TraceFreeMem
+    Freemem : TraceFreeMem;
+    FreememSize : TraceFreeMemSize;
+    MemSize : TraceMemSize
   );
 
 procedure TraceExit;
@@ -761,7 +794,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.23  1999-09-10 17:13:41  peter
+  Revision 1.24  1999-09-17 17:14:12  peter
+    + new heap manager supporting delphi freemem(pointer)
+
+  Revision 1.23  1999/09/10 17:13:41  peter
     * fixed missing var
 
   Revision 1.22  1999/09/08 16:14:41  peter

rtl/objpas/objpas.pp

@@ -68,14 +68,9 @@ Type
    Function GetResourceStringHash(TableIndex,StringIndex : Longint) : Longint;
    Function GetResourceStringDefaultValue(TableIndex,StringIndex : Longint) : AnsiString;
    Function GetResourceStringCurrentValue(TableIndex,StringIndex : Longint) : AnsiString;
-   Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;   
-   
-{$endif}
-
+   Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;
 
-    Procedure Getmem(Var p:pointer;Size:Longint);
-    Procedure Freemem(Var p:pointer;Size:Longint);
-    Procedure Freemem(Var p:pointer);
+{$endif}
 
 
   implementation
@@ -174,59 +169,6 @@ begin
       paramstr:='';
   end;
 
-{ ---------------------------------------------------------------------
-    Delphi-Style memory management
-  ---------------------------------------------------------------------}
-
-  Type PLongint = ^Longint;
-
-
-    Procedure Getmem(Var p:pointer;Size:Longint);
-
-    begin
-      Inc(Size,SizeOf(Longint));
-      SysGetmem(P,Size);
-      PLongint(P)^:=Size;
-      Inc(P,SizeOf(Longint));
-    end;
-
-    Procedure DummyFreemem(Var p:pointer;Size:Longint);
-    begin
-      FreeMem(P);
-    end;
-
-    Procedure Freemem(Var p:pointer;Size:Longint);
-
-    begin
-      Freemem(P);
-    end;
-
-    Procedure Freemem(Var p:pointer);
-
-    begin
-      If P<>Nil then
-        begin
-        Dec(P,SizeOf(Longint));
-        SysFreemem(P,Plongint(P)^);
-        end;
-    end;
-
-
-Var OldMM,NEWMM : TmemoryManager;
-
-    Procedure InitMemoryManager;
-
-    begin
-      GetMemoryManager(OldMM);
-      NewMM.FreeMem:=@DummyFreeMem;
-      NewMM.GetMem:=@GetMem;
-      SetMemoryManager(NewMM);
-    end;
-
-    Procedure ResetMemoryManager;
-    begin
-      SetMemoryManager(OldMM);
-    end;
 
 {$IFDEF HasResourceStrings}
 
@@ -357,7 +299,7 @@ end;
 Function GetResourceStringName(TableIndex,StringIndex : Longint) : Ansistring;
 
 begin
-  If not CheckStringIndex(Tableindex,StringIndex) then  
+  If not CheckStringIndex(Tableindex,StringIndex) then
     Result:=''
   else
     result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].Name;
@@ -366,7 +308,7 @@ end;
 Function GetResourceStringHash(TableIndex,StringIndex : Longint) : Longint;
 
 begin
-  If not CheckStringIndex(Tableindex,StringIndex) then  
+  If not CheckStringIndex(Tableindex,StringIndex) then
     Result:=0
   else
     result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].HashValue;
@@ -375,7 +317,7 @@ end;
 Function GetResourceStringDefaultValue(TableIndex,StringIndex : Longint) : AnsiString;
 
 begin
-  If not CheckStringIndex(Tableindex,StringIndex) then  
+  If not CheckStringIndex(Tableindex,StringIndex) then
     Result:=''
   else
     result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].DefaultValue;
@@ -384,13 +326,13 @@ end;
 Function GetResourceStringCurrentValue(TableIndex,StringIndex : Longint) : AnsiString;
 
 begin
-  If not CheckStringIndex(Tableindex,StringIndex) then  
+  If not CheckStringIndex(Tableindex,StringIndex) then
     Result:=''
   else
     result:=ResourceStringTable.Tables[TableIndex]^.ResRec[StringIndex].CurrentValue;
 end;
 
-Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;   
+Function SetResourceStringValue(TableIndex,StringIndex : longint; Value : Ansistring) : Boolean;
 
 begin
   Result:=CheckStringIndex(Tableindex,StringIndex);
@@ -405,14 +347,17 @@ Initialization
 {$IFDEF HasResourceStrings}
   ResetResourceTables;
 {$endif}
-  InitMemoryManager;
+
 finalization
-  ResetMemoryManager;
+
 end.
 
 {
   $Log$
-  Revision 1.39  1999-08-28 13:03:23  michael
+  Revision 1.40  1999-09-17 17:14:12  peter
+    + new heap manager supporting delphi freemem(pointer)
+
+  Revision 1.39  1999/08/28 13:03:23  michael
   + Added Hash function to interface
 
   Revision 1.38  1999/08/27 15:54:15  michael