From 6bd04949abe180f5cb0a4e43cc931ac02be10229 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A1roly=20Balogh?= Date: Sun, 6 Jun 2004 14:45:20 +0000 Subject: [PATCH] * dummy file to have classes compiled, still needs lot of work --- rtl/morphos/tthread.inc | 189 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 189 insertions(+) create mode 100644 rtl/morphos/tthread.inc diff --git a/rtl/morphos/tthread.inc b/rtl/morphos/tthread.inc new file mode 100644 index 0000000000..53a39c7c76 --- /dev/null +++ b/rtl/morphos/tthread.inc @@ -0,0 +1,189 @@ +{ + $Id$ + This file is part of the Free Component Library (FCL) + Copyright (c) 1999-2002 by the Free Pascal development team + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{****************************************************************************} +{* TThread *} +{****************************************************************************} + +{$WARNING This file is only a stub, and will not work!} + +const + ThreadCount: longint = 0; + +(* Implementation of exported functions *) + +procedure AddThread (T: TThread); +begin + Inc (ThreadCount); +end; + + +procedure RemoveThread (T: TThread); +begin + Dec (ThreadCount); +end; + + +procedure TThread.CallOnTerminate; +begin + FOnTerminate (Self); +end; + + +function TThread.GetPriority: TThreadPriority; +var +{ PTIB: PThreadInfoBlock; + PPIB: PProcessInfoBlock;} + I: TThreadPriority; +begin +{ + DosGetInfoBlocks (@PTIB, @PPIB); + with PTIB^.TIB2^ do + if Priority >= $300 then GetPriority := tpTimeCritical else + if Priority < $200 then GetPriority := tpIdle else + begin + I := Succ (Low (TThreadPriority)); + while (I < High (TThreadPriority)) and + (Priority - Priorities [I] <= Priorities [Succ (I)] - Priority) do Inc (I); + GetPriority := I; + end; +} +end; + + +procedure TThread.SetPriority(Value: TThreadPriority); +{var + PTIB: PThreadInfoBlock; + PPIB: PProcessInfoBlock;} +begin +{ DosGetInfoBlocks (@PTIB, @PPIB);} +(* + PTIB^.TIB2^.Priority := Priorities [Value]; +*) +{ + DosSetPriority (2, High (Priorities [Value]), + Low (Priorities [Value]) - PTIB^.TIB2^.Priority, FHandle);} +end; + + +procedure TThread.SetSuspended(Value: Boolean); +begin + if Value <> FSuspended then + begin + if Value then Suspend else Resume; + end; +end; + + +procedure TThread.DoTerminate; +begin + if Assigned (FOnTerminate) then Synchronize (@CallOnTerminate); +end; + + +procedure TThread.Synchronize(Method: TThreadMethod); +begin +end; + + +function ThreadProc(Args: pointer): Integer; cdecl; +var + FreeThread: Boolean; + Thread: TThread absolute Args; +begin + 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; +{ + DosExit (deThread, Result); +} +end; + +constructor TThread.Create(CreateSuspended: Boolean); +var + Flags: cardinal; +begin + inherited Create; + AddThread (Self); +{ + FSuspended := CreateSuspended; + Flags := dtStack_Commited; + if FSuspended then Flags := Flags or dtSuspended; + if DosCreateThread (cardinal (FThreadID), @ThreadProc, pointer (Self), + Flags, 16384) <> 0 then + begin + FFinished := true; + Destroy; + end else FHandle := FThreadID; + IsMultiThread := true; + FFatalException := nil; +} +end; + + +destructor TThread.Destroy; +begin + if not FFinished and not Suspended then + begin + Terminate; + WaitFor; + end; +{ + if FHandle <> -1 then DosKillThread (cardinal (FHandle)); + FFatalException.Free; + FFatalException := nil; + inherited Destroy; + RemoveThread (Self); +} +end; + +procedure TThread.Resume; +begin +{ FSuspended := not (DosResumeThread (cardinal (FHandle)) = 0);} +end; + + +procedure TThread.Suspend; +begin +{ FSuspended := DosSuspendThread (cardinal (FHandle)) = 0;} +end; + + +procedure TThread.Terminate; +begin + FTerminated := true; +end; + + +function TThread.WaitFor: Integer; +var + FH: cardinal; +begin +{ WaitFor := DosWaitThread (FH, dtWait);} +end; + + +{ + $Log$ + Revision 1.1 2004-06-06 14:45:20 karoly + * dummy file to have classes compiled, still needs lot of work + +}