xtool/contrib/mORMot/SyNode/SyNode.pas

2272 lines
76 KiB
ObjectPascal

/// SyNode - server-side JavaScript execution using the SpiderMonkey 45/52
// library with nodeJS modules support
// - this unit is a part of the freeware Synopse framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SyNode;
{
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
Synopse Informatique - http://synopse.info
SyNode for mORMot Copyright (C) 2022 Pavel Mashlyakovsky & Vadim Orel
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) 2022
the Initial Developer. All Rights Reserved.
Contributor(s):
- Arnaud Bouchez
- Vadim Orel
- Pavel Mashlyakovsky
- win2014
- Geogre
- ssoftpro
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 *****
Version 1.18
- initial release. Use SpiderMonkey 45
- x64 support added
- move a Worker classes from UnityBase to SyNode
Allow to create and communicate with a threads from JavaScript
- implement nodeJS Buffer
- improved compartibility with nodeJS utils
- add a `process.version`
- implement a setTimeout/setInverval/setImmediate etc.
- SpiderMonkey 52 (x32 & x64) support ( SM52 condition should be defined )
- VSCode debugging support via [vscode-firefox-debug](https://github.com/hbenl/vscode-firefox-debug) adapter
Thanks to George for patch
- JS `process` now instance of EventEmitter
- JS Engine will emit `exit` event on destroy as in node
}
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
{$I SyNode.inc} // define SM_DEBUG CONSIDER_TIME_IN_Z
{$IFDEF CORE_MODULES_IN_RES}
{$R 'core_modules.res' 'core_modules.rc'}
{$ENDIF}
interface
uses
{$ifndef FPC}
Windows,
ShLwApi, // for older Delphi versions download this file from JEDI library
{$else}
LazFileUtils, dynlibs,
{$endif}
{$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif}
Classes,
{$ifndef LVCL}
Contnrs,
{$endif}
{$ifdef ISDELPHIXE2}
System.Rtti,
{$endif}
Variants,
SynCommons,
SynLog,
SpiderMonkey,
NSPRAPI,
SyNodeProto,
mORMot,
SynCrtSock,
SyNodeBinding_worker;
const
/// default stack growning size
STACK_CHUNK_SIZE: Cardinal = 8192;
type
{$M+}
TSMEngineManager = class;
{$M-}
TSMEngine = class;
TSMEngineClass = class of TSMEngine;
/// 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
private
fPrivateDataForDebugger: Pointer;
fNameForDebug: RawUTF8;
fDoInteruptInOwnThread: TThreadMethod;
{$IFNDEF SM52}
fRt: PJSRuntime;
{$ENDIF}
fcomp: PJSCompartment;
fStringFinalizer: JSStringFinalizer;
fManager: TSMEngineManager;
fGlobalObject: PJSRootedObject;
// gloal._timerLoop function used to emulate setTimeout/setInterval
// event loop. Implemented in WindowsTimer.js
FGlobalTimerLoopFunc: PJSRootedValue;
fGlobalObjectDbg: PJSRootedObject;
fEngineContentVersion: Cardinal;
fThreadID: TThreadID;
fLastErrorMsg: string;
fLastErrorNum: integer;
fLastErrorFileName: RawUTF8;
fLastErrorLine: integer;
fLastErrorStackTrace: SynUnicode;
fErrorExist: boolean;
fThreadData: pointer;
fDllModulesUnInitProcList: TList;
fNeverExpire: boolean;
fWebAppRootDir: RawUTF8;
/// called from SpiderMonkey callback. Do not raise exception here
// instead use CheckJSError metod after JSAPI compile/evaluate call
{$IFDEF SM52}
procedure DoProcessJSError(report: PJSErrorReport); virtual;
{$ELSE}
procedure DoProcessJSError(errMsg: PCChar; report: PJSErrorReport); virtual;
{$ENDIF}
/// called from SpiderMonkey callback. It used for interrupt execution of script
// when it executes too long
function DoProcessOperationCallback: Boolean; virtual;
procedure SetPrivateDataForDebugger(const Value: Pointer);
protected
fCx: PJSContext;
// used by Watchdog thread state. See js.cpp
fTimeOutAborted: Boolean;
fTimedOut: Boolean;
fWatchdogLock: PRLock;
fWatchdogWakeup: PRCondVar;
fWatchdogThread: PRThread;
fWatchdogHasTimeout: Boolean;
fWatchdogTimeout: Int64;
fSleepWakeup: PRCondVar;
fTimeoutValue: integer;
fCreatedAtTick: Int64;
function ScheduleWatchdog(t: integer): Boolean;
procedure KillWatchdog;
function InitWatchdog: boolean;
procedure SetTimeoutValue(const Value: Integer);
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;
/// reference to TSMEngineManager own this engine
property Manager: TSMEngineManager read FManager;
/// thread specific data - pointer to any structure, passed into ThreadSafeEngine call
// used to access a thread-details in the native functions
// as TsmEngive(cx.PrivateData).ThreadData
property ThreadData: pointer read FThreadData;
procedure SetThreadData(pThreadData: pointer);
/// 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: Boolean);
/// 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;
/// evaluate a JavaScript script in the global scope
// - 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)
procedure Evaluate(const script: SynUnicode; const scriptName: RawUTF8;
lineNo: Cardinal; out result: jsval); overload;
procedure Evaluate(const script: SynUnicode; const scriptName: RawUTF8;
lineNo: Cardinal); overload;
/// evaluate script embadedd into application resources
procedure EvaluateRes(const ResName: string; out result: jsval);
/// evaluate a JavaScript script as Module
// - if exception raised in script - raise Delphi ESMException
// - JavaScript equivalent to import of ES6
function EvaluateModule(const scriptName: RawUTF8): jsval;
/// run method of object
// - if exception raised in script - raise Delphi ESMException
// - on success returns function result
// - JavaScript equivalent to
// ! obj.funcName(args[0], args[1]...)
function CallObjectFunction(obj: PJSRootedObject; funcName: PCChar; const args: array of jsval): jsval;
/// The same as CallObjectFunction but accept funcVal insteadof fuction name
// a little bit faster when CallObjectFunction
function CallObjectFunctionVal(obj: PJSRootedObject; const funcVal: PJSRootedValue; const args: array of jsval): jsval;
/// access to the associated global object as low-level PJSRootedObject
property GlobalObject: PJSRootedObject read FGlobalObject;
/// access to the associated global object for debugging as low-level PJSRootedObject
property GlobalObjectDbg: PJSRootedObject read FGlobalObjectDbg;
/// access to the associated execution context
property cx: PJSContext read fCx;
{$IFNDEF SM52}
/// access to the associated execution runtime
property rt: PJSRuntime read frt;
{$ENDIF}
/// 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: string 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 (in seconds)
// - is set to -1 by default, i.e. meaning no execution timeout
property TimeOutValue: Integer read fTimeoutValue write SetTimeoutValue default -1;
/// If `true` engine will never expire
property NeverExpire: boolean read FNeverExpire write FNeverExpire;
/// Define a Delphi class as JS class (prototype), so it can be created via new:
// engine.defineClass(TmyObject, TSMNewRTTIProtoObject);
// and in JS
// var myObj = new TmyObject();
// - Class will be exposed in the aParent javaScript object, if aParent is omitted - in the global object
// - AProto parameter can be a TSMCustomProtoObject descendant (TSMSimpleRTTIProtoObject, TSMNewRTTIProtoObject)
// WARNING - possible prototypes count is limited to 255 - JSCLASS_GLOBAL_SLOT_COUNT = 76 for SM45,
// so it is better to use a bindings, add where a native functions and wrap it in class into the JavaScript
// see `fs.js` for sample.
function defineClass(AForClass: TClass; AProto: TSMCustomProtoObjectClass; aParent: PJSRootedObject = nil): TSMCustomProtoObject;
/// Add a set of classes with the same delphi binding implementation:
// engine.defineClasses([TubEntity, TubDomain, TubEntityAttribute], TSMNewRTTIProtoObject);
procedure defineClasses(const AClasses: array of TClass; AProto: TSMCustomProtoObjectClass; aParent: PJSRootedObject = nil);
/// define JS object for enumeratin type
// for TMyEnum = (etA, etB); will create in JS aObj.TMyEnum = {etA: 0, etB: 1);
procedure defineEnum(ti: PTypeInfo; aObj: PJSRootedObject);
/// Cancel current execution JavaScript.
// This procedure can be called from other script
// if AWithException paramener is thue, will raise a
// ESMException with message LONG_SCRIPT_EXECUTION
procedure CancelExecution(AWithException: boolean = true);
procedure DefineProcessBinding;
procedure DefineNodeProcess;
procedure DefineModuleLoader;
/// Used by debugger
property PrivateDataForDebugger: Pointer read FPrivateDataForDebugger write SetPrivateDataForDebugger;
/// Name of this engine. Will be shown in debugger for indentify this engine
property nameForDebug: RawUTF8 read fnameForDebug;
/// root path for current web app engine context
property webAppRootDir: RawUTF8 read fWebAppRootDir;
/// Handler hor debugger. Called from debugger thread when debugger need
// call rt.InterruptCallback(cx) in engine''s thread
// this method must wake up the engine's thread and thread must
// execute rt.InterruptCallback(cx) for this engine
property doInteruptInOwnThread: TThreadMethod read fDoInteruptInOwnThread write fDoInteruptInOwnThread;
end;
/// prototype of SpideMonkey notification callback method
TEngineEvent = procedure(const Engine: TSMEngine) of object;
/// event of getting engine name or web app root path
TEngineNameEvent = function(const Engine: TSMEngine): RawUTF8 of object;
/// event for loading dll module
TDllModuleEvent = procedure(Handle: HMODULE) of object;
/// event for adding values to process.binding
TSMProcessBindingHandler = function(const Engine: TSMEngine; const bindingNamespaceName: SynUnicode): jsval;
TDllModuleInitProc = function(cx: PJSContext; exports_: PJSRootedObject; require: PJSRootedObject; module: PJSRootedObject; __filename: PWideChar; __dirname: PWideChar): boolean; cdecl;
TDllModuleUnInitProc = function: boolean; cdecl;
TDllModuleRec = record
init: TDllModuleInitProc;
unInit: TDllModuleUnInitProc;
end;
PDllModuleRec = ^TDllModuleRec;
/// 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
private
FMaxPerEngineMemory: Cardinal;
FMaxNurseryBytes: Cardinal;
FMaxRecursionDepth: Cardinal;
FEnginePool: TSynObjectListLocked;
FRemoteDebuggerThread: TThread;
FContentVersion: Cardinal;
FOnNewEngine: TEngineEvent;
FOnDebuggerInit: TEngineEvent;
FOnGetName: TEngineNameEvent;
FOnGetWebAppRootPath: TEngineNameEvent;
FOnDebuggerConnected: TEngineEvent;
FOnDllModuleLoaded: TDllModuleEvent;
{$ifdef ISDELPHIXE2}
FRttiCx: TRttiContext;
{$endif}
FEngineClass: TSMEngineClass;
/// List of loaded dll modules
FDllModules: TRawUTF8List;
/// Path to core modules
FCoreModulesPath: RawUTF8;
FEngineExpireTimeOutTicks: Int64;
FWorkersManager: TJSWorkersManager;
function GetEngineExpireTimeOutMinutes: cardinal;
procedure SetEngineExpireTimeOutMinutes(const minutes: cardinal);
procedure SetMaxPerEngineMemory(AMaxMem: Cardinal);
procedure SetMaxNurseryBytes(AMaxNurseryBytes: Cardinal);
protected
grandParent: TSMEngine;
/// Release a javaScript engine for specified thread
procedure ReleaseEngineForThread(aThreadID: TThreadID);
/// 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;
/// called when a new Engine is created
// - this default implementation will run the OnNewEngine callback (if any)
procedure DoOnNewEngine(const Engine: TSMEngine); virtual;
function getPauseDebuggerOnFirstStep: boolean;
procedure setPauseDebuggerOnFirstStep(const Value: boolean);
function evalDllModule(cx: PJSContext; module: PJSRootedObject; const filename: RawUTF8): TDllModuleUnInitProc;
/// Get handler of process.binding
function GetBinding(const Name: RawUTF8): TSMProcessBindingHandler;
public
/// initialize the SpiderMonkey scripting engine
// aCoreModulesPath can be empty in case core modules are embadded
// as resources (CORE_MODULES_IN_RES is defined)
constructor Create(const aCoreModulesPath: RawUTF8; aEngineClass: TSMEngineClass = nil); virtual;
/// finalize the SpiderMonkey scripting engine
destructor Destroy; override;
/// Add a binding namespace - a set of native functions exposed to the JavaScript engine
// - we recommend not to use it directly in the businnes logic,
// but create a JavaScript module and wrap a binding function by the JavaScript
// see how `fs` binding from SyNodeBinding_fs unit is wrapped by `SyNode\core_modules\node_modules\fs.js`
class procedure RegisterBinding(const Name: RawUTF8; const handler: TSMProcessBindingHandler);
/// get or create one Engine associated with current running thread
// pThreadData is a pointer to any structure relative to this thread
// accessible via TsmEngine.ThreadData
function ThreadSafeEngine(pThreadData: pointer): 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;
/// returns nil if none was defined yet
function EngineForThread(ThreadID: TTHreadID): TSMEngine;
/// 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
procedure Lock;
procedure UnLock;
{$ifdef ISDELPHIXE2}
/// for defining JS object based on New RTTI we need a single TRttiContext
// in other case we got AV if used from DLL
property RttiCx: TRttiContext read FRttiCx;
{$endif}
/// Start/stop debugger listening on selected port
// - expects the port to be specified as Ansi string, e.g. '1234'
// - you can optionally specify a server address to bind to, e.g.
// '1.2.3.4:1234'
// - debugger create a dedicated thread where it listen to a requests
// from a remote debug UI
procedure startDebugger(const port: SockString = '6000');
procedure stopDebugger;
/// Write text as console log to current thread Engine's debugger (if exists)
procedure debuggerLog(const Text: RawUTF8);
/// when debugger connected to new engine this Engine must pause on first step
property pauseDebuggerOnFirstStep: boolean read getPauseDebuggerOnFirstStep write setPauseDebuggerOnFirstStep;
/// Workers manager
property WorkersManager: TJSWorkersManager read FWorkersManager;
/// Delete all started worker threads
procedure ClearWorkers;
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 32 MB
property MaxPerEngineMemory: Cardinal read FMaxPerEngineMemory write SetMaxPerEngineMemory
default 32*1024*1024;
// Nursery size in bytes
// - default is 16 MB
property MaxNurseryBytes: Cardinal read FMaxNurseryBytes write SetMaxNurseryBytes
default 16*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;
/// specify a maximum lifetime period after which JavaScript Engine will
// be recreated, to avoid potential JavaScript memory leak (variables in global,
// closures circle, etc.)
// - 0 by default - mean no expire timeout
// In case engine must never expire - set the NeverExpire property of engine manually
property EngineExpireTimeOutMinutes: cardinal
read GetEngineExpireTimeOutMinutes write SetEngineExpireTimeOutMinutes default 0;
/// Path to synode core modules.
// Not used in case core modules are embadded as resources (CORE_MODULES_IN_RES is defined)
property CoreModulesPath: RawUTF8 read FCoreModulesPath;
/// event triggered every time a new Engine is created
// event trigered before OnDebuggerInit and OnNewEngine events
// Result og this method is Engine's name for debug
property OnGetName: TEngineNameEvent read FOnGetName write FOnGetName;
/// event triggered every time a new Engine is created
// event trigered before OnDebuggerInit and OnNewEngine events
// Result og this method is Engine's web app root path
property OnGetWebAppRootPath: TEngineNameEvent read FOnGetWebAppRootPath write FOnGetWebAppRootPath;
/// event triggered every time a internal debugger process connected to Engine
// - event trigered in debugger's compartment
// - here your code can change the initial state of the debugger
property OnDebuggerInit: TEngineEvent read FOnDebuggerInit write FOnDebuggerInit;
/// 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;
/// event triggered every time a new remote debugger(Firefox) connect to Engine
// - Warning!!! event trigered in debugger's communication thread(not thread of Engine)
// so you cannot use Engine's Javascript in this method, but only Engine's properties
property OnDebuggerConnected: TEngineEvent read FOnDebuggerConnected write FOnDebuggerConnected;
/// event triggered every time a new dll module is loaded
// - here you code can customize dll module or call some functions from dll
property OnDllModuleLoaded: TDllModuleEvent read FOnDllModuleLoaded write FOnDllModuleLoaded;
end;
{$M-}
function SyNodeBinding_modules(const Engine: TSMEngine; const bindingNamespaceName: SynUnicode): 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;
LONG_SCRIPT_EXECUTION: string = 'Script runs for too long. Terminating';
/// check is AFileName is relative path, and if true - transform it to absolute from ABaseDir
// if ACheckResultInsideBase = true the perform check of result path is under ABaseDir. If not - return '';
// In any case will concatenates any relative path elements and replace '/' by '\' under Windows
function RelToAbs(const ABaseDir, AFileName: TFileName; ACheckResultInsideBase: boolean = false): TFileName;
implementation
uses
{$IFNDEF MSWINDOWS}
Errors, SynFPCLinux,
{$ENDIF}
SyNodeRemoteDebugger,
SyNodeBinding_fs {used by other core modules},
SyNodeBinding_const,
SyNodeBinding_buffer,
SyNodeBinding_util,
SyNodeBinding_uv,
synodebinding_os;
const
jsglobal_class: JSClass = (name: 'global';
flags:
JSCLASS_GLOBAL_FLAGS or
JSCLASS_HAS_PRIVATE or
(255 shl JSCLASS_RESERVED_SLOTS_SHIFT);
);
var
GlobalSyNodeBindingHandlers: TRawUTF8List;
/// handle errors from JavaScript. Just call DoProcessJSError of corresponding TSMEngine
// to set TSMEngine error properties
{$IFDEF SM52}
procedure WarningReporter(cx: PJSContext; report: PJSErrorReport); cdecl;
begin
TSMEngine(cx.PrivateData).DoProcessJSError(report)
end;
{$ELSE}
procedure ErrorReporter(cx: PJSContext; pErrMsg: PCChar; report: PJSErrorReport); cdecl;
begin
TSMEngine(cx.PrivateData).DoProcessJSError(pErrMsg, report)
end;
{$ENDIF}
function OperationCallback(cx: PJSContext): Boolean; cdecl;
begin
Result := TSMEngine(cx.PrivateData).DoProcessOperationCallback;
end;
{ TSMEngine }
// do nothing here
procedure ExternalStringFinalizer(fin: PJSStringFinalizer; chars: PCChar16); cdecl;
begin
{}
end;
function process_binding(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
const
USAGE = 'usage: binding(scope: String)';
var
Eng: TSMEngine;
in_argv: PjsvalVector;
bindingNS: SynUnicode;
res: jsval;
handler: TSMProcessBindingHandler;
FBindingObject: PJSRootedObject;
begin
Eng := TObject(cx.PrivateData) as TSMEngine;
try
in_argv := vp.argv;
if (argc <> 1) or not (in_argv[0].isString) then
raise ESMException.Create(USAGE);
bindingNS := in_argv[0].asJSString.ToSynUnicode(cx);
FBindingObject := cx.NewRootedObject(vp.calleObject);
try
if FBindingObject.ptr <> nil then begin
res := FBindingObject.ptr.GetPropValue(cx, bindingNS);
if res.isVoid then begin
handler := Eng.Manager.GetBinding(SynUnicodeToUtf8(bindingNS));
if Assigned(handler) then begin
res := handler(eng, bindingNS);
if not res.isVoid then begin
FBindingObject.ptr.DefineUCProperty(cx, bindingNS, res);
end;
end else
raise ESMException.CreateFmt('Invalid binding namespace "%s"',[bindingNS]);
end;
end else
res.SetNull;
finally
cx.FreeRootedObject(FBindingObject);
end;
vp.rval := res;
Result := True;
except
on E: Exception do begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
constructor TSMEngine.Create(aManager: TSMEngineManager);
const
gMaxStackSize = 128 * sizeof(size_t) * 1024;
var
{$IFDEF SM52}
cOpts: PJSContextOptions;
{$ELSE}
rOpts: PJSRuntimeOptions;
{$ENDIF}
fpu: IUnknown;
begin
fpu := TSynFPUException.ForLibraryCode;
if aManager = nil then
raise ESMException.Create('No manager provided');
FCreatedAtTick := GetTickCount64;
FManager := aManager;
FEngineContentVersion := FManager.ContentVersion;
{$IFDEF SM52}
// TODO - solve problem of destroying parent engine before slave and uncomment a code below
// this will save up to 20% of RAM - some internal structures of SM Engines will be reused
// between threads
// if aManager.grandParent <> nil then
// fCx := PJSContext(nil).CreateNew(FManager.MaxPerEngineMemory, $01000000, aManager.grandParent.cx)
// else
fCx := PJSContext(nil).CreateNew(FManager.MaxPerEngineMemory, $01000000, nil);
if fCx = nil then
raise ESMException.Create('Create context: out of memory');
{$IFNDEF CPUX64} // This check does not always work correctly under 64-bit configurations. Need more investigation to understand the problem
fCx.SetNativeStackQuota(gMaxStackSize);
{$ENDIF}
fCx.GCParameter[JSGC_MAX_BYTES] := FManager.MaxPerEngineMemory;
// MPV as Mozilla recommend in https://bugzilla.mozilla.org/show_bug.cgi?id=950044
//TODO - USE JS_SetGCParametersBasedOnAvailableMemory for SM32 and override JSGC_MAX_MALLOC_BYTES
if (FManager.MaxPerEngineMemory >= 512 * 1024 * 1024) then begin
fCx.GCParameter[JSGC_MAX_MALLOC_BYTES] := 96 * 1024 * 1024;
fCx.GCParameter[JSGC_SLICE_TIME_BUDGET] := 30;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1000;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_HIGH_LIMIT] := 500;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_LOW_LIMIT] := 100;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_HEAP_GROWTH_MAX] := 300;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_HEAP_GROWTH_MIN] := 150;
fCx.GCParameter[JSGC_LOW_FREQUENCY_HEAP_GROWTH] := 150;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fCx.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fCx.GCParameter[JSGC_ALLOCATION_THRESHOLD] := 30;
// fCx.GCParameter[JSGC_DECOMMIT_THRESHOLD] := 32;
// fCx.GCParameter[JSGC_MODE] := uint32(JSGC_MODE_COMPARTMENT);
fCx.GCParameter[JSGC_MODE] := uint32(JSGC_MODE_INCREMENTAL);
end else begin
fCx.GCParameter[JSGC_MAX_MALLOC_BYTES] := 6 * 1024 * 1024; //MPV in PREV realisation - FManager.MaxPerEngineMemory div 2; we got a memory overuse
fCx.GCParameter[JSGC_MODE] := uint32(JSGC_MODE_INCREMENTAL);
end;
{$ELSE}
frt := PJSRuntime(nil).New(FManager.MaxPerEngineMemory, $01000000, nil);
if frt = nil then
raise ESMException.Create('Create runtime: out of memory');
fRt.SetNativeStackQuota(gMaxStackSize);
fRt.GCParameter[JSGC_MAX_BYTES] := FManager.MaxPerEngineMemory;
// MPV as Mozilla recommend in https://bugzilla.mozilla.org/show_bug.cgi?id=950044
//TODO - USE JS_SetGCParametersBasedOnAvailableMemory for SM32 and override JSGC_MAX_MALLOC_BYTES
if (FManager.MaxPerEngineMemory >= 512 * 1024 * 1024) then begin
fRt.GCParameter[JSGC_MAX_MALLOC_BYTES] := 96 * 1024 * 1024;
fRt.GCParameter[JSGC_SLICE_TIME_BUDGET] := 30;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1000;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_HIGH_LIMIT] := 500;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_LOW_LIMIT] := 100;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_HEAP_GROWTH_MAX] := 300;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_HEAP_GROWTH_MIN] := 150;
fRt.GCParameter[JSGC_LOW_FREQUENCY_HEAP_GROWTH] := 150;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fRt.GCParameter[JSGC_HIGH_FREQUENCY_TIME_LIMIT] := 1500;
fRt.GCParameter[JSGC_ALLOCATION_THRESHOLD] := 30;
fRt.GCParameter[JSGC_DECOMMIT_THRESHOLD] := 32;
fRt.GCParameter[JSGC_MODE] := uint32(JSGC_MODE_COMPARTMENT);
end else begin
fRt.GCParameter[JSGC_MAX_MALLOC_BYTES] := 6 * 1024 * 1024; //MPV in PREV realisation - FManager.MaxPerEngineMemory div 2; we got a memory overuse
fRt.GCParameter[JSGC_MODE] := uint32(JSGC_MODE_INCREMENTAL);
end;
fCx := rt.NewContext(STACK_CHUNK_SIZE);
if fCx = nil then
raise ESMException.Create('JSContext create');
{$ENDIF}
{$IFDEF SM52}
cOpts := cx.Options;
cOpts.Baseline := True;
cOpts.Ion := True;
cOpts.AsmJS := True;
{$ELSE}
// You must set jsoBaseLine,jsoTypeInference,jsoIon for the enabling ION
// ION is disabled without these options
rOpts := rt.Options;
rOpts.Baseline := True;
rOpts.Ion := True;
rOpts.AsmJS := True;
{$ENDIF}
fStringFinalizer.finalize := ExternalStringFinalizer;
cx.PrivateData := self;
{$IFDEF SM52}
// not working for errors
// TODO: implement log warnings if needed
// fCx.WarningReporter := WarningReporter;
{$ELSE}
fRt.ErrorReporter := ErrorReporter;
{$ENDIF}
FGlobalObject := cx.NewRootedObject(cx.NewGlobalObject(@jsglobal_class));
if FGlobalObject.ptr = nil then
raise ESMException.Create('Create global object');
fcomp := cx.EnterCompartment(FGlobalObject.ptr);
if not cx.InitStandardClasses(FGlobalObject.ptr) then
raise ESMException.Create('InitStandardClasses failure');
if not cx.InitCTypesClass(FGlobalObject.ptr) then
raise ESMException.Create('InitCTypesClass failure');
// if not cx.InitReflectParse(FGlobalObject.ptr) then
// raise ESMException.Create('InitReflectParse failure');
if not cx.InitModuleClasses(FGlobalObject.ptr) then
raise ESMException.Create('InitModuleClasses failure');
FGlobalObject.ptr.DefineProperty(cx, 'global', FGlobalObject.ptr.ToJSValue,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY, nil, nil);
fTimeoutValue := -1;
if not InitWatchdog then
raise ESMException.Create('InitWatchDog failure');
{$IFDEF SM52}
fcx.AddInterruptCallback(OperationCallback);
{$ELSE}
fRt.InterruptCallback := OperationCallback;
{$ENDIF}
FDllModulesUnInitProcList := TList.Create;
DefineProcessBinding;
DefineNodeProcess;
DefineModuleLoader;
EvaluateModule('synode.js');
FGlobalTimerLoopFunc := cx.NewRootedValue(FGlobalObject.ptr.GetPropValue(cx, '_timerLoop'));
FGlobalObjectDbg := cx.NewRootedObject(cx.NewGlobalObject(@jsglobal_class));
end;
procedure TSMEngine.defineEnum(ti: PTypeInfo; aObj: PJSRootedObject);
begin
SyNodeProto.defineEnum(cx, ti, aObj);
end;
procedure TSMEngine.DefineModuleLoader;
var ModuleLoaderPath: TFileName;
script: SynUnicode;
rval: jsval;
begin
{$IFDEF CORE_MODULES_IN_RES}
EvaluateRes('MODULELOADER.JS', rval);
{$ELSE}
ModuleLoaderPath := RelToAbs(UTF8ToString(FManager.coreModulesPath) , 'ModuleLoader.js');
script := AnyTextFileToSynUnicode(ModuleLoaderPath);
if script = '' then
raise ESMException.Create('File not found ' + ModuleLoaderPath);
Evaluate(script, 'ModuleLoader.js', 1, rval);
{$ENDIF}
end;
procedure TSMEngine.DefineNodeProcess;
var process: PJSRootedObject;
env: PJSRootedObject;
FStartupPath: TFileName;
{$IFDEF FPC}
I, Cnt: Integer;
EnvStr: AnsiString;
Parts: array of AnsiString;
{$ELSE}
L: PtrInt;
EnvBlock, P, pEq: PChar;
strName, strVal: SynUnicode;
{$ENDIF}
begin
process := cx.NewRootedObject(FGlobalObject.ptr.GetPropValue(cx, 'process').asObject);
env := cx.NewRootedObject(cx.NewObject(nil));
try
process.ptr.defineProperty(cx, 'binPath', cx.NewJSString(ExeVersion.ProgramFilePath).ToJSVal,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY);
process.ptr.defineProperty(cx, 'execPath', cx.NewJSString(ExeVersion.ProgramFileName).ToJSVal,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY);
FStartupPath := GetCurrentDir + {$IFDEF FPC}DirectorySeparator{$ELSE}'\'{$ENDIF};
if FStartupPath = '' then
FStartupPath := ExeVersion.ProgramFilePath;
process.ptr.defineProperty(cx, 'startupPath', cx.NewJSString(StringToSynUnicode(FStartupPath)).ToJSVal,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY);
{$IFDEF FPC}
Cnt := GetEnvironmentVariableCount;
for I := 1 to Cnt do begin
EnvStr := GetEnvironmentString(I);
Parts := EnvStr.Split('=', TStringSplitOptions.ExcludeEmpty);
if (Length(Parts) = 2) and (Trim(Parts[0]) <> '') then begin
env.ptr.DefineUCProperty(cx, StringToSynUnicode(Trim(Parts[0])), cx.NewJSString(Trim(Parts[1])).ToJSVal,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY, nil, nil);
end
end;
{$ELSE}
EnvBlock := GetEnvironmentStrings;
try
P := EnvBlock;
while P^<>#0 do begin
{$ifdef UNICODE}
L := StrLenW(P);
{$else}
L := StrLen(P);
{$endif}
if (L>0) and (P^<>'=') then begin
pEq := StrScan(P, '=');
if pEq <> nil then begin
SetString(strName, p, pEq-P);
SetString(strVal, pEq+1, {$ifdef UNICODE}StrLenW{$else}StrLen{$endif}(pEq+1));
env.ptr.DefineUCProperty(cx, Pointer(strName), Length(strName), cx.NewJSString(strVal).ToJSVal,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY, nil, nil);
end;
end;
inc(P,L+1);
end;
finally
FreeEnvironmentStrings(EnvBlock);
end;
{$ENDIF}
process.ptr.defineProperty(cx, 'env', env.ptr.ToJSValue,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY);
{$IFDEF MSWINDOWS}
process.ptr.defineProperty(cx, 'platform', cx.NewJSString('win32').ToJSVal);
{$ELSE}
process.ptr.defineProperty(cx, 'platform', cx.NewJSString('nix').ToJSVal);
{$ENDIF}
{$IFDEF CPU64}
process.ptr.defineProperty(cx, 'arch', cx.NewJSString('x64').ToJSVal);
{$ELSE}
process.ptr.defineProperty(cx, 'arch', cx.NewJSString('x32').ToJSVal);
{$ENDIF}
with ExeVersion.Version do
process.ptr.DefineProperty(cx, 'version',
cx.NewJSString('v' + IntToString(Major)+'.'+IntToString(Minor) + '.' + IntToString(Release)).ToJSVal);
finally
cx.FreeRootedObject(env);
cx.FreeRootedObject(process);
end;
end;
procedure TSMEngine.DefineProcessBinding;
var
process: PJSRootedObject;
global: PJSRootedObject;
begin
process := cx.NewRootedObject(cx.NewObject(nil));
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
try
process.ptr.DefineFunction(cx, 'binding', process_binding, 1);
global.ptr.DefineProperty(cx, 'process', process.ptr.ToJSValue,
JSPROP_ENUMERATE or JSPROP_PERMANENT or JSPROP_READONLY, nil, nil);
finally
cx.FreeRootedObject(global);
cx.FreeRootedObject(process);
end;
end;
destructor TSMEngine.Destroy;
var
unInitProc: TDllModuleUnInitProc;
process: PJSRootedObject;
procExitCodeVal: jsval;
begin
try
process := cx.NewRootedObject(GlobalObject.ptr.GetPropValue(cx,'process').asObject);
try
process.ptr.SetProperty(cx, '_exiting', SimpleVariantToJSval(cx, true));
if process.ptr.HasProperty(cx, 'emit') then
CallObjectFunction(process, 'emit', [cx.NewJSString('exit').ToJSVal])
else
raise Exception.Create('`process` initialized incorrectly (dont have `emit` method)');
procExitCodeVal := process.ptr.GetPropValue(cx, 'exitCode');
if procExitCodeVal.isInteger then
ExitCode := procExitCodeVal.asInteger;
finally
cx.FreeRootedObject(process);
end;
except
on E: Exception do begin
ExitCode := 1;
end;
end;
if Manager.FRemoteDebuggerThread <> nil then begin
TSMRemoteDebuggerThread(Manager.FRemoteDebuggerThread).stopDebugCurrentThread(Self);
end;
while FDllModulesUnInitProcList.Count > 0 do begin
unInitProc := FDllModulesUnInitProcList[FDllModulesUnInitProcList.Count - 1];
FDllModulesUnInitProcList.Delete(FDllModulesUnInitProcList.Count - 1);
unInitProc();
end;
FDllModulesUnInitProcList.Free;
inherited Destroy;
if FGlobalTimerLoopFunc <> nil then cx.FreeRootedValue(FGlobalTimerLoopFunc);
if FGlobalObjectDbg <> nil then cx.FreeRootedObject(FGlobalObjectDbg);
if FGlobalObject <> nil then cx.FreeRootedObject(FGlobalObject);
with TSynFPUException.ForLibraryCode do begin
cx.LeaveCompartment(comp);
if FThreadID=GetCurrentThreadId then
cx^.Destroy; // SM 45 expects the context to be released in the same thread
KillWatchdog;
{$IFNDEF SM52}
if FThreadID=GetCurrentThreadId then
rt^.Destroy;
{$ENDIF}
end;
end;
{$IFDEF SM52}
procedure TSMEngine.DoProcessJSError(report: PJSErrorReport);
{$ELSE}
procedure TSMEngine.DoProcessJSError(errMsg: PCChar; report: PJSErrorReport);
{$ENDIF}
var
exc: jsval;
exObj: PJSRootedObject;
begin
if {$IFDEF SM52}(report = nil) or {$ENDIF}(report.flags = JSREPORT_WARNING) then
Exit;
FErrorExist := True;
if report^.filename = nil then
FLastErrorFileName := '<>' else
FLastErrorFileName := CurrentAnsiConvert.AnsiBufferToRawUTF8(
report^.filename,StrLen(pointer(report^.filename)));
FLastErrorLine := report^.lineno;
FLastErrorNum := report^.errorNumber;
{$IFDEF SM52}
FLastErrorMsg := Utf8ToString(FormatUTF8('%', [report^.message_]));
{$ELSE}
if report^.ucmessage=nil then
FLastErrorMsg := Utf8ToString(FormatUTF8('%', [errMsg])) else
SetString(FLastErrorMsg, PWideChar(report^.ucmessage), StrLenW(PWideChar(report^.ucmessage)));
{$ENDIF}
FLastErrorStackTrace := '';
if ( cx.GetPendingException(exc)) then begin
if exc.isObject then begin
exObj := cx.NewRootedObject(exc.asObject);
exObj.ptr.GetProperty(cx, 'stack', exc);
if (not exc.isVoid) and (exc.isString) then
FLastErrorStackTrace := exc.asJSString.ToSynUnicode(cx);
cx.FreeRootedObject(exObj);
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: Boolean);
var exc: jsval;
{$IFDEF SM52}
excObj: PJSRootedObject;
{$ENDIF}
rep: PJSErrorReport;
R: RawUTF8;
begin
{$IFDEF SM52}
if JS_IsExceptionPending(fCx) and JS_GetPendingException(cx, exc) then begin
if exc.isObject then begin
excObj := cx.NewRootedObject(exc.asObject);
try
rep := JS_ErrorFromException(cx, excObj.ptr);
if (rep <> nil) and (rep.flags = JSREPORT_WARNING) then
exit;
// Error inheritance (assert.AssertionError for example)
// will return an nil as a rep, so we need to examine a exc object
FErrorExist := True;
excObj.ptr.GetProperty(cx, 'fileName', exc);
if (not exc.isVoid) and (exc.isString) then
FLastErrorFileName := exc.asJSString.ToUTF8(fCx);
excObj.ptr.GetProperty(cx, 'lineNumber', exc);
if (not exc.isVoid) then begin
if (exc.isString) then begin // error line is in format line:char (123:16)
R := exc.asJSString.ToUTF8(fCx);
FLastErrorLine := GetInteger(pointer(R));
end else if (exc.isInteger) then
FLastErrorLine := exc.asInteger
end;
excObj.ptr.GetProperty(cx, 'message', exc);
if (not exc.isVoid) and (exc.isString) then
FLastErrorMsg := exc.asJSString.ToString(fCx);
excObj.ptr.GetProperty(cx, 'stack', exc);
if (not exc.isVoid) and (exc.isString) then
FLastErrorStackTrace := exc.asJSString.ToSynUnicode(fCx);
if (rep <> nil) then
FLastErrorNum := rep^.errorNumber
else begin
excObj.ptr.GetProperty(cx, 'errorNumber', exc);
if (not exc.isVoid) and (exc.isInteger) then
FLastErrorNum := exc.asInteger
else
FLastErrorNum := 0;
end;
finally
cx.FreeRootedObject(excObj);
end;
end else if exc.isString then begin
FErrorExist := True;
FLastErrorFileName := '<betterToThrowErrorInsteadOfPlainValue>';
FLastErrorMsg := exc.asJSString.ToString(fCx);
FLastErrorStackTrace := '';
FLastErrorNum := 0;
end else begin
FErrorExist := True;
FLastErrorFileName := '<betterToThrowError>';
FLastErrorMsg := 'code throw a plain value instead of Error (or error like) object';
FLastErrorStackTrace := '';
FLastErrorNum := 0;
end;
raise ESMException.CreateWithTrace(FLastErrorFileName, FLastErrorNum, FLastErrorLine, FLastErrorMsg, FLastErrorStackTrace);
end;
{$ENDIF}
if (FTimeOutAborted and (FLastErrorMsg <> '')) or FErrorExist then begin
raise ESMException.CreateWithTrace(FLastErrorFileName, FLastErrorNum, FLastErrorLine, FLastErrorMsg, FLastErrorStackTrace);
end;
if not res and not FTimeOutAborted then begin
raise ESMException.CreateWithTrace(FLastErrorFileName, 0, FLastErrorLine, 'Error compiling script', '');
end;
end;
procedure TSMEngine.ClearLastError;
begin
fcx.ClearPendingException;
FErrorExist := False;
FTimeOutAborted := False;
fTimedOut := False;
end;
procedure TSMEngine.GarbageCollect;
begin
{$IFDEF SM52}
cx.GC;
{$ELSE}
rt.GC;
{$ENDIF}
end;
procedure TSMEngine.MaybeGarbageCollect;
begin
cx.MaybeGC;
end;
{ TSMEngineManager }
class procedure TSMEngineManager.RegisterBinding(const Name: RawUTF8;
const handler: TSMProcessBindingHandler);
begin
if GlobalSyNodeBindingHandlers = nil then
GlobalSyNodeBindingHandlers := TRawUTF8List.Create(false);
GlobalSyNodeBindingHandlers.AddObject(Name, TObject(@handler));
end;
function TSMEngineManager.GetBinding(const Name: RawUTF8): TSMProcessBindingHandler;
var
obj: TObject;
handler: TSMProcessBindingHandler absolute obj;
begin
obj := GlobalSyNodeBindingHandlers.GetObjectFrom(Name);
result := handler;
end;
function TSMEngineManager.GetEngineExpireTimeOutMinutes: cardinal;
begin
result := fEngineExpireTimeOutTicks div 60000;
end;
procedure TSMEngineManager.ClearWorkers;
begin
FWorkersManager.Free;
FWorkersManager := TJSWorkersManager.Create;
end;
constructor TSMEngineManager.Create(const aCoreModulesPath: RawUTF8; aEngineClass: TSMEngineClass = nil);
begin
FMaxPerEngineMemory := 32*1024*1024;
FMaxRecursionDepth := 32;
FEnginePool := TSynObjectListLocked.Create(true);
if aEngineClass <> nil then
FEngineClass := aEngineClass
else
FEngineClass := TSMEngine;
{$ifdef ISDELPHIXE2}
FRttiCx := TRttiContext.Create();
{$endif}
FDllModules := TRawUTF8List.Create();
FCoreModulesPath := aCoreModulesPath;
FWorkersManager := TJSWorkersManager.Create;
end;
procedure TSMEngineManager.SetMaxPerEngineMemory(AMaxMem: Cardinal);
begin
if aMaxMem<STACK_CHUNK_SIZE*MaxRecursionDepth then
raise ESMException.CreateFmt(
'Per engine memory must be >= STACK_CHUNK_SIZE*%d, i.e. %d',
[MaxRecursionDepth,STACK_CHUNK_SIZE*MaxRecursionDepth]);
FMaxPerEngineMemory := AMaxMem;
end;
procedure TSMEngineManager.SetEngineExpireTimeOutMinutes(const minutes: cardinal);
begin
fEngineExpireTimeOutTicks := minutes * 60000;
end;
procedure TSMEngineManager.SetMaxNurseryBytes(AMaxNurseryBytes: Cardinal);
begin
FMaxNurseryBytes := AMaxNurseryBytes;
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;
var
dllModule: PDllModuleRec;
i: Integer;
begin
FWorkersManager.Free;
FWorkersManager := nil;
stopDebugger;
if FEnginePool.Count>0 then
raise ESMException.Create('There are unreleased engines');
FEnginePool.Free;
for I := 0 to FDllModules.Count - 1 do begin
dllModule := PDllModuleRec(FDllModules.Objects[i]);
Dispose(dllModule);
end;
FDllModules.Free;
inherited;
{$ifdef ISDELPHIXE2}
FRttiCx.Free;
{$endif}
end;
procedure TSMEngineManager.DoOnNewEngine(const Engine: TSMEngine);
begin
if Assigned(FOnNewEngine) then begin
Engine.cx.BeginRequest();
try
FOnNewEngine(Engine);
finally
Engine.cx.EndRequest;
end;
end;
end;
function TSMEngineManager.EngineForThread(ThreadID: TThreadID): TSMEngine;
var
i: integer;
begin
FEnginePool.Safe.Lock;
try
i := ThreadEngineIndex(ThreadID);
if i < 0 then
result := nil else
result := FEnginePool.List[i];
finally
FEnginePool.Safe.UnLock;
end;
end;
function TSMEngineManager.evalDllModule(cx: PJSContext; module: PJSRootedObject;
const filename: RawUTF8): TDllModuleUnInitProc;
var
dirname: TFileName;
exports_V: jsval;
exports_: PJSRootedObject;
require_V: jsval;
require: PJSRootedObject;
__filename: PWideChar;
__dirname: PWideChar;
fHandle: HMODULE;
ModuleRec: PDllModuleRec;
const
EXPORTS_NAME: AnsiString = 'exports';
REQUIRE_NAME: AnsiString = 'require';
INIT_PROC_NAME = 'InitPlugin';
UNINIT_PROC_NAME = 'UnInitPlugin';
begin
Lock;
try
cx.BeginRequest;
try
dirname := ExtractFilePath(UTF8ToString(filename)) ;
ModuleRec := PDllModuleRec(FDllModules.GetObjectFrom(filename));
if ModuleRec = nil then begin
fHandle := {$IFDEF FPC}dynlibs.{$ENDIF}SafeLoadLibrary(UTF8ToString(filename));
if fHandle=0 then
raise ESMException.CreateFmt('Unable to load %s (%s)',
[filename, {$ifdef FPC}GetLoadErrorStr{$else}SysErrorMessage(GetLastError){$endif}]);
new(ModuleRec);
ModuleRec.init := GetProcAddress(fHandle, INIT_PROC_NAME);
if not Assigned(ModuleRec.init) then begin
FreeLibrary(fHandle);
Dispose(ModuleRec);
raise ESMException.CreateFmt('Invalid %s: missing %s',[filename, INIT_PROC_NAME]);
end;
if Assigned(OnDllModuleLoaded) then
OnDllModuleLoaded(fHandle);
ModuleRec.unInit := GetProcAddress(fHandle, UNINIT_PROC_NAME);
FDllModules.AddObject(filename, TObject(ModuleRec));
end;
__filename := Pointer(filename);
__dirname := Pointer(dirname);
if module.ptr.GetProperty(cx, pointer(EXPORTS_NAME), exports_V) then
exports_ := cx.NewRootedObject(exports_V.asObject)
else
exports_ := cx.NewRootedObject(nil);
try
if module.ptr.GetProperty(cx, pointer(REQUIRE_NAME), require_V) then
require := cx.NewRootedObject(require_V.asObject)
else
require := cx.NewRootedObject(nil);
try
if not ModuleRec.init(cx, exports_, require, module, __filename, __dirname) then begin
try
RaiseLastOSError;
except
on E: Exception do begin
E.Message := format('require %s failed:',[ ExtractFileName(UTF8ToString(filename))])+E.Message;
raise;
end;
end;
end;
finally
cx.FreeRootedObject(require);
end;
finally
cx.FreeRootedObject(exports_);
end;
//TODO: Store all evaled libs and call UnInit on destroy engine
finally
cx.EndRequest;
end;
finally
UnLock;
end;
Result := ModuleRec.unInit;
end;
function TSMEngineManager.getPauseDebuggerOnFirstStep: boolean;
begin
if FRemoteDebuggerThread<> nil then begin
result := TSMRemoteDebuggerThread(FRemoteDebuggerThread).NeedPauseOnFirstStep;
end else
result := false;
end;
function TSMEngineManager.ThreadSafeEngine(pThreadData: pointer): TSMEngine;
var i: integer;
ThreadID: TThreadID;
begin
FEnginePool.Safe.Lock;
try
ThreadID := GetCurrentThreadId;
i := ThreadEngineIndex(ThreadID); // inlined CurrentThreadEngine
if i<0 then
result := nil else begin
result := FEnginePool.List[i];
if (pThreadData) <> nil then
result.SetThreadData(pThreadData);
end;
if result<>nil then begin
// memorize a thread data for possible engine recreation
if pThreadData = nil then
pThreadData := result.ThreadData;
if result.EngineContentVersion=Self.ContentVersion then begin
if Result.NeverExpire or (FEngineExpireTimeOutTicks = 0) or (GetTickCount64 - Result.fCreatedAtTick < FEngineExpireTimeOutTicks ) then
// return existing Engine corresponding to the current thread
exit else begin
// content expired -> force recreate thread Engine
{$ifdef SM_DEBUG}
SynSMLog.Add.Log(sllDebug,
'Drop SpiderMonkey Engine for thread % - timeout expired', ThreadID);
{$endif}
ReleaseEngineForThread(ThreadID);
end;
end 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}
ReleaseEngineForThread(ThreadID);
end;
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 := FEngineClass.Create(Self);
if grandParent = nil then
grandParent := Result;
if (pThreadData <> nil) then
Result.SetThreadData(pThreadData);
if WorkersManager.curThreadIsWorker then
Result.fnameForDebug := WorkersManager.getCurrentWorkerThreadName
else if Assigned(OnGetName) then
Result.fnameForDebug := OnGetName(Result);
if Assigned(OnGetWebAppRootPath) then
Result.fWebAppRootDir := OnGetWebAppRootPath(Result)
else
Result.fWebAppRootDir := StringToUTF8(ExeVersion.ProgramFilePath);
result.fThreadID := ThreadID;
FEnginePool.Add(result);
finally
FEnginePool.Safe.UnLock;
end;
if FRemoteDebuggerThread <> nil then
TSMRemoteDebuggerThread(FRemoteDebuggerThread).startDebugCurrentThread(result);
if WorkersManager.curThreadIsWorker then
Result.doInteruptInOwnThread := WorkersManager.DoInteruptInOwnThreadhandlerForCurThread;
DoOnNewEngine(Result);
end;
procedure TSMEngineManager.Lock;
begin
FEnginePool.Safe.Lock;
end;
procedure TSMEngineManager.UnLock;
begin
FEnginePool.Safe.UnLock;
end;
procedure TSMEngineManager.ReleaseEngineForThread(aThreadID: TThreadID);
var
i: integer;
begin
FEnginePool.Safe.Lock;
try
i := ThreadEngineIndex(aThreadID);
if i>=0 then begin
(TObject(FEnginePool[i]) as TSMEngine).GarbageCollect;
FEnginePool.Delete(i);
end;
finally
FEnginePool.Safe.UnLock;
end;
end;
procedure TSMEngineManager.ReleaseCurrentThreadEngine;
begin
ReleaseEngineForThread(GetCurrentThreadId);
end;
function TSMEngineManager.CurrentThreadEngine: TSMEngine;
var
i: integer;
begin
FEnginePool.Safe.Lock;
try
i := ThreadEngineIndex(GetCurrentThreadId);
if i < 0 then
result := nil else
result := FEnginePool.List[i];
finally
FEnginePool.Safe.UnLock;
end;
end;
procedure TSMEngineManager.debuggerLog(const Text: RawUTF8);
begin
if FRemoteDebuggerThread<> nil then begin
TSMRemoteDebuggerThread(FRemoteDebuggerThread).doLog(Text);
end;
end;
procedure TSMEngineManager.setPauseDebuggerOnFirstStep(const Value: boolean);
begin
if FRemoteDebuggerThread<> nil then begin
TSMRemoteDebuggerThread(FRemoteDebuggerThread).NeedPauseOnFirstStep := Value;
end
end;
procedure TSMEngineManager.startDebugger(const port: SockString = '6000');
begin
FRemoteDebuggerThread := TSMRemoteDebuggerThread.Create(self, port);
inc(FContentVersion);
end;
procedure TSMEngineManager.stopDebugger;
begin
if FRemoteDebuggerThread <> nil then begin
TSMRemoteDebuggerThread(FRemoteDebuggerThread).SetTerminated;
FRemoteDebuggerThread := nil;
end;
end;
function StringReplaceChars(const Source: String; OldChar, NewChar: Char): String;
var i,j,n: integer;
begin
if (OldChar<>NewChar) and (Source<>'') then begin
n := length(Source);
for i := 0 to n-1 do
if PChar(pointer(Source))[i]=OldChar then begin
SetString(result,PChar(pointer(Source)),n);
for j := i to n-1 do
if PChar(pointer(result))[j]=OldChar then
PChar(pointer(result))[j] := NewChar;
exit;
end;
end;
result := Source;
end;
function RelToAbs(const ABaseDir, AFileName: TFileName; ACheckResultInsideBase: boolean = false): TFileName;
var
{$IFNDEF FPC}
aBase, aTail: PChar;
localBase, localTail: TFileName;
{$ELSE}
aBase: TFileName;
{$ENDIF}
begin
{$IFNDEF FPC}
if AFileName <> '' then begin
if PathIsRelative(PChar(AFileName)) then begin
localTail := AFileName;
localBase := ABaseDir;
end else begin
localTail := '';
localBase := AFileName;
end;
end else begin
localTail := '';
localBase := ABaseDir;
end;
localBase := StringReplaceChars(localBase, '/', '\');;
localTail := StringReplaceChars(localTail, '/', '\');
aBase := PChar(LocalBase);
aTail := PChar(localTail);
SetLength(Result, MAX_PATH);
// PathCombine do not understand '/', so we raplace '/' -> '\' above
if PathCombine(@Result[1], aBase, aTail) = nil then
Result := ''
else
SetLength(Result, {$ifdef UNICODE}StrLenW{$else}StrLen{$endif}(@Result[1]));
if ACheckResultInsideBase and
((length(Result) < length(ABaseDir)) or (length(ABaseDir)=0) or
(StrLIComp(PChar(@Result[1]), @localBase[1], length(localBase)) <> 0)) then
Result := ''
{$ELSE}
{
aBase := GetForcedPathDelims(ABaseDir);
if AFileName <> '' then begin
aTail := GetForcedPathDelims(AFileName);
if FilenameIsAbsolute(aTail) then begin
localTail := '';
localBase := aBase;
end else begin
localTail := aTail;
localBase := aBase;
end;
end else begin
localTail := '';
localBase := aBase;
end;
Result := CreateAbsolutePath(localTail, localBase);
}
aBase := ExpandFileName(ABaseDir);
Result := ExpandFileNameUTF8(AFileName, aBase);
if ACheckResultInsideBase and
((Length(Result) < Length(aBase)) or (Length(aBase)=0) or
(StrCompL(PUtf8Char(Result), PUtf8Char(aBase), length(aBase), 0) <> 0)) then
//{ not Result.StartsWith(aBase, false))} not compiled in fpc 3.1.1
Result := ''
{$ENDIF}
end;
function TSMEngine.DoProcessOperationCallback: Boolean;
begin
Result := not fTimedOut;
end;
// Remove #13 characters from script(change it to #32)
// Spidermonkey debugger crashes when `...`(new ES6 strings) contains #13#10
procedure remChar13FromScript(const Script: SynUnicode); {$IFDEF HASINLINE}inline;{$ENDIF}
var
c: PWideChar;
i: Integer;
begin
c := pointer(script);
for I := 1 to Length(script) do begin
if (c^ = #13) then
c^ := ' ';
Inc(c);
end;
end;
// get a pointer to a file embadded as a UNICODE resource and it length in chars
function getResCharsAndLength(const ResName: string; out pRes: pointer;
out resLength: LongWord): boolean;
var HResInfo: THandle;
HGlobal: THandle;
Instance: THandle;
begin
Instance := HInstance;
HResInfo := FindResource(Instance,PChar(ResName),PChar(10)); //RC_DATA
if HResInfo=0 then
exit(false);
HGlobal := LoadResource(Instance,HResInfo);
if HGlobal=0 then
exit(false);
pRes := LockResource(HGlobal);
resLength := SizeofResource(Instance,HResInfo) div 2;
Result := resLength > 0;
end;
procedure TSMEngine.EvaluateRes(const ResName: string; out result: jsval);
var r: Boolean;
opts: PJSCompileOptions;
isFirst: Boolean;
pScript: pointer;
scriptLength: LongWord;
rval: jsval;
begin
with TSynFPUException.ForLibraryCode do begin
ClearLastError;
ScheduleWatchdog(fTimeoutValue);
isFirst := not cx.IsRunning;
opts := cx.NewCompileOptions;
opts.filename := Pointer(ResName);
if not getResCharsAndLength(ResName, pScript, scriptLength) then
raise ESMException.CreateUTF8('Resource "%" not found', [ResName]);
r := cx.EvaluateUCScript(opts, pScript, scriptLength, result);
cx.FreeCompileOptions(opts);
if r and isFirst and GlobalObject.ptr.HasProperty(cx, '_timerLoop') then
r := GlobalObject.ptr.CallFunctionName(cx, '_timerLoop', 0, nil, rval);
if not r then
r := false;
ScheduleWatchdog(-1);
CheckJSError(r);
end;
end;
procedure TSMEngine.Evaluate(const script: SynUnicode;
const scriptName: RawUTF8; lineNo: Cardinal; out result: jsval);
var r: Boolean;
opts: PJSCompileOptions;
isFirst: Boolean;
rval: jsval;
begin
with TSynFPUException.ForLibraryCode do begin
ClearLastError;
ScheduleWatchdog(fTimeoutValue);
isFirst := not cx.IsRunning;
opts := cx.NewCompileOptions;
opts.filename := Pointer(scriptName);
remChar13FromScript(script);
r := cx.EvaluateUCScript(
opts, pointer(script), length(script), result);
cx.FreeCompileOptions(opts);
if r and isFirst and GlobalObject.ptr.HasProperty(cx, '_timerLoop') then
r := GlobalObject.ptr.CallFunctionName(cx, '_timerLoop', 0, nil, rval);
if not r then
r := false;
ScheduleWatchdog(-1);
CheckJSError(r);
end;
end;
procedure TSMEngine.Evaluate(const script: SynUnicode; const scriptName: RawUTF8; lineNo: Cardinal);
var
jsvalue: jsval;
begin
Evaluate(script, scriptName, lineNo, jsvalue);
end;
function TSMEngine.EvaluateModule(const scriptName: RawUTF8): jsval;
var
global: PJSRootedObject;
reflect: jsval;
moduleLoader: PJSRootedObject;
begin
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
reflect := global.ptr.GetPropValue(cx, 'Reflect');
moduleLoader := cx.NewRootedObject(reflect.asObject.GetPropValue(cx, 'Loader').asObject);
try
result := CallObjectFunction(moduleLoader, 'import', [cx.NewJSString(scriptName).ToJSVal])
finally
cx.FreeRootedObject(moduleLoader);
cx.FreeRootedObject(global);
end;
end;
function TSMEngine.CallObjectFunctionVal(obj: PJSRootedObject; const funcVal: PJSRootedValue; const args: array of jsval): jsval;
var r: Boolean;
isFirst: Boolean;
rval: jsval;
global: PJSRootedObject;
begin
with TSynFPUException.ForLibraryCode do begin
ClearLastError;
ScheduleWatchdog(fTimeoutValue);
isFirst := not cx.IsRunning;
r := obj.ptr.CallFunctionValue(cx, funcVal.ptr, high(args) + 1, @args[0], Result);
if r and isFirst then begin
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
try
if FGlobalTimerLoopFunc <> nil then
r := global.ptr.CallFunctionValue(cx, FGlobalTimerLoopFunc.ptr, 0, nil, rval);
finally
cx.FreeRootedObject(global);
end;
end;
ScheduleWatchdog(-1);
CheckJSError(r);
end;
end;
function TSMEngine.CallObjectFunction(obj: PJSRootedObject; funcName: PCChar;
const args: array of jsval): jsval;
var r: Boolean;
isFirst: Boolean;
rval: jsval;
global: PJSRootedObject;
begin
with TSynFPUException.ForLibraryCode do begin
ClearLastError;
ScheduleWatchdog(fTimeoutValue);
isFirst := not cx.IsRunning;
r := obj.ptr.CallFunctionName(cx, funcName, high(args) + 1, @args[0], Result);
if r and isFirst then begin
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
try
if FGlobalTimerLoopFunc <> nil then
r := global.ptr.CallFunctionValue(cx, FGlobalTimerLoopFunc.ptr, 0, nil, rval);
finally
cx.FreeRootedObject(global);
end;
end;
ScheduleWatchdog(-1);
CheckJSError(r);
end;
end;
procedure TSMEngine.CancelExecution(AWithException: boolean = true);
begin
fTimedOut := True;
FTimeOutAborted := True;
if AWithException then begin
FErrorExist := True;
FLastErrorFileName := '<>';
FLastErrorLine := 0;
FLastErrorNum := 0;
FLastErrorMsg := LONG_SCRIPT_EXECUTION;
end;
{$IFDEF SM52}
cx.RequestInterruptCallback;
{$ELSE}
rt.RequestInterruptCallback;
{$ENDIF}
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;
{$IFDEF SM52}
cx: PJSContext;
{$ELSE}
rt: PJSRuntime;
{$ENDIF}
now_: int64;
sleepDuration: PRIntervalTime;
status: PRStatus;
begin
PR_SetCurrentThreadName('JS Watchdog');
eng := TSMEngine(arg);
{$IFDEF SM52}
cx := eng.cx;
{$ELSE}
rt := eng.rt;
{$ENDIF}
PR_Lock(eng.fWatchdogLock);
while Assigned(eng.fWatchdogThread) do begin
{$IFDEF SM52}
now_ := cx.NowMs;
{$ELSE}
now_ := rt.NowMs;
{$ENDIF}
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.
{$IFDEF SM52}
cx.RequestInterruptCallback;
{$ELSE}
rt.RequestInterruptCallback;
{$ENDIF}
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: integer): 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(t * PRMJ_USEC_PER_SEC);
{$IFDEF SM52}
timeout := cx.NowMs + interval;
{$ELSE}
timeout := rt.NowMs + interval;
{$ENDIF}
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
PR_NotifyCondVar(fWatchdogWakeup);
fWatchdogHasTimeout := true;
fWatchdogTimeout := timeout;
PR_Unlock(fWatchdogLock);
Result := true;
end;
procedure TSMEngine.SetPrivateDataForDebugger(const Value: Pointer);
begin
FPrivateDataForDebugger := Value;
end;
function TSMEngine.defineClass(AForClass: TClass; AProto: TSMCustomProtoObjectClass; aParent: PJSRootedObject=nil): TSMCustomProtoObject;
begin
if aParent = nil then
aParent := GlobalObject;
result := SyNodeProto.defineClass(cx, AForClass, AProto, aParent);
end;
procedure TSMEngine.defineClasses(const AClasses: array of TClass; AProto: TSMCustomProtoObjectClass; aParent: PJSRootedObject=nil);
var i: Integer;
begin
for i := 0 to high(AClasses) do
defineClass(AClasses[i], AProto);
end;
procedure TSMEngine.SetThreadData(pThreadData: pointer);
begin
FThreadData := pThreadData;
end;
procedure TSMEngine.SetTimeoutValue(const Value: Integer);
begin
if fTimeoutValue = Value then
exit;
fTimeoutValue := Value;
ScheduleWatchdog(fTimeoutValue);
end;
// Bindings
// synode
function synode_parseModule(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
var
in_argv: PjsvalVector;
Script: SynUnicode;
FileName: RawUTF8;
global: PJSRootedObject;
options: PJSCompileOptions;
res: PJSRootedObject;
const
USAGE = 'usage parseModule(source, [path]: String): ModuleObject';
begin
try
in_argv := vp.argv;
if (argc=0) or not in_argv[0].IsString or ((argc > 1) and not in_argv[1].IsString) then
raise ESMException.Create(USAGE);
Script := in_argv[0].asJSString.ToSynUnicode(cx);
FileName := '';
if argc > 1 then
FileName := in_argv[1].asJSString.ToUTF8(cx);
if FileName = '' then
FileName := 'no file';
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
try
options := cx.NewCompileOptions;
options.filename := Pointer(FileName);
res := cx.NewRootedObject(cx.CompileModule(global.ptr, options, Pointer(Script), Length(Script)));
result := res <> nil;
if result then
vp.rval := res.ptr.ToJSValue;
cx.FreeRootedObject(res);
cx.FreeCompileOptions(options);
finally
cx.FreeRootedObject(global);
end;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
{$IFDEF CORE_MODULES_IN_RES}
/// Parse and evaluate module stored in resources
function synode_parseModuleRes(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
var
in_argv: PjsvalVector;
ResName: string;
FileName: RawUTF8;
global: PJSRootedObject;
options: PJSCompileOptions;
res: PJSRootedObject;
pScript: pointer;
scriptLength: LongWord;
const
USAGE = 'usage parseModuleRes(resourceName, [path]: String): ModuleObject';
begin
try
in_argv := vp.argv;
if (argc=0) or not in_argv[0].IsString or ((argc > 1) and not in_argv[1].IsString) then
raise ESMException.Create(USAGE);
ResName := in_argv[0].asJSString.ToString(cx);
if not getResCharsAndLength(ResName, pScript, scriptLength) then
raise ESMException.CreateUTF8('Resource "%" not found', [ResName]);
FileName := '';
if argc > 1 then
FileName := in_argv[1].asJSString.ToUTF8(cx);
if FileName = '' then
FileName := ResName;
global := cx.NewRootedObject(cx.CurrentGlobalOrNull);
try
options := cx.NewCompileOptions;
options.filename := Pointer(FileName);
res := cx.NewRootedObject(cx.CompileModule(global.ptr, options, pScript, scriptLength));
result := res <> nil;
if result then
vp.rval := res.ptr.ToJSValue;
cx.FreeRootedObject(res);
cx.FreeCompileOptions(options);
finally
cx.FreeRootedObject(global);
end;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
{$endif}
function synode_setModuleResolveHook(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
var
in_argv: PjsvalVector;
ro: PJSRootedObject;
begin
try
in_argv := vp.argv;
result := (argc > 0) and (in_argv[0].isObject);
if Result then begin
ro := cx.NewRootedObject(in_argv[0].asObject);
try
Result := ro.ptr.isFunction(cx);
if Result then
cx.SetModuleResolveHook(ro.ptr);
finally
cx.FreeRootedObject(ro);
end;
end;
except
on E: Exception do begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
function synode_runInThisContext(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
const
USAGE = 'usage: runInThisContext(script, [fileName]: string)';
var
in_argv: PjsvalVector;
res: jsval;
Script: SynUnicode;
FileName: RawUTF8;
opts: PJSCompileOptions;
begin
try
in_argv := vp.argv;
if (argc < 1) or not in_argv[0].isString or ((argc >1) and not in_argv[1].isString) then
raise ESMException.Create(USAGE);
Script := in_argv[0].asJSString.ToSynUnicode(cx);
FileName := '';
if argc > 1 then
FileName := in_argv[1].asJSString.ToUTF8(cx);
if FileName = '' then
FileName := 'no file';
cx.BeginRequest;
try
opts := cx.NewCompileOptions;
opts.filename := Pointer(FileName);
remChar13FromScript(Script);
Result := cx.EvaluateUCScript(opts, Pointer(Script), Length(Script), res);
cx.FreeCompileOptions(opts);
if Result then
vp.rval := res;
finally
cx.EndRequest;
end;
vp.rval := res;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
{$IFDEF CORE_MODULES_IN_RES}
/// Compile and execute a script from named resource
function synode_runInThisContextRes(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
const
USAGE = 'usage: runResInThisContextRes(resourceName, [fileName]: string)';
var
in_argv: PjsvalVector;
res: jsval;
ResName: string;
pScript: pointer;
scriptLength: LongWord;
FileName: RawUTF8;
opts: PJSCompileOptions;
begin
try
in_argv := vp.argv;
if (argc < 1) or not in_argv[0].isString or ((argc >1) and not in_argv[1].isString) then
raise ESMException.Create(USAGE);
ResName := in_argv[0].asJSString.ToString(cx);
if not getResCharsAndLength(ResName, pScript, scriptLength) then
raise ESMException.CreateUTF8('Resource "%" not found', [ResName]);
FileName := '';
if argc > 1 then
FileName := in_argv[1].asJSString.ToUTF8(cx);
if FileName = '' then
FileName := ResName;
cx.BeginRequest;
try
opts := cx.NewCompileOptions;
opts.filename := Pointer(FileName);
Result := cx.EvaluateUCScript(opts, pScript, scriptLength, res);
cx.FreeCompileOptions(opts);
if Result then
vp.rval := res;
finally
cx.EndRequest;
end;
vp.rval := res;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
{$ENDIF}
function synode_loadDll(cx: PJSContext; argc: uintN; var vp: jsargRec): Boolean; cdecl;
const
USAGE = 'usage: loadDll(module:Object , filename: String)';
var
Eng: TSMEngine;
in_argv: PjsvalVector;
res: jsval;
filename: RawUTF8;
module: PJSRootedObject;
uninitProc: TDllModuleUnInitProc;
begin
Eng := TObject(cx.PrivateData) as TSMEngine;
try
in_argv := vp.argv;
if (argc < 2) or not (in_argv[0].isObject) or not (in_argv[1].isString) then
raise ESMException.Create(USAGE);
filename := in_argv[1].asJSString.ToUTF8(cx);
module := cx.NewRootedObject(in_argv[0].asObject);
try
uninitProc := Eng.FManager.evalDllModule(cx, module, filename);
if Assigned(uninitProc) then
Eng.FDllModulesUnInitProcList.Add(@uninitProc);
finally
cx.FreeRootedObject(module);
end;
res := JSVAL_NULL;
vp.rval := res;
Result := True;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
function SyNodeBinding_modules(const Engine: TSMEngine; const bindingNamespaceName: SynUnicode): jsval;
var
obj: PJSRootedObject;
cx: PJSContext;
{$IFDEF CORE_MODULES_IN_RES}
val: jsval;
{$endif}
begin
cx := Engine.cx;
obj := cx.NewRootedObject(cx.NewObject(nil));
try
obj.ptr.DefineFunction(cx, 'parseModule', synode_parseModule, 2, JSPROP_READONLY or JSPROP_PERMANENT);
obj.ptr.DefineFunction(cx, 'setModuleResolveHook', synode_setModuleResolveHook, 1, JSPROP_READONLY or JSPROP_PERMANENT);
obj.ptr.DefineFunction(cx, 'runInThisContext', synode_runInThisContext, 2, JSPROP_READONLY or JSPROP_PERMANENT);
obj.ptr.DefineFunction(cx, 'loadDll', synode_loadDll, 2, JSPROP_READONLY or JSPROP_PERMANENT);
{$IFDEF CORE_MODULES_IN_RES}
val.asBoolean := true;
obj.ptr.DefineProperty(cx, '_coreModulesInRes', val, JSPROP_READONLY or JSPROP_PERMANENT);
obj.ptr.DefineFunction(cx, 'parseModuleRes', synode_parseModuleRes, 2, JSPROP_READONLY or JSPROP_PERMANENT);
obj.ptr.DefineFunction(cx, 'runInThisContextRes', synode_runInThisContextRes, 2, JSPROP_READONLY or JSPROP_PERMANENT);
{$ENDIF}
obj.ptr.DefineProperty(cx, 'coreModulesPath', cx.NewJSString(Engine.Manager.CoreModulesPath).ToJSVal, JSPROP_READONLY or JSPROP_PERMANENT);
Result := obj.ptr.ToJSValue;
finally
cx.FreeRootedObject(obj);
end;
end;
/// sleep X ms
function synode_sleep(cx: PJSContext; argc: uintN; var vp: JSArgRec): Boolean; cdecl;
var
in_argv: PjsvalVector;
interval: int64;
engine: TSMEngine;
const
USAGE = 'usage: sleep(module: Number)';
begin
try
in_argv := vp.argv;
if (argc < 1) or not in_argv[0].isNumber then
raise ESMException.Create(USAGE);
engine := TSMEngine(cx.PrivateData);
if in_argv[0].isInteger then
interval := in_argv[0].asInteger
else
interval := Trunc(in_argv[0].asDouble);
while not engine.TimeOutAborted and (interval > 0) do
begin
Sleep(100);
interval := interval - 100;
end;
Result := True;
except
on E: Exception do
begin
Result := False;
vp.rval := JSVAL_VOID;
JSError(cx, E);
end;
end;
end;
function SyNodeBinding_syNode(const Engine: TSMEngine; const bindingNamespaceName: SynUnicode): jsval;
var
obj: PJSRootedObject;
cx: PJSContext;
begin
cx := Engine.cx;
obj := cx.NewRootedObject(cx.NewObject(nil));
try
obj.ptr.DefineFunction(cx, 'sleep', synode_sleep, 1, JSPROP_READONLY or JSPROP_PERMANENT);
Result := obj.ptr.ToJSValue;
finally
cx.FreeRootedObject(obj);
end;
end;
initialization
TSMEngineManager.RegisterBinding('modules', SyNodeBinding_modules);
TSMEngineManager.RegisterBinding('syNode', SyNodeBinding_syNode);
finalization
FreeAndNil(GlobalSyNodeBindingHandlers);
end.