idfiber.pas

photo.163.com 相册下载器 多线程下载

      Exit;
    end else begin
      SwitchToFiber := nil;
      CreateFiber := nil;
      DeleteFiber := nil;
      ConvertThreadToFiber := nil;
    end;
  end;
  EIdFibersNotSupported.Toss(RSFibersNotSupported);
end;

procedure FiberFunc(AFiber: TIdFiber); stdcall;
var
  LParentFiber: TIdFiberBase;
begin
  with AFiber do begin
    Execute;
    LParentFiber := ParentFiber;
  end;
  // Threads converted from Fibers have no parent. Also use may specify
  // nil if they want to control exit manually.
  //
  // We must do this last because with schedulers fibers get switched away
  // at this last point and not rescheduled. We do this outside the
  // execute as the fiber will likely be freed from somewhere else
  if LParentFiber <> nil then begin
    LParentFiber.SwitchToMeFrom(AFiber);
  end;
end;

{ TIdFiber }

procedure TIdFiber.AfterRun;
begin
end;

procedure TIdFiber.BeforeRun;
begin
end;

procedure TIdFiber.CheckRunnable;
begin
  inherited;
  EIdFiberFinished.IfTrue(Finished, 'Fiber is finished.'); {do not localize}
  EIdFiber.IfTrue((ParentFiber = nil) and (Assigned(FOnRelinquish) = False)
   , 'No parent fiber or fiber weaver specified.'); {do not localize}
end;

constructor TIdFiber.Create(
  AParentFiber: TIdFiberBase;
  ALoop: Boolean;
  AStackSize: Integer
  );
begin
  inherited Create;
  FFinished := TIdThreadSafeBoolean.Create;
  FStarted := TIdThreadSafeBoolean.Create;
  FStopped := TIdThreadSafeBoolean.Create;
  FFreeFiber := True;
  FLoop := ALoop;
  FParentFiber := AParentFiber;
  // Create Fiber
  FHandle := Pointer(CreateFiber(AStackSize, @FiberFunc, Self));
  Win32Check(LongBool(FHandle));
end;

destructor TIdFiber.Destroy;
begin
  EIdException.IfTrue(Started and (Finished = False), 'Fiber not finished.'); {do not localize}
  // Threads converted from Fibers will have nil parents and if we call
  // DeleteFiber it will exit the whole thread.
  if FFreeFiber then begin
    // Must never call from self. If so ExitThread is called
    // Because of this FreeOnTerminate cannot be suported because a fiber
    // cannot delete itself, and we never know where a fiber will go for sure
    // when it is done. It can be done that the next fiber deletes it, but
    // there are catches here too. Because of this I have made it the
    // responsibility of the user (manual) or the scheduler (optional).
    Win32Check(DeleteFiber(FHandle));
  end;
  FreeAndNil(FYarn);
  FreeAndNil(FFinished);
  FreeAndNil(FStarted);
  FreeAndNil(FStopped);
  // Kudzu:
  // Docs say to call ReleaseException, but its empty. But it appears that since
  // we are taking the exception and taking it from the raise list, that instead
  // what we need to do is call .Free on the exception instead and that the docs
  // are wrong. Need to run through a memory checker to verify the behaviour.
  //
  // Normally the except block frees the exception object, but we are stealing
  // it out fo the list, so it does not free it.
  //
  // Ive looked into TThread and this is what it does as well, so big surprise
  // that the docs are wrong.
  //
  // Update: We only free it if we dont reraise the exception. If we reraise it
  // the fiber may be freed in a finally, and thus when the exception is handled
  // again an AV or other will occur because the exception has been freed.
  // When it is reraised, it is added back into the exception list and the
  // VCL will free it as part of the final except block.
  //
  if FFreeFatalException then begin
    FreeAndNil(FFatalException);
  end;
  //
  inherited;
end;

procedure TIdFiber.Execute;
begin
  try
    try
      BeforeRun; try
        // This can be combined, but then it checks loop each run and its not
        // valid to toggle it after run has started and therefore adds an
        // unnecessary check
        if Loop then begin
          while not Stopped do begin
            Run;
            // If Weaver, this will let the weaver reschedule.
            // If manual it will switch back to parent to let it handle it.
            // If stopped just run through so it can clean up and exit
            if not Stopped then begin
              Yield;
            end;
          end;
        end else begin
          Run;
        end;
      finally AfterRun; end;
    except FFatalException := AcquireExceptionObject; end;
    if FFatalException <> nil then begin
      FFatalExceptionOccurred := True;
      FFreeFatalException := True;
    end;
  finally FFinished.Value := True; end;
end;

function TIdFiber.GetFinished: Boolean;
begin
  Result := FFinished.Value;
end;

function TIdFiber.GetStarted: Boolean;
begin
  Result := FStarted.Value;
end;

function TIdFiber.GetStopped: Boolean;
begin
  Result := FStopped.Value;
end;

procedure TIdFiber.RaiseFatalException;
begin
  if FatalExceptionOccurred then begin
    FFreeFatalException := False;
    raise FFatalException;
  end;
end;

procedure TIdFiber.Stop;
begin
  FStopped.Value := True;
end;

procedure TIdFiber.SwitchToParent;
begin
  EIdException.IfNotAssigned(FParentFiber, 'No parent fiber to switch to.'); {do not localize}
  SwitchTo(FParentFiber);
end;

procedure TIdFiber.Relinquish;
begin
  if Assigned(FOnRelinquish) then begin
    FOnRelinquish(Self, False);
  end else begin
    SwitchToParent;
  end;
end;

procedure TIdFiber.Yield;
begin
  // If manual fiber, yield is same as relinquish
  if Assigned(FOnRelinquish) then begin
    FOnRelinquish(Self, True);
  end else begin
    SwitchToParent;
  end;
end;

procedure TIdFiber.SetRelinquishHandler(AValue: TIdFiberRelinquishEvent);
begin
  FOnRelinquish := AValue;
end;

{ TIdConvertedFiber }

constructor TIdConvertedFiber.Create;
begin
  inherited;
  FHandle := Pointer(ConvertThreadToFiber(Self));
end;

{ TIdFiberBase }

constructor TIdFiberBase.Create;
begin
  inherited;
  if not Assigned(@CreateFiber) then begin
    LoadFiberFunctions;
  end;
end;

procedure TIdFiberBase.CheckRunnable;
begin
end;

class function TIdFiberBase.HaveFiberSupport:boolean;
begin
  Result := Win32Platform = VER_PLATFORM_WIN32_NT;
end;

procedure TIdFiberBase.SwitchTo(AFiber: TIdFiberBase);
begin
  //Kudzu
  // Be VERY careful in this section. This section takes care of Delphi's
  // exception handling mechanism.
  //
  // This section swaps out the exception frames for each fiber so that
  // exceptions are handled properly, preserved between switches, and across
  // threads.
  //
  // Notes:
  // -Only works on Windows, but we dont support fibers on Kylix right now
  //  anyways
  // -Developer MUST use our fibers and not call Fiber API calls directly.
  // -May not work on C++ Builder at this time.
  // -May not work on older Delphi editions at this time.
  // -If the user calls this method and the fiber is not the current fiber, will
  // be problems. Maybe lock against thread ID and check that.
  //
  // This could be extended to make ThreadVars "FiberVars" by swaping out the
  // TLS entry. I may make this an option in the future.
  // This would also take care of the exception stack by itself and may be
  // more portable to Linux, CB and older versions of Delphi. Will check later.
  //
  //
  // Save raise list for current fiber
  FRaiseList := RaiseList;
  AFiber.SwitchToMeFrom(Self);
end;

procedure TIdFiberBase.SwitchToMeFrom(
  AFromFiber: TIdFiberBase
  );
begin
  // See if we can run the fiber. If not it will raise an exception.
  CheckRunnable;
  FPriorFiber := AFromFiber;
  // Restore raise list
  SetRaiseList(FRaiseList);
  // Switch to the actual fiber
  SwitchToFiber(Handle);
end;

{ TIdFiberWithTask }

procedure TIdFiberWithTask.AfterRun;
begin
  FTask.DoAfterRun;
  inherited;
end;

procedure TIdFiberWithTask.BeforeRun;
begin
  inherited;
  FTask.DoBeforeRun;
end;

constructor TIdFiberWithTask.Create(
  AParentFiber: TIdFiberBase = nil;
  ATask: TIdTask = nil;
  AName: string = '';
  AStackSize: Integer = 0
  );
begin
  inherited Create(AParentFiber, True, AStackSize);
  FTask := ATask;
end;

destructor TIdFiberWithTask.Destroy;
begin
  FreeAndNil(FTask);
  inherited;
end;

procedure TIdFiberWithTask.Run;
begin
  if not FTask.DoRun then begin
    Stop;
  end;
end;

end.