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

AROS: some bugfixes for threading

Browse Source 
git-svn-id: trunk@28684 -
This commit is contained in:
marcus 2014-09-17 15:19:40 +00:00
parent 26f8a732e8
commit 8ec15cb6ba
3 changed files with 11 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
rtl/aros/arosthreads.inc
View File

@ -49,7 +49,7 @@ type
PAROSThreadStruct = ^TAROSThreadStruct; PAROSThreadStruct = ^TAROSThreadStruct;
var var
AROSThreadStruct: PAROSThreadStruct; AROSThreadStruct: PAROSThreadStruct external name 'AROS_THREADLIB';
function CreateNewProcTags(const Tags: array of PtrUInt): PProcess; function CreateNewProcTags(const Tags: array of PtrUInt): PProcess;
@ -293,7 +293,7 @@ begin
// create New Stack // create New Stack
StackMem := GetMem(NewThread^.StackSize); StackMem := GetMem(NewThread^.StackSize);
sswap.stk_Lower := StackMem; sswap.stk_Lower := StackMem;
sswap.stk_Upper := Pointer(PtrUInt(sswap.stk_Lower) + 256*1024); sswap.stk_Upper := Pointer(PtrUInt(sswap.stk_Lower) + NewThread^.StackSize);
sswap.stk_Pointer := sswap.stk_Upper; sswap.stk_Pointer := sswap.stk_Upper;
ReleaseSemaphore(@AROSThreadStruct^.ThreadMemSem); ReleaseSemaphore(@AROSThreadStruct^.ThreadMemSem);
// semaphore against too fast startup // semaphore against too fast startup
@ -369,6 +369,8 @@ begin
// Semaphore for too fast startup // Semaphore for too fast startup
ObtainSemaphore(@(NewThread^.StartupSemaphore)); ObtainSemaphore(@(NewThread^.StartupSemaphore));
// a very ugly Bugfix, for crashing AROS, on the very first Task after reboot
// recheck later if can be removed
if NewThread^.ThreadID = 1 then if NewThread^.ThreadID = 1 then
begin begin
//debugln('make empty thread'); //debugln('make empty thread');
@ -377,13 +379,13 @@ begin
NP_Entry, PtrUInt(@EmptyFunc), NP_Entry, PtrUInt(@EmptyFunc),
TAG_DONE, TAG_END]); TAG_DONE, TAG_END]);
ObtainSemaphore(@AROSThreadStruct^.EmptySemaphore); ObtainSemaphore(@AROSThreadStruct^.EmptySemaphore);
Delay(10); Delay(1);
end; end;
// //
NewThread^.Task := CreateNewProcTags([ NewThread^.Task := CreateNewProcTags([
NP_Entry, PtrUInt(@StarterFunc), NP_Entry, PtrUInt(@StarterFunc),
//NP_Name, PtrUInt(PChar('Thread' + IntToStr(LastThreadNum))), //NP_Name, PtrUInt(PChar('Thread' + IntToStr(LastThreadNum))),
//NP_StackSize, 256 * 1024, //NP_StackSize, 10024 * 1024,
NP_Priority, Priority, NP_Priority, Priority,
NP_UserData, PtrUInt(NewThread), NP_UserData, PtrUInt(NewThread),
TAG_DONE, TAG_END]); TAG_DONE, TAG_END]);
@ -516,6 +518,7 @@ end;
procedure WaitAllThreads; procedure WaitAllThreads;
var var
i: Integer; i: Integer;
TID: LongWord;
begin begin
if not Assigned(AROSThreadStruct) then if not Assigned(AROSThreadStruct) then
Exit; Exit;
@ -525,12 +528,13 @@ begin
begin begin
if Assigned(AROSThreadStruct^.ThreadList[i]) then if Assigned(AROSThreadStruct^.ThreadList[i]) then
begin begin
ReleaseSemaphore(@AROSThreadStruct^.ThreadListSem); TID := AROSThreadStruct^.ThreadList[i]^.ThreadID;
// //
ObtainSemaphore(@(AROSThreadStruct^.ThreadList[i]^.StartupSemaphore)); ObtainSemaphore(@(AROSThreadStruct^.ThreadList[i]^.StartupSemaphore));
ReleaseSemaphore(@(AROSThreadStruct^.ThreadList[i]^.StartupSemaphore)); ReleaseSemaphore(@(AROSThreadStruct^.ThreadList[i]^.StartupSemaphore));
// //
AROSWaitThread(AROSThreadStruct^.ThreadList[i]^.ThreadID); ReleaseSemaphore(@AROSThreadStruct^.ThreadListSem);
AROSWaitThread(TID);
ObtainSemaphore(@AROSThreadStruct^.ThreadListSem); ObtainSemaphore(@AROSThreadStruct^.ThreadListSem);
end; end;
Inc(i); Inc(i);
@ -543,7 +547,6 @@ end;
procedure InitThreadLib; procedure InitThreadLib;
begin begin
New(AROSThreadStruct); New(AROSThreadStruct);
AROS_ThreadLib := AROSThreadStruct;
AROSThreadStruct^.LastThreadNum := 0; AROSThreadStruct^.LastThreadNum := 0;
InitSemaphore(@(AROSThreadStruct^.MutexListSem)); InitSemaphore(@(AROSThreadStruct^.MutexListSem));
InitSemaphore(@(AROSThreadStruct^.ConditionListSem)); InitSemaphore(@(AROSThreadStruct^.ConditionListSem));
@ -581,7 +584,6 @@ begin
ReleaseSemaphore(@AROSThreadStruct^.ConditionListSem); ReleaseSemaphore(@AROSThreadStruct^.ConditionListSem);
Dispose(AROSThreadStruct); Dispose(AROSThreadStruct);
AROSThreadStruct := nil; AROSThreadStruct := nil;
AROS_ThreadLib := nil;
end; end;
{$endif THREAD_SYSTEM} {$endif THREAD_SYSTEM}

2
rtl/aros/system.pp
View File

@ -63,7 +63,7 @@ var
AOS_ExecBase : Pointer; external name '_ExecBase'; AOS_ExecBase : Pointer; external name '_ExecBase';
AOS_DOSBase : Pointer; AOS_DOSBase : Pointer;
AOS_UtilityBase: Pointer; AOS_UtilityBase: Pointer;
AROS_ThreadLib : Pointer = nil; AROS_ThreadLib : Pointer; public name 'AROS_THREADLIB';
ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap } ASYS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
ASYS_origDir : LongInt; { original directory on startup } ASYS_origDir : LongInt; { original directory on startup }

3
rtl/aros/tthread.inc
View File

@ -52,9 +52,6 @@ end;
procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt); procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
begin begin
if not Assigned(AROSThreadStruct) then
AROSThreadStruct := AROS_ThreadLib;
if not Assigned(AROSThreadStruct) then if not Assigned(AROSThreadStruct) then
raise EThread.CreateFmt(SThreadCreateError, ['ThreadLib not found']); raise EThread.CreateFmt(SThreadCreateError, ['ThreadLib not found']);