paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 15:49:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* heap manager: fix thread exit race condition by using single global lock

Browse Source 
fix finishing to be freed list in orphaned list context
  fix heaptrace finalization

git-svn-id: trunk@7752 -
This commit is contained in:
micha 2007-06-20 21:10:35 +00:00
parent 17764bbbf6
commit c0fa8fd255
2 changed files with 57 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
rtl/inc/heap.inc
View File

@ -53,7 +53,6 @@ const
maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord } maxblocksize = 512+blocksize; { 1024+8 needed for heaprecord }
{$endif} {$endif}
maxblockindex = maxblocksize div blocksize; { highest index in array of lists of memchunks } maxblockindex = maxblocksize div blocksize; { highest index in array of lists of memchunks }
maxreusebigger = 8; { max reuse bigger tries }
{ common flags } { common flags }
fixedsizeflag = 1; { flag if the block is of fixed size } fixedsizeflag = 1; { flag if the block is of fixed size }
@ -187,9 +186,7 @@ type
varlist : pmemchunk_var; varlist : pmemchunk_var;
{ chunks waiting to be freed from other thread } { chunks waiting to be freed from other thread }
waitfixed : pmemchunk_fixed; waitfixed : pmemchunk_fixed;
lockfixed : trtlcriticalsection;
waitvar : pmemchunk_var; waitvar : pmemchunk_var;
lockvar : trtlcriticalsection;
{ heap statistics } { heap statistics }
internal_status : TFPCHeapStatus; internal_status : TFPCHeapStatus;
end; end;
@ -209,7 +206,7 @@ var
main_orig_freelists : pfreelists; main_orig_freelists : pfreelists;
main_relo_freelists : pfreelists; main_relo_freelists : pfreelists;
orphaned_freelists : tfreelists; orphaned_freelists : tfreelists;
orphaned_oslist_lock : trtlcriticalsection; heap_lock : trtlcriticalsection;
threadvar threadvar
freelists : tfreelists; freelists : tfreelists;
@ -754,9 +751,9 @@ begin
if not assigned(poc) and (assigned(orphaned_freelists.waitfixed) if not assigned(poc) and (assigned(orphaned_freelists.waitfixed)
or assigned(orphaned_freelists.waitvar) or (orphaned_freelists.oscount > 0)) then or assigned(orphaned_freelists.waitvar) or (orphaned_freelists.oscount > 0)) then
begin begin
entercriticalsection(orphaned_oslist_lock); entercriticalsection(heap_lock);
try_finish_waitfixedlist(@orphaned_freelists); finish_waitfixedlist(@orphaned_freelists);
try_finish_waitvarlist(@orphaned_freelists); finish_waitvarlist(@orphaned_freelists);
if orphaned_freelists.oscount > 0 then if orphaned_freelists.oscount > 0 then
begin begin
{ blocks available in orphaned freelist ? } { blocks available in orphaned freelist ? }
@ -778,7 +775,7 @@ begin
loc_freelists^.oslist_all := poc; loc_freelists^.oslist_all := poc;
end; end;
end; end;
leavecriticalsection(orphaned_oslist_lock); leavecriticalsection(heap_lock);
end; end;
if poc = nil then if poc = nil then
begin begin
@ -1045,31 +1042,29 @@ end;
procedure waitfree_fixed(pmc: pmemchunk_fixed; loc_freelists: pfreelists); procedure waitfree_fixed(pmc: pmemchunk_fixed; loc_freelists: pfreelists);
begin begin
entercriticalsection(loc_freelists^.lockfixed); entercriticalsection(heap_lock);
pmc^.next_fixed := loc_freelists^.waitfixed; pmc^.next_fixed := loc_freelists^.waitfixed;
loc_freelists^.waitfixed := pmc; loc_freelists^.waitfixed := pmc;
leavecriticalsection(loc_freelists^.lockfixed); leavecriticalsection(heap_lock);
end; end;
procedure waitfree_var(pmcv: pmemchunk_var; loc_freelists: pfreelists); procedure waitfree_var(pmcv: pmemchunk_var; loc_freelists: pfreelists);
begin begin
entercriticalsection(loc_freelists^.lockvar); entercriticalsection(heap_lock);
pmcv^.next_var := loc_freelists^.waitvar; pmcv^.next_var := loc_freelists^.waitvar;
loc_freelists^.waitvar := pmcv; loc_freelists^.waitvar := pmcv;
leavecriticalsection(loc_freelists^.lockvar); leavecriticalsection(heap_lock);
end; end;
function SysFreeMem_Fixed(pmc: pmemchunk_fixed): ptrint; function SysFreeMem_Fixed(loc_freelists: pfreelists; pmc: pmemchunk_fixed): ptrint;
var var
chunkindex, chunkindex,
chunksize: ptrint; chunksize: ptrint;
poc: poschunk; poc: poschunk;
pmc_next: pmemchunk_fixed; pmc_next: pmemchunk_fixed;
loc_freelists: pfreelists;
begin begin
poc := poschunk(pointer(pmc)-(pmc^.size shr fixedoffsetshift)); poc := poschunk(pointer(pmc)-(pmc^.size shr fixedoffsetshift));
chunksize := pmc^.size and fixedsizemask; chunksize := pmc^.size and fixedsizemask;
loc_freelists := @freelists;
if loc_freelists <> poc^.freelists then if loc_freelists <> poc^.freelists then
begin begin
if poc^.freelists = main_orig_freelists then if poc^.freelists = main_orig_freelists then
@ -1104,13 +1099,11 @@ begin
result := chunksize; result := chunksize;
end; end;
function SysFreeMem_Var(pmcv: pmemchunk_var): ptrint; function SysFreeMem_Var(loc_freelists: pfreelists; pmcv: pmemchunk_var): ptrint;
var var
chunksize: ptrint; chunksize: ptrint;
loc_freelists: pfreelists;
begin begin
chunksize := pmcv^.size and sizemask; chunksize := pmcv^.size and sizemask;
loc_freelists := @freelists;
if loc_freelists <> pmcv^.freelists then if loc_freelists <> pmcv^.freelists then
begin begin
if pmcv^.freelists = main_orig_freelists then if pmcv^.freelists = main_orig_freelists then
@ -1137,6 +1130,7 @@ end;
function SysFreeMem(p: pointer): ptrint; function SysFreeMem(p: pointer): ptrint;
var var
pmc: pmemchunk_fixed; pmc: pmemchunk_fixed;
loc_freelists: pfreelists;
{$ifdef DUMP_MEM_USAGE} {$ifdef DUMP_MEM_USAGE}
size: sizeint; size: sizeint;
{$endif} {$endif}
@ -1153,12 +1147,13 @@ begin
else else
dec(sizeusage[size shr sizeusageshift]); dec(sizeusage[size shr sizeusageshift]);
{$endif} {$endif}
loc_freelists := @freelists;
pmc := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr)); pmc := pmemchunk_fixed(p-sizeof(tmemchunk_fixed_hdr));
{ check if this is a fixed- or var-sized chunk } { check if this is a fixed- or var-sized chunk }
if (pmc^.size and fixedsizeflag) = 0 then if (pmc^.size and fixedsizeflag) = 0 then
result := sysfreemem_var(pmemchunk_var(p-sizeof(tmemchunk_var_hdr))) result := sysfreemem_var(loc_freelists, pmemchunk_var(p-sizeof(tmemchunk_var_hdr)))
else else
result := sysfreemem_fixed(pmc); result := sysfreemem_fixed(loc_freelists, pmc);
end; end;
procedure finish_waitfixedlist(loc_freelists: pfreelists); procedure finish_waitfixedlist(loc_freelists: pfreelists);
@ -1171,7 +1166,7 @@ begin
{ keep next_fixed, might be destroyed } { keep next_fixed, might be destroyed }
pmc := loc_freelists^.waitfixed; pmc := loc_freelists^.waitfixed;
loc_freelists^.waitfixed := pmc^.next_fixed; loc_freelists^.waitfixed := pmc^.next_fixed;
SysFreeMem_Fixed(pmc); SysFreeMem_Fixed(loc_freelists, pmc);
end; end;
end; end;
@ -1179,9 +1174,9 @@ function try_finish_waitfixedlist(loc_freelists: pfreelists): boolean;
begin begin
if loc_freelists^.waitfixed = nil then if loc_freelists^.waitfixed = nil then
exit(false); exit(false);
entercriticalsection(loc_freelists^.lockfixed); entercriticalsection(heap_lock);
finish_waitfixedlist(loc_freelists); finish_waitfixedlist(loc_freelists);
leavecriticalsection(loc_freelists^.lockfixed); leavecriticalsection(heap_lock);
result := true; result := true;
end; end;
@ -1195,7 +1190,7 @@ begin
{ keep next_var, might be destroyed } { keep next_var, might be destroyed }
pmcv := loc_freelists^.waitvar; pmcv := loc_freelists^.waitvar;
loc_freelists^.waitvar := pmcv^.next_var; loc_freelists^.waitvar := pmcv^.next_var;
SysFreeMem_Var(pmcv); SysFreeMem_Var(loc_freelists, pmcv);
end; end;
end; end;
@ -1203,9 +1198,9 @@ procedure try_finish_waitvarlist(loc_freelists: pfreelists);
begin begin
if loc_freelists^.waitvar = nil then if loc_freelists^.waitvar = nil then
exit; exit;
entercriticalsection(loc_freelists^.lockvar); entercriticalsection(heap_lock);
finish_waitvarlist(loc_freelists); finish_waitvarlist(loc_freelists);
leavecriticalsection(loc_freelists^.lockvar); leavecriticalsection(heap_lock);
end; end;
{***************************************************************************** {*****************************************************************************
@ -1434,8 +1429,6 @@ var
begin begin
loc_freelists := @freelists; loc_freelists := @freelists;
fillchar(loc_freelists^,sizeof(tfreelists),0); fillchar(loc_freelists^,sizeof(tfreelists),0);
initcriticalsection(loc_freelists^.lockfixed);
initcriticalsection(loc_freelists^.lockvar);
{$ifdef DUMP_MEM_USAGE} {$ifdef DUMP_MEM_USAGE}
fillchar(sizeusage,sizeof(sizeusage),0); fillchar(sizeusage,sizeof(sizeusage),0);
fillchar(maxsizeusage,sizeof(sizeusage),0); fillchar(maxsizeusage,sizeof(sizeusage),0);
@ -1463,11 +1456,7 @@ begin
{ this function should be called in main thread context } { this function should be called in main thread context }
loc_freelists := @freelists; loc_freelists := @freelists;
main_relo_freelists := loc_freelists; main_relo_freelists := loc_freelists;
initcriticalsection(loc_freelists^.lockfixed); initcriticalsection(heap_lock);
initcriticalsection(loc_freelists^.lockvar);
initcriticalsection(orphaned_freelists.lockfixed);
initcriticalsection(orphaned_freelists.lockvar);
initcriticalsection(orphaned_oslist_lock);
modify_freelists(loc_freelists, main_relo_freelists); modify_freelists(loc_freelists, main_relo_freelists);
if MemoryManager.RelocateHeap <> nil then if MemoryManager.RelocateHeap <> nil then
MemoryManager.RelocateHeap(); MemoryManager.RelocateHeap();
@ -1482,9 +1471,8 @@ begin
loc_freelists := @freelists; loc_freelists := @freelists;
if main_relo_freelists <> nil then if main_relo_freelists <> nil then
begin begin
entercriticalsection(loc_freelists^.lockfixed); entercriticalsection(heap_lock);
finish_waitfixedlist(loc_freelists); finish_waitfixedlist(loc_freelists);
entercriticalsection(loc_freelists^.lockvar);
finish_waitvarlist(loc_freelists); finish_waitvarlist(loc_freelists);
{$ifdef HAS_SYSOSFREE} {$ifdef HAS_SYSOSFREE}
end; end;
@ -1494,7 +1482,10 @@ begin
poc_next := poc^.next_free; poc_next := poc^.next_free;
{ check if this os chunk was 'recycled' i.e. taken in use again } { check if this os chunk was 'recycled' i.e. taken in use again }
if (poc^.size and ocrecycleflag) = 0 then if (poc^.size and ocrecycleflag) = 0 then
begin
poc^.size := poc^.size and not ocrecycleflag;
free_oschunk(loc_freelists, poc); free_oschunk(loc_freelists, poc);
end;
poc := poc_next; poc := poc_next;
end; end;
loc_freelists^.oslist := nil; loc_freelists^.oslist := nil;
@ -1502,15 +1493,8 @@ begin
if main_relo_freelists <> nil then if main_relo_freelists <> nil then
begin begin
{$endif HAS_SYSOSFREE} {$endif HAS_SYSOSFREE}
if main_relo_freelists = loc_freelists then if main_relo_freelists <> loc_freelists then
begin begin
donecriticalsection(orphaned_freelists.lockfixed);
donecriticalsection(orphaned_freelists.lockvar);
donecriticalsection(orphaned_oslist_lock);
end else begin
entercriticalsection(orphaned_oslist_lock);
entercriticalsection(orphaned_freelists.lockfixed);
entercriticalsection(orphaned_freelists.lockvar);
poc := modify_freelists(loc_freelists, @orphaned_freelists); poc := modify_freelists(loc_freelists, @orphaned_freelists);
if assigned(poc) then if assigned(poc) then
begin begin
@ -1519,12 +1503,11 @@ begin
orphaned_freelists.oslist_all^.prev_any := poc; orphaned_freelists.oslist_all^.prev_any := poc;
orphaned_freelists.oslist_all := loc_freelists^.oslist_all; orphaned_freelists.oslist_all := loc_freelists^.oslist_all;
end; end;
leavecriticalsection(orphaned_freelists.lockvar); leavecriticalsection(heap_lock);
leavecriticalsection(orphaned_freelists.lockfixed);
leavecriticalsection(orphaned_oslist_lock);
end; end;
donecriticalsection(loc_freelists^.lockfixed); leavecriticalsection(heap_lock);
donecriticalsection(loc_freelists^.lockvar); if main_relo_freelists = loc_freelists then
donecriticalsection(heap_lock);
end; end;
{$ifdef SHOW_MEM_USAGE} {$ifdef SHOW_MEM_USAGE}
writeln('Max heap used/size: ', loc_freelists^.internal_status.maxheapused, '/', writeln('Max heap used/size: ', loc_freelists^.internal_status.maxheapused, '/',

71
rtl/inc/heaptrc.pp
View File

@ -111,12 +111,6 @@ type
ppheap_mem_info = ^pheap_mem_info; ppheap_mem_info = ^pheap_mem_info;
pheap_mem_info = ^theap_mem_info; pheap_mem_info = ^theap_mem_info;
pheap_todo = ^theap_todo;
theap_todo = record
lock : trtlcriticalsection;
list : pheap_mem_info;
end;
{ warning the size of theap_mem_info { warning the size of theap_mem_info
must be a multiple of 8 must be a multiple of 8
because otherwise you will get because otherwise you will get
@ -126,7 +120,7 @@ type
theap_mem_info = record theap_mem_info = record
previous, previous,
next : pheap_mem_info; next : pheap_mem_info;
todolist : pheap_todo; todolist : ppheap_mem_info;
todonext : pheap_mem_info; todonext : pheap_mem_info;
size : ptrint; size : ptrint;
sig : longword; sig : longword;
@ -147,7 +141,7 @@ type
heap_valid_last : pheap_mem_info; heap_valid_last : pheap_mem_info;
{$endif EXTRA} {$endif EXTRA}
heap_mem_root : pheap_mem_info; heap_mem_root : pheap_mem_info;
heap_free_todo : theap_todo; heap_free_todo : pheap_mem_info;
getmem_cnt, getmem_cnt,
freemem_cnt : ptrint; freemem_cnt : ptrint;
getmem_size, getmem_size,
@ -164,9 +158,10 @@ var
{$ifdef EXTRA} {$ifdef EXTRA}
error_file : text; error_file : text;
{$endif EXTRA} {$endif EXTRA}
main_orig_todolist: pheap_todo; main_orig_todolist: ppheap_mem_info;
main_relo_todolist: pheap_todo; main_relo_todolist: ppheap_mem_info;
orphaned_info: theap_info; orphaned_info: theap_info;
todo_lock: trtlcriticalsection;
threadvar threadvar
heap_info: theap_info; heap_info: theap_info;
@ -259,7 +254,7 @@ end;
*****************************************************************************} *****************************************************************************}
function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info; function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info;
size: ptrint; release_orphaned_lock: boolean): ptrint; forward; size: ptrint; release_todo_lock: boolean): ptrint; forward;
function TraceFreeMem(p: pointer): ptrint; forward; function TraceFreeMem(p: pointer): ptrint; forward;
procedure call_stack(pp : pheap_mem_info;var ptext : text); procedure call_stack(pp : pheap_mem_info;var ptext : text);
@ -380,7 +375,7 @@ var
pp: pheap_mem_info; pp: pheap_mem_info;
list: ppheap_mem_info; list: ppheap_mem_info;
begin begin
list := @loc_info^.heap_free_todo.list; list := @loc_info^.heap_free_todo;
repeat repeat
pp := list^; pp := list^;
list^ := list^^.todonext; list^ := list^^.todonext;
@ -393,11 +388,11 @@ procedure try_finish_heap_free_todo_list(loc_info: pheap_info);
var var
bp: pointer; bp: pointer;
begin begin
if loc_info^.heap_free_todo.list <> nil then if loc_info^.heap_free_todo <> nil then
begin begin
entercriticalsection(loc_info^.heap_free_todo.lock); entercriticalsection(todo_lock);
finish_heap_free_todo_list(loc_info); finish_heap_free_todo_list(loc_info);
leavecriticalsection(loc_info^.heap_free_todo.lock); leavecriticalsection(todo_lock);
end; end;
end; end;
@ -620,7 +615,7 @@ begin
end; end;
function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info; function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info;
size: ptrint; release_orphaned_lock: boolean): ptrint; size: ptrint; release_todo_lock: boolean): ptrint;
var var
i,ppsize : ptrint; i,ppsize : ptrint;
bp : pointer; bp : pointer;
@ -634,8 +629,8 @@ begin
inc(ppsize,sizeof(ptrint)); inc(ppsize,sizeof(ptrint));
{ do various checking } { do various checking }
release_mem := CheckFreeMemSize(loc_info, pp, size, ppsize); release_mem := CheckFreeMemSize(loc_info, pp, size, ppsize);
if release_orphaned_lock then if release_todo_lock then
leavecriticalsection(orphaned_info.heap_free_todo.lock); leavecriticalsection(todo_lock);
if release_mem then if release_mem then
begin begin
{ release the normal memory at least } { release the normal memory at least }
@ -665,7 +660,7 @@ begin
begin begin
if pp^.todolist = main_orig_todolist then if pp^.todolist = main_orig_todolist then
pp^.todolist := main_relo_todolist; pp^.todolist := main_relo_todolist;
entercriticalsection(pp^.todolist^.lock); entercriticalsection(todo_lock);
if pp^.todolist = @orphaned_info.heap_free_todo then if pp^.todolist = @orphaned_info.heap_free_todo then
begin begin
loc_info := @orphaned_info; loc_info := @orphaned_info;
@ -673,9 +668,9 @@ begin
if pp^.todolist <> @loc_info^.heap_free_todo then if pp^.todolist <> @loc_info^.heap_free_todo then
begin begin
{ allocated in different heap, push to that todolist } { allocated in different heap, push to that todolist }
pp^.todonext := pp^.todolist^.list; pp^.todonext := pp^.todolist^;
pp^.todolist^.list := pp; pp^.todolist^ := pp;
leavecriticalsection(pp^.todolist^.lock); leavecriticalsection(todo_lock);
exit(pp^.size); exit(pp^.size);
end; end;
end; end;
@ -1183,24 +1178,21 @@ begin
loc_info^.error_in_heap := false; loc_info^.error_in_heap := false;
loc_info^.inside_trace_getmem := false; loc_info^.inside_trace_getmem := false;
EntryMemUsed := SysGetFPCHeapStatus.CurrHeapUsed; EntryMemUsed := SysGetFPCHeapStatus.CurrHeapUsed;
if main_relo_todolist <> nil then
initcriticalsection(loc_info^.heap_free_todo.lock);
end; end;
procedure TraceRelocateHeap; procedure TraceRelocateHeap;
begin begin
main_relo_todolist := @heap_info.heap_free_todo; main_relo_todolist := @heap_info.heap_free_todo;
initcriticalsection(main_relo_todolist^.lock); initcriticalsection(todo_lock);
initcriticalsection(orphaned_info.heap_free_todo.lock);
end; end;
procedure move_heap_info(src_info, dst_info: pheap_info); procedure move_heap_info(src_info, dst_info: pheap_info);
var var
heap_mem: pheap_mem_info; heap_mem: pheap_mem_info;
begin begin
if src_info^.heap_free_todo.list <> nil then if src_info^.heap_free_todo <> nil then
finish_heap_free_todo_list(src_info); finish_heap_free_todo_list(src_info);
if dst_info^.heap_free_todo.list <> nil then if dst_info^.heap_free_todo <> nil then
finish_heap_free_todo_list(dst_info); finish_heap_free_todo_list(dst_info);
heap_mem := src_info^.heap_mem_root; heap_mem := src_info^.heap_mem_root;
if heap_mem <> nil then if heap_mem <> nil then
@ -1237,21 +1229,9 @@ var
heap_mem: pheap_mem_info; heap_mem: pheap_mem_info;
begin begin
loc_info := @heap_info; loc_info := @heap_info;
entercriticalsection(loc_info^.heap_free_todo.lock); entercriticalsection(todo_lock);
entercriticalsection(orphaned_info.heap_free_todo.lock); move_heap_info(loc_info, @orphaned_info);
{ if not main thread exiting, move bookkeeping to orphaned heap } leavecriticalsection(todo_lock);
if (@loc_info^.heap_free_todo <> main_orig_todolist)
and (@loc_info^.heap_free_todo <> main_relo_todolist) then
begin
move_heap_info(loc_info, @orphaned_info);
end else
if not loc_info^.error_in_heap then
begin
move_heap_info(@orphaned_info, loc_info);
Dumpheap;
end;
leavecriticalsection(orphaned_info.heap_free_todo.lock);
donecriticalsection(loc_info^.heap_free_todo.lock);
end; end;
function TraceGetHeapStatus:THeapStatus; function TraceGetHeapStatus:THeapStatus;
@ -1361,11 +1341,12 @@ begin
end; end;
exit; exit;
end; end;
TraceExitThread; move_heap_info(@orphaned_info, @heap_info);
dumpheap;
if heap_info.error_in_heap and (exitcode=0) then if heap_info.error_in_heap and (exitcode=0) then
exitcode:=203; exitcode:=203;
if main_relo_todolist <> nil then if main_relo_todolist <> nil then
donecriticalsection(orphaned_info.heap_free_todo.lock); donecriticalsection(todo_lock);
{$ifdef EXTRA} {$ifdef EXTRA}
Close(error_file); Close(error_file);
{$endif EXTRA} {$endif EXTRA}