asynccalls.pas

Asyncronous call of delphi functions and procedures.

begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgVariant.Create(Method, Arg).ExecuteAsync;
end;

{ ---------------------------------------------------------------------------- }

function AsyncCall(Method: TAsyncCallArgObjectEvent; Arg: TObject): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgObjectMethod(Method), Arg);
end;

function AsyncCall(Method: TAsyncCallArgIntegerEvent; Arg: Integer): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgIntegerMethod(Method), Arg);
end;

function AsyncCall(Method: TAsyncCallArgStringEvent; const Arg: AnsiString): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgStringMethod(Method), Arg);
end;

function AsyncCall(Method: TAsyncCallArgWideStringEvent; const Arg: WideString): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgWideStringMethod(Method), Arg);
end;

function AsyncCall(Method: TAsyncCallArgInterfaceEvent; const Arg: IInterface): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgInterfaceMethod(Method), Arg);
end;

function AsyncCall(Method: TAsyncCallArgExtendedEvent; const Arg: Extended): IAsyncCall;
begin
  Result := AsyncCall(TAsyncCallArgExtendedMethod(Method), Arg);
end;

function AsyncCallVar(Method: TAsyncCallArgVariantEvent; const Arg: Variant): IAsyncCall;
begin
  Result := AsyncCallVar(TAsyncCallArgVariantMethod(Method), Arg);
end;

function AsyncCallRunnable(const Arg: IInterface): Integer;
begin
  IAsyncRunnable(Arg).AsyncRun;
  Result := 0;
end;

function AsyncCall(Runnable: IAsyncRunnable): IAsyncCall;
begin
  Result := AsyncCall(AsyncCallRunnable, IInterface(Runnable));
end;

{ ---------------------------------------------------------------------------- }

procedure AsyncExec(Method: TNotifyEvent; Arg: TObject; IdleMsgMethod: TAsyncIdleMsgMethod);
var
  Handle: IAsyncCall;
begin
  Handle := AsyncCall(Method, Arg);
  if Assigned(IdleMsgMethod) then
  begin
    Handle.ForceDifferentThread;
    IdleMsgMethod;
    while MsgAsyncMultiSync([Handle], False, INFINITE, QS_ALLINPUT or QS_ALLPOSTMESSAGE) = 1 do
      IdleMsgMethod;
  end;
end;

{ ---------------------------------------------------------------------------- }
function InternLocalAsyncCall(LocalProc: TLocalAsyncProc; BasePointer: Pointer): IAsyncCall;
begin
  Result := TAsyncCallLocalProc.Create(LocalProc, BasePointer).ExecuteAsync;
end;

function LocalAsyncCall(LocalProc: TLocalAsyncProc): IAsyncCall;
asm
  mov ecx, edx // interface return address
  mov edx, ebp
  jmp InternLocalAsyncCall
end;

function InternLocalAsyncCallEx(LocalProc: TLocalAsyncProc; Param: INT_PTR; BasePointer: Pointer): IAsyncCall;
begin
  Result := TAsyncCallLocalProcEx.Create(LocalProc, Param, BasePointer).ExecuteAsync;
end;

function LocalAsyncCallEx(LocalProc: TLocalAsyncProcEx; Param: INT_PTR): IAsyncCall;
asm
  push ecx // interface return address
  mov ecx, ebp
  call InternLocalAsyncCallEx
end;

procedure InternLocalAsyncExec(LocalProc: TLocalAsyncProc; IdleMsgMethod: TAsyncIdleMsgMethod; BasePointer: Pointer);
var
  Handle: IAsyncCall;
begin
  Handle := TAsyncCallLocalProc.Create(LocalProc, BasePointer).ExecuteAsync;
  if Assigned(IdleMsgMethod) then
  begin
    Handle.ForceDifferentThread;
    IdleMsgMethod;
    while MsgAsyncMultiSync([Handle], False, INFINITE, QS_ALLINPUT or QS_ALLPOSTMESSAGE) = 1 do
      IdleMsgMethod;
  end;
end;

{$STACKFRAMES ON}
procedure LocalAsyncExec(Proc: TLocalAsyncProc; IdleMsgMethod: TAsyncIdleMsgMethod);
asm // TMethod causes the compiler to generate a stackframe
  pop ebp // remove stackframe
  mov edx, ebp
  jmp InternLocalAsyncExec
end;
{$STACKFRAMES OFF}

{ ---------------------------------------------------------------------------- }

function AsyncCallEx(Proc: TAsyncCallArgRecordProc; var Arg{: TRecordType}): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Proc(Arg))
  else
    Result := TAsyncCallArgRecord.Create(Proc, @Arg).ExecuteAsync;
