Browse Source

* syncobjs now bases on system unit thread support

git-svn-id: trunk@5905 -
michael 18 years ago
parent
commit
2d7b828694

+ 1 - 9
.gitattributes

@@ -599,7 +599,6 @@ fcl/beos/classes.pp svneol=native#text/plain
 fcl/beos/eventlog.inc svneol=native#text/plain
 fcl/beos/pipes.inc svneol=native#text/plain
 fcl/beos/thread.inc svneol=native#text/plain
-fcl/darwin/syncobjs.pp svneol=native#text/plain
 fcl/db/Dataset.txt svneol=native#text/plain
 fcl/db/Makefile svneol=native#text/plain
 fcl/db/Makefile.fpc svneol=native#text/plain
@@ -816,7 +815,6 @@ fcl/fpcunit/testutils.pp svneol=native#text/plain
 fcl/fpcunit/ubmockobject.pp svneol=native#text/plain
 fcl/fpcunit/xmlreporter.pas svneol=native#text/plain
 fcl/fpmake.pp svneol=native#text/plain
-fcl/freebsd/syncobjs.pp svneol=native#text/plain
 fcl/go32v2/custapp.inc svneol=native#text/plain
 fcl/go32v2/eventlog.inc svneol=native#text/plain
 fcl/go32v2/pipes.inc svneol=native#text/plain
@@ -908,8 +906,7 @@ fcl/inc/ssockets.pp svneol=native#text/plain
 fcl/inc/streamcoll.pp svneol=native#text/plain
 fcl/inc/streamex.pp svneol=native#text/plain
 fcl/inc/streamio.pp svneol=native#text/plain
-fcl/inc/syncob.inc svneol=native#text/plain
-fcl/inc/syncobh.inc svneol=native#text/plain
+fcl/inc/syncobjs.pp svneol=native#text/plain
 fcl/inc/wformat.pp svneol=native#text/plain
 fcl/inc/whtml.pp svneol=native#text/plain
 fcl/inc/wtex.pp svneol=native#text/plain
@@ -917,7 +914,6 @@ fcl/inc/xmlreg.pp svneol=native#text/plain
 fcl/inc/xregreg.inc svneol=native#text/plain
 fcl/inc/zipper.pp svneol=native#text/plain
 fcl/inc/zstream.pp svneol=native#text/plain
-fcl/linux/syncobjs.pp svneol=native#text/plain
 fcl/morphos/eventlog.inc svneol=native#text/plain
 fcl/morphos/pipes.inc svneol=native#text/plain
 fcl/net/Makefile svneol=native#text/plain
@@ -946,7 +942,6 @@ fcl/netwlibc/custapp.inc svneol=native#text/plain
 fcl/netwlibc/eventlog.inc svneol=native#text/plain
 fcl/netwlibc/pipes.inc svneol=native#text/plain
 fcl/netwlibc/resolve.inc svneol=native#text/plain
-fcl/netwlibc/syncobjs.pp svneol=native#text/plain
 fcl/os2/custapp.inc svneol=native#text/plain
 fcl/os2/eventlog.inc svneol=native#text/plain
 fcl/os2/pipes.inc svneol=native#text/plain
@@ -980,7 +975,6 @@ 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
@@ -1103,7 +1097,6 @@ fcl/win/pipes.inc svneol=native#text/plain
 fcl/win/process.inc svneol=native#text/plain
 fcl/win/resolve.inc svneol=native#text/plain
 fcl/win/simpleipc.inc svneol=native#text/plain
-fcl/win/syncobjs.pp svneol=native#text/plain
 fcl/win/winreg.inc svneol=native#text/plain
 fcl/wince/eventlog.inc svneol=native#text/plain
 fcl/wince/fileinfo.pp svneol=native#text/plain
@@ -1111,7 +1104,6 @@ fcl/wince/pipes.inc svneol=native#text/plain
 fcl/wince/process.inc svneol=native#text/plain
 fcl/wince/resolve.inc svneol=native#text/plain
 fcl/wince/simpleipc.inc svneol=native#text/plain
-fcl/wince/syncobjs.pp svneol=native#text/plain
 fcl/xml/Makefile svneol=native#text/plain
 fcl/xml/Makefile.fpc svneol=native#text/plain
 fcl/xml/README -text

+ 0 - 179
fcl/darwin/syncobjs.pp

@@ -1,179 +0,0 @@
-{
-    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));
-  dispose(PSemaphore(FSem));
-  FEventSection.Free;
-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.

+ 0 - 179
fcl/freebsd/syncobjs.pp

@@ -1,179 +0,0 @@
-{
-    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));
-  dispose(PSemaphore(FSem));
-  FEventSection.Free;
-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.

+ 0 - 32
fcl/inc/syncob.inc

@@ -1,32 +0,0 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 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.
-
- **********************************************************************}
-
-procedure TSynchroObject.Acquire;
-begin
-end;
-
-procedure TSynchroObject.Release;
-begin
-end;
-
-procedure TCriticalSection.Enter;
-begin
-  Acquire;
-end;
-
-
-procedure TCriticalSection.Leave;
-begin
-  Release;
-end;

+ 0 - 64
fcl/inc/syncobh.inc

@@ -1,64 +0,0 @@
-{
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999-2000 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.
-
- **********************************************************************}
-
-type
-   TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
-
-   TSynchroObject = class(TObject)
-      procedure Acquire;virtual;
-      procedure Release;virtual;
-   end;
-
-   TCriticalSection = class(TSynchroObject)
-   private
-      CriticalSection : TRTLCriticalSection;
-   public
-      procedure Acquire;override;
-      procedure Release;override;
-      procedure Enter;
-      procedure Leave;
-      constructor Create;
-      destructor Destroy;override;
-   end;
-
-   THandleObject = class(TSynchroObject)
-   protected
-      FHandle : TEventHandle;
-      FLastError : Integer;
-   public
-      destructor destroy;override;
-      property Handle : TEventHandle read FHandle;
-      property LastError : Integer read FLastError;
-   end;
-
-   TEventObject = class(THandleObject)
-   private
-      FSem: Pointer;
-      FManualReset: Boolean;
-      FEventSection: TCriticalSection;
-   public
-      constructor Create(EventAttributes : PSecurityAttributes;
-        AManualReset,InitialState : Boolean;const Name : string);
-      destructor destroy; override;
-      procedure ResetEvent;
-      procedure SetEvent;
-      function WaitFor(Timeout : Cardinal) : TWaitResult;
-      Property ManualReset : Boolean read FManualReset;
-   end;
-
-   TEvent = TEventObject;
-
-   TSimpleEvent = class(TEventObject)
-      constructor Create;
-   end;

+ 175 - 0
fcl/inc/syncobjs.pp

@@ -0,0 +1,175 @@
+{
+    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
+  sysutils;
+
+type
+  PSecurityAttributes = Pointer;
+  TEventHandle = Pointer;
+
+const
+  INFINITE = Cardinal(-1);
+
+type
+   TWaitResult = (wrSignaled, wrTimeout, wrAbandoned, wrError);
+
+   TSynchroObject = class(TObject)
+      procedure Acquire;virtual;
+      procedure Release;virtual;
+   end;
+
+   TCriticalSection = class(TSynchroObject)
+   private
+      CriticalSection : TRTLCriticalSection;
+   public
+      procedure Acquire;override;
+      procedure Release;override;
+      procedure Enter;
+      procedure Leave;
+      constructor Create;
+      destructor Destroy;override;
+   end;
+
+   THandleObject = class(TSynchroObject)
+   protected
+      FHandle : TEventHandle;
+      FLastError : Integer;
+   public
+      destructor destroy;override;
+      property Handle : TEventHandle read FHandle;
+      property LastError : Integer read FLastError;
+   end;
+
+   TEventObject = class(THandleObject)
+   private
+      FManualReset: Boolean;
+   public
+      constructor Create(EventAttributes : PSecurityAttributes;
+        AManualReset,InitialState : Boolean;const Name : string);
+      destructor destroy; override;
+      procedure ResetEvent;
+      procedure SetEvent;
+      function WaitFor(Timeout : Cardinal) : TWaitResult;
+      Property ManualReset : Boolean read FManualReset;
+   end;
+
+   TEvent = TEventObject;
+
+   TSimpleEvent = class(TEventObject)
+      constructor Create;
+   end;
+
+implementation
+
+{ ---------------------------------------------------------------------
+    Real syncobjs implementation
+  ---------------------------------------------------------------------}
+
+procedure TSynchroObject.Acquire;
+begin
+end;
+
+procedure TSynchroObject.Release;
+begin
+end;
+
+procedure TCriticalSection.Enter;
+begin
+  Acquire;
+end;
+
+procedure TCriticalSection.Leave;
+begin
+  Release;
+end;
+
+
+procedure TCriticalSection.Acquire;
+
+begin
+  EnterCriticalSection(CriticalSection);
+end;
+
+procedure TCriticalSection.Release;
+
+begin
+  LeaveCriticalSection(CriticalSection);
+end;
+
+constructor TCriticalSection.Create;
+
+begin
+  Inherited Create;
+  InitCriticalSection(CriticalSection);
+end;
+
+destructor TCriticalSection.Destroy;
+
+begin
+  DoneCriticalSection(CriticalSection);
+end;
+
+destructor THandleObject.destroy;
+
+begin
+end;
+
+constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
+  AManualReset,InitialState : Boolean;const Name : string);
+
+begin
+  FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
+  FManualReset:=AManualReset;
+end;
+
+destructor TEventObject.destroy;
+
+begin
+  BasicEventDestroy(Handle);
+end;
+
+procedure TEventObject.ResetEvent;
+
+begin
+  BasicEventResetEvent(Handle);
+end;
+
+procedure TEventObject.SetEvent;
+
+begin
+  BasicEventSetEvent(Handle);
+end;
+
+
+function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
+
+begin
+  Result := TWaitResult(basiceventWaitFor(Timeout, Handle));
+  if Result = wrError then
+    FLastError := GetLastOSError;
+end;
+
+constructor TSimpleEvent.Create;
+
+begin
+  inherited Create(nil, True, False, '');
+end;
+
+end.

+ 0 - 179
fcl/linux/syncobjs.pp

@@ -1,179 +0,0 @@
-{
-    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, 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);
-  dispose(PSemaphore(FSem));
-  FEventSection.Free;
-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.

+ 0 - 178
fcl/netwlibc/syncobjs.pp

@@ -1,178 +0,0 @@
-{
-    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);
-  dispose(PSemaphore(FSem));
-  FEventSection.Free;
-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.

+ 0 - 179
fcl/solaris/syncobjs.pp

@@ -1,179 +0,0 @@
-{
-    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));
-  dispose(PSemaphore(FSem));
-  FEventSection.Free;
-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.

+ 0 - 115
fcl/win/syncobjs.pp

@@ -1,115 +0,0 @@
-{
-    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
-       windows,sysutils;
-
-    type
-      PSecurityAttributes = Windows.PSecurityAttributes;
-      TSecurityAttributes = Windows.TSecurityAttributes;
-      TEventHandle = THandle;
-
-{$I syncobh.inc}
-
-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);
-  inherited Destroy;
-end;
-
-destructor THandleObject.destroy;
-
-begin
-  CloseHandle(FHandle);
-  inherited Destroy;
-end;
-
-constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
-  AManualReset,InitialState : Boolean;const Name : string);
-
-begin
-  FHandle := CreateEvent(EventAttributes, AManualReset, InitialState, PChar(Name));
-end;
-
-destructor TEventObject.destroy;
-
-begin
-  inherited;
-end;
-
-procedure TEventObject.ResetEvent;
-
-begin
-  Windows.ResetEvent(FHandle)
-end;
-
-procedure TEventObject.SetEvent;
-
-begin
-  Windows.SetEvent(FHandle);
-end;
-
-function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
-
-begin
-  case WaitForSingleObject(Handle, Timeout) of
-    WAIT_ABANDONED: Result := wrAbandoned;
-    WAIT_OBJECT_0: Result := wrSignaled;
-    WAIT_TIMEOUT: Result := wrTimeout;
-    WAIT_FAILED:
-        begin
-        Result := wrError;
-        FLastError := GetLastError;
-       end;
-  else
-    Result := wrError;
-  end;
-end;
-
-constructor TSimpleEvent.Create;
-
-begin
-  FHandle := CreateEvent(nil, True, False, nil);
-end;
-
-end.

+ 0 - 115
fcl/wince/syncobjs.pp

@@ -1,115 +0,0 @@
-{
-    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
-       windows,sysutils;
-
-    type
-      PSecurityAttributes = Windows.PSecurityAttributes;
-      TSecurityAttributes = Windows.TSecurityAttributes;
-      TEventHandle = THandle;
-
-{$I syncobh.inc}
-
-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);
-  inherited Destroy;
-end;
-
-destructor THandleObject.destroy;
-
-begin
-  CloseHandle(FHandle);
-  inherited Destroy;
-end;
-
-constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
-  AManualReset,InitialState : Boolean;const Name : string);
-
-begin
-  FHandle := CreateEvent(EventAttributes, AManualReset, InitialState, PWidechar(Name));
-end;
-
-destructor TEventObject.destroy;
-
-begin
-  inherited;
-end;
-
-procedure TEventObject.ResetEvent;
-
-begin
-  Windows.ResetEvent(FHandle)
-end;
-
-procedure TEventObject.SetEvent;
-
-begin
-  Windows.SetEvent(FHandle);
-end;
-
-function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
-
-begin
-  case WaitForSingleObject(Handle, Timeout) of
-    WAIT_ABANDONED: Result := wrAbandoned;
-    WAIT_OBJECT_0: Result := wrSignaled;
-    WAIT_TIMEOUT: Result := wrTimeout;
-    WAIT_FAILED:
-        begin
-        Result := wrError;
-        FLastError := GetLastError;
-       end;
-  else
-    Result := wrError;
-  end;
-end;
-
-constructor TSimpleEvent.Create;
-
-begin
-  FHandle := CreateEvent(nil, True, False, nil);
-end;
-
-end.