Browse Source

* implement waitformultiple for win32 only.
* Change interface to allow for COM waiting + a basic windows implementation. (only for desktop apps? Use msgwait* for the rest?)

marcoonthegit 2 years ago
parent
commit
452ec93f06

+ 107 - 37
packages/fcl-base/src/syncobjs.pp

@@ -51,17 +51,26 @@ type
       constructor Create;
       destructor Destroy;override;
    end;
-
+   THandleObject= class;
+   THandleObjectArray = array of THandleObject;
    THandleObject = class abstract  (TSynchroObject)
    protected
       FHandle : TEventHandle;
       FLastError : Integer;
+      {$IFDEF MSWINDOWS}
+       // Windows specific, use COWait* functions for com compatibility.
+        FUseCOMWait: Boolean;
+      {$ENDIF MSWINDOWS}
    public
+      constructor Create(UseComWait : Boolean=false);
       destructor Destroy; override;
+      function WaitFor(Timeout : Cardinal=INFINITE) : TWaitResult;
+      {$IFDEF MSWINDOWS}
+        class function WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
+      {$ENDIF MSWINDOWS}
       property Handle : TEventHandle read FHandle;
       property LastError : Integer read FLastError;
    end;
-   THandleObjectArray = array of THandleObject;
 
    TEventObject = class(THandleObject)
    private
@@ -69,12 +78,10 @@ type
    public
       constructor Create(EventAttributes : PSecurityAttributes;
         AManualReset,InitialState : Boolean;const Name : string;
-        UseComWait:boolean=false);
-      constructor Create(UseComWait : Boolean=false);
-      destructor Destroy; override;
+        UseComWait:boolean=false); overload;
       procedure ResetEvent;
       procedure SetEvent;
-      function WaitFor(Timeout : Cardinal=INFINITE) : TWaitResult;
+
       Property ManualReset : Boolean read FManualReset;
    end;
 
@@ -86,8 +93,18 @@ type
 
 implementation
 
+{$ifdef MSWindows}
+uses Windows;
+
+function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'CoWaitForMultipleObjects';
+{$endif}
+
+
 Resourcestring
-  SErrEventCreateFailed = 'Failed to create OS basic event with name "%s"'; 
+  SErrEventCreateFailed   = 'Failed to create OS basic event with name "%s"';
+  SErrEventZeroNotAllowed = 'Handle count of zero is not allowed.';
+  SErrEventMaxObjects     = 'The maximal amount of objects is %d.';
+  SErrEventTooManyHandles = 'Length of object handles smaller than Len.';
 
 { ---------------------------------------------------------------------
     Real syncobjs implementation
@@ -122,7 +139,7 @@ end;
 
 function  TCriticalSection.TryEnter:boolean;
 begin
-  result:=TryEnterCriticalSection(CriticalSection)<>0;
+  result:=System.TryEnterCriticalSection(CriticalSection)<>0;
 end;
 
 procedure TCriticalSection.Acquire;
@@ -150,32 +167,102 @@ begin
   DoneCriticalSection(CriticalSection);
 end;
 
-destructor THandleObject.destroy;
+{ THandleObject }
 
+constructor THandleObject.Create(UseComWait : Boolean=false);
+// cmompatibility shortcut constructor, Com waiting not implemented yet
 begin
+  FHandle := BasicEventCreate(nil, True,False,'');
+  if (FHandle=Nil) then
+    Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,['']);
 end;
 
-constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
-  AManualReset,InitialState : Boolean;const Name : string;UseComWait:boolean=false);
+function THandleObject.WaitFor(Timeout : Cardinal) : TWaitResult;
 
 begin
-  FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
-  if (FHandle=Nil) then
-    Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,[Name]);
-  FManualReset:=AManualReset;
+  Result := TWaitResult(basiceventWaitFor(Timeout, Handle));
+  if Result = wrError then
+{$IFDEF OS2}
+    FLastError := PLocalEventRec (Handle)^.FLastError;
+{$ELSE OS2}
+  {$if declared(getlastoserror)}
+    FLastError := GetLastOSError;
+  {$else}
+    FLastError:=-1;
+  {$endif}
+{$ENDIF OS2}
 end;
 
