* start of tthread for linux,win32

fcl/go32v2/classes.pp

@@ -0,0 +1,43 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for win32
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  strings,
+  sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+end.
+{
+  $Log$
+  Revision 1.4  1999-05-30 10:46:37  peter
+    * start of tthread for linux,win32
+
+}

fcl/inc/thread.inc → fcl/go32v2/thread.inc

@@ -92,7 +92,10 @@ end;
 
 {
   $Log$
-  Revision 1.2  1999-04-08 10:18:57  peter
+  Revision 1.1  1999-05-30 10:46:39  peter
+    * start of tthread for linux,win32
+
+  Revision 1.2  1999/04/08 10:18:57  peter
     * makefile updates
 
 }

fcl/inc/classes.pp

@@ -1,68 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    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.
-
- **********************************************************************}
-
-{$MODE OBJFPC}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-end.
-{
-  $Log$
-  Revision 1.1  1999-02-10 13:40:26  michael
-  + Classes now system independent
-
-  Revision 1.9  1999/02/02 21:32:02  michael
-  - removed osfile.inc. All in sysutils now
-
-  Revision 1.8  1998/11/04 10:46:43  peter
-    * exceptions work
-
-  Revision 1.7  1998/11/04 10:15:13  peter
-    * fixes to compile
-
-  Revision 1.6  1998/10/02 09:17:57  michael
-  Removed objpas from uses clause
-
-  Revision 1.5  1998/09/23 07:46:57  michael
-  * patches by TSE
-
-  Revision 1.4  1998/06/10 21:53:09  michael
-  + Implemented Handle/FileStreams
-
-  Revision 1.3  1998/05/06 13:00:25  michael
-  + Added strings to uses clause, for TStrings class.
-
-  Revision 1.2  1998/05/04 14:31:51  michael
-  + Split classes file.
-
-  Revision 1.1  1998/05/04 12:16:01  florian
-    + Initial revisions after making a new directory structure
-
-}

fcl/linux/classes.pp

@@ -0,0 +1,53 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for linux
+    
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  strings,
+  sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  linux;
+  
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+
+finalization
+  if ThreadsInited then
+   DoneThreads;
+
+end.
+{
+  $Log$
+  Revision 1.11  1999-05-30 10:46:41  peter
+    * start of tthread for linux,win32
+
+}

fcl/linux/thread.inc

