restemplate/indy/SuperCore/IdSchedulerOfFiber.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.2    6/11/2004 8:40:06 AM  DSiders
  Added "Do not Localize" comments.

  Rev 1.1    2004.02.09 9:16:48 PM  czhower
  Updated to compile and match lib changes.

  Rev 1.0    2004.02.03 12:38:58 AM  czhower
  Move

  Rev 1.9    2003.10.24 1:00:06 PM  czhower
  Name change

  Rev 1.8    2003.10.21 12:19:20 AM  czhower
  TIdTask support and fiber bug fixes.

  Rev 1.7    2003.10.19 4:38:34 PM  czhower
  Updates

  Rev 1.6    2003.10.19 2:50:40 PM  czhower
  Fiber cleanup

  Rev 1.5    2003.10.19 1:04:28 PM  czhower
  Updates

  Rev 1.4    2003.10.14 11:17:06 PM  czhower
  Updates to match core changes.

  Rev 1.3    2003.10.11 5:43:48 PM  czhower
  Chained servers now functional.

  Rev 1.2    2003.09.19 10:09:42 PM  czhower
  Next stage of fiber support in servers.
}

unit IdSchedulerOfFiber;

interface

uses
  Classes,
  IdFiberWeaver, IdTask, IdFiber, IdScheduler, IdYarn;

type
  TIdSchedulerOfFiber = class;

  TIdYarnOfFiber = class(TIdYarn)
  protected
    FFiber: TIdFiberWithTask;
    FScheduler: TIdScheduler;
  public
    constructor Create(
      AScheduler: TIdScheduler;
      AFiber: TIdFiberWithTask
      ); reintroduce; virtual;
    destructor Destroy;
      override;
    //
    property Fiber: TIdFiberWithTask read FFiber;
  end;

  TIdSchedulerOfFiber = class(TIdScheduler)
  protected
    FFiberWeaver: TIdFiberWeaver;
  public
    function AcquireYarn
      : TIdYarn;
      override;
    procedure StartYarn(
      AYarn: TIdYarn;
      ATask: TIdTask
      ); override;
    procedure TerminateYarn(
      AYarn: TIdYarn
      ); override;
  published
    //TODO: Need to add notification for this prop
    //TODO: Dont allow setting while active
    property FiberWeaver: TIdFiberWeaver read FFiberWeaver write FFiberWeaver;
  end;

implementation

uses
  IdGlobal,
  SysUtils;

{ TIdSchedulerOfFiber }

function TIdSchedulerOfFiber.AcquireYarn: TIdYarn;
var
  LFiber: TIdFiberWithTask;
begin
  LFiber := TIdFiberWithTask.Create(nil, nil, Format('%s User', [Name])); {do not localize}
  Result := TIdYarnOfFiber.Create(Self, LFiber);
  ActiveYarns.Add(Result);
end;

procedure TIdSchedulerOfFiber.StartYarn(
  AYarn: TIdYarn;
  ATask: TIdTask
  );
begin
  inherited;
  TIdYarnOfFiber(AYarn).Fiber.Task := ATask;
  // Last - Put it in the queue to be scheduled
  Assert(FiberWeaver<>nil);
  FiberWeaver.Add(TIdYarnOfFiber(AYarn).Fiber);
end;

procedure TIdSchedulerOfFiber.TerminateYarn(AYarn: TIdYarn);
begin
  // Fibers dont "run", so we dont terminate them
  FreeAndNil(AYarn);
end;

{ TIdYarnOfFiber }

constructor TIdYarnOfFiber.Create(
  AScheduler: TIdScheduler;
  AFiber: TIdFiberWithTask
  );
begin
  inherited Create;
  FScheduler := AScheduler;
  FFiber := AFiber;
  AFiber.Yarn := Self;
end;

destructor TIdYarnOfFiber.Destroy;
begin
  FScheduler.ReleaseYarn(Self);
  inherited;
end;

end.