OS X compatibility patch, Thanks to Phil for testing.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@537 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2008-08-29 12:57:35 +00:00
parent bfbb77cd0b
commit 6b911011c0
2 changed files with 53 additions and 26 deletions

View File

@ -16,7 +16,7 @@ unit object_serializer;
interface
uses
Classes, SysUtils, TypInfo, Contnrs,
Classes, SysUtils, TypInfo, Contnrs, SyncObjs,
base_service_intf, wst_types;
type
@ -95,9 +95,10 @@ type
TBaseComplexTypeRegistryItem = class(TTypeRegistryItem)
private
FGetterLock : PtrInt;
FGetterLock : TCriticalSection;
FSerializer : TObjectSerializer;
FGetFunction : TGetSerializerFunction;
FFuncIsNotReady : Boolean;
private
function FirstGetter() : TObjectSerializer;
function StaticGetter() : TObjectSerializer;
@ -132,13 +133,6 @@ resourcestring
SERR_SerializerInitializationException = 'Unable to initialize the serializer of that type : "%s".';
implementation
{$IFDEF WST_DELPHI}
{$IFDEF MSWINDOWS}
uses
Windows;
{$ENDIF MSWINDOWS}
{$ENDIF WST_DELPHI}
procedure ErrorProc(
AObject : TObject;
@ -1175,26 +1169,17 @@ end;
{ TBaseComplexTypeRegistryItem }
function TBaseComplexTypeRegistryItem.FirstGetter() : TObjectSerializer;
var
oldValue : PtrInt;
begin
if ( InterlockedCompareExchange(Pointer(FGetterLock),Pointer(1),Pointer(0)) = Pointer(0) ) then begin
FGetterLock.Acquire();
try
if ( FSerializer = nil ) then begin
FSerializer := TObjectSerializer.Create(TBaseComplexRemotableClass(GetTypeData(DataType)^.ClassType),Owner);
except
InterLockedDecrement(FGetterLock);
raise;
end;
FFuncIsNotReady := True;
FGetFunction := {$IFDEF FPC}@{$ENDIF}StaticGetter;
InterLockedIncrement(FGetterLock);
end else begin
repeat
//this is a way t get the value of "FGetterLock" without altering it.
oldValue := PtrInt(InterlockedCompareExchange(Pointer(FGetterLock),Pointer(1),Pointer(12)));
//this is a busy wait!
until ( oldValue <> 1 );
if ( oldValue <> 2 ) then
raise ESerializerException.CreateFmt(SERR_SerializerInitializationException,[DataType^.Name]);
FFuncIsNotReady := False;
end;
finally
FGetterLock.Release();
end;
Result := FSerializer;
end;
@ -1213,16 +1198,21 @@ constructor TBaseComplexTypeRegistryItem.Create(
begin
inherited Create(AOwner, ANameSpace, ADataType, ADeclaredName);
FGetFunction := {$IFDEF FPC}@{$ENDIF}FirstGetter;
FGetterLock := TCriticalSection.Create();
end;
destructor TBaseComplexTypeRegistryItem.Destroy();
begin
FGetterLock.Free();
FSerializer.Free();
inherited Destroy();
end;
function TBaseComplexTypeRegistryItem.GetSerializer() : TObjectSerializer;
begin
while FFuncIsNotReady do begin
//busy wait
end;
Result := FGetFunction();
end;

View File

@ -0,0 +1,37 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2008 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{$INCLUDE wst_global.inc}
unit wst_delphi_rtl;
interface
uses
wst_types;
{$IFDEF WST_DELPHI}
function InterlockedExchange(var Target: Pointer; Value: Pointer): Integer; stdcall;
{$ENDIF WST_DELPHI}
implementation
{$IFDEF WST_DELPHI}
uses
Windows;
{$ENDIF WST_DELPHI}
{$IFDEF WST_DELPHI}
function InterlockedExchange(var Target: Pointer; Value: Pointer): Integer;
begin
Windows.InterlockedExchange(PtrInt(Target),PtrInt(Value));
end;
{$ENDIF WST_DELPHI}
end.