service implementation pooling

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@189 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/base_service_intf.pas

@@ -15,7 +15,7 @@ unit base_service_intf;
 interface
 
 uses
-  Classes, SysUtils, TypInfo, Contnrs;
+  Classes, SysUtils, TypInfo, Contnrs, syncobjs, semaphore;
 
 {$INCLUDE wst.inc}
 {$INCLUDE wst_delphi.inc}
@@ -90,6 +90,7 @@ type
 
   IItemFactoryEx = interface(IItemFactory)
     ['{66B77926-7E45-4780-8FFB-FB78625EDC1D}']
+    procedure ReleaseInstance(var AInstance : IInterface);
     function GetPropertyManager(
       const APropertyGroup : string;
       const ACreateIfNotExists : Boolean
@@ -987,26 +988,84 @@ type
   private
     FItemClass : TSimpleFactoryItemClass;
   protected
-    function CreateInstance():IInterface;
+    function CreateInstance():IInterface;virtual;
+    function GetItemClass() : TSimpleFactoryItemClass;
   public
     constructor Create(AItemClass : TSimpleFactoryItemClass);
   End;
 
+  { TIntfPoolItem }
+
+  TIntfPoolItem = class
+  private
+    FIntf: IInterface;
+    FUsed: Boolean;
+  public
+    constructor Create(AIntf : IInterface; const AUsed : Boolean);
+    destructor Destroy();override;
+    property Intf : IInterface read FIntf;
+    property Used : Boolean read FUsed write FUsed;
+  end;
+  
+  TIntfPool = class
+  private
+    FList : TObjectList;
+    FCS : TCriticalSection;
+    FLock : TSemaphoreObject;
+    FFactory : IItemFactory;
+    FMin : PtrInt;
+    FMax : PtrInt;
+  private
+    function CreateNew() : TIntfPoolItem;
+    function TryGet(const AIndex : PtrInt) : Boolean;
+  public
+    constructor Create(
+      const AMin, AMax : PtrInt;
+            AFactory   : IItemFactory
+    );
+    destructor Destroy();override;
+    function Get(const ATimeOut : Cardinal) : IInterface;
+    procedure Release(var AItem : IInterface);
+    property Min : PtrInt read FMin;
+    property Max : PtrInt read FMax;
+  end;
+  
   { TSimpleItemFactoryEx }
 
   TSimpleItemFactoryEx = class(TSimpleItemFactory,IInterface,IItemFactory,IItemFactoryEx)
   private
+    FPooled: Boolean;
+    FPoolMax: PtrInt;
+    FPoolMin: PtrInt;
     FPropertyNames : TStringList;
     FProperties : IInterfaceList;
+    FPool : TIntfPool;
+    FTimeOut: PtrUInt;
+  private
+    procedure PreparePool();
+    procedure SetPooled(const AValue: Boolean);
+    procedure SetPoolMax(const AValue: PtrInt);
+    procedure SetPoolMin(const AValue: PtrInt);
   protected
+    function CreateInstance():IInterface;override;
+    procedure ReleaseInstance(var AInstance : IInterface);virtual;
     function GetPropertyManager(
       const APropertyGroup : string;
       const ACreateIfNotExists : Boolean
     ):IPropertyManager;
   public
-    constructor Create(AItemClass : TSimpleFactoryItemClass);
+    constructor Create(
+      AItemClass         : TSimpleFactoryItemClass;
+      const APropsString : string
+    );overload;
+    constructor Create(AItemClass : TSimpleFactoryItemClass);overload;
     destructor Destroy();override;
-  End;
+  published
+    property PoolMax : PtrInt read FPoolMax write SetPoolMax;
+    property PoolMin : PtrInt read FPoolMin write SetPoolMin;
+    property Pooled : Boolean read FPooled write SetPooled;
+    property TimeOut : PtrUInt read FTimeOut write FTimeOut;
+  end;
 
   TTypeRegistryItemOption = ( trioNonVisibleToMetadataService );
   TTypeRegistryItemOptions = set of TTypeRegistryItemOption;
@@ -1107,6 +1166,7 @@ const
   function IsStoredPropClass(AClass : TClass;PropInfo : PPropInfo) : TPropStoreType;
 
 implementation
+uses imp_utils;
 
 Var
   TypeRegistryInstance : TTypeRegistry = Nil;
@@ -1999,6 +2059,11 @@ begin
   Result := FItemClass.Create() as IInterface;
 end;
 
+function TSimpleItemFactory.GetItemClass(): TSimpleFactoryItemClass;
+begin
+  Result := FItemClass;
+end;
+
 constructor TSimpleItemFactory.Create(AItemClass: TSimpleFactoryItemClass);
 begin
   Assert(Assigned(AItemClass));
@@ -2007,6 +2072,62 @@ end;
 
 { TSimpleItemFactoryEx }
 
+procedure TSimpleItemFactoryEx.PreparePool();
+begin
+  if ( FPool = nil ) then begin
+    FPool := TIntfPool.Create(PoolMin,PoolMax,TSimpleItemFactory.Create(FItemClass));
+  end;
+end;
+
+procedure TSimpleItemFactoryEx.SetPooled(const AValue: Boolean);
+begin
+  if ( FPooled = AValue ) then
+    Exit;
+  FreeAndNil(FPool);
+  if AValue then begin
+    if ( PoolMin < 0 ) or ( PoolMin > PoolMax ) or ( PoolMax < 1 ) then
+      raise EServiceException.Create('Invalid pool parametters.');
+    PreparePool();
+  end;
+  FPooled := AValue;
+end;
+
+procedure TSimpleItemFactoryEx.SetPoolMax(const AValue: PtrInt);
+begin
+  if ( FPoolMax = AValue ) then
+    Exit;
+  if Pooled then
+    raise EServiceException.Create('Operation not allowed on an active pool.');
+  FPoolMax := AValue;
+end;
+
+procedure TSimpleItemFactoryEx.SetPoolMin(const AValue: PtrInt);
+begin
+  if ( FPoolMin = AValue ) then
+    Exit;
+  if Pooled then
+    raise EServiceException.Create('Operation not allowed on an active pool.');
+  FPoolMin := AValue;
+end;
+
+function TSimpleItemFactoryEx.CreateInstance(): IInterface;
+begin
+  if Pooled then begin
+    Result := FPool.Get(TimeOut);
+  end else begin
+    Result := inherited CreateInstance();
+  end;
+end;
+
+procedure TSimpleItemFactoryEx.ReleaseInstance(var AInstance: IInterface);
+begin
+  if Pooled then begin
+    FPool.Release(AInstance);
+  end else begin
+    AInstance := nil;
+  end;
+end;
+
 function TSimpleItemFactoryEx.GetPropertyManager(
   const APropertyGroup : string;
   const ACreateIfNotExists : Boolean
@@ -2022,22 +2143,37 @@ begin
     if not ACreateIfNotExists then
       Exit;
     i := FPropertyNames.Add(s);
+    if ( s = '' ) then
+      FProperties.Add(TPublishedPropertyManager.Create(Self) as IInterface)
+    else
       FProperties.Add(TStoredPropertyManager.Create() as IInterface);
   end;
   Result := FProperties.Get(i) as IPropertyManager;
 end;
 
-constructor TSimpleItemFactoryEx.Create(AItemClass: TSimpleFactoryItemClass);
+constructor TSimpleItemFactoryEx.Create(
+  AItemClass         : TSimpleFactoryItemClass;
+  const APropsString : string
+);
 begin
   inherited Create(AItemClass);
   FPropertyNames := TStringList.Create();
   FProperties := TInterfaceList.Create();
+  if ( Length(APropsString) > 0 ) then begin
+    GetPropertyManager('',True).SetProperties(APropsString);
+  end;
+end;
+
+constructor TSimpleItemFactoryEx.Create(AItemClass: TSimpleFactoryItemClass);
+begin
+  Create(AItemClass,'');
 end;
 
 destructor TSimpleItemFactoryEx.Destroy();
 begin
   FreeAndNil(FPropertyNames);
   FProperties := nil;
+  FreeAndNil(FPool);
   inherited Destroy();
 end;
 
@@ -4138,6 +4274,110 @@ begin
   (AObject as TComplexBooleanContentRemotable).Value := i;
 end;
 
+{ TIntfPoolItem }
+
+constructor TIntfPoolItem.Create(AIntf: IInterface; const AUsed: Boolean);
+begin
+  FIntf := AIntf;
+  FUsed := AUsed;
+end;
+
+destructor TIntfPoolItem.Destroy();
+begin
+  FIntf := nil;
+  inherited Destroy();
+end;
+
+{ TIntfPool }
+
+function TIntfPool.CreateNew(): TIntfPoolItem;
+begin
+  FCS.Acquire();
+  try
+    Result := TIntfPoolItem.Create(FFactory.CreateInstance(),True);
+    FList.Add(Result);
+  finally
+    FCS.Release();
+  end;
+end;
+
+function TIntfPool.TryGet(const AIndex: PtrInt): Boolean;
+var
+  itm : TIntfPoolItem;
+begin
+  FCS.Acquire();
+  try
+    itm := TIntfPoolItem(FList[AIndex]);
+    Result := not itm.Used;
+    if Result then begin
+      itm.Used := True;
+    end;
+  finally
+    FCS.Release();
+  end;
+end;
+
+constructor TIntfPool.Create(
+  const AMin, AMax : PtrInt;
+        AFactory   : IItemFactory
+);
+var
+  i : PtrInt;
+begin
+  Assert( ( AMin >= 0 ) and ( AMax >= AMin ) and ( AFactory <> nil ) );
+  FMax := AMax;
+  FMin := AMin;
+  FFactory := AFactory;
+  FLock := TSemaphoreObject.Create(FMax);
+  FList := TObjectList.Create(True);
+  FCS := TCriticalSection.Create();
+  for i := 0 to Pred(AMin) do begin
+    CreateNew();
+  end;
+end;
+
+destructor TIntfPool.Destroy();
+begin
+  FFactory := nil;
+  FreeAndNil(FCS);
+  FreeAndNil(FLock);
+  FreeAndNil(FList);
+  inherited Destroy();
+end;
+
+function TIntfPool.Get(const ATimeOut : Cardinal): IInterface;
+var
+  i : PtrInt;
+begin
+  Result := nil;
+  if ( FLock.WaitFor(ATimeOut) = wrSignaled ) then begin
+    for i := 0 to Pred(FList.Count) do begin
+      if TryGet(i) then begin
+        Result := TIntfPoolItem(FList[i]).Intf;
+        Break;
+      end;
+    end;
+    if ( Result = nil ) then begin
+      Result := CreateNew().Intf;
+    end;
+  end else begin
+    raise EServiceException.Create('Unable to create the object : Timeout expired.');
+  end;
+end;
+
+procedure TIntfPool.Release(var AItem: IInterface);
+var
+  i : PtrInt;
+begin
+  for i := 0 to Pred(FList.Count) do begin
+    if ( TIntfPoolItem(FList[i]).Intf = AItem ) then begin
+      TIntfPoolItem(FList[i]).Used := False;
+      AItem := nil;
+      Break;
+    end;
+  end;
+end;
+
 initialization
   TypeRegistryInstance := TTypeRegistry.Create();
   SerializeOptionsRegistryInstance := TSerializeOptionsRegistry.Create();

wst/trunk/imp_utils.pas

@@ -96,6 +96,10 @@ begin
           If TryStrToInt64(AValue,int64Val) Then
             SetOrdProp(FParent,AName,int64Val);
         End;
+      {$IFDEF FPC}
+      tkBool :
+        SetOrdProp(FParent,AName,Ord(StrToBool(AValue)));
+      {$ENDIF}
     End;
   End;
 end;

wst/trunk/metadata_service_binder.pas

@@ -15,16 +15,23 @@ type
 
   TWSTMetadataService_ServiceBinder=class(TBaseServiceBinder)
   Protected
-    procedure GetRepositoryListHandler(AFormatter:IFormatterResponse);
+    procedure GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
-    procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse);
+    procedure GetRepositoryInfoHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
   Public
     constructor Create();
   End;
 
+  { TWSTMetadataService_ServiceBinderFactory }
+
   TWSTMetadataService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
+  private
+    FInstance : IInterface;
   protected
     function CreateInstance():IInterface;
-  End;
+  public
+    constructor Create();
+    destructor Destroy();override;
+  end;
 
   procedure Server_service_RegisterWSTMetadataServiceService();
 
@@ -32,7 +39,7 @@ Implementation
 uses TypInfo, wst_resources_imp,metadata_repository;
 
 { TWSTMetadataService_ServiceBinder implementation }
-procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse);
+procedure TWSTMetadataService_ServiceBinder.GetRepositoryListHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
 Var
   cllCntrl : ICallControl;
   tmpObj : IWSTMetadataService;
