diff --git a/rtl/darwin/tthread.inc b/rtl/darwin/tthread.inc index f078c27929..a6dc88e27b 100644 --- a/rtl/darwin/tthread.inc +++ b/rtl/darwin/tthread.inc @@ -15,285 +15,6 @@ **********************************************************************} -{$IFDEF VER1_0} // leaving the old implementation in for now... -type - PThreadRec=^TThreadRec; - TThreadRec=record - thread : TThread; - next : PThreadRec; - end; - -var - ThreadRoot : PThreadRec; - ThreadsInited : boolean; -// MainThreadID: longint; - -Const - ThreadCount: longint = 0; - -function ThreadSelf:TThread; -var - hp : PThreadRec; - sp : Pointer; -begin - sp:=SPtr; - hp:=ThreadRoot; - while assigned(hp) do - begin - if (sp<=hp^.Thread.FStackPointer) and - (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then - begin - Result:=hp^.Thread; - exit; - end; - hp:=hp^.next; - end; - Result:=nil; -end; - - -//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function -procedure SIGCHLDHandler(Sig: longint); cdecl; - -begin - fpwaitpid(-1, nil, WNOHANG); -end; - -procedure InitThreads; -var - Act, OldAct: Baseunix.PSigActionRec; -begin - ThreadRoot:=nil; - ThreadsInited:=true; - - -// This will install SIGCHLD signal handler -// signal() installs "one-shot" handler, -// so it is better to install and set up handler with sigaction() - - GetMem(Act, SizeOf(SigActionRec)); - GetMem(OldAct, SizeOf(SigActionRec)); - - Act^.sa_handler := TSigAction(@SIGCHLDHandler); - Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART}; - Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags - FpSigAction(SIGCHLD, Act, OldAct); - - FreeMem(Act, SizeOf(SigActionRec)); - FreeMem(OldAct, SizeOf(SigActionRec)); -end; - - -procedure DoneThreads; -var - hp : PThreadRec; -begin - while assigned(ThreadRoot) do - begin - ThreadRoot^.Thread.Destroy; - hp:=ThreadRoot; - ThreadRoot:=ThreadRoot^.Next; - dispose(hp); - end; - ThreadsInited:=false; -end; - - -procedure AddThread(t:TThread); -var - hp : PThreadRec; -begin - { Need to initialize threads ? } - if not ThreadsInited then - InitThreads; - - { Put thread in the linked list } - new(hp); - hp^.Thread:=t; - hp^.next:=ThreadRoot; - ThreadRoot:=hp; - - inc(ThreadCount, 1); -end; - - -procedure RemoveThread(t:TThread); -var - lasthp,hp : PThreadRec; -begin - hp:=ThreadRoot; - lasthp:=nil; - while assigned(hp) do - begin - if hp^.Thread=t then - begin - if assigned(lasthp) then - lasthp^.next:=hp^.next - else - ThreadRoot:=hp^.next; - dispose(hp); - exit; - end; - lasthp:=hp; - hp:=hp^.next; - end; - - Dec(ThreadCount, 1); - if ThreadCount = 0 then DoneThreads; -end; - - -{ TThread } -function ThreadProc(args:pointer): Integer; cdecl; -var - FreeThread: Boolean; - Thread : TThread absolute args; -begin - while Thread.FHandle = 0 do fpsleep(1); - if Thread.FSuspended then Thread.suspend(); - try - Thread.Execute; - except - Thread.FFatalException := TObject(AcquireExceptionObject); - end; - FreeThread := Thread.FFreeOnTerminate; - Result := Thread.FReturnValue; - Thread.FFinished := True; - Thread.DoTerminate; - if FreeThread then - Thread.Free; - fpexit(Result); -end; - - -constructor TThread.Create(CreateSuspended: Boolean); -var - Flags: Integer; -begin - inherited Create; - AddThread(self); - FSuspended := CreateSuspended; - Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD; - { Setup 16k of stack } - FStackSize:=16384; - Getmem(FStackPointer,FStackSize); - inc(FStackPointer,FStackSize); - FCallExitProcess:=false; - { Clone } - FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self); -// if FSuspended then Suspend; - FThreadID := FHandle; - IsMultiThread := TRUE; - FFatalException := nil; -end; - - -destructor TThread.Destroy; -begin - if not FFinished and not Suspended then - begin - Terminate; - WaitFor; - end; - if FHandle <> -1 then - fpkill(FHandle, SIGKILL); - dec(FStackPointer,FStackSize); - Freemem(FStackPointer); - FFatalException.Free; - FFatalException := nil; - inherited Destroy; - RemoveThread(self); -end; - - -procedure TThread.CallOnTerminate; -begin - FOnTerminate(Self); -end; - -procedure TThread.DoTerminate; -begin - if Assigned(FOnTerminate) then - Synchronize(@CallOnTerminate); -end; - - -const -{ I Don't know idle or timecritical, value is also 20, so the largest other - possibility is 19 (PFV) } - Priorities: array [TThreadPriority] of Integer = - (-20,-19,-10,9,10,19,20); - -function TThread.GetPriority: TThreadPriority; -var - P: Integer; - I: TThreadPriority; -begin - P := fpGetPriority(Prio_Process,FHandle); - Result := tpNormal; - for I := Low(TThreadPriority) to High(TThreadPriority) do - if Priorities[I] = P then - Result := I; -end; - - -procedure TThread.SetPriority(Value: TThreadPriority); -begin - fpSetPriority(Prio_Process,FHandle,Priorities[Value]); -end; - - -procedure TThread.Synchronize(Method: TThreadMethod); -begin - FSynchronizeException := nil; - FMethod := Method; -{ SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); } - if Assigned(FSynchronizeException) then - raise FSynchronizeException; -end; - - -procedure TThread.SetSuspended(Value: Boolean); -begin - if Value <> FSuspended then - if Value then - Suspend - else - Resume; -end; - - -procedure TThread.Suspend; -begin - FSuspended := true; - fpKill(FHandle, SIGSTOP); -end; - - -procedure TThread.Resume; -begin - fpKill(FHandle, SIGCONT); - FSuspended := False; -end; - - -procedure TThread.Terminate; -begin - FTerminated := True; -end; - -function TThread.WaitFor: Integer; -var - status : longint; -begin - if FThreadID = MainThreadID then - fpwaitpid(0,@status,0) - else - fpwaitpid(FHandle,@status,0); - Result:=status; -end; -{$ELSE} - { What follows, is a short description on my implementation of TThread. Most information can also be found by reading the source and accompanying @@ -375,9 +96,6 @@ end; var ThreadsInited: boolean = false; -{$IFDEF LINUX} - GMainPID: LongInt = 0; -{$ENDIF} const // stupid, considering its not even implemented... Priorities: array [TThreadPriority] of Integer = @@ -387,9 +105,6 @@ procedure InitThreads; begin if not ThreadsInited then begin ThreadsInited := true; - {$IFDEF LINUX} - GMainPid := fpgetpid(); - {$ENDIF} end; end; @@ -414,12 +129,6 @@ var begin WRITE_DEBUG('ThreadFunc is here...'); LThread := TThread(parameter); - {$IFDEF LINUX} - // save the PID of the "thread" - // this is different from the PID of the main thread if - // the LinuxThreads implementation is used - LThread.FPid := fpgetpid(); - {$ENDIF} WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread)); try if LThread.FInitialSuspended then begin @@ -512,22 +221,7 @@ begin SemaphoreWait(FSem); end else begin FSuspendedExternal := true; -{$IFDEF LINUX} - // naughty hack if the user doesn't have Linux with NPTL... - // in that case, the PID of threads will not be identical - // to the other threads, which means that our thread is a normal - // process that we can suspend via SIGSTOP... - // this violates POSIX, but is the way it works on the - // LinuxThreads pthread implementation. Not with NPTL, but in that case - // getpid(2) also behaves properly and returns the same PID for - // all threads. Thats actually (FINALLY!) native thread support :-) - if FPid <> GMainPID then begin - FSuspended := true; - fpkill(FPid, SIGSTOP); - end; -{$ELSE} SuspendThread(FHandle); -{$ENDIF} end; end; end; @@ -542,15 +236,7 @@ begin FSuspended := False; end; end else begin -{$IFDEF LINUX} - // see .Suspend - if FPid <> GMainPID then begin - fpkill(FPid, SIGCONT); - FSuspended := False; - end; -{$ELSE} ResumeThread(FHandle); -{$ENDIF} FSuspendedExternal := false; end; end; @@ -602,11 +288,13 @@ procedure TThread.SetPriority(Value: TThreadPriority); begin ThreadSetPriority(FHandle, Priorities[Value]); end; -{$ENDIF} { $Log$ - Revision 1.2 2004-03-04 12:34:36 jonas + Revision 1.3 2004-03-04 12:42:44 jonas + - removed legacy code + + Revision 1.2 2004/03/04 12:34:36 jonas * fixed compilation Revision 1.1 2004/01/04 20:05:38 jonas