From 4aa4aeae793fa7a3b50c911851feca62bae3c35a Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 13 Apr 2005 20:10:50 +0000 Subject: [PATCH] + TThreadID --- rtl/beos/system.pp | 10 +++- rtl/bsd/sysosh.inc | 8 ++- rtl/emx/sysosh.inc | 33 ++++++----- rtl/go32v2/sysosh.inc | 16 ++++-- rtl/inc/threadh.inc | 33 ++++++----- rtl/linux/sysosh.inc | 8 ++- rtl/macos/sysosh.inc | 8 ++- rtl/morphos/sysosh.inc | 16 ++++-- rtl/netware/sysosh.inc | 8 ++- rtl/netwlibc/sysosh.inc | 20 ++++--- rtl/os2/sysosh.inc | 32 ++++++----- rtl/solaris/sysosh.inc | 18 +++--- rtl/unix/cthreads.pp | 118 +++++++++++++++++++++------------------- rtl/watcom/system.pp | 8 ++- rtl/win32/sysosh.inc | 32 ++++++----- 15 files changed, 214 insertions(+), 154 deletions(-) diff --git a/rtl/beos/system.pp b/rtl/beos/system.pp index afa0ebb939..2a2cb5823b 100644 --- a/rtl/beos/system.pp +++ b/rtl/beos/system.pp @@ -27,8 +27,9 @@ interface {$I systemh.inc} type - THandle = longint; - + THandle = longint; + TThreadID = THandle; + { include heap support headers } {$I heaph.inc} @@ -547,7 +548,10 @@ begin end. { $Log$ - Revision 1.22 2005-04-03 21:10:59 hajny + Revision 1.23 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.22 2005/04/03 21:10:59 hajny * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453) Revision 1.21 2005/02/14 17:13:21 peter diff --git a/rtl/bsd/sysosh.inc b/rtl/bsd/sysosh.inc index 8fa1148fc6..386ea88353 100644 --- a/rtl/bsd/sysosh.inc +++ b/rtl/bsd/sysosh.inc @@ -20,7 +20,8 @@ type { fd are int in C also for 64bit targets (x86_64) } THandle = Longint; - + TThreadID = THandle; + { pthread_mutex_t } PRTLCriticalSection = ^TRTLCriticalSection; TRTLCriticalSection = record @@ -37,7 +38,10 @@ type { $Log$ - Revision 1.2 2005-02-14 17:13:21 peter + Revision 1.3 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.2 2005/02/14 17:13:21 peter * truncate log Revision 1.1 2005/02/06 12:16:52 peter diff --git a/rtl/emx/sysosh.inc b/rtl/emx/sysosh.inc index acd6248609..764e25971d 100644 --- a/rtl/emx/sysosh.inc +++ b/rtl/emx/sysosh.inc @@ -19,24 +19,29 @@ {Platform specific information} type THandle = Longint; - - { the fields of this record are os dependent } - { and they shouldn't be used in a program } - { only the type TCriticalSection is important } - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = packed record - DebugInfo : pointer; - LockCount : longint; - RecursionCount : longint; - OwningThread : DWord; - LockSemaphore : DWord; - Reserved : DWord; - end; + + TThreadID = THandle; + + { the fields of this record are os dependent } + { and they shouldn't be used in a program } + { only the type TCriticalSection is important } + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = packed record + DebugInfo : pointer; + LockCount : longint; + RecursionCount : longint; + OwningThread : DWord; + LockSemaphore : DWord; + Reserved : DWord; + end; { $Log$ - Revision 1.1 2005-02-06 16:57:18 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/06 16:57:18 peter * threads for go32v2,os,emx,netware Revision 1.1 2005/02/06 13:06:20 peter diff --git a/rtl/go32v2/sysosh.inc b/rtl/go32v2/sysosh.inc index a7dedb8bde..dba0677f9b 100644 --- a/rtl/go32v2/sysosh.inc +++ b/rtl/go32v2/sysosh.inc @@ -19,16 +19,20 @@ {Platform specific information} type THandle = Longint; - - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = record - Locked: boolean - end; + TThreadID = THandle; + + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = record + Locked: boolean + end; { $Log$ - Revision 1.1 2005-02-06 16:57:18 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/06 16:57:18 peter * threads for go32v2,os,emx,netware Revision 1.1 2005/02/06 13:06:20 peter diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc index 93e81c4dda..b1338de629 100644 --- a/rtl/inc/threadh.inc +++ b/rtl/inc/threadh.inc @@ -3,7 +3,7 @@ This file is part of the Free Pascal Run time library. Copyright (c) 2000 by the Free Pascal development team - This File contains the OS indenpendend declartions for multi + This file contains the OS indenpendend declartions for multi threading support in FPC See the File COPYING.FPC, included in this distribution, @@ -26,15 +26,15 @@ type trtlmethod = procedure of object; // Function prototypes for TThreadManager Record. - TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : THandle) : DWord; + TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : TThreadID) : DWord; TEndThreadHandler = Procedure (ExitCode : DWord); // Used for Suspend/Resume/Kill - TThreadHandler = Function (threadHandle : dword) : dword; + TThreadHandler = Function (threadHandle : TThreadID) : dword; TThreadSwitchHandler = Procedure; - TWaitForThreadTerminateHandler = Function (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} - TThreadSetPriorityHandler = Function (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} - TThreadGetPriorityHandler = Function (threadHandle : dword): longint; - TGetCurrentThreadIdHandler = Function : dword; + TWaitForThreadTerminateHandler = Function (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout} + TThreadSetPriorityHandler = Function (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal} + TThreadGetPriorityHandler = Function (threadHandle : TThreadID): longint; + TGetCurrentThreadIdHandler = Function : TThreadID; TCriticalSectionHandler = Procedure (var cs); TInitThreadVarHandler = Procedure(var offset : dword;size : dword); TRelocateThreadVarHandler = Function(offset : dword) : pointer; @@ -114,19 +114,19 @@ function BeginThread(sa : Pointer;stacksize : dword; { to other OSes too ... } function BeginThread(ThreadFunction : tthreadfunc) : DWord; function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord; -function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : THandle) : DWord; +function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : TThreadID) : DWord; procedure EndThread(ExitCode : DWord); procedure EndThread; {some thread support functions} -function SuspendThread (threadHandle : dword) : dword; -function ResumeThread (threadHandle : dword) : dword; +function SuspendThread (threadHandle : TThreadID) : dword; +function ResumeThread (threadHandle : TThreadID) : dword; procedure ThreadSwitch; {give time to other threads} -function KillThread (threadHandle : dword) : dword; -function WaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} -function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} -function ThreadGetPriority (threadHandle : dword): longint; +function KillThread (threadHandle : TThreadID) : dword; +function WaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout} +function ThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal} +function ThreadGetPriority (threadHandle : TThreadID): longint; function GetCurrentThreadId : dword; @@ -155,7 +155,10 @@ procedure RTLeventsync(m:trtlmethod;p:tprocedure); { $Log$ - Revision 1.29 2005-04-09 17:26:08 florian + Revision 1.30 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.29 2005/04/09 17:26:08 florian + classes.mainthreadid is set now + rtleventresetevent + rtleventwairfor with timeout diff --git a/rtl/linux/sysosh.inc b/rtl/linux/sysosh.inc index 51a999593c..8b5fcf2f19 100644 --- a/rtl/linux/sysosh.inc +++ b/rtl/linux/sysosh.inc @@ -20,7 +20,8 @@ type { fd are int in C also for 64bit targets (x86_64) } THandle = Longint; - + TThreadID = THandle; + { pthread_mutex_t } PRTLCriticalSection = ^TRTLCriticalSection; TRTLCriticalSection = record @@ -37,7 +38,10 @@ type { $Log$ - Revision 1.2 2005-02-14 17:13:30 peter + Revision 1.3 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.2 2005/02/14 17:13:30 peter * truncate log Revision 1.1 2005/02/06 11:20:52 peter diff --git a/rtl/macos/sysosh.inc b/rtl/macos/sysosh.inc index 857987d467..ae74ebeaee 100644 --- a/rtl/macos/sysosh.inc +++ b/rtl/macos/sysosh.inc @@ -19,10 +19,11 @@ {Platform specific information} type {$ifdef CPU64} - THandle = Int64; + THandle = Int64; {$else CPU64} THandle = Longint; {$endif CPU64} + TThreadID = THandle; PRTLCriticalSection = ^TRTLCriticalSection; TRTLCriticalSection = record @@ -32,7 +33,10 @@ type { $Log$ - Revision 1.1 2005-02-07 21:30:12 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/07 21:30:12 peter * system unit updated Revision 1.1 2005/02/06 16:57:18 peter diff --git a/rtl/morphos/sysosh.inc b/rtl/morphos/sysosh.inc index 857987d467..cae2a083ec 100644 --- a/rtl/morphos/sysosh.inc +++ b/rtl/morphos/sysosh.inc @@ -23,16 +23,20 @@ type {$else CPU64} THandle = Longint; {$endif CPU64} - - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = record - Locked: boolean - end; + TThreadID = THandle; + + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = record + Locked: boolean + end; { $Log$ - Revision 1.1 2005-02-07 21:30:12 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/07 21:30:12 peter * system unit updated Revision 1.1 2005/02/06 16:57:18 peter diff --git a/rtl/netware/sysosh.inc b/rtl/netware/sysosh.inc index bb80091f62..da66715c13 100644 --- a/rtl/netware/sysosh.inc +++ b/rtl/netware/sysosh.inc @@ -19,7 +19,8 @@ type THandle = DWord; - + TThreadID = THandle; + { the fields of this record are os dependent } { and they shouldn't be used in a program } { only the type TCriticalSection is important } @@ -42,7 +43,10 @@ const { $Log$ - Revision 1.1 2005-02-06 16:57:18 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/06 16:57:18 peter * threads for go32v2,os,emx,netware Revision 1.1 2005/02/06 13:06:20 peter diff --git a/rtl/netwlibc/sysosh.inc b/rtl/netwlibc/sysosh.inc index 0445eaeb54..457bf1673c 100644 --- a/rtl/netwlibc/sysosh.inc +++ b/rtl/netwlibc/sysosh.inc @@ -17,17 +17,21 @@ **********************************************************************} type - THandle = DWord; - - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = packed record - mutex : pointer; - reserved : array[0..52] of dword; - end; + THandle = DWord; + TThreadID = THandle; + + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = packed record + mutex : pointer; + reserved : array[0..52] of dword; + end; { $Log$ - Revision 1.2 2005-02-14 17:13:30 peter + Revision 1.3 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.2 2005/02/14 17:13:30 peter * truncate log Revision 1.1 2005/02/06 16:57:18 peter diff --git a/rtl/os2/sysosh.inc b/rtl/os2/sysosh.inc index acd6248609..e9f691453b 100644 --- a/rtl/os2/sysosh.inc +++ b/rtl/os2/sysosh.inc @@ -19,24 +19,28 @@ {Platform specific information} type THandle = Longint; - - { the fields of this record are os dependent } - { and they shouldn't be used in a program } - { only the type TCriticalSection is important } - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = packed record - DebugInfo : pointer; - LockCount : longint; - RecursionCount : longint; - OwningThread : DWord; - LockSemaphore : DWord; - Reserved : DWord; - end; + TThreadID = THandle; + + { the fields of this record are os dependent } + { and they shouldn't be used in a program } + { only the type TCriticalSection is important } + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = packed record + DebugInfo : pointer; + LockCount : longint; + RecursionCount : longint; + OwningThread : DWord; + LockSemaphore : DWord; + Reserved : DWord; + end; { $Log$ - Revision 1.1 2005-02-06 16:57:18 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/06 16:57:18 peter * threads for go32v2,os,emx,netware Revision 1.1 2005/02/06 13:06:20 peter diff --git a/rtl/solaris/sysosh.inc b/rtl/solaris/sysosh.inc index 8786aabc03..733011134a 100644 --- a/rtl/solaris/sysosh.inc +++ b/rtl/solaris/sysosh.inc @@ -18,16 +18,20 @@ type THandle = Longint; - - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = record - {$warning TODO TRTLCriticalSection} - Locked: boolean - end; + TThreadID = THandle; + + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = record + {$warning TODO TRTLCriticalSection} + Locked: boolean + end; { $Log$ - Revision 1.1 2005-02-10 17:30:54 peter + Revision 1.2 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.1 2005/02/10 17:30:54 peter * renamed to solaris Revision 1.1 2005/02/07 22:17:26 peter diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp index b15d0ea3db..1a3374629e 100644 --- a/rtl/unix/cthreads.pp +++ b/rtl/unix/cthreads.pp @@ -197,90 +197,91 @@ Type PINTRTLEvent = ^TINTRTLEvent; end; - function CBeginThread(sa : Pointer;stacksize : dword; - ThreadFunction : tthreadfunc;p : pointer; - creationFlags : dword; var ThreadId : THandle) : DWord; - var - ti : pthreadinfo; - thread_attr : pthread_attr_t; - begin + function CBeginThread(sa : Pointer;stacksize : dword; + ThreadFunction : tthreadfunc;p : pointer; + creationFlags : dword; var ThreadId : THandle) : DWord; + var + ti : pthreadinfo; + thread_attr : pthread_attr_t; + begin {$ifdef DEBUG_MT} - writeln('Creating new thread'); + writeln('Creating new thread'); {$endif DEBUG_MT} - { Initialize multithreading if not done } - if not IsMultiThread then - begin + { Initialize multithreading if not done } + if not IsMultiThread then + begin {$ifdef HASTHREADVAR} - { We're still running in single thread mode, setup the TLS } - pthread_key_create(@TLSKey,nil); - InitThreadVars(@CRelocateThreadvar); + { We're still running in single thread mode, setup the TLS } + pthread_key_create(@TLSKey,nil); + InitThreadVars(@CRelocateThreadvar); {$endif HASTHREADVAR} - IsMultiThread:=true; - end; - { the only way to pass data to the newly created thread - in a MT safe way, is to use the heap } - new(ti); - ti^.f:=ThreadFunction; - ti^.p:=p; - ti^.stklen:=stacksize; - { call pthread_create } + IsMultiThread:=true; + end; + { the only way to pass data to the newly created thread + in a MT safe way, is to use the heap } + new(ti); + ti^.f:=ThreadFunction; + ti^.p:=p; + ti^.stklen:=stacksize; + { call pthread_create } {$ifdef DEBUG_MT} - writeln('Starting new thread'); + writeln('Starting new thread'); {$endif DEBUG_MT} - pthread_attr_init(@thread_attr); - pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED); + pthread_attr_init(@thread_attr); + pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED); - // will fail under linux -- apparently unimplemented - pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS); + // will fail under linux -- apparently unimplemented + pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS); - // don't create detached, we need to be able to join (waitfor) on - // the newly created thread! - //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED); - if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin - threadid := 0; - end; - CBeginThread:=threadid; + // don't create detached, we need to be able to join (waitfor) on + // the newly created thread! + //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED); + if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin + threadid := 0; + end; + CBeginThread:=threadid; {$ifdef DEBUG_MT} - writeln('BeginThread returning ',CBeginThread); + writeln('BeginThread returning ',CBeginThread); {$endif DEBUG_MT} - end; + end; - procedure CEndThread(ExitCode : DWord); - begin - DoneThread; - pthread_detach(pthread_t(pthread_self())); - pthread_exit(pointer(ptrint(ExitCode))); - end; + procedure CEndThread(ExitCode : DWord); + begin + DoneThread; + pthread_detach(pthread_t(pthread_self())); + pthread_exit(pointer(ptrint(ExitCode))); + end; -{$warning threadhandle can be larger than a dword} - function CSuspendThread (threadHandle : dword) : dword; + + function CSuspendThread (threadHandle : TThreadID) : dword; begin {$Warning SuspendThread needs to be implemented} end; -{$warning threadhandle can be larger than a dword} - function CResumeThread (threadHandle : dword) : dword; + + function CResumeThread (threadHandle : TThreadID) : dword; begin {$Warning ResumeThread needs to be implemented} end; - procedure CThreadSwitch; {give time to other threads} + + procedure CThreadSwitch; {give time to other threads} begin {extern int pthread_yield (void) __THROW;} {$Warning ThreadSwitch needs to be implemented} end; -{$warning threadhandle can be larger than a dword} - function CKillThread (threadHandle : dword) : dword; + + function CKillThread (threadHandle : TThreadID) : dword; begin pthread_detach(pthread_t(threadHandle)); CKillThread := pthread_cancel(pthread_t(threadHandle)); end; -{$warning threadhandle can be larger than a dword} - function CWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} + + function CWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword; {0=no timeout} var LResultP: Pointer; LResult: DWord; @@ -292,20 +293,20 @@ Type PINTRTLEvent = ^TINTRTLEvent; end; {$warning threadhandle can be larger than a dword} - function CThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} + function CThreadSetPriority (threadHandle : TThreadID; Prio: longint): boolean; {-15..+15, 0=normal} begin {$Warning ThreadSetPriority needs to be implemented} end; {$warning threadhandle can be larger than a dword} - function CThreadGetPriority (threadHandle : dword): Integer; + function CThreadGetPriority (threadHandle : TThreadID): Integer; begin {$Warning ThreadGetPriority needs to be implemented} end; + -{$warning threadhandle can be larger than a dword} - function CGetCurrentThreadId : dword; + function CGetCurrentThreadId : TThreadID; begin CGetCurrentThreadId:=dword(pthread_self()); end; @@ -659,7 +660,10 @@ finalization end. { $Log$ - Revision 1.27 2005-04-09 18:45:43 florian + Revision 1.28 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.27 2005/04/09 18:45:43 florian * fixed some unix stuff Revision 1.26 2005/04/09 17:26:08 florian diff --git a/rtl/watcom/system.pp b/rtl/watcom/system.pp index 442612df84..05f911ccab 100644 --- a/rtl/watcom/system.pp +++ b/rtl/watcom/system.pp @@ -34,7 +34,8 @@ INTERFACE {Platform specific information} type THandle = Longint; - + TThreadID = THandle; + const LineEnding = #13#10; { LFNSupport is a variable here, defined below!!! } @@ -1540,7 +1541,10 @@ End. { $Log$ - Revision 1.21 2005-04-03 21:10:59 hajny + Revision 1.22 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.21 2005/04/03 21:10:59 hajny * EOF_CTRLZ conditional define replaced with CtrlZMarksEOF, #26 handling made more consistent (fix for bug 2453) Revision 1.20 2005/02/14 17:13:32 peter diff --git a/rtl/win32/sysosh.inc b/rtl/win32/sysosh.inc index ecc5cab87e..3786cbad10 100644 --- a/rtl/win32/sysosh.inc +++ b/rtl/win32/sysosh.inc @@ -23,23 +23,27 @@ type {$else CPU64} THandle = DWord; {$endif CPU64} - - { the fields of this record are os dependent } - { and they shouldn't be used in a program } - { only the type TCriticalSection is important } - PRTLCriticalSection = ^TRTLCriticalSection; - TRTLCriticalSection = packed record - DebugInfo : pointer; - LockCount : longint; - RecursionCount : longint; - OwningThread : DWord; - LockSemaphore : DWord; - Reserved : DWord; - end; + TThreadID = THandle; + + { the fields of this record are os dependent } + { and they shouldn't be used in a program } + { only the type TCriticalSection is important } + PRTLCriticalSection = ^TRTLCriticalSection; + TRTLCriticalSection = packed record + DebugInfo : pointer; + LockCount : longint; + RecursionCount : longint; + OwningThread : DWord; + LockSemaphore : DWord; + Reserved : DWord; + end; { $Log$ - Revision 1.2 2005-02-14 17:13:32 peter + Revision 1.3 2005-04-13 20:10:50 florian + + TThreadID + + Revision 1.2 2005/02/14 17:13:32 peter * truncate log Revision 1.1 2005/02/06 13:06:20 peter