end;

function AsyncCallEx(Method: TAsyncCallArgRecordMethod; var Arg{: TRecordType}): IAsyncCall;
begin
  { Execute the function synchron if no thread pool exists }
  if ThreadPool.MaxThreads = 0 then
    Result := TSyncCall.Create(Method(Arg))
  else
    Result := TAsyncCallMethodArgRecord.Create(Method, @Arg).ExecuteAsync;
end;

function AsyncCallEx(Method: TAsyncCallArgRecordEvent; var Arg{: TRecordType}): IAsyncCall;
begin
  Result := AsyncCallEx(TAsyncCallArgRecordMethod(Method), Arg);
end;

{ ---------------------------------------------------------------------------- }

function AsyncCall(Proc: TCdeclFunc; const Args: array of const): IAsyncCall; overload;
var
  Call: TAsyncCall;
begin
  Call := TAsyncCallArrayOfConst.Create(Proc, Args);
  if ThreadPool.MaxThreads = 0 then
    Call.InternExecuteSyncCall
  else
    Call.ExecuteAsync;
  Result := Call;
end;

function AsyncCall(Proc: TCdeclMethod; const Args: array of const): IAsyncCall; overload;
var
  Call: TAsyncCall;
begin
  Call := TAsyncCallArrayOfConst.Create(Proc.Code, TObject(Proc.Data), Args);
  if ThreadPool.MaxThreads = 0 then
    Call.InternExecuteSyncCall
  else
    Call.ExecuteAsync;
  Result := Call;
end;

{ ---------------------------------------------------------------------------- }

function WaitForSingleObjectMainThread(AHandle: THandle; Timeout: Cardinal): Cardinal;
var
  Handles: array[0..2] of THandle;
begin
  Handles[0] := AHandle;
  Handles[1] := SyncEvent;
  Handles[2] := ThreadPool.MainThreadSyncEvent;
  {$IFDEF DELPHI6}
  HookWakeMainThread;
  try
  {$ENDIF DELPHI6}
  repeat
    Result := WaitForMultipleObjects(3, @Handles[0], False, Timeout);
    if Result = WAIT_OBJECT_0 + 1 then
      CheckSynchronize
    else if Result = WAIT_OBJECT_0 + 2 then
      ThreadPool.ProcessMainThreadSync;
  until (Result <> WAIT_OBJECT_0 + 1) and (Result <> WAIT_OBJECT_0 + 2);
  {$IFDEF DELPHI6}
  finally
    UnhookWakeMainThread;
  end;
  {$ENDIF DELPHI6}
end;

function WaitForMultipleObjectsMainThread(Count: Cardinal;
  const AHandles: array of THandle; WaitAll: Boolean; Timeout: Cardinal;
  MsgWait: Boolean; dwWakeMask: DWORD): Cardinal;
var
  Handles: array of THandle;
  Index: Cardinal;
  FirstFinished, OriginalCount: Cardinal;
begin
  { Wait for the specified events, for the VCL SyncEvent and for the MainThreadSync event }
  OriginalCount := Count;
  SetLength(Handles, Count + 2);
  Move(AHandles[0], Handles[0], Count * SizeOf(THandle));
  Handles[Count] := SyncEvent;
  Handles[Count + 1] := ThreadPool.MainThreadSyncEvent;
  {$IFDEF DELPHI6}
  HookWakeMainThread;
  try
  {$ENDIF DELPHI6}
  if not WaitAll then
  begin
    repeat
      if MsgWait then
      begin
        Result := MsgWaitForMultipleObjects(Count + 2, Handles[0], WaitAll, Timeout, dwWakeMask);
        if Result = WAIT_OBJECT_0 + Count + 2 then
        begin
          ThreadPool.ProcessMainThreadSync; // also uses the message queue
          Result := WAIT_OBJECT_0 + OriginalCount; // caller doesn't know about the 2 synchronization events
          Exit;
        end;
      end
      else
        Result := WaitForMultipleObjects(Count + 2, @Handles[0], WaitAll, Timeout);

      if Result = WAIT_OBJECT_0 + Count then
        CheckSynchronize
      else if Result = WAIT_OBJECT_0 + Count + 1 then
        ThreadPool.ProcessMainThreadSync;
    until (Result <> WAIT_OBJECT_0 + Count) and (Result <> WAIT_OBJECT_0 + Count + 1);
  end
  else
  begin
    FirstFinished := WAIT_TIMEOUT;
    repeat
      if MsgWait then
      begin
        Result := MsgWaitForMultipleObjects(Count + 2, Handles[0], False, Timeout, dwWakeMask);
        if Result = WAIT_OBJECT_0 + Count + 2 then
        begin
          ThreadPool.ProcessMainThreadSync; // also uses the message queue
          Result := WAIT_OBJECT_0 + OriginalCount; // caller doesn't know about the 2 synchronization events
          Exit;
        end;
      end
      else
        Result := WaitForMultipleObjects(Count + 2, @Handles[0], False, Timeout);

      if Result = WAIT_OBJECT_0 + Count then
        CheckSynchronize
      else if Result = WAIT_OBJECT_0 + Count + 1 then
        ThreadPool.ProcessMainThreadSync
      else
      if {(Result >= WAIT_OBJECT_0) and} (Result <= WAIT_OBJECT_0 + Count) then
      begin
        if FirstFinished = WAIT_TIMEOUT then
          FirstFinished := Result;
        Dec(Count);
        if Count > 0 then
        begin
          Index := Result - WAIT_OBJECT_0;
          Move(Handles[Index + 1], Handles[Index], ((Count + 2) - Index) * SizeOf(THandle));
        end;
      end
      else
        Break;
    until Count = 0;
    if Count = 0 then
      Result := FirstFinished;
  end;
  {$IFDEF DELPHI6}
  finally
    UnhookWakeMainThread;
  end;
  {$ENDIF DELPHI6}
