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

* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows

Browse Source 
Check work: ask Neli.
This commit is contained in:
marco 2004-12-22 21:29:24 +00:00
parent 1da9e24cee
commit 0db4315ea9
7 changed files with 195 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
rtl/darwin/pthread.inc
View File

@ -32,6 +32,8 @@ CONST PTHREAD_EXPLICIT_SCHED = 0;
__destr_func_t = procedure (p :pointer);cdecl;
__startroutine_t = function (p :pointer):pointer;cdecl;
ppthread_mutexattr_t = ^pthread_mutexattr_t;
ppthread_cond_t = ^pthread_cond_t;
ppthread_condattr_t = ^pthread_condattr_t;
sem_t = cint;
psem_t = ^sem_t;
@ -55,6 +57,10 @@ function pthread_mutex_unlock (p:ppthread_mutexattr_t):cint; cdecl;external 'c
function pthread_cancel(_para1:pthread_t):cint;cdecl;external 'c';
function pthread_detach(_para1:pthread_t):cint;cdecl;external 'c';
function pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external 'c';
function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_destroy';
function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external 'c' name 'pthread_cond_init';
function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external 'c' name 'pthread_cond_signal';
function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external 'c' name 'pthread_cond_wait';
function sem_init(__sem:Psem_t; __pshared:cint;__value:cuint):cint;cdecl; external 'c' name 'sem_init';
function sem_destroy(__sem:Psem_t):cint;cdecl;external 'c' name 'sem_destroy';
@ -72,7 +78,11 @@ function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cin
{
$Log$
Revision 1.5 2004-09-09 20:29:06 jonas
Revision 1.6 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.5 2004/09/09 20:29:06 jonas
* fixed definition of pthread_mutex_t for non-linux targets (and for
linux as well, actually).
* base libpthread definitions are now in ptypes.inc, included in unixtype

4
rtl/freebsd/Makefile
View File

@ -232,11 +232,11 @@ UNIXINC=$(RTL)/unix
UNITPREFIX=rtl
ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
SYSTEMUNIT=system
override FPCOPT+=-dNOMOUSE
override FPCOPT+=-dNOGPM
loaders+=gprt0
else
SYSTEMUNIT=sysbsd
override FPCOPT+=-dUNIX -dNOMOUSE
override FPCOPT+=-dUNIX -dNOGPM
endif
ifdef RELEASE
override FPCOPT+=-Ur

13
rtl/freebsd/pthread.inc
View File

@ -29,6 +29,9 @@ CONST PTHREAD_EXPLICIT_SCHED = 0;
ppthread_key_t = ^pthread_key_t;
ppthread_mutex_t= ^pthread_mutex_t;
ppthread_attr_t = ^pthread_attr_t;
ppthread_cond_t = ^pthread_cond_t;
ppthread_condattr_t = ^pthread_condattr_t;
__destr_func_t = procedure (p :pointer);cdecl;
__startroutine_t= function (p :pointer):pointer;cdecl;
ppthread_mutexattr_t = ^pthread_mutexattr_t;
@ -56,6 +59,10 @@ function pthread_mutex_unlock (p:ppthread_mutex_attr_t):cint; cdecl;external;
function pthread_cancel(_para1:pthread_t):cint;cdecl;external;
function pthread_detach(_para1:pthread_t):cint;cdecl;external;
function pthread_join(_para1:pthread_t; _para2:Ppointer):cint;cdecl;external;
function pthread_cond_destroy(_para1:Ppthread_cond_t):cint;cdecl;external;
function pthread_cond_init(_para1:Ppthread_cond_t;_para2:Ppthread_condattr_t):cint;cdecl;external;
function pthread_cond_signal(_para1:Ppthread_cond_t):cint;cdecl;external;
function pthread_cond_wait(_para1:Ppthread_cond_t;_para2:Ppthread_mutex_t):cint;cdecl;external;
function sem_init(__sem:Psem_t; __pshared:cint;__value:dword):cint;cdecl; external;
function sem_destroy(__sem:Psem_t):cint;cdecl;external ;
@ -74,7 +81,11 @@ function pthread_mutexattr_settype(_para1:Ppthread_mutexattr_t; _para2:cint):cin
{
$Log$
Revision 1.5 2004-09-10 15:15:45 marco
Revision 1.6 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.5 2004/09/10 15:15:45 marco
* small glitch fixes
Revision 1.4 2004/09/09 20:29:06 jonas

60
rtl/inc/thread.inc
View File

@ -229,6 +229,31 @@ begin
result:=currenttm.basiceventWaitFor(Timeout,state);
end;
function RTLEventCreate :PRTLEvent;
begin
result:=currenttm.rtleventcreate;
end;
procedure RTLeventdestroy(state:pRTLEvent);
begin
currenttm.rtleventdestroy(state);
end;
procedure RTLeventSetEvent(state:pRTLEvent);
begin
currenttm.rtleventsetEvent(state);
end;
procedure RTLeventWaitFor(state:pRTLEvent);
begin
currenttm.rtleventWaitFor(state);
end;
{ ---------------------------------------------------------------------
ThreadManager which gives run-time error. Use if no thread support.
@ -354,6 +379,31 @@ begin
NoThreadError;
end;
function NORTLEventCreate :PRTLEvent;
begin
NoThreadError;
end;
procedure NORTLeventdestroy(state:pRTLEvent);
begin
NoThreadError;
end;
procedure NORTLeventSetEvent(state:pRTLEvent);
begin
NoThreadError;
end;
procedure NORTLeventWaitFor(state:pRTLEvent);
begin
NoThreadError;
end;
Var
NoThreadManager : TThreadManager;
@ -387,6 +437,10 @@ begin
basiceventResetEvent :=@NobasiceventResetEvent;
basiceventSetEvent :=@NobasiceventSetEvent;
basiceventWaitFor :=@NobasiceventWaitFor;
rtlEventCreate :=@NortlEventCreate;
rtleventdestroy :=@Nortleventdestroy;
rtleventSetEvent :=@NortleventSetEvent;
rtleventWaitFor :=@NortleventWaitFor;
end;
SetThreadManager(NoThreadManager);
@ -395,7 +449,11 @@ end;
{
$Log$
Revision 1.12 2004-09-19 18:55:30 armin
Revision 1.13 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.12 2004/09/19 18:55:30 armin
* added define DISABLE_NO_THREAD_MANAGER to avoid warnings if thread manager is always present
Revision 1.11 2004/05/23 20:26:20 marco

24
rtl/inc/threadh.inc
View File

@ -21,6 +21,7 @@ const
type
PEventState = pointer;
PRTLEvent = pointer; // Windows=thandle, other=pointer to record.
TThreadFunc = function(parameter : pointer) : ptrint;
// Function prototypes for TThreadManager Record.
@ -41,6 +42,8 @@ type
TBasicEventHandler = procedure(state:peventstate);
TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
TBasicEventCreateHandler = function (EventAttributes :Pointer; AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
TRTLEventHandler = procedure(AEvent:PRTLEvent);
TRTLCreateEventHandler = function:PRTLEvent;
// TThreadManager interface.
TThreadManager = Record
@ -64,11 +67,15 @@ type
RelocateThreadVar : TRelocateThreadVarHandler;
AllocateThreadVars : TAllocateThreadVarsHandler;
ReleaseThreadVars : TReleaseThreadVarsHandler;
BasicEventCreate : TBasicEventCreateHandler;
BasicEventDestroy : TBasicEventHandler;
BasicEventResetEvent : TBasicEventHandler;
BasicEventCreate : TBasicEventCreateHandler; // left in for a while.
BasicEventDestroy : TBasicEventHandler; // we might need BasicEvent
BasicEventResetEvent : TBasicEventHandler; // for a real TEvent
BasicEventSetEvent : TBasicEventHandler;
BasiceventWaitFOr : TBasicEventWaitForHandler;
RTLEventCreate : TRTLCreateEventHandler;
RTLEventDestroy : TRTLEventHandler;
RTLEventSetEvent : TRTLEventHandler;
RTLeventWaitFOr : TRTLEventHandler;
end;
{*****************************************************************************
@ -143,9 +150,18 @@ procedure basiceventResetEvent(state:peventstate);
procedure basiceventSetEvent(state:peventstate);
function basiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
function RTLEventCreate :PRTLEvent;
procedure RTLeventdestroy(state:pRTLEvent);
procedure RTLeventSetEvent(state:pRTLEvent);
procedure RTLeventWaitFor(state:pRTLEvent);
{
$Log$
Revision 1.20 2004-12-12 14:30:27 peter
Revision 1.21 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.20 2004/12/12 14:30:27 peter
* x86_64 updates
Revision 1.19 2004/09/19 18:55:30 armin

58
rtl/unix/cthreads.pp
View File

@ -52,6 +52,12 @@ Uses
{ Include OS specific parts. }
{$i pthread.inc}
Type PINTRTLEvent = ^TINTRTLEvent;
TINTRTLEvent = record
condvar: pthread_cond_t;
mutex: pthread_mutex_t;
end;
{*****************************************************************************
Threadvar support
*****************************************************************************}
@ -516,6 +522,48 @@ begin
end;
end;
function intRTLEventCreate: PRTLEvent;
var p:pintrtlevent;
begin
new(p);
pthread_cond_init(@p^.condvar, nil);
pthread_mutex_init(@p^.mutex, nil);
result:=PRTLEVENT(p);
end;
procedure intRTLEventDestroy(AEvent: PRTLEvent);
var p:pintrtlevent;
begin
p:=pintrtlevent(aevent);
pthread_cond_destroy(@p^.condvar);
pthread_mutex_destroy(@p^.mutex);
dispose(p);
end;
procedure intRTLEventSetEvent(AEvent: PRTLEvent);
var p:pintrtlevent;
begin
p:=pintrtlevent(aevent);
pthread_mutex_lock(@p^.mutex);
pthread_cond_signal(@p^.condvar);
pthread_mutex_unlock(@p^.mutex);
end;
procedure intRTLEventWaitFor(AEvent: PRTLEvent);
var p:pintrtlevent;
begin
p:=pintrtlevent(aevent);
pthread_mutex_lock(@p^.mutex);
pthread_cond_wait(@p^.condvar, @p^.mutex);
pthread_mutex_unlock(@p^.mutex);
end;
Var
CThreadManager : TThreadManager;
@ -551,6 +599,10 @@ begin
BasicEventResetEvent :=@intBasicEventResetEvent;
BasicEventSetEvent :=@intBasicEventSetEvent;
BasiceventWaitFor :=@intBasiceventWaitFor;
rtlEventCreate :=@intrtlEventCreate;
rtlEventDestroy :=@intrtlEventDestroy;
rtlEventSetEvent :=@intrtlEventSetEvent;
rtleventWaitFor :=@intrtleventWaitFor;
end;
SetThreadManager(CThreadManager);
InitHeapMutexes;
@ -561,7 +613,11 @@ initialization
end.
{
$Log$
Revision 1.14 2004-12-12 14:30:27 peter
Revision 1.15 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.14 2004/12/12 14:30:27 peter
* x86_64 updates
Revision 1.13 2004/10/14 17:39:33 florian

35
rtl/win32/systhrds.pp
View File

@ -88,6 +88,7 @@ function CreateEvent(lpEventAttributes:pointer;bManualReset:longbool;bInitialSt
function CloseHandle(hObject:CARDINAL):LONGBOOL; external 'kernel32' name 'CloseHandle';
function ResetEvent(hEvent:CARDINAL):LONGBOOL; external 'kernel32' name 'ResetEvent';
function SetEvent(hEvent:CARDINAL):LONGBOOL; external 'kernel32' name 'SetEvent';
function PulseEvent(hEvent:THANDLE):CARDINAL {WINBOOL}; external 'kernel32' name 'PulseEvent';
CONST
WAIT_OBJECT_0 = 0;
@ -419,6 +420,30 @@ begin
end;
end;
function intRTLEventCreate: PRTLEvent;
begin
Result := PRTLEVENT(CreateEvent(nil, false, false, nil));
end;
procedure intRTLEventDestroy(AEvent: PRTLEvent);
begin
CloseHandle(THANDLE(AEvent));
end;
procedure intRTLEventSetEvent(AEvent: PRTLEvent);
begin
PulseEvent(THANDLE(AEvent));
end;
CONST INFINITE=-1;
procedure intRTLEventWaitFor(AEvent: PRTLEvent);
begin
WaitForSingleObject(THANDLE(AEvent), INFINITE);
end;
Var
WinThreadManager : TThreadManager;
@ -454,6 +479,10 @@ begin
BasicEventResetEvent :=@intBasicEventResetEvent;
BasicEventSetEvent :=@intBasicEventSetEvent;
BasiceventWaitFor :=@intBasiceventWaitFor;
RTLEventCreate :=@intRTLEventCreate;
RTLEventDestroy :=@intRTLEventDestroy;
RTLEventSetEvent :=@intRTLEventSetEvent;
RTLeventWaitFor :=@intRTLeventWaitFor;
end;
SetThreadManager(WinThreadManager);
InitHeapMutexes;
@ -465,7 +494,11 @@ end.
{
$Log$
Revision 1.11 2004-05-23 15:30:13 marco
Revision 1.12 2004-12-22 21:29:24 marco
* rtlevent kraam. Checked (compile): Linux, FreeBSD, Darwin, Windows
Check work: ask Neli.
Revision 1.11 2004/05/23 15:30:13 marco
* first try
Revision 1.10 2004/01/21 14:15:42 florian