mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 14:29:13 +02:00
+ New threadmanager implementation
This commit is contained in:
michael
parent
058d480f40
commit
4b2084fb50
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
487
rtl/unix/cthreads.pp
Normal file
487
rtl/unix/cthreads.pp
Normal file
@ -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
|
||||
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user