diff --git a/rtl/inc/heap.inc b/rtl/inc/heap.inc index 63a4abd96f..c80fdd6253 100644 --- a/rtl/inc/heap.inc +++ b/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 diff --git a/rtl/inc/heaph.inc b/rtl/inc/heaph.inc index 5e63148bde..9e58a376d4 100644 --- a/rtl/inc/heaph.inc +++ b/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 diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index 59e85e3b19..525f028a0d 100644 --- a/rtl/inc/heaptrc.pp +++ b/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