end;

{ ---------------------------------------------------------------------------- }

function InternalAsyncMultiSync(const List: array of IAsyncCall; const Handles: array of THandle;
  WaitAll: Boolean; Milliseconds: Cardinal; MsgWait: Boolean; dwWakeMask: DWORD): Cardinal;

  function InternalWait(const List: array of IAsyncCall; const Handles: array of THandle;
    WaitAll: Boolean; Milliseconds: Cardinal; MsgWait: Boolean; dwWakeMask: DWORD): Cardinal;
  var
    WaitHandles: array of THandle;
    Mapping: array of Integer;
    I: Integer;
    Count: Cardinal;
    EventIntf: IAsyncCallEx;
    SignalState: Cardinal;
  begin
    SetLength(WaitHandles, Length(List) + Length(Handles));
    SetLength(Mapping, Length(WaitHandles));
    Count := 0;
    { Get the TAsyncCall events }
    for I := 0 to High(List) do
    begin
      if (List[I] <> nil) and Supports(List[I], IAsyncCallEx, EventIntf) then
      begin
        WaitHandles[Count] := EventIntf.GetEvent;
        if WaitHandles[Count] <> 0 then
        begin
          Mapping[Count] := I;
          Inc(Count);
        end;
      end
      else
      if not WaitAll then
      begin
        { There are synchron calls in List[] and the caller does not want to
          wait for all handles. }
        Result := I;
        Exit;
      end;
    end;

    { Append other handles }
    for I := 0 to High(Handles) do
    begin
      WaitHandles[Count] := Handles[I];
      Mapping[Count] := Length(List) + I;
      Inc(Count);
    end;

    { Wait for the async calls }
    if Count > 0 then
    begin
      if GetCurrentThreadId = MainThreadID then
      begin
        SignalState := WaitForMultipleObjectsMainThread(Count, WaitHandles, WaitAll, Milliseconds, MsgWait, dwWakeMask);
        if SignalState = Count then // "message" was signaled
        begin
          Result := SignalState;
          Exit;
        end;
      end
      else
      begin
        if MsgWait then
        begin
          SignalState := MsgWaitForMultipleObjects(Count, WaitHandles[0], WaitAll, Milliseconds, dwWakeMask);
          if SignalState = Count then // "message" was signaled
          begin
            Result := SignalState;
            Exit;
          end;
        end
        else
          SignalState := WaitForMultipleObjects(Count, @WaitHandles[0], WaitAll, Milliseconds);
      end;
      if {(SignalState >= WAIT_OBJECT_0) and} (SignalState < WAIT_OBJECT_0 + Count) then
        Result := WAIT_OBJECT_0 + Mapping[SignalState - WAIT_OBJECT_0]
      else if (SignalState >= WAIT_ABANDONED_0) and (SignalState < WAIT_ABANDONED_0 + Count) then
        Result := WAIT_ABANDONED_0 + Mapping[SignalState - WAIT_ABANDONED_0]
      else
        Result := SignalState;
    end
    else
      Result := WAIT_OBJECT_0; // all AsyncCalls are already synchronized
  end;

  function InternalWaitAllInfinite(const List: array of IAsyncCall; const Handles: array of THandle): Cardinal;
  var
    I: Integer;
  begin
    { Wait for the async calls that aren't finished yet. }
    for I := 0 to High(List) do
      if List[I] <> nil then
        List[I].Sync;

    if Length(Handles) > 0 then
    begin