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