+{$IFDEF MSWINDOWS}
+class function THandleObject.WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: Cardinal; AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer = 0): TWaitResult;
+var
+  ret: Integer;
+  AmountHandles: Integer;
+begin
+  AmountHandles := Length(HandleObjs);
+  if AmountHandles = 0 then
+    raise ESyncObjectException.Create(SErrEventZeroNotAllowed);
+
+  if AmountHandles > MAXIMUM_WAIT_OBJECTS then
+    raise ESyncObjectException.CreateFmt(SErrEventMaxObjects, [MAXIMUM_WAIT_OBJECTS]);
+
+  if Len > AmountHandles then
+    raise ESyncObjectException.Create(SErrEventTooManyHandles);
+
+  // what about UseCOMWait?
+  {$IFDEF MSWINDOWS}
+  if UseCOMWait Then
+    begin
+      SetLastError(ERROR_SUCCESS); // only for "alertable" objects
+      ret := CoWaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
+    end
+  else
+  {$ENDIF}
+    ret := WaitForMultipleObjects(Len, @HandleObjs, AAll, Timeout);
+
+  if (ret >= WAIT_OBJECT_0) and (ret < (WAIT_OBJECT_0 + Len)) then
+    begin
+      if not AAll then
+        SignaledObj := HandleObjs[ret];
+      Exit(wrSignaled);
+    end;
+
+  if (ret >= WAIT_ABANDONED_0) and (ret < (WAIT_ABANDONED_0 + Len)) then
+    begin
+      if not AAll then
+        SignaledObj := HandleObjs[ret];
+      Exit(wrAbandoned);
+    end;
+
+  case ret of
+    WAIT_TIMEOUT:
+      begin
+        Result := wrTimeout;
+      end;
+    Integer(WAIT_FAILED): // w/o: Warning: Range check error while evaluating constants (4294967295 must be between -2147483648 and 2147483647)
+      begin
+        Result := wrError;
+      end;
+  end;
+end;
+{$endif}
 
-constructor TEventObject.Create(UseComWait : Boolean=false);
-// cmompatibility shortcut constructor, Com waiting not implemented yet
+destructor THandleObject.Destroy;
 begin
- Create(nil,True,false,'',UseComWait);
+  BasicEventDestroy(Handle);
 end;
 
-destructor TEventObject.destroy;
+constructor TEventObject.Create(EventAttributes : PSecurityAttributes;
+  AManualReset,InitialState : Boolean;const Name : string;UseComWait:boolean=false);
 
 begin
-  BasicEventDestroy(Handle);
+  {$IFDEF MSWINDOWS}
+    FUseCOMWait:=UseComWait;
+  {$endif}
+  FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name);
+  if (FHandle=Nil) then
+    Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,[Name]);
+  FManualReset:=AManualReset;
 end;
 
 procedure TEventObject.ResetEvent;
@@ -190,23 +277,6 @@ begin
   BasicEventSetEvent(Handle);
 end;
 
-
-function TEventObject.WaitFor(Timeout : Cardinal) : TWaitResult;
-
-begin
-  Result := TWaitResult(basiceventWaitFor(Timeout, Handle));
-  if Result = wrError then
-{$IFDEF OS2}
-    FLastError := PLocalEventRec (Handle)^.FLastError;
-{$ELSE OS2}
-  {$if defined(getlastoserror)}
-    FLastError := GetLastOSError;
-  {$else}
-    FLastError:=-1;
-  {$endif}
-{$ENDIF OS2}
-end;
-
 constructor TSimpleEvent.Create;
 
 begin

+ 1 - 1
rtl/amicommon/athreads.pp

@@ -1117,7 +1117,7 @@ end;
 // End timer stuff
 
 // the mighty Waitfor routine
-function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 var
   AmiEvent: PAmiEvent absolute State;
   Tr: PTimeRequest = nil;

+ 1 - 1
rtl/beos/bethreads.pp

@@ -463,7 +463,7 @@ begin
   end;
 end;
 
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 
 begin
   If TimeOut<>Cardinal($FFFFFFFF) then

+ 3 - 3
rtl/inc/thread.inc

@@ -305,10 +305,10 @@ begin
   currenttm.BasicEventSetEvent(state);
 end;
 
-function  BasicEventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function  BasicEventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 
 begin
- result:=currenttm.BasicEventWaitFor(Timeout,state);
+ result:=currenttm.BasicEventWaitFor(Timeout,state,FUseComWait);
 end;
 
 function  RTLEventCreate :PRTLEvent;
@@ -542,7 +542,7 @@ begin
     ThreadingAlreadyUsed:=true;
 end;
 
-function  NoBasicEventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function  NoBasicEventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 
 begin
   if IsMultiThread then

+ 2 - 2
rtl/inc/threadh.inc