@@ -0,0 +1,270 @@
+{
+  $Id$
+
+  Linux TThread implementation
+}
+
+
+{ Thread management routines }
+
+const
+  Sig_Cancel = SIGUSR2;
+
+type
+  PThreadRec=^TThreadRec;
+  TThreadRec=record
+    thread : TThread;
+    next   : PThreadRec;
+  end;
+
+var
+  ThreadRoot : PThreadRec;
+  ThreadsInited : boolean;
+
+function StackPointer:longint;assembler;
+asm
+        movl    %esp,%eax
+end;
+
+
+function ThreadSelf:TThread;
+var
+  hp : PThreadRec;
+  sp : longint;
+begin
+  sp:=StackPointer;
+  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;
+
+
+procedure ThreadCancelHandler(Sig:integer);cdecl;
+var
+  p : TThread;
+begin
+  p:=ThreadSelf;
+  if assigned(p) and (p.FCallExitProcess) then
+   ExitProcess(p.FReturnValue);
+end;
+
+
+procedure InitThreads;
+begin
+  ThreadRoot:=nil;
+  ThreadsInited:=true;
+  { Install sig_cancel handler }
+  Signal(Sig_Cancel,@ThreadCancelHandler);
+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;
+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;
+end;
+
+
+{ TThread }
+function ThreadProc(Thread: TThread): Integer;cdecl;
+var
+  FreeThread: Boolean;
+begin
+  Thread.Execute;
+  FreeThread := Thread.FFreeOnTerminate;
+  Result := Thread.FReturnValue;
+  Thread.FFinished := True;
+  Thread.DoTerminate;
+  if FreeThread then
+    Thread.Free;
+  ExitProcess(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;
+  { Setup 16k of stack }
+  FStackSize:=16384;
+  Getmem(pointer(FStackPointer),FStackSize);
+  inc(FStackPointer,FStackSize);
+  FCallExitProcess:=false;
+  { Clone }
+  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
+  FThreadID := FHandle;
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if not FFinished and not Suspended then
+   begin
+     Terminate;
+     WaitFor;
+   end;
+{ Remove stack }
+  dec(FStackPointer,FStackSize);
+  Freemem(pointer(FStackPointer),FStackSize);
+  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 := Linux.GetPriority(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
+  Linux.SetPriority(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;
+{  SuspendThread(FHandle); }
+end;
+
+
+procedure TThread.Resume;
+begin
+{  if ResumeThread(FHandle) = 1 then }
+    FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  { Set the flag for this tthread, so the sighandler knows which tthread
+    needs termination }
+  FCallExitProcess:=true;
+  Kill(FHandle,Sig_Cancel);
+  FTerminated := True;
+end;
+
+
+function TThread.WaitFor: Integer;
+var
+  status : longint;
+begin
+  if FThreadID = MainThreadID then
+   WaitPid(0,@status,0)
+  else
+   WaitPid(FHandle,@status,0);
+  Result:=status;
+end;
+
+{
+  $Log$
+  Revision 1.1  1999-05-30 10:46:42  peter
+    * start of tthread for linux,win32
+
+}

fcl/os2/classes.pp

@@ -0,0 +1,43 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for win32
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  strings,
+  sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+end.
+{
+  $Log$
+  Revision 1.5  1999-05-30 10:46:42  peter
+    * start of tthread for linux,win32
+
+}

fcl/os2/thread.inc

@@ -0,0 +1,101 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 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                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+
+begin
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+
+begin
+end;
+
+
+destructor TThread.Destroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+procedure TThread.Terminate;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+
+{
+  $Log$
+  Revision 1.1  1999-05-30 10:46:43  peter
+    * start of tthread for linux,win32
+
+  Revision 1.2  1999/04/08 10:18:57  peter
+    * makefile updates
+
+}

fcl/template/classes.pp

@@ -0,0 +1,43 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for win32
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  strings,
+  sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+end.
+{
+  $Log$
+  Revision 1.1  1999-05-30 10:46:43  peter
+    * start of tthread for linux,win32
+
+}

fcl/template/thread.inc

@@ -0,0 +1,101 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 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                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+
+begin
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+
+begin
+end;
+
+
+destructor TThread.Destroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+procedure TThread.Terminate;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+
+{
+  $Log$
+  Revision 1.1  1999-05-30 10:46:43  peter
+    * start of tthread for linux,win32
+
+  Revision 1.2  1999/04/08 10:18:57  peter
+    * makefile updates
+
+}

fcl/tests/Makefile

@@ -35,7 +35,7 @@ NEEDOPT=-S2
 #####################################################################
 
 UNITOBJECTS=
-EXEOBJECTS=stringl dparser fstream mstream list
+EXEOBJECTS=stringl dparser fstream mstream list threads
 
 
 #####################################################################
@@ -112,7 +112,10 @@ endif
 
 #
 # $Log$
-# Revision 1.4  1999-04-08 10:19:04  peter
+# Revision 1.5  1999-05-30 10:46:43  peter
+#   * start of tthread for linux,win32
+#
+# Revision 1.4  1999/04/08 10:19:04  peter
 #   * makefile updates
 #
 #

fcl/tests/threads.pp

@@ -0,0 +1,45 @@
+program testthreads;
+
+{$mode objfpc}
+
+uses
+  sysutils,
+  classes;
+
+type
+  TMyThread=class(TThread)
+  private
+    ch : char;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(c:char);
+  end;
+
+procedure TMyThread.Execute;
+begin
+  repeat
+    write(ch);
+  until false;
+end;
+
+
+constructor TMyThread.Create(c:char);
+begin
+  ch:=c;
+  inherited Create(false);
+end;
+
+var
+  t1,t2 : TMyThread;
+begin
+  t1:=TMyThread.Create('a');
+  t2:=TMyThread.Create('b');
+  readln;
+  t2.Terminate;
+  readln;
+  t1.Terminate;
+  readln;
+  t2.Destroy;
+  t1.Destroy;
+end.

fcl/win32/classes.pp

@@ -0,0 +1,46 @@
+{
+    $Id$
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for win32
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  strings,
+  sysutils;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  windows;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+end.
+{
+  $Log$
+  Revision 1.9  1999-05-30 10:46:45  peter
+    * start of tthread for linux,win32
+
+}

fcl/win32/thread.inc

@@ -0,0 +1,210 @@
+{ Thread management routines }
+
+const
+  CM_EXECPROC = $8FFF;
+  CM_DESTROYWINDOW = $8FFE;
+
+type
+  PRaiseFrame = ^TRaiseFrame;
+  TRaiseFrame = record
+    NextRaise: PRaiseFrame;
+    ExceptAddr: Pointer;
+    ExceptObject: TObject;
+    ExceptionRecord: pointer; {PExceptionRecord}
+  end;
+
+var
+  ThreadWindow: HWND;
+  ThreadCount: Integer;
+
+function ThreadWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint;stdcall;
+begin
+  case Message of
+    CM_EXECPROC:
+      with TThread(lParam) do
+      begin
+        Result := 0;
+        try
+          FSynchronizeException := nil;
+          FMethod;
+        except
+{          if RaiseList <> nil then
+          begin
+            FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
+            PRaiseFrame(RaiseList)^.ExceptObject := nil;
+          end; }
+        end;
+      end;
+    CM_DESTROYWINDOW:
+      begin
+        DestroyWindow(Window);
+        Result := 0;
+      end;
+  else
+    Result := DefWindowProc(Window, Message, wParam, lParam);
+  end;
+end;
+
+const
+  ThreadWindowClass: TWndClass = (
+    style: 0;
+    lpfnWndProc: nil;
+    cbClsExtra: 0;
+    cbWndExtra: 0;
+    hInstance: 0;
+    hIcon: 0;
+    hCursor: 0;
+    hbrBackground: 0;
+    lpszMenuName: nil;
+    lpszClassName: 'TThreadWindow');
+
+procedure AddThread;
+
+  function AllocateWindow: HWND;
+  var
+    TempClass: TWndClass;
+    ClassRegistered: Boolean;
+  begin
+    ThreadWindowClass.hInstance := HInstance;
+    ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc);
+    ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
+      @TempClass);
+    if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then
+    begin
+      if ClassRegistered then
+        Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
+      Windows.RegisterClass(ThreadWindowClass);
+    end;
+    Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
+      0, 0, 0, 0, 0, 0, HInstance, nil);
+  end;
+
+begin
+  if ThreadCount = 0 then
+    ThreadWindow := AllocateWindow;
+  Inc(ThreadCount);
+end;
+
+procedure RemoveThread;
+begin
+  Dec(ThreadCount);
+  if ThreadCount = 0 then
+    PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
+end;
+
+{ TThread }
+
+function ThreadProc(Thread: TThread): Integer;
+var
+  FreeThread: Boolean;
+begin
+  Thread.Execute;
+  FreeThread := Thread.FFreeOnTerminate;
+  Result := Thread.FReturnValue;
+  Thread.FFinished := True;
+  Thread.DoTerminate;
+  if FreeThread then Thread.Free;
+  ExitThread(Result);
+end;
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+  Flags: Integer;
+begin
+  inherited Create;
+  AddThread;
+  FSuspended := CreateSuspended;
+  Flags := 0;
+  if CreateSuspended then Flags := CREATE_SUSPENDED;
+  FHandle := CreateThread(nil, 0, @ThreadProc, Pointer(self), Flags, FThreadID);
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if not FFinished and not Suspended then
+  begin
+    Terminate;
+    WaitFor;
+  end;
+  if FHandle <> 0 then CloseHandle(FHandle);
+  inherited Destroy;
+  RemoveThread;
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+  FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+const
+  Priorities: array [TThreadPriority] of Integer =
+   (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
+    THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
+    THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := GetThreadPriority(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
+  SetThreadPriority(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;
+  SuspendThread(FHandle);
+end;
+
+procedure TThread.Resume;
+begin
+  if ResumeThread(FHandle) = 1 then FSuspended := False;
+end;
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+  Msg: TMsg;
+begin
+  if GetCurrentThreadID = MainThreadID then
+    while MsgWaitForMultipleObjects(1, @FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do
+      PeekMessage(@Msg, 0, 0, 0, PM_NOREMOVE)
+  else
+    WaitForSingleObject(ulong(FHandle), INFINITE);
+  GetExitCodeThread(FHandle, @Result);
+end;