diff --git a/Source/SourceUtils/dwsCaseNormalizer.pas b/Source/SourceUtils/dwsCaseNormalizer.pas index 1b142fe6..46a9bfd3 100644 --- a/Source/SourceUtils/dwsCaseNormalizer.pas +++ b/Source/SourceUtils/dwsCaseNormalizer.pas @@ -52,13 +52,13 @@ TSymbolLocation = class (TRefCountedObject) end; TSymbolLocations = class(TObjectList) - function CompareLocations(a, b : Integer) : Integer; - procedure Swap(a, b : Integer); + function CompareLocations(a, b : NativeInt) : Integer; + procedure Swap(a, b : NativeInt); end; // CompareLocations // -function TSymbolLocations.CompareLocations(a, b : Integer) : Integer; +function TSymbolLocations.CompareLocations(a, b : NativeInt) : Integer; var locA, locB : TSymbolLocation; begin @@ -71,7 +71,7 @@ function TSymbolLocations.CompareLocations(a, b : Integer) : Integer; // Swap // -procedure TSymbolLocations.Swap(a, b : Integer); +procedure TSymbolLocations.Swap(a, b : NativeInt); var tmp : TSymbolLocation; begin diff --git a/Source/dwsArrayElementContext.pas b/Source/dwsArrayElementContext.pas index 03557667..cf61bab4 100644 --- a/Source/dwsArrayElementContext.pas +++ b/Source/dwsArrayElementContext.pas @@ -28,54 +28,54 @@ interface TArrayElementDataContext = class (TInterfacedObject, IDataContext) private FArray : IScriptDynArray; - FIndex : Integer; + FIndex : NativeInt; FElementSize : Integer; - FBase : Integer; + FBase : NativeInt; protected function GetSelf : TObject; - function ComputeAddr(addr : Integer) : Integer; inline; + function ComputeAddr(addr : NativeInt) : NativeInt; inline; - function GetAsVariant(addr : Integer) : Variant; - procedure SetAsVariant(addr : Integer; const value : Variant); - function GetAsInteger(addr : Integer) : Int64; - procedure SetAsInteger(addr : Integer; const value : Int64); - function GetAsFloat(addr : Integer) : Double; - procedure SetAsFloat(addr : Integer; const value : Double); - function GetAsBoolean(addr : Integer) : Boolean; - procedure SetAsBoolean(addr : Integer; const value : Boolean); - function GetAsString(addr : Integer) : String; - procedure SetAsString(addr : Integer; const value : String); - function GetAsInterface(addr : Integer) : IUnknown; - procedure SetAsInterface(addr : Integer; const value : IUnknown); + function GetAsVariant(addr : NativeInt) : Variant; + procedure SetAsVariant(addr : NativeInt; const value : Variant); + function GetAsInteger(addr : NativeInt) : Int64; + procedure SetAsInteger(addr : NativeInt; const value : Int64); + function GetAsFloat(addr : NativeInt) : Double; + procedure SetAsFloat(addr : NativeInt; const value : Double); + function GetAsBoolean(addr : NativeInt) : Boolean; + procedure SetAsBoolean(addr : NativeInt; const value : Boolean); + function GetAsString(addr : NativeInt) : String; + procedure SetAsString(addr : NativeInt; const value : String); + function GetAsInterface(addr : NativeInt) : IUnknown; + procedure SetAsInterface(addr : NativeInt; const value : IUnknown); - function Addr : Integer; - function DataLength : Integer; + function Addr : NativeInt; + function DataLength : NativeInt; function AsPData : PData; - procedure CreateOffset(offset : Integer; var result : IDataContext); + procedure CreateOffset(offset : NativeInt; var result : IDataContext); - procedure EvalAsVariant(addr : Integer; var result : Variant); - procedure EvalAsString(addr : Integer; var result : String); - procedure EvalAsInterface(addr : Integer; var result : IUnknown); + procedure EvalAsVariant(addr : NativeInt; var result : Variant); + procedure EvalAsString(addr : NativeInt; var result : String); + procedure EvalAsInterface(addr : NativeInt; var result : IUnknown); - function IsEmpty(addr : Integer) : Boolean; - function VarType(addr : Integer) : TVarType; + function IsEmpty(addr : NativeInt) : Boolean; + function VarType(addr : NativeInt) : TVarType; - procedure CopyData(const destData : TData; destAddr, size : Integer); - procedure WriteData(const src : IDataContext; size : Integer); overload; - procedure WriteData(destAddr : Integer; const src : IDataContext; size : Integer); overload; - procedure WriteData(const srcData : TData; srcAddr, size : Integer); overload; - function SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; + procedure CopyData(const destData : TData; destAddr, size : NativeInt); + procedure WriteData(const src : IDataContext; size : NativeInt); overload; + procedure WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); overload; + procedure WriteData(const srcData : TData; srcAddr, size : NativeInt); overload; + function SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; - function IncInteger(addr : Integer; delta : Int64) : Int64; + function IncInteger(addr : NativeInt; delta : Int64) : Int64; - function HashCode(size : Integer) : Cardinal; + function HashCode(size : NativeInt) : Cardinal; public - constructor Create(const anArray : IScriptDynArray; anIndex : Integer); + constructor Create(const anArray : IScriptDynArray; anIndex : NativeInt); end; @@ -88,7 +88,7 @@ implementation // Create // -constructor TArrayElementDataContext.Create(const anArray : IScriptDynArray; anIndex : Integer); +constructor TArrayElementDataContext.Create(const anArray : IScriptDynArray; anIndex : NativeInt); begin inherited Create; if FIndex < 0 then @@ -108,7 +108,7 @@ function TArrayElementDataContext.GetSelf : TObject; // ComputeAddr // -function TArrayElementDataContext.ComputeAddr(addr : Integer) : Integer; +function TArrayElementDataContext.ComputeAddr(addr : NativeInt) : NativeInt; begin Assert(Cardinal(addr) < Cardinal(FElementSize)); if FIndex >= FArray.ArrayLength then @@ -118,98 +118,98 @@ function TArrayElementDataContext.ComputeAddr(addr : Integer) : Integer; // GetAsVariant // -function TArrayElementDataContext.GetAsVariant(addr : Integer) : Variant; +function TArrayElementDataContext.GetAsVariant(addr : NativeInt) : Variant; begin FArray.EvalAsVariant(ComputeAddr(addr), Result); end; // SetAsVariant // -procedure TArrayElementDataContext.SetAsVariant(addr : Integer; const value : Variant); +procedure TArrayElementDataContext.SetAsVariant(addr : NativeInt; const value : Variant); begin FArray.SetAsVariant(ComputeAddr(addr), value); end; // GetAsInteger // -function TArrayElementDataContext.GetAsInteger(addr : Integer) : Int64; +function TArrayElementDataContext.GetAsInteger(addr : NativeInt) : Int64; begin Result := FArray.AsInteger[ComputeAddr(addr)]; end; // SetAsInteger // -procedure TArrayElementDataContext.SetAsInteger(addr : Integer; const value : Int64); +procedure TArrayElementDataContext.SetAsInteger(addr : NativeInt; const value : Int64); begin FArray.AsInteger[ComputeAddr(addr)] := value; end; // GetAsFloat // -function TArrayElementDataContext.GetAsFloat(addr : Integer) : Double; +function TArrayElementDataContext.GetAsFloat(addr : NativeInt) : Double; begin Result := FArray.AsFloat[ComputeAddr(addr)]; end; // SetAsFloat // -procedure TArrayElementDataContext.SetAsFloat(addr : Integer; const value : Double); +procedure TArrayElementDataContext.SetAsFloat(addr : NativeInt; const value : Double); begin FArray.AsFloat[ComputeAddr(addr)] := value; end; // GetAsBoolean // -function TArrayElementDataContext.GetAsBoolean(addr : Integer) : Boolean; +function TArrayElementDataContext.GetAsBoolean(addr : NativeInt) : Boolean; begin Result := FArray.AsBoolean[FIndex]; end; // SetAsBoolean // -procedure TArrayElementDataContext.SetAsBoolean(addr : Integer; const value : Boolean); +procedure TArrayElementDataContext.SetAsBoolean(addr : NativeInt; const value : Boolean); begin FArray.AsBoolean[ComputeAddr(addr)] := value; end; // GetAsString // -function TArrayElementDataContext.GetAsString(addr : Integer) : String; +function TArrayElementDataContext.GetAsString(addr : NativeInt) : String; begin FArray.EvalAsString(ComputeAddr(addr), Result); end; // SetAsString // -procedure TArrayElementDataContext.SetAsString(addr : Integer; const value : String); +procedure TArrayElementDataContext.SetAsString(addr : NativeInt; const value : String); begin FArray.SetAsString(ComputeAddr(addr), value); end; // GetAsInterface // -function TArrayElementDataContext.GetAsInterface(addr : Integer) : IUnknown; +function TArrayElementDataContext.GetAsInterface(addr : NativeInt) : IUnknown; begin FArray.EvalAsInterface(ComputeAddr(addr), Result); end; // SetAsInterface // -procedure TArrayElementDataContext.SetAsInterface(addr : Integer; const value : IUnknown); +procedure TArrayElementDataContext.SetAsInterface(addr : NativeInt; const value : IUnknown); begin FArray.SetAsInterface(ComputeAddr(addr), value); end; // Addr // -function TArrayElementDataContext.Addr : Integer; +function TArrayElementDataContext.Addr : NativeInt; begin Result := 0; end; // DataLength // -function TArrayElementDataContext.DataLength : Integer; +function TArrayElementDataContext.DataLength : NativeInt; begin Result := FElementSize; end; @@ -223,7 +223,7 @@ function TArrayElementDataContext.AsPData : PData; // CreateOffset // -procedure TArrayElementDataContext.CreateOffset(offset : Integer; var result : IDataContext); +procedure TArrayElementDataContext.CreateOffset(offset : NativeInt; var result : IDataContext); var dc : TArrayElementDataContext; begin @@ -237,44 +237,44 @@ procedure TArrayElementDataContext.CreateOffset(offset : Integer; var result : I // EvalAsVariant // -procedure TArrayElementDataContext.EvalAsVariant(addr : Integer; var result : Variant); +procedure TArrayElementDataContext.EvalAsVariant(addr : NativeInt; var result : Variant); begin FArray.EvalAsVariant(ComputeAddr(addr), result); end; // EvalAsString // -procedure TArrayElementDataContext.EvalAsString(addr : Integer; var result : String); +procedure TArrayElementDataContext.EvalAsString(addr : NativeInt; var result : String); begin FArray.EvalAsString(ComputeAddr(addr), result); end; // EvalAsInterface // -procedure TArrayElementDataContext.EvalAsInterface(addr : Integer; var result : IUnknown); +procedure TArrayElementDataContext.EvalAsInterface(addr : NativeInt; var result : IUnknown); begin FArray.EvalAsInterface(ComputeAddr(addr), result); end; // IsEmpty // -function TArrayElementDataContext.IsEmpty(addr : Integer) : Boolean; +function TArrayElementDataContext.IsEmpty(addr : NativeInt) : Boolean; begin Result := FArray.IsEmpty(ComputeAddr(addr)); end; // VarType // -function TArrayElementDataContext.VarType(addr : Integer) : TVarType; +function TArrayElementDataContext.VarType(addr : NativeInt) : TVarType; begin Result := FArray.VarType(ComputeAddr(addr)); end; // CopyData // -procedure TArrayElementDataContext.CopyData(const destData : TData; destAddr, size : Integer); +procedure TArrayElementDataContext.CopyData(const destData : TData; destAddr, size : NativeInt); var - i : Integer; + i : NativeInt; begin for i := 0 to size-1 do FArray.EvalAsVariant(ComputeAddr(i), destData[destAddr+i]); @@ -282,9 +282,9 @@ procedure TArrayElementDataContext.CopyData(const destData : TData; destAddr, si // WriteData // -procedure TArrayElementDataContext.WriteData(const src : IDataContext; size : Integer); +procedure TArrayElementDataContext.WriteData(const src : IDataContext; size : NativeInt); var - p, i : Integer; + p, i : NativeInt; v : Variant; begin p := ComputeAddr(0); @@ -296,28 +296,28 @@ procedure TArrayElementDataContext.WriteData(const src : IDataContext; size : In // WriteData // -procedure TArrayElementDataContext.WriteData(destAddr : Integer; const src : IDataContext; size : Integer); +procedure TArrayElementDataContext.WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); begin raise Exception.Create('TArrayElementDataContext.WriteData(2) not implemented'); end; // WriteData // -procedure TArrayElementDataContext.WriteData(const srcData : TData; srcAddr, size : Integer); +procedure TArrayElementDataContext.WriteData(const srcData : TData; srcAddr, size : NativeInt); begin raise Exception.Create('TArrayElementDataContext.WriteData(3) not implemented'); end; // SameData // -function TArrayElementDataContext.SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; +function TArrayElementDataContext.SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; begin raise Exception.Create('TArrayElementDataContext.SameData not implemented'); end; // IncInteger // -function TArrayElementDataContext.IncInteger(addr : Integer; delta : Int64) : Int64; +function TArrayElementDataContext.IncInteger(addr : NativeInt; delta : Int64) : Int64; begin addr := ComputeAddr(addr); Result := FArray.AsInteger[addr] + delta; @@ -326,7 +326,7 @@ function TArrayElementDataContext.IncInteger(addr : Integer; delta : Int64) : In // HashCode // -function TArrayElementDataContext.HashCode(size : Integer) : Cardinal; +function TArrayElementDataContext.HashCode(size : NativeInt) : Cardinal; begin Result := FArray.HashCode(ComputeAddr(0), size); end; diff --git a/Source/dwsArrayExprs.pas b/Source/dwsArrayExprs.pas index 567c2425..07e8668b 100644 --- a/Source/dwsArrayExprs.pas +++ b/Source/dwsArrayExprs.pas @@ -141,9 +141,11 @@ TDynamicArrayExpr = class(TArrayExpr) procedure GetDataPtr(exec : TdwsExecution; var result : IDataContext); override; function EvalAsInteger(exec : TdwsExecution) : Int64; override; + function EvalAsBoolean(exec : TdwsExecution) : Boolean; override; function EvalAsFloat(exec : TdwsExecution) : Double; override; procedure EvalAsVariant(exec : TdwsExecution; var result : Variant); override; procedure EvalAsString(exec : TdwsExecution; var result : String); override; + procedure EvalAsInterface(exec : TdwsExecution; var result : IUnknown); override; function SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; override; @@ -154,6 +156,7 @@ TDynamicArrayExpr = class(TArrayExpr) TDynamicArrayVarExpr = class sealed (TDynamicArrayExpr) public function EvalAsInteger(exec : TdwsExecution) : Int64; override; + function EvalAsBoolean(exec : TdwsExecution) : Boolean; override; function EvalAsFloat(exec : TdwsExecution) : Double; override; procedure EvalAsString(exec : TdwsExecution; var result : String); override; @@ -1259,6 +1262,22 @@ function TDynamicArrayExpr.EvalAsInteger(exec : TdwsExecution) : Int64; Result := dyn.AsInteger[index]; end; +// EvalAsBoolean +// +function TDynamicArrayExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean; +var + dyn : IScriptDynArray; + index : Integer; +begin + FBaseExpr.EvalAsScriptDynArray(exec, dyn); + + index := IndexExpr.EvalAsInteger(exec); + if not dyn.BoundsCheckPassed(index) then + BoundsCheckFailed(exec, index); + + Result := dyn.AsBoolean[index]; +end; + // EvalAsFloat // function TDynamicArrayExpr.EvalAsFloat(exec : TdwsExecution) : Double; @@ -1307,6 +1326,22 @@ procedure TDynamicArrayExpr.EvalAsString(exec : TdwsExecution; var result : Stri dyn.EvalAsString(index, result); end; +// EvalAsInterface +// +procedure TDynamicArrayExpr.EvalAsInterface(exec : TdwsExecution; var result : IUnknown); +var + dyn : IScriptDynArray; + index : Integer; +begin + FBaseExpr.EvalAsScriptDynArray(exec, dyn); + + index := IndexExpr.EvalAsInteger(exec); + if not dyn.BoundsCheckPassed(index) then + BoundsCheckFailed(exec, index); + + dyn.EvalAsInterface(index, result); +end; + // SpecializeDataExpr // function TDynamicArrayExpr.SpecializeDataExpr(const context : ISpecializationContext) : TDataExpr; @@ -1355,6 +1390,22 @@ function TDynamicArrayVarExpr.EvalAsInteger(exec : TdwsExecution) : Int64; Result := IScriptDynArray(pIDyn^).AsInteger[index*FElementSize]; end; +// EvalAsBoolean +// +function TDynamicArrayVarExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean; +var + pIDyn : PIUnknown; + index : Integer; +begin + pIDyn := exec.Stack.PointerToInterfaceValue_BaseRelative(TObjectVarExpr(FBaseExpr).StackAddr); + + index := IndexExpr.EvalAsInteger(exec); + if not IScriptDynArray(pIDyn^).BoundsCheckPassed(index) then + BoundsCheckFailed(exec, index); + + Result := IScriptDynArray(pIDyn^).AsBoolean[index*FElementSize]; +end; + // EvalAsFloat // function TDynamicArrayVarExpr.EvalAsFloat(exec : TdwsExecution) : Double; @@ -1427,18 +1478,13 @@ destructor TDynamicArraySetExpr.Destroy; // procedure TDynamicArraySetExpr.EvalNoResult(exec : TdwsExecution); var + dyn : IScriptDynArray; index : Integer; - base : IScriptDynArray; - buf : Variant; begin - FArrayExpr.EvalAsScriptDynArray(exec, base); - + ArrayExpr.EvalAsScriptDynArray(exec, dyn); index := IndexExpr.EvalAsInteger(exec); - if not base.BoundsCheckPassed(index) then + if not dyn.SetFromExpr(index, exec, ValueExpr) then BoundsCheckFailed(exec, index); - - ValueExpr.EvalAsVariant(exec, buf); - base.AsVariant[index] := buf; end; // SpecializeProgramExpr @@ -1481,16 +1527,13 @@ function TDynamicArraySetExpr.GetSubExprCount : Integer; // procedure TDynamicArraySetVarExpr.EvalNoResult(exec : TdwsExecution); var - dyn : IScriptDynArray; + p : PIUnknown; index : Integer; - v : Variant; begin - ArrayExpr.EvalAsScriptDynArray(exec, dyn); - index:=IndexExpr.EvalAsInteger(exec); - if not dyn.BoundsCheckPassed(index) then + p := exec.Stack.PointerToInterfaceValue_BaseRelative(TObjectVarExpr(ArrayExpr).StackAddr); + index := IndexExpr.EvalAsInteger(exec); + if not IScriptDynArray(p^).SetFromExpr(index, exec, ValueExpr) then BoundsCheckFailed(exec, index); - ValueExpr.EvalAsVariant(exec, v); - dyn.SetAsVariant(index, v); end; // ------------------ @@ -1928,9 +1971,9 @@ TArraySortComparer = class FFuncPointer : IFuncPointer; FLeftAddr, FRightAddr : Integer; constructor Create(exec : TdwsExecution; const dyn : IScriptDynArray; compareFunc : TFuncPtrExpr); - function CompareData(index1, index2 : Integer) : Integer; - function CompareValue(index1, index2 : Integer) : Integer; - procedure Swap(index1, index2 : Integer); + function CompareData(index1, index2 : NativeInt) : Integer; + function CompareValue(index1, index2 : NativeInt) : Integer; + procedure Swap(index1, index2 : NativeInt); end; // Create @@ -1948,7 +1991,7 @@ constructor TArraySortComparer.Create(exec : TdwsExecution; const dyn : IScriptD // CompareData // -function TArraySortComparer.CompareData(index1, index2 : Integer) : Integer; +function TArraySortComparer.CompareData(index1, index2 : NativeInt) : Integer; var dyn : TScriptDynamicDataArray; begin @@ -1960,7 +2003,7 @@ function TArraySortComparer.CompareData(index1, index2 : Integer) : Integer; // CompareValue // -function TArraySortComparer.CompareValue(index1, index2 : Integer) : Integer; +function TArraySortComparer.CompareValue(index1, index2 : NativeInt) : Integer; begin FDyn.EvalAsVariant(index1, FExec.Stack.Data[FLeftAddr]); FDyn.EvalAsVariant(index2, FExec.Stack.Data[FRightAddr]); @@ -1969,7 +2012,7 @@ function TArraySortComparer.CompareValue(index1, index2 : Integer) : Integer; // Swap // -procedure TArraySortComparer.Swap(index1, index2 : Integer); +procedure TArraySortComparer.Swap(index1, index2 : NativeInt); begin FDyn.Swap(index1, index2); end; diff --git a/Source/dwsCompiler.pas b/Source/dwsCompiler.pas index 260af509..49f36d33 100644 --- a/Source/dwsCompiler.pas +++ b/Source/dwsCompiler.pas @@ -1829,18 +1829,18 @@ function TdwsCompiler.HandleExplicitDependency(const scriptPos : TScriptPos; con TRankedUnits = class Ranked : TUnitMainSymbolArray; - function Compare(index1, index2 : Integer) : Integer; - procedure Swap(index1, index2 : Integer); + function Compare(index1, index2 : NativeInt) : Integer; + procedure Swap(index1, index2 : NativeInt); end; -function TRankedUnits.Compare(index1, index2 : Integer) : Integer; +function TRankedUnits.Compare(index1, index2 : NativeInt) : Integer; begin Result:=Ranked[index1].InitializationRank-Ranked[index2].InitializationRank; end; // Swap // -procedure TRankedUnits.Swap(index1, index2 : Integer); +procedure TRankedUnits.Swap(index1, index2 : NativeInt); var t : TUnitMainSymbol; begin diff --git a/Source/dwsCoreExprs.pas b/Source/dwsCoreExprs.pas index 6742e53f..61fb9392 100644 --- a/Source/dwsCoreExprs.pas +++ b/Source/dwsCoreExprs.pas @@ -3613,7 +3613,7 @@ procedure TStringInOpStaticSetExpr.Prepare; // function TStringInOpStaticSetExpr.EvalAsBoolean(exec : TdwsExecution) : Boolean; var - i : Integer; + i : NativeInt; value : UnicodeString; begin FLeft.EvalAsUnicodeString(exec, value); diff --git a/Source/dwsDataContext.pas b/Source/dwsDataContext.pas index 30b8a825..8f261516 100644 --- a/Source/dwsDataContext.pas +++ b/Source/dwsDataContext.pas @@ -35,56 +35,56 @@ interface IDataContext = interface (IGetSelf) ['{306EAD7F-1FEC-4D6F-8579-F48D75C5C1FF}'] - function GetAsVariant(addr : Integer) : Variant; - procedure SetAsVariant(addr : Integer; const value : Variant); - function GetAsInteger(addr : Integer) : Int64; - procedure SetAsInteger(addr : Integer; const value : Int64); - function GetAsFloat(addr : Integer) : Double; - procedure SetAsFloat(addr : Integer; const value : Double); - function GetAsBoolean(addr : Integer) : Boolean; - procedure SetAsBoolean(addr : Integer; const value : Boolean); - function GetAsString(addr : Integer) : String; - procedure SetAsString(addr : Integer; const value : String); - function GetAsInterface(addr : Integer) : IUnknown; - procedure SetAsInterface(addr : Integer; const value : IUnknown); - - function Addr : Integer; - function DataLength : Integer; - - property AsVariant[addr : Integer] : Variant read GetAsVariant write SetAsVariant; default; + function GetAsVariant(addr : NativeInt) : Variant; + procedure SetAsVariant(addr : NativeInt; const value : Variant); + function GetAsInteger(addr : NativeInt) : Int64; + procedure SetAsInteger(addr : NativeInt; const value : Int64); + function GetAsFloat(addr : NativeInt) : Double; + procedure SetAsFloat(addr : NativeInt; const value : Double); + function GetAsBoolean(addr : NativeInt) : Boolean; + procedure SetAsBoolean(addr : NativeInt; const value : Boolean); + function GetAsString(addr : NativeInt) : String; + procedure SetAsString(addr : NativeInt; const value : String); + function GetAsInterface(addr : NativeInt) : IUnknown; + procedure SetAsInterface(addr : NativeInt; const value : IUnknown); + + function Addr : NativeInt; + function DataLength : NativeInt; + + property AsVariant[addr : NativeInt] : Variant read GetAsVariant write SetAsVariant; default; function AsPData : PData; - procedure CreateOffset(offset : Integer; var result : IDataContext); + procedure CreateOffset(offset : NativeInt; var result : IDataContext); - property AsInteger[addr : Integer] : Int64 read GetAsInteger write SetAsInteger; - property AsBoolean[addr : Integer] : Boolean read GetAsBoolean write SetAsBoolean; - property AsFloat[addr : Integer] : Double read GetAsFloat write SetAsFloat; - property AsString[addr : Integer] : String read GetAsString write SetAsString; - property AsInterface[addr : Integer] : IUnknown read GetAsInterface write SetAsInterface; + property AsInteger[addr : NativeInt] : Int64 read GetAsInteger write SetAsInteger; + property AsBoolean[addr : NativeInt] : Boolean read GetAsBoolean write SetAsBoolean; + property AsFloat[addr : NativeInt] : Double read GetAsFloat write SetAsFloat; + property AsString[addr : NativeInt] : String read GetAsString write SetAsString; + property AsInterface[addr : NativeInt] : IUnknown read GetAsInterface write SetAsInterface; - procedure EvalAsVariant(addr : Integer; var result : Variant); - procedure EvalAsString(addr : Integer; var result : String); - procedure EvalAsInterface(addr : Integer; var result : IUnknown); + procedure EvalAsVariant(addr : NativeInt; var result : Variant); + procedure EvalAsString(addr : NativeInt; var result : String); + procedure EvalAsInterface(addr : NativeInt; var result : IUnknown); - function IsEmpty(addr : Integer) : Boolean; - function VarType(addr : Integer) : TVarType; + function IsEmpty(addr : NativeInt) : Boolean; + function VarType(addr : NativeInt) : TVarType; - procedure CopyData(const destData : TData; destAddr, size : Integer); - procedure WriteData(const src : IDataContext; size : Integer); overload; - procedure WriteData(destAddr : Integer; const src : IDataContext; size : Integer); overload; - procedure WriteData(const srcData : TData; srcAddr, size : Integer); overload; - function SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; + procedure CopyData(const destData : TData; destAddr, size : NativeInt); + procedure WriteData(const src : IDataContext; size : NativeInt); overload; + procedure WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); overload; + procedure WriteData(const srcData : TData; srcAddr, size : NativeInt); overload; + function SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; - function IncInteger(addr : Integer; delta : Int64) : Int64; + function IncInteger(addr : NativeInt; delta : Int64) : Int64; - function HashCode(size : Integer) : Cardinal; + function HashCode(size : NativeInt) : Cardinal; end; TDataContext = class; IDataContextPool = interface - function Create(const aData : TData; anAddr : Integer) : TDataContext; + function Create(const aData : TData; anAddr : NativeInt) : TDataContext; procedure Cleanup; end; @@ -99,8 +99,8 @@ TDataContextPool = class (TInterfacedObject, IDataContextPool) procedure Push(ref : TDataContext); inline; procedure Cleanup; - function CreateData(const aData : TData; anAddr : Integer) : TDataContext; - function CreateOffset(offset : Integer; ref : TDataContext) : TDataContext; + function CreateData(const aData : TData; anAddr : NativeInt) : TDataContext; + function CreateOffset(offset : NativeInt; ref : TDataContext) : TDataContext; function IDataContextPool.Create = CreateData; end; @@ -108,7 +108,7 @@ TDataContextPool = class (TInterfacedObject, IDataContextPool) TDataContext = class(TInterfacedObject, IDataContext, IGetSelf) private - FAddr : Integer; + FAddr : NativeInt; FData : TData; FNext : TDataContext; FPool : TDataContextPool; @@ -116,18 +116,18 @@ TDataContext = class(TInterfacedObject, IDataContext, IGetSelf) {$IFDEF DELPHI_2010_MINUS} protected // D2009 needs protected here to "see" these methods in inherited classes {$ENDIF} - function GetAsVariant(addr : Integer) : Variant; inline; - procedure SetAsVariant(addr : Integer; const value : Variant); inline; - function GetAsInteger(addr : Integer) : Int64; inline; - procedure SetAsInteger(addr : Integer; const value : Int64); inline; - function GetAsFloat(addr : Integer) : Double; inline; - procedure SetAsFloat(addr : Integer; const value : Double); inline; - function GetAsBoolean(addr : Integer) : Boolean; inline; - procedure SetAsBoolean(addr : Integer; const value : Boolean); inline; - function GetAsString(addr : Integer) : String; inline; - procedure SetAsString(addr : Integer; const value : String); inline; - function GetAsInterface(addr : Integer) : IUnknown; inline; - procedure SetAsInterface(addr : Integer; const value : IUnknown); inline; + function GetAsVariant(addr : NativeInt) : Variant; inline; + procedure SetAsVariant(addr : NativeInt; const value : Variant); inline; + function GetAsInteger(addr : NativeInt) : Int64; inline; + procedure SetAsInteger(addr : NativeInt; const value : Int64); inline; + function GetAsFloat(addr : NativeInt) : Double; inline; + procedure SetAsFloat(addr : NativeInt; const value : Double); inline; + function GetAsBoolean(addr : NativeInt) : Boolean; inline; + procedure SetAsBoolean(addr : NativeInt; const value : Boolean); inline; + function GetAsString(addr : NativeInt) : String; inline; + procedure SetAsString(addr : NativeInt; const value : String); inline; + function GetAsInterface(addr : NativeInt) : IUnknown; inline; + procedure SetAsInterface(addr : NativeInt; const value : IUnknown); inline; function _Release: Integer; stdcall; @@ -135,60 +135,60 @@ TDataContext = class(TInterfacedObject, IDataContext, IGetSelf) property DirectData : TData read FData; public - constructor CreateStandalone(size : Integer); + constructor CreateStandalone(size : NativeInt); function GetSelf : TObject; - property AsVariant[addr : Integer] : Variant read GetAsVariant write SetAsVariant; default; + property AsVariant[addr : NativeInt] : Variant read GetAsVariant write SetAsVariant; default; function AsPData : PData; inline; - function Addr : Integer; - function DataLength : Integer; inline; - procedure Offset(delta : Integer); inline; + function Addr : NativeInt; + function DataLength : NativeInt; inline; + procedure Offset(delta : NativeInt); inline; - procedure CreateOffset(offset : Integer; var result : IDataContext); + procedure CreateOffset(offset : NativeInt; var result : IDataContext); - procedure EvalAsVariant(addr : Integer; var result : Variant); inline; - procedure EvalAsString(addr : Integer; var result : String); inline; - procedure EvalAsInterface(addr : Integer; var result : IUnknown); inline; + procedure EvalAsVariant(addr : NativeInt; var result : Variant); inline; + procedure EvalAsString(addr : NativeInt; var result : String); inline; + procedure EvalAsInterface(addr : NativeInt; var result : IUnknown); inline; - property AsInteger[addr : Integer] : Int64 read GetAsInteger write SetAsInteger; - property AsBoolean[addr : Integer] : Boolean read GetAsBoolean write SetAsBoolean; - property AsFloat[addr : Integer] : Double read GetAsFloat write SetAsFloat; - property AsString[addr : Integer] : String read GetAsString write SetAsString; - property AsInterface[addr : Integer] : IUnknown read GetAsInterface write SetAsInterface; + property AsInteger[addr : NativeInt] : Int64 read GetAsInteger write SetAsInteger; + property AsBoolean[addr : NativeInt] : Boolean read GetAsBoolean write SetAsBoolean; + property AsFloat[addr : NativeInt] : Double read GetAsFloat write SetAsFloat; + property AsString[addr : NativeInt] : String read GetAsString write SetAsString; + property AsInterface[addr : NativeInt] : IUnknown read GetAsInterface write SetAsInterface; - function IsEmpty(addr : Integer) : Boolean; - function VarType(addr : Integer) : TVarType; virtual; + function IsEmpty(addr : NativeInt) : Boolean; + function VarType(addr : NativeInt) : TVarType; virtual; - procedure InternalCopyData(sourceAddr, destAddr, size : Integer); inline; + procedure InternalCopyData(sourceAddr, destAddr, size : NativeInt); inline; - procedure CopyData(const destData : TData; destAddr, size : Integer); overload; inline; - procedure CopyData(addr : Integer; const destData : TData; destAddr, size : Integer); overload; inline; - procedure CopyData(addr : Integer; const destPVariant : PVariant; size : Integer); overload; inline; + procedure CopyData(const destData : TData; destAddr, size : NativeInt); overload; inline; + procedure CopyData(addr : NativeInt; const destData : TData; destAddr, size : NativeInt); overload; inline; + procedure CopyData(addr : NativeInt; const destPVariant : PVariant; size : NativeInt); overload; inline; - procedure WriteData(const src : IDataContext; size : Integer); overload; inline; - procedure WriteData(const src : IDataContext; srcAddr, size : Integer); overload; inline; - procedure WriteData(destAddr : Integer; const src : IDataContext; size : Integer); overload; inline; - procedure WriteData(const srcData : TData; srcAddr, size : Integer); overload; inline; + procedure WriteData(const src : IDataContext; size : NativeInt); overload; inline; + procedure WriteData(const src : IDataContext; srcAddr, size : NativeInt); overload; inline; + procedure WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); overload; inline; + procedure WriteData(const srcData : TData; srcAddr, size : NativeInt); overload; inline; - procedure MoveData(srcAddr, destAddr, size : Integer); inline; + procedure MoveData(srcAddr, destAddr, size : NativeInt); inline; - function SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; overload; inline; - function SameData(addr : Integer; const otherData : IDataContext; size : Integer) : Boolean; overload; inline; + function SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; overload; inline; + function SameData(addr : NativeInt; const otherData : IDataContext; size : NativeInt) : Boolean; overload; inline; - function IndexOfData(const item : IDataContext; fromIndex, toIndex, itemSize : Integer) : Integer; - function IndexOfValue(const item : Variant; fromIndex, toIndex : Integer) : Integer; - function IndexOfString(const item : String; fromIndex : Integer) : Integer; - function IndexOfInteger(const item : Int64; fromIndex : Integer) : Integer; - function IndexOfFloat(const item : Double; fromIndex : Integer) : Integer; + function IndexOfData(const item : IDataContext; fromIndex, toIndex, itemSize : NativeInt) : NativeInt; + function IndexOfValue(const item : Variant; fromIndex, toIndex : NativeInt) : NativeInt; + function IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; + function IndexOfInteger(const item : Int64; fromIndex : NativeInt) : NativeInt; + function IndexOfFloat(const item : Double; fromIndex : NativeInt) : NativeInt; procedure ReplaceData(const newData : TData); virtual; procedure ClearData; virtual; - procedure SetDataLength(n : Integer); + procedure SetDataLength(n : NativeInt); - function IncInteger(addr : Integer; delta : Int64) : Int64; + function IncInteger(addr : NativeInt; delta : Int64) : Int64; - function HashCode(size : Integer) : Cardinal; + function HashCode(size : NativeInt) : Cardinal; end; TGetPDataFunc = function : PData of object; @@ -196,60 +196,60 @@ TDataContext = class(TInterfacedObject, IDataContext, IGetSelf) TRelativeDataContext = class (TInterfacedObject, IDataContext, IGetSelf) private FGetPData : TGetPDataFunc; - FAddr : Integer; + FAddr : NativeInt; public - constructor Create(const getPData : TGetPDataFunc; addr : Integer); + constructor Create(const getPData : TGetPDataFunc; addr : NativeInt); function GetSelf : TObject; - function GetAsVariant(addr : Integer) : Variant; - procedure SetAsVariant(addr : Integer; const value : Variant); - function GetAsInteger(addr : Integer) : Int64; - procedure SetAsInteger(addr : Integer; const value : Int64); - function GetAsFloat(addr : Integer) : Double; - procedure SetAsFloat(addr : Integer; const value : Double); - function GetAsBoolean(addr : Integer) : Boolean; - procedure SetAsBoolean(addr : Integer; const value : Boolean); - function GetAsString(addr : Integer) : String; - procedure SetAsString(addr : Integer; const value : String); - function GetAsInterface(addr : Integer) : IUnknown; - procedure SetAsInterface(addr : Integer; const value : IUnknown); - - function Addr : Integer; - function DataLength : Integer; + function GetAsVariant(addr : NativeInt) : Variant; + procedure SetAsVariant(addr : NativeInt; const value : Variant); + function GetAsInteger(addr : NativeInt) : Int64; + procedure SetAsInteger(addr : NativeInt; const value : Int64); + function GetAsFloat(addr : NativeInt) : Double; + procedure SetAsFloat(addr : NativeInt; const value : Double); + function GetAsBoolean(addr : NativeInt) : Boolean; + procedure SetAsBoolean(addr : NativeInt; const value : Boolean); + function GetAsString(addr : NativeInt) : String; + procedure SetAsString(addr : NativeInt; const value : String); + function GetAsInterface(addr : NativeInt) : IUnknown; + procedure SetAsInterface(addr : NativeInt; const value : IUnknown); + + function Addr : NativeInt; + function DataLength : NativeInt; function AsPData : PData; - procedure CreateOffset(offset : Integer; var result : IDataContext); + procedure CreateOffset(offset : NativeInt; var result : IDataContext); - procedure EvalAsVariant(addr : Integer; var result : Variant); - procedure EvalAsString(addr : Integer; var result : String); - procedure EvalAsInterface(addr : Integer; var result : IUnknown); + procedure EvalAsVariant(addr : NativeInt; var result : Variant); + procedure EvalAsString(addr : NativeInt; var result : String); + procedure EvalAsInterface(addr : NativeInt; var result : IUnknown); - function IsEmpty(addr : Integer) : Boolean; - function VarType(addr : Integer) : TVarType; + function IsEmpty(addr : NativeInt) : Boolean; + function VarType(addr : NativeInt) : TVarType; - procedure CopyData(const destData : TData; destAddr, size : Integer); - procedure WriteData(const src : IDataContext; size : Integer); overload; - procedure WriteData(destAddr : Integer; const src : IDataContext; size : Integer); overload; - procedure WriteData(const srcData : TData; srcAddr, size : Integer); overload; - function SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; overload; + procedure CopyData(const destData : TData; destAddr, size : NativeInt); + procedure WriteData(const src : IDataContext; size : NativeInt); overload; + procedure WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); overload; + procedure WriteData(const srcData : TData; srcAddr, size : NativeInt); overload; + function SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; overload; - function IncInteger(addr : Integer; delta : Int64) : Int64; + function IncInteger(addr : NativeInt; delta : Int64) : Int64; - function HashCode(size : Integer) : Cardinal; + function HashCode(size : NativeInt) : Cardinal; end; -procedure DWSCopyPVariants(src, dest : PVariant; size : Integer); inline; +procedure DWSCopyPVariants(src, dest : PVariant; size : NativeInt); inline; -procedure DWSCopyData(const sourceData : TData; sourceAddr : Integer; - const destData : TData; destAddr : Integer; size : Integer); overload; -procedure DWSCopyData(const data : TData; sourceAddr, destAddr : Integer; size : Integer); overload; +procedure DWSCopyData(const sourceData : TData; sourceAddr : NativeInt; + const destData : TData; destAddr : NativeInt; size : NativeInt); overload; +procedure DWSCopyData(const data : TData; sourceAddr, destAddr : NativeInt; size : NativeInt); overload; -procedure DWSMoveData(const data : TData; sourceAddr, destAddr, size : Integer); +procedure DWSMoveData(const data : TData; sourceAddr, destAddr, size : NativeInt); -function DWSSameData(const data1, data2 : TData; offset1, offset2, size : Integer) : Boolean; overload; +function DWSSameData(const data1, data2 : TData; offset1, offset2, size : NativeInt) : Boolean; overload; function DWSSameData(const data1, data2 : TData) : Boolean; overload; function DWSSameVariant(const v1, v2 : Variant) : Boolean; @@ -260,8 +260,8 @@ function DWSSameVariant(const v1, v2 : Variant) : Boolean; procedure DWSHashCode(var partial : Cardinal; const v : Variant); overload; function DWSHashCode(const v : Variant) : Cardinal; overload; -function DWSHashCode(const data : TData; offset, size : Integer) : Cardinal; overload; -function DWSHashCode(p : PVariant; size : Integer) : Cardinal; overload; +function DWSHashCode(const data : TData; offset, size : NativeInt) : Cardinal; overload; +function DWSHashCode(p : PVariant; size : NativeInt) : Cardinal; overload; // ------------------------------------------------------------------ // ------------------------------------------------------------------ @@ -273,7 +273,7 @@ implementation // DWSCopyPVariants // -procedure DWSCopyPVariants(src, dest : PVariant; size : Integer); inline; +procedure DWSCopyPVariants(src, dest : PVariant; size : NativeInt); inline; begin while size > 0 do begin VarCopySafe(dest^, src^); @@ -285,8 +285,8 @@ procedure DWSCopyPVariants(src, dest : PVariant; size : Integer); inline; // DWSCopyData // -procedure DWSCopyData(const sourceData: TData; sourceAddr: Integer; - const destData: TData; destAddr: Integer; size: Integer); +procedure DWSCopyData(const sourceData: TData; sourceAddr: NativeInt; + const destData: TData; destAddr: NativeInt; size: NativeInt); var src, dest : PVariant; begin @@ -297,9 +297,9 @@ procedure DWSCopyData(const sourceData: TData; sourceAddr: Integer; // DWSCopyData // -procedure DWSCopyData(const data : TData; sourceAddr, destAddr : Integer; size : Integer); +procedure DWSCopyData(const data : TData; sourceAddr, destAddr : NativeInt; size : NativeInt); var - i : Integer; + i : NativeInt; begin if sourceAddr > destAddr then begin for i := 0 to size-1 do @@ -312,13 +312,13 @@ procedure DWSCopyData(const data : TData; sourceAddr, destAddr : Integer; size : // DWSMoveData // -procedure DWSMoveData(const data : TData; sourceAddr, destAddr, size : Integer); +procedure DWSMoveData(const data : TData; sourceAddr, destAddr, size : NativeInt); const cStaticBufferSize = 4*SizeOf(Variant); var bufVariant : array[0..cStaticBufferSize-1] of Byte; buf : Pointer; - sizeBytes : Integer; + sizeBytes : NativeInt; begin if sourceAddr = destAddr then Exit; @@ -339,9 +339,9 @@ procedure DWSMoveData(const data : TData; sourceAddr, destAddr, size : Integer); // DWSSameData // -function DWSSameData(const data1, data2 : TData; offset1, offset2, size : Integer) : Boolean; +function DWSSameData(const data1, data2 : TData; offset1, offset2, size : NativeInt) : Boolean; var - i : Integer; + i : NativeInt; begin for i:=0 to size-1 do if not DWSSameVariant(data1[offset1+i], data2[offset2+i]) then @@ -353,7 +353,7 @@ function DWSSameData(const data1, data2 : TData; offset1, offset2, size : Intege // function DWSSameData(const data1, data2 : TData) : Boolean; var - s : Integer; + s : NativeInt; begin s:=Length(data1); Result:=(s=Length(data2)) and DWSSameData(data1, data2, 0, 0, s); @@ -363,7 +363,7 @@ function DWSSameData(const data1, data2 : TData) : Boolean; // function DWSSameVariant(const v1, v2 : Variant) : Boolean; var - vt : Integer; + vt : TVarType; begin vt:=TVarData(v1).VType; if vt<>TVarData(v2).VType then @@ -440,9 +440,9 @@ function DWSHashCode(const v : Variant) : Cardinal; Result := cFNV_basis; end; -function DWSHashCode(const data : TData; offset, size : Integer) : Cardinal; +function DWSHashCode(const data : TData; offset, size : NativeInt) : Cardinal; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := offset to offset+size-1 do @@ -451,9 +451,9 @@ function DWSHashCode(const data : TData; offset, size : Integer) : Cardinal; Result := cFNV_basis; end; -function DWSHashCode(p : PVariant; size : Integer) : Cardinal; overload; +function DWSHashCode(p : PVariant; size : NativeInt) : Cardinal; overload; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := 1 to size do begin @@ -538,7 +538,7 @@ procedure TDataContextPool.Cleanup; // CreateData // -function TDataContextPool.CreateData(const aData : TData; anAddr : Integer) : TDataContext; +function TDataContextPool.CreateData(const aData : TData; anAddr : NativeInt) : TDataContext; begin Result:=Pop; Result.FAddr:=anAddr; @@ -547,7 +547,7 @@ function TDataContextPool.CreateData(const aData : TData; anAddr : Integer) : TD // CreateOffset // -function TDataContextPool.CreateOffset(offset : Integer; ref : TDataContext) : TDataContext; +function TDataContextPool.CreateOffset(offset : NativeInt; ref : TDataContext) : TDataContext; begin Result:=Pop; Result.FAddr:=ref.FAddr+offset; @@ -569,7 +569,7 @@ function TDataContext._Release: Integer; // CreateStandalone // -constructor TDataContext.CreateStandalone(size : Integer); +constructor TDataContext.CreateStandalone(size : NativeInt); begin inherited Create; SetLength(FData, size); @@ -584,21 +584,21 @@ function TDataContext.GetSelf : TObject; // GetAsVariant // -function TDataContext.GetAsVariant(addr : Integer) : Variant; +function TDataContext.GetAsVariant(addr : NativeInt) : Variant; begin VarCopySafe(Result, FData[FAddr+addr]); end; // SetAsVariant // -procedure TDataContext.SetAsVariant(addr : Integer; const value : Variant); +procedure TDataContext.SetAsVariant(addr : NativeInt; const value : Variant); begin VarCopySafe(FData[FAddr+addr], value); end; // GetAsInteger // -function TDataContext.GetAsInteger(addr : Integer) : Int64; +function TDataContext.GetAsInteger(addr : NativeInt) : Int64; var p : PVarData; begin @@ -610,7 +610,7 @@ function TDataContext.GetAsInteger(addr : Integer) : Int64; // SetAsInteger // -procedure TDataContext.SetAsInteger(addr : Integer; const value : Int64); +procedure TDataContext.SetAsInteger(addr : NativeInt; const value : Int64); var p : PVarData; begin @@ -622,7 +622,7 @@ procedure TDataContext.SetAsInteger(addr : Integer; const value : Int64); // GetAsFloat // -function TDataContext.GetAsFloat(addr : Integer) : Double; +function TDataContext.GetAsFloat(addr : NativeInt) : Double; var p : PVarData; begin @@ -634,7 +634,7 @@ function TDataContext.GetAsFloat(addr : Integer) : Double; // SetAsFloat // -procedure TDataContext.SetAsFloat(addr : Integer; const value : Double); +procedure TDataContext.SetAsFloat(addr : NativeInt; const value : Double); var p : PVarData; begin @@ -646,7 +646,7 @@ procedure TDataContext.SetAsFloat(addr : Integer; const value : Double); // GetAsBoolean // -function TDataContext.GetAsBoolean(addr : Integer) : Boolean; +function TDataContext.GetAsBoolean(addr : NativeInt) : Boolean; var p : PVarData; begin @@ -658,7 +658,7 @@ function TDataContext.GetAsBoolean(addr : Integer) : Boolean; // SetAsBoolean // -procedure TDataContext.SetAsBoolean(addr : Integer; const value : Boolean); +procedure TDataContext.SetAsBoolean(addr : NativeInt; const value : Boolean); var p : PVarData; begin @@ -670,14 +670,14 @@ procedure TDataContext.SetAsBoolean(addr : Integer; const value : Boolean); // GetAsString // -function TDataContext.GetAsString(addr : Integer) : String; +function TDataContext.GetAsString(addr : NativeInt) : String; begin EvalAsString(addr, Result); end; // SetAsString // -procedure TDataContext.SetAsString(addr : Integer; const value : String); +procedure TDataContext.SetAsString(addr : NativeInt; const value : String); var p : PVarData; begin @@ -694,7 +694,7 @@ procedure TDataContext.SetAsString(addr : Integer; const value : String); // GetAsInterface // -function TDataContext.GetAsInterface(addr : Integer) : IUnknown; +function TDataContext.GetAsInterface(addr : NativeInt) : IUnknown; var p : PVarData; begin @@ -706,7 +706,7 @@ function TDataContext.GetAsInterface(addr : Integer) : IUnknown; // SetAsInterface // -procedure TDataContext.SetAsInterface(addr : Integer; const value : IUnknown); +procedure TDataContext.SetAsInterface(addr : NativeInt; const value : IUnknown); var p : PVarData; begin @@ -725,30 +725,30 @@ function TDataContext.AsPData : PData; // Addr // -function TDataContext.Addr : Integer; +function TDataContext.Addr : NativeInt; begin Result:=FAddr; end; // DataLength // -function TDataContext.DataLength : Integer; +function TDataContext.DataLength : NativeInt; begin Result:=System.Length(FData); end; // Offset // -procedure TDataContext.Offset(delta : Integer); +procedure TDataContext.Offset(delta : NativeInt); begin Inc(FAddr, delta); end; // CreateOffset // -procedure TDataContext.CreateOffset(offset : Integer; var result : IDataContext); +procedure TDataContext.CreateOffset(offset : NativeInt; var result : IDataContext); - function CreateData(context : TDataContext; addr : Integer) : TDataContext; + function CreateData(context : TDataContext; addr : NativeInt) : TDataContext; begin Result:=TDataContext.Create; Result.FData:=context.FData; @@ -763,14 +763,14 @@ procedure TDataContext.CreateOffset(offset : Integer; var result : IDataContext) // EvalAsVariant // -procedure TDataContext.EvalAsVariant(addr : Integer; var result : Variant); +procedure TDataContext.EvalAsVariant(addr : NativeInt; var result : Variant); begin VarCopySafe(result, FData[FAddr+addr]); end; // EvalAsString // -procedure TDataContext.EvalAsString(addr : Integer; var result : String); +procedure TDataContext.EvalAsString(addr : NativeInt; var result : String); var p : PVarData; begin @@ -788,7 +788,7 @@ procedure TDataContext.EvalAsString(addr : Integer; var result : String); // EvalAsInterface // -procedure TDataContext.EvalAsInterface(addr : Integer; var result : IUnknown); +procedure TDataContext.EvalAsInterface(addr : NativeInt; var result : IUnknown); var p : PVarData; begin @@ -800,58 +800,58 @@ procedure TDataContext.EvalAsInterface(addr : Integer; var result : IUnknown); // IsEmpty // -function TDataContext.IsEmpty(addr : Integer) : Boolean; +function TDataContext.IsEmpty(addr : NativeInt) : Boolean; begin Result := DWSVarIsEmpty(FData[FAddr+addr]); end; // VarType // -function TDataContext.VarType(addr : Integer) : TVarType; +function TDataContext.VarType(addr : NativeInt) : TVarType; begin Result := VarType(FData[FAddr+addr]); end; // InternalCopyData // -procedure TDataContext.InternalCopyData(sourceAddr, destAddr, size : Integer); +procedure TDataContext.InternalCopyData(sourceAddr, destAddr, size : NativeInt); begin DWSCopyData(FData, sourceAddr, destAddr, size); end; // CopyData // -procedure TDataContext.CopyData(const destData : TData; destAddr, size : Integer); +procedure TDataContext.CopyData(const destData : TData; destAddr, size : NativeInt); begin DWSCopyData(FData, FAddr, destData, destAddr, size); end; // CopyData // -procedure TDataContext.CopyData(addr : Integer; const destData : TData; destAddr, size : Integer); +procedure TDataContext.CopyData(addr : NativeInt; const destData : TData; destAddr, size : NativeInt); begin DWSCopyData(FData, FAddr+addr, destData, destAddr, size); end; // CopyData // -procedure TDataContext.CopyData(addr : Integer; const destPVariant : PVariant; size : Integer); +procedure TDataContext.CopyData(addr : NativeInt; const destPVariant : PVariant; size : NativeInt); begin DWSCopyPVariants(@FData[FAddr+addr], destPVariant, size); end; // WriteData // -procedure TDataContext.WriteData(const src : IDataContext; size : Integer); +procedure TDataContext.WriteData(const src : IDataContext; size : NativeInt); begin WriteData(src, 0, size); end; // WriteData // -procedure TDataContext.WriteData(const src : IDataContext; srcAddr, size : Integer); +procedure TDataContext.WriteData(const src : IDataContext; srcAddr, size : NativeInt); var - i : Integer; + i : NativeInt; pDest : PVariant; begin Assert(FAddr + size <= Length(FData)); @@ -864,9 +864,9 @@ procedure TDataContext.WriteData(const src : IDataContext; srcAddr, size : Integ // WriteData // -procedure TDataContext.WriteData(destAddr : Integer; const src : IDataContext; size : Integer); +procedure TDataContext.WriteData(destAddr : NativeInt; const src : IDataContext; size : NativeInt); var - i : Integer; + i : NativeInt; pDest : PVariant; begin Assert(FAddr + destAddr + size <= Length(FData)); @@ -879,37 +879,37 @@ procedure TDataContext.WriteData(destAddr : Integer; const src : IDataContext; s // WriteData // -procedure TDataContext.WriteData(const srcData : TData; srcAddr, size : Integer); +procedure TDataContext.WriteData(const srcData : TData; srcAddr, size : NativeInt); begin DWSCopyData(srcData, srcAddr, FData, FAddr, size); end; // MoveData // -procedure TDataContext.MoveData(srcAddr, destAddr, size : Integer); +procedure TDataContext.MoveData(srcAddr, destAddr, size : NativeInt); begin DWSMoveData(FData, srcAddr, destAddr, size); end; // SameData // -function TDataContext.SameData(addr : Integer; const otherData : TData; otherAddr, size : Integer) : Boolean; +function TDataContext.SameData(addr : NativeInt; const otherData : TData; otherAddr, size : NativeInt) : Boolean; begin Result:=DWSSameData(FData, otherData, FAddr+addr, otherAddr, size); end; // SameData // -function TDataContext.SameData(addr : Integer; const otherData : IDataContext; size : Integer) : Boolean; +function TDataContext.SameData(addr : NativeInt; const otherData : IDataContext; size : NativeInt) : Boolean; begin Result:=DWSSameData(FData, otherData.AsPData^, FAddr+addr, otherData.Addr, size); end; // IndexOfData // -function TDataContext.IndexOfData(const item : IDataContext; fromIndex, toIndex, itemSize : Integer) : Integer; +function TDataContext.IndexOfData(const item : IDataContext; fromIndex, toIndex, itemSize : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; data : PData; begin data := AsPData; @@ -921,9 +921,9 @@ function TDataContext.IndexOfData(const item : IDataContext; fromIndex, toIndex, // IndexOfValue // -function TDataContext.IndexOfValue(const item : Variant; fromIndex, toIndex : Integer) : Integer; +function TDataContext.IndexOfValue(const item : Variant; fromIndex, toIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; data : PData; begin data:=AsPData; @@ -935,9 +935,9 @@ function TDataContext.IndexOfValue(const item : Variant; fromIndex, toIndex : In // IndexOfString // -function TDataContext.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TDataContext.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; varData : PVarData; begin if fromIndexnil then size := elemTyp.Size else size := 0; if size = 1 then begin - elemTypClass := elemTyp.UnAliasedType.ClassType; - if elemTypClass = TBaseStringSymbol then + ct := elemTyp.UnAliasedType.ClassType; + if ct = TBaseStringSymbol then Result := TScriptDynamicNativeStringArray.Create(elemTyp) - else if elemTypClass = TBaseFloatSymbol then + else if ct = TBaseFloatSymbol then Result := TScriptDynamicNativeFloatArray.Create(elemTyp) - else if elemTypClass = TBaseIntegerSymbol then + else if ct = TBaseIntegerSymbol then Result := TScriptDynamicNativeIntegerArray.Create(elemTyp) - else if elemTypClass = TBaseBooleanSymbol then + else if ct = TBaseBooleanSymbol then Result := TScriptDynamicNativeBooleanArray.Create(elemTyp) +// else if ct = TClassSymbol then +// Result := TScriptDynamicNativeObjectArray.Create(elemTyp) + else if ct = TDynamicArraySymbol then + Result := TScriptDynamicNativeDynArrayArray.Create(elemTyp) +// else if ct = TInterfaceSymbol then +// Result := TScriptDynamicNativeInterfaceArray.Create(elemTyp) else Result := TScriptDynamicValueArray.Create(elemTyp) end else Result := TScriptDynamicDataArray.Create(elemTyp); end; // ------------------ -// ------------------ TScriptDynamicArray ------------------ +// ------------------ TScriptDynamicDataArray ------------------ // ------------------ // Create // -constructor TScriptDynamicArray.Create(elemTyp : TTypeSymbol); +constructor TScriptDynamicDataArray.Create(elemTyp : TTypeSymbol); begin inherited Create; FElementTyp := elemTyp; @@ -471,9 +567,9 @@ constructor TScriptDynamicArray.Create(elemTyp : TTypeSymbol); // SetArrayLength // -procedure TScriptDynamicArray.SetArrayLength(n : Integer); +procedure TScriptDynamicDataArray.SetArrayLength(n : NativeInt); var - i : Integer; + i : NativeInt; p : PData; begin SetDataLength(n*ElementSize); @@ -485,112 +581,125 @@ procedure TScriptDynamicArray.SetArrayLength(n : Integer); // GetArrayLength // -function TScriptDynamicArray.GetArrayLength : Integer; +function TScriptDynamicDataArray.GetArrayLength : NativeInt; begin Result:=FArrayLength; end; // SetAsVariant // -procedure TScriptDynamicArray.SetAsVariant(index : Integer; const v : Variant); +procedure TScriptDynamicDataArray.SetAsVariant(index : NativeInt; const v : Variant); begin inherited AsVariant[index] := v; end; // EvalAsVariant // -procedure TScriptDynamicArray.EvalAsVariant(index : Integer; var result : Variant); +procedure TScriptDynamicDataArray.EvalAsVariant(index : NativeInt; var result : Variant); begin inherited EvalAsVariant(index, result); end; // BoundsCheckPassed // -function TScriptDynamicArray.BoundsCheckPassed(index : Integer) : Boolean; +function TScriptDynamicDataArray.BoundsCheckPassed(index : NativeInt) : Boolean; begin Result := Cardinal(index) < Cardinal(FArrayLength); end; // GetAsInteger // -function TScriptDynamicArray.GetAsInteger(index : Integer) : Int64; +function TScriptDynamicDataArray.GetAsInteger(index : NativeInt) : Int64; begin Result := inherited AsInteger[index]; end; // SetAsInteger // -procedure TScriptDynamicArray.SetAsInteger(index : Integer; const v : Int64); +procedure TScriptDynamicDataArray.SetAsInteger(index : NativeInt; const v : Int64); begin inherited AsInteger[index] := v; end; // GetAsFloat // -function TScriptDynamicArray.GetAsFloat(index : Integer) : Double; +function TScriptDynamicDataArray.GetAsFloat(index : NativeInt) : Double; begin Result := inherited AsFloat[index]; end; // SetAsFloat // -procedure TScriptDynamicArray.SetAsFloat(index : Integer; const v : Double); +procedure TScriptDynamicDataArray.SetAsFloat(index : NativeInt; const v : Double); begin inherited AsFloat[index] := v; end; // GetAsBoolean // -function TScriptDynamicArray.GetAsBoolean(index : Integer) : Boolean; +function TScriptDynamicDataArray.GetAsBoolean(index : NativeInt) : Boolean; begin Result := inherited AsBoolean[index]; end; // SetAsBoolean // -procedure TScriptDynamicArray.SetAsBoolean(index : Integer; const v : Boolean); +procedure TScriptDynamicDataArray.SetAsBoolean(index : NativeInt; const v : Boolean); begin inherited AsBoolean[index] := v; end; // SetAsString // -procedure TScriptDynamicArray.SetAsString(index : Integer; const v : String); +procedure TScriptDynamicDataArray.SetAsString(index : NativeInt; const v : String); begin inherited AsString[index] := v; end; // EvalAsString // -procedure TScriptDynamicArray.EvalAsString(index : Integer; var result : String); +procedure TScriptDynamicDataArray.EvalAsString(index : NativeInt; var result : String); begin inherited EvalAsString(index, result); end; // GetAsString // -function TScriptDynamicArray.GetAsString(index : Integer) : String; +function TScriptDynamicDataArray.GetAsString(index : NativeInt) : String; begin EvalAsString(index, Result); end; // SetAsInterface // -procedure TScriptDynamicArray.SetAsInterface(index : Integer; const v : IUnknown); +procedure TScriptDynamicDataArray.SetAsInterface(index : NativeInt; const v : IUnknown); begin inherited AsInterface[index] := v; end; // EvalAsInterface // -procedure TScriptDynamicArray.EvalAsInterface(index : Integer; var result : IUnknown); +procedure TScriptDynamicDataArray.EvalAsInterface(index : NativeInt; var result : IUnknown); begin inherited EvalAsInterface(index, result); end; +// SetFromExpr +// +function TScriptDynamicDataArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +var + v : Variant; +begin + if BoundsCheckPassed(index) then begin + valueExpr.EvalAsVariant(exec, v); + AsVariant[index] := v; + Result := True; + end else Result := False; +end; + // ReplaceData // -procedure TScriptDynamicArray.ReplaceData(const newData : TData); +procedure TScriptDynamicDataArray.ReplaceData(const newData : TData); begin inherited; FArrayLength:=System.Length(newData) div ElementSize; @@ -598,45 +707,37 @@ procedure TScriptDynamicArray.ReplaceData(const newData : TData); // AddStrings // -procedure TScriptDynamicArray.AddStrings(sl : TStrings); +procedure TScriptDynamicDataArray.AddStrings(sl : TStrings); begin DynamicArrayAddStrings(Self, sl); end; -// AsPDouble -// -function TScriptDynamicArray.AsPDouble(var nbElements, stride : Integer) : PDouble; -begin - Assert(False); - Result := nil; -end; - // HashCode // -function TScriptDynamicArray.HashCode(addr : Integer; size : Integer) : Cardinal; +function TScriptDynamicDataArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; begin Result := DWSHashCode(@DirectData[addr], size); end; // VarType // -function TScriptDynamicArray.VarType(addr : Integer) : TVarType; +function TScriptDynamicDataArray.VarType(addr : NativeInt) : TVarType; begin Result := inherited VarType(addr); end; // IsEmpty // -function TScriptDynamicArray.IsEmpty(addr : Integer) : Boolean; +function TScriptDynamicDataArray.IsEmpty(addr : NativeInt) : Boolean; begin Result := inherited IsEmpty(addr); end; // Insert // -procedure TScriptDynamicArray.Insert(index : Integer); +procedure TScriptDynamicDataArray.Insert(index : NativeInt); var - n : Integer; + n : NativeInt; p : PData; begin Inc(FArrayLength); @@ -651,9 +752,9 @@ procedure TScriptDynamicArray.Insert(index : Integer); // Delete // -procedure TScriptDynamicArray.Delete(index, count : Integer); +procedure TScriptDynamicDataArray.Delete(index, count : NativeInt); var - i, d : Integer; + i, d : NativeInt; p : PData; begin if count<=0 then Exit; @@ -670,11 +771,30 @@ procedure TScriptDynamicArray.Delete(index, count : Integer); SetDataLength(FArrayLength*ElementSize); end; +// Swap +// +procedure TScriptDynamicDataArray.Swap(i1, i2 : NativeInt); +var + i : NativeInt; + elem1, elem2 : PVarData; + buf : TVarData; +begin + elem1:=@DirectData[i1*ElementSize]; + elem2:=@DirectData[i2*ElementSize]; + for i:=1 to ElementSize do begin + buf:=elem1^; + elem1^:=elem2^; + elem2^:=buf; + Inc(elem1); + Inc(elem2); + end; +end; + // Reverse // -procedure TScriptDynamicArray.Reverse; +procedure TScriptDynamicDataArray.Reverse; var - t, b : Integer; + t, b : NativeInt; begin t:=ArrayLength-1; b:=0; @@ -687,44 +807,51 @@ procedure TScriptDynamicArray.Reverse; // NaturalSort // -procedure TScriptDynamicArray.NaturalSort; +procedure TScriptDynamicDataArray.NaturalSort; begin Assert(False); end; // IndexOfValue // -function TScriptDynamicArray.IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicDataArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := inherited IndexOfValue(item, fromIndex, FArrayLength-1) end; // IndexOfInteger // -function TScriptDynamicArray.IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; +function TScriptDynamicDataArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; begin Result := inherited IndexOfValue(item, fromIndex, FArrayLength-1); end; // IndexOfFloat // -function TScriptDynamicArray.IndexOfFloat(item : Double; fromIndex : Integer) : Integer; +function TScriptDynamicDataArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; begin Result := inherited IndexOfValue(item, fromIndex, FArrayLength-1); end; // IndexOfString // -function TScriptDynamicArray.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TScriptDynamicDataArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; +begin + Result := inherited IndexOfValue(item, fromIndex, FArrayLength-1); +end; + +// IndexOfInterface +// +function TScriptDynamicDataArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; begin Result := inherited IndexOfValue(item, fromIndex, FArrayLength-1); end; // IndexOfFuncPtr // -function TScriptDynamicArray.IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicDataArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; itemFunc : IFuncPointer; p : PVarData; begin @@ -745,7 +872,7 @@ function TScriptDynamicArray.IndexOfFuncPtr(const item : Variant; fromIndex : In // Copy // -procedure TScriptDynamicArray.Copy(src : TScriptDynamicArray; index, count : Integer); +procedure TScriptDynamicDataArray.Copy(src : TScriptDynamicDataArray; index, count : NativeInt); begin ArrayLength := count; WriteData(src, index*ElementSize, count*ElementSize); @@ -753,14 +880,14 @@ procedure TScriptDynamicArray.Copy(src : TScriptDynamicArray; index, count : Int // Concat // -procedure TScriptDynamicArray.Concat(const src : IScriptDynArray; index, size : Integer); +procedure TScriptDynamicDataArray.Concat(const src : IScriptDynArray; index, size : NativeInt); var - n : Integer; - srcDyn : TScriptDynamicArray; + n : NativeInt; + srcDyn : TScriptDynamicDataArray; begin Assert(src.GetSelf.ClassType = Self.ClassType); Assert(index >= 0); - srcDyn := TScriptDynamicArray(src.GetSelf); + srcDyn := TScriptDynamicDataArray(src.GetSelf); if size > srcDyn.ArrayLength - index then size := srcDyn.ArrayLength - index; if size > 0 then begin @@ -773,23 +900,23 @@ procedure TScriptDynamicArray.Concat(const src : IScriptDynArray; index, size : // MoveItem // -procedure TScriptDynamicArray.MoveItem(srcIndex, dstIndex : Integer); +procedure TScriptDynamicDataArray.MoveItem(srcIndex, dstIndex : NativeInt); begin MoveData(srcIndex*ElementSize, dstIndex*ElementSize, ElementSize); end; // ToString // -function TScriptDynamicArray.ToString : String; +function TScriptDynamicDataArray.ToString : String; begin Result := 'array of '+FElementTyp.Name; end; // ToStringArray // -function TScriptDynamicArray.ToStringArray : TStringDynArray; +function TScriptDynamicDataArray.ToStringArray : TStringDynArray; var - i : Integer; + i : NativeInt; begin Assert(FElementTyp.BaseType.ClassType=TBaseStringSymbol); @@ -800,9 +927,9 @@ function TScriptDynamicArray.ToStringArray : TStringDynArray; // ToInt64Array // -function TScriptDynamicArray.ToInt64Array : TInt64DynArray; +function TScriptDynamicDataArray.ToInt64Array : TInt64DynArray; var - i : Integer; + i : NativeInt; begin Assert(FElementTyp.BaseType.ClassType=TBaseIntegerSymbol); @@ -813,9 +940,9 @@ function TScriptDynamicArray.ToInt64Array : TInt64DynArray; // ToData // -function TScriptDynamicArray.ToData : TData; +function TScriptDynamicDataArray.ToData : TData; var - i, j, p : Integer; + i, j, p : NativeInt; begin System.SetLength(Result, ArrayLength*ElementSize); p := 0; @@ -829,14 +956,14 @@ function TScriptDynamicArray.ToData : TData; // GetElementSize // -function TScriptDynamicArray.GetElementSize : Integer; +function TScriptDynamicDataArray.GetElementSize : Integer; begin Result:=FElementSize; end; // GetElementType // -function TScriptDynamicArray.GetElementType : TTypeSymbol; +function TScriptDynamicDataArray.GetElementType : TTypeSymbol; begin Result := FElementTyp; end; @@ -849,7 +976,7 @@ function TScriptDynamicArray.GetElementType : TTypeSymbol; // procedure TScriptDynamicValueArray.ReplaceData(const newData : TData); var - i, n : Integer; + i, n : NativeInt; begin n := Length(newData); ArrayLength := n; @@ -859,95 +986,17 @@ procedure TScriptDynamicValueArray.ReplaceData(const newData : TData); // Swap // -procedure TScriptDynamicValueArray.Swap(i1, i2 : Integer); +procedure TScriptDynamicValueArray.Swap(i1, i2 : NativeInt); var elem1, elem2 : PVarData; buf : TVarData; begin - elem1:=@DirectData[i1]; - elem2:=@DirectData[i2]; - buf.VType:=elem1^.VType; - buf.VInt64:=elem1^.VInt64; - elem1^.VType:=elem2^.VType; - elem1^.VInt64:=elem2^.VInt64; - elem2^.VType:=buf.VType; - elem2^.VInt64:=buf.VInt64; -end; - -// CompareString -// -function TScriptDynamicValueArray.CompareString(i1, i2 : Integer) : Integer; -var - p : PVarDataArray; - v1, v2 : PVarData; -begin - p:=@DirectData[0]; - v1:=@p[i1]; - v2:=@p[i2]; - {$ifdef FPC} - Assert((v1.VType=varString) and (v2.VType=varString)); - Result:=UnicodeCompareStr(String(v1.VString), String(v2.VString)); - {$else} - Assert((v1.VType=varUString) and (v2.VType=varUString)); - Result:=UnicodeCompareStr(String(v1.VUString), String(v2.VUString)); - {$endif} -end; - -// CompareInteger -// -function TScriptDynamicValueArray.CompareInteger(i1, i2 : Integer) : Integer; -var - p : PVarDataArray; - v1, v2 : PVarData; -begin - p:=@DirectData[0]; - v1:=@p[i1]; - v2:=@p[i2]; - if (v1.VType=varInt64) and (v2.VType=varInt64) then begin - end else - Assert((v1.VType=varInt64) and (v2.VType=varInt64)); - if v1.VInt64v2.VInt64); -end; - -// CompareFloat -// -function TScriptDynamicValueArray.CompareFloat(i1, i2 : Integer) : Integer; -var - p : PVarDataArray; - v1, v2 : PVarData; -begin - p:=@DirectData[0]; - v1:=@p[i1]; - v2:=@p[i2]; - Assert((v1.VType=varDouble) and (v2.VType=varDouble)); - if v1.VDoublev2.VDouble); -end; - -// ------------------ -// ------------------ TScriptDynamicDataArray ------------------ -// ------------------ + elem1 := @DirectData[i1]; + elem2 := @DirectData[i2]; -// Swap -// -procedure TScriptDynamicDataArray.Swap(i1, i2 : Integer); -var - i : Integer; - elem1, elem2 : PVarData; - buf : TVarData; -begin - elem1:=@DirectData[i1*ElementSize]; - elem2:=@DirectData[i2*ElementSize]; - for i:=1 to ElementSize do begin - buf:=elem1^; - elem1^:=elem2^; - elem2^:=buf; - Inc(elem1); - Inc(elem2); - end; + buf := elem1^; + elem1^ := elem2^; + elem2^ := buf; end; // ------------------ @@ -960,7 +1009,14 @@ constructor TScriptDynamicNativeArray.Create(elemTyp : TTypeSymbol); begin inherited Create; FElementTyp := elemTyp; - Assert(elemTyp.Size = 1); + Assert((elemTyp = nil) or (elemTyp.Size = 1)); +end; + +// GetSelf +// +function TScriptDynamicNativeArray.GetSelf : TObject; +begin + Result := Self; end; // ToString @@ -972,7 +1028,7 @@ function TScriptDynamicNativeArray.ToString : String; // BoundsCheckPassed // -function TScriptDynamicNativeArray.BoundsCheckPassed(index : Integer) : Boolean; +function TScriptDynamicNativeArray.BoundsCheckPassed(index : NativeInt) : Boolean; begin Result := Cardinal(index) < Cardinal(FArrayLength); end; @@ -993,7 +1049,7 @@ function TScriptDynamicNativeArray.GetElementType : TTypeSymbol; // GetArrayLength // -function TScriptDynamicNativeArray.GetArrayLength : Integer; +function TScriptDynamicNativeArray.GetArrayLength : NativeInt; begin Result := FArrayLength; end; @@ -1004,7 +1060,7 @@ function TScriptDynamicNativeArray.GetArrayLength : Integer; // SetArrayLength // -procedure TScriptDynamicNativeIntegerArray.SetArrayLength(n : Integer); +procedure TScriptDynamicNativeIntegerArray.SetArrayLength(n : NativeInt); begin SetLength(FData, n); if n > FArrayLength then @@ -1016,7 +1072,7 @@ procedure TScriptDynamicNativeIntegerArray.SetArrayLength(n : Integer); // function TScriptDynamicNativeIntegerArray.ToStringArray : TStringDynArray; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1034,7 +1090,7 @@ function TScriptDynamicNativeIntegerArray.ToInt64Array : TInt64DynArray; // function TScriptDynamicNativeIntegerArray.ToData : TData; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1043,7 +1099,7 @@ function TScriptDynamicNativeIntegerArray.ToData : TData; // Insert // -procedure TScriptDynamicNativeIntegerArray.Insert(index : Integer); +procedure TScriptDynamicNativeIntegerArray.Insert(index : NativeInt); begin System.Insert(0, FData, index); Inc(FArrayLength); @@ -1051,15 +1107,15 @@ procedure TScriptDynamicNativeIntegerArray.Insert(index : Integer); // Delete // -procedure TScriptDynamicNativeIntegerArray.Delete(index, count : Integer); +procedure TScriptDynamicNativeIntegerArray.Delete(index, count : NativeInt); begin System.Delete(FData, index, count); - Dec(FArrayLength); + Dec(FArrayLength, count); end; // MoveItem // -procedure TScriptDynamicNativeIntegerArray.MoveItem(source, destination : Integer); +procedure TScriptDynamicNativeIntegerArray.MoveItem(source, destination : NativeInt); var buf : Int64; begin @@ -1074,7 +1130,7 @@ procedure TScriptDynamicNativeIntegerArray.MoveItem(source, destination : Intege // Swap // -procedure TScriptDynamicNativeIntegerArray.Swap(index1, index2 : Integer); +procedure TScriptDynamicNativeIntegerArray.Swap(index1, index2 : NativeInt); var buf : Int64; begin @@ -1085,16 +1141,16 @@ procedure TScriptDynamicNativeIntegerArray.Swap(index1, index2 : Integer); // IndexOfValue // -function TScriptDynamicNativeIntegerArray.IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfInteger(VariantToInt64(item), fromIndex); end; // IndexOfInteger // -function TScriptDynamicNativeIntegerArray.IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; begin if fromIndex < 0 then fromIndex := 0; @@ -1107,7 +1163,7 @@ function TScriptDynamicNativeIntegerArray.IndexOfInteger(item : Int64; fromIndex // IndexOfFloat // -function TScriptDynamicNativeIntegerArray.IndexOfFloat(item : Double; fromIndex : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; var i : Int64; begin @@ -1119,23 +1175,30 @@ function TScriptDynamicNativeIntegerArray.IndexOfFloat(item : Double; fromIndex // IndexOfString // -function TScriptDynamicNativeIntegerArray.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfInteger(StrToInt64(item), fromIndex); end; +// IndexOfInterface +// +function TScriptDynamicNativeIntegerArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + // IndexOfFuncPtr // -function TScriptDynamicNativeIntegerArray.IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := -1; end; // WriteData // -procedure TScriptDynamicNativeIntegerArray.WriteData(const src : TData; srcAddr, size : Integer); +procedure TScriptDynamicNativeIntegerArray.WriteData(const src : TData; srcAddr, size : NativeInt); var - i : Integer; + i : NativeInt; begin for i := 0 to size-1 do VariantToInt64(src[i + srcAddr], FData[i]); @@ -1145,18 +1208,17 @@ procedure TScriptDynamicNativeIntegerArray.WriteData(const src : TData; srcAddr, // procedure TScriptDynamicNativeIntegerArray.ReplaceData(const v : TData); begin - FArrayLength := Length(v); - SetLength(FData, FArrayLength); + SetArrayLength(Length(v)); WriteData(v, 0, FArrayLength); end; // Concat // -procedure TScriptDynamicNativeIntegerArray.Concat(const src : IScriptDynArray; index, size : Integer); +procedure TScriptDynamicNativeIntegerArray.Concat(const src : IScriptDynArray; index, size : NativeInt); var srcSelf : TObject; srcDyn : TScriptDynamicNativeIntegerArray; - n : Integer; + n : NativeInt; begin srcSelf := src.GetSelf; Assert(srcSelf.ClassType = TScriptDynamicNativeIntegerArray); @@ -1167,8 +1229,7 @@ procedure TScriptDynamicNativeIntegerArray.Concat(const src : IScriptDynArray; i size := srcDyn.ArrayLength - index; if size > 0 then begin n := FArrayLength; - FArrayLength := n + size; - SetLength(FData, FArrayLength); + SetArrayLength(n + size); System.Move(srcDyn.FData[index], FData[n], size*SizeOf(Int64)); end; end; @@ -1195,7 +1256,7 @@ procedure TScriptDynamicNativeIntegerArray.Reverse; // Compare // -function TScriptDynamicNativeIntegerArray.Compare(index1, index2 : Integer) : Integer; +function TScriptDynamicNativeIntegerArray.Compare(index1, index2 : NativeInt) : Integer; var n1, n2 : Int64; begin @@ -1224,117 +1285,119 @@ procedure TScriptDynamicNativeIntegerArray.AddStrings(sl : TStrings); DynamicArrayAddStrings(Self, sl); end; -// AsPDouble -// -function TScriptDynamicNativeIntegerArray.AsPDouble(var nbElements, stride : Integer) : PDouble; -begin - Assert(False); - Result := nil; -end; - // GetAsFloat // -function TScriptDynamicNativeIntegerArray.GetAsFloat(index : Integer) : Double; +function TScriptDynamicNativeIntegerArray.GetAsFloat(index : NativeInt) : Double; begin Result := FData[index]; end; // SetAsFloat // -procedure TScriptDynamicNativeIntegerArray.SetAsFloat(index : Integer; const v : Double); +procedure TScriptDynamicNativeIntegerArray.SetAsFloat(index : NativeInt; const v : Double); begin FData[index] := Round(v); end; // GetAsInteger // -function TScriptDynamicNativeIntegerArray.GetAsInteger(index : Integer) : Int64; +function TScriptDynamicNativeIntegerArray.GetAsInteger(index : NativeInt) : Int64; begin Result := FData[index]; end; // SetAsInteger // -procedure TScriptDynamicNativeIntegerArray.SetAsInteger(index : Integer; const v : Int64); +procedure TScriptDynamicNativeIntegerArray.SetAsInteger(index : NativeInt; const v : Int64); begin FData[index] := v; end; // GetAsBoolean // -function TScriptDynamicNativeIntegerArray.GetAsBoolean(index : Integer) : Boolean; +function TScriptDynamicNativeIntegerArray.GetAsBoolean(index : NativeInt) : Boolean; begin Result := FData[index] <> 0; end; // SetAsBoolean // -procedure TScriptDynamicNativeIntegerArray.SetAsBoolean(index : Integer; const v : Boolean); +procedure TScriptDynamicNativeIntegerArray.SetAsBoolean(index : NativeInt; const v : Boolean); begin FData[index] := Ord(v); end; // SetAsVariant // -procedure TScriptDynamicNativeIntegerArray.SetAsVariant(index : Integer; const v : Variant); +procedure TScriptDynamicNativeIntegerArray.SetAsVariant(index : NativeInt; const v : Variant); begin FData[index] := VariantToInt64(v); end; // EvalAsVariant // -procedure TScriptDynamicNativeIntegerArray.EvalAsVariant(index : Integer; var result : Variant); +procedure TScriptDynamicNativeIntegerArray.EvalAsVariant(index : NativeInt; var result : Variant); begin VarCopySafe(result, FData[index]); end; // SetAsString // -procedure TScriptDynamicNativeIntegerArray.SetAsString(index : Integer; const v : String); +procedure TScriptDynamicNativeIntegerArray.SetAsString(index : NativeInt; const v : String); begin FData[index] := StrToInt64(v); end; // EvalAsString // -procedure TScriptDynamicNativeIntegerArray.EvalAsString(index : Integer; var result : String); +procedure TScriptDynamicNativeIntegerArray.EvalAsString(index : NativeInt; var result : String); begin result := IntToStr(FData[index]); end; // SetAsInterface // -procedure TScriptDynamicNativeIntegerArray.SetAsInterface(index : Integer; const v : IUnknown); +procedure TScriptDynamicNativeIntegerArray.SetAsInterface(index : NativeInt; const v : IUnknown); begin Assert(False); end; // EvalAsInterface // -procedure TScriptDynamicNativeIntegerArray.EvalAsInterface(index : Integer; var result : IUnknown); +procedure TScriptDynamicNativeIntegerArray.EvalAsInterface(index : NativeInt; var result : IUnknown); begin Assert(False); end; +// SetFromExpr +// +function TScriptDynamicNativeIntegerArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + FData[index] := valueExpr.EvalAsInteger(exec); + Result := True; + end else Result := False; +end; + // IsEmpty // -function TScriptDynamicNativeIntegerArray.IsEmpty(addr : Integer) : Boolean; +function TScriptDynamicNativeIntegerArray.IsEmpty(addr : NativeInt) : Boolean; begin Result := False; end; // VarType // -function TScriptDynamicNativeIntegerArray.VarType(addr : Integer) : TVarType; +function TScriptDynamicNativeIntegerArray.VarType(addr : NativeInt) : TVarType; begin Result := vtInt64; end; // HashCode // -function TScriptDynamicNativeIntegerArray.HashCode(addr : Integer; size : Integer) : Cardinal; +function TScriptDynamicNativeIntegerArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := 0 to FArrayLength-1 do @@ -1347,7 +1410,7 @@ function TScriptDynamicNativeIntegerArray.HashCode(addr : Integer; size : Intege // procedure TScriptDynamicNativeIntegerArray.WriteToJSON(writer : TdwsJSONWriter); var - i : Integer; + i : NativeInt; begin writer.BeginArray; for i := 0 to FArrayLength-1 do @@ -1355,13 +1418,26 @@ procedure TScriptDynamicNativeIntegerArray.WriteToJSON(writer : TdwsJSONWriter); writer.EndArray; end; +// InterfaceToDataOffset +// +class function TScriptDynamicNativeIntegerArray.InterfaceToDataOffset : Integer; +// Here be dragons! This is used for JIT casting of interface to field offset, this is a hack +var + instance : TScriptDynamicNativeIntegerArray; + intf : IScriptDynArray; +begin + instance := TScriptDynamicNativeIntegerArray.Create(nil); + intf := instance; + Result := NativeInt(@instance.FData) - NativeInt(intf); +end; + // ------------------ // ------------------ TScriptDynamicNativeFloatArray ------------------ // ------------------ // SetArrayLength // -procedure TScriptDynamicNativeFloatArray.SetArrayLength(n : Integer); +procedure TScriptDynamicNativeFloatArray.SetArrayLength(n : NativeInt); begin SetLength(FData, n); if n > FArrayLength then @@ -1373,7 +1449,7 @@ procedure TScriptDynamicNativeFloatArray.SetArrayLength(n : Integer); // function TScriptDynamicNativeFloatArray.ToStringArray : TStringDynArray; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1384,7 +1460,7 @@ function TScriptDynamicNativeFloatArray.ToStringArray : TStringDynArray; // function TScriptDynamicNativeFloatArray.ToInt64Array : TInt64DynArray; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1395,7 +1471,7 @@ function TScriptDynamicNativeFloatArray.ToInt64Array : TInt64DynArray; // function TScriptDynamicNativeFloatArray.ToData : TData; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1404,7 +1480,7 @@ function TScriptDynamicNativeFloatArray.ToData : TData; // Insert // -procedure TScriptDynamicNativeFloatArray.Insert(index : Integer); +procedure TScriptDynamicNativeFloatArray.Insert(index : NativeInt); begin System.Insert(0, FData, index); Inc(FArrayLength); @@ -1412,15 +1488,15 @@ procedure TScriptDynamicNativeFloatArray.Insert(index : Integer); // Delete // -procedure TScriptDynamicNativeFloatArray.Delete(index, count : Integer); +procedure TScriptDynamicNativeFloatArray.Delete(index, count : NativeInt); begin System.Delete(FData, index, count); - Dec(FArrayLength); + Dec(FArrayLength, count); end; // MoveItem // -procedure TScriptDynamicNativeFloatArray.MoveItem(source, destination : Integer); +procedure TScriptDynamicNativeFloatArray.MoveItem(source, destination : NativeInt); var buf : Double; begin @@ -1435,7 +1511,7 @@ procedure TScriptDynamicNativeFloatArray.MoveItem(source, destination : Integer) // Swap // -procedure TScriptDynamicNativeFloatArray.Swap(index1, index2 : Integer); +procedure TScriptDynamicNativeFloatArray.Swap(index1, index2 : NativeInt); var buf : Double; begin @@ -1446,23 +1522,23 @@ procedure TScriptDynamicNativeFloatArray.Swap(index1, index2 : Integer); // IndexOfValue // -function TScriptDynamicNativeFloatArray.IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeFloatArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfFloat(VariantToInt64(item), fromIndex); end; // IndexOfInteger // -function TScriptDynamicNativeFloatArray.IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; +function TScriptDynamicNativeFloatArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfFloat(item, fromIndex); end; // IndexOfFloat // -function TScriptDynamicNativeFloatArray.IndexOfFloat(item : Double; fromIndex : Integer) : Integer; +function TScriptDynamicNativeFloatArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; begin if fromIndex < 0 then fromIndex := 0; @@ -1475,23 +1551,30 @@ function TScriptDynamicNativeFloatArray.IndexOfFloat(item : Double; fromIndex : // IndexOfString // -function TScriptDynamicNativeFloatArray.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TScriptDynamicNativeFloatArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfFloat(StrToFloat(item), fromIndex); end; +// IndexOfInterface +// +function TScriptDynamicNativeFloatArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + // IndexOfFuncPtr // -function TScriptDynamicNativeFloatArray.IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeFloatArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := -1; end; // WriteData // -procedure TScriptDynamicNativeFloatArray.WriteData(const src : TData; srcAddr, size : Integer); +procedure TScriptDynamicNativeFloatArray.WriteData(const src : TData; srcAddr, size : NativeInt); var - i : Integer; + i : NativeInt; begin for i := 0 to size-1 do FData[i] := VariantToFloat(src[i + srcAddr]); @@ -1501,18 +1584,17 @@ procedure TScriptDynamicNativeFloatArray.WriteData(const src : TData; srcAddr, s // procedure TScriptDynamicNativeFloatArray.ReplaceData(const v : TData); begin - FArrayLength := Length(v); - SetLength(FData, FArrayLength); + SetArrayLength(Length(v)); WriteData(v, 0, FArrayLength); end; // Concat // -procedure TScriptDynamicNativeFloatArray.Concat(const src : IScriptDynArray; index, size : Integer); +procedure TScriptDynamicNativeFloatArray.Concat(const src : IScriptDynArray; index, size : NativeInt); var srcSelf : TObject; srcDyn : TScriptDynamicNativeFloatArray; - n : Integer; + n : NativeInt; begin srcSelf := src.GetSelf; Assert(srcSelf.ClassType = TScriptDynamicNativeFloatArray); @@ -1523,8 +1605,7 @@ procedure TScriptDynamicNativeFloatArray.Concat(const src : IScriptDynArray; ind size := srcDyn.ArrayLength - index; if size > 0 then begin n := FArrayLength; - FArrayLength := n + size; - SetLength(FData, FArrayLength); + SetArrayLength(n + size); System.Move(srcDyn.FData[index], FData[n], size*SizeOf(Double)); end; end; @@ -1551,7 +1632,7 @@ procedure TScriptDynamicNativeFloatArray.Reverse; // Compare // -function TScriptDynamicNativeFloatArray.Compare(index1, index2 : Integer) : Integer; +function TScriptDynamicNativeFloatArray.Compare(index1, index2 : NativeInt) : Integer; var n1, n2 : Double; begin @@ -1582,7 +1663,7 @@ procedure TScriptDynamicNativeFloatArray.AddStrings(sl : TStrings); // AsPDouble // -function TScriptDynamicNativeFloatArray.AsPDouble(var nbElements, stride : Integer) : PDouble; +function TScriptDynamicNativeFloatArray.AsPDouble(var nbElements, stride : NativeInt) : PDouble; begin Result := Pointer(FData); nbElements := FArrayLength; @@ -1591,107 +1672,117 @@ function TScriptDynamicNativeFloatArray.AsPDouble(var nbElements, stride : Integ // GetAsFloat // -function TScriptDynamicNativeFloatArray.GetAsFloat(index : Integer) : Double; +function TScriptDynamicNativeFloatArray.GetAsFloat(index : NativeInt) : Double; begin Result := FData[index]; end; // SetAsFloat // -procedure TScriptDynamicNativeFloatArray.SetAsFloat(index : Integer; const v : Double); +procedure TScriptDynamicNativeFloatArray.SetAsFloat(index : NativeInt; const v : Double); begin FData[index] := v; end; // GetAsInteger // -function TScriptDynamicNativeFloatArray.GetAsInteger(index : Integer) : Int64; +function TScriptDynamicNativeFloatArray.GetAsInteger(index : NativeInt) : Int64; begin Result := Round(FData[index]); end; // SetAsInteger // -procedure TScriptDynamicNativeFloatArray.SetAsInteger(index : Integer; const v : Int64); +procedure TScriptDynamicNativeFloatArray.SetAsInteger(index : NativeInt; const v : Int64); begin FData[index] := v; end; // GetAsBoolean // -function TScriptDynamicNativeFloatArray.GetAsBoolean(index : Integer) : Boolean; +function TScriptDynamicNativeFloatArray.GetAsBoolean(index : NativeInt) : Boolean; begin Result := FData[index] <> 0; end; // SetAsBoolean // -procedure TScriptDynamicNativeFloatArray.SetAsBoolean(index : Integer; const v : Boolean); +procedure TScriptDynamicNativeFloatArray.SetAsBoolean(index : NativeInt; const v : Boolean); begin FData[index] := Ord(v); end; // SetAsVariant // -procedure TScriptDynamicNativeFloatArray.SetAsVariant(index : Integer; const v : Variant); +procedure TScriptDynamicNativeFloatArray.SetAsVariant(index : NativeInt; const v : Variant); begin FData[index] := VariantToFloat(v); end; // EvalAsVariant // -procedure TScriptDynamicNativeFloatArray.EvalAsVariant(index : Integer; var result : Variant); +procedure TScriptDynamicNativeFloatArray.EvalAsVariant(index : NativeInt; var result : Variant); begin VarCopySafe(result, FData[index]); end; // SetAsString // -procedure TScriptDynamicNativeFloatArray.SetAsString(index : Integer; const v : String); +procedure TScriptDynamicNativeFloatArray.SetAsString(index : NativeInt; const v : String); begin FData[index] := StrToFloat(v); end; // EvalAsString // -procedure TScriptDynamicNativeFloatArray.EvalAsString(index : Integer; var result : String); +procedure TScriptDynamicNativeFloatArray.EvalAsString(index : NativeInt; var result : String); begin FastFloatToStr(FData[index], result, FormatSettings); end; // SetAsInterface // -procedure TScriptDynamicNativeFloatArray.SetAsInterface(index : Integer; const v : IUnknown); +procedure TScriptDynamicNativeFloatArray.SetAsInterface(index : NativeInt; const v : IUnknown); begin Assert(False); end; // EvalAsInterface // -procedure TScriptDynamicNativeFloatArray.EvalAsInterface(index : Integer; var result : IUnknown); +procedure TScriptDynamicNativeFloatArray.EvalAsInterface(index : NativeInt; var result : IUnknown); begin Assert(False); end; +// SetFromExpr +// +function TScriptDynamicNativeFloatArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + FData[index] := valueExpr.EvalAsFloat(exec); + Result := True; + end else Result := False; +end; + // IsEmpty // -function TScriptDynamicNativeFloatArray.IsEmpty(addr : Integer) : Boolean; +function TScriptDynamicNativeFloatArray.IsEmpty(addr : NativeInt) : Boolean; begin Result := False; end; // VarType // -function TScriptDynamicNativeFloatArray.VarType(addr : Integer) : TVarType; +function TScriptDynamicNativeFloatArray.VarType(addr : NativeInt) : TVarType; begin Result := varDouble; end; // HashCode // -function TScriptDynamicNativeFloatArray.HashCode(addr : Integer; size : Integer) : Cardinal; +function TScriptDynamicNativeFloatArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := 0 to FArrayLength-1 do @@ -1704,7 +1795,7 @@ function TScriptDynamicNativeFloatArray.HashCode(addr : Integer; size : Integer) // procedure TScriptDynamicNativeFloatArray.WriteToJSON(writer : TdwsJSONWriter); var - i : Integer; + i : NativeInt; begin writer.BeginArray; for i := 0 to FArrayLength-1 do @@ -1712,13 +1803,26 @@ procedure TScriptDynamicNativeFloatArray.WriteToJSON(writer : TdwsJSONWriter); writer.EndArray; end; +// InterfaceToDataOffset +// +class function TScriptDynamicNativeFloatArray.InterfaceToDataOffset : Integer; +// Here be dragons! This is used for JIT casting of interface to field offset, this is a hack +var + instance : TScriptDynamicNativeFloatArray; + intf : IScriptDynArray; +begin + instance := TScriptDynamicNativeFloatArray.Create(nil); + intf := instance; + Result := NativeInt(@instance.FData) - NativeInt(intf); +end; + // ------------------ // ------------------ TScriptDynamicNativeStringArray ------------------ // ------------------ // SetArrayLength // -procedure TScriptDynamicNativeStringArray.SetArrayLength(n : Integer); +procedure TScriptDynamicNativeStringArray.SetArrayLength(n : NativeInt); begin SetLength(FData, n); FArrayLength := n; @@ -1735,7 +1839,7 @@ function TScriptDynamicNativeStringArray.ToStringArray : TStringDynArray; // function TScriptDynamicNativeStringArray.ToInt64Array : TInt64DynArray; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1746,7 +1850,7 @@ function TScriptDynamicNativeStringArray.ToInt64Array : TInt64DynArray; // function TScriptDynamicNativeStringArray.ToData : TData; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do @@ -1755,7 +1859,7 @@ function TScriptDynamicNativeStringArray.ToData : TData; // Insert // -procedure TScriptDynamicNativeStringArray.Insert(index : Integer); +procedure TScriptDynamicNativeStringArray.Insert(index : NativeInt); begin System.Insert('', FData, index); Inc(FArrayLength); @@ -1763,15 +1867,15 @@ procedure TScriptDynamicNativeStringArray.Insert(index : Integer); // Delete // -procedure TScriptDynamicNativeStringArray.Delete(index, count : Integer); +procedure TScriptDynamicNativeStringArray.Delete(index, count : NativeInt); begin System.Delete(FData, index, count); - Dec(FArrayLength); + Dec(FArrayLength, count); end; // MoveItem // -procedure TScriptDynamicNativeStringArray.MoveItem(source, destination : Integer); +procedure TScriptDynamicNativeStringArray.MoveItem(source, destination : NativeInt); var buf : Pointer; begin @@ -1786,7 +1890,7 @@ procedure TScriptDynamicNativeStringArray.MoveItem(source, destination : Integer // Swap // -procedure TScriptDynamicNativeStringArray.Swap(index1, index2 : Integer); +procedure TScriptDynamicNativeStringArray.Swap(index1, index2 : NativeInt); var buf : Pointer; begin @@ -1797,30 +1901,30 @@ procedure TScriptDynamicNativeStringArray.Swap(index1, index2 : Integer); // IndexOfValue // -function TScriptDynamicNativeStringArray.IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeStringArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfString(VariantToString(item), fromIndex); end; // IndexOfInteger // -function TScriptDynamicNativeStringArray.IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; +function TScriptDynamicNativeStringArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfString(IntToStr(item), fromIndex); end; // IndexOfFloat // -function TScriptDynamicNativeStringArray.IndexOfFloat(item : Double; fromIndex : Integer) : Integer; +function TScriptDynamicNativeStringArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfString(FloatToStr(item), fromIndex); end; // IndexOfString // -function TScriptDynamicNativeStringArray.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TScriptDynamicNativeStringArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; var - i : Integer; + i : NativeInt; begin if fromIndex < 0 then fromIndex := 0; @@ -1831,18 +1935,25 @@ function TScriptDynamicNativeStringArray.IndexOfString(const item : String; from Result := -1; end; +// IndexOfInterface +// +function TScriptDynamicNativeStringArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + // IndexOfFuncPtr // -function TScriptDynamicNativeStringArray.IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeStringArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := -1; end; // WriteData // -procedure TScriptDynamicNativeStringArray.WriteData(const src : TData; srcAddr, size : Integer); +procedure TScriptDynamicNativeStringArray.WriteData(const src : TData; srcAddr, size : NativeInt); var - i : Integer; + i : NativeInt; begin for i := 0 to size-1 do FData[i] := VariantToString(src[i + srcAddr]); @@ -1852,18 +1963,17 @@ procedure TScriptDynamicNativeStringArray.WriteData(const src : TData; srcAddr, // procedure TScriptDynamicNativeStringArray.ReplaceData(const v : TData); begin - FArrayLength := Length(v); - SetLength(FData, FArrayLength); + SetArrayLength(Length(v)); WriteData(v, 0, FArrayLength); end; // Concat // -procedure TScriptDynamicNativeStringArray.Concat(const src : IScriptDynArray; index, size : Integer); +procedure TScriptDynamicNativeStringArray.Concat(const src : IScriptDynArray; index, size : NativeInt); var srcSelf : TObject; srcDyn : TScriptDynamicNativeStringArray; - n, i : Integer; + n, i : NativeInt; begin srcSelf := src.GetSelf; Assert(srcSelf.ClassType = TScriptDynamicNativeStringArray); @@ -1874,8 +1984,7 @@ procedure TScriptDynamicNativeStringArray.Concat(const src : IScriptDynArray; in size := srcDyn.ArrayLength - index; if size > 0 then begin n := FArrayLength; - FArrayLength := n + size; - SetLength(FData, FArrayLength); + SetArrayLength(n + size); for i := 0 to size-1 do FData[n + i] := srcDyn.FData[index + i]; end; @@ -1903,7 +2012,7 @@ procedure TScriptDynamicNativeStringArray.Reverse; // Compare // -function TScriptDynamicNativeStringArray.Compare(index1, index2 : Integer) : Integer; +function TScriptDynamicNativeStringArray.Compare(index1, index2 : NativeInt) : Integer; begin Result := CompareStr(FData[index1], FData[index2]); end; @@ -1923,61 +2032,52 @@ procedure TScriptDynamicNativeStringArray.NaturalSort; // procedure TScriptDynamicNativeStringArray.AddStrings(sl : TStrings); var - i, n : Integer; + i, n : NativeInt; begin n := FArrayLength; - FArrayLength := n + sl.Count; - SetLength(FData, FArrayLength); + SetArrayLength(n + sl.Count); for i := 0 to sl.Count-1 do FData[i+n] := sl[i]; end; -// AsPDouble -// -function TScriptDynamicNativeStringArray.AsPDouble(var nbElements, stride : Integer) : PDouble; -begin - Assert(False); - Result := nil; -end; - // GetAsFloat // -function TScriptDynamicNativeStringArray.GetAsFloat(index : Integer) : Double; +function TScriptDynamicNativeStringArray.GetAsFloat(index : NativeInt) : Double; begin Result := StrToFloat(FData[index]); end; // SetAsFloat // -procedure TScriptDynamicNativeStringArray.SetAsFloat(index : Integer; const v : Double); +procedure TScriptDynamicNativeStringArray.SetAsFloat(index : NativeInt; const v : Double); begin FData[index] := FloatToStr(v); end; // GetAsInteger // -function TScriptDynamicNativeStringArray.GetAsInteger(index : Integer) : Int64; +function TScriptDynamicNativeStringArray.GetAsInteger(index : NativeInt) : Int64; begin Result := StrToInt64(FData[index]); end; // SetAsInteger // -procedure TScriptDynamicNativeStringArray.SetAsInteger(index : Integer; const v : Int64); +procedure TScriptDynamicNativeStringArray.SetAsInteger(index : NativeInt; const v : Int64); begin FData[index] := IntToStr(v); end; // GetAsBoolean // -function TScriptDynamicNativeStringArray.GetAsBoolean(index : Integer) : Boolean; +function TScriptDynamicNativeStringArray.GetAsBoolean(index : NativeInt) : Boolean; begin Result := StringToBoolean(FData[index]); end; // SetAsBoolean // -procedure TScriptDynamicNativeStringArray.SetAsBoolean(index : Integer; const v : Boolean); +procedure TScriptDynamicNativeStringArray.SetAsBoolean(index : NativeInt; const v : Boolean); begin if v then FData[index] := '1' @@ -1986,65 +2086,75 @@ procedure TScriptDynamicNativeStringArray.SetAsBoolean(index : Integer; const v // SetAsVariant // -procedure TScriptDynamicNativeStringArray.SetAsVariant(index : Integer; const v : Variant); +procedure TScriptDynamicNativeStringArray.SetAsVariant(index : NativeInt; const v : Variant); begin FData[index] := VariantToString(v); end; // EvalAsVariant // -procedure TScriptDynamicNativeStringArray.EvalAsVariant(index : Integer; var result : Variant); +procedure TScriptDynamicNativeStringArray.EvalAsVariant(index : NativeInt; var result : Variant); begin VarCopySafe(result, FData[index]); end; // SetAsString // -procedure TScriptDynamicNativeStringArray.SetAsString(index : Integer; const v : String); +procedure TScriptDynamicNativeStringArray.SetAsString(index : NativeInt; const v : String); begin FData[index] := v; end; // EvalAsString // -procedure TScriptDynamicNativeStringArray.EvalAsString(index : Integer; var result : String); +procedure TScriptDynamicNativeStringArray.EvalAsString(index : NativeInt; var result : String); begin result := FData[index]; end; // SetAsInterface // -procedure TScriptDynamicNativeStringArray.SetAsInterface(index : Integer; const v : IUnknown); +procedure TScriptDynamicNativeStringArray.SetAsInterface(index : NativeInt; const v : IUnknown); begin Assert(False); end; // EvalAsInterface // -procedure TScriptDynamicNativeStringArray.EvalAsInterface(index : Integer; var result : IUnknown); +procedure TScriptDynamicNativeStringArray.EvalAsInterface(index : NativeInt; var result : IUnknown); begin Assert(False); end; +// SetFromExpr +// +function TScriptDynamicNativeStringArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + valueExpr.EvalAsString(exec, FData[index]); + Result := True; + end else Result := False; +end; + // IsEmpty // -function TScriptDynamicNativeStringArray.IsEmpty(addr : Integer) : Boolean; +function TScriptDynamicNativeStringArray.IsEmpty(addr : NativeInt) : Boolean; begin Result := False; end; // VarType // -function TScriptDynamicNativeStringArray.VarType(addr : Integer) : TVarType; +function TScriptDynamicNativeStringArray.VarType(addr : NativeInt) : TVarType; begin Result := varUString; end; // HashCode // -function TScriptDynamicNativeStringArray.HashCode(addr : Integer; size : Integer) : Cardinal; +function TScriptDynamicNativeStringArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := 0 to FArrayLength-1 do @@ -2057,7 +2167,7 @@ function TScriptDynamicNativeStringArray.HashCode(addr : Integer; size : Integer // procedure TScriptDynamicNativeStringArray.WriteToJSON(writer : TdwsJSONWriter); var - i : Integer; + i : NativeInt; begin writer.BeginArray; for i := 0 to FArrayLength-1 do @@ -2065,136 +2175,588 @@ procedure TScriptDynamicNativeStringArray.WriteToJSON(writer : TdwsJSONWriter); writer.EndArray; end; -// ------------------ -// ------------------ TScriptDynamicNativeBooleanArray ------------------ -// ------------------ - -// Create +// InterfaceToDataOffset // -constructor TScriptDynamicNativeBooleanArray.Create(elemTyp : TTypeSymbol); +class function TScriptDynamicNativeStringArray.InterfaceToDataOffset : Integer; +// Here be dragons! This is used for JIT casting of interface to field offset, this is a hack +var + instance : TScriptDynamicNativeStringArray; + intf : IScriptDynArray; begin - inherited Create(elemTyp); - FBits := TBits.Create; + instance := TScriptDynamicNativeStringArray.Create(nil); + intf := instance; + Result := NativeInt(@instance.FData) - NativeInt(intf); end; -// Destroy -// -destructor TScriptDynamicNativeBooleanArray.Destroy; -begin - inherited; - FBits.Free; -end; +// ------------------ +// ------------------ TScriptDynamicNativeBaseInterfaceArray ------------------ +// ------------------ // SetArrayLength // -procedure TScriptDynamicNativeBooleanArray.SetArrayLength(n : Integer); +procedure TScriptDynamicNativeBaseInterfaceArray.SetArrayLength(n : NativeInt); begin - FBits.Size := n; + SetLength(FData, n); FArrayLength := n; end; // ToStringArray // -function TScriptDynamicNativeBooleanArray.ToStringArray : TStringDynArray; +function TScriptDynamicNativeBaseInterfaceArray.ToStringArray : TStringDynArray; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do - if FBits[i] then - Result[i] := 'True' - else Result[i] := 'False'; + Result[i] := (FData[i] as IGetSelf).ToString; end; // ToInt64Array // -function TScriptDynamicNativeBooleanArray.ToInt64Array : TInt64DynArray; -var - i : Integer; +function TScriptDynamicNativeBaseInterfaceArray.ToInt64Array : TInt64DynArray; begin - SetLength(Result, FArrayLength); - for i := 0 to FArrayLength-1 do - Result[i] := Ord(FBits[i]); + Assert(False); end; // ToData // -function TScriptDynamicNativeBooleanArray.ToData : TData; +function TScriptDynamicNativeBaseInterfaceArray.ToData : TData; var - i : Integer; + i : NativeInt; begin SetLength(Result, FArrayLength); for i := 0 to FArrayLength-1 do - VarCopySafe(Result[i], FBits[i]); + VarCopySafe(Result[i], FData[i]); end; // Insert // -procedure TScriptDynamicNativeBooleanArray.Insert(index : Integer); -var - i : Integer; +procedure TScriptDynamicNativeBaseInterfaceArray.Insert(index : NativeInt); begin - SetArrayLength(FArrayLength + 1); - for i := FArrayLength-1 downto index+1 do - FBits[i] := FBits[i-1]; - FBits[index] := False; + System.Insert(nil, FData, index); + Inc(FArrayLength); end; // Delete // -procedure TScriptDynamicNativeBooleanArray.Delete(index, count : Integer); -var - i : Integer; +procedure TScriptDynamicNativeBaseInterfaceArray.Delete(index, count : NativeInt); begin - for i := index to FArrayLength-count-1 do - FBits[i] := FBits[i+count]; - SetArrayLength(FArrayLength - count); + System.Delete(FData, index, count); + Dec(FArrayLength, count); end; // MoveItem // -procedure TScriptDynamicNativeBooleanArray.MoveItem(source, destination : Integer); +procedure TScriptDynamicNativeBaseInterfaceArray.MoveItem(source, destination : NativeInt); var - buf : Boolean; - i : Integer; + buf : Pointer; begin if source = destination then Exit; - buf := FBits[source]; - - if source < destination then begin - for i := source to destination-1 do - FBits[i] := FBits[i+1]; - end else begin - for i := source downto destination+1 do - FBits[i] := FBits[i-1]; - end; - FBits[destination] := buf; + buf := PPointer(@FData[source])^; + if source < destination then + System.Move(FData[source+1], FData[source], SizeOf(Pointer)*(destination-source)) + else System.Move(FData[destination], FData[destination+1], SizeOf(Pointer)*(source-destination)); + PPointer(@FData[destination])^ := buf; end; // Swap // -procedure TScriptDynamicNativeBooleanArray.Swap(index1, index2 : Integer); +procedure TScriptDynamicNativeBaseInterfaceArray.Swap(index1, index2 : NativeInt); var - buf : Boolean; + buf : Pointer; begin - buf := FBits[index1]; - FBits[index1] := FBits[index2]; - FBits[index2] := buf; + buf := PPointer(@FData[index1])^; + PPointer(@FData[index1])^ := PPointer(@FData[index2])^; + PPointer(@FData[index2])^ := buf; end; // IndexOfValue // -function TScriptDynamicNativeBooleanArray.IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeBaseInterfaceArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; begin - Result := IndexOfInteger(VariantToInt64(item), fromIndex); + if TVarData(item).VType = varUnknown then + Result := IndexOfInterface(IUnknown(TVarData(item).VUnknown), fromIndex) + else Result := -1; end; // IndexOfInteger // -function TScriptDynamicNativeBooleanArray.IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; -var - i : Integer; +function TScriptDynamicNativeBaseInterfaceArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + +// IndexOfFloat +// +function TScriptDynamicNativeBaseInterfaceArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + +// IndexOfString +// +function TScriptDynamicNativeBaseInterfaceArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + +// IndexOfInterface +// +function TScriptDynamicNativeBaseInterfaceArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; +var + i : NativeInt; +begin + for i := fromIndex to FArrayLength-1 do + if FData[i] = item then + Exit(i); + Result := -1; +end; + +// IndexOfFuncPtr +// +function TScriptDynamicNativeBaseInterfaceArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; +var + i : NativeInt; + itemFunc : IFuncPointer; +begin + itemFunc := IFuncPointer(IUnknown(item)); + if itemFunc = nil then begin + for i := fromIndex to ArrayLength-1 do begin + if FData[i] = nil then + Exit(i); + end; + end else begin + for i := fromIndex to ArrayLength-1 do + if itemFunc.SameFunc(FData[i]) then + Exit(i); + end; + Result:=-1; +end; + +// WriteData +// +procedure TScriptDynamicNativeBaseInterfaceArray.WriteData(const src : TData; srcAddr, size : NativeInt); +var + i : NativeInt; +begin + for i := 0 to size-1 do + FData[i] := src[i + srcAddr]; +end; + +// ReplaceData +// +procedure TScriptDynamicNativeBaseInterfaceArray.ReplaceData(const v : TData); +begin + SetArrayLength(Length(v)); + WriteData(v, 0, FArrayLength); +end; + +// Concat +// +procedure TScriptDynamicNativeBaseInterfaceArray.Concat(const src : IScriptDynArray; index, size : NativeInt); +var + srcSelf : TObject; + srcDyn : TScriptDynamicNativeBaseInterfaceArray; + n, i : NativeInt; +begin + srcSelf := src.GetSelf; + Assert(srcSelf.ClassType = Self.ClassType); + Assert(index >= 0); + + srcDyn := TScriptDynamicNativeBaseInterfaceArray(srcSelf); + if size > srcDyn.ArrayLength - index then + size := srcDyn.ArrayLength - index; + if size > 0 then begin + n := FArrayLength; + SetArrayLength(n + size); + for i := 0 to size-1 do + FData[n + i] := srcDyn.FData[index + i]; + end; +end; + +// Reverse +// +procedure TScriptDynamicNativeBaseInterfaceArray.Reverse; +var + pLow, pHigh : PPointer; + t : Pointer; +begin + if FArrayLength <= 1 then Exit; + + pLow := @FData[0]; + pHigh := @FData[FArrayLength-1]; + while NativeUInt(pHigh) > NativeUInt(pLow) do begin + t := pLow^; + pLow^ := pHigh^; + pHigh^ := t; + Inc(pLow); + Dec(pHigh); + end; +end; + +// Compare +// +function TScriptDynamicNativeBaseInterfaceArray.Compare(index1, index2 : NativeInt) : NativeInt; +begin + Result := 0; +end; + +// NaturalSort +// +procedure TScriptDynamicNativeBaseInterfaceArray.NaturalSort; +begin + Assert(False); +end; + +// AddStrings +// +procedure TScriptDynamicNativeBaseInterfaceArray.AddStrings(sl : TStrings); +begin + Assert(False); +end; + +// GetAsFloat +// +function TScriptDynamicNativeBaseInterfaceArray.GetAsFloat(index : NativeInt) : Double; +begin + Assert(False); + Result := 0; +end; + +// SetAsFloat +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsFloat(index : NativeInt; const v : Double); +begin + Assert(False); +end; + +// GetAsInteger +// +function TScriptDynamicNativeBaseInterfaceArray.GetAsInteger(index : NativeInt) : Int64; +begin + Assert(False); + Result := 0; +end; + +// SetAsInteger +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsInteger(index : NativeInt; const v : Int64); +begin + Assert(False); +end; + +// GetAsBoolean +// +function TScriptDynamicNativeBaseInterfaceArray.GetAsBoolean(index : NativeInt) : Boolean; +begin + Assert(False); + Result := False; +end; + +// SetAsBoolean +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsBoolean(index : NativeInt; const v : Boolean); +begin + Assert(False); +end; + +// SetAsVariant +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsVariant(index : NativeInt; const v : Variant); +begin + FData[index] := v; +end; + +// EvalAsVariant +// +procedure TScriptDynamicNativeBaseInterfaceArray.EvalAsVariant(index : NativeInt; var result : Variant); +begin + VarCopySafe(result, FData[index]); +end; + +// SetAsString +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsString(index : NativeInt; const v : String); +begin + Assert(False); +end; + +// EvalAsString +// +procedure TScriptDynamicNativeBaseInterfaceArray.EvalAsString(index : NativeInt; var result : String); +begin + result := VariantToString(FData[index]); +end; + +// SetAsInterface +// +procedure TScriptDynamicNativeBaseInterfaceArray.SetAsInterface(index : NativeInt; const v : IUnknown); +begin + FData[index] := v; +end; + +// EvalAsInterface +// +procedure TScriptDynamicNativeBaseInterfaceArray.EvalAsInterface(index : NativeInt; var result : IUnknown); +begin + result := FData[index]; +end; + +// IsEmpty +// +function TScriptDynamicNativeBaseInterfaceArray.IsEmpty(addr : NativeInt) : Boolean; +begin + Result := False; +end; + +// VarType +// +function TScriptDynamicNativeBaseInterfaceArray.VarType(addr : NativeInt) : TVarType; +begin + Result := varUnknown; +end; + +// HashCode +// +function TScriptDynamicNativeBaseInterfaceArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; +var + i : NativeInt; +begin + Result := cFNV_basis; + for i := 0 to FArrayLength-1 do + Result := (Result xor varUnknown) * cFNV_prime; + if Result = 0 then + Result := cFNV_basis; +end; + +// InterfaceToDataOffset +// +class function TScriptDynamicNativeBaseInterfaceArray.InterfaceToDataOffset : Integer; +// Here be dragons! This is used for JIT casting of interface to field offset, this is a hack +var + instance : TScriptDynamicNativeInterfaceArray; + intf : IScriptDynArray; +begin + instance := TScriptDynamicNativeInterfaceArray.Create(nil); + intf := instance; + Result := NativeInt(@instance.FData) - NativeInt(intf); +end; + +// ------------------ +// ------------------ TScriptDynamicNativeInterfaceArray ------------------ +// ------------------ + +// SetFromExpr +// +function TScriptDynamicNativeInterfaceArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + valueExpr.EvalAsInterface(exec, FData[index]); + Result := True; + end else Result := False; +end; + +// ------------------ +// ------------------ TScriptDynamicNativeObjectArray ------------------ +// ------------------ + +// SetFromExpr +// +function TScriptDynamicNativeObjectArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + valueExpr.EvalAsInterface(exec, FData[index]); + Result := True; + end else Result := False; +end; + +// ------------------ +// ------------------ TScriptDynamicNativeDynArrayArray ------------------ +// ------------------ + +// SetArrayLength +// +procedure TScriptDynamicNativeDynArrayArray.SetArrayLength(n : NativeInt); + + procedure InitElements(n : NativeInt); + var + i : NativeInt; + subElemTyp : TTypeSymbol; + begin + subElemTyp := ElementTyp.UnAliasedType.Typ; + for i := FArrayLength to n-1 do + FData[i] := CreateNewDynamicArray(subElemTyp) + end; + +begin + SetLength(FData, n); + if FArrayLength < n then + InitElements(n); + FArrayLength := n; +end; + +// Insert +// +procedure TScriptDynamicNativeDynArrayArray.Insert(index : NativeInt); +begin + inherited Insert(index); + FData[index] := CreateNewDynamicArray(ElementTyp.UnAliasedType.Typ); +end; + +// SetFromExpr +// +function TScriptDynamicNativeDynArrayArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + valueExpr.EvalAsInterface(exec, FData[index]); + Result := True; + end else Result := False; +end; + +// ------------------ +// ------------------ TScriptDynamicNativeBooleanArray ------------------ +// ------------------ + +// Create +// +constructor TScriptDynamicNativeBooleanArray.Create(elemTyp : TTypeSymbol); +begin + inherited Create(elemTyp); + FBits := TBits.Create; +end; + +// Destroy +// +destructor TScriptDynamicNativeBooleanArray.Destroy; +begin + inherited; + FBits.Free; +end; + +// InterfaceToDataOffset +// +class function TScriptDynamicNativeBooleanArray.InterfaceToDataOffset : Integer; +// Here be dragons! This is used for JIT casting of interface to field offset, this is a hack +var + instance : TScriptDynamicNativeIntegerArray; + intf : IScriptDynArray; +begin + instance := TScriptDynamicNativeIntegerArray.Create(nil); + intf := instance; + Result := NativeInt(@instance.FData) - NativeInt(intf); +end; + +// SetArrayLength +// +procedure TScriptDynamicNativeBooleanArray.SetArrayLength(n : NativeInt); +begin + FBits.Size := n; + FArrayLength := n; +end; + +// ToStringArray +// +function TScriptDynamicNativeBooleanArray.ToStringArray : TStringDynArray; +var + i : NativeInt; +begin + SetLength(Result, FArrayLength); + for i := 0 to FArrayLength-1 do + if FBits[i] then + Result[i] := 'True' + else Result[i] := 'False'; +end; + +// ToInt64Array +// +function TScriptDynamicNativeBooleanArray.ToInt64Array : TInt64DynArray; +var + i : NativeInt; +begin + SetLength(Result, FArrayLength); + for i := 0 to FArrayLength-1 do + Result[i] := Ord(FBits[i]); +end; + +// ToData +// +function TScriptDynamicNativeBooleanArray.ToData : TData; +var + i : NativeInt; +begin + SetLength(Result, FArrayLength); + for i := 0 to FArrayLength-1 do + VarCopySafe(Result[i], FBits[i]); +end; + +// Insert +// +procedure TScriptDynamicNativeBooleanArray.Insert(index : NativeInt); +var + i : NativeInt; +begin + SetArrayLength(FArrayLength + 1); + for i := FArrayLength-1 downto index+1 do + FBits[i] := FBits[i-1]; + FBits[index] := False; +end; + +// Delete +// +procedure TScriptDynamicNativeBooleanArray.Delete(index, count : NativeInt); +var + i : NativeInt; +begin + for i := index to FArrayLength-count-1 do + FBits[i] := FBits[i+count]; + SetArrayLength(FArrayLength - count); +end; + +// MoveItem +// +procedure TScriptDynamicNativeBooleanArray.MoveItem(source, destination : NativeInt); +var + buf : Boolean; + i : NativeInt; +begin + if source = destination then Exit; + + buf := FBits[source]; + + if source < destination then begin + for i := source to destination-1 do + FBits[i] := FBits[i+1]; + end else begin + for i := source downto destination+1 do + FBits[i] := FBits[i-1]; + end; + FBits[destination] := buf; +end; + +// Swap +// +procedure TScriptDynamicNativeBooleanArray.Swap(index1, index2 : NativeInt); +var + buf : Boolean; +begin + buf := FBits[index1]; + FBits[index1] := FBits[index2]; + FBits[index2] := buf; +end; + +// IndexOfValue +// +function TScriptDynamicNativeBooleanArray.IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; +begin + Result := IndexOfInteger(VariantToInt64(item), fromIndex); +end; + +// IndexOfInteger +// +function TScriptDynamicNativeBooleanArray.IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; +var + i : NativeInt; v : Boolean; begin v := (item <> 0); @@ -2206,30 +2768,37 @@ function TScriptDynamicNativeBooleanArray.IndexOfInteger(item : Int64; fromIndex // IndexOfFloat // -function TScriptDynamicNativeBooleanArray.IndexOfFloat(item : Double; fromIndex : Integer) : Integer; +function TScriptDynamicNativeBooleanArray.IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfInteger(Ord(item <> 0), fromIndex); end; // IndexOfString // -function TScriptDynamicNativeBooleanArray.IndexOfString(const item : String; fromIndex : Integer) : Integer; +function TScriptDynamicNativeBooleanArray.IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; begin Result := IndexOfInteger(Ord(StringToBoolean(item)), fromIndex); end; +// IndexOfInterface +// +function TScriptDynamicNativeBooleanArray.IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; +begin + Result := -1; +end; + // IndexOfFuncPtr // -function TScriptDynamicNativeBooleanArray.IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; +function TScriptDynamicNativeBooleanArray.IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; begin Result := -1; end; // WriteData // -procedure TScriptDynamicNativeBooleanArray.WriteData(const src : TData; srcAddr, size : Integer); +procedure TScriptDynamicNativeBooleanArray.WriteData(const src : TData; srcAddr, size : NativeInt); var - i : Integer; + i : NativeInt; begin for i := 0 to size-1 do FBits[i] := VariantToBool(src[i + srcAddr]); @@ -2245,11 +2814,11 @@ procedure TScriptDynamicNativeBooleanArray.ReplaceData(const v : TData); // Concat // -procedure TScriptDynamicNativeBooleanArray.Concat(const src : IScriptDynArray; index, size : Integer); +procedure TScriptDynamicNativeBooleanArray.Concat(const src : IScriptDynArray; index, size : NativeInt); var srcSelf : TObject; srcDyn : TScriptDynamicNativeBooleanArray; - i, n : Integer; + i, n : NativeInt; begin srcSelf := src.GetSelf; Assert(srcSelf.ClassType = TScriptDynamicNativeBooleanArray); @@ -2270,7 +2839,7 @@ procedure TScriptDynamicNativeBooleanArray.Concat(const src : IScriptDynArray; i // procedure TScriptDynamicNativeBooleanArray.Reverse; var - i, j : Integer; + i, j : NativeInt; buf : Boolean; begin i := 0; @@ -2286,7 +2855,7 @@ procedure TScriptDynamicNativeBooleanArray.Reverse; // Compare // -function TScriptDynamicNativeBooleanArray.Compare(index1, index2 : Integer) : Integer; +function TScriptDynamicNativeBooleanArray.Compare(index1, index2 : NativeInt) : NativeInt; begin Result := Ord(FBits[index1]) - Ord(FBits[index2]); end; @@ -2295,7 +2864,7 @@ function TScriptDynamicNativeBooleanArray.Compare(index1, index2 : Integer) : In // procedure TScriptDynamicNativeBooleanArray.NaturalSort; var - i, j : Integer; + i, j : NativeInt; begin j := FArrayLength; for i := 0 to FArrayLength-1 do begin @@ -2316,80 +2885,72 @@ procedure TScriptDynamicNativeBooleanArray.AddStrings(sl : TStrings); DynamicArrayAddStrings(Self, sl); end; -// AsPDouble -// -function TScriptDynamicNativeBooleanArray.AsPDouble(var nbElements, stride : Integer) : PDouble; -begin - Assert(False); - Result := nil; -end; - // GetAsFloat // -function TScriptDynamicNativeBooleanArray.GetAsFloat(index : Integer) : Double; +function TScriptDynamicNativeBooleanArray.GetAsFloat(index : NativeInt) : Double; begin Result := Ord(FBits[index]); end; // SetAsFloat // -procedure TScriptDynamicNativeBooleanArray.SetAsFloat(index : Integer; const v : Double); +procedure TScriptDynamicNativeBooleanArray.SetAsFloat(index : NativeInt; const v : Double); begin FBits[index] := (v <> 0); end; // GetAsInteger // -function TScriptDynamicNativeBooleanArray.GetAsInteger(index : Integer) : Int64; +function TScriptDynamicNativeBooleanArray.GetAsInteger(index : NativeInt) : Int64; begin Result := Ord(FBits[index]); end; // SetAsInteger // -procedure TScriptDynamicNativeBooleanArray.SetAsInteger(index : Integer; const v : Int64); +procedure TScriptDynamicNativeBooleanArray.SetAsInteger(index : NativeInt; const v : Int64); begin FBits[index] := (v <> 0); end; // GetAsBoolean // -function TScriptDynamicNativeBooleanArray.GetAsBoolean(index : Integer) : Boolean; +function TScriptDynamicNativeBooleanArray.GetAsBoolean(index : NativeInt) : Boolean; begin Result := FBits[index]; end; // SetAsBoolean // -procedure TScriptDynamicNativeBooleanArray.SetAsBoolean(index : Integer; const v : Boolean); +procedure TScriptDynamicNativeBooleanArray.SetAsBoolean(index : NativeInt; const v : Boolean); begin FBits[index] := v; end; // SetAsVariant // -procedure TScriptDynamicNativeBooleanArray.SetAsVariant(index : Integer; const v : Variant); +procedure TScriptDynamicNativeBooleanArray.SetAsVariant(index : NativeInt; const v : Variant); begin FBits[index] := VariantToBool(v); end; // EvalAsVariant // -procedure TScriptDynamicNativeBooleanArray.EvalAsVariant(index : Integer; var result : Variant); +procedure TScriptDynamicNativeBooleanArray.EvalAsVariant(index : NativeInt; var result : Variant); begin VarCopySafe(result, FBits[index]); end; // SetAsString // -procedure TScriptDynamicNativeBooleanArray.SetAsString(index : Integer; const v : String); +procedure TScriptDynamicNativeBooleanArray.SetAsString(index : NativeInt; const v : String); begin FBits[index] := StringToBoolean(v); end; // EvalAsString // -procedure TScriptDynamicNativeBooleanArray.EvalAsString(index : Integer; var result : String); +procedure TScriptDynamicNativeBooleanArray.EvalAsString(index : NativeInt; var result : String); begin if FBits[index] then result := 'True' @@ -2398,37 +2959,47 @@ procedure TScriptDynamicNativeBooleanArray.EvalAsString(index : Integer; var res // SetAsInterface // -procedure TScriptDynamicNativeBooleanArray.SetAsInterface(index : Integer; const v : IUnknown); +procedure TScriptDynamicNativeBooleanArray.SetAsInterface(index : NativeInt; const v : IUnknown); begin Assert(False); end; // EvalAsInterface // -procedure TScriptDynamicNativeBooleanArray.EvalAsInterface(index : Integer; var result : IUnknown); +procedure TScriptDynamicNativeBooleanArray.EvalAsInterface(index : NativeInt; var result : IUnknown); begin Assert(False); end; +// SetFromExpr +// +function TScriptDynamicNativeBooleanArray.SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; +begin + if BoundsCheckPassed(index) then begin + FBits[index] := valueExpr.EvalAsBoolean(exec); + Result := True; + end else Result := False; +end; + // IsEmpty // -function TScriptDynamicNativeBooleanArray.IsEmpty(addr : Integer) : Boolean; +function TScriptDynamicNativeBooleanArray.IsEmpty(addr : NativeInt) : Boolean; begin Result := False; end; // VarType // -function TScriptDynamicNativeBooleanArray.VarType(addr : Integer) : TVarType; +function TScriptDynamicNativeBooleanArray.VarType(addr : NativeInt) : TVarType; begin Result := varBoolean; end; // HashCode // -function TScriptDynamicNativeBooleanArray.HashCode(addr : Integer; size : Integer) : Cardinal; +function TScriptDynamicNativeBooleanArray.HashCode(addr : NativeInt; size : NativeInt) : Cardinal; var - i : Integer; + i : NativeInt; begin Result := cFNV_basis; for i := 0 to FArrayLength-1 do @@ -2441,7 +3012,7 @@ function TScriptDynamicNativeBooleanArray.HashCode(addr : Integer; size : Intege // procedure TScriptDynamicNativeBooleanArray.WriteToJSON(writer : TdwsJSONWriter); var - i : Integer; + i : NativeInt; begin writer.BeginArray; for i := 0 to FArrayLength-1 do diff --git a/Source/dwsExprs.pas b/Source/dwsExprs.pas index 5c0322b4..cd96655e 100644 --- a/Source/dwsExprs.pas +++ b/Source/dwsExprs.pas @@ -1621,8 +1621,8 @@ TScriptAssociativeArray = class sealed (TScriptObj, IScriptAssociativeArray) FElementTyp, FKeyTyp : TTypeSymbol; FElementSize, FKeySize : Integer; - FCount : Integer; - FCapacity, FGrowth : Integer; + FCount : NativeInt; + FCapacity, FGrowth : NativeInt; FHashCodes : TScriptAssociativeArrayHashCodes; FKeys : TData; FCreateKeyOnAccess : Boolean; @@ -1661,8 +1661,8 @@ TScriptAssociativeArray = class sealed (TScriptObj, IScriptAssociativeArray) function ReadBucket(index : Integer; var key : TData; var value : IDataContext) : Boolean; - function Count : Integer; - function Capacity : Integer; + function Count : NativeInt; + function Capacity : NativeInt; function CopyKeys : TData; @@ -7796,14 +7796,14 @@ function TScriptAssociativeArray.ReadBucket(index : Integer; var key : TData; va // Count // -function TScriptAssociativeArray.Count : Integer; +function TScriptAssociativeArray.Count : NativeInt; begin - Result:=FCount; + Result := FCount; end; // Capacity // -function TScriptAssociativeArray.Capacity : Integer; +function TScriptAssociativeArray.Capacity : NativeInt; begin Result := FCapacity; end; diff --git a/Source/dwsJSON.pas b/Source/dwsJSON.pas index 1ec4f31e..6d71702d 100644 --- a/Source/dwsJSON.pas +++ b/Source/dwsJSON.pas @@ -380,7 +380,7 @@ TdwsJSONArray = class sealed (TdwsJSONValue) procedure SetCapacity(newCapacity : Integer); procedure DetachChild(child : TdwsJSONValue); override; procedure DeleteIndex(idx : Integer); - procedure SwapNoRangeCheck(index1, index2 : Integer); + procedure SwapNoRangeCheck(index1, index2 : NativeInt); function GetValueType : TdwsJSONValueType; override; function DoGetName(index : Integer) : UnicodeString; override; @@ -2109,9 +2109,9 @@ procedure TdwsJSONArray.Delete(index : Integer); TCompareAdapter = class ValueArray : PdwsJSONValueArray; CompareMethod : TdwsJSONValueCompareMethod; - function Compare(index1, index2 : Integer) : Integer; + function Compare(index1, index2 : NativeInt) : Integer; end; - function TCompareAdapter.Compare(index1, index2 : Integer) : Integer; + function TCompareAdapter.Compare(index1, index2 : NativeInt) : Integer; begin Result:=CompareMethod(ValueArray[index1], ValueArray[Index2]); end; @@ -2136,7 +2136,7 @@ procedure TdwsJSONArray.Sort(const aCompareMethod : TdwsJSONValueCompareMethod); // SwapNoRangeCheck // -procedure TdwsJSONArray.SwapNoRangeCheck(index1, index2 : Integer); +procedure TdwsJSONArray.SwapNoRangeCheck(index1, index2 : NativeInt); var temp : TdwsJSONValue; begin diff --git a/Source/dwsMathFunctions.pas b/Source/dwsMathFunctions.pas index a0f14ccf..78073d86 100644 --- a/Source/dwsMathFunctions.pas +++ b/Source/dwsMathFunctions.pas @@ -334,6 +334,8 @@ implementation // ------------------------------------------------------------------ // ------------------------------------------------------------------ +uses dwsDynamicArrays; + // Gcd // function Gcd(a, b : Int64) : Int64; @@ -985,11 +987,11 @@ procedure TSetRandSeedFunc.DoEvalProc(const args : TExprBaseListExec); // procedure TFloatArrayProcessFunc.DoEvalAsDynArray(const args : TExprBaseListExec; var result : IScriptDynArray); var - n, stride : Integer; + n, stride : NativeInt; p : PDouble; begin args.EvalAsDynArray(0, result); - p := result.AsPDouble(n, stride); + p := (result as IPDoubleArray).AsPDouble(n, stride); if p <> nil then DoProcess(p, n, stride, args); end; diff --git a/Source/dwsRTTIFunctions.pas b/Source/dwsRTTIFunctions.pas index eef1e46a..1c7b9305 100644 --- a/Source/dwsRTTIFunctions.pas +++ b/Source/dwsRTTIFunctions.pas @@ -215,7 +215,6 @@ procedure RegisterRTTIOperators(systemTable : TSystemSymbolTable; procedure PrepareRTTIRawAttributes(info : TProgramInfo; var scriptDynArray : IScriptDynArray); var typRawAttribute : TRecordSymbol; - dynArray : TScriptDynamicDataArray; attributes : TdwsSymbolAttributes; publishedSymbols : TSimpleSymbolList; i, n : Integer; @@ -231,9 +230,8 @@ procedure PrepareRTTIRawAttributes(info : TProgramInfo; var scriptDynArray : ISc buf : Variant; begin typRawAttribute:=info.Execution.Prog.Table.FindTypeSymbol(SYS_TRTTIRAWATTRIBUTE, cvPublic) as TRecordSymbol; - dynArray:=TScriptDynamicDataArray.Create(typRawAttribute); - scriptDynArray:=dynArray; - info.Execution.RTTIRawAttributes:=scriptDynArray; + scriptDynArray := CreateNewDynamicArray(typRawAttribute); + info.Execution.RTTIRawAttributes := scriptDynArray; rttiPropertyAttributeCreate:=Info.Vars[SYS_RTTIPROPERTYATTRIBUTE].Method[SYS_TOBJECT_CREATE]; rttiMethodAttributeCreate:=Info.Vars[SYS_RTTIMETHODATTRIBUTE].Method[SYS_TOBJECT_CREATE]; @@ -241,43 +239,43 @@ procedure PrepareRTTIRawAttributes(info : TProgramInfo; var scriptDynArray : ISc publishedSymbols:=info.Execution.Prog.CollectAllPublishedSymbols(False); try - attributes:=info.Execution.Prog.Attributes; + attributes := info.Execution.Prog.Attributes; - dynArray.ArrayLength:=attributes.Count+publishedSymbols.Count*2; + scriptDynArray.ArrayLength := attributes.Count+publishedSymbols.Count*2; for i:=0 to attributes.Count-1 do begin attrib:=attributes[i]; symbolClassType:=attrib.Symbol.ClassType; if symbolClassType=TClassSymbol then begin - dynArray.AsInteger[i*2]:=Int64(attrib.Symbol); + scriptDynArray.AsInteger[i*2] := Int64(attrib.Symbol); attrib.AttributeConstructor.EvalAsVariant(info.Execution, buf); - dynArray.AsVariant[i*2+1] := buf; + scriptDynArray.AsVariant[i*2+1] := buf; end else Assert(False); end; - n:=attributes.Count*2; - for i:=0 to publishedSymbols.Count-1 do begin - symbol:=publishedSymbols[i]; - symbolClassType:=symbol.ClassType; - if symbolClassType=TPropertySymbol then begin - propertySymbol:=TPropertySymbol(symbol); - dynArray.AsInteger[n]:=Int64(propertySymbol.OwnerSymbol); + n := attributes.Count*2; + for i := 0 to publishedSymbols.Count-1 do begin + symbol := publishedSymbols[i]; + symbolClassType := symbol.ClassType; + if symbolClassType = TPropertySymbol then begin + propertySymbol := TPropertySymbol(symbol); + scriptDynArray.AsInteger[n] := Int64(propertySymbol.OwnerSymbol); attribute:=rttiPropertyAttributeCreate.Call; - dynArray.AsVariant[n+1]:=attribute.Value; - attribute.ExternalObject:=propertySymbol; + scriptDynArray.AsVariant[n+1] := attribute.Value; + attribute.ExternalObject := propertySymbol; Inc(n, 2); end else if symbolClassType=TFieldSymbol then begin fieldSymbol:=TFieldSymbol(symbol); - dynArray.AsInteger[n]:=Int64(fieldSymbol.StructSymbol); + scriptDynArray.AsInteger[n]:=Int64(fieldSymbol.StructSymbol); attribute:=rttiPropertyAttributeCreate.Call; - dynArray.AsVariant[n+1]:=attribute.Value; + scriptDynArray.AsVariant[n+1]:=attribute.Value; attribute.ExternalObject:=fieldSymbol; Inc(n, 2); end else if symbolClassType.InheritsFrom(TMethodSymbol) then begin methSymbol:=TMethodSymbol(symbol); - dynArray.AsInteger[n]:=Int64(methSymbol.StructSymbol); + scriptDynArray.AsInteger[n]:=Int64(methSymbol.StructSymbol); attribute:=rttiMethodAttributeCreate.Call; - dynArray.AsVariant[n+1]:=attribute.Value; + scriptDynArray.AsVariant[n+1]:=attribute.Value; attribute.ExternalObject:=methSymbol; Inc(n, 2); end; diff --git a/Source/dwsSymbols.pas b/Source/dwsSymbols.pas index 7f52807e..7f475701 100644 --- a/Source/dwsSymbols.pas +++ b/Source/dwsSymbols.pas @@ -2186,73 +2186,74 @@ TdwsExecution = class abstract (TInterfacedSelfObject, IdwsExecution) function GetElementType : TTypeSymbol; property ElementType : TTypeSymbol read GetElementType; - function GetArrayLength : Integer; - procedure SetArrayLength(n : Integer); - property ArrayLength : Integer read GetArrayLength write SetArrayLength; + function GetArrayLength : NativeInt; + procedure SetArrayLength(n : NativeInt); + property ArrayLength : NativeInt read GetArrayLength write SetArrayLength; - function BoundsCheckPassed(index : Integer) : Boolean; + function BoundsCheckPassed(index : NativeInt) : Boolean; function ToStringArray : TStringDynArray; function ToInt64Array : TInt64DynArray; function ToData : TData; - procedure Insert(index : Integer); - procedure Delete(index, count : Integer); - procedure MoveItem(source, destination : Integer); - procedure Swap(index1, index2 : Integer); + procedure Insert(index : NativeInt); + procedure Delete(index, count : NativeInt); + procedure MoveItem(source, destination : NativeInt); + procedure Swap(index1, index2 : NativeInt); - function IndexOfValue(const item : Variant; fromIndex : Integer) : Integer; - function IndexOfInteger(item : Int64; fromIndex : Integer) : Integer; - function IndexOfFloat(item : Double; fromIndex : Integer) : Integer; - function IndexOfString(const item : String; fromIndex : Integer) : Integer; - function IndexOfFuncPtr(const item : Variant; fromIndex : Integer) : Integer; + function IndexOfValue(const item : Variant; fromIndex : NativeInt) : NativeInt; + function IndexOfInteger(item : Int64; fromIndex : NativeInt) : NativeInt; + function IndexOfFloat(item : Double; fromIndex : NativeInt) : NativeInt; + function IndexOfString(const item : String; fromIndex : NativeInt) : NativeInt; + function IndexOfInterface(const item : IUnknown; fromIndex : NativeInt) : NativeInt; + function IndexOfFuncPtr(const item : Variant; fromIndex : NativeInt) : NativeInt; - procedure WriteData(const src : TData; srcAddr, size : Integer); + procedure WriteData(const src : TData; srcAddr, size : NativeInt); procedure ReplaceData(const v : TData); - procedure Concat(const src : IScriptDynArray; index, size : Integer); + procedure Concat(const src : IScriptDynArray; index, size : NativeInt); procedure Reverse; procedure NaturalSort; procedure AddStrings(sl : TStrings); - function AsPDouble(var nbElements, stride : Integer) : PDouble; + function GetAsFloat(index : NativeInt) : Double; + procedure SetAsFloat(index : NativeInt; const v : Double); + property AsFloat[index : NativeInt] : Double read GetAsFloat write SetAsFloat; - function GetAsFloat(index : Integer) : Double; - procedure SetAsFloat(index : Integer; const v : Double); - property AsFloat[index : Integer] : Double read GetAsFloat write SetAsFloat; + function GetAsInteger(index : NativeInt) : Int64; + procedure SetAsInteger(index : NativeInt; const v : Int64); + property AsInteger[index : NativeInt] : Int64 read GetAsInteger write SetAsInteger; - function GetAsInteger(index : Integer) : Int64; - procedure SetAsInteger(index : Integer; const v : Int64); - property AsInteger[index : Integer] : Int64 read GetAsInteger write SetAsInteger; + function GetAsBoolean(index : NativeInt) : Boolean; + procedure SetAsBoolean(index : NativeInt; const v : Boolean); + property AsBoolean[index : NativeInt] : Boolean read GetAsBoolean write SetAsBoolean; - function GetAsBoolean(index : Integer) : Boolean; - procedure SetAsBoolean(index : Integer; const v : Boolean); - property AsBoolean[index : Integer] : Boolean read GetAsBoolean write SetAsBoolean; + procedure SetAsVariant(index : NativeInt; const v : Variant); + procedure EvalAsVariant(index : NativeInt; var result : Variant); + property AsVariant[index : NativeInt] : Variant write SetAsVariant; - procedure SetAsVariant(index : Integer; const v : Variant); - procedure EvalAsVariant(index : Integer; var result : Variant); - property AsVariant[index : Integer] : Variant write SetAsVariant; + procedure SetAsString(index : NativeInt; const v : String); + procedure EvalAsString(index : NativeInt; var result : String); + property AsString[index : NativeInt] : String write SetAsString; - procedure SetAsString(index : Integer; const v : String); - procedure EvalAsString(index : Integer; var result : String); - property AsString[index : Integer] : String write SetAsString; + procedure SetAsInterface(index : NativeInt; const v : IUnknown); + procedure EvalAsInterface(index : NativeInt; var result : IUnknown); + property AsInterface[index : NativeInt] : IUnknown write SetAsInterface; - procedure SetAsInterface(index : Integer; const v : IUnknown); - procedure EvalAsInterface(index : Integer; var result : IUnknown); - property AsInterface[index : Integer] : IUnknown write SetAsInterface; + function SetFromExpr(index : NativeInt; exec : TdwsExecution; valueExpr : TExprBase) : Boolean; - function IsEmpty(addr : Integer) : Boolean; - function VarType(addr : Integer) : TVarType; + function IsEmpty(addr : NativeInt) : Boolean; + function VarType(addr : NativeInt) : TVarType; - function HashCode(addr : Integer; size : Integer) : Cardinal; + function HashCode(addr : NativeInt; size : NativeInt) : Cardinal; end; // IScriptAssociativeArray IScriptAssociativeArray = interface (IDataContext) ['{1162D4BD-6033-4505-8D8C-0715588C768C}'] procedure Clear; - function Count : Integer; + function Count : NativeInt; end; TPerfectMatchEnumerator = class diff --git a/Source/dwsUnicode.pas b/Source/dwsUnicode.pas index 905570ca..9a98ad1c 100644 --- a/Source/dwsUnicode.pas +++ b/Source/dwsUnicode.pas @@ -33,18 +33,18 @@ interface TUnicodeStringList = class private FItems : array of UnicodeString; - FCount : Integer; + FCount : NativeInt; FFlags : TUnicodeStringListFlags; protected - function GetString(index : Integer) : UnicodeString; inline; - procedure SetString(index : Integer; const v : UnicodeString); inline; - function GetValueFromIndex(index : Integer) : UnicodeString; inline; + function GetString(index : NativeInt) : UnicodeString; inline; + procedure SetString(index : NativeInt; const v : UnicodeString); inline; + function GetValueFromIndex(index : NativeInt) : UnicodeString; inline; function GetValue(const name : UnicodeString) : UnicodeString; procedure SetValue(const name, value: UnicodeString); function Compare(const s1, s2 : UnicodeString) : Integer; virtual; - function CompareIndex(index1, index2 : Integer) : Integer; + function CompareIndex(index1, index2 : NativeInt) : Integer; function GetSorted : Boolean; procedure SetSorted(const val : Boolean); @@ -55,26 +55,26 @@ TUnicodeStringList = class procedure Assign(src : TUnicodeStringList); procedure AssignFromTStrings(src : TStrings); - function Add(const s : UnicodeString) : Integer; - procedure Insert(index : Integer; const s : UnicodeString); + function Add(const s : UnicodeString) : NativeInt; + procedure Insert(index : NativeInt; const s : UnicodeString); - procedure Delete(index : Integer); + procedure Delete(index : NativeInt); procedure Clear; - function Find(const s : UnicodeString; var index : Integer) : Boolean; - function IndexOf(const s : UnicodeString) : Integer; + function Find(const s : UnicodeString; var index : NativeInt) : Boolean; + function IndexOf(const s : UnicodeString) : NativeInt; function Contains(const s : UnicodeString) : Boolean; inline; - function FindName(const name : UnicodeString; var index : Integer) : Boolean; - function IndexOfName(const name : UnicodeString) : Integer; + function FindName(const name : UnicodeString; var index : NativeInt) : Boolean; + function IndexOfName(const name : UnicodeString) : NativeInt; - procedure Exchange(index1, index2 : Integer); + procedure Exchange(index1, index2 : NativeInt); procedure Sort; - property Strings[index : Integer] : UnicodeString read GetString write SetString; default; + property Strings[index : NativeInt] : UnicodeString read GetString write SetString; default; property Values[const name : UnicodeString] : UnicodeString read GetValue write SetValue; - property ValueFromIndex[index : Integer] : UnicodeString read GetValueFromIndex; - property Count : Integer read FCount; + property ValueFromIndex[index : NativeInt] : UnicodeString read GetValueFromIndex; + property Count : NativeInt read FCount; property Sorted : Boolean read GetSorted write SetSorted; property CaseSensitive : Boolean read GetCaseSensitive write SetCaseSensitive; @@ -94,23 +94,23 @@ implementation // GetString // -function TUnicodeStringList.GetString(index : Integer) : UnicodeString; +function TUnicodeStringList.GetString(index : NativeInt) : UnicodeString; begin Result := FItems[index]; end; // SetString // -procedure TUnicodeStringList.SetString(index : Integer; const v : UnicodeString); +procedure TUnicodeStringList.SetString(index : NativeInt; const v : UnicodeString); begin FItems[index] := v; end; // GetValueFromIndex // -function TUnicodeStringList.GetValueFromIndex(index : Integer) : UnicodeString; +function TUnicodeStringList.GetValueFromIndex(index : NativeInt) : UnicodeString; var - p : Integer; + p : NativeInt; begin p := Pos('=', FItems[index]); if p > 0 then @@ -122,7 +122,7 @@ function TUnicodeStringList.GetValueFromIndex(index : Integer) : UnicodeString; // function TUnicodeStringList.GetValue(const name : UnicodeString) : UnicodeString; var - i : Integer; + i : NativeInt; begin i := IndexOfName(name); if i >= 0 then @@ -134,7 +134,7 @@ function TUnicodeStringList.GetValue(const name : UnicodeString) : UnicodeString // procedure TUnicodeStringList.SetValue(const name, value: UnicodeString); var - i : Integer; + i : NativeInt; begin i := IndexOfName(name); if i >= 0 then @@ -153,7 +153,7 @@ function TUnicodeStringList.Compare(const s1, s2 : UnicodeString) : Integer; // CompareIndex // -function TUnicodeStringList.CompareIndex(index1, index2 : Integer) : Integer; +function TUnicodeStringList.CompareIndex(index1, index2 : NativeInt) : Integer; begin Result := Compare(FItems[index1], FItems[index2]); end; @@ -201,7 +201,7 @@ procedure TUnicodeStringList.SetCaseSensitive(const val : Boolean); // procedure TUnicodeStringList.Assign(src : TUnicodeStringList); var - i : Integer; + i : NativeInt; begin FCount := src.FCount; SetLength(FItems, FCount); @@ -217,7 +217,7 @@ procedure TUnicodeStringList.Assign(src : TUnicodeStringList); // procedure TUnicodeStringList.AssignFromTStrings(src : TStrings); var - i : Integer; + i : NativeInt; begin FCount := src.Count; SetLength(FItems, FCount); @@ -229,7 +229,7 @@ procedure TUnicodeStringList.AssignFromTStrings(src : TStrings); // IndexOf // -function TUnicodeStringList.IndexOf(const s : UnicodeString) : Integer; +function TUnicodeStringList.IndexOf(const s : UnicodeString) : NativeInt; begin if usflSorted in FFlags then begin if Find(s, Result) then Exit; @@ -249,9 +249,9 @@ function TUnicodeStringList.Contains(const s : UnicodeString) : Boolean; // FindName // -function TUnicodeStringList.FindName(const name : UnicodeString; var index : Integer) : Boolean; +function TUnicodeStringList.FindName(const name : UnicodeString; var index : NativeInt) : Boolean; var - lo, hi, mid, cmp, n, nc : Integer; + lo, hi, mid, cmp, n, nc : NativeInt; initial : UnicodeString; begin Result := False; @@ -282,9 +282,9 @@ function TUnicodeStringList.FindName(const name : UnicodeString; var index : Int // IndexOfName // -function TUnicodeStringList.IndexOfName(const name : UnicodeString) : Integer; +function TUnicodeStringList.IndexOfName(const name : UnicodeString) : NativeInt; var - n, nc : Integer; + n, nc : NativeInt; begin if not Sorted then begin n:=Length(name); @@ -303,7 +303,7 @@ function TUnicodeStringList.IndexOfName(const name : UnicodeString) : Integer; // Add // -function TUnicodeStringList.Add(const s : UnicodeString) : Integer; +function TUnicodeStringList.Add(const s : UnicodeString) : NativeInt; begin if usflSorted in FFlags then begin Find(s, Result); @@ -319,7 +319,7 @@ function TUnicodeStringList.Add(const s : UnicodeString) : Integer; // Insert // -procedure TUnicodeStringList.Insert(index : Integer; const s : UnicodeString); +procedure TUnicodeStringList.Insert(index : NativeInt; const s : UnicodeString); begin if FCount = Length(FItems) then SetLength(FItems, (FCount div 4)+4); @@ -332,9 +332,9 @@ procedure TUnicodeStringList.Insert(index : Integer; const s : UnicodeString); // Delete // -procedure TUnicodeStringList.Delete(index : Integer); +procedure TUnicodeStringList.Delete(index : NativeInt); var - n : Integer; + n : NativeInt; begin FItems[index] := ''; n := FCount-index-1; @@ -352,9 +352,9 @@ procedure TUnicodeStringList.Clear; // Find // -function TUnicodeStringList.Find(const s : UnicodeString; var index : Integer) : Boolean; +function TUnicodeStringList.Find(const s : UnicodeString; var index : NativeInt) : Boolean; var - low, high, mid, cmp : Integer; + low, high, mid, cmp : NativeInt; begin Result := False; low := 0; @@ -376,7 +376,7 @@ function TUnicodeStringList.Find(const s : UnicodeString; var index : Integer) : // Exchange // -procedure TUnicodeStringList.Exchange(index1, index2 : Integer); +procedure TUnicodeStringList.Exchange(index1, index2 : NativeInt); var p1, p2 : PPointer; buf : Pointer; diff --git a/Source/dwsUtils.pas b/Source/dwsUtils.pas index d7581e53..e44fcab2 100644 --- a/Source/dwsUtils.pas +++ b/Source/dwsUtils.pas @@ -32,6 +32,7 @@ interface TStringDynArray = array of String; TInt64DynArray = array of Int64; TDoubleDynArray = array of Double; + TInterfaceDynArray = array of IUnknown; TInt64Array = array [0..High(MaxInt) shr 4] of Int64; PInt64Array = ^TInt64Array; @@ -866,10 +867,10 @@ ETightListOutOfBound = class(Exception) TQuickSort = record public - CompareMethod : function (index1, index2 : Integer) : Integer of object; - SwapMethod : procedure (index1, index2 : Integer) of object; + CompareMethod : function (index1, index2 : NativeInt) : Integer of object; + SwapMethod : procedure (index1, index2 : NativeInt) of object; - procedure Sort(minIndex, maxIndex : Integer); + procedure Sort(minIndex, maxIndex : NativeInt); end; TStringIterator = class @@ -6452,9 +6453,9 @@ function TClassCloneConstructor.Create : T; // Sort // -procedure TQuickSort.Sort(minIndex, maxIndex : Integer); +procedure TQuickSort.Sort(minIndex, maxIndex : NativeInt); var - i, j, p, n : Integer; + i, j, p, n : NativeInt; begin n:=maxIndex-minIndex; case n of diff --git a/Source/jitter/dwsJIT.pas b/Source/jitter/dwsJIT.pas index 46b6f5f6..0105ea42 100644 --- a/Source/jitter/dwsJIT.pas +++ b/Source/jitter/dwsJIT.pas @@ -231,6 +231,7 @@ TdwsJIT = class function CompileBooleanValue(expr : TTypedExpr) : Integer; procedure CompileBoolean(expr : TTypedExpr; targetTrue, targetFalse : TFixup); function CompileScriptObj(expr : TTypedExpr) : Integer; + function CompileScriptDynArray(expr : TTypedExpr) : Integer; procedure CompileAssignFloat(expr : TTypedExpr; source : Integer); procedure CompileAssignInteger(expr : TTypedExpr; source : Integer); @@ -240,6 +241,8 @@ TdwsJIT = class function IsFloat(typ : TTypeSymbol) : Boolean; overload; function IsInteger(expr : TTypedExpr) : Boolean; overload; function IsBoolean(expr : TTypedExpr) : Boolean; overload; + function IsDynamicArray(expr : TTypedExpr) : Boolean; overload; + function IsInterface(expr : TTypedExpr) : Boolean; overload; property LoopContext : TJITLoopContext read FLoopContext; property ExitTarget : TFixupTarget read FExitTarget; @@ -508,7 +511,7 @@ function TdwsJIT.FindJITter(exprClass : TClass) : TdwsJITter; FTempReg.Expr:=exprClass; if FRegistered.Find(FTempReg, i) then Result:=FRegistered.Items[i].JIT - else Result:=nil; + else Result := nil; end; // FindJITter @@ -658,6 +661,19 @@ function TdwsJIT.CompileScriptObj(expr : TTypedExpr) : Integer; end else Result:=jit.CompileScriptObj(expr); end; +// CompileScriptDynArray +// +function TdwsJIT.CompileScriptDynArray(expr : TTypedExpr) : Integer; +var + jit : TdwsJITter; +begin + jit:=FindJITter(expr); + if jit=nil then begin + OutputFailedOn:=expr; + Result:=0; + end else Result:=jit.CompileScriptObj(expr); +end; + // CompileAssignFloat // procedure TdwsJIT.CompileAssignFloat(expr : TTypedExpr; source : Integer); @@ -722,6 +738,26 @@ function TdwsJIT.IsBoolean(expr : TTypedExpr) : Boolean; Result:=(expr.Typ.UnAliasedType.ClassType=TBaseBooleanSymbol); end; +// IsDynamicArray +// +function TdwsJIT.IsDynamicArray(expr : TTypedExpr) : Boolean; +var + ct : TClass; +begin + ct := expr.Typ.UnAliasedType.ClassType; + Result := (ct = TDynamicArraySymbol); +end; + +// IsInterface +// +function TdwsJIT.IsInterface(expr : TTypedExpr) : Boolean; +var + ct : TClass; +begin + ct := expr.Typ.UnAliasedType.ClassType; + Result := (ct = TClassSymbol) or (ct = TDynamicArraySymbol) or (ct = TInterfaceSymbol); +end; + // EnterLoop // procedure TdwsJIT.EnterLoop(targetContinue, targetExit : TFixup); diff --git a/Source/jitter/dwsJITx86Intrinsics.pas b/Source/jitter/dwsJITx86Intrinsics.pas index c21a5288..0b2582c3 100644 --- a/Source/jitter/dwsJITx86Intrinsics.pas +++ b/Source/jitter/dwsJITx86Intrinsics.pas @@ -53,6 +53,10 @@ interface xmm_movsd = $10 ); + TxmmOp_pd = ( + xmm_andpd = $54 + ); + TgpRegister = ( gprEAX = 0, gprECX = 1, gprEDX = 2, gprEBX = 3, gprESP = 4, gprEBP = 5, gprESI = 6, gprEDI = 7 diff --git a/Source/jitter/dwsJITx86_64.pas b/Source/jitter/dwsJITx86_64.pas index 58d72fb2..76a41a89 100644 --- a/Source/jitter/dwsJITx86_64.pas +++ b/Source/jitter/dwsJITx86_64.pas @@ -153,6 +153,7 @@ Tx86_64FixupLogicHelper = class helper for TFixupLogic function NewGPOpRegImm(const op : TgpOp; reg : TgpRegister64; const value : Int64) : TStaticDataFixup; function NewNegRegImm(reg : TxmmRegister) : TStaticDataFixup; function NewXMMOpRegImm(op : TxmmOp; reg : TxmmRegister; const value : Double) : TStaticDataFixup; + function NewXMMOpRegPDImm(op : TxmmOp_pd; reg : TxmmRegister; const value1, value2 : Double) : TStaticDataFixup; function AddStaticData(const data : UInt64) : Integer; function AddStaticData128(const data1, data2 : UInt64) : Integer; @@ -234,6 +235,7 @@ TdwsJITx86_64 = class (TdwsJIT) procedure CompileAssignExprToInteger(dest, source : TTypedExpr); function CompileScriptObj(expr : TTypedExpr) : TgpRegister64; + function CompileScriptDynArray(expr : TTypedExpr) : TgpRegister64; procedure CompileBoolean(expr : TTypedExpr; targetTrue, targetFalse : TFixup); @@ -393,19 +395,19 @@ Tx86StaticArray = class (Tx86ArrayBase) procedure DoCompileAssignFloat(expr : TTypedExpr; source : TxmmRegister); override; // procedure CompileAssignInteger(expr : TTypedExpr; source : Integer); override; end; -(* Tx86DynamicArrayBase = class (Tx86ArrayBase) - function CompileAsData(expr : TTypedExpr) : TgpRegister64; - function CompileAsItemPtr(base, index : TTypedExpr; var offset : Integer) : TgpRegister64; + + Tx86DynamicArrayBase = class (Tx86ArrayBase) + function CompileAsData(expr : TTypedExpr; elementType : TVarType) : TgpRegister64; + function CompileAsItemPtr(base, index : TTypedExpr; var offset : Integer; elementType : TVarType) : TgpRegister64; end; Tx86DynamicArray = class (Tx86DynamicArrayBase) function DoCompileFloat(expr : TTypedExpr) : TxmmRegister; override; -// function CompileInteger(expr : TTypedExpr) : Integer; override; -// function CompileScriptObj(expr : TTypedExpr) : Integer; override; + function DoCompileInteger(expr : TTypedExpr) : TgpRegister64; override; + function DoCompileScriptObj(expr : TTypedExpr) : TgpRegister64; override; end; Tx86DynamicArraySet = class (Tx86DynamicArrayBase) procedure CompileStatement(expr : TExprBase); override; end; - *) Tx86AssignConstToFloatVar = class (TdwsJITter_x86) procedure CompileStatement(expr : TExprBase); override; @@ -630,14 +632,14 @@ Tx86DirectCallFunc = class (Tx86InterpretedExpr) procedure DoCompileBoolean(expr : TTypedExpr; targetTrue, targetFalse : TFixup); override; function CompileBooleanValue(expr : TTypedExpr) : Integer; override; end; -{ + Tx86AbsIntFunc = class (TdwsJITter_x86) - function CompileInteger(expr : TTypedExpr) : Integer; override; + function DoCompileInteger(expr : TTypedExpr) : TgpRegister64; override; end; Tx86AbsFloatFunc = class (TdwsJITter_x86) function DoCompileFloat(expr : TTypedExpr) : TxmmRegister; override; end; -} + Tx86SqrtFunc = class (Tx86MagicFunc) function DoCompileFloat(expr : TTypedExpr) : TxmmRegister; override; end; @@ -830,10 +832,10 @@ constructor TdwsJITx86_64.Create; RegisterJITter(TVarParamParentExpr, FInterpretedJITter.IncRefCount); RegisterJITter(TStaticArrayExpr, Tx86StaticArray.Create(Self)); - RegisterJITter(TDynamicArrayExpr, FInterpretedJITter.IncRefCount); //Tx86DynamicArray.Create(Self)); - RegisterJITter(TDynamicArrayVarExpr, FInterpretedJITter.IncRefCount); //Tx86DynamicArray.Create(Self)); - RegisterJITter(TDynamicArraySetExpr, FInterpretedJITter.IncRefCount); //Tx86DynamicArraySet.Create(Self)); - RegisterJITter(TDynamicArraySetVarExpr, FInterpretedJITter.IncRefCount); //Tx86DynamicArraySet.Create(Self)); + RegisterJITter(TDynamicArrayExpr, Tx86DynamicArray.Create(Self)); + RegisterJITter(TDynamicArrayVarExpr, Tx86DynamicArray.Create(Self)); + RegisterJITter(TDynamicArraySetExpr, Tx86DynamicArraySet.Create(Self)); + RegisterJITter(TDynamicArraySetVarExpr, Tx86DynamicArraySet.Create(Self)); RegisterJITter(TDynamicArraySetDataExpr, FInterpretedJITter.IncRefCount); RegisterJITter(TArrayLengthExpr, FInterpretedJITter.IncRefCount); @@ -1000,7 +1002,7 @@ constructor TdwsJITx86_64.Create; RegisterJITter(TRelNotEqualBoolExpr, FInterpretedJITter.IncRefCount); RegisterJITter(TRelEqualMetaExpr, Tx86RelEqualInt.Create(Self)); - RegisterJITter(TRelNotEqualMetaExpr, FInterpretedJITter.IncRefCount);// Tx86RelNotEqualInt.Create(Self)); + RegisterJITter(TRelNotEqualMetaExpr, Tx86RelNotEqualInt.Create(Self)); RegisterJITter(TRelVarEqualNilExpr, FInterpretedJITter.IncRefCount); RegisterJITter(TRelVarNotEqualNilExpr, FInterpretedJITter.IncRefCount); @@ -1066,8 +1068,8 @@ constructor TdwsJITx86_64.Create; RegisterJITter(TMagicIntFuncExpr, Tx86MagicFunc.Create(Self)); RegisterJITter(TMagicBoolFuncExpr, Tx86MagicFunc.Create(Self)); - RegisterJITter(TAbsIntFunc, FInterpretedJITter.IncRefCount);// Tx86AbsIntFunc.Create(Self)); - RegisterJITter(TAbsFloatFunc, FInterpretedJITter.IncRefCount);// Tx86AbsFloatFunc.Create(Self)); + RegisterJITter(TAbsIntFunc, Tx86AbsIntFunc.Create(Self)); + RegisterJITter(TAbsFloatFunc, Tx86AbsFloatFunc.Create(Self)); RegisterJITter(TSqrtFunc, Tx86SqrtFunc.Create(Self)); RegisterJITter(TSqrFloatFunc, Tx86SqrFloatFunc.Create(Self)); @@ -1542,6 +1544,13 @@ function TdwsJITx86_64.CompileScriptObj(expr : TTypedExpr) : TgpRegister64; Result := TgpRegister64(inherited CompileScriptObj(expr)); end; +// CompileScriptDynArray +// +function TdwsJITx86_64.CompileScriptDynArray(expr : TTypedExpr) : TgpRegister64; +begin + Result := TgpRegister64(inherited CompileScriptDynArray(expr)); +end; + // CompileBoolean // procedure TdwsJITx86_64.CompileBoolean(expr : TTypedExpr; targetTrue, targetFalse : TFixup); @@ -2391,6 +2400,19 @@ function Tx86_64FixupLogicHelper.NewXMMOpRegImm(op : TxmmOp; reg : TxmmRegister; AddFixup(Result); end; +// NewXMMOpRegPDImm +// +function Tx86_64FixupLogicHelper.NewXMMOpRegPDImm(op : TxmmOp_pd; reg : TxmmRegister; const value1, value2 : Double) : TStaticDataFixup; +begin + if reg < xmm8 then + Result := TStaticDataFixup.Create([$66, $0F, Ord(op), $05 + 8*(Ord(reg) and 7)]) + else Result := TStaticDataFixup.Create([$66, $44, $0F, Ord(op), $05 + 8*(Ord(reg) and 7)]); + Assert(reg in [xmm0..High(TxmmRegister)]); + Result.Logic := Self; + Result.DataIndex := AddStaticData128(PUInt64(@value1)^, PUInt64(@value2)^); + AddFixup(Result); +end; + // AddStaticData // function Tx86_64FixupLogicHelper.AddStaticData(const data : UInt64) : Integer; @@ -2554,7 +2576,7 @@ procedure TdwsJITter_x86.CompileBoolean(expr : TTypedExpr; targetTrue, targetFal // procedure TdwsJITter_x86.DoCompileBoolean(expr : TTypedExpr; targetTrue, targetFalse : TFixup); begin - jit.OutputFailedOn:=expr; + jit.OutputFailedOn := expr; end; // ------------------ @@ -4037,59 +4059,83 @@ procedure Tx86StaticArray.CompileAssignInteger(expr : TTypedExpr; source : Integ end else inherited; end; } + // ------------------ // ------------------ Tx86DynamicArrayBase ------------------ // ------------------ -(* + // CompileAsData // -function Tx86DynamicArrayBase.CompileAsData(expr : TTypedExpr) : TgpRegister64; +function Tx86DynamicArrayBase.CompileAsData(expr : TTypedExpr; elementType : TVarType) : TgpRegister64; var - regObj : TgpRegister64; + regDyn : TgpRegister64; begin - regObj := jit.CompileScriptObj(expr); - jit.ReleaseGPReg(regObj); + regDyn := jit.CompileScriptDynArray(expr); + jit.ReleaseGPReg(regDyn); Result := jit.AllocGPReg(nil); - x86._mov_reg_qword_ptr_reg(Result, regObj, vmt_ScriptDynamicArray_IScriptObj_To_FData); + case elementType of + varDouble : + x86._mov_reg_qword_ptr_reg(Result, regDyn, vmt_ScriptDynamicFloatArray_IScriptDynArray_To_DataPointer); + varInt64 : + x86._mov_reg_qword_ptr_reg(Result, regDyn, vmt_ScriptDynamicIntegerArray_IScriptDynArray_To_DataPointer); + varUnknown : + x86._mov_reg_qword_ptr_reg(Result, regDyn, vmt_ScriptDynamicInterfaceArray_IScriptDynArray_To_DataPointer); + else + Assert(False); + end; end; // CompileAsItemPtr // -function Tx86DynamicArrayBase.CompileAsItemPtr(base, index : TTypedExpr; var offset : Integer) : TgpRegister64; +function Tx86DynamicArrayBase.CompileAsItemPtr(base, index : TTypedExpr; var offset : Integer; elementType : TVarType) : TgpRegister64; var indexClass : TClass; + elementSize : Integer; begin + case elementType of + varDouble : elementSize := SizeOf(Double); + varInt64 : elementSize := SizeOf(Int64); + varUnknown : elementSize := SizeOf(IUnknown); + else + elementSize := 0; + Assert(False); + end; + indexClass := index.ClassType; if indexClass = TAddIntExpr then begin if TAddIntExpr(index).Right.ClassType = TConstIntExpr then begin - Result := CompileAsItemPtr(base, TAddIntExpr(index).Left, offset); - offset := offset + TConstIntExpr(TAddIntExpr(index).Right).Value * SizeOf(Variant); + offset := offset + TConstIntExpr(TAddIntExpr(index).Right).Value * elementSize; + Result := CompileAsItemPtr(base, TAddIntExpr(index).Left, offset, elementType); Exit; end; end else if indexClass = TSubIntExpr then begin if TSubIntExpr(index).Right.ClassType = TConstIntExpr then begin - Result := CompileAsItemPtr(base, TSubIntExpr(index).Left, offset); - offset := offset - TConstIntExpr(TSubIntExpr(index).Right).Value * SizeOf(Variant); + offset := offset - TConstIntExpr(TSubIntExpr(index).Right).Value * elementSize; + Result := CompileAsItemPtr(base, TSubIntExpr(index).Left, offset, elementType); Exit; end; end; - Result := CompileAsData(base); - - offset := cVariant_DataOffset; + Result := CompileAsData(base, elementType); if index is TConstIntExpr then begin - x86._add_reg_imm(Result, TConstIntExpr(index).Value * SizeOf(Variant)); + x86._add_reg_imm(Result, TConstIntExpr(index).Value * elementSize); end else begin var regIdx := jit.CompileIntegerToRegister(index); - x86._imul_reg_reg_imm(gprRAX, regIdx, SizeOf(Variant)); - jit.ReleaseGPReg(regIdx); - x86._add_reg_reg(Result, gprRAX); + if (elementSize in [ 1, 2, 4, 8 ]) and not (regIdx in [ gprRSP, gprR12 ]) then begin + x86._lea_reg_ptr_indexed_reg(Result, Result, regIdx, elementSize, offset); + jit.ReleaseGPReg(regIdx); + offset := 0; + end else begin + x86._imul_reg_reg_imm(gprRAX, regIdx, elementSize); + jit.ReleaseGPReg(regIdx); + x86._add_reg_reg(Result, gprRAX); + end; - end; + end; end; // ------------------ @@ -4104,11 +4150,12 @@ function Tx86DynamicArray.DoCompileFloat(expr : TTypedExpr) : TxmmRegister; regPtr : TgpRegister64; offset : Integer; begin - e:=TDynamicArrayExpr(expr); + e := TDynamicArrayExpr(expr); if jit.IsFloat(e) then begin - regPtr := CompileAsItemPtr(e.BaseExpr, e.IndexExpr, offset); + offset := 0; + regPtr := CompileAsItemPtr(e.BaseExpr, e.IndexExpr, offset, varDouble); Result := jit.AllocXMMReg(e); x86._movsd_reg_qword_ptr_reg(Result, regPtr, offset); @@ -4117,39 +4164,54 @@ function Tx86DynamicArray.DoCompileFloat(expr : TTypedExpr) : TxmmRegister; end else Result:=inherited; end; -{ -// CompileInteger + + +// DoCompileInteger // -function Tx86DynamicArray.CompileInteger(expr : TTypedExpr) : Integer; +function Tx86DynamicArray.DoCompileInteger(expr : TTypedExpr) : TgpRegister64; var e : TDynamicArrayExpr; - delta : Integer; + regPtr : TgpRegister64; + offset : Integer; begin - e:=TDynamicArrayExpr(expr); + e := TDynamicArrayExpr(expr); + + if jit.IsInteger(e) then begin - CompileAsItemPtr(e, delta); + offset := 0; + regPtr := CompileAsItemPtr(e.BaseExpr, e.IndexExpr, offset, varInt64); - x86._mov_reg_qword_ptr_indexed(gprRAW, gprRAX, gprRDX, 1, delta); + Result := jit.AllocGPReg(e); + x86._mov_reg_qword_ptr_reg(Result, regPtr, offset); - Result:=0; + jit.ReleaseGPReg(regPtr); + + end else Result := inherited; end; -// CompileScriptObj +// DoCompileScriptObj // -function Tx86DynamicArray.CompileScriptObj(expr : TTypedExpr) : Integer; +function Tx86DynamicArray.DoCompileScriptObj(expr : TTypedExpr) : TgpRegister64; var e : TDynamicArrayExpr; - delta : Integer; + regPtr : TgpRegister64; + offset : Integer; begin - e:=TDynamicArrayExpr(expr); + e := TDynamicArrayExpr(expr); - CompileAsItemPtr(e, delta); + if jit.IsDynamicArray(e) then begin - x86._mov_reg_qword_ptr_indexed(gprRAW, gprRAX, gprRDX, 1, delta); + offset := 0; + regPtr := CompileAsItemPtr(e.BaseExpr, e.IndexExpr, offset, varUnknown); - Result:=0; + Result := jit.AllocGPReg(e); + x86._mov_reg_qword_ptr_reg(Result, regPtr, offset); + + jit.ReleaseGPReg(regPtr); + + end else Result := inherited; end; -} + // ------------------ // ------------------ Tx86DynamicArraySet ------------------ // ------------------ @@ -4159,23 +4221,37 @@ function Tx86DynamicArray.CompileScriptObj(expr : TTypedExpr) : Integer; procedure Tx86DynamicArraySet.CompileStatement(expr : TExprBase); var e : TDynamicArraySetExpr; - reg : TxmmRegister; + regValueFloat : TxmmRegister; + regValueGP : TgpRegister64; regPtr : TgpRegister64; offset : Integer; + elementTypeClass : TClass; begin e:=TDynamicArraySetExpr(expr); - if jit.IsFloat(e.ArrayExpr.Typ.Typ) then begin + elementTypeClass := e.ArrayExpr.Typ.Typ.UnAliasedType.ClassType; - regPtr := CompileAsItemPtr(e.ArrayExpr, e.IndexExpr, offset); - reg := jit.CompileFloat(e.ValueExpr); - x86._movsd_qword_ptr_reg_reg(regPtr, offset, reg); - jit.ReleaseXMMReg(reg); + if elementTypeClass = TBaseIntegerSymbol then begin + + offset := 0; + regPtr := CompileAsItemPtr(e.ArrayExpr, e.IndexExpr, offset, varInt64); + regValueGP := jit.CompileIntegerToRegister(e.ValueExpr); + x86._mov_qword_ptr_reg_reg(regPtr, offset, regValueGP); + jit.ReleaseGPReg(regValueGP); + jit.ReleaseGPReg(regPtr); + + end else if elementTypeClass = TBaseFloatSymbol then begin + + offset := 0; + regPtr := CompileAsItemPtr(e.ArrayExpr, e.IndexExpr, offset, varDouble); + regValueFloat := jit.CompileFloat(e.ValueExpr); + x86._movsd_qword_ptr_reg_reg(regPtr, offset, regValueFloat); + jit.ReleaseXMMReg(regValueFloat); jit.ReleaseGPReg(regPtr); end else inherited; end; -*) + // ------------------ // ------------------ Tx86NegInt ------------------ // ------------------ @@ -5200,26 +5276,37 @@ function Tx86DirectCallFunc.CompileBooleanValue(expr : TTypedExpr) : Integer; x86._op_reg_imm(gpOp_and, gprRAX, 1); Result:=0; end; -{ + // ------------------ // ------------------ Tx86AbsIntFunc ------------------ // ------------------ -// CompileInteger +// DoCompileInteger // -function Tx86AbsIntFunc.CompileInteger(expr : TTypedExpr) : Integer; +function Tx86AbsIntFunc.DoCompileInteger(expr : TTypedExpr) : TgpRegister64; var jump : TFixupJump; + opReg : TgpRegister64; begin - Result := jit.CompileInteger(TMagicFuncExpr(expr).Args[0] as TTypedExpr); + opReg := jit.CompileIntegerToRegister(TMagicFuncExpr(expr).Args[0] as TTypedExpr); - x86._test_reg_reg(gprEDX, gprEDX); + x86._test_reg_reg(opReg, opReg); - jump:=jit.Fixups.NewJump(flagsNL); + if jit.IsSymbolGPReg(opReg) then begin - x86._neg_reg(gprEDX); - x86._neg_reg(gprEAX); - x86._sbb_reg_int32(gprEDX, 0); + Result := jit.AllocGPReg(expr); + x86._mov_reg_reg(Result, opReg); + jit.ReleaseGPReg(opReg); + + end else begin + + Result := opReg; + jit.SetContainsGPReg(Result, expr); + + end; + jump := jit.Fixups.NewJump(flagsNL); + + x86._neg_reg(Result); jump.NewTarget(False); end; @@ -5231,16 +5318,30 @@ function Tx86AbsIntFunc.CompileInteger(expr : TTypedExpr) : Integer; // DoCompileFloat // function Tx86AbsFloatFunc.DoCompileFloat(expr : TTypedExpr) : TxmmRegister; +const + cAbsMask : array [0..SizeOf(Double)-1] of Byte = ( $FF, $FF, $FF, $FF, $FF, $FF, $FF, $7F ); +var + opReg : TxmmRegister; begin - Result:=jit.CompileFloat(TMagicFuncExpr(expr).Args[0] as TTypedExpr); + opReg := jit.CompileFloat(TMagicFuncExpr(expr).Args[0] as TTypedExpr); - // andpd Result, dqword ptr [AbsMask] - x86.WriteBytes([$66, $0F, $54, $05+Ord(Result)*8]); - x86.WritePointer(jit.AbsMaskPD); + if jit.IsSymbolXMMReg(opReg) then begin - jit.ContainsXMMReg(Result, expr); + Result := jit.AllocXMMReg(expr); + x86._movsd_reg_reg(Result, opReg); + jit.ReleaseXMMReg(opReg); + + end else begin + + Result := opReg; + jit.SetContainsXMMReg(Result, expr); + + end; + + // andpd Result, dqword ptr [AbsMask] + jit.Fixups.NewXMMOpRegPDImm(xmm_andpd, Result, PDouble(@cAbsMask)^, PDouble(@cAbsMask)^); end; -} + // ------------------ // ------------------ Tx86SqrtFunc ------------------ // ------------------ diff --git a/Source/jitter/dwsVMTOffsets.pas b/Source/jitter/dwsVMTOffsets.pas index 9933d0c1..a4d77678 100644 --- a/Source/jitter/dwsVMTOffsets.pas +++ b/Source/jitter/dwsVMTOffsets.pas @@ -43,6 +43,10 @@ interface // vmt_ScriptDynamicArray_IScriptObj_To_FData : Integer; vmt_ScriptObjInstance_IScriptObj_To_FData : Integer; + vmt_ScriptDynamicFloatArray_IScriptDynArray_To_DataPointer : Integer; + vmt_ScriptDynamicIntegerArray_IScriptDynArray_To_DataPointer : Integer; + vmt_ScriptDynamicInterfaceArray_IScriptDynArray_To_DataPointer : Integer; + fld_TdwsExecution_Status : Integer; {$IF Defined(WIN32)} @@ -95,20 +99,18 @@ procedure PrepareVMTOffsets; procedure PrepareDynArrayIDataContextToFDataOffset; var - sda : TScriptDynamicArray; soi : TScriptObjInstance; - ia : IScriptDynArray; io : IScriptObj; begin - sda:=TScriptDynamicDataArray.Create(nil); - ia:=IScriptDynArray(sda); - -// vmt_ScriptDynamicArray_IScriptObj_To_FData:=NativeInt(ia.AsPData)-NativeInt(ia); + vmt_ScriptDynamicFloatArray_IScriptDynArray_To_DataPointer := TScriptDynamicNativeFloatArray.InterfaceToDataOffset; + vmt_ScriptDynamicIntegerArray_IScriptDynArray_To_DataPointer := TScriptDynamicNativeIntegerArray.InterfaceToDataOffset; + vmt_ScriptDynamicInterfaceArray_IScriptDynArray_To_DataPointer := TScriptDynamicNativeInterfaceArray.InterfaceToDataOffset; soi:=TScriptObjInstance.Create(nil); io:=IScriptObj(soi); vmt_ScriptObjInstance_IScriptObj_To_FData:=NativeInt(io.AsPData)-NativeInt(io); + end; // ------------------------------------------------------------------ diff --git a/Test/SimpleScripts/array_of_array.pas b/Test/SimpleScripts/array_of_array.pas new file mode 100644 index 00000000..2e85bc10 --- /dev/null +++ b/Test/SimpleScripts/array_of_array.pas @@ -0,0 +1,30 @@ +var a : array of array of String; + +procedure PrintA; +begin + PrintLn(a.Map(lambda (e) => e.Join(',')).Join(';')); +end; + +a.Add(('a-b').Split('-'), ('c-d').Split('-')); + +PrintA; + +a.Move(0, 1); +PrintA; + +a.Move(1, 0); +PrintA; + +a.Insert(1, ('foo').Split(',')); + +a.Move(0, 2); +PrintA; + +a.Move(2, 0); +PrintA; + +a.Reverse; +PrintA; + +a.Add(a.Copy); +PrintA; \ No newline at end of file diff --git a/Test/SimpleScripts/array_of_array.txt b/Test/SimpleScripts/array_of_array.txt new file mode 100644 index 00000000..789a26e7 --- /dev/null +++ b/Test/SimpleScripts/array_of_array.txt @@ -0,0 +1,7 @@ +a,b;c,d +c,d;a,b +a,b;c,d +foo;c,d;a,b +a,b;foo;c,d +c,d;foo;a,b +c,d;foo;a,b;c,d;foo;a,b \ No newline at end of file diff --git a/Test/UdwsUtilsTests.pas b/Test/UdwsUtilsTests.pas index fd4873e4..e46545cc 100644 --- a/Test/UdwsUtilsTests.pas +++ b/Test/UdwsUtilsTests.pas @@ -822,14 +822,14 @@ procedure TdwsUtilsTests.StrContainsTest; type TSortable = class Items : array of Integer; - function Compare(i1, i2 : Integer) : Integer; - procedure Swap(i1, i2 : Integer); + function Compare(i1, i2 : NativeInt) : Integer; + procedure Swap(i1, i2 : NativeInt); end; -function TSortable.Compare(i1, i2 : Integer) : Integer; +function TSortable.Compare(i1, i2 : NativeInt) : Integer; begin Result:=Items[i1]-Items[i2]; end; -procedure TSortable.Swap(i1, i2 : Integer); +procedure TSortable.Swap(i1, i2 : NativeInt); var t : Integer; begin