Permalink
Cannot retrieve contributors at this time
/// features JavaScript execution using the SpiderMonkey library | |
// - this unit is a part of the freeware Synopse framework, | |
// licensed under a MPL/GPL/LGPL tri-license; version 1.18 | |
unit SynSM; | |
{ | |
This file is part of Synopse framework. | |
Synopse framework. Copyright (C) 2021 Arnaud Bouchez | |
Synopse Informatique - https://synopse.info | |
Scripting support for mORMot Copyright (C) 2021 Pavel Mashlyakovsky | |
pavel.mash at gmail.com | |
Some ideas taken from | |
http://code.google.com/p/delphi-javascript | |
http://delphi.mozdev.org/javascript_bridge/ | |
*** BEGIN LICENSE BLOCK ***** | |
Version: MPL 1.1/GPL 2.0/LGPL 2.1 | |
The contents of this file are subject to the Mozilla Public License Version | |
1.1 (the "License"); you may not use this file except in compliance with | |
the License. You may obtain a copy of the License at | |
http://www.mozilla.org/MPL | |
Software distributed under the License is distributed on an "AS IS" basis, | |
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License | |
for the specific language governing rights and limitations under the License. | |
The Initial Developer of the Original Code is | |
Pavel Mashlyakovsky. | |
Portions created by the Initial Developer are Copyright (C) 2021 | |
the Initial Developer. All Rights Reserved. | |
Contributor(s): | |
- Arnaud Bouchez | |
- Vadim Orel | |
- win2014 | |
Alternatively, the contents of this file may be used under the terms of | |
either the GNU General Public License Version 2 or later (the "GPL"), or | |
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), | |
in which case the provisions of the GPL or the LGPL are applicable instead | |
of those above. If you wish to allow use of your version of this file only | |
under the terms of either the GPL or the LGPL, and not to allow others to | |
use your version of this file under the terms of the MPL, indicate your | |
decision by deleting the provisions above and replace them with the notice | |
and other provisions required by the GPL or the LGPL. If you do not delete | |
the provisions above, a recipient may use your version of this file under | |
the terms of any one of the MPL, the GPL or the LGPL. | |
***** END LICENSE BLOCK ***** | |
--------------------------------------------------------------------------- | |
Download the SpiderMonkey library at https://synopse.info/files/synsm.7z ! | |
--------------------------------------------------------------------------- | |
Version 1.18 | |
- initial release. Use SpiderMonkey 24 | |
- add TSMObject.defineNativeMethod | |
- add JSError procedure for Exception handling inside of JSNative function | |
- enhanced multi thread process | |
- add TSMEngine.MaybeGarbageCollect method | |
- add timeout Framework | |
} | |
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER | |
{$I SynSM.inc} // define SM_DEBUG JS_THREADSAFE CONSIDER_TIME_IN_Z | |
interface | |
uses | |
Windows, | |
{$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif} | |
Classes, | |
{$ifndef LVCL} | |
Contnrs, | |
{$endif} | |
Variants, | |
SynCommons, | |
SynLog, | |
SynTests, | |
SynTable, | |
SynSMAPI; | |
const | |
/// default stack growing size, in bytes | |
STACK_CHUNK_SIZE: cardinal = 8192; | |
type | |
/// generic parent class of all SpiderMonkey-related Exception types | |
ESMException = class(ESynException); | |
{$M+} | |
TSMEngineManager = class; | |
{$M-} | |
TSMEngine = class; | |
/// just a wrapper around jsval API type, to be used with our object wrappers | |
// - SpiderMonkey jsval type can be directly casted to this type via TSMValue(jsval) | |
// - note that some methods expect an execution context to be supplied as | |
// parameter, as soon as it contains a non primitive type (double/integer) | |
TSMValue = object | |
protected | |
FValue: jsval; | |
public | |
/// type of the value | |
// - you should better use this before calling other To*() methods | |
function ValType(cx: PJSContext): JSType; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// direct access to the internal jsval instance | |
property AsJSVal: jsval read FValue write FValue; | |
/// set the value as one 32 bit integer | |
procedure SetInteger(const Value: integer); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// read the value as one 32 bit integer | |
function ToInteger: integer; | |
{$ifdef WITHASSERT}{$ifdef HASINLINE}inline;{$endif}{$endif} | |
/// access to the value as integer | |
property AsInteger: integer read ToInteger write SetInteger; | |
/// set the value as floating point | |
procedure SetDouble(const Value: double); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// read the value as floating point | |
function ToDouble: double; | |
{$ifdef WITHASSERT}{$ifdef HASINLINE}inline;{$endif}{$endif} | |
/// access to the value as floating point | |
property AsDouble: double read ToDouble write SetDouble; | |
/// set the value as boolean | |
procedure SetBoolean(const Value: boolean); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// read the value as boolean | |
function ToBoolean: boolean; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// access to the value as boolean | |
property AsBoolean: boolean read ToBoolean write SetBoolean; | |
/// set the value as one 64 bit integer | |
// - this is a somewhat dirty hack, since SpiderMonkey don't support int64: | |
// but it is possible to transform int64 to double for ant value < (1 shl 51) | |
// - sometimes we need int64 to be passed do SpiderMonkey (e.g. for an ID) | |
procedure SetInt64(const Value: int64); | |
/// read the value as one 64 bit integer | |
// - note that SpiderMonkey is not able to store all Int64 values directly | |
function ToInt64: int64; | |
/// access to the value as one 64 bit integer | |
property AsInt64: int64 read ToInt64 write SetInt64; | |
/// set the value as VOID | |
procedure SetVoid; {$ifdef HASINLINE}inline;{$endif} | |
/// set the value as NULL | |
procedure SetNull; {$ifdef HASINLINE}inline;{$endif} | |
/// set the value as variant (not implemented yet) | |
// - will set any custom variant type (e.g. TDocVariant) as a JavaScript | |
// object value computed from the JSON serialization of the variant | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
procedure SetVariant(cx: PJSContext; const Value: Variant); | |
/// return the value as variant (not implemented yet) | |
// - will return any JavaScript string value directly as a RawUTF8 | |
// - will return any JavaScript object value as a TDocVariant document | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
function ToVariant(cx: PJSContext): Variant; overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// return the value as variant (not implemented yet) | |
// - will return any JavaScript string value directly as a RawUTF8 | |
// - will return any JavaScript object value as a TDocVariant document | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
procedure ToVariant(cx: PJSContext; var result: Variant); overload; | |
/// set the value as TVarRec (i.e. an "array of const" open parameter) | |
// - here any AnsiString parameter is expected to be a RawUTF8 before Delphi | |
// 2009, or its correct code page will be retrieved since Delphi 2009 | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
procedure SetTVarRec(cx: PJSContext; const V: TVarRec); | |
/// set the value as an UTF-16 encoded buffer | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
// - warning - JSString string is a subject for GC so you must root it or set | |
// as property of some object or use SetNativeString() method to pass the | |
// value by reference | |
procedure SetWideChar(cx: PJSContext; Text: PWideChar; TextLen: integer); | |
/// set the value as an Ansi encoded buffer (may be UTF-8 or any code page) | |
// - if CodePage is 0, will use the CurrentAnsiCodePage value | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
// - warning - JSString string is a subject for GC so you must root it or set | |
// as property of some object or use SetNativeString() method to pass the | |
// value by reference | |
procedure SetAnsiChar(cx: PJSContext; Text: PAnsiChar; TextLen, CodePage: integer); | |
/// set the value as an Unicode String | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
// - warning - JSString string is a subject for GC so you must root it or set | |
// as property of some object or use SetNativeString() method to pass the | |
// value by reference | |
procedure SetSynUnicode(cx: PJSContext; const aStr: SynUnicode); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// return the value as an Unicode String | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
function ToSynUnicode(cx: PJSContext): SynUnicode; overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// return the value as an Unicode String | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
procedure ToSynUnicode(cx: PJSContext; var result: SynUnicode); overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// set the value as an Unicode WideString | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
// - warning - JSString string is a subject for GC so you must root it or set | |
// as property of some object or use SetNativeString() method to pass the | |
// value by reference | |
procedure SetWideString(cx: PJSContext; const aStr: WideString); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// return the value as an Unicode WideString | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
function ToWideString(cx: PJSContext): WideString; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// set the value as an UTF-8 String | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
// - warning - JSString string is a subject for GC so you must root it or set | |
// as property of some object or use SetNativeString() method to pass the | |
// value by reference | |
procedure SetUTF8(cx: PJSContext; const aStr: RawUTF8); | |
{$ifdef HASINLINE}inline;{$endif} | |
/// return the value as an UTF-8 String | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
function ToUTF8(cx: PJSContext): RawUTF8; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// set the value from UTF-8 encoded JSON | |
// - returns TRUE if aJSON was valid, FALSE in case of an error | |
function SetJSON(cx: PJSContext; const aJSON: RawUTF8): boolean; | |
/// return the value as UTF-8 encoded JSON | |
function ToJSON(cx: PJSContext): RawUTF8; | |
/// add the value as UTF-8 encoded JSON | |
procedure AddJSON(cx: PJSContext; W: TTextWriter); | |
/// set the value as Unicode String by reference | |
// - this is the fastest way to add a string to SpiderMonley: String is in | |
// fact not copied to the SpiderMonkey engine, just passed by reference | |
// - Only SynUnicode string support by now (SpiderMonkey is internally UTF-16 based) | |
// - WARNING - as a consequence, aStr must be UNCHANGED until SpiderMonkey engine | |
// points to it (SpiderMonkey will also consider its strings as immutable, so will | |
// never change its content during execution) - for instance, never pass a | |
// function result as aStr, nor use a local SynUnicode variable unless you | |
// trigger the Garbage Collection before the end of the local method | |
procedure SetNativeString(cx: PJSContext; const aStr: SynUnicode); | |
/// set the value as a date/time | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
procedure SetDateTime(cx: PJSContext; const Value: TDateTime); | |
/// return the value as a date/time | |
// - in SpiderMonkey non-simple type instances do exist in a given JSContext, | |
// so we need to know the execution context (using a property is not an option) | |
function ToDateTime(cx: PJSContext): TDateTime; | |
/// transform a JSValue to its UTF-16 string representation | |
// - JavaScript equivalent is | |
// ! variable.toString() | |
function TransformToSynUnicode(cx: PJSContext): SynUnicode; | |
/// transform a JSValue to its UTF-8 string representation | |
// - JavaScript equivalent is | |
// ! variable.toString() | |
function TransformToUTF8(cx: PJSContext): RawUTF8; | |
/// attemps to convert the value into a native function pointer | |
function ToNativeFunction(cx: PJSContext): PJSFunction; | |
/// attemps to convert the value into a native function name | |
function ToNativeFunctionName(cx: PJSContext): RawUTF8; | |
end; | |
/// a pointer to a jsval wrapper | |
PSMValue = ^TSMValue; | |
/// a jsval wrappers array | |
TSMValues = array[0..(MaxInt div sizeof(TSMValue))-1] of TSMValue; | |
/// a pointer to a jsval wrappers array | |
PSMValues = ^TSMValues; | |
/// a dynamic array of jsval wrappers | |
SMValArray = array of TSMValue; | |
/// just a wrapper around JavaScript Object API type, to be used with other | |
// values wrappers | |
// - SpiderMonkey object type can NOT be directly casted to this type via | |
// TSMObject(jsobject) - use JSObject wrapper instead - since we expects | |
// an execution context to be specified | |
// - to create instance of this structure, use TSMEngine.NewObject() or | |
// MakeObject() overloaded methods | |
TSMObject = object | |
private | |
FDefaultPropertyAttrs: TJSPropertyAttrs; | |
function GetPrivate: pointer; | |
procedure SetPrivate(const Value: pointer); | |
function GetItem(aIndex: integer): variant; | |
procedure SetItem(aIndex: integer; const Value: variant); | |
procedure SetDefaultPropertyAttrs(const Value: TJSPropertyAttrs); | |
protected | |
fCx: PJSContext; | |
fObj: PJSObject; | |
procedure SetPropVariant(const propName: SynUnicode; const Value: variant); | |
public | |
/// get the parent object of a given object | |
function Parent: TSMObject; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// get the prototype of a given object | |
function Prototype: TSMObject; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// access the private data field of an object | |
// - wrapper to JS_GetPrivate()/JS_SetPrivate() | |
// - only works if the object's JSClass has the JSCLASS_HAS_PRIVATE flag: | |
// it is safer to use GetPrivateData() method and providing the JSClass | |
property PrivateData: pointer read GetPrivate write SetPrivate; | |
/// retrieve the private data associated with an object, if that object | |
// is an instance of a specified class | |
// - wrapper to JS_GetInstancePrivate() | |
function GetPrivateData(expectedClass: PJSClass): pointer; | |
/// return TRUE if the object is an array | |
function IsArray: boolean; | |
/// return the number of elements in this array | |
function ItemsCount: cardinal; | |
/// delete an item of this object as array | |
procedure DeleteItem(aIndex: integer); | |
/// access to an item of this object as array | |
property Items[aIndex: integer]: variant read GetItem write SetItem; | |
/// define an object property with a value, specified as jsvalue | |
// - this is not a direct JavaScript equivalent of | |
// ! obj[name] = val | |
// since any setter will be called | |
// - to set a property in a global object, call either | |
// ! SMEngine.Global.property := ... // via late-binding | |
// ! SMEngine.GlobalObject.DefineProperty() // direct via TSMObject | |
// equivalent in JavaScript to: | |
// ! var name = value | |
// outside a JavaScript function context (i.e. in global scope) | |
// - if property already exists, it will just replace its value with the | |
// supplied value | |
// - this method will use the default properties attributes of this engine | |
procedure DefineProperty(const name: SynUnicode; const value: TSMValue); overload; | |
/// define an object property with a value, specified as jsvalue | |
// - this is not a direct JavaScript equivalent of | |
// ! obj[name] = val | |
// since any setter will be called | |
// - to set a property in a global object, call either | |
// ! SMEngine.Global.property := ... // via late-binding | |
// ! SMEngine.GlobalObject.DefineProperty() // direct via TSMObject | |
// equivalent in JavaScript to: | |
// ! var name = value | |
// outside a JavaScript function context (i.e. in global scope) | |
// - if property already exists, it will just replace its value with the | |
// supplied value | |
// - this method will allow to set custom properties attributes of this engine | |
procedure DefineProperty(const name: SynUnicode; const value: TSMValue; | |
attrs: TJSPropertyAttrs); overload; | |
/// define an object property with a value, specified as variant | |
// - you can also use the property Properties[] | |
// - this is not a direct JavaScript equivalent of | |
// ! obj[name] = val | |
// since any setter will be called | |
// - to set a property in a global object, call either | |
// ! SMEngine.Global.property := ... // via late-binding | |
// ! SMEngine.GlobalObject.DefineProperty() // direct via TSMObject | |
// equivalent in JavaScript to: | |
// ! var name = value | |
// outside a JavaScript function context (i.e. in global scope) | |
// - if property already exists, it will just replace its value with the | |
// supplied value | |
// - this method will use the default properties attributes of this engine | |
procedure DefineProperty(const name: SynUnicode; const value: variant); overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// define an object property with a value, specified as variant | |
// - you can also use the property Properties[] | |
// - this is not a direct JavaScript equivalent of | |
// ! obj[name] = val | |
// since any setter will be called | |
// - to set a property in a global object, call either | |
// ! SMEngine.Global.property := ... // via late-binding | |
// ! SMEngine.GlobalObject.DefineProperty() // direct via TSMObject | |
// equivalent in JavaScript to: | |
// ! var name = value | |
// outside a JavaScript function context (i.e. in global scope) | |
// - if property already exists, it will just replace its value with the | |
// supplied value | |
// - this method will allow to set custom properties attributes of this engine | |
procedure DefineProperty(const name: SynUnicode; const value: variant; | |
attrs: TJSPropertyAttrs); overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// add JSNative compatible function into JS object | |
// - here the method name is specified as SynUnicode | |
// - func if reference to function with JSNative signature | |
// - nargs is function argument count | |
// - actually this method creates a JSFunction and assing its value to | |
// ! obj[methodName] | |
// - to add a global function, define it into the "global" object - i.e. call | |
// ! TSMEngine.GlobalObject.DefineNativeMethod() | |
// - this method will use the default properties attributes of this engine | |
function DefineNativeMethod(const methodName: SynUnicode; | |
func: JSNative; nargs: uintN): PJSFunction; overload; | |
/// add JSNative compatible function into JS object | |
// - here the method name is specified as SynUnicode | |
// - func if reference to function with JSNative signature | |
// - nargs is function argument count | |
// - actually this method creates a JSFunction and assing its value to | |
// ! obj[methodName] | |
// - to add a global function, define it into the "global" object - i.e. call | |
// ! TSMEngine.GlobalObject.DefineNativeMethod() | |
// - this method will allow to set custom properties attributes of this engine | |
function DefineNativeMethod(const methodName: SynUnicode; | |
func: JSNative; nargs: uintN; attrs: TJSPropertyAttrs): PJSFunction; overload; | |
/// add JSNative compatible function into JS object | |
// - here the method name is specified as AnsiString | |
// - func if reference to function with JSNative signature | |
// - nargs is function argument count | |
// - this method will use the default properties attributes of this engine | |
function DefineNativeMethod(const methodName: AnsiString; | |
func: JSNative; nargs: uintN): PJSFunction; overload; | |
/// add JSNative compatible function into JS object | |
// - here the method name is specified as AnsiString | |
// - func if reference to function with JSNative signature | |
// - nargs is function argument count | |
// - this method will allow to set custom properties attributes of this engine | |
function DefineNativeMethod(const methodName: AnsiString; | |
func: JSNative; nargs: uintN; attrs: TJSPropertyAttrs): PJSFunction; overload; | |
/// check object property does exist (including prototype chain lookup) | |
function HasProperty(const propName: SynUnicode): Boolean; | |
/// Determine whether a property is physically present on a object | |
// - JavaScript equivalent of | |
// ! Object.hasOwnProperty(propName) | |
function HasOwnProperty(const propName: SynUnicode): Boolean; | |
/// get object property value (call geter for native) | |
// - JavaScript equivalent of | |
// ! obj[name] | |
// - returns JSVAL_VOID if object does not have such property | |
function GetPropValue(const propName: SynUnicode): TSMValue; | |
/// get object property value (call geter for native) | |
// - you can also use the property Properties[] | |
// - JavaScript equivalent of | |
// ! obj[name] | |
// - returns null if object does not have such property | |
function GetPropVariant(const propName: SynUnicode): variant; | |
/// read/write access to the object properties as variant | |
property Properties[const propName: SynUnicode]: variant | |
read GetPropVariant write SetPropVariant; default; | |
/// evaluate JavaScript script in the current object scope | |
// - if exception raised in script - raise Delphi ESMException | |
// - on success, returns the last executed expression statement processed | |
// in the script in low-level result output variable | |
// - JavaScript Equivalent of | |
// ! with(obj) eval(script) | |
// - be careful about execution scope - see JS_ExecuteScript() description | |
// - usualy you need to evaluate script only in global object scope, so you | |
// should better always call TSMEngine.Evaluate() | |
procedure Evaluate(const script: SynUnicode; const scriptName: RawUTF8; | |
lineNo: Cardinal; out result: TSMValue); | |
/// executes a JavaScript object method using low-level SMVal arguments | |
// - returns the function result as a TSMValue | |
// - JavaScript equivalent of | |
// ! rval := obj.methodName(argv[0], ....); | |
procedure RunMethod(const methodName: AnsiString; const argv: SMValArray; | |
out rval: TSMValue); overload; | |
/// executes a JavaScript object method using a Delphi array of const | |
// - returns the function result as a TSMValue | |
// - JavaScript equivalent of | |
// ! rval := obj.methodName(argv[0], ....); | |
// - here any AnsiString parameter is expected to be a RawUTF8 before Delphi | |
// 2009, or its correct code page will be retrieved since Delphi 2009 | |
procedure RunMethod(const methodName: AnsiString; const argv: array of const; | |
out rval: TSMValue); overload; | |
/// executes a JavaScript object method using a Delphi array of variants | |
// - returns the function result as a variant | |
// - JavaScript equivalent of | |
// ! rval := obj.methodName(argv[0], ....); | |
function Run(const methodName: AnsiString; const argv: array of variant): variant; | |
/// returns the associated execution context | |
property cx: PJSContext read fCx; | |
/// returns the associated jsobject instance | |
property obj: PJSObject read fObj; | |
/// returns the associated jsobject instance as a jsvalue | |
function AsSMValue: TSMValue; | |
/// protect the object from Garbage Collection | |
// - if this object is not set as property value of any other object | |
// or passed as parameter to function, you must protect it | |
procedure Root; | |
/// unprotect a previously "rooted" object | |
// - WARNING!! Object MUST be protected by a previous Root method call, | |
// otherwise you get an access violation | |
procedure UnRoot; | |
/// set properties obj and cx to nil | |
procedure Clear; | |
/// returns the associated script engine instance | |
function Engine: TSMEngine; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// access to the default attributes when accessing any properties | |
property DefaultPropertyAttrs: TJSPropertyAttrs read FDefaultPropertyAttrs write SetDefaultPropertyAttrs; | |
end; | |
//// variant-based callback signature used for TSMEngine.RegisterMethod() | |
// - any Delphi exception raised during this execution will be converted into | |
// a JavaScript exception by TSMEngine | |
// - "this" JavaScript calling object is transmitted as a TSMVariant custom | |
// variant: you can use late-binding over it to access its methods | |
// or properties, or transtype it using TSMVariantData(Instance) | |
// and access its low-level API content | |
// - input arguments (and function result) are simple variant values, or | |
// TDocVariant custom variant instance for any object as complex document | |
// - corresponds to meVariant kind of callback method | |
TSMEngineMethodEventVariant = function(const This: variant; | |
const Args: array of variant): variant of object; | |
//// JSON-based callback signature used for TSMEngine.RegisterMethod() | |
// - any Delphi exception raised during this execution will be converted into | |
// a JavaScript exception by TSMEngine | |
// - similar to TServiceMethod.InternalExecute() as defined in mORMot.pas | |
// (for instance, this callback will be used to execute native Delphi | |
// interface-based methods from JavaScript code in mORMotSM.pas unit) | |
// - "this" JavaScript calling object is transmitted as low-level TSMObject | |
// - will expect as input a JSON array of parameters from Args, e.g. | |
// ! '[1,2,3]' | |
// - if the method only expect one result, shall return one JSON value, e.g. | |
// ! '6' | |
// - if the method expect more than one result (i.e. several var/out parameters | |
// in addition to the main function result), it shall return a JSON object, | |
// with parameter names for all var/out/result values, e.g. | |
// ! '{"first":1,"second":2,"result":3}' | |
// - this allows the function result to be consumed by the JavaScript as | |
// a regular JS value or object | |
// - corresponds to meJSON kind of callback method | |
TSMEngineMethodEventJSON = function(const This: TSMObject; | |
const Args: RawUTF8): RawUTF8 of object; | |
/// pointer to our wrapper around JavaScript Object | |
PSMObject = ^TSMObject; | |
/// kinds of callback methods available for TSMEngine.RegisterMethod() | |
TSMEngineMethodEventKind = (meVariant, meJSON); | |
/// used to store one registered method event | |
TSMEngineMethodEvent = record | |
Func: PJSFunction; | |
case EventKind: TSMEngineMethodEventKind of | |
meVariant: (CallbackVariant: TSMEngineMethodEventVariant); | |
meJSON: (CallbackJSON: TSMEngineMethodEventJSON); | |
end; | |
/// used to store the registered method events | |
TSMEngineMethodEventDynArray = array of TSMEngineMethodEvent; | |
/// implements a ThreadSafe JavaScript engine | |
// - use TSMEngineManager.ThreadSafeEngine to retrieve the Engine instance | |
// corresponding to the current thread, in multithread application | |
// - contains JSRuntime + JSContext (to be ready for new SpiderMonkey version where | |
// context and runtime is the same) | |
// - contains also one "global" JavaScript object. From script it is | |
// accessible via "global." (in browser, this is the "window." object) | |
// - set SpiderMonkey error reporter and store last SpiderMonkey error in | |
// LastError property | |
TSMEngine = class | |
protected | |
fRt: PJSRuntime; | |
fCx: PJSContext; | |
fcomp: PJSCompartment; | |
fNativeMethod: TSMEngineMethodEventDynArray; | |
fNativeMethods: TDynArrayHashed; | |
fNativeMethodCount: integer; | |
FManager: TSMEngineManager; | |
FGlobal: variant; | |
FGlobalObject: TSMObject; | |
FEngineContentVersion: Cardinal; | |
FStringFinalizer: JSStringFinalizer; | |
FThreadID: TThreadID; | |
FLastErrorMsg: RawUTF8; | |
FLastErrorFileName: RawUTF8; | |
FLastErrorLine: integer; | |
FLastErrorStackTrace: RawUTF8; | |
FErrorExist: boolean; | |
function InternalRegisterMethod(obj: PJSObject; const MethodName: SynUnicode; | |
const Event: TMethod; Kind: TSMEngineMethodEventKind; ArgumentsCount: integer): PJSFunction; | |
/// called from SpiderMonkey callback. Do not raise exception here | |
// instead use CheckJSError metod after JSAPI compile/evaluate call | |
procedure DoProcessJSError(errMsg: PCChar; report: PJSErrorReport); virtual; | |
/// called from SpiderMonkey callback. It used for interrupt execution of script | |
// when it executes too long | |
function DoProcessOperationCallback: JSBool; virtual; | |
procedure CancelExecution; | |
private | |
FDefaultPropertyAttrs: TJSPropertyAttrs; | |
procedure SetDefaultPropertyAttrs(const Value: TJSPropertyAttrs); | |
protected | |
// used by Watchdog thread state. See js.cpp | |
fTimeOutAborted: Boolean; | |
fTimedOut: Boolean; | |
fWatchdogLock: PRLock; | |
fWatchdogWakeup: PRCondVar; | |
fWatchdogThread: PRThread; | |
fWatchdogHasTimeout: Boolean; | |
fWatchdogTimeout: Int64; | |
fSleepWakeup: PRCondVar; | |
fTimeoutInterval: double; | |
function ScheduleWatchdog(t: Double): Boolean; | |
procedure KillWatchdog; | |
function InitWatchdog: boolean; | |
procedure SetTimeoutValue(const Value: Double); | |
public | |
/// create one threadsafe JavaScript Engine instance | |
// - initialize internal JSRuntime, JSContext, and global objects and | |
// standard JavaScript classes | |
// - do not create Engine directly via this constructor, but instead call | |
// TSMEngineManager.ThreadSafeEngine | |
constructor Create(aManager: TSMEngineManager); virtual; | |
/// finalize the JavaScript engine instance | |
destructor Destroy; override; | |
/// check if last call to JSAPI compile/eval fucntion was successful | |
// - raise ESMException if any error occurred | |
// - put error description to SynSMLog | |
procedure CheckJSError(res: JSBool); virtual; | |
/// clear last JavaScript error | |
// - called before every evaluate() function call | |
procedure ClearLastError; | |
/// trigger Garbage Collection | |
// - all unrooted things (JSString, JSObject, VSVal) will be released | |
procedure GarbageCollect; | |
/// Offer the JavaScript engine an opportunity to perform garbage collection if needed | |
// - Tries to determine whether garbage collection in would free up enough | |
// memory to be worth the amount of time it would take. If so, it performs | |
// some garbage collection | |
// - Frequent calls are safe and will not cause the application to spend a | |
// lot of time doing redundant garbage collection work | |
procedure MaybeGarbageCollect; | |
/// create new ordinary JavaScript object | |
// - JavaScript equivalent of | |
// ! {} | |
// - new object is subject to Garbage Collection, so must be rooted or | |
// assigned as value for a property to create new object type property, | |
// as in JavaScript: | |
// ! var obj = {} | |
procedure NewObject(out newobj: TSMObject); overload; | |
/// create new ordinary JavaScript object, stored as TSMVariant custom type | |
// - JavaScript equivalent of | |
// ! {} | |
// - new object is subject to Garbage Collection, so should be | |
// assigned as value for a property to create new object type property, | |
// as in JavaScript: | |
// ! var obj = {} | |
function NewSMVariant: variant; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// create new ordinary JavaScript object, stored as TSMVariant custom type, | |
// and rooted to avoid garbage collection | |
// - JavaScript equivalent of | |
// ! {} | |
// - new object is subject to Garbage Collection, so is rooted and should | |
// be explicitly unrooted, e.g. via: | |
// ! obj: variant; | |
// ! ... | |
// ! FManager.ThreadSafeEngine.NewSMVariantRooted(obj); | |
// ! try | |
// ! ... work with obj | |
// ! finally | |
// ! obj._UnRoot; // pseudo-method | |
// ! end; | |
procedure NewSMVariantRooted(out newobj: variant); | |
/// create new JavaScript object with prototype | |
// - JavaScript equivalent of | |
// ! {}.__proto__ := prototype; | |
procedure NewObject(const prototype: TSMObject; out newobj: TSMObject); overload; | |
/// create new JavaScript object from its class | |
procedure NewObjectWithClass(clasp: PJSClass; var newobj: TSMObject); overload; | |
/// create new JavaScript object from its prototype | |
procedure NewObjectWithClass(clasp: PJSClass; const prototype: TSMObject; const parent: TSMObject; var newobj: TSMObject); overload; | |
/// create new JavaScript object from its class and property specifications | |
procedure InitClass(clasp: PJSClass; ps: PJSPropertySpec; var newobj: TSMObject); | |
/// converts a JavaScript value into a JavaScript object | |
procedure MakeObject(const value: TSMValue; out obj: TSMObject); overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// converts a JavaScript low-level value into a JavaScript object | |
procedure MakeObject(const value: jsval; out obj: TSMObject); overload; | |
/// converts a JavaScript low-level object into a JavaScript object | |
procedure MakeObject(jsobj: PJSObject; out obj: TSMObject); overload; | |
/// register a native Delphi variant-based method for a given object | |
// - the supplied function name is case-sensitive | |
// - the supplied callback will be executed directly by the JavaScript | |
// engine, supplying all parameters as variant (including TDocVariant for | |
// any complex object), and returning the function result as variant | |
// - raise an ESMException if the function could not be registered | |
function RegisterMethod(obj: PJSObject; const MethodName: SynUnicode; | |
const Event: TSMEngineMethodEventVariant; ArgumentsCount: integer): PJSFunction; overload; | |
/// register a native Delphi JSON-based method for a given object | |
// - the supplied function name is case-sensitive | |
// - the supplied callback will be executed directly by the JavaScript | |
// engine, supplying all parameters as JSON array, and returning the | |
// function result either as a JSON value or a JSON object | |
// - raise an ESMException if the function could not be registered | |
function RegisterMethod(obj: PJSObject; const MethodName: SynUnicode; | |
const Event: TSMEngineMethodEventJSON; ArgumentsCount: integer): PJSFunction; overload; | |
/// unregister a native Delphi method for a given object | |
// - raise an ESMException if the function was not previously registered | |
// - you should not call it usually, but it is available in case | |
procedure UnRegisterMethod(JSFunction: PJSFunction); | |
/// evaluate a JavaScript script in the global scope | |
// - a wrapper to GlobalObject.Evaluate(...) | |
// - if exception raised in script - raise Delphi ESMException | |
// - on success returns last executed expression statement processed | |
// in the script as a variant | |
// - JavaScript equivalent to | |
// ! eval(script) | |
function Evaluate(const script: SynUnicode; const scriptName: RawUTF8='script'; | |
lineNo: Cardinal=1): variant; | |
/// access to the associated global object as a TSMVariant custom variant | |
// - allows direct property and method executions in Delphi code, via | |
// late-binding, for instance: | |
// ! engine.Global.MyVariable := 1.0594631; | |
// ! engine.Global.MyFunction(1,'text'); | |
property Global: variant read FGlobal; | |
/// access to the associated global object as a TSMObject wrapper | |
// - you can use it to register a method | |
property GlobalObject: TSMObject read FGlobalObject; | |
/// access to the associated global object as low-level PJSObject | |
property GlobalObj: PJSObject read FGlobalObject.fobj; | |
/// access to the associated execution context | |
property cx: PJSContext read fCx; | |
/// access to the associated execution runtime | |
property rt: PJSRuntime read frt; | |
/// access to the associated execution compartment | |
property comp: PJSCompartment read fcomp; | |
/// internal version number of engine scripts | |
// - used in TSMEngine.ThreadSafeEngine to determine if context is up to | |
// date, in order to trigger on-the-fly reload of scripts without the need | |
// if restarting the application | |
// - caller must change this parameter value e.g. in case of changes in | |
// the scripts folder in an HTTP server | |
property EngineContentVersion: Cardinal read FEngineContentVersion; | |
/// last error message triggered during JavaScript execution | |
property LastErrorMsg: RawUTF8 read FLastErrorMsg; | |
/// last error source code line number triggered during JavaScript execution | |
property LastErrorLine: integer read FLastErrorLine; | |
/// last error file name triggered during JavaScript execution | |
property LastErrorFileName: RawUTF8 read FLastErrorFileName; | |
/// TRUE if an error was triggered during JavaScript execution | |
property ErrorExist: boolean read FErrorExist; | |
/// notifies a WatchDog timeout | |
property TimeOutAborted: boolean read FTimeOutAborted; | |
/// define a WatchDog timeout interval | |
// - is set to -1 by default, i.e. meaning no execution timeout | |
property TimeOutValue: Double read fTimeoutInterval write SetTimeoutValue; | |
/// access to the default attributes when accessing any properties | |
property DefaultPropertyAttrs: TJSPropertyAttrs read FDefaultPropertyAttrs write SetDefaultPropertyAttrs; | |
end; | |
/// prototype of SpideMonkey notification callback method | |
TEngineEvent = procedure(const Engine: TSMEngine) of object; | |
/// main access point to the SpiderMonkey per-thread scripting engines | |
// - allow thread-safe access to an internal per-thread TSMEngine instance list | |
// - contains runtime-level properties shared between thread-safe engines | |
// - you can create several TSMEngineManager instances, if you need several | |
// separate scripting instances | |
// - set OnNewEngine callback to initialize each TSMEngine, when a new thread | |
// is accessed, and tune per-engine memory allocation via MaxPerEngineMemory | |
// and MaxRecursionDepth | |
// - get the current per-thread TSMEngine instance via ThreadSafeEngine method | |
TSMEngineManager = class | |
protected | |
FMaxPerEngineMemory: Cardinal; | |
FMaxRecursionDepth: Cardinal; | |
FEnginePool: TObjectList; | |
FEngineCS: TRTLCriticalSection; | |
FContentVersion: Cardinal; | |
FOnNewEngine: TEngineEvent; | |
procedure SetMaxPerEngineMemory(AMaxMem: Cardinal); | |
/// returns -1 if none was defined yet | |
// - this method is not protected via the global FEngineCS mutex/lock | |
function ThreadEngineIndex(ThreadID: TThreadID): Integer; | |
/// returns nil if none was defined yet | |
function CurrentThreadEngine: TSMEngine; | |
/// create a new SpiderMonkey Engine | |
// - used by ThreadSafeEngine method to instantiate a new per-thread Engine | |
function CreateNewEngine: TSMEngine; virtual; | |
/// called when a new Engine is created | |
// - this default implementation will run the OnNewEngine callback (if any) | |
procedure DoOnNewEngine(const Engine: TSMEngine); virtual; | |
public | |
/// initialize the SpiderMonkey scripting engine | |
constructor Create; virtual; | |
/// finalize the SpiderMonkey scripting engine | |
destructor Destroy; override; | |
/// get or create one Engine associated with current running thread | |
// - in single thread application will return the MainEngine | |
function ThreadSafeEngine: TSMEngine; | |
/// method to be called when a thread is about to be finished | |
// - you can call this method just before a thread is finished to ensure | |
// that the associated scripting Engine will be released | |
// - could be used e.g. in a try...finally block inside a TThread.Execute | |
// overriden method | |
procedure ReleaseCurrentThreadEngine; | |
/// internal version of the script files | |
// - used in TSMEngine.ThreadSafeEngine to determine if context is up to | |
// date, in order to trigger on-the-fly reload of scripts without the need | |
// if restarting the application | |
property ContentVersion: Cardinal read FContentVersion write FContentVersion; | |
/// lock/mutex used for thread-safe access to the TSMEngine list | |
property Lock: TRTLCriticalSection read FEngineCS; | |
published | |
/// max amount of memory (in bytes) for a single SpiderMonkey instance | |
// - this parameter will be set only at Engine start, i.e. it must be set | |
// BEFORE any call to ThreadSafeEngine | |
// - default is 8 MB | |
property MaxPerEngineMemory: Cardinal read FMaxPerEngineMemory write SetMaxPerEngineMemory | |
default 8*1024*1024; | |
/// maximum expected recursion depth for JavaScript functions | |
// - to avoid out of memory situation in functions like | |
// ! function f(){ f() }; | |
// - default is 32, but you can specify some higher value | |
property MaxRecursionDepth: Cardinal read FMaxRecursionDepth write FMaxRecursionDepth | |
default 32; | |
/// event triggered every time a new Engine is created | |
// - here your code can change the initial state of the Engine | |
property OnNewEngine: TEngineEvent read FOnNewEngine write FOnNewEngine; | |
end; | |
{$M-} | |
var | |
/// the internal custom variant type used to register TSMVariant | |
SMVariantType: TSynInvokeableVariantType = nil; | |
type | |
/// pointer to a TSMVariant storage | |
PSMVariantData = ^TSMVariantData; | |
/// a custom variant type used to store a SpiderMonkey object in Delphi code | |
// - via the magic of late binding, it will allow access of any JavaScript | |
// object property, or execute any of its methods | |
// - primitive types (i.e. null, string, or numbers) will be stored as | |
// simple variant instances, but JavaScript objects (i.e. objects, prototypes | |
// or functions) can be stored as an instance of this TSMVariant custom type | |
// - you can use the _Root and _UnRoot pseudo-methods, which will protect | |
// the object instance to avoid unexpected Garbage Collection | |
TSMVariant = class(TSynInvokeableVariantType) | |
protected | |
/// fast getter/setter implementation of object properties | |
function IntGet(var Dest: TVarData; const Instance: TVarData; | |
Name: PAnsiChar; NameLen: PtrInt): boolean; override; | |
function IntSet(const Instance, Value: TVarData; | |
Name: PAnsiChar; NameLen: PtrInt): boolean; override; | |
public | |
/// initialize a variant instance to store a JavaScript object | |
class procedure New(const aObject: TSMObject; out aValue: variant); overload; | |
/// initialize a variant instance to store a JavaScript object | |
class procedure New(cx: PJSContext; obj: PJSObject; out aValue: variant); overload; | |
/// initialize a variant instance to store a new JavaScript object | |
class procedure New(engine: TSMEngine; out aValue: variant); overload; | |
// this implementation will let SpiderMonkey write directly the JSON content | |
procedure ToJSON(W: TTextWriter; const Value: variant; Escape: TTextWriterKind); override; | |
/// handle type conversion | |
// - any TSMVariant will be converted to '<<JavaScript TSMVariant>>' text | |
procedure Cast(var Dest: TVarData; const Source: TVarData); override; | |
/// handle type conversion | |
// - any TSMVariant will be converted to '<<JavaScript TSMVariant>>' text | |
procedure CastTo(var Dest: TVarData; const Source: TVarData; | |
const AVarType: TVarType); override; | |
/// low-level callback to execute any JavaScript object method | |
// - add the _(Index: integer): variant method to retrieve an item | |
// if the object is an array | |
function DoFunction(var Dest: TVarData; const V: TVarData; | |
const Name: string; const Arguments: TVarDataArray): Boolean; override; | |
end; | |
{$A-} { packet object not allowed since Delphi 2009 :( } | |
/// memory structure used for TSMVariant storage of any JavaScript object | |
// as Delphi variant | |
// - primitive types (i.e. null, string, or numbers) will be stored as | |
// simple variant instances, but JavaScript objects (i.e. objects, prototypes | |
// or functions) can be stored as an instance of this TSMVariant custom type | |
// - this variant stores its execution context, so is pretty convenient to | |
// work with in plain Delphi code, also thanks to late-binding feature | |
{$ifdef UNICODE} | |
TSMVariantData = record | |
private | |
{$else} | |
TSMVariantData = object | |
protected | |
{$endif} | |
VType: TVarType; | |
{$IFDEF FPC} {$PUSH} {$ENDIF} {$HINTS OFF} | |
// does not complain if Filler is declared but never used | |
Filler: array[1..SizeOf(TVarData)-SizeOf(TVarType)-SizeOf(TSMObject)] of byte; | |
{$IFDEF FPC} {$POP} {$ELSE} {$HINTS ON} {$ENDIF} | |
VObject: TSMObject; | |
public | |
/// initialize a TSMVariant structure to store a specified JavaScript object | |
procedure Init(const aObject: TSMObject); overload; | |
{$ifdef HASINLINE}inline;{$endif} | |
/// initialize a TSMVariant structure to store a specified JavaScript object | |
procedure Init(aCx: PJSContext; aObj: PJSObject); overload; | |
/// initialize a TSMVariant structure to store a new JavaScript object | |
procedure InitNew(engine: TSMEngine); | |
/// retrieve the global object of this execution context | |
// - you can use this from a native function, e.g.: | |
//!function TMyClass.MyFunction(const This: variant; const Args: array of variant): variant; | |
//!var global: variant; | |
//!begin | |
//! TSMVariantData(This).GetGlobal(global); | |
//! global.anotherFunction(Args[0],Args[1],'test'); | |
//! // same as: | |
//! global := TSMVariantData(This).SMObject.Engine.Global; | |
//! global.anotherFunction(Args[0],Args[1],'test'); | |
//! // but you may also write directly: | |
//! with TSMVariantData(This).SMObject.Engine do | |
//! Global.anotherFunction(Args[0],Args[1],'test'); | |
//! result := AnyTextFileToSynUnicode(Args[0]); | |
//!end; | |
procedure GetGlobal(out global: variant); | |
/// return the custom variant type identifier, i.e. SMVariantType.VarType | |
property VarType: word read VType; | |
/// returns the associated TSMObject instance | |
property SMObject: TSMObject read VObject; | |
/// returns the associated execution context | |
property cx: PJSContext read VObject.fcx; | |
/// returns the associated jsobject instance | |
property obj: PJSObject read VObject.fobj; | |
end; | |
{$A+} | |
/// to be used to catch Delphi exceptions inside JSNative function implementation | |
// - usage example: | |
// ! try | |
// ! doSomething() | |
// ! Result := JS_TRUE; | |
// ! except | |
// ! on E: Exception do begin | |
// ! JS_SET_RVAL(cx, vp, JSVAL_VOID); | |
// ! JSError(cx, E); | |
// ! Result := JS_FALSE; | |
// ! end; | |
procedure JSError(cx: PJSContext; aException: Exception; const aContext: RawByteString=''); | |
/// convert a variant to a Java Script value | |
function VariantToJSVal(cx: PJSContext; const Value: Variant): jsval; | |
var | |
/// define the TSynLog class used for logging for all our SynSM related units | |
// - you may override it with TSQLLog, if available from mORMot.pas | |
// - since not all exceptions are handled specificaly by this unit, you | |
// may better use a common TSynLog class for the whole application or module | |
SynSMLog: TSynLogClass=TSynLog; | |
implementation | |
uses | |
Math; | |
const | |
jsglobal_class: JSClass = (name: 'global'; | |
flags: JSCLASS_HAS_PRIVATE or JSCLASS_GLOBAL_FLAGS { or JSCLASS_NEW_RESOLVE }; | |
addProperty: JS_PropertyStub; | |
delProperty: JS_DeletePropertyStub; | |
getProperty: JS_PropertyStub; | |
setProperty: JS_StrictPropertyStub; | |
enumerate: @JS_EnumerateStub; | |
resolve: JS_ResolveStub; | |
convert: JS_ConvertStub //finalize is Optionally non-null member | |
//in source it marked as Mandatory, but it doesn't | |
//use in tests and there is no exported function JS_FinalizeStub | |
); | |
/// handle errors from JavaScript. Just call DoProcessJSError of corresponding TSMEngine | |
// to set TSMEngine error properties | |
procedure ErrorReporter(cx: PJSContext; pErrMsg: PCChar; report: PJSErrorReport); cdecl; | |
begin | |
TSMEngine(cx.PrivateData).DoProcessJSError(pErrMsg, report) | |
end; | |
procedure JSError(cx: PJSContext; aException: Exception; | |
const aContext: RawByteString); | |
begin | |
if JS_IsExceptionPending(cx)=JS_FALSE then | |
// raise only if this is the first exception in chain | |
if aException is EOutOfMemory then | |
JS_ReportOutOfMemory(cx) else | |
JS_ReportError(cx, PCchar(AnsiString(aException.Message)+AnsiString(aContext))); | |
end; | |
function OperationCallback(cx: PJSContext): JSBool; cdecl; | |
begin | |
Result := TSMEngine(cx.PrivateData).DoProcessOperationCallback; | |
end; | |
{ TSMEngine } | |
// do nothing here | |
procedure ExternalStringFinalizer(fin: PJSStringFinalizer; chars: Pjschar); cdecl; | |
begin | |
{} | |
end; | |
constructor TSMEngine.Create(aManager: TSMEngineManager); | |
const | |
Opt: CompartmentOptions = | |
( | |
zoneSpec: zsFreshZone; | |
hasVersion: True; | |
version: JSVERSION_LATEST; | |
); | |
gMaxStackSize = 128 * sizeof(size_t) * 1024; | |
begin | |
if aManager = nil then | |
raise ESMException.CreateUTF8('%.Create(nil): No manager provided',[self]); | |
FDefaultPropertyAttrs := [jspEnumerate]; | |
fNativeMethods.Init(TypeInfo(TSMEngineMethodEventDynArray), | |
fNativeMethod,HashPointer,SortDynArrayPointer,nil,@fNativeMethodCount); | |
{$ifdef RESETFPUEXCEPTION} | |
TSynFPUException.ForLibraryCode; | |
{$endif} | |
FManager := aManager; | |
FEngineContentVersion := FManager.ContentVersion; | |
frt := JS_NewRuntime(FManager.MaxPerEngineMemory, JS_USE_HELPER_THREADS); | |
if frt = nil then | |
raise ESMException.CreateUTF8('%.Create runtime: out of memory',[self]); | |
JS_SetNativeStackQuota(rt, gMaxStackSize); | |
JS_SetGCParameter(frt, JSGC_MAX_BYTES, FManager.MaxPerEngineMemory); | |
JS_SetGCParameter(frt, JSGC_MAX_MALLOC_BYTES, FManager.MaxPerEngineMemory div 2); | |
JS_SetGCParameter(frt, JSGC_MODE, uint32(JSGC_MODE_INCREMENTAL) ); | |
fCx := JS_NewContext(rt, STACK_CHUNK_SIZE); | |
if fCx = nil then | |
raise ESMException.CreateUTF8('%.Create: JS_NewContext failure',[self]); | |
// You must set jsoBaseLine,jsoTypeInference,jsoIon for the enabling ION | |
// ION is disabled without these options | |
{$ifdef FIXBUGXE3} | |
fCx.SetOptions([jsoVarObjFix,jsoBaseLine,jsoTypeInference,jsoIon,jsoAsmJs]); | |
{$else} | |
fCx.Options := [jsoVarObjFix,jsoBaseLine,jsoTypeInference,jsoIon,jsoAsmJs]; | |
{$endif} | |
fStringFinalizer.finalize := ExternalStringFinalizer; | |
JS_SetContextPrivate(cx, self); | |
JS_SetErrorReporter(cx, ErrorReporter); | |
FGlobalObject.fCx := cx; | |
FGlobalObject.fObj := JS_NewGlobalObject(cx, @jsglobal_class, nil, @Opt); | |
if GlobalObj = nil then | |
raise ESMException.CreateUTF8('%.Create: JS_NewGlobalObject failure',[self]); | |
fcomp := fcomp.EnterCompartment(cx,GlobalObj); | |
if JS_InitStandardClasses(cx, GlobalObj)<>JS_TRUE then | |
raise ESMException.CreateUTF8('%.Create: JS_InitStandardClasses failure',[self]); | |
FGlobalObject.DefineProperty('global', GlobalObject.AsSMValue, | |
[jspEnumerate,jspPermanent,jspReadOnly]); | |
TSMVariantData(FGlobal).Init(FGlobalObject); | |
fTimeoutInterval := -1; | |
if not InitWatchdog then | |
raise ESMException.CreateUTF8('%.Create: InitWatchDog failure',[self]); | |
JS_SetOperationCallback(cx, OperationCallback); | |
end; | |
destructor TSMEngine.Destroy; | |
begin | |
inherited Destroy; | |
VarClear(FGlobal); | |
{$ifdef RESETFPUEXCEPTION} | |
TSynFPUException.ForLibraryCode; | |
{$endif} | |
//JS_RemoveExternalStringFinalizer(ExternalStringFinalizer); | |
// comp^.Destroy; | |
JS_LeaveCompartment(cx, comp); | |
if FThreadID=GetCurrentThreadId then | |
cx^.Destroy; // SM 24 expects the context to be released in the same thread | |
KillWatchdog; | |
rt^.Destroy; | |
end; | |
procedure TSMEngine.DoProcessJSError(errMsg: PCChar; report: PJSErrorReport); | |
const PATTERN: PUTF8Char = '[JSError %] % (%): %'; | |
var exc: jsval; | |
pExObj: PJSObject; | |
msg: SynUnicode; | |
begin | |
FErrorExist := True; | |
if report^.filename = nil then | |
FLastErrorFileName := '(w/o name)' else | |
FLastErrorFileName := CurrentAnsiConvert.AnsiBufferToRawUTF8( | |
report^.filename,StrLen(pointer(report^.filename))); | |
FLastErrorLine := report^.lineno; | |
if report^.ucmessage=nil then | |
FLastErrorMsg := FormatUTF8(PATTERN,[report^.errorNumber,FLastErrorFileName, | |
FLastErrorLine,errMsg]) else | |
FLastErrorMsg := FormatUTF8(PATTERN,[report^.errorNumber,FLastErrorFileName, | |
FLastErrorLine,PWideChar(report^.ucmessage)]); | |
FLastErrorStackTrace := ''; | |
if ( JS_GetPendingException(cx, exc) = JS_TRUE ) then begin | |
if JSVAL_IS_OBJECT(exc) then begin | |
pExObj := JSVAL_TO_OBJECT(exc); | |
JS_GetProperty(cx, pExObj, 'stack', exc); | |
if (exc <> JSVAL_VOID) and JSVAL_IS_STRING(exc) then begin | |
msg := JSVAL_TO_STRING(exc).ToSynUnicode(cx); | |
if msg <> '' then // this can happend in case syntax error while parse script | |
FLastErrorStackTrace := SynUnicodeToUtf8(msg); | |
end; | |
end; | |
end; | |
(* | |
// This situation is possible when application are run from the IDE | |
// and stop on the breakpoint. | |
// When we evaluate some js script with errors(like call JS_Stringify | |
// for global object) this function will be called. | |
// If breakpoint is set between ClearLastError and CheckJSError we get | |
// FErrorExist value is equivalent true, but script have no error | |
if DebugHook=0 then try | |
CheckJSError(JS_FALSE); | |
finally | |
FErrorExist := false; | |
end; | |
*) | |
end; | |
procedure TSMEngine.CheckJSError(res: JSBool); | |
begin | |
if FTimeOutAborted then | |
raise ESMException.CreateUTF8('%: script runs for too long, abort',[self]); | |
if FErrorExist then begin | |
SynSMLog.Add.Log(sllError, FLastErrorMsg); | |
raise ESMException.CreateUTF8('% error: %',[self,FLastErrorMsg]); | |
end; | |
if res=JS_FALSE then begin | |
SynSMLog.Add.Log(sllError, 'Error compiling script %', FLastErrorFileName); | |
raise ESMException.CreateUTF8('%: Error compiling script [%]. Line %', | |
[self,FLastErrorFileName,FLastErrorLine]); | |
end; | |
end; | |
procedure TSMEngine.ClearLastError; | |
begin | |
JS_ClearPendingException(cx); | |
FErrorExist := False; | |
FTimeOutAborted := False; | |
end; | |
procedure TSMEngine.GarbageCollect; | |
begin | |
JS_GC(rt); | |
end; | |
procedure TSMEngine.MaybeGarbageCollect; | |
begin | |
JS_MaybeGC(cx); | |
end; | |
procedure TSMEngine.NewObject(out newobj: TSMObject); | |
begin | |
newobj.fCx := cx; | |
newobj.fObj := JS_NewObject(cx, nil{class}, nil{proto}, globalObj{parent}); | |
newobj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
if newobj.fObj=nil then | |
raise ESMException.CreateUTF8('%.NewObject',[self]); | |
end; | |
procedure TSMEngine.NewObject(const prototype: TSMObject; out newobj: TSMObject); | |
begin | |
newobj.fCx := cx; | |
newobj.fObj := JS_NewObject(cx, nil{class}, prototype.obj, nil{parent}); | |
newobj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
if newobj.fObj=nil then | |
raise ESMException.CreateUTF8('%.NewObject(prototype)',[self]); | |
end; | |
procedure TSMEngine.NewObjectWithClass(clasp: PJSClass; var newobj: TSMObject); | |
begin | |
newobj.fCx := cx; | |
newobj.fObj := JS_NewObject(cx, clasp, nil, nil); | |
newobj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
if newobj.fObj=nil then | |
raise ESMException.CreateUTF8('%.NewObjectWithClass',[self]); | |
end; | |
procedure TSMEngine.NewObjectWithClass(clasp: PJSClass; const prototype: TSMObject; | |
const parent: TSMObject; var newobj: TSMObject); | |
begin | |
newobj.fCx := cx; | |
newobj.fObj := JS_NewObject(cx, clasp, prototype.obj, parent.obj); | |
newobj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
if newobj.fObj=nil then | |
raise ESMException.CreateUTF8('%.NewObjectWithClass(parent)',[self]); | |
end; | |
procedure TSMEngine.InitClass(clasp: PJSClass; ps: PJSPropertySpec; var newobj: TSMObject); | |
begin | |
newobj.fCx := cx; | |
newobj.fObj := | |
JS_InitClass(cx, GlobalObj, nil, clasp, nil, 0, ps , nil, nil, nil); | |
newobj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
if newobj.obj=nil then | |
raise ESMException.CreateUTF8('%.InitClass',[self]); | |
end; | |
procedure TSMEngine.MakeObject(const value: TSMValue; out obj: TSMObject); | |
begin | |
MakeObject(value.FValue,obj); | |
end; | |
procedure TSMEngine.MakeObject(const value: jsval; out obj: TSMObject); | |
begin | |
if JSVAL_IS_OBJECT(value) then begin | |
obj.fCx := cx; | |
obj.fObj := JSVAL_TO_OBJECT(value); | |
obj.FDefaultPropertyAttrs := self.FDefaultPropertyAttrs; | |
end else | |
raise ESMException.CreateUTF8('%.MakeObject(value: not an object)',[self]); | |
end; | |
procedure TSMEngine.MakeObject(jsobj: PJSObject; out obj: TSMObject); | |
begin | |
obj.fCx := cx; | |
obj.fObj := jsobj; | |
end; | |
function TSMEngine.NewSMVariant: variant; | |
begin | |
TSMVariant.New(self,result); | |
end; | |
procedure TSMEngine.NewSMVariantRooted(out newobj: variant); | |
begin | |
TSMVariant.New(self,newobj); | |
TSMVariantData(newobj).VObject.Root; | |
end; | |
function TSMEngine.Evaluate(const script: SynUnicode; const scriptName: RawUTF8; | |
lineNo: Cardinal): variant; | |
var res: TSMValue; | |
begin | |
globalObject.Evaluate(script, scriptName, lineNo, res); | |
res.ToVariant(cx,result); | |
end; | |
function nsm_methodDelphi(cx: PJSContext; argc: uintN; vp: Pjsval): JSBool; cdecl; | |
var engine: TSMEngine; | |
argv: PSMValues; | |
f: PJSFunction; | |
instance: TSMVariantData; | |
callee,res: TSMValue; | |
method: integer; | |
procedure RunAsVariant(const CallbackVariant: TSMEngineMethodEventVariant); | |
var a: integer; | |
Args: TVariantDynArray; | |
begin | |
SetLength(Args,argc); | |
for a := 0 to argc-1 do | |
argv^[a].ToVariant(cx,Args[a]); | |
res.SetVariant(cx,CallbackVariant(Variant(instance),Args)); | |
end; | |
procedure RunAsJson(const CallbackJSON: TSMEngineMethodEventJSON); | |
var a: integer; | |
W: TTextWriter; | |
begin | |
W := TTextWriter.CreateOwnedStream(4096); | |
try | |
W.Add('['); | |
for a := 0 to argc-1 do begin | |
argv^[a].AddJSON(cx,W); | |
W.Add(','); | |
end; | |
W.CancelLastComma; | |
W.Add(']'); | |
res.SetJSON(cx,CallbackJSON(instance.SMObject,W.Text)); | |
finally | |
W.Free; | |
end; | |
end; | |
procedure RunError(E: Exception); | |
begin // avoid temporary allocation of strings on the stack | |
JSError(cx, E, FormatUTF8(' for function %()', | |
[callee.ToNativeFunctionName(cx)])); | |
end; | |
begin | |
{$ifdef RESETFPUEXCEPTION} | |
TSynFPUException.ForDelphiCode; // ensure we are back in Delphi FPU mask | |
{$endif} | |
try | |
engine := cx.PrivateData; | |
callee.FValue := vp^; | |
f := callee.ToNativeFunction(cx); | |
if f=nil then | |
method := -1 else | |
method := engine.fNativeMethods.FindHashed(f); | |
if method<0 then | |
raise ESMException.Create('nsm_methodDelphi: No callback defined'); | |
argv := pointer(JS_ARGV(cx,vp)); | |
instance.Init(cx,JS_THIS_OBJECT(cx,vp)); | |
with engine.fNativeMethod[method] do | |
case EventKind of | |
meVariant: RunAsVariant(CallbackVariant); | |
meJSON: RunAsJson(CallbackJSON); | |
else raise ESMException.CreateUTF8('nsm_methodDelphi: Unknown EventKind=%', | |
[ord(EventKind)]); | |
end; | |
JS_SET_RVAL(cx,vp,res.FValue); | |
result := JS_TRUE; | |
except | |
on E: Exception do begin | |
RunError(E); | |
JS_SET_RVAL(cx,vp,JSVAL_VOID); | |
result := JS_FALSE; | |
end; | |
end; | |
end; | |
function TSMEngine.InternalRegisterMethod(obj: PJSObject; | |
const MethodName: SynUnicode; const Event: TMethod; Kind: TSMEngineMethodEventKind; | |
ArgumentsCount: integer): PJSFunction; | |
var added: boolean; | |
i: integer; | |
begin | |
result := JS_DefineUCFunction(cx, obj, pointer(MethodName), Length(MethodName), | |
nsm_methodDelphi, ArgumentsCount, JSPROP_ENUMERATE); | |
if result=nil then | |
raise ESMException.CreateUTF8( | |
'%.InternalRegisterMethod(%): Defining native function',[self,MethodName]); | |
i := fNativeMethods.FindHashedForAdding(result,added); | |
if added then | |
with fNativeMethod[i] do begin | |
Func := result; | |
EventKind := Kind; | |
TMethod(CallbackVariant) := Event; | |
end else | |
raise ESMException.CreateUTF8( | |
'%.InternalRegisterMethod(%): Duplicated name',[self,MethodName]); | |
end; | |
function TSMEngine.RegisterMethod(obj: PJSObject; const MethodName: SynUnicode; | |
const Event: TSMEngineMethodEventVariant; ArgumentsCount: integer): PJSFunction; | |
begin | |
result := InternalRegisterMethod(obj,MethodName, | |
TMethod(Event),meVariant,ArgumentsCount); | |
end; | |
function TSMEngine.RegisterMethod(obj: PJSObject; | |
const MethodName: SynUnicode; const Event: TSMEngineMethodEventJSON; | |
ArgumentsCount: integer): PJSFunction; | |
begin | |
result := InternalRegisterMethod(obj,MethodName, | |
TMethod(Event),meJSON,ArgumentsCount); | |
end; | |
procedure TSMEngine.UnRegisterMethod(JSFunction: PJSFunction); | |
var i: integer; | |
begin | |
i := fNativeMethods.FindHashed(JSFunction); | |
if i<0 then | |
raise ESMException.CreateUTF8( | |
'%.UnRegisterMethod(%): Method not previously registered',[self,JSFunction]); | |
fNativeMethods.Delete(i); | |
end; | |
{ TSMEngineManager } | |
constructor TSMEngineManager.Create; | |
begin | |
FMaxPerEngineMemory := 8*1024*1024; | |
FMaxRecursionDepth := 32; | |
FEnginePool := TObjectList.Create; | |
InitializeCriticalSection(fEngineCS); | |
end; | |
procedure TSMEngineManager.SetMaxPerEngineMemory(AMaxMem: Cardinal); | |
begin | |
if aMaxMem<STACK_CHUNK_SIZE*MaxRecursionDepth then | |
raise ESMException.CreateUTF8( | |
'%.MaxPerEngineMemory := %, but must be >= STACK_CHUNK_SIZE*%, i.e. %', | |
[self,aMaxMem,MaxRecursionDepth,STACK_CHUNK_SIZE*MaxRecursionDepth]); | |
FMaxPerEngineMemory := AMaxMem; | |
end; | |
function TSMEngineManager.ThreadEngineIndex(ThreadID: TThreadID): Integer; | |
begin | |
if self<>nil then | |
for result := 0 to FEnginePool.Count-1 do | |
if TSMEngine(FEnginePool.List[result]).fThreadID=ThreadID then | |
exit; | |
result := -1; | |
end; | |
destructor TSMEngineManager.Destroy; | |
begin | |
FEnginePool.Free; | |
inherited; | |
DeleteCriticalSection(fEngineCS); | |
end; | |
procedure TSMEngineManager.DoOnNewEngine(const Engine: TSMEngine); | |
begin | |
if Assigned(FOnNewEngine) then | |
FOnNewEngine(Engine); | |
end; | |
function TSMEngineManager.ThreadSafeEngine: TSMEngine; | |
var i: integer; | |
ThreadID: TThreadID; | |
begin | |
EnterCriticalSection(fEngineCS); | |
try | |
ThreadID := GetCurrentThreadId; | |
i := ThreadEngineIndex(ThreadID); // inlined CurrentThreadEngine | |
if i<0 then | |
result := nil else | |
result := FEnginePool.List[i]; | |
if result<>nil then | |
if result.EngineContentVersion=Self.ContentVersion then | |
// return existing Engine corresponding to the current thread | |
exit else begin | |
// content version changed -> force recreate thread Engine | |
{$ifdef SM_DEBUG} | |
SynSMLog.Add.Log(sllDebug, | |
'Drop SpiderMonkey Engine for thread % - modification found',ThreadID); | |
{$endif} | |
FEnginePool.Delete(i); // as in ReleaseCurrentThreadEngine | |
end; | |
// here result=nil or to be ignored (just dropped) | |
{$ifdef SM_DEBUG} | |
SynSMLog.Add.Log(sllDebug, 'Create new JavaScript Engine for thread %',ThreadID); | |
{$endif} | |
result := CreateNewEngine; | |
result.fThreadID := ThreadID; | |
FEnginePool.Add(result); | |
finally | |
LeaveCriticalSection(fEngineCS); | |
end; | |
end; | |
procedure TSMEngineManager.ReleaseCurrentThreadEngine; | |
var | |
i: integer; | |
begin | |
EnterCriticalSection(fEngineCS); | |
try | |
i := ThreadEngineIndex(GetCurrentThreadId); | |
if i>=0 then begin | |
(FEnginePool[i] as TSMEngine).GarbageCollect; | |
FEnginePool.Delete(i); | |
end; | |
finally | |
LeaveCriticalSection(fEngineCS); | |
end; | |
end; | |
function TSMEngineManager.CurrentThreadEngine: TSMEngine; | |
var | |
i: integer; | |
begin | |
EnterCriticalSection(fEngineCS); | |
try | |
i := ThreadEngineIndex(GetCurrentThreadId); | |
if i < 0 then | |
result := nil else | |
result := FEnginePool.List[i]; | |
finally | |
LeaveCriticalSection(fEngineCS); | |
end; | |
end; | |
function TSMEngineManager.CreateNewEngine: TSMEngine; | |
begin | |
Result := TSMEngine.Create(Self); | |
if Assigned(FOnNewEngine) then begin | |
{$ifdef JS_THREADSAFE} | |
JS_BeginRequest(Result.cx); | |
try | |
{$endif} | |
FOnNewEngine(Result); | |
{$ifdef JS_THREADSAFE} | |
finally | |
JS_EndRequest(Result.cx); | |
end; | |
{$endif} | |
end; | |
end; | |
{ TSMValue } | |
function VariantToJSVal(cx: PJSContext; const Value: Variant): jsval; | |
begin | |
TSMValue(result).SetVariant(cx,Value); | |
end; | |
function TSMValue.ToInteger: integer; | |
begin | |
{$ifndef WITHASSERT} | |
if not JSVAL_IS_INT(FValue) then | |
raise ESMException.Create('TSMValue.ToInteger!'); | |
{$endif} | |
Result := JSVAL_TO_INT(FValue); | |
end; | |
procedure TSMValue.SetInteger(const Value: integer); | |
begin | |
FValue := INT_TO_JSVAL(Value); | |
end; | |
function TSMValue.ToDouble: double; | |
begin | |
{$ifndef WITHASSERT} | |
if not JSVAL_IS_DOUBLE(FValue) then | |
raise ESMException.Create('TSMValue.ToDouble!'); | |
{$endif} | |
Result := JSVAL_TO_DOUBLE(FValue); | |
end; | |
procedure TSMValue.SetDouble(const Value: double); | |
begin | |
FValue := DOUBLE_TO_JSVAL(Value); | |
end; | |
function TSMValue.ToBoolean: boolean; | |
begin | |
Result := (FValue=JSVAL_TRUE); | |
end; | |
procedure TSMValue.SetBoolean(const Value: boolean); | |
begin | |
if Value then | |
FValue := JSVAL_TRUE else | |
FValue := JSVAL_FALSE; | |
end; | |
function TSMValue.ToInt64: int64; | |
begin | |
if JSVAL_IS_INT(FValue) then | |
result := JSVAL_TO_INT(FValue) else | |
{$ifndef WITHASSERT} | |
if not JSVAL_IS_DOUBLE(FValue) then | |
raise ESMException.Create('TSMValue.ToInt64!') else | |
{$endif} | |
result := trunc(JSVAL_TO_DOUBLE(FValue)); | |
end; | |
procedure TSMValue.SetInt64(const Value: int64); | |
begin | |
if (Value>=Low(integer)) and (Value<=High(integer)) then | |
FValue := INT_TO_JSVAL(Value) else | |
FValue := DOUBLE_TO_JSVAL(Value); | |
end; | |
function TSMValue.ValType(cx: PJSContext): JSType; | |
begin | |
Result := JS_TypeOfValue(cx, FValue); | |
end; | |
function TSMValue.ToVariant(cx: PJSContext): Variant; | |
begin | |
ToVariant(cx,result); | |
end; | |
procedure TSMValue.ToVariant(cx: PJSContext; var result: Variant); | |
begin | |
case ValType(cx) of | |
JSTYPE_VOID: | |
VarClear(result); | |
JSTYPE_NULL: | |
SetVariantNull(result); | |
JSTYPE_OBJECT: | |
TSMVariant.New(cx,JSVAL_TO_OBJECT(FValue),result); | |
JSTYPE_STRING: | |
JSVAL_TO_STRING(FValue).ToVariant(cx,result); | |
JSTYPE_NUMBER: | |
if JSVAL_IS_INT(FValue) then | |
result := JSVAL_TO_INT(FValue) else | |
result := JSVAL_TO_DOUBLE(FValue); | |
JSTYPE_BOOLEAN: | |
result := JSVAL_TO_BOOLEAN(FValue)=JS_TRUE; | |
JSTYPE_FUNCTION: | |
result := TransformToSynUnicode(cx); | |
else | |
raise ESMException.CreateUTF8('Unhandled ToVariant(%)',[ord(ValType(cx))]); | |
end; | |
end; | |
procedure TSMValue.SetVariant(cx: PJSContext; const Value: Variant); | |
var CustomVariantType: TCustomVariantType; | |
begin | |
with TVarData(Value) do | |
case VType of | |
varNull: | |
FValue := JSVAL_NULL; | |
varEmpty: | |
FValue := JSVAL_VOID; | |
varBoolean: | |
if VBoolean then | |
FValue := JSVAL_TRUE else | |
FValue := JSVAL_FALSE; | |
varSmallint: | |
FValue := INT_TO_JSVAL(VSmallInt); | |
{$ifndef DELPHI5OROLDER} | |
varShortInt: | |
FValue := INT_TO_JSVAL(VShortInt); | |
varWord: | |
FValue := INT_TO_JSVAL(VWord); | |
varLongWord: | |
if VLongWord<=cardinal(high(Integer)) then | |
FValue := INT_TO_JSVAL(VLongWord) else | |
FValue := DOUBLE_TO_JSVAL(VLongWord); | |
{$endif} | |
varByte: | |
FValue := INT_TO_JSVAL(VByte); | |
varInteger: | |
FValue := INT_TO_JSVAL(VInteger); | |
varInt64: | |
SetInt64(VInt64); | |
varSingle: | |
FValue := DOUBLE_TO_JSVAL(VSingle); | |
varDouble: | |
FValue := DOUBLE_TO_JSVAL(VDouble); | |
varCurrency: | |
FValue := DOUBLE_TO_JSVAL(VCurrency); | |
varDate: | |
SetDateTime(cx,VDate); | |
varOleStr: | |
SetWideString(cx,WideString(VAny)); | |
varString: | |
SetAnsiChar(cx,VAny,length(RawByteString(VAny)), | |
{$ifndef HASVARUSTRING} CP_UTF8); | |
{$else} StringCodePage(RawByteString(VAny))); | |
varUString: | |
SetSynUnicode(cx,UnicodeString(VAny)); | |
{$endif} | |
else | |
if VType=varByRef or varVariant then | |
SetVariant(cx,PVariant(VPointer)^) else | |
if VType=varByRef or varOleStr then | |
SetWideString(cx,PWideString(VAny)^) else | |
{$ifdef HASVARUSTRING} | |
if VType=varByRef or varUString then | |
SetSynUnicode(cx,PUnicodeString(VAny)^) else | |
{$endif} | |
if (SMVariantType<>nil) and (VType=SMVariantType.VarType) then | |
FValue := OBJECT_TO_JSVAL(TSMVariantData(Value).obj) else | |
if FindCustomVariantType(VType,CustomVariantType) and | |
CustomVariantType.InheritsFrom(TSynInvokeableVariantType) then | |
SetJSON(cx,VariantSaveJSON(Value)) else | |
raise ESMException.CreateUTF8('Unhandled variant type %',[VType]); | |
end; | |
end; | |
procedure TSMValue.SetTVarRec(cx: PJSContext; const V: TVarRec); | |
begin | |
case V.VType of | |
vtPointer: | |
FValue := JSVAL_VOID; | |
vtBoolean: | |
if V.VBoolean then | |
FValue := JSVAL_TRUE else | |
FValue := JSVAL_FALSE; | |
vtInteger: | |
FValue := INT_TO_JSVAL(V.VInteger); | |
vtInt64{$ifdef FPC},vtQWord{$endif}: | |
SetInt64(V.VInt64^); | |
vtCurrency: | |
FValue := DOUBLE_TO_JSVAL(V.VCurrency^); | |
vtExtended: | |
FValue := DOUBLE_TO_JSVAL(V.VExtended^); | |
vtVariant: | |
SetVariant(cx,V.VVariant^); | |
vtWideString: | |
SetWideString(cx,WideString(V.VPointer)); | |
vtAnsiString: | |
SetAnsiChar(cx,V.VPointer,length(RawByteString(V.VAnsiString)), | |
{$ifndef HASCODEPAGE} CP_UTF8); | |
{$else} StringCodePage(RawByteString(V.VAnsiString))); | |
vtUnicodeString: | |
SetSynUnicode(cx,UnicodeString(V.VPointer)); | |
{$endif} | |
vtString: | |
SetAnsiChar(cx,PAnsiChar(@V.VString^[1]),ord(V.VString^[0]),0); | |
vtPChar: | |
SetAnsiChar(cx,V.VPChar,StrLen(V.VPointer),0); | |
vtChar: | |
SetAnsiChar(cx,@V.VChar,1,0); | |
vtWideChar: | |
FValue := STRING_TO_JSVAL(cx^.NewJSString(PWideChar(@V.VWideChar),1)); | |
else raise ESMException.CreateUTF8('Unhandled TVarRec.VType=%',[V.VType]); | |
end; | |
end; | |
function TSMValue.ToSynUnicode(cx: PJSContext): SynUnicode; | |
begin | |
ToSynUnicode(cx,result); | |
end; | |
procedure TSMValue.ToSynUnicode(cx: PJSContext; var result: SynUnicode); | |
begin | |
Result := JSVAL_TO_STRING(FValue).ToSynUnicode(cx); | |
end; | |
procedure TSMValue.SetSynUnicode(cx: PJSContext; const aStr: SynUnicode); | |
begin | |
SetWideChar(cx,pointer(aStr),length(aStr)); | |
end; | |
function TSMValue.ToWideString(cx: PJSContext): WideString; | |
begin | |
Result := JSVAL_TO_STRING(FValue).ToWideString(cx); | |
end; | |
procedure TSMValue.SetWideString(cx: PJSContext; const aStr: WideString); | |
begin | |
SetWideChar(cx,pointer(aStr),length(aStr)); | |
end; | |
procedure TSMValue.SetWideChar(cx: PJSContext; Text: PWideChar; TextLen: integer); | |
begin | |
if (Text=nil) or (TextLen=0) then | |
FValue := JS_GetEmptyStringValue(cx) else | |
FValue := STRING_TO_JSVAL(cx^.NewJSString(Text,TextLen)); | |
end; | |
procedure TSMValue.SetAnsiChar(cx: PJSContext; Text: PAnsiChar; TextLen, | |
CodePage: integer); | |
begin | |
if (Text=nil) or (TextLen=0) then | |
FValue := JS_GetEmptyStringValue(cx) else | |
FValue := STRING_TO_JSVAL(cx^.NewJSString(Text,TextLen,CodePage)); | |
end; | |
function TSMValue.ToUTF8(cx: PJSContext): RawUTF8; | |
begin | |
Result := JSVAL_TO_STRING(FValue).ToUTF8(cx); | |
end; | |
procedure TSMValue.SetUTF8(cx: PJSContext; const aStr: RawUTF8); | |
begin | |
FValue := STRING_TO_JSVAL(cx^.NewJSString(aStr)); | |
end; | |
procedure TSMValue.SetNativeString(cx: PJSContext; const aStr: SynUnicode); | |
begin | |
FValue := STRING_TO_JSVAL(JS_NewExternalString(cx, | |
pointer(aStr), length(aStr), @TSMEngine(cx.PrivateData).FStringFinalizer)); | |
end; | |
function TSMValue.ToDateTime(cx: PJSContext): TDateTime; | |
var oDate: PJSObject; | |
{$ifdef CONSIDER_TIME_IN_Z} // as defined in SynSM.inc | |
ms: double; | |
ms64: Int64; | |
fval: jsval; | |
{$else} | |
d, m, Y, h, mn, s, ml: Integer; | |
v, fval: jsval; | |
function GetIntFuncPropVal(funcName: PWideChar): Integer; | |
begin | |
Result := 0; | |
if JS_GetUCProperty(cx, oDate, pointer(funcName), Length(funcName), fval) = JS_TRUE then | |
if JS_CallFunctionValue(cx, oDate, fval, 0, nil, v) = JS_TRUE then | |
Result := JSVAL_TO_INT(v); | |
end; | |
{$endif} | |
begin | |
oDate := JSVAL_TO_OBJECT(FValue); | |
if JS_ObjectIsDate(cx, oDate) = JS_FALSE then | |
raise ESMException.Create('TSMValue.ToDateTime: not a DateTime object'); | |
{$ifdef CONSIDER_TIME_IN_Z} | |
ms := 0; | |
if JS_CallFunctionName(cx, oDate, PCChar('getTime'), 0, nil, fval) = JS_TRUE then | |
ms := JSVAL_TO_DOUBLE(fval); | |
if ms = 0 then | |
raise ESMException.Create('TSMValue.ToDateTime: no getTime() in Date object'); | |
ms64 := Trunc(ms); | |
// W/O millisec: Result := IncMilliSecond(UnixDateDelta, ms64); | |
Result := UnixMSTimeToDateTime(ms64); | |
{$else} | |
d := GetIntFuncPropVal('getDate'); | |
m := GetIntFuncPropVal('getMonth') + 1; //WTF months start from 0 | |
Y := GetIntFuncPropVal('getFullYear'); | |
h := GetIntFuncPropVal('getHours'); | |
mn := GetIntFuncPropVal('getMinutes'); | |
s := GetIntFuncPropVal('getSeconds'); | |
ml := GetIntFuncPropVal('getMilliseconds'); | |
Result := EncodeDateTime(Y, m, d, h, mn, s, ml); | |
{$endif} | |
end; | |
procedure TSMValue.SetDateTime(cx: PJSContext; const Value: TDateTime); | |
var dmsec: double; | |
unixTime: Int64; | |
{$ifdef CONSIDER_TIME_IN_Z} // as defined in SynSM.inc | |
oDate: PJSObject; | |
{$else} | |
// this realisation is buggy - it ignores timezone rules change history | |
// for server-side realisation the best solution is to use GMT time here | |
ms: Word; | |
STLocal, STUtc: TSystemTime; | |
TZ: TTimeZoneInformation; | |
AUTCDateTime: TDateTime; | |
{$endif} | |
begin | |
{$ifdef CONSIDER_TIME_IN_Z} | |
unixTime := DateTimeToUnixMSTime(Value); | |
dmsec := unixTime-(unixTime mod 1000); | |
oDate := JS_NewDateObjectMsec(cx, dmsec); | |
if JS_ObjectIsDate(cx, oDate)<>JS_TRUE then | |
raise ESMException.CreateUTF8('TSMValue.SetDateTime(%): not a valid date',[Value]); | |
FValue := oDate.ToJSValue; | |
{$else} | |
DateTimeToSystemTime(Value, STLocal); | |
GetTimeZoneInformation(TZ); | |
// use TzSpecificLocalTimeToSystemTime? | |
TZ.Bias := -TZ.Bias; | |
TZ.StandardBias := -TZ.StandardBias; | |
TZ.DaylightBias := -TZ.DaylightBias; | |
SystemTimeToTzSpecificLocalTime(@TZ, STLocal, STUtc); | |
ms := STUtc.wMilliseconds; | |
AUTCDateTime := SystemTimeToDateTime(STUtc); | |
dmSec := DateTimeToUnixMSTime(AUTCDateTime) + ms; | |
FValue := JS_NewDateObjectMsec(cx, dmsec).ToJSValue; | |
{$endif} | |
end; | |
function TSMValue.TransformToSynUnicode(cx: PJSContext): SynUnicode; | |
begin | |
Result := JS_ValueToString(cx, FValue).ToSynUnicode(cx); | |
end; | |
function TSMValue.TransformToUTF8(cx: PJSContext): RawUTF8; | |
begin | |
Result := JS_ValueToString(cx, FValue).ToUTF8(cx); | |
end; | |
function TSMValue.ToNativeFunction(cx: PJSContext): PJSFunction; | |
begin | |
if (not JSVAL_IS_OBJECT(FValue)) or | |
(JS_ObjectIsFunction(cx,JSVAL_TO_OBJECT(FValue))=JS_FALSE) then | |
result := nil else | |
result := JS_ValueToFunction(cx,FValue); | |
end; | |
function TSMValue.ToNativeFunctionName(cx: PJSContext): RawUTF8; | |
var str: PJSString; | |
buf,name: PWideChar; | |
len: size_t; | |
begin | |
result := ''; | |
if (@self=nil) or (not JSVAL_IS_OBJECT(FValue)) or | |
(JS_ObjectIsFunction(cx,JSVAL_TO_OBJECT(FValue))=JS_FALSE) then | |
exit; | |
str := JS_ValueToString(cx, FValue); | |
if str=nil then | |
exit; | |
buf := PWideChar(JS_GetStringCharsAndLength(cx, str, len)); | |
if (len<10) or not IdemPCharW(buf,'FUNCTION ') then | |
exit; | |
dec(len,9); | |
inc(buf,9); | |
name := buf; | |
while (len>0) and (buf^<>'(') do begin | |
dec(len); | |
inc(buf); | |
end; | |
RawUnicodeToUtf8(name,buf-name,result); | |
end; | |
function writeCallback(const buf: Pjschar; len: uint32; data: pointer): JSBool; cdecl; | |
begin | |
TTextWriter(data).AddNoJSONEscapeW(pointer(buf),len); | |
result := JS_TRUE; | |
end; | |
procedure TSMValue.AddJSON(cx: PJSContext; W: TTextWriter); | |
begin | |
if @self=nil then | |
W.AddShort('null') else | |
case ValType(cx) of | |
JSTYPE_VOID, | |
JSTYPE_NULL: | |
W.AddShort('null'); | |
JSTYPE_STRING: | |
JSVAL_TO_STRING(FValue).ToJSONString(cx,W); | |
JSTYPE_NUMBER: | |
if JSVAL_IS_INT(FValue) then | |
W.Add(JSVAL_TO_INT(FValue)) else | |
W.AddDouble(JSVAL_TO_DOUBLE(FValue)); | |
JSTYPE_BOOLEAN: | |
W.Add(JSVAL_TO_BOOLEAN(FValue)=JS_TRUE); | |
JSTYPE_OBJECT, | |
JSTYPE_FUNCTION: begin | |
if JS_Stringify(cx, @FValue, nil, JSVAL_NULL, writeCallback, pointer(W))<>JS_TRUE then begin | |
TSMEngine(cx.PrivateData).CheckJSError(JS_FALSE); | |
TSMEngine(cx.PrivateData).ClearLastError; | |
end | |
end | |
else raise ESMException.CreateUTF8( | |
'Unhandled TSMValue.AddJSON(%)',[ord(ValType(cx))]); | |
end; | |
end; | |
function TSMValue.ToJSON(cx: PJSContext): RawUTF8; | |
var W: TJSONWriter; | |
tmp: TTextWriterStackBuffer; | |
begin | |
W := TJSONWriter.CreateOwnedStream(tmp); | |
try | |
AddJSON(cx,W); | |
W.SetText(result); | |
finally | |
W.Free; | |
end; | |
end; | |
function TSMValue.SetJSON(cx: PJSContext; const aJSON: RawUTF8): boolean; | |
var tmp: RawUnicode; | |
len: integer; | |
begin | |
if aJSON='' then begin | |
SetVoid; | |
result := true; | |
end else begin | |
len := Utf8DecodeToRawUnicodeUI(aJSON,tmp); | |
result := JS_ParseJSON(cx,pointer(tmp),len shr 1,@self)<>JS_FALSE; | |
end; | |
end; | |
procedure TSMValue.SetNull; | |
begin | |
FValue := JSVAL_NULL; | |
end; | |
procedure TSMValue.SetVoid; | |
begin | |
FValue := JSVAL_VOID; | |
end; | |
{ TSMObject } | |
function TSMObject.Engine: TSMEngine; | |
begin | |
if @self=nil then | |
Result := nil else | |
Result := TSMEngine(cx.PrivateData); | |
end; | |
function TSMObject.AsSMValue: TSMValue; | |
begin | |
if (@self=nil) or (obj=nil) then | |
Result.FValue := JSVAL_NULL else | |
Result.FValue := OBJECT_TO_JSVAL(obj); | |
end; | |
procedure TSMObject.DefineProperty(const name: SynUnicode; | |
const value: TSMValue; attrs: TJSPropertyAttrs); | |
begin | |
if (@self=nil) or (cx=nil) or (obj=nil) or | |
(JS_DefineUCProperty(cx, Obj, pointer(name), length(name), | |
value.AsJSVal, nil, nil, word(attrs))<>JS_TRUE) then | |
raise ESMException.CreateUTF8('TSMObject.DefineProperty(%)', [name]); | |
end; | |
procedure TSMObject.DefineProperty(const name: SynUnicode; | |
const value: variant; attrs: TJSPropertyAttrs); | |
begin | |
DefineProperty(name,TSMValue(VariantToJsVal(cx,value)),attrs); | |
end; | |
procedure TSMObject.DefineProperty(const name: SynUnicode; | |
const value: variant); | |
begin | |
DefineProperty(name, value, FDefaultPropertyAttrs); | |
end; | |
procedure TSMObject.SetPropVariant(const propName: SynUnicode; | |
const Value: variant); | |
begin | |
DefineProperty(propName,Value); | |
end; | |
function TSMObject.HasProperty(const propName: SynUnicode): Boolean; | |
var has: JSBool; | |
begin | |
Result := (JS_HasUCProperty(cx, obj, | |
pointer(propName), length(propName), has)=JS_TRUE) and (has=JS_TRUE); | |
end; | |
function TSMObject.HasOwnProperty(const propName: SynUnicode): Boolean; | |
var has: JSBool; | |
begin | |
Result := (JS_AlreadyHasOwnUCProperty(cx, obj, | |
pointer(propName), length(propName), has)=JS_TRUE) and (has=JS_TRUE); | |
end; | |
function TSMObject.GetPropValue(const propName: SynUnicode): TSMValue; | |
begin | |
if JS_GetUCProperty(cx, obj, | |
pointer(propName), length(propName), Result.FValue)=JS_FALSE then | |
raise ESMException.CreateUTF8('TSMObject.GetPropValue(%)',[propName]); | |
end; | |
function TSMObject.GetPropVariant(const propName: SynUnicode): variant; | |
var res: TSMValue; // need a temp. var to compile with latest Delphi! :( | |
begin | |
res := GetPropValue(propName); | |
res.ToVariant(cx,result); | |
end; | |
procedure TSMObject.Evaluate(const script: SynUnicode; const scriptName: RawUTF8; | |
lineNo: Cardinal; out result: TSMValue); | |
var r: JSBool; | |
eng: TSMEngine; | |
begin | |
{$ifdef RESETFPUEXCEPTION} | |
TSynFPUException.ForLibraryCode; | |
{$endif} | |
eng := Engine; | |
eng.ClearLastError; | |
eng.ScheduleWatchdog(eng.fTimeoutInterval); | |
r := JS_EvaluateUCScript(cx, obj, | |
pointer(script), length(script), pointer(scriptName), lineNo, Result.FValue); | |
eng.ScheduleWatchdog(-1); | |
eng.CheckJSError(r); | |
end; | |
procedure TSMObject.RunMethod(const methodName: AnsiString; | |
const argv: SMValArray; out rval: TSMValue); | |
var r: JSBool; | |
eng: TSMEngine; | |
begin | |
{$ifdef RESETFPUEXCEPTION} | |
TSynFPUException.ForLibraryCode; | |
{$endif} | |
eng := Engine; | |
eng.ClearLastError; | |
eng.ScheduleWatchdog(Engine.fTimeoutInterval); | |
r := JS_CallFunctionName(cx, obj, pointer(methodName), | |
Length(argv), pointer(argv), rval.FValue); | |
eng.ScheduleWatchdog(-1); | |
eng.CheckJSError(r); | |
end; | |
procedure TSMObject.RunMethod(const methodName: AnsiString; | |
const argv: array of const; out rval: TSMValue); | |
var args: SMValArray; | |
a: integer; | |
begin | |
SetLength(args,length(argv)); | |
for a := 0 to high(argv) do | |
args[a].SetTVarRec(cx,argv[a]); | |
RunMethod(methodName,args,rval); | |
end; | |
function TSMObject.Run(const methodName: AnsiString; const argv: array of variant): variant; | |
var args: SMValArray; | |
a: integer; | |
res: TSMValue; | |
begin | |
SetLength(args,length(argv)); | |
for a := 0 to high(argv) do | |
args[a].SetVariant(cx,argv[a]); | |
RunMethod(methodName,args,res); | |
res.ToVariant(cx,result); | |
end; | |
procedure TSMObject.Root; | |
begin | |
if obj<>nil then | |
JS_AddObjectRoot(cx, @obj); | |
end; | |
procedure TSMObject.UnRoot; | |
begin | |
if obj<>nil then | |
JS_RemoveObjectRoot(cx, @obj); | |
end; | |
function TSMObject.DefineNativeMethod(const methodName: SynUnicode; func: JSNative; nargs: uintN; | |
attrs: TJSPropertyAttrs): PJSFunction; | |
begin | |
Result := JS_DefineUCFunction(cx, obj, | |
Pjschar(methodName), Length(methodName), func, nargs, word(attrs)); | |
if Result=nil then | |
raise ESMException.CreateUTF8('TSMObject.DefineNativeMethod(%)',[methodName]); | |
end; | |
procedure TSMObject.Clear; | |
begin | |
fCx := nil; | |
fObj := nil; | |
end; | |
function TSMObject.DefineNativeMethod(const methodName: AnsiString; func: JSNative; nargs: uintN; | |
attrs: TJSPropertyAttrs): PJSFunction; | |
begin | |
Result := JS_DefineFunction(cx, obj, | |
PCChar(methodName), func, nargs, word(attrs)); | |
if Result=nil then | |
raise ESMException.CreateUTF8('TSMObject.DefineNativeMethod(%)',[methodName]); | |
end; | |
function TSMObject.DefineNativeMethod(const methodName: AnsiString; | |
func: JSNative; nargs: uintN): PJSFunction; | |
begin | |
result := DefineNativeMethod(methodName, func, nargs, DefaultPropertyAttrs); | |
end; | |
function TSMObject.DefineNativeMethod(const methodName: SynUnicode; | |
func: JSNative; nargs: uintN): PJSFunction; | |
begin | |
result := DefineNativeMethod(methodName, func, nargs, DefaultPropertyAttrs); | |
end; | |
procedure TSMObject.DefineProperty(const name: SynUnicode; | |
const value: TSMValue); | |
begin | |
DefineProperty(name, value, FDefaultPropertyAttrs); | |
end; | |
function TSMObject.Parent: TSMObject; | |
begin | |
result.fCx := cx; | |
if obj=nil then | |
result.fObj := nil else | |
result.fObj := JS_GetParent(obj); | |
end; | |
function TSMObject.Prototype: TSMObject; | |
begin | |
result.fCx := cx; | |
if obj=nil then | |
result.fObj := nil else | |
JS_GetPrototype(cx, obj, result.fObj); | |
end; | |
function TSMEngine.DoProcessOperationCallback: JSBool; | |
begin | |
if fTimedOut then | |
Result := JS_FALSE else | |
Result := JS_TRUE; | |
end; | |
procedure TSMEngine.CancelExecution; | |
begin | |
fTimedOut := True; | |
FTimeOutAborted := True; | |
FErrorExist := True; | |
FLastErrorFileName := '(w/o name)'; | |
FLastErrorLine := 0; | |
FLastErrorMsg := FormatUTF8('JSError. Filename: %. Line %. Message: %', | |
[FLastErrorFileName, FLastErrorLine, 'Script runs for too long, terminating']); | |
JS_TriggerOperationCallback(rt); | |
end; | |
function TSMEngine.InitWatchdog: boolean; | |
begin | |
Assert(not Assigned(fWatchdogThread)); | |
fWatchdogLock := PR_NewLock; | |
if Assigned(fWatchdogLock) then begin | |
fWatchdogWakeup := PR_NewCondVar(fWatchdogLock); | |
if Assigned(fWatchdogWakeup) then begin | |
fSleepWakeup := PR_NewCondVar(fWatchdogLock); | |
if Assigned(fSleepWakeup) then begin | |
result := True; | |
exit; | |
end; | |
PR_DestroyCondVar(fWatchdogWakeup); | |
end; | |
end; | |
result := False; | |
end; | |
procedure TSMEngine.KillWatchdog; | |
var thread: PRThread; | |
begin | |
PR_Lock(fWatchdogLock); | |
thread := fWatchdogThread; | |
if Assigned(thread) then begin | |
// The watchdog thread is running, tell it to terminate waking it up | |
// if necessary. | |
fWatchdogThread := nil; | |
PR_NotifyCondVar(fWatchdogWakeup); | |
end; | |
PR_Unlock(fWatchdogLock); | |
if Assigned(thread) then | |
PR_JoinThread(thread); | |
PR_DestroyCondVar(fSleepWakeup); | |
PR_DestroyCondVar(fWatchdogWakeup); | |
PR_DestroyLock(fWatchdogLock); | |
end; | |
function IsBefore( t1, t2: int64): Boolean; | |
begin | |
Result := int32(t1 - t2) < 0; | |
end; | |
procedure WatchdogMain(arg: pointer); cdecl; | |
var eng: TSMEngine; | |
rt: PJSRuntime; | |
now_: int64; | |
sleepDuration: PRIntervalTime; | |
status: PRStatus; | |
begin | |
PR_SetCurrentThreadName('JS Watchdog'); | |
eng := TSMEngine(arg); | |
rt := eng.rt; | |
PR_Lock(eng.fWatchdogLock); | |
while Assigned(eng.fWatchdogThread) do begin | |
now_ := JS_Now(); | |
if (eng.fWatchdogHasTimeout and not IsBefore(now_, eng.fWatchdogTimeout)) then begin | |
// The timeout has just expired. Trigger the operation callback outside the lock | |
eng.fWatchdogHasTimeout := false; | |
PR_Unlock(eng.fWatchdogLock); | |
eng.CancelExecution; | |
PR_Lock(eng.fWatchdogLock); | |
// Wake up any threads doing sleep | |
PR_NotifyAllCondVar(eng.fSleepWakeup); | |
end else begin | |
if (eng.fWatchdogHasTimeout) then begin | |
// Time hasn't expired yet. Simulate an operation callback | |
// which doesn't abort execution. | |
JS_TriggerOperationCallback(rt); | |
end; | |
sleepDuration := PR_INTERVAL_NO_TIMEOUT; | |
if (eng.fWatchdogHasTimeout) then | |
sleepDuration := PR_TicksPerSecond() div 10; | |
status := PR_WaitCondVar(eng.fWatchdogWakeup, sleepDuration); | |
Assert(status = PR_SUCCESS); | |
end | |
end; | |
PR_Unlock(eng.fWatchdogLock); | |
end; | |
function TSMEngine.ScheduleWatchdog(t: Double): Boolean; | |
var interval: Int64; | |
timeout: Int64; | |
begin | |
if (t <= 0) then begin | |
PR_Lock(fWatchdogLock); | |
fWatchdogHasTimeout := false; | |
PR_Unlock(fWatchdogLock); | |
result := true; | |
exit; | |
end; | |
interval := int64(ceil(t * PRMJ_USEC_PER_SEC)); | |
timeout := JS_Now() + interval; | |
PR_Lock(fWatchdogLock); | |
if not Assigned(fWatchdogThread) then begin | |
Assert(not fWatchdogHasTimeout); | |
fWatchdogThread := PR_CreateThread(PR_USER_THREAD, | |
@WatchdogMain, | |
Self, | |
PR_PRIORITY_NORMAL, | |
PR_LOCAL_THREAD, | |
PR_JOINABLE_THREAD, | |
0); | |
if not Assigned(fWatchdogThread) then begin | |
PR_Unlock(fWatchdogLock); | |
Result := false; | |
Exit; | |
end | |
end else if (not fWatchdogHasTimeout or IsBefore(timeout, fWatchdogTimeout)) then begin | |
PR_NotifyCondVar(fWatchdogWakeup); | |
end; | |
fWatchdogHasTimeout := true; | |
fWatchdogTimeout := timeout; | |
PR_Unlock(fWatchdogLock); | |
Result := true; | |
end; | |
procedure TSMEngine.SetDefaultPropertyAttrs(const Value: TJSPropertyAttrs); | |
begin | |
FDefaultPropertyAttrs := Value; | |
end; | |
procedure TSMEngine.SetTimeoutValue(const Value: Double); | |
begin | |
fTimeoutInterval := Value; | |
ScheduleWatchdog(Value); | |
end; | |
function TSMObject.GetPrivate: pointer; | |
{$ifdef WITHASSERT} | |
var C: PJSClass; | |
{$endif} | |
begin | |
if obj=nil then | |
result := nil else | |
{$ifdef WITHASSERT} | |
// JS_GetPrivate can return some not-nil pointer when we call JS_GetPrivate for object | |
// with class which has no flag JSCLASS_HAS_PRIVATE | |
begin | |
C := JS_GetClass(obj); | |
if C.flags and JSCLASS_HAS_PRIVATE = 0 then | |
result := nil // May be need to raise exception | |
else | |
{$endif} | |
result := JS_GetPrivate(obj); | |
{$ifdef WITHASSERT} | |
end; | |
{$endif} | |
end; | |
procedure TSMObject.SetPrivate(const Value: pointer); | |
{$ifdef WITHASSERT} | |
var C: PJSClass; | |
{$endif} | |
begin | |
if obj<>nil then | |
{$ifdef WITHASSERT} begin | |
// If we set private data into object with class which has no flag JSCLASS_HAS_PRIVATE | |
// SM don't raise exception, but we can get AV in any other place | |
C := JS_GetClass(obj); | |
if C.flags and JSCLASS_HAS_PRIVATE = 0 then | |
exit // May be need to raise exception | |
else | |
{$endif} | |
JS_SetPrivate(obj, Value); | |
{$ifdef WITHASSERT} | |
end; | |
{$endif} | |
end; | |
function TSMObject.GetPrivateData(expectedClass: PJSClass): pointer; | |
begin | |
if obj=nil then | |
result := nil else | |
result := JS_GetInstancePrivate(cx, obj, expectedClass, nil); | |
end; | |
function TSMObject.ItemsCount: cardinal; | |
begin | |
JS_GetArrayLength(cx,obj,result) | |
end; | |
function TSMObject.IsArray: boolean; | |
begin | |
result := JS_IsArrayObject(cx,obj)=JS_TRUE; | |
end; | |
function TSMObject.GetItem(aIndex: integer): variant; | |
var res: TSMValue; | |
begin | |
if JS_GetElement(cx,obj,aIndex,res.FValue)=JS_FALSE then | |
raise ESMException.CreateUTF8('get TSMObject.Items[%]',[aIndex]) else | |
res.ToVariant(cx,result); | |
end; | |
procedure TSMObject.SetDefaultPropertyAttrs(const Value: TJSPropertyAttrs); | |
begin | |
FDefaultPropertyAttrs := Value; | |
end; | |
procedure TSMObject.SetItem(aIndex: integer; const Value: variant); | |
var val: TSMValue; | |
begin | |
val.SetVariant(cx,Value); | |
if JS_SetElement(cx,obj,aIndex,val.FValue)=JS_FALSE then | |
raise ESMException.CreateUTF8('set TSMObject.Items[%]',[aIndex]); | |
end; | |
procedure TSMObject.DeleteItem(aIndex: integer); | |
begin | |
if JS_DeleteElement(cx,obj,aIndex)=JS_FALSE then | |
raise ESMException.CreateUTF8('TSMObject.DeleteItem(%)',[aIndex]); | |
end; | |
{ TSMVariant } | |
function TSMVariant.IntGet(var Dest: TVarData; const Instance: TVarData; | |
Name: PAnsiChar; NameLen: PtrInt): boolean; | |
var res: TSMValue; | |
begin | |
//Assert(Instance.VType=SMVariantType.VarType); | |
with TSMVariantData(Instance) do | |
if JS_GetProperty(cx,obj,Name,res.FValue)=JS_FALSE then | |
raise ESMException.CreateUTF8('Unexpected %.%',[self,Name]) else | |
res.ToVariant(cx,variant(Dest)); | |
result := true; | |
end; | |
function TSMVariant.DoFunction(var Dest: TVarData; const V: TVarData; | |
const Name: string; const Arguments: TVarDataArray): Boolean; | |
var args: SMValArray; | |
a: integer; | |
res: TSMValue; | |
{$ifdef UNICODE} | |
nam: array[byte] of AnsiChar; | |
{$endif} | |
begin | |
//Assert(V.VType=SMVariantType.VarType); | |
result := true; | |
with TSMVariantData(V).VObject do begin | |
if (Arguments=nil) and (Name[1]='_') then begin | |
{$ifdef UNICODE} | |
UpperCopy255W(nam,Name)^ := #0; | |
case IdemPCharArray(@nam[1], | |
{$else} | |
case IdemPCharArray(@Name[2], | |
{$endif} ['ROOT','UNROOT']) of | |
0: begin | |
Root; | |
exit; | |
end; | |
1: begin | |
UnRoot; | |
exit; | |
end; | |
end; | |
end; | |
SetLength(args,length(Arguments)); | |
for a := 0 to high(args) do | |
args[a].SetVariant(cx,Variant(Arguments[a])); | |
RunMethod(AnsiString(Name),args,res); | |
res.ToVariant(cx,variant(Dest)); | |
end; | |
end; | |
function TSMVariant.IntSet(const Instance, Value: TVarData; | |
Name: PAnsiChar; NameLen: PtrInt): boolean; | |
var smValue: TSMValue; | |
begin | |
//Assert(Instance.VType=SMVariantType.VarType); | |
with TSMVariantData(Instance) do begin | |
smValue.SetVariant(cx,Variant(Value)); | |
result := JS_SetProperty(cx,obj,Name,smValue.FValue)<>JS_FALSE; | |
end; | |
if not result then | |
raise ESMException.CreateUTF8('Error setting %.%',[self,Name]); | |
end; | |
procedure TSMVariant.ToJSON(W: TTextWriter; const Value: variant; | |
Escape: TTextWriterKind); | |
var val: jsval; | |
begin | |
with TSMVariantData(Value) do | |
if VType=VarType then begin | |
val := OBJECT_TO_JSVAL(obj); | |
if JS_Stringify(cx, @val, nil, JSVAL_NULL, writeCallback, pointer(W))<>JS_TRUE then begin | |
TSMEngine(cx.PrivateData).CheckJSError(JS_FALSE); | |
TSMEngine(cx.PrivateData).ClearLastError; | |
end; | |
end else raise ESMException.CreateUTF8( | |
'%.ToJSON: Unexpected variant type %',[self,VType]); | |
end; | |
class procedure TSMVariant.New(const aObject: TSMObject; | |
out aValue: variant); | |
begin | |
VarClear(aValue); | |
TSMVariantData(aValue).Init(aObject); | |
end; | |
class procedure TSMVariant.New(cx: PJSContext; obj: PJSObject; | |
out aValue: variant); | |
begin | |
VarClear(aValue); | |
TSMVariantData(aValue).Init(cx,obj); | |
end; | |
class procedure TSMVariant.New(engine: TSMEngine; out aValue: variant); | |
begin | |
VarClear(aValue); | |
TSMVariantData(aValue).InitNew(engine); | |
end; | |
procedure TSMVariant.Cast(var Dest: TVarData; const Source: TVarData); | |
begin | |
CastTo(Dest,Source,VarType); | |
end; | |
procedure TSMVariant.CastTo(var Dest: TVarData; const Source: TVarData; | |
const AVarType: TVarType); | |
var tmp: RawUTF8; | |
begin | |
if Source.VType<>VarType then | |
RaiseCastError; | |
tmp := VariantToUTF8(variant(Source)); | |
if tmp='' then | |
Variant(Dest) := '<<JavaScript TSMVariant>>' else | |
RawUTF8ToVariant(tmp,Variant(Dest)); | |
end; | |
{ TSMVariantData } | |
procedure TSMVariantData.GetGlobal(out global: variant); | |
begin | |
global := VObject.Engine.Global; | |
end; | |
procedure TSMVariantData.Init(const aObject: TSMObject); | |
begin | |
Init(aObject.cx,aObject.obj); | |
end; | |
procedure TSMVariantData.Init(aCx: PJSContext; aObj: PJSObject); | |
begin | |
if SMVariantType=nil then | |
SMVariantType := SynRegisterCustomVariantType(TSMVariant); | |
ZeroFill(@self); | |
VType := SMVariantType.VarType; | |
VObject.fCx := aCx; | |
VObject.fObj := aObj; | |
end; | |
procedure TSMVariantData.InitNew(engine: TSMEngine); | |
var aObj: TSMObject; | |
begin | |
engine.NewObject(aObj); | |
Init(aObj.cx,aObj.obj); | |
end; | |
initialization | |
Assert(sizeof(TSMVariantData)=sizeof(variant)); | |
end. |