Browse Source

* added syncobj for netwlibc

armin 20 years ago
parent
commit
c0a16133fb
4 changed files with 201 additions and 6 deletions
  1. 4 4
      fcl/Makefile
  2. 1 1
      fcl/Makefile.fpc
  3. 190 0
      fcl/netwlibc/syncobjs.pp
  4. 6 1
      rtl/netwlibc/libc.pp

+ 4 - 4
fcl/Makefile

@@ -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

+ 1 - 1
fcl/Makefile.fpc

@@ -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 - 0
fcl/netwlibc/syncobjs.pp

@@ -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
+
+}

+ 6 - 1
rtl/netwlibc/libc.pp

@@ -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
 
 }