mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-08-27 17:40:23 +02:00
rtl: added TVarRec and compiler utility function VarRecs
This commit is contained in:
parent
eff31f67be
commit
6daad959fb
@ -213,6 +213,55 @@ const
|
|||||||
|
|
||||||
function GUIDToString(const GUID: TGUID): string; external name 'rtl.guidrToStr';
|
function GUIDToString(const GUID: TGUID): string; external name 'rtl.guidrToStr';
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
Array of const support
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
|
const
|
||||||
|
vtInteger = 0;
|
||||||
|
vtBoolean = 1;
|
||||||
|
//vtChar = 2; // Delphi/FPC: ansichar
|
||||||
|
vtExtended = 3; // Note: double in pas2js, PExtended in Delphi/FPC
|
||||||
|
//vtString = 4; // Delphi/FPC: PShortString
|
||||||
|
vtPointer = 5;
|
||||||
|
//vtPChar = 6;
|
||||||
|
vtObject = 7;
|
||||||
|
vtClass = 8;
|
||||||
|
vtWideChar = 9;
|
||||||
|
//vtPWideChar = 10;
|
||||||
|
//vtAnsiString = 11;
|
||||||
|
vtCurrency = 12; // Note: currency in pas2js, PCurrency in Delphi/FPC
|
||||||
|
//vtVariant = 13;
|
||||||
|
vtInterface = 14;
|
||||||
|
//vtWideString = 15;
|
||||||
|
//vtInt64 = 16;
|
||||||
|
//vtQWord = 17;
|
||||||
|
vtUnicodeString = 18;
|
||||||
|
// only pas2js, not in Delphi/FPC:
|
||||||
|
vtNativeInt = 19;
|
||||||
|
vtJSValue = 20;
|
||||||
|
|
||||||
|
type
|
||||||
|
PVarRec = ^TVarRec;
|
||||||
|
TVarRec = record
|
||||||
|
VType: byte;
|
||||||
|
VJSValue: JSValue;
|
||||||
|
VInteger: LongInt external name 'VJSValue';
|
||||||
|
VBoolean: Boolean external name 'VJSValue';
|
||||||
|
VExtended: Double external name 'VJSValue';
|
||||||
|
VPointer: Pointer external name 'VJSValue';
|
||||||
|
VObject: TObject external name 'VJSValue';
|
||||||
|
VClass: TClass external name 'VJSValue';
|
||||||
|
VWideChar: WideChar external name 'VJSValue';
|
||||||
|
VCurrency: Currency external name 'VJSValue';
|
||||||
|
VInterface: Pointer external name 'VJSValue';
|
||||||
|
VUnicodeString: UnicodeString external name 'VJSValue';
|
||||||
|
VNativeInt: NativeInt external name 'VJSValue';
|
||||||
|
end;
|
||||||
|
TVarRecArray = array of TVarRec;
|
||||||
|
|
||||||
|
function VarRecs: TVarRecArray; varargs;
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Init / Exit / ExitProc
|
Init / Exit / ExitProc
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -320,6 +369,24 @@ type
|
|||||||
property Properties[Name: String]: JSValue read GetProperties write SetProperties; default;
|
property Properties[Name: String]: JSValue read GetProperties write SetProperties; default;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
TJSArray = class external name 'Array'
|
||||||
|
public
|
||||||
|
length: nativeint;
|
||||||
|
constructor new; overload;
|
||||||
|
function push(aElement : JSValue) : NativeInt; varargs;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TJSArguments = class external name 'arguments'
|
||||||
|
private
|
||||||
|
FLength: NativeInt; external name 'length';
|
||||||
|
function GetElements(Index: NativeInt): JSValue; external name '[]';
|
||||||
|
public
|
||||||
|
property Length: NativeInt read FLength;
|
||||||
|
property Elements[Index: NativeInt]: JSValue read GetElements; default;
|
||||||
|
end;
|
||||||
|
var
|
||||||
|
JSArguments: TJSArguments; external name 'arguments';
|
||||||
|
|
||||||
// function parseInt(s: String; Radix: NativeInt): NativeInt; external name 'parseInt'; // may result NaN
|
// function parseInt(s: String; Radix: NativeInt): NativeInt; external name 'parseInt'; // may result NaN
|
||||||
function isNaN(i: JSValue): boolean; external name 'isNaN'; // may result NaN
|
function isNaN(i: JSValue): boolean; external name 'isNaN'; // may result NaN
|
||||||
|
|
||||||
@ -329,6 +396,23 @@ asm
|
|||||||
return s1.toLowerCase() == s2.toLowerCase();
|
return s1.toLowerCase() == s2.toLowerCase();
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function VarRecs: TVarRecArray;
|
||||||
|
var
|
||||||
|
i: nativeint;
|
||||||
|
v: PVarRec;
|
||||||
|
begin
|
||||||
|
Result:=nil;
|
||||||
|
while i<JSArguments.Length do
|
||||||
|
begin
|
||||||
|
new(v);
|
||||||
|
v^.VType:=byte(JSArguments[i]);
|
||||||
|
inc(i);
|
||||||
|
v^.VJSValue:=JSArguments[i];
|
||||||
|
inc(i);
|
||||||
|
TJSArray(Result).push(v^);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
function ParamCount: Longint;
|
function ParamCount: Longint;
|
||||||
begin
|
begin
|
||||||
if Assigned(OnParamCount) then
|
if Assigned(OnParamCount) then
|
||||||
@ -347,7 +431,6 @@ begin
|
|||||||
Result:='';
|
Result:='';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function Frac(const A: Double): Double; assembler;
|
function Frac(const A: Double): Double; assembler;
|
||||||
asm
|
asm
|
||||||
return A % 1;
|
return A % 1;
|
||||||
@ -431,18 +514,8 @@ begin
|
|||||||
Target:=copy(t,1,Index-1)+Insertion+copy(t,Index,length(t));
|
Target:=copy(t,1,Index-1)+Insertion+copy(t,Index,length(t));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
type
|
|
||||||
TJSArguments = class external name 'arguments'
|
|
||||||
private
|
|
||||||
FLength: NativeInt; external name 'length';
|
|
||||||
function GetElements(Index: NativeInt): JSValue; external name '[]';
|
|
||||||
public
|
|
||||||
property Length: NativeInt read FLength;
|
|
||||||
property Elements[Index: NativeInt]: JSValue read GetElements; default;
|
|
||||||
end;
|
|
||||||
var
|
var
|
||||||
WriteBuf: String;
|
WriteBuf: String;
|
||||||
JSArguments: TJSArguments; external name 'arguments';
|
|
||||||
WriteCallBack : TConsoleHandler;
|
WriteCallBack : TConsoleHandler;
|
||||||
|
|
||||||
Function SetWriteCallBack(H : TConsoleHandler) : TConsoleHandler;
|
Function SetWriteCallBack(H : TConsoleHandler) : TConsoleHandler;
|
||||||
|
Loading…
Reference in New Issue
Block a user