diff --git a/rtl/os2/tthread.inc b/rtl/os2/tthread.inc index bde5735d0e..b5596c9354 100644 --- a/rtl/os2/tthread.inc +++ b/rtl/os2/tthread.inc @@ -17,11 +17,11 @@ (* OS/2 specific declarations - see unit DosCalls for descriptions *) type - TByteArray = array [0..$fff0] of byte; +{ TByteArray = array [0..$fff0] of byte; PByteArray = ^TByteArray; - - TThreadEntry = function (Param: pointer): longint; cdecl; - +} +{ TThreadEntry = function (Param: pointer): longint; cdecl; +} TSysThreadIB = record TID, Priority, Version: longint; MCCount, MCForceFlag: word; @@ -46,9 +46,9 @@ type const - deThread = 0; +{ deThread = 0; deProcess = 1; - +} dtSuspended = 1; dtStack_Commited = 2; @@ -61,7 +61,7 @@ procedure DosGetInfoBlocks (PATIB: PPThreadInfoBlock; function DosSetPriority (Scope, TrClass: cardinal; Delta: longint; PortID: cardinal): cardinal; cdecl; external 'DOSCALLS' index 236; - +{ procedure DosExit (Action, Result: cardinal); cdecl; external 'DOSCALLS' index 233; @@ -77,7 +77,7 @@ function DosResumeThread (TID: cardinal): cardinal; cdecl; function DosSuspendThread (TID: cardinal): cardinal; cdecl; external 'DOSCALLS' index 238; - +} function DosWaitThread (var TID: cardinal; Option: cardinal): cardinal; cdecl; external 'DOSCALLS' index 349; @@ -89,15 +89,46 @@ const (* Implementation of exported functions *) -procedure AddThread (T: TThread); +procedure AddThread; begin - Inc (ThreadCount); + InterlockedIncrement (ThreadCount); end; -procedure RemoveThread (T: TThread); +procedure RemoveThread; begin - Dec (ThreadCount); + InterlockedDecrement (ThreadCount); +end; + + +constructor TThread.Create(CreateSuspended: Boolean; + const StackSize: SizeUInt = DefaultStackSize); +var + Flags: cardinal; +begin + inherited Create; + AddThread; + Flags := dtStack_Commited; + FSuspended := CreateSuspended; + if FSuspended then Flags := Flags or dtSuspended; + FHandle := BeginThread (nil, StackSize, @ThreadProc, pointer (Self), + Flags, FThreadID); + FFatalException := nil; +end; + + +destructor TThread.Destroy; +begin + if not FFinished and not Suspended then + begin + Terminate; + WaitFor; + end; +{ if FHandle <> 0 then DosKillThread (cardinal (FHandle));} + FFatalException.Free; + FFatalException := nil; + inherited Destroy; + RemoveThread; end; @@ -107,6 +138,13 @@ begin end; +procedure TThread.DoTerminate; +begin + if Assigned (FOnTerminate) then + Synchronize (@CallOnTerminate); +end; + + function TThread.GetPriority: TThreadPriority; var PTIB: PThreadInfoBlock; @@ -142,63 +180,29 @@ 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; - - -constructor TThread.Create(CreateSuspended: Boolean; - const StackSize: SizeUInt = DefaultStackSize); -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); + if Value <> FSuspended then + begin + if Value then + Suspend + else + Resume; + end; end; procedure TThread.Suspend; begin - FSuspended := DosSuspendThread (cardinal (FHandle)) = 0; + FSuspended := true; + SuspendThread (FHandle); +{DosSuspendThread (cardinal (FHandle)) = 0;} +end; + + +procedure TThread.Resume; +begin + if ResumeThread (FHandle) = 1 then + FSuspended := false; +{ FSuspended := not (DosResumeThread (cardinal (FHandle)) = 0);} end; @@ -217,5 +221,3 @@ begin CheckSynchronize (1000); WaitFor := DosWaitThread (FH, dtWait); end; - -