mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 11:13:02 +02:00
Allow compilation with -Sfnothreading
git-svn-id: trunk@36092 -
This commit is contained in:
parent
b1c66dee9b
commit
6c43882cf5
@ -227,8 +227,8 @@ var
|
|||||||
{$ifdef FPC_HAS_FEATURE_THREADING}
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
heap_lock : trtlcriticalsection;
|
heap_lock : trtlcriticalsection;
|
||||||
heap_lock_use : integer;
|
heap_lock_use : integer;
|
||||||
{$endif}
|
|
||||||
threadvar
|
threadvar
|
||||||
|
{$endif}
|
||||||
freelists : tfreelists;
|
freelists : tfreelists;
|
||||||
|
|
||||||
{$ifdef DUMP_MEM_USAGE}
|
{$ifdef DUMP_MEM_USAGE}
|
||||||
@ -238,7 +238,11 @@ const
|
|||||||
sizeusagesize = sizeusageindex shl sizeusageshift;
|
sizeusagesize = sizeusageindex shl sizeusageshift;
|
||||||
type
|
type
|
||||||
tsizeusagelist = array[0..sizeusageindex] of longint;
|
tsizeusagelist = array[0..sizeusageindex] of longint;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
threadvar
|
threadvar
|
||||||
|
{$else}
|
||||||
|
var
|
||||||
|
{$endif}
|
||||||
sizeusage, maxsizeusage: tsizeusagelist;
|
sizeusage, maxsizeusage: tsizeusagelist;
|
||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
|
@ -177,7 +177,11 @@ var
|
|||||||
orphaned_info: theap_info;
|
orphaned_info: theap_info;
|
||||||
todo_lock: trtlcriticalsection;
|
todo_lock: trtlcriticalsection;
|
||||||
textoutput : ^text;
|
textoutput : ^text;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
threadvar
|
threadvar
|
||||||
|
{$else}
|
||||||
|
var
|
||||||
|
{$endif}
|
||||||
heap_info: theap_info;
|
heap_info: theap_info;
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
@ -371,7 +375,7 @@ function released_modified(p : pheap_mem_info;var ptext : text) : boolean;
|
|||||||
pb : pbyte;
|
pb : pbyte;
|
||||||
i : longint;
|
i : longint;
|
||||||
begin
|
begin
|
||||||
released_modified:=false;
|
released_modified:=false;
|
||||||
{ Check tail_size bytes just after allocation !! }
|
{ Check tail_size bytes just after allocation !! }
|
||||||
pl:=pointer(p)+sizeof(theap_mem_info)+p^.size;
|
pl:=pointer(p)+sizeof(theap_mem_info)+p^.size;
|
||||||
pb:=pointer(p)+sizeof(theap_mem_info);
|
pb:=pointer(p)+sizeof(theap_mem_info);
|
||||||
@ -379,13 +383,13 @@ begin
|
|||||||
if pb[i]<>$F0 then
|
if pb[i]<>$F0 then
|
||||||
begin
|
begin
|
||||||
Writeln(ptext,'offset',i,':$',hexstr(i,2*sizeof(pointer)),'"',hexstr(pb[i],2),'"');
|
Writeln(ptext,'offset',i,':$',hexstr(i,2*sizeof(pointer)),'"',hexstr(pb[i],2),'"');
|
||||||
released_modified:=true;
|
released_modified:=true;
|
||||||
end;
|
end;
|
||||||
for i:=1 to (tail_size div sizeof(dword)) do
|
for i:=1 to (tail_size div sizeof(dword)) do
|
||||||
begin
|
begin
|
||||||
if unaligned(pl^) <> AllocateSig then
|
if unaligned(pl^) <> AllocateSig then
|
||||||
begin
|
begin
|
||||||
released_modified:=true;
|
released_modified:=true;
|
||||||
writeln(ptext,'Tail modified after release at pos ',i*sizeof(ptruint));
|
writeln(ptext,'Tail modified after release at pos ',i*sizeof(ptruint));
|
||||||
printhex(pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size,tail_size,ptext);
|
printhex(pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size,tail_size,ptext);
|
||||||
break;
|
break;
|
||||||
@ -480,9 +484,13 @@ procedure try_finish_heap_free_todo_list(loc_info: pheap_info);
|
|||||||
begin
|
begin
|
||||||
if loc_info^.heap_free_todo <> nil then
|
if loc_info^.heap_free_todo <> nil then
|
||||||
begin
|
begin
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
entercriticalsection(todo_lock);
|
entercriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
finish_heap_free_todo_list(loc_info);
|
finish_heap_free_todo_list(loc_info);
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
leavecriticalsection(todo_lock);
|
leavecriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -701,8 +709,10 @@ begin
|
|||||||
inc(ppsize,tail_size);
|
inc(ppsize,tail_size);
|
||||||
{ do various checking }
|
{ do various checking }
|
||||||
release_mem := CheckFreeMemSize(loc_info, pp, size, ppsize);
|
release_mem := CheckFreeMemSize(loc_info, pp, size, ppsize);
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
if release_todo_lock then
|
if release_todo_lock then
|
||||||
leavecriticalsection(todo_lock);
|
leavecriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
if release_mem then
|
if release_mem then
|
||||||
begin
|
begin
|
||||||
{ release the normal memory at least }
|
{ release the normal memory at least }
|
||||||
@ -734,7 +744,9 @@ 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;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
entercriticalsection(todo_lock);
|
entercriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
release_lock:=true;
|
release_lock:=true;
|
||||||
if pp^.todolist = @orphaned_info.heap_free_todo then
|
if pp^.todolist = @orphaned_info.heap_free_todo then
|
||||||
begin
|
begin
|
||||||
@ -746,7 +758,9 @@ begin
|
|||||||
pp^.todonext := pp^.todolist^;
|
pp^.todonext := pp^.todolist^;
|
||||||
pp^.todolist^ := pp;
|
pp^.todolist^ := pp;
|
||||||
TraceFreeMemSize := pp^.size;
|
TraceFreeMemSize := pp^.size;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
leavecriticalsection(todo_lock);
|
leavecriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -1286,7 +1300,9 @@ end;
|
|||||||
procedure TraceRelocateHeap;
|
procedure TraceRelocateHeap;
|
||||||
begin
|
begin
|
||||||
main_relo_todolist := @heap_info.heap_free_todo;
|
main_relo_todolist := @heap_info.heap_free_todo;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
initcriticalsection(todo_lock);
|
initcriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure move_heap_info(src_info, dst_info: pheap_info);
|
procedure move_heap_info(src_info, dst_info: pheap_info);
|
||||||
@ -1331,9 +1347,13 @@ var
|
|||||||
loc_info: pheap_info;
|
loc_info: pheap_info;
|
||||||
begin
|
begin
|
||||||
loc_info := @heap_info;
|
loc_info := @heap_info;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
entercriticalsection(todo_lock);
|
entercriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
move_heap_info(loc_info, @orphaned_info);
|
move_heap_info(loc_info, @orphaned_info);
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
leavecriticalsection(todo_lock);
|
leavecriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TraceGetHeapStatus:THeapStatus;
|
function TraceGetHeapStatus:THeapStatus;
|
||||||
@ -1488,8 +1508,10 @@ begin
|
|||||||
dumpheap;
|
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;
|
||||||
|
{$ifdef FPC_HAS_FEATURE_THREADING}
|
||||||
if main_relo_todolist <> nil then
|
if main_relo_todolist <> nil then
|
||||||
donecriticalsection(todo_lock);
|
donecriticalsection(todo_lock);
|
||||||
|
{$endif}
|
||||||
{$ifdef EXTRA}
|
{$ifdef EXTRA}
|
||||||
Close(error_file);
|
Close(error_file);
|
||||||
{$endif EXTRA}
|
{$endif EXTRA}
|
||||||
|
Loading…
Reference in New Issue
Block a user