diff --git a/packages/fcl-base/src/syncobjs.pp b/packages/fcl-base/src/syncobjs.pp index 3c0705f313..b25b2780a1 100644 --- a/packages/fcl-base/src/syncobjs.pp +++ b/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,34 +167,104 @@ 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; + +function THandleObject.WaitFor(Timeout : Cardinal) : TWaitResult; begin + 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} + +destructor THandleObject.Destroy; +begin + BasicEventDestroy(Handle); end; constructor TEventObject.Create(EventAttributes : PSecurityAttributes; AManualReset,InitialState : Boolean;const Name : string;UseComWait:boolean=false); begin + {$IFDEF MSWINDOWS} + FUseCOMWait:=UseComWait; + {$endif} FHandle := BasicEventCreate(EventAttributes, AManualReset, InitialState, Name); if (FHandle=Nil) then Raise ESyncObjectException.CreateFmt(SErrEventCreateFailed,[Name]); FManualReset:=AManualReset; end; - -constructor TEventObject.Create(UseComWait : Boolean=false); -// cmompatibility shortcut constructor, Com waiting not implemented yet -begin - Create(nil,True,false,'',UseComWait); -end; - -destructor TEventObject.destroy; - -begin - BasicEventDestroy(Handle); -end; - procedure TEventObject.ResetEvent; begin @@ -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 diff --git a/rtl/amicommon/athreads.pp b/rtl/amicommon/athreads.pp index 7f4dd49b5b..6c8a0a09b5 100644 --- a/rtl/amicommon/athreads.pp +++ b/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; diff --git a/rtl/beos/bethreads.pp b/rtl/beos/bethreads.pp index ee2c47c6e5..f212c09cdd 100644 --- a/rtl/beos/bethreads.pp +++ b/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 diff --git a/rtl/inc/thread.inc b/rtl/inc/thread.inc index 85c7175d12..f7e7b91f7e 100644 --- a/rtl/inc/thread.inc +++ b/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 diff --git a/rtl/inc/threadh.inc b/rtl/inc/threadh.inc index db811bc8e3..e6c23da0b2 100644 --- a/rtl/inc/threadh.inc +++ b/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); diff --git a/rtl/nativent/systhrd.inc b/rtl/nativent/systhrd.inc index 2eac9b3ca5..427bea7869 100644 --- a/rtl/nativent/systhrd.inc +++ b/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; diff --git a/rtl/netware/systhrd.inc b/rtl/netware/systhrd.inc index 298fc0a9ff..e97852c3cb 100644 --- a/rtl/netware/systhrd.inc +++ b/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; diff --git a/rtl/netwlibc/systhrd.inc b/rtl/netwlibc/systhrd.inc index 6a3b5232b0..08163e366e 100644 --- a/rtl/netwlibc/systhrd.inc +++ b/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 diff --git a/rtl/os2/systhrd.inc b/rtl/os2/systhrd.inc index 93c4f6d1ae..5574e7f81e 100644 --- a/rtl/os2/systhrd.inc +++ b/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 diff --git a/rtl/unix/cthreads.pp b/rtl/unix/cthreads.pp index 0c7db9766d..1075b1b947 100644 --- a/rtl/unix/cthreads.pp +++ b/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; diff --git a/rtl/wasi/systhrd.inc b/rtl/wasi/systhrd.inc index b558c22e67..79b42b8aaa 100644 --- a/rtl/wasi/systhrd.inc +++ b/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; diff --git a/rtl/win/systhrd.inc b/rtl/win/systhrd.inc index 7fe4eab8f3..588d0a815c 100644 --- a/rtl/win/systhrd.inc +++ b/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;