* fixed problem with reallocmem and heaptrc

rtl/inc/heap.inc

@@ -533,25 +533,32 @@ end;
 {*****************************************************************************
                                  SysReAllocMem
 *****************************************************************************}
-
-function SysReAllocMem(var p:pointer;size : longint):pointer;
+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) }
 var
   orgsize,
   currsize,
   foundsize,
   sizeleft,
   s     : longint;
-  wasbeforeheapend : boolean;
+  wasbeforeheapend, canDoMove : boolean;
   p2    : pointer;
   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);
-     SysReallocmem:=P;
+     internSysReallocmem:=P;
      exit;
    end;
 { fix needed size }
@@ -564,7 +571,7 @@ begin
 { is the allocated block still correct? }
   if currsize=size then
    begin
-     SysReAllocMem:=p;
+     internSysReAllocMem:=p;
      exit;
    end;
 { do we need to allocate more memory ? }
@@ -632,12 +639,16 @@ begin
      else
       begin
         { we need to call getmem/move/freemem }
-        p2:=MemoryManager.GetMem(orgsize);
-        if p2<>nil then
-         Move(p^,p2^,orgsize);
-        MemoryManager.Freemem(p);
-        p:=p2;
-        SysReAllocMem:=p;
+        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;
         exit;
       end;
      currsize:=pcurr^.size and sizemask;
@@ -670,7 +681,13 @@ begin
         pcurr^.size:=size or usedmask or (pcurr^.size and beforeheapendmask);
       end;
    end;
-  SysReAllocMem:=p;
+  internSysReAllocMem:=p;
+end;
+
+function SysReAllocMem(var p:pointer;size : longint):pointer;
+const doMove: boolean = true;
+begin
+  SysReAllocMem := internSysReallocMem(p,size,doMove);
 end;
 
 
@@ -783,7 +800,10 @@ end;
 
 {
   $Log$
-  Revision 1.29  2000-01-07 16:41:34  daniel
+  Revision 1.30  2000-01-20 12:35:35  jonas
+    * fixed problem with reallocmem and heaptrc
+
+  Revision 1.29  2000/01/07 16:41:34  daniel
     * copyright 2000
 
   Revision 1.28  2000/01/07 16:32:24  daniel

rtl/inc/heaph.inc

@@ -45,6 +45,9 @@ 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  SysReAllocMem(var p:pointer;size:longint):Pointer;
 Function  Sysmemavail:Longint;
 Function  Sysmaxavail:Longint;
@@ -76,7 +79,10 @@ Procedure release(var p : pointer);
 
 {
   $Log$
-  Revision 1.14  2000-01-07 16:41:34  daniel
+  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
     * copyright 2000
 
   Revision 1.13  2000/01/07 16:32:24  daniel

rtl/inc/heaptrc.pp

@@ -759,9 +759,11 @@ end;
 
 function TraceReAllocMem(var p:pointer;size:longint):Pointer;
 var
+  newP: pointer;
   i,bp : longint;
   pl : plongint;
   pp : pheap_mem_info;
+  mustMove: boolean;
 begin
   if not assigned(p) then
    begin
@@ -770,19 +772,37 @@ begin
      exit;
    end;
    dec(p,sizeof(theap_mem_info)+extra_info_size);
-   { remove heap_mem_info for linked list }
-   pp:=pheap_mem_info(p);
-   if pp^.next<>nil then
-    pp^.next^.previous:=pp^.previous;
-   if pp^.previous<>nil then
-    pp^.previous^.next:=pp^.next;
-   if pp=heap_mem_root then
-    heap_mem_root:=heap_mem_root^.previous;
+  { remove heap_mem_info from linked list }
+  pp:=pheap_mem_info(p);
+  if pp^.next<>nil then
+   pp^.next^.previous:=pp^.previous;
+  if pp^.previous<>nil then
+   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 }
-     bp:=size+sizeof(theap_mem_info)+extra_info_size;
+   bp:=size+sizeof(theap_mem_info)+extra_info_size;
    if add_tail then
      inc(bp,sizeof(longint));
-  p:=SysReAllocMem(p,bp);
+  { 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;
 { Create the info block }
   pheap_mem_info(p)^.sig:=$DEADBEEF;
   pheap_mem_info(p)^.size:=size;
@@ -945,7 +965,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.33  2000-01-07 16:41:34  daniel
+  Revision 1.34  2000-01-20 12:35:35  jonas
+    * fixed problem with reallocmem and heaptrc
+
+  Revision 1.33  2000/01/07 16:41:34  daniel
     * copyright 2000
 
   Revision 1.32  2000/01/07 16:32:24  daniel