* reallocmem fixed for freemem() call when size=0

rtl/inc/heap.inc

@@ -531,38 +531,21 @@ end;
 
 
 {*****************************************************************************
-                                 SysReAllocMem
+                                 SysResizeMem
 *****************************************************************************}
-function internSysReAllocMem(var p:pointer;size : longint; var doMove: boolean):pointer;
-{ On entry, doMove determines if a new block has to be allocated, whether this is   }
-{ done and the data is moved from the old to the new block                          }
-{ If doMove was false on entry, it is set to true on exit if a move has to be done  }
-{ which then has to be carried out by the caller, otherwise it remains false        }
-{ This functionality is required if you install you own heap manager (e.g. heaptrc) }
+
+function SysTryResizeMem(var p:pointer;size : longint):boolean;
 var
-  orgsize,
   currsize,
   foundsize,
   sizeleft,
   s     : longint;
-  wasbeforeheapend, canDoMove : boolean;
-  p2    : pointer;
+  wasbeforeheapend : boolean;
   hp,
   pnew,
   pcurr : pfreerecord;
 begin
-  canDoMove := doMove;
-  { assume no move is necessary }
-  doMove := false;
-{ Allocate a new block? }
-  if p=nil then
-   begin
-     p:=MemoryManager.GetMem(size);
-     internSysReallocmem:=P;
-     exit;
-   end;
 { fix needed size }
-  orgsize:=size;
   size:=(size+sizeof(theaprecord)+(blocksize-1)) and (not (blocksize-1));
 { fix p to point to the heaprecord }
   pcurr:=pfreerecord(pointer(p)-sizeof(theaprecord));
@@ -571,7 +554,7 @@ begin
 { is the allocated block still correct? }
   if currsize=size then
    begin
-     internSysReAllocMem:=p;
+     SysTryResizeMem:=true;
      exit;
    end;
 { do we need to allocate more memory ? }
@@ -639,17 +622,7 @@ begin
      else
       begin
         { we need to call getmem/move/freemem }
-        If canDoMove then
-          begin
-            p2:= MemoryManager.GetMem(orgsize);
-            if p2<>nil then
-              Move(p^,p2^,orgsize);
-            MemoryManager.FreeMem(p);
-            p:=p2;
-          end
-        else
-          doMove := true;
-        internSysReAllocMem:=p;
+        SysTryResizeMem:=false;
         exit;
       end;
      currsize:=pcurr^.size and sizemask;
@@ -682,15 +655,43 @@ begin
         pcurr^.size:=size or usedmask or (pcurr^.size and beforeheapendmask);
       end;
    end;
-  internSysReAllocMem:=p;
+  SysTryResizeMem:=true;
 end;
 
+
+{*****************************************************************************
+                                 SysResizeMem
+*****************************************************************************}
+
 function SysReAllocMem(var p:pointer;size : longint):pointer;
 var
-  doMove: boolean;
+  p2 : pointer;
 begin
-  doMove:=true;
-  SysReAllocMem := internSysReallocMem(p,size,doMove);
+{ Free block? }
+  if size=0 then
+   begin
+     if p<>nil then
+      MemoryManager.FreeMem(p);
+     SysReallocmem:=P;
+     exit;
+   end;
+{ Allocate a new block? }
+  if p=nil then
+   begin
+     p:=MemoryManager.GetMem(size);
+     SysReallocmem:=P;
+     exit;
+   end;
+{ Resize block }
+  if not SysTryResizeMem(p,size) then
+   begin
+     p2:= MemoryManager.GetMem(size);
+     if p2<>nil then
+      Move(p^,p2^,size);
+     MemoryManager.FreeMem(p);
+     p:=p2;
+   end;
+  SysReAllocMem := p;
 end;
 
 
@@ -803,7 +804,10 @@ end;
 
 {
   $Log$
-  Revision 1.31  2000-01-24 23:56:10  peter
+  Revision 1.32  2000-01-31 23:41:30  peter
+    * reallocmem fixed for freemem() call when size=0
+
+  Revision 1.31  2000/01/24 23:56:10  peter
     * fixed reallocmem which didn't work anymore and thus broke a lot
       of objfpc/delphi code
 

rtl/inc/heaph.inc

@@ -45,9 +45,7 @@ Function  SysFreemem(var p:pointer):Longint;
 Function  SysFreememSize(var p:pointer;Size:Longint):Longint;
 Function  SysMemSize(p:pointer):Longint;
 Function  SysAllocMem(size:longint):Pointer;
-{ the next one is for internal use by heap managers only, don't call directly }
-{ from programs! (JM)                                                         }       
-Function  InternSysReAllocMem(var p:pointer;size : longint; var doMove: boolean):pointer;
+function  SysTryResizeMem(var p:pointer;size : longint):boolean;
 Function  SysReAllocMem(var p:pointer;size:longint):Pointer;
 Function  Sysmemavail:Longint;
 Function  Sysmaxavail:Longint;
@@ -79,7 +77,10 @@ Procedure release(var p : pointer);
 
 {
   $Log$
-  Revision 1.15  2000-01-20 12:35:35  jonas
+  Revision 1.16  2000-01-31 23:41:30  peter
+    * reallocmem fixed for freemem() call when size=0
+
+  Revision 1.15  2000/01/20 12:35:35  jonas
     * fixed problem with reallocmem and heaptrc
 
   Revision 1.14  2000/01/07 16:41:34  daniel

rtl/inc/heaptrc.pp

@@ -763,15 +763,24 @@ var
   i,bp : longint;
   pl : plongint;
   pp : pheap_mem_info;
-  mustMove: boolean;
 begin
-  if not assigned(p) then
+{ Free block? }
+  if size=0 then
+   begin
+     if p<>nil then
+      TraceFreeMem(p);
+     TraceReallocMem:=P;
+     exit;
+   end;
+{ Allocate a new block? }
+  if p=nil then
    begin
      p:=TraceGetMem(size);
      TraceReallocMem:=P;
      exit;
    end;
-   dec(p,sizeof(theap_mem_info)+extra_info_size);
+{ Resize block }
+  dec(p,sizeof(theap_mem_info)+extra_info_size);
   { remove heap_mem_info from linked list }
   pp:=pheap_mem_info(p);
   if pp^.next<>nil then
@@ -780,33 +789,31 @@ begin
    pp^.previous^.next:=pp^.next;
   if pp=heap_mem_root then
    heap_mem_root:=heap_mem_root^.previous;
-{ Do the real ReAllocMem, but alloc also for the info block }
+  { Do the real ReAllocMem, but alloc also for the info block }
    bp:=size+sizeof(theap_mem_info)+extra_info_size;
    if add_tail then
      inc(bp,sizeof(longint));
   { the internal ReAllocMem is not allowed to move any data }
-  mustMove := false;
-  p:=internSysReAllocMem(p,bp,mustMove);
-  { a new block is needed? }
-  if mustMove then
-    begin
-      { restore p }
-      inc(p,sizeof(theap_mem_info)+extra_info_size);
-      { get a new block }
-      newP := TraceGetMem(size);
-      { move the data }
-      if newP <> nil then
-        move(p^,newP^,pp^.size);
-      { release p }
-      traceFreeMem(p);
-      p := newP;
-      traceReAllocMem := p;
-      exit;
-    end;
+  if not SysTryResizeMem(p,size) then
+   begin
+     { restore p }
+     inc(p,sizeof(theap_mem_info)+extra_info_size);
+     { get a new block }
+     newP := TraceGetMem(size);
+     { move the data }
+     if newP <> nil then
+       move(p^,newP^,pp^.size);
+     { release p }
+     traceFreeMem(p);
+     p := newP;
+     traceReAllocMem := p;
+     exit;
+   end;
   { adjust getmem/freemem sizes }
   if pp^.size > size then
     inc(freemem_size,pp^.size-size)
-  else inc(getmem_size,size-pp^.size);
+  else
+    inc(getmem_size,size-pp^.size);
 { Create the info block }
   pheap_mem_info(p)^.sig:=$DEADBEEF;
   pheap_mem_info(p)^.size:=size;
@@ -968,7 +975,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.36  2000-01-20 14:25:51  jonas
+  Revision 1.37  2000-01-31 23:41:30  peter
+    * reallocmem fixed for freemem() call when size=0
+
+  Revision 1.36  2000/01/20 14:25:51  jonas
     * finally fixed tracereallocmem completely
 
   Revision 1.35  2000/01/20 13:17:11  jonas