paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 17:49:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revisions 3537 via svnmerge from

Browse Source 
http://hajny@svn.freepascal.org/svn/fpc/trunk

........
r3537 | hajny | 2006-05-15 00:24:33 +0100 (Mon, 15 May 2006) | 1 line

  * compilation fix required due to recent changes (systhrd.inc implementation inherited instead of reimplementation)
........

git-svn-id: branches/fixes_2_0@3624 -
This commit is contained in:
Tomas Hajny 2006-05-22 05:31:29 +00:00
parent 6a7e704331
commit c926e1727c
1 changed files with 68 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
rtl/os2/tthread.inc
View File

@ -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;