diff --git a/.gitattributes b/.gitattributes index 433948dbc2..35f9b2100b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -927,6 +927,7 @@ fcl/shedit/sh_pas.pp svneol=native#text/plain fcl/shedit/sh_xml.pp svneol=native#text/plain fcl/shedit/shedit.pp svneol=native#text/plain fcl/shedit/undo.inc svneol=native#text/plain +fcl/solaris/syncobjs.pp svneol=native#text/plain fcl/template/classes.pp svneol=native#text/plain fcl/template/footer -text fcl/template/header -text diff --git a/fcl/solaris/syncobjs.pp b/fcl/solaris/syncobjs.pp new file mode 100644 index 0000000000..1bafdfe26c --- /dev/null +++ b/fcl/solaris/syncobjs.pp @@ -0,0 +1,177 @@ +{ + 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 + pthreads, + unix, + 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,longint(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(psem_t(FSem),ord(False),Ord(InitialState)); +end; + +destructor TEventObject.destroy; + +begin + sem_destroy(psem_t(FSem)); +end; + +procedure TEventObject.ResetEvent; + +begin + While sem_trywait(psem_t(FSem))=0 do + ; +end; + +procedure TEventObject.SetEvent; + +Var + Value : Longint; + +begin + FEventSection.Enter; + Try + sem_getvalue(FSem,@Value); + if Value=0 then + sem_post(psem_t(FSem)); + finally + FEventSection.Leave; + end; +end; + + +function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult; + +begin + If TimeOut<>Cardinal($FFFFFFFF) then + result:=wrError + else + begin + sem_wait(psem_t(FSem)); + result:=wrSignaled; + if FManualReset then + begin + FEventSection.Enter; + Try + resetevent; + sem_post(psem_t(FSem)); + Finally + FEventSection.Leave; + end; + end; + end; +end; + +constructor TSimpleEvent.Create; + +begin + inherited Create(nil, True, False, ''); +end; + +end.