@@ -56,7 +56,7 @@ type
   TAllocateThreadVarsHandler = Procedure;
   TReleaseThreadVarsHandler = Procedure;
   TBasicEventHandler        = procedure(state:peventstate);
-  TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate):longint;
+  TBasicEventWaitForHandler = function (timeout:cardinal;state:peventstate;FUseComWait : Boolean=False):longint;
   TBasicEventCreateHandler  = function (EventAttributes :Pointer;  AManualReset,InitialState : Boolean;const Name:ansistring):pEventState;
   TRTLEventHandler          = procedure(AEvent:PRTLEvent);
   TRTLEventHandlerTimeout   = procedure(AEvent:PRTLEvent;timeout : longint);
@@ -174,7 +174,7 @@ function  BasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState
 procedure BasicEventDestroy(state:peventstate);
 procedure BasicEventResetEvent(state:peventstate);
 procedure BasicEventSetEvent(state:peventstate);
-function  BasicEventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function  BasicEventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 
 function  RTLEventCreate :PRTLEvent;
 procedure RTLEventDestroy(state:pRTLEvent);

+ 1 - 1
rtl/nativent/systhrd.inc

@@ -188,7 +188,7 @@ procedure intbasiceventSetEvent(state:peventstate);
 begin
 end;
 
-function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 begin
   Result := STATUS_NOT_IMPLEMENTED;
 end;

+ 1 - 1
rtl/netware/systhrd.inc

@@ -420,7 +420,7 @@ begin
   {$WARNING TODO! intbasiceventSetEvent}
 end;
 
-function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 begin
   {$WARNING TODO! intbasiceventWaitFor}
 end;

+ 1 - 1
rtl/netwlibc/systhrd.inc

@@ -333,7 +333,7 @@ begin
   end;
 end;
 
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 
 begin
   If TimeOut<>Cardinal($FFFFFFFF) then

+ 1 - 1
rtl/os2/systhrd.inc

@@ -833,7 +833,7 @@ begin
 end;
 
 
-function SysBasicEventWaitFor (Timeout: Cardinal; State: PEventState): longint;
+function SysBasicEventWaitFor (Timeout: Cardinal; State: PEventState;FUseComWait : Boolean=False): longint;
 var
   RC: cardinal;
 begin

+ 1 - 1
rtl/unix/cthreads.pp

@@ -809,7 +809,7 @@ begin
   pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
 end;
 
-function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate;FUseComWait : Boolean=False) : longint;
 var
   timespec: ttimespec;
   errres: cint;

+ 1 - 1
rtl/wasi/systhrd.inc

@@ -162,7 +162,7 @@ begin
   {todo:implement}
 end;
 
-function WasiBasicEventWaitFor(timeout:cardinal;state:peventstate):longint;
+function WasiBasicEventWaitFor(timeout:cardinal;state:peventstate;FUseComWait : Boolean=False):longint;
 begin
   {todo:implement}
 end;

+ 16 - 2
rtl/win/systhrd.inc

@@ -329,7 +329,9 @@ var
 
     function  SysWaitForThreadTerminate (threadHandle : TThreadID; TimeoutMs : longint) : dword;
     begin
+      // shouldn't this be a msgwait in case the thread creates "Windows"  See comment in waitforsingle?
       if timeoutMs = 0 then dec (timeoutMs);  // $ffffffff is INFINITE
+      // does waiting on thread require cowait too ?
       SysWaitForThreadTerminate := WaitForSingleObject(threadHandle, TimeoutMs);
     end;
 
@@ -539,10 +541,22 @@ begin
   SetEvent(THandle(state));
 end;
 
-function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
 
+type 
+      PWOHandleArray = ^THandle;
+
+function CoWaitForMultipleObjects(nCount:DWORD; lpHandles : PWOHandleArray; bWaitAll:LONGBOOL; dwMilliseconds:DWORD):DWORD; external 'ole32.dll' name 'CoWaitForMultipleObjects';
+
+function intbasiceventWaitFor(Timeout : Cardinal;state:peventstate;UseCOMWait: Boolean = False) : longint;
+
+var ret : Integer;
 begin
-  case WaitForSingleObject(THandle(state), Timeout) of
+   if UseComWait Then
+     ret:=CoWaitForMultipleObjects(1,PWOHandleArray(@state), True, Timeout)
+   else 
+     ret:=WaitForSingleObject(THandle(state), Timeout);
+
+   case ret of
     WAIT_ABANDONED: Result := wrAbandoned;
     WAIT_OBJECT_0: Result := wrSignaled;
     WAIT_TIMEOUT: Result := wrTimeout;