@@ -41,14 +48,14 @@ Var
   procName,trgName : string;
   returnVal : TArrayOfStringRemotable;
 Begin
-  callCtx := GetCallContext();
+  callCtx := AContext;
   If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind in [tkClass,tkInterface] ) Then
     Pointer(returnVal) := Nil;
   
   
   tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService;
   if Supports(tmpObj,ICallControl,cllCntrl) then
-    cllCntrl.SetCallContext(GetCallContext());
+    cllCntrl.SetCallContext(callCtx);
   
   returnVal := tmpObj.GetRepositoryList();
   If ( PTypeInfo(TypeInfo(TArrayOfStringRemotable))^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then
@@ -64,7 +71,7 @@ Begin
   callCtx := Nil;
 End;
 
-procedure TWSTMetadataService_ServiceBinder.GetRepositoryInfoHandler(AFormatter:IFormatterResponse);
+procedure TWSTMetadataService_ServiceBinder.GetRepositoryInfoHandler(AFormatter:IFormatterResponse; AContext : ICallContext);
 Var
   cllCntrl : ICallControl;
   tmpObj : IWSTMetadataService;
@@ -74,14 +81,14 @@ Var
   AName : string;
   returnVal : TWSTMtdRepository;
 Begin
-  callCtx := GetCallContext();
+  callCtx := AContext;
   Pointer(returnVal) := Nil;
   
   strPrmName := 'AName';  AFormatter.Get(TypeInfo(string),strPrmName,AName);
   
   tmpObj := Self.GetFactory().CreateInstance() as IWSTMetadataService;
   if Supports(tmpObj,ICallControl,cllCntrl) then
-    cllCntrl.SetCallContext(GetCallContext());
+    cllCntrl.SetCallContext(callCtx);
   
   returnVal := tmpObj.GetRepositoryInfo(AName);
   If Assigned(Pointer(returnVal)) Then
@@ -109,9 +116,20 @@ End;
 { TWSTMetadataService_ServiceBinderFactory }
 function TWSTMetadataService_ServiceBinderFactory.CreateInstance():IInterface;
 Begin
-  Result := TWSTMetadataService_ServiceBinder.Create() as IInterface;
+  Result := FInstance;
 End;
 
+constructor TWSTMetadataService_ServiceBinderFactory.Create();
+begin
+  FInstance := TWSTMetadataService_ServiceBinder.Create();
+end;
+
+destructor TWSTMetadataService_ServiceBinderFactory.Destroy();
+begin
+  FInstance := nil;
+  inherited Destroy();
+end;
+
 
 procedure Server_service_RegisterWSTMetadataServiceService();
 Begin

wst/trunk/metadata_wsdl.pas

@@ -577,7 +577,7 @@ procedure TBaseComplexRemotable_TypeHandler.Generate(
 var
   typItm, propTypItm : TTypeRegistryItem;
   s, prop_ns_shortName : string;
-  defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement;
+  defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement;
   i : Integer;
   propList : PPropList;
   propCount, propListLen : Integer;
@@ -596,13 +596,10 @@ begin
     Assert(Assigned(defTypesNode));
     defSchemaNode := defTypesNode.FirstChild as TDOMElement;
     
-    s := Format('%s:%s',[sXSD,sELEMENT]);
-    eltNode := CreateElement(s,defSchemaNode,AWsdlDocument);
-    eltNode.SetAttribute(sNAME, typItm.DeclaredName) ;
-
     s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
-    cplxNode := CreateElement(s,eltNode,AWsdlDocument);
+    cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument);
-    //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ;
+    cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ;
+
       s := Format('%s:%s',[sXSD,sSEQUENCE]);
       sqcNode := CreateElement(s,cplxNode,AWsdlDocument);
       objTypeData := GetTypeData(typItm.DataType);
@@ -623,7 +620,7 @@ begin
                 s := Format('%s:%s',[sXSD,sELEMENT]);
                 propNode := CreateElement(s,sqcNode,AWsdlDocument);
               end;
-              propNode.SetAttribute(sNAME,p^.Name);
+              propNode.SetAttribute(sNAME,typItm.GetExternalPropertyName(p^.Name));
               propTypItm := GetTypeRegistry().Find(p^.PropType^.Name);
               if Assigned(propTypItm) then begin
                 prop_ns_shortName := GetNameSpaceShortName(propTypItm.NameSpace,AWsdlDocument);
@@ -775,7 +772,7 @@ procedure TBaseArrayRemotable_TypeHandler.Generate(
 var
   typItm, propTypItm : TTypeRegistryItem;
   s, prop_ns_shortName : string;
-  defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode, eltNode : TDOMElement;
+  defTypesNode, defSchemaNode, cplxNode, sqcNode, propNode : TDOMElement;
   arrayTypeData : PTypeData;
   arrayTypeClass : TBaseArrayRemotableClass;
 begin
@@ -792,13 +789,10 @@ begin
     Assert(Assigned(defTypesNode));
     defSchemaNode := defTypesNode.FirstChild as TDOMElement;
 
-    s := Format('%s:%s',[sXSD,sELEMENT]);
-    eltNode := CreateElement(s,defSchemaNode,AWsdlDocument);
-    eltNode.SetAttribute(sNAME, typItm.DeclaredName) ;
-
     s := Format('%s:%s',[sXSD,sCOMPLEX_TYPE]);
-    cplxNode := CreateElement(s,eltNode,AWsdlDocument);
+    cplxNode := CreateElement(s,defSchemaNode,AWsdlDocument);
-    //cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ;
+    cplxNode.SetAttribute(sNAME, typItm.DeclaredName) ;
+
       s := Format('%s:%s',[sXSD,sSEQUENCE]);
       sqcNode := CreateElement(s,cplxNode,AWsdlDocument);
       arrayTypeClass := TBaseArrayRemotableClass(arrayTypeData^.ClassType);

wst/trunk/semaphore.pas

@@ -0,0 +1,99 @@
+unit semaphore;
+
+{$mode objfpc}{$H+}
+interface
+
+uses
+  Classes, SysUtils, syncobjs;
+  
+type
+
+  ESemaphoreException = class(Exception);
+  
+  { TSemaphoreObject }
+
+  TSemaphoreObject = class
+  private
+    FHandle : PRTLEvent;
+    FLimit: Integer;
+    FCurrentState : Integer;
+    FCriticalSection : TCriticalSection;
+  public
+    constructor Create(const ALimit : Integer);
+    destructor Destroy(); override;
+    function WaitFor(ATimeout : Cardinal) : TWaitResult;
+    procedure Release();
+    property Limit : Integer read FLimit;
+  end;
+
+implementation
+
+{ TSemaphoreObject }
+
+constructor TSemaphoreObject.Create(const ALimit: Integer);
+begin
+  Assert(ALimit>0);
+  FLimit := ALimit;
+  FHandle := RTLEventCreate();
+  FCriticalSection := TCriticalSection.Create();
+  FCurrentState := FLimit;
+  RTLeventSetEvent(FHandle);
+end;
+
+destructor TSemaphoreObject.Destroy();
+begin
+  RTLeventdestroy(FHandle);
+  FreeAndNil(FCriticalSection);
+  inherited Destroy();
+end;
+
+function TSemaphoreObject.WaitFor(ATimeout: Cardinal): TWaitResult;
+var
+  ok : Boolean;
+begin
+  Result := wrTimeout;
+  ok := False;
+  FCriticalSection.Acquire();
+  try
+    if ( FCurrentState > 0 ) then begin
+      Dec(FCurrentState);
+      ok := True;
+      if ( FCurrentState = 0 ) then
+        RTLeventResetEvent(FHandle);
+    end;
+  finally
+    FCriticalSection.Release();
+  end;
+  if not ok then begin
+    RTLeventWaitFor(FHandle,ATimeout);
+    FCriticalSection.Acquire();
+    try
+      if ( FCurrentState > 0 ) then begin
+        Dec(FCurrentState);
+        ok := True;
+      end;
+    finally
+      FCriticalSection.Release();
+    end;
+  end;
+  if ok then
+    Result := wrSignaled;
+end;
+
+procedure TSemaphoreObject.Release();
+begin
+  FCriticalSection.Acquire();
+  try
+    if ( FCurrentState < Limit ) then begin
+      Inc(FCurrentState);
+    end else begin
+      raise ESemaphoreException.Create('Invalid semaphore operation.');
+    end;
+  finally
+    FCriticalSection.Release();
+  end;
+  RTLeventSetEvent(FHandle);
+end;
+
+end.
+

wst/trunk/server_service_intf.pas

@@ -33,6 +33,7 @@ Type
 
   IServiceExtension = interface;
   IServiceExtensionRegistry = interface;
+  IObjectControl = interface;
 
   ICallControl = interface
     ['{7B4B7192-EE96-4B52-92C7-AE855FBC31E7}']
@@ -122,15 +123,21 @@ Type
     procedure EndExceptionList();
   End;
 
-  TServiceVerbMethod = procedure(AFormatter:IFormatterResponse) of object;
+  IObjectControl = interface
+    ['{C422C7CA-4C95-48A4-9A82-2616E619F851}']
+    procedure Activate();
+    procedure Deactivate();
+    function CanBePooled() : Boolean;
+  end;
+    
+  TServiceVerbMethod = procedure(AFormatter:IFormatterResponse; AContext : ICallContext) of object;
   
   { TBaseServiceBinder }
 
-  TBaseServiceBinder = Class(TInterfacedObject,IServerService)
+  TBaseServiceBinder = Class(TInterfacedPersistent,IServerService)
   Private
     FVerbList : TObjectList;
     FImplementationFactory : IServiceImplementationFactory;
-    FCallContext : ICallContext;
   Protected
     procedure RegisterVerbHandler(
       const AVerb        : string;
@@ -138,9 +145,8 @@ Type
     );
     function FindVerbHandler(const AVerb : string):TServiceVerbMethod;
     procedure HandleRequest(ARequestBuffer : IRequestBuffer);
-    function GetFactory():IItemFactory;
+    function GetFactory():IServiceImplementationFactory;
     function CreateCallContext():ICallContext;virtual;
-    function GetCallContext():ICallContext;
     procedure DoProcessMessage(
       const AMessageStage  : TMessageStage;
             ACallContext   : ICallContext;
@@ -163,6 +169,14 @@ Type
     function GetCallContext():ICallContext;
   End;
 
+  { TActivableServiceImplementation }
+
+  TActivableServiceImplementation = class(TBaseServiceImplementation,IObjectControl)
+  protected
+    procedure Activate();virtual;
+    procedure Deactivate();virtual;
+    function CanBePooled() : Boolean;virtual;
+  end;
 
   { TImplementationFactory }
 
@@ -332,17 +346,17 @@ begin
   if not Assigned(f) then
     Error('No formatter for that content type : "%s"',[s]);
   try
-    cllCtx := GetCallContext();
+    cllCtx := CreateCallContext();
     DoProcessMessage(msBeforeDeserialize,cllCtx,ARequestBuffer);
     strm := ARequestBuffer.GetContent();
     f.LoadFromStream(strm);
-    f.BeginCallRead(GetCallContext());
+    f.BeginCallRead(cllCtx);
     DoProcessMessage(msAfterDeserialize,cllCtx,f);
     s := f.GetCallProcedureName();
     m := FindVerbHandler(s);
     if not Assigned(m) then
       Error('No handler for that verb : "%s"',[s]);
-    m(f);
+    m(f,cllCtx);
     for i := 0 to Pred(cllCtx.GetHeaderCount(AllHeaderDirection)) do begin
       hdr := cllCtx.GetHeader(i);
       if ( hdr.Direction = hdIn ) and ( hdr.mustUnderstand <> 0 ) and ( not hdr.Understood ) then begin
@@ -368,23 +382,14 @@ begin
   DoProcessMessage(msAfterSerialize,cllCtx,ARequestBuffer);
 end;
 
-function TBaseServiceBinder.GetFactory(): IItemFactory;
+function TBaseServiceBinder.GetFactory(): IServiceImplementationFactory;
 begin
   Result := FImplementationFactory;
 end;
 
 function TBaseServiceBinder.CreateCallContext(): ICallContext;
 begin
-  if not Assigned(FCallContext) then
+  Result := TSimpleCallContext.Create() as ICallContext;
-    FCallContext := TSimpleCallContext.Create() as ICallContext;
-  Result := FCallContext;
-end;
-
-function TBaseServiceBinder.GetCallContext(): ICallContext;
-begin
-  if not Assigned(FCallContext) then
-    CreateCallContext();
-  Result := FCallContext;
 end;
 
 procedure TBaseServiceBinder.DoProcessMessage(
@@ -421,6 +426,7 @@ end;
 constructor TBaseServiceBinder.Create(AImplementationFactory : IServiceImplementationFactory);
 begin
   Assert(Assigned(AImplementationFactory));
+  inherited Create();
   FImplementationFactory := AImplementationFactory;
   FVerbList := TObjectList.Create(True);
 end;
@@ -554,6 +560,7 @@ end;
 
 { TImplementationFactory }
 const sSERVICES_EXTENSIONS = 'extensions';sLIST = 'list';
+
 procedure TImplementationFactory.RegisterExtension(
   const AExtensionList : array of string
 );
@@ -621,6 +628,23 @@ begin
   Result := ServiceExtensionRegistryInst;
 end;
 
+{ TActivableServiceImplementation }
+
+procedure TActivableServiceImplementation.Activate();
+begin
+
+end;
+
+procedure TActivableServiceImplementation.Deactivate();
+begin
+
+end;
+
+function TActivableServiceImplementation.CanBePooled(): Boolean;
+begin
+  Result := False;
+end;
+
 Initialization
   FormatterRegistryInst := TFormatterRegistry.Create() as IFormatterRegistry;
   ServerServiceRegistryInst := TServerServiceRegistry.Create() as IServerServiceRegistry;