From 4b2084fb5009a9f007137d524a66f9abab6b748e Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 26 Nov 2003 20:10:59 +0000 Subject: [PATCH] + New threadmanager implementation --- rtl/inc/thread.inc | 241 ++++++++++++++++++++- rtl/inc/threadh.inc | 59 ++++- rtl/inc/threadvr.inc | 32 +-- rtl/linux/pthread.inc | 133 +++++++++++- rtl/unix/cthreads.pp | 487 ++++++++++++++++++++++++++++++++++++++++++ rtl/unix/systhrds.pp | 349 ++---------------------------- rtl/win32/systhrds.pp | 97 ++++++--- 7 files changed, 1019 insertions(+), 379 deletions(-) create mode 100644 rtl/unix/cthreads.pp diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc index 456f88fb1b..7cd6245184 100644 --- a/rtl/inc/thread.inc +++ b/rtl/inc/thread.inc @@ -78,10 +78,249 @@ EndThread(0); end; +Var + CurrentTM : TThreadManager; + +function BeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : DWord) : DWord; + +begin + Result:=CurrentTM.BeginThread(sa,stacksize,threadfunction,P,creationflags,ThreadID); +end; + +procedure EndThread(ExitCode : DWord); + +begin + CurrentTM.EndThread(ExitCode); +end; + +function SuspendThread (threadHandle : dword) : dword; + +begin + Result:=CurrentTM.SuspendThread(ThreadHandle); +end; + +function ResumeThread (threadHandle : dword) : dword; + +begin + Result:=CurrentTM.ResumeThread(ThreadHandle); +end; + +procedure ThreadSwitch; + +begin + CurrentTM.ThreadSwitch; +end; + +function KillThread (threadHandle : dword) : dword; + +begin + Result:=CurrentTM.KillThread(ThreadHandle); +end; + +function WaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; + +begin + Result:=CurrentTM.WaitForThreadTerminate(ThreadHandle,TimeOutMS); +end; + +function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; +begin + Result:=CurrentTM.ThreadSetPriority(ThreadHandle,Prio); +end; + +function ThreadGetPriority (threadHandle : dword): Integer; + +begin + Result:=CurrentTM.ThreadGetPriority(ThreadHandle); +end; + +function GetCurrentThreadId : dword; + +begin + Result:=CurrentTM.GetCurrentThreadID(); +end; + +procedure InitCriticalSection(var cs : TRTLCriticalSection); + +begin + CurrentTM.InitCriticalSection(cs); +end; + +procedure DoneCriticalsection(var cs : TRTLCriticalSection); + +begin + CurrentTM.DoneCriticalSection(cs); +end; + +procedure EnterCriticalsection(var cs : TRTLCriticalSection); + +begin + CurrentTM.EnterCriticalSection(cs); +end; + +procedure LeaveCriticalsection(var cs : TRTLCriticalSection); + +begin + CurrentTM.LeaveCriticalSection(cs); +end; + +Function GetThreadManager(Var TM : TThreadManager) : Boolean; + +begin + TM:=CurrentTM; + Result:=True; +end; + +Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean; + +begin + Result:=True; + OldTM:=CurrentTM; + If Assigned(CurrentTM.DoneManager) then + Result:=CurrentTM.DoneManager(); + If Result then + begin + CurrentTM:=NewTM; + If Assigned(CurrentTM.InitManager) then + Result:=CurrentTM.InitManager(); + end; +end; + +{ --------------------------------------------------------------------- + ThreadManager which gives run-time error. Use if no thread support. + ---------------------------------------------------------------------} + + +Resourcestring + SNoThreads = 'This binary has no thread support compiled in.'; + SRecompileWithThreads = 'Recompile the application with a thread-driver in the program uses clause.'; + +Procedure NoThreadError; + +begin + If IsConsole then + begin + Writeln(StdErr,SNoThreads); + Writeln(StdErr,SRecompileWithThreads); + end; + RunError(232) +end; + +function NoBeginThread(sa : Pointer;stacksize : dword; + ThreadFunction : tthreadfunc;p : pointer; + creationFlags : dword; var ThreadId : DWord) : DWord; +begin + NoThreadError; +end; + +procedure NoEndThread(ExitCode : DWord); +begin + NoThreadError; +end; + +function NoThreadHandler (threadHandle : dword) : dword; +begin + NoThreadError; +end; + +procedure NoThreadSwitch; {give time to other threads} +begin + NoThreadError; +end; + +function NoWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} +begin + NoThreadError; +end; + +function NoThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} +begin + NoThreadError; +end; + +function NoThreadGetPriority (threadHandle : dword): Integer; +begin + NoThreadError; +end; + +function NoGetCurrentThreadId : dword; +begin + NoThreadError; +end; + +procedure NoCriticalSection(var CS); + +begin + NoThreadError; +end; + +procedure NoInitThreadvar(var offset : dword;size : dword); + +begin + NoThreadError; +end; + +function NoRelocateThreadvar(offset : dword) : pointer; + +begin + NoThreadError; +end; + + +procedure NoAllocateThreadVars; + +begin + NoThreadError; +end; + +procedure NoReleaseThreadVars; + +begin + NoThreadError; +end; + +Var + NoThreadManager : TThreadManager; + +Procedure SetNoThreadManager; + +Var + Dummy : TThreadManager; + +begin + With NoThreadManager do + begin + InitManager :=Nil; + DoneManager :=Nil; + BeginThread :=@NoBeginThread; + EndThread :=@NoEndThread; + SuspendThread :=@NoThreadHandler; + ResumeThread :=@NoThreadHandler; + KillThread :=@NoThreadHandler; + ThreadSwitch :=@NoThreadSwitch; + WaitForThreadTerminate :=@NoWaitForThreadTerminate; + ThreadSetPriority :=@NoThreadSetPriority; + ThreadGetPriority :=@NoThreadGetPriority; + GetCurrentThreadId :=@NoGetCurrentThreadId; + InitCriticalSection :=@NoCriticalSection; + DoneCriticalSection :=@NoCriticalSection; + EnterCriticalSection :=@NoCriticalSection; + LeaveCriticalSection :=@NoCriticalSection; + InitThreadVar :=@NoInitThreadVar; + RelocateThreadVar :=@NoRelocateThreadVar; + AllocateThreadVars :=@NoAllocateThreadVars; + ReleaseThreadVars :=@NoReleaseThreadVars; + end; + SetThreadManager(NoThreadManager,Dummy); +end; + { $Log$ - Revision 1.3 2002-11-14 12:40:06 jonas + Revision 1.4 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.3 2002/11/14 12:40:06 jonas * the BeginThread() variant that allowed you to specify the stacksize still passed DefaultStackSize to the OS-specific routines diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc index 7e5b265dcb..0e7dfe1367 100644 --- a/rtl/inc/threadh.inc +++ b/rtl/inc/threadh.inc @@ -20,7 +20,59 @@ const type - TThreadFunc = function(parameter : pointer) : longint; + TThreadFunc = function(parameter : pointer) : longint; + + // Function prototypes for TThreadManager Record. + TBeginThreadHandler = Function (sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword; var ThreadId : DWord) : DWord; + TEndThreadHandler = Procedure (ExitCode : DWord); + // Used for Suspend/Resume/Kill + TThreadHandler = Function (threadHandle : dword) : 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): Integer; + TGetCurrentThreadIdHandler = Function : dword; + TCriticalSectionHandler = Procedure (var cs); + TInitThreadVarHandler = Procedure(var offset : dword;size : dword); + TRelocateThreadVarHandler = Function(offset : dword) : pointer; + TAllocateThreadVarsHandler = Procedure; + TReleaseThreadVarsHandler = Procedure; + + // TThreadManager interface. + TThreadManager = Record + InitManager : Function : Boolean; + DoneManager : Function : Boolean; + BeginThread : TBeginThreadHandler; + EndThread : TEndThreadHandler; + SuspendThread : TThreadHandler; + ResumeThread : TThreadHandler; + KillThread : TThreadHandler; + ThreadSwitch : TThreadSwitchHandler; + WaitForThreadTerminate : TWaitForThreadTerminateHandler; + ThreadSetPriority : TThreadSetPriorityHandler; + ThreadGetPriority : TThreadGetPriorityHandler; + GetCurrentThreadId : TGetCurrentThreadIdHandler; + InitCriticalSection : TCriticalSectionHandler; + DoneCriticalSection : TCriticalSectionHandler; + EnterCriticalSection : TCriticalSectionHandler; + LeaveCriticalSection : TCriticalSectionHandler; + InitThreadVar : TInitThreadVarHandler; + RelocateThreadVar : TRelocateThreadVarHandler; + AllocateThreadVars : TAllocateThreadVarsHandler; + ReleaseThreadVars : TReleaseThreadVarsHandler; + end; + +{***************************************************************************** + Thread Handler routines +*****************************************************************************} + + +Function GetThreadManager(Var TM : TThreadManager) : Boolean; +Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean; +Procedure SetNoThreadManager; +// Needs to be exported, so the manager can call it. +procedure InitThreadVars(RelocProc : Pointer); +procedure InitThread(stklen:cardinal); {***************************************************************************** Multithread Handling @@ -65,7 +117,10 @@ procedure LeaveCriticalsection(var cs : TRTLCriticalSection); { $Log$ - Revision 1.11 2003-10-01 21:00:09 peter + Revision 1.12 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.11 2003/10/01 21:00:09 peter * GetCurrentThreadHandle renamed to GetCurrentThreadId Revision 1.10 2003/03/27 17:14:27 armin diff --git a/rtl/inc/threadvr.inc b/rtl/inc/threadvr.inc index 039162705f..134979956b 100644 --- a/rtl/inc/threadvr.inc +++ b/rtl/inc/threadvr.inc @@ -41,7 +41,7 @@ procedure init_unit_threadvars (tableEntry : pltvInitEntry); begin while tableEntry^.varaddr <> nil do begin - SysInitThreadvar (tableEntry^.varaddr^, tableEntry^.size); + CurrentTM.InitThreadvar (tableEntry^.varaddr^, tableEntry^.size); inc (pchar (tableEntry), sizeof (tableEntry^)); end; end; @@ -66,7 +66,7 @@ var begin while tableEntry^.varaddr <> nil do begin - newp:=SysRelocateThreadVar(tableEntry^.varaddr^); + newp:=CurrentTM.RelocateThreadVar(tableEntry^.varaddr^); oldp:=pointer(pchar(tableEntry^.varaddr)+4); move(oldp^,newp^,tableEntry^.size); inc (pchar (tableEntry), sizeof (tableEntry^)); @@ -85,23 +85,27 @@ begin copy_unit_threadvars (ThreadvarTablesTable.tables[i]); end; - procedure InitThreadVars(RelocProc : Pointer); - begin - { initialize threadvars } - init_all_unit_threadvars; - { allocate mem for main thread threadvars } - SysAllocateThreadVars; - { copy main thread threadvars } - copy_all_unit_threadvars; - { install threadvar handler } - fpc_threadvar_relocate_proc:=RelocProc; - end; +procedure InitThreadVars(RelocProc : Pointer); + +begin + { initialize threadvars } + init_all_unit_threadvars; + { allocate mem for main thread threadvars } + CurrentTM.AllocateThreadVars; + { copy main thread threadvars } + copy_all_unit_threadvars; + { install threadvar handler } + fpc_threadvar_relocate_proc:=RelocProc; +end; {$endif HASTHREADVAR} { $Log$ - Revision 1.1 2002-10-31 13:46:11 carl + Revision 1.2 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.1 2002/10/31 13:46:11 carl * threadvar.inc -> threadvr.inc Revision 1.2 2002/10/16 19:04:27 michael diff --git a/rtl/linux/pthread.inc b/rtl/linux/pthread.inc index 2eb5b0b20a..cc9b7543fe 100644 --- a/rtl/linux/pthread.inc +++ b/rtl/linux/pthread.inc @@ -142,6 +142,7 @@ t_pthread_cleanup_push_routine = procedure (_para1:pointer); t_pthread_cleanup_push_defer_routine = procedure (_para1:pointer); +{$ifndef dynpthreads} function pthread_create(__thread:ppthread_t; __attr:ppthread_attr_t;__start_routine: __start_routine_t;__arg:pointer):longint;cdecl;external; function pthread_self:pthread_t;cdecl;external; function pthread_equal(__thread1:pthread_t; __thread2:pthread_t):longint;cdecl;external; @@ -195,10 +196,140 @@ function sigwait(__set:psigset_t; __sig:plongint):longint;cdecl;external; function pthread_atfork(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl;external; procedure pthread_kill_other_threads_np;cdecl;external; +{$else} +Var + pthread_create : Function(__thread:ppthread_t; __attr:ppthread_attr_t;__start_routine: __start_routine_t;__arg:pointer):longint;cdecl; + pthread_self: Function : pthread_t;cdecl; + pthread_equal : Function(__thread1:pthread_t; __thread2:pthread_t):longint;cdecl; + pthread_exit : procedure (__retval:pointer);cdecl; + pthread_join : Function(__th:pthread_t; __thread_return:ppointer):longint;cdecl; + pthread_detach : Function(__th:pthread_t):longint;cdecl; + pthread_attr_init : Function(__attr:ppthread_attr_t):longint;cdecl; + pthread_attr_destroy : Function(__attr:ppthread_attr_t):longint;cdecl; + pthread_attr_setdetachstate : Function(__attr:ppthread_attr_t; __detachstate:longint):longint;cdecl; + pthread_attr_getdetachstate : Function(__attr:ppthread_attr_t; __detachstate:plongint):longint;cdecl; + pthread_attr_setschedparam : Function(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl; + pthread_attr_getschedparam : Function(__attr:ppthread_attr_t; __param:psched_param):longint;cdecl; + pthread_attr_setschedpolicy : Function(__attr:ppthread_attr_t; __policy:longint):longint;cdecl; + pthread_attr_getschedpolicy : Function(__attr:ppthread_attr_t; __policy:plongint):longint;cdecl; + pthread_attr_setinheritsched : Function(__attr:ppthread_attr_t; __inherit:longint):longint;cdecl; + pthread_attr_getinheritsched : Function(__attr:ppthread_attr_t; __inherit:plongint):longint;cdecl; + pthread_attr_setscope : Function(__attr:ppthread_attr_t; __scope:longint):longint;cdecl; + pthread_attr_getscope : Function(__attr:ppthread_attr_t; __scope:plongint):longint;cdecl; + pthread_setschedparam : Function(__target_thread:pthread_t; __policy:longint; __param:psched_param):longint;cdecl; + pthread_getschedparam : Function(__target_thread:pthread_t; __policy:plongint; __param:psched_param):longint;cdecl; + pthread_mutex_init : Function(__mutex:ppthread_mutex_t; __mutex_attr:ppthread_mutexattr_t):longint;cdecl; + pthread_mutex_destroy : Function(__mutex:ppthread_mutex_t):longint;cdecl; + pthread_mutex_trylock : Function(__mutex:ppthread_mutex_t):longint;cdecl; + pthread_mutex_lock : Function(__mutex:ppthread_mutex_t):longint;cdecl; + pthread_mutex_unlock : Function(__mutex:ppthread_mutex_t):longint;cdecl; + pthread_mutexattr_init : Function(__attr:ppthread_mutexattr_t):longint;cdecl; + pthread_mutexattr_destroy : Function(__attr:ppthread_mutexattr_t):longint;cdecl; + pthread_mutexattr_setkind_np : Function(__attr:ppthread_mutexattr_t; __kind:longint):longint;cdecl; + pthread_mutexattr_getkind_np : Function(__attr:ppthread_mutexattr_t; __kind:plongint):longint;cdecl; + pthread_cond_init : Function(__cond:ppthread_cond_t; __cond_attr:ppthread_condattr_t):longint;cdecl; + pthread_cond_destroy : Function(__cond:ppthread_cond_t):longint;cdecl; + pthread_cond_signal : Function(__cond:ppthread_cond_t):longint;cdecl; + pthread_cond_broadcast : Function(__cond:ppthread_cond_t):longint;cdecl; + pthread_cond_wait : Function(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t):longint;cdecl; + pthread_cond_timedwait : Function(__cond:ppthread_cond_t; __mutex:ppthread_mutex_t; __abstime:ptimespec):longint;cdecl; + pthread_condattr_init : Function(__attr:ppthread_condattr_t):longint;cdecl; + pthread_condattr_destroy : Function(__attr:ppthread_condattr_t):longint;cdecl; + pthread_key_create : Function(__key:ppthread_key_t; __destr_function:__destr_function_t):longint;cdecl; + pthread_key_delete : Function(__key:pthread_key_t):longint;cdecl; + pthread_setspecific : Function(__key:pthread_key_t; __pointer:pointer):longint;cdecl; + pthread_getspecific : Function(__key:pthread_key_t):pointer;cdecl; + pthread_once : Function(__once_control:ppthread_once_t; __init_routine:tprocedure ):longint;cdecl; + pthread_setcancelstate : Function(__state:longint; __oldstate:plongint):longint;cdecl; + pthread_setcanceltype : Function(__type:longint; __oldtype:plongint):longint;cdecl; + pthread_cancel : Function(__thread:pthread_t):longint;cdecl; + pthread_testcancel : Procedure ;cdecl; + _pthread_cleanup_push : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_routine; __arg:pointer);cdecl; + _pthread_cleanup_push_defer : procedure (__buffer:p_pthread_cleanup_buffer;__routine:t_pthread_cleanup_push_defer_routine; __arg:pointer);cdecl; + pthread_sigmask : Function(__how:longint; __newmask:psigset_t; __oldmask:psigset_t):longint;cdecl; + pthread_kill : Function(__thread:pthread_t; __signo:longint):longint;cdecl; + sigwait : Function(__set:psigset_t; __sig:plongint):longint;cdecl; + pthread_atfork : Function(__prepare:tprocedure ; __parent:tprocedure ; __child:tprocedure ):longint;cdecl; + pthread_kill_other_threads_np : procedure;cdecl; + +Var + PthreadDLL : Pointer; + +Function LoadPthreads : Boolean; + +begin + PThreadDLL:=DlOpen('libpthread.so.0',RTLD_LAZY); + Result:=PThreadDLL<>Nil; + If Not Result then + exit; + Pointer(pthread_create) := dlsym(PthreadDLL,'pthread_create'); + Pointer(pthread_self) := dlsym(PthreadDLL,'pthread_self'); + Pointer(pthread_equal) := dlsym(PthreadDLL,'pthread_equal'); + Pointer(pthread_exit) := dlsym(PthreadDLL,'pthread_exit'); + Pointer(pthread_join) := dlsym(PthreadDLL,'pthread_join'); + Pointer(pthread_detach) := dlsym(PthreadDLL,'pthread_detach'); + Pointer(pthread_attr_init) := dlsym(PthreadDLL,'pthread_attr_init'); + Pointer(pthread_attr_destroy) := dlsym(PthreadDLL,'pthread_attr_destroy'); + Pointer(pthread_attr_setdetachstate) := dlsym(PthreadDLL,'pthread_attr_setdetachstate'); + Pointer(pthread_attr_getdetachstate) := dlsym(PthreadDLL,'pthread_attr_getdetachstate'); + Pointer(pthread_attr_setschedparam) := dlsym(PthreadDLL,'pthread_attr_setschedparam'); + Pointer(pthread_attr_getschedparam) := dlsym(PthreadDLL,'pthread_attr_getschedparam'); + Pointer(pthread_attr_setschedpolicy) := dlsym(PthreadDLL,'pthread_attr_setschedpolicy'); + Pointer(pthread_attr_getschedpolicy) := dlsym(PthreadDLL,'pthread_attr_getschedpolicy'); + Pointer(pthread_attr_setinheritsched) := dlsym(PthreadDLL,'pthread_attr_setinheritsched'); + Pointer(pthread_attr_getinheritsched) := dlsym(PthreadDLL,'pthread_attr_getinheritsched'); + Pointer(pthread_attr_setscope) := dlsym(PthreadDLL,'pthread_attr_setscope'); + Pointer(pthread_attr_getscope) := dlsym(PthreadDLL,'pthread_attr_getscope'); + Pointer(pthread_setschedparam) := dlsym(PthreadDLL,'pthread_setschedparam'); + Pointer(pthread_getschedparam) := dlsym(PthreadDLL,'pthread_getschedparam'); + Pointer(pthread_mutex_init) := dlsym(PthreadDLL,'pthread_mutex_init'); + Pointer(pthread_mutex_destroy) := dlsym(PthreadDLL,'pthread_mutex_destroy'); + Pointer(pthread_mutex_trylock) := dlsym(PthreadDLL,'pthread_mutex_trylock'); + Pointer(pthread_mutex_lock) := dlsym(PthreadDLL,'pthread_mutex_lock'); + Pointer(pthread_mutex_unlock) := dlsym(PthreadDLL,'pthread_mutex_unlock'); + Pointer(pthread_mutexattr_init) := dlsym(PthreadDLL,'pthread_mutexattr_init'); + Pointer(pthread_mutexattr_destroy) := dlsym(PthreadDLL,'pthread_mutexattr_destroy'); + Pointer(pthread_mutexattr_setkind_np) := dlsym(PthreadDLL,'pthread_mutexattr_setkind_np'); + Pointer(pthread_mutexattr_getkind_np) := dlsym(PthreadDLL,'pthread_mutexattr_getkind_np'); + Pointer(pthread_cond_init) := dlsym(PthreadDLL,'pthread_cond_init'); + Pointer(pthread_cond_destroy) := dlsym(PthreadDLL,'pthread_cond_destroy'); + Pointer(pthread_cond_signal) := dlsym(PthreadDLL,'pthread_cond_signal'); + Pointer(pthread_cond_broadcast) := dlsym(PthreadDLL,'pthread_cond_broadcast'); + Pointer(pthread_cond_wait) := dlsym(PthreadDLL,'pthread_cond_wait'); + Pointer(pthread_cond_timedwait) := dlsym(PthreadDLL,'pthread_cond_timedwait'); + Pointer(pthread_condattr_init) := dlsym(PthreadDLL,'pthread_condattr_init'); + Pointer(pthread_condattr_destroy) := dlsym(PthreadDLL,'pthread_condattr_destroy'); + Pointer(pthread_key_create) := dlsym(PthreadDLL,'pthread_key_create'); + Pointer(pthread_key_delete) := dlsym(PthreadDLL,'pthread_key_delete'); + Pointer(pthread_setspecific) := dlsym(PthreadDLL,'pthread_setspecific'); + Pointer(pthread_getspecific) := dlsym(PthreadDLL,'pthread_getspecific'); + Pointer(pthread_once) := dlsym(PthreadDLL,'pthread_once'); + Pointer(pthread_setcancelstate) := dlsym(PthreadDLL,'pthread_setcancelstate'); + Pointer(pthread_setcanceltype) := dlsym(PthreadDLL,'pthread_setcanceltype'); + Pointer(pthread_cancel) := dlsym(PthreadDLL,'pthread_cancel'); + Pointer(pthread_testcancel) := dlsym(PthreadDLL,'pthread_testcancel'); + Pointer(_pthread_cleanup_push) := dlsym(PthreadDLL,'_pthread_cleanup_push'); + Pointer(_pthread_cleanup_push_defer) := dlsym(PthreadDLL,'_pthread_cleanup_push_defer'); + Pointer(pthread_sigmask) := dlsym(PthreadDLL,'pthread_sigmask'); + Pointer(pthread_kill) := dlsym(PthreadDLL,'pthread_kill'); + Pointer(pthread_atfork) := dlsym(PthreadDLL,'pthread_atfork'); + Pointer(pthread_kill_other_threads_np) := dlsym(PthreadDLL,'pthread_kill_other_threads_np'); +end; + +Function UnLoadPthreads : Boolean; + +begin + Result:=dlclose(PThreadDLL)=0; +end; + +{$endif} { $Log$ - Revision 1.2 2003-09-14 20:15:01 marco + Revision 1.3 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.2 2003/09/14 20:15:01 marco * Unix reform stage two. Remove all calls from Unix that exist in Baseunix. Revision 1.1 2002/10/18 18:03:57 marco diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp new file mode 100644 index 0000000000..f400a17705 --- /dev/null +++ b/rtl/unix/cthreads.pp @@ -0,0 +1,487 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2002 by Peter Vreman, + member of the Free Pascal development team. + + Linux (pthreads) threading support implementation + + 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} +{$define dynpthreads} + +unit cthreads; +interface +{$S-} + +{$ifndef dynpthreads} +{$ifndef BSD} + {$linklib c} + {$linklib pthread} +{$else} + // Link reentrant libc with pthreads + {$linklib c_r} +{$endif} +{$endif} + +Procedure SetCThreadManager; + +implementation + +Uses + systhrds, + BaseUnix, + unix +{$ifdef dynpthreads} + ,dl +{$endif} + ; + +{***************************************************************************** + Generic overloaded +*****************************************************************************} + +{ Include OS specific parts. } +{$i pthread.inc} + +{***************************************************************************** + Threadvar support +*****************************************************************************} + +{$ifdef HASTHREADVAR} + const + threadvarblocksize : dword = 0; + + var + TLSKey : pthread_key_t; + + procedure CInitThreadvar(var offset : dword;size : dword); + begin + offset:=threadvarblocksize; + inc(threadvarblocksize,size); + end; + + function CRelocateThreadvar(offset : dword) : pointer; + begin + CRelocateThreadvar:=pthread_getspecific(tlskey)+Offset; + end; + + + procedure CAllocateThreadVars; + var + dataindex : pointer; + begin + { we've to allocate the memory from system } + { because the FPC heap management uses } + { exceptions which use threadvars but } + { these aren't allocated yet ... } + { allocate room on the heap for the thread vars } + DataIndex:=Pointer(Fpmmap(0,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0)); + FillChar(DataIndex^,threadvarblocksize,0); + pthread_setspecific(tlskey,dataindex); + end; + + + procedure CReleaseThreadVars; + begin + {$ifdef ver1_0} + Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize); + {$else} + Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize); + {$endif} + end; + +{ Include OS independent Threadvar initialization } + +{$endif HASTHREADVAR} + + +{***************************************************************************** + Thread starting +*****************************************************************************} + + type + pthreadinfo = ^tthreadinfo; + tthreadinfo = record + f : tthreadfunc; + p : pointer; + stklen : cardinal; + end; + + procedure DoneThread; + begin + { Release Threadvars } +{$ifdef HASTHREADVAR} + CReleaseThreadVars; +{$endif HASTHREADVAR} + end; + + + function ThreadMain(param : pointer) : pointer;cdecl; + var + ti : tthreadinfo; +{$ifdef DEBUG_MT} + // in here, don't use write/writeln before having called + // InitThread! I wonder if anyone ever debugged these routines, + // because they will have crashed if DEBUG_MT was enabled! + // this took me the good part of an hour to figure out + // why it was crashing all the time! + // this is kind of a workaround, we simply write(2) to fd 0 + s: string[100]; // not an ansistring +{$endif DEBUG_MT} + begin +{$ifdef DEBUG_MT} + s := 'New thread started, initing threadvars'#10; + fpwrite(0,s[1],length(s)); +{$endif DEBUG_MT} +{$ifdef HASTHREADVAR} + { Allocate local thread vars, this must be the first thing, + because the exception management and io depends on threadvars } + CAllocateThreadVars; +{$endif HASTHREADVAR} + { Copy parameter to local data } +{$ifdef DEBUG_MT} + s := 'New thread started, initialising ...'#10; + fpwrite(0,s[1],length(s)); +{$endif DEBUG_MT} + ti:=pthreadinfo(param)^; + dispose(pthreadinfo(param)); + { Initialize thread } + InitThread(ti.stklen); + { Start thread function } +{$ifdef DEBUG_MT} + writeln('Jumping to thread function'); +{$endif DEBUG_MT} + ThreadMain:=pointer(ti.f(ti.p)); + DoneThread; + pthread_detach(pointer(pthread_self)); + end; + + + function CBeginThread(sa : Pointer;stacksize : dword; + ThreadFunction : tthreadfunc;p : pointer; + creationFlags : dword; var ThreadId : DWord) : DWord; + var + ti : pthreadinfo; + thread_attr : pthread_attr_t; + begin +{$ifdef DEBUG_MT} + writeln('Creating new thread'); +{$endif DEBUG_MT} + { 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); +{$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 } +{$ifdef DEBUG_MT} + writeln('Starting new thread'); +{$endif DEBUG_MT} + 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); + + // 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 ',BeginThread); +{$endif DEBUG_MT} + end; + + + procedure CEndThread(ExitCode : DWord); + begin + DoneThread; + pthread_detach(pointer(pthread_self)); + pthread_exit(pointer(ExitCode)); + end; + + + function CSuspendThread (threadHandle : dword) : dword; + begin + {$Warning SuspendThread needs to be implemented} + end; + + function CResumeThread (threadHandle : dword) : dword; + begin + {$Warning ResumeThread needs to be implemented} + end; + + procedure CThreadSwitch; {give time to other threads} + begin + {extern int pthread_yield (void) __THROW;} + {$Warning ThreadSwitch needs to be implemented} + end; + + function CKillThread (threadHandle : dword) : dword; + begin + pthread_detach(pointer(threadHandle)); + CKillThread := pthread_cancel(Pointer(threadHandle)); + end; + + function CWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} + var + LResultP: Pointer; + LResult: DWord; + begin + LResult := 0; + LResultP := @LResult; + pthread_join(Pointer(threadHandle), @LResultP); + CWaitForThreadTerminate := LResult; + end; + + function CThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} + begin + {$Warning ThreadSetPriority needs to be implemented} + end; + + + function CThreadGetPriority (threadHandle : dword): Integer; + begin + {$Warning ThreadGetPriority needs to be implemented} + end; + + function CGetCurrentThreadId : dword; + begin + CGetCurrentThreadId:=dword(pthread_self); + end; + + +{***************************************************************************** + Delphi/Win32 compatibility +*****************************************************************************} + + procedure CInitCriticalSection(var CS); + + Var + P : PRTLCriticalSection; + + begin + P:=PRTLCriticalSection(@CS); + With p^ do + begin + m_spinlock:=0; + m_count:=0; + m_owner:=0; + m_kind:=1; + m_waiting.head:=0; + m_waiting.tail:=0; + end; + pthread_mutex_init(P,NIL); + end; + + procedure CEnterCriticalSection(var CS); + begin + pthread_mutex_lock(@CS); + end; + + procedure CLeaveCriticalSection(var CS); + begin + pthread_mutex_unlock(@CS); + end; + + procedure CDoneCriticalSection(var CS); + begin + pthread_mutex_destroy(@CS); + end; + + +{***************************************************************************** + Heap Mutex Protection +*****************************************************************************} + + var + HeapMutex : pthread_mutex_t; + + procedure PThreadHeapMutexInit; + begin + pthread_mutex_init(@heapmutex,nil); + end; + + procedure PThreadHeapMutexDone; + begin + pthread_mutex_destroy(@heapmutex); + end; + + procedure PThreadHeapMutexLock; + begin + pthread_mutex_lock(@heapmutex); + end; + + procedure PThreadHeapMutexUnlock; + begin + pthread_mutex_unlock(@heapmutex); + end; + + const + PThreadMemoryMutexManager : TMemoryMutexManager = ( + MutexInit : @PThreadHeapMutexInit; + MutexDone : @PThreadHeapMutexDone; + MutexLock : @PThreadHeapMutexLock; + MutexUnlock : @PThreadHeapMutexUnlock; + ); + + procedure InitHeapMutexes; + begin + SetMemoryMutexManager(PThreadMemoryMutexManager); + end; + +Function CInitThreads : Boolean; + +begin + Writeln('Entering InitThreads.'); +{$ifndef dynpthreads} + Result:=True; +{$else} + Result:=LoadPthreads; +{$endif} + Writeln('InitThreads : ',Result); +end; + +Function CDoneThreads : Boolean; + +begin +{$ifndef dynpthreads} + Result:=True; +{$else} + Result:=UnloadPthreads; +{$endif} +end; + + +Var + CThreadManager : TThreadManager; + +Procedure SetCThreadManager; + +Var + Dummy : TThreadManager; + +begin + With CThreadManager do + begin + InitManager :=@CInitThreads; + DoneManager :=@CDoneThreads; + BeginThread :=@CBeginThread; + EndThread :=@CEndThread; + SuspendThread :=@CSuspendThread; + ResumeThread :=@CResumeThread; + KillThread :=@CKillThread; + ThreadSwitch :=@CThreadSwitch; + WaitForThreadTerminate :=@CWaitForThreadTerminate; + ThreadSetPriority :=@CThreadSetPriority; + ThreadGetPriority :=@CThreadGetPriority; + GetCurrentThreadId :=@CGetCurrentThreadId; + InitCriticalSection :=@CInitCriticalSection; + DoneCriticalSection :=@CDoneCriticalSection; + EnterCriticalSection :=@CEnterCriticalSection; + LeaveCriticalSection :=@CLeaveCriticalSection; + InitThreadVar :=@CInitThreadVar; + RelocateThreadVar :=@CRelocateThreadVar; + AllocateThreadVars :=@CAllocateThreadVars; + ReleaseThreadVars :=@CReleaseThreadVars; + end; + SetThreadManager(CThreadManager,Dummy); + InitHeapMutexes; +end; + +initialization + SetCThreadManager; +end. +{ + $Log$ + Revision 1.1 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.20 2003/11/19 10:54:32 marco + * some simple restructures + + Revision 1.19 2003/11/18 22:36:12 marco + * Last patch was ok, problem was somewhere else. Moved *BSD part of pthreads to freebsd/pthreads.inc + + Revision 1.18 2003/11/18 22:35:09 marco + * Last patch was ok, problem was somewhere else. Moved *BSD part of pthreads to freebsd/pthreads.inc + + Revision 1.17 2003/11/17 10:05:51 marco + * threads for FreeBSD. Not working tho + + Revision 1.16 2003/11/17 08:27:50 marco + * pthreads based ttread from Johannes Berg + + Revision 1.15 2003/10/01 21:00:09 peter + * GetCurrentThreadHandle renamed to GetCurrentThreadId + + Revision 1.14 2003/10/01 20:53:08 peter + * GetCurrentThreadId implemented + + Revision 1.13 2003/09/20 12:38:29 marco + * FCL now compiles for FreeBSD with new 1.1. Now Linux. + + Revision 1.12 2003/09/16 13:17:03 marco + * Wat cleanup, ouwe syscalls nu via baseunix e.d. + + Revision 1.11 2003/09/16 13:00:02 marco + * small BSD gotcha removed (typing mmap params) + + Revision 1.10 2003/09/15 20:08:49 marco + * small fixes. FreeBSD now cycles + + Revision 1.9 2003/09/14 20:15:01 marco + * Unix reform stage two. Remove all calls from Unix that exist in Baseunix. + + Revision 1.8 2003/03/27 17:14:27 armin + * more platform independent thread routines, needs to be implemented for unix + + Revision 1.7 2003/01/05 19:11:32 marco + * small changes originating from introduction of Baseunix to FreeBSD + + Revision 1.6 2002/11/11 21:41:06 marco + * syscall.inc -> syscallo.inc + + Revision 1.5 2002/10/31 13:45:21 carl + * threadvar.inc -> threadvr.inc + + Revision 1.4 2002/10/26 18:27:52 marco + * First series POSIX calls commits. Including getcwd. + + Revision 1.3 2002/10/18 18:05:06 marco + * $I pthread.inc instead of pthreads.inc + + Revision 1.2 2002/10/18 12:19:59 marco + * Fixes to get the generic *BSD RTL compiling again + fixes for thread + support. Still problems left in fexpand. (inoutres?) Therefore fixed + sysposix not yet commited + + Revision 1.1 2002/10/16 06:22:56 michael + Threads renamed from threads to systhrds + + Revision 1.1 2002/10/14 19:39:17 peter + * threads unit added for thread support + +} + diff --git a/rtl/unix/systhrds.pp b/rtl/unix/systhrds.pp index 36aeb0b9e5..6191f63da7 100644 --- a/rtl/unix/systhrds.pp +++ b/rtl/unix/systhrds.pp @@ -14,17 +14,14 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -unit systhrds; -interface -{$S-} +{$mode objfpc} +{$define dynpthreads} -{$ifndef BSD} - {$linklib c} - {$linklib pthread} -{$else} - // Link reentrant libc with pthreads - {$linklib c_r} -{$endif} +unit systhrds; + +interface + +{ Posix compliant definition } type PRTLCriticalSection = ^TRTLCriticalSection; @@ -41,11 +38,8 @@ interface { Include generic thread interface } {$i threadh.inc} - implementation -Uses BaseUnix,unix; - {***************************************************************************** Generic overloaded *****************************************************************************} @@ -53,335 +47,26 @@ Uses BaseUnix,unix; { Include generic overloaded routines } {$i thread.inc} -{ Include OS specific parts. } -{$i pthread.inc} - -{***************************************************************************** - System dependent memory allocation -*****************************************************************************} - -{ -{$ifndef BSD} - -Const - - { Constants for MMAP } - MAP_PRIVATE =2; - MAP_ANONYMOUS =$20; - -{$else} - -{$ifdef FreeBSD} -CONST - { Constants for MMAP. These are still private for *BSD } - MAP_PRIVATE =2; - MAP_ANONYMOUS =$1000; -{$ELSE} - {$ENTER ME} -{$ENDIF} -{$ENDIF} -} -{***************************************************************************** - Threadvar support -*****************************************************************************} - -{$ifdef HASTHREADVAR} - const - threadvarblocksize : dword = 0; - - var - TLSKey : pthread_key_t; - - procedure SysInitThreadvar(var offset : dword;size : dword); - begin - offset:=threadvarblocksize; - inc(threadvarblocksize,size); - end; - - function SysRelocateThreadvar(offset : dword) : pointer; - begin - SysRelocateThreadvar:=pthread_getspecific(tlskey)+Offset; - end; - - - procedure SysAllocateThreadVars; - var - dataindex : pointer; - begin - { we've to allocate the memory from system } - { because the FPC heap management uses } - { exceptions which use threadvars but } - { these aren't allocated yet ... } - { allocate room on the heap for the thread vars } - DataIndex:=Pointer(Fpmmap(0,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0)); - FillChar(DataIndex^,threadvarblocksize,0); - pthread_setspecific(tlskey,dataindex); - end; - - - procedure SysReleaseThreadVars; - begin - {$ifdef ver1_0} - Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize); - {$else} - Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize); - {$endif} - end; - { Include OS independent Threadvar initialization } +{$ifdef HASTHREADVAR} {$i threadvr.inc} - - {$endif HASTHREADVAR} +Procedure InitSystemThreads; -{***************************************************************************** - Thread starting -*****************************************************************************} - - type - pthreadinfo = ^tthreadinfo; - tthreadinfo = record - f : tthreadfunc; - p : pointer; - stklen : cardinal; - end; - - procedure DoneThread; - begin - { Release Threadvars } -{$ifdef HASTHREADVAR} - SysReleaseThreadVars; -{$endif HASTHREADVAR} - end; - - - function ThreadMain(param : pointer) : pointer;cdecl; - var - ti : tthreadinfo; -{$ifdef DEBUG_MT} - // in here, don't use write/writeln before having called - // InitThread! I wonder if anyone ever debugged these routines, - // because they will have crashed if DEBUG_MT was enabled! - // this took me the good part of an hour to figure out - // why it was crashing all the time! - // this is kind of a workaround, we simply write(2) to fd 0 - s: string[100]; // not an ansistring -{$endif DEBUG_MT} - begin -{$ifdef DEBUG_MT} - s := 'New thread started, initing threadvars'#10; - fpwrite(0,s[1],length(s)); -{$endif DEBUG_MT} -{$ifdef HASTHREADVAR} - { Allocate local thread vars, this must be the first thing, - because the exception management and io depends on threadvars } - SysAllocateThreadVars; -{$endif HASTHREADVAR} - { Copy parameter to local data } -{$ifdef DEBUG_MT} - s := 'New thread started, initialising ...'#10; - fpwrite(0,s[1],length(s)); -{$endif DEBUG_MT} - ti:=pthreadinfo(param)^; - dispose(pthreadinfo(param)); - { Initialize thread } - InitThread(ti.stklen); - { Start thread function } -{$ifdef DEBUG_MT} - writeln('Jumping to thread function'); -{$endif DEBUG_MT} - ThreadMain:=pointer(ti.f(ti.p)); - DoneThread; - pthread_detach(pointer(pthread_self)); - end; - - - function BeginThread(sa : Pointer;stacksize : dword; - ThreadFunction : tthreadfunc;p : pointer; - creationFlags : dword; var ThreadId : DWord) : DWord; - var - ti : pthreadinfo; - thread_attr : pthread_attr_t; - begin -{$ifdef DEBUG_MT} - writeln('Creating new thread'); -{$endif DEBUG_MT} - { 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(@SysRelocateThreadvar); -{$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 } -{$ifdef DEBUG_MT} - writeln('Starting new thread'); -{$endif DEBUG_MT} - 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); - - // 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; - BeginThread:=threadid; -{$ifdef DEBUG_MT} - writeln('BeginThread returning ',BeginThread); -{$endif DEBUG_MT} - end; - - - procedure EndThread(ExitCode : DWord); - begin - DoneThread; - pthread_detach(pointer(pthread_self)); - pthread_exit(pointer(ExitCode)); - end; - - - function SuspendThread (threadHandle : dword) : dword; - begin - {$Warning SuspendThread needs to be implemented} - end; - - function ResumeThread (threadHandle : dword) : dword; - begin - {$Warning ResumeThread needs to be implemented} - end; - - procedure ThreadSwitch; {give time to other threads} - begin - {extern int pthread_yield (void) __THROW;} - {$Warning ThreadSwitch needs to be implemented} - end; - - function KillThread (threadHandle : dword) : dword; - begin - pthread_detach(pointer(threadHandle)); - KillThread := pthread_cancel(Pointer(threadHandle)); - end; - - function WaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; {0=no timeout} - var - LResultP: Pointer; - LResult: DWord; - begin - LResult := 0; - LResultP := @LResult; - pthread_join(Pointer(threadHandle), @LResultP); - WaitForThreadTerminate := LResult; - end; - - function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} - begin - {$Warning ThreadSetPriority needs to be implemented} - end; - - - function ThreadGetPriority (threadHandle : dword): Integer; - begin - {$Warning ThreadGetPriority needs to be implemented} - end; - - function GetCurrentThreadId : dword; - begin - GetCurrentThreadId:=dword(pthread_self); - end; - - -{***************************************************************************** - Delphi/Win32 compatibility -*****************************************************************************} - - procedure InitCriticalSection(var CS:TRTLCriticalSection); - begin - cs.m_spinlock:=0; - cs.m_count:=0; - cs.m_owner:=0; - cs.m_kind:=1; - cs.m_waiting.head:=0; - cs.m_waiting.tail:=0; - pthread_mutex_init(@CS,NIL); - end; - - procedure EnterCriticalSection(var CS:TRTLCriticalSection); - begin - pthread_mutex_lock(@CS); - end; - - procedure LeaveCriticalSection(var CS:TRTLCriticalSection); - begin - pthread_mutex_unlock(@CS); - end; - - procedure DoneCriticalSection(var CS:TRTLCriticalSection); - begin - pthread_mutex_destroy(@CS); - end; - - -{***************************************************************************** - Heap Mutex Protection -*****************************************************************************} - - var - HeapMutex : pthread_mutex_t; - - procedure PThreadHeapMutexInit; - begin - pthread_mutex_init(@heapmutex,nil); - end; - - procedure PThreadHeapMutexDone; - begin - pthread_mutex_destroy(@heapmutex); - end; - - procedure PThreadHeapMutexLock; - begin - pthread_mutex_lock(@heapmutex); - end; - - procedure PThreadHeapMutexUnlock; - begin - pthread_mutex_unlock(@heapmutex); - end; - - const - PThreadMemoryMutexManager : TMemoryMutexManager = ( - MutexInit : @PThreadHeapMutexInit; - MutexDone : @PThreadHeapMutexDone; - MutexLock : @PThreadHeapMutexLock; - MutexUnlock : @PThreadHeapMutexUnlock; - ); - - procedure InitHeapMutexes; - begin - SetMemoryMutexManager(PThreadMemoryMutexManager); - end; - +begin + SetNoThreadManager; +end; initialization - InitHeapMutexes; + InitSystemThreads; end. { $Log$ - Revision 1.20 2003-11-19 10:54:32 marco + Revision 1.21 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.20 2003/11/19 10:54:32 marco * some simple restructures Revision 1.19 2003/11/18 22:36:12 marco diff --git a/rtl/win32/systhrds.pp b/rtl/win32/systhrds.pp index fe9e37d6cf..b1bb45e89e 100644 --- a/rtl/win32/systhrds.pp +++ b/rtl/win32/systhrds.pp @@ -14,6 +14,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} +{$mode objfpc} unit systhrds; interface @@ -178,7 +179,7 @@ function WinGetCurrentThreadId : dword; stdcall;external 'kernel32' name 'GetCu end; - function BeginThread(sa : Pointer;stacksize : dword; + function SysBeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer; creationFlags : dword; var ThreadId : DWord) : DWord; var @@ -207,66 +208,66 @@ function WinGetCurrentThreadId : dword; stdcall;external 'kernel32' name 'GetCu {$ifdef DEBUG_MT} writeln('Starting new thread'); {$endif DEBUG_MT} - BeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,threadid); + SysBeginThread:=CreateThread(sa,stacksize,@ThreadMain,ti,creationflags,threadid); end; - procedure EndThread(ExitCode : DWord); + procedure SysEndThread(ExitCode : DWord); begin DoneThread; ExitThread(ExitCode); end; - procedure ThreadSwitch; + procedure SysThreadSwitch; begin Sleep(0); end; - function SuspendThread (threadHandle : dword) : dword; + function SysSuspendThread (threadHandle : dword) : dword; begin - SuspendThread:=WinSuspendThread(threadHandle); + SysSuspendThread:=WinSuspendThread(threadHandle); end; - function ResumeThread (threadHandle : dword) : dword; + function SysResumeThread (threadHandle : dword) : dword; begin - ResumeThread:=WinResumeThread(threadHandle); + SysResumeThread:=WinResumeThread(threadHandle); end; - function KillThread (threadHandle : dword) : dword; + function SysKillThread (threadHandle : dword) : dword; var exitCode : dword; begin if not TerminateThread (threadHandle, exitCode) then - KillThread := GetLastError + SysKillThread := GetLastError else - KillThread := 0; + SysKillThread := 0; end; - function WaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; + function SysWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword; begin if timeoutMs = 0 then dec (timeoutMs); // $ffffffff is INFINITE - WaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs); + SysWaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs); end; - function ThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} + function SysThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal} begin - ThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio); + SysThreadSetPriority:=WinThreadSetPriority(threadHandle,Prio); end; - function ThreadGetPriority (threadHandle : dword): Integer; + function SysThreadGetPriority (threadHandle : dword): Integer; begin - ThreadGetPriority:=WinThreadGetPriority(threadHandle); + SysThreadGetPriority:=WinThreadGetPriority(threadHandle); end; - function GetCurrentThreadId : dword; + function SysGetCurrentThreadId : dword; begin - GetCurrentThreadId:=WinGetCurrentThreadId; + SysGetCurrentThreadId:=WinGetCurrentThreadId; end; {***************************************************************************** @@ -285,27 +286,27 @@ procedure WinEnterCriticalSection(var cs : TRTLCriticalSection); procedure WinLeaveCriticalSection(var cs : TRTLCriticalSection); stdcall;external 'kernel32' name 'LeaveCriticalSection'; -procedure InitCriticalSection(var cs : TRTLCriticalSection); +procedure SySInitCriticalSection(var cs); begin - WinInitCriticalSection(cs); + WinInitCriticalSection(PRTLCriticalSection(@cs)^); end; -procedure DoneCriticalSection(var cs : TRTLCriticalSection); +procedure SysDoneCriticalSection(var cs); begin - WinDoneCriticalSection(cs); + WinDoneCriticalSection(PRTLCriticalSection(@cs)^); end; -procedure EnterCriticalSection(var cs : TRTLCriticalSection); +procedure SysEnterCriticalSection(var cs); begin - WinEnterCriticalSection(cs); + WinEnterCriticalSection(PRTLCriticalSection(@cs)^); end; -procedure LeaveCriticalSection(var cs : TRTLCriticalSection); +procedure SySLeaveCriticalSection(var cs); begin - WinLeaveCriticalSection(cs); + WinLeaveCriticalSection(PRTLCriticalSection(@cs)^); end; @@ -348,14 +349,52 @@ end; begin SetMemoryMutexManager(Win32MemoryMutexManager); end; +Var + WinThreadManager : TThreadManager; +Procedure SetWinThreadManager; + +Var + Dummy : TThreadManager; + +begin + With WinThreadManager do + begin + InitManager :=Nil; + DoneManager :=Nil; + BeginThread :=@SysBeginThread; + EndThread :=@SysEndThread; + SuspendThread :=@SysSuspendThread; + ResumeThread :=@SysResumeThread; + KillThread :=@SysKillThread; + ThreadSwitch :=@SysThreadSwitch; + WaitForThreadTerminate :=@SysWaitForThreadTerminate; + ThreadSetPriority :=@SysThreadSetPriority; + ThreadGetPriority :=@SysThreadGetPriority; + GetCurrentThreadId :=@SysGetCurrentThreadId; + InitCriticalSection :=@SysInitCriticalSection; + DoneCriticalSection :=@SysDoneCriticalSection; + EnterCriticalSection :=@SysEnterCriticalSection; + LeaveCriticalSection :=@SysLeaveCriticalSection; + InitThreadVar :=@SysInitThreadVar; + RelocateThreadVar :=@SysRelocateThreadVar; + AllocateThreadVars :=@SysAllocateThreadVars; + ReleaseThreadVars :=@SysReleaseThreadVars; + end; + SetThreadManager(WinThreadManager,Dummy); + InitHeapMutexes; +end; initialization - InitHeapMutexes; + SetWinThreadManager; end. + { $Log$ - Revision 1.6 2003-10-01 21:00:09 peter + Revision 1.7 2003-11-26 20:10:59 michael + + New threadmanager implementation + + Revision 1.6 2003/10/01 21:00:09 peter * GetCurrentThreadHandle renamed to GetCurrentThreadId Revision 1.5 2003/09/17 15:06:36 peter