ソースを参照

+arm/wince more fcl unit : syncobjs

git-svn-id: trunk@2057 -
oro06 19 年 前
コミット
ef1def657f
4 ファイル変更119 行追加3 行削除
  1. 1 0
      .gitattributes
  2. 2 2
      fcl/Makefile
  3. 1 1
      fcl/Makefile.fpc
  4. 115 0
      fcl/wince/syncobjs.pp

+ 1 - 0
.gitattributes

@@ -1045,6 +1045,7 @@ fcl/wince/fileinfo.pp svneol=native#text/plain
 fcl/wince/pipes.inc svneol=native#text/plain
 fcl/wince/process.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

+ 2 - 2
fcl/Makefile

@@ -392,7 +392,7 @@ ifeq ($(FULL_TARGET),i386-netwlibc)
 override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  resolve ssockets syncobjs
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process fileinfo simpleipc
+override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process fileinfo syncobjs simpleipc msgintf dbugintf
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf
@@ -452,7 +452,7 @@ ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process fileinfo simpleipc
+override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process fileinfo syncobjs simpleipc msgintf dbugintf
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_UNITS+=$(CLASSES10) contnrs inifiles ezcgi pipes rtfpars idea base64 gettext iostream zstream cachecls avl_tree xmlreg registry eventlog custapp cgiapp wformat whtml wtex rttiutils bufstream streamex  process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf

+ 1 - 1
fcl/Makefile.fpc

@@ -33,7 +33,7 @@ units_netbsd=process ssockets resolve fpasync simpleipc msgintf dbugintf
 units_openbsd=process ssockets resolve fpasync simpleipc msgintf dbugintf
 units_linux=process resolve ssockets fpasync syncobjs simpleipc msgintf dbugintf
 units_win32=process fileinfo resolve ssockets syncobjs simpleipc msgintf dbugintf
-units_wince=process fileinfo simpleipc
+units_wince=process fileinfo syncobjs simpleipc msgintf dbugintf
 units_os2=resolve ssockets
 units_emx=resolve ssockets
 units_netware=resolve ssockets

+ 115 - 0
fcl/wince/syncobjs.pp

@@ -0,0 +1,115 @@
+{
+    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.