mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 05:00:07 +02:00
* added syncobj for netwlibc
This commit is contained in:
parent
9984dd16b0
commit
c0a16133fb
@ -1,11 +1,11 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/12/05]
|
||||
# Don't edit, this file is generated by FPCMake Version 1.1 [2004/11/26]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom morphos netwlibc
|
||||
BSDs = freebsd netbsd openbsd darwin
|
||||
UNIXs = linux $(BSDs) sunos qnx
|
||||
LIMIT83fs = go32v2 os2 emx watcom
|
||||
LIMIT83fs = go32v2 os2
|
||||
FORCE:
|
||||
.PHONY: FORCE
|
||||
override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
|
||||
@ -248,7 +248,7 @@ ifeq ($(OS_TARGET),darwin)
|
||||
override TARGET_UNITS+=process ssockets resolve fpasync syncobjs
|
||||
endif
|
||||
ifeq ($(OS_TARGET),netwlibc)
|
||||
override TARGET_UNITS+=resolve ssockets
|
||||
override TARGET_UNITS+=resolve ssockets syncobjs
|
||||
endif
|
||||
override TARGET_RSTS+=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry
|
||||
override TARGET_EXAMPLEDIRS+=tests
|
||||
@ -644,7 +644,7 @@ HASSHAREDLIB=1
|
||||
ZIPSUFFIX=darwin
|
||||
endif
|
||||
ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
|
||||
FPCMADE=fpcmade.$(FPCMADEEXT)
|
||||
FPCMADE=fpcmade$(FPCMADEEXT)
|
||||
else
|
||||
FPCMADE=fpcmade.$(FULL_TARGET)
|
||||
endif
|
||||
|
@ -31,7 +31,7 @@ units_openbsd=process ssockets resolve fpasync
|
||||
units_linux=process resolve ssockets fpasync syncobjs
|
||||
units_win32=process fileinfo resolve ssockets syncobjs
|
||||
units_netware=resolve ssockets
|
||||
units_netwlibc=resolve ssockets
|
||||
units_netwlibc=resolve ssockets syncobjs
|
||||
rsts=$(CLASSES10) ssockets cachecls resolve custapp cgiapp eventlog registry
|
||||
exampledirs=tests
|
||||
|
||||
|
190
fcl/netwlibc/syncobjs.pp
Normal file
190
fcl/netwlibc/syncobjs.pp
Normal file
@ -0,0 +1,190 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 1998 by Florian Klaempfl
|
||||
member of the Free Pascal development team
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
unit syncobjs;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
libc,
|
||||
sysutils;
|
||||
|
||||
type
|
||||
PSecurityAttributes = Pointer;
|
||||
TEventHandle = THandle;
|
||||
TRTLCriticalSection = TPthreadMutex;
|
||||
|
||||
{$I syncobh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Some wrappers around PThreads.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
function InitializeCriticalSection(var lpCriticalSection: TRTLCriticalSection): Integer;
|
||||
|
||||
var
|
||||
MAttr : TMutexAttribute;
|
||||
|
||||
begin
|
||||
Result:=pthread_mutexattr_init(@MAttr);
|
||||
if Result=0 then
|
||||
try
|
||||
Result:=pthread_mutexattr_settype(@MAttr, PTHREAD_MUTEX_RECURSIVE);
|
||||
if Result=0 then
|
||||
Result:=pthread_mutex_init(@lpCriticalSection,@MAttr);
|
||||
finally
|
||||
pthread_mutexattr_destroy(@MAttr);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function EnterCriticalSection(var lpCriticalSection: TRTLCriticalSection) : Integer;
|
||||
|
||||
begin
|
||||
Result:=pthread_mutex_lock(@lpCriticalSection);
|
||||
end;
|
||||
|
||||
function LeaveCriticalSection (var lpCriticalSection: TRTLCriticalSection) : Integer;
|
||||
begin
|
||||
Result:=pthread_mutex_unlock(@lpCriticalSection);
|
||||
end;
|
||||
|
||||
function DeleteCriticalSection(var lpCriticalSection: TRTLCriticalSection) : Integer;
|
||||
begin
|
||||
Result:=pthread_mutex_destroy(@lpCriticalSection);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Real syncobjs implementation
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
{$I syncob.inc}
|
||||
|
||||
|
||||
procedure TCriticalSection.Acquire;
|
||||
|
||||
begin
|
||||
EnterCriticalSection(CriticalSection);
|
||||
end;
|
||||
|
||||
procedure TCriticalSection.Release;
|
||||
|
||||
begin
|
||||
LeaveCriticalSection(CriticalSection);
|
||||
end;
|
||||
|
||||
constructor TCriticalSection.Create;
|
||||
|
||||
begin
|
||||
Inherited Create;
|
||||
InitializeCriticalSection(CriticalSection);
|
||||
end;
|
||||
|
||||
destructor TCriticalSection.Destroy;
|
||||
|
||||
begin
|
||||
DeleteCriticalSection(CriticalSection);
|
||||
end;
|
||||
|
||||
destructor THandleObject.destroy;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
|
||||
AManualReset,InitialState : Boolean;const Name : string);
|
||||
|
||||
begin
|
||||
FManualReset:=AManualReset;
|
||||
FSem:=New(PSemaphore);
|
||||
FEventSection:=TCriticalSection.Create;
|
||||
sem_init(FSem,ord(False),Ord(InitialState));
|
||||
end;
|
||||
|
||||
destructor TEventObject.destroy;
|
||||
|
||||
begin
|
||||
sem_destroy(FSem);
|
||||
end;
|
||||
|
||||
procedure TEventObject.ResetEvent;
|
||||
|
||||
begin
|
||||
While sem_trywait(FSem)=0 do
|
||||
;
|
||||
end;
|
||||
|
||||
procedure TEventObject.SetEvent;
|
||||
|
||||
Var
|
||||
Value : Longint;
|
||||
|
||||
begin
|
||||
FEventSection.Enter;
|
||||
Try
|
||||
sem_getvalue(FSem,@Value);
|
||||
if Value=0 then
|
||||
sem_post(FSem);
|
||||
finally
|
||||
FEventSection.Leave;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
|
||||
|
||||
begin
|
||||
If TimeOut<>Cardinal($FFFFFFFF) then
|
||||
result:=wrError
|
||||
else
|
||||
begin
|
||||
sem_wait(FSem);
|
||||
result:=wrSignaled;
|
||||
if FManualReset then
|
||||
begin
|
||||
FEventSection.Enter;
|
||||
Try
|
||||
resetevent;
|
||||
sem_post(FSem);
|
||||
Finally
|
||||
FEventSection.Leave;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TSimpleEvent.Create;
|
||||
|
||||
begin
|
||||
inherited Create(nil, True, False, '');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2004-12-07 14:13:42 armin
|
||||
* added syncobj for netwlibc
|
||||
|
||||
Revision 1.2 2002/08/17 02:23:35 michael
|
||||
+ Fixed 1.1 build of syncobjs
|
||||
|
||||
Revision 1.1 2003/06/14 19:14:31 michael
|
||||
+ Initial implementation
|
||||
|
||||
}
|
@ -8189,6 +8189,7 @@ type
|
||||
mutex : pointer;
|
||||
reserved : array[0..52] of dword;
|
||||
end;
|
||||
TpthreadMutex = pthread_mutex_t;
|
||||
|
||||
Ppthread_rwlock_t = ^pthread_rwlock_t;
|
||||
pthread_rwlock_t = record
|
||||
@ -8228,6 +8229,7 @@ type
|
||||
end;
|
||||
Ppthread_mutex_attr_t = Ppthread_mutexattr_t;
|
||||
pthread_mutex_attr_t = pthread_mutexattr_t;
|
||||
TMutexAttribute = pthread_mutex_attr_t;
|
||||
|
||||
Ppthread_rwlockattr_t = ^pthread_rwlockattr_t;
|
||||
pthread_rwlockattr_t = record
|
||||
@ -9073,7 +9075,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2004-12-07 11:40:43 armin
|
||||
Revision 1.6 2004-12-07 14:13:42 armin
|
||||
* added syncobj for netwlibc
|
||||
|
||||
Revision 1.5 2004/12/07 11:40:43 armin
|
||||
* implemented GetProcessId, defined TimeVal and TimeZone in addition to TTimeVal, TTimeZone, Makefile defaults to binutilsprefix i386-netware
|
||||
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user