diff --git a/demo/wasienv/dom/WasiDomTest1.lpr b/demo/wasienv/dom/WasiDomTest1.lpr index 0fef242..aed243f 100644 --- a/demo/wasienv/dom/WasiDomTest1.lpr +++ b/demo/wasienv/dom/WasiDomTest1.lpr @@ -16,12 +16,14 @@ uses type EWasiTest = class(Exception); + IJSBird = interface; TJSBird = class; TBirdCallBoolean = function(const v: Boolean): Boolean of object; TBirdCallInteger = function(const v: integer): integer of object; TBirdCallDouble = function(const v: double): double of object; TBirdCallUnicodeString = function(const v: UnicodeString): UnicodeString of object; + TBirdCallBird = function(const v: IJSBird): IJSBird of object; TBirdCallVariant = function(const v: variant): variant of object; { IJSBird } @@ -42,6 +44,7 @@ type function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer; function EchoDouble(const v: Double; const Call: TBirdCallDouble): Double; function EchoUnicodeString(const v: UnicodeString; const Call: TBirdCallUnicodeString): UnicodeString; + function EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird; function EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant; // properties function GetCaption: UnicodeString; @@ -84,6 +87,7 @@ type function EchoInteger(const v: integer; const Call: TBirdCallInteger): integer; function EchoDouble(const v: Double; const Call: TBirdCallDouble): Double; function EchoUnicodeString(const v: UnicodeString; const Call: TBirdCallUnicodeString): UnicodeString; + function EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird; function EchoVariant(const v: Variant; const Call: TBirdCallVariant): Variant; // properties function GetCaption: UnicodeString; @@ -115,6 +119,7 @@ type function OnBirdCallInteger(const v: integer): integer; function OnBirdCallDouble(const v: double): double; function OnBirdCallUnicodeString(const v: UnicodeString): UnicodeString; + function OnBirdCallBird(const v: IJSBird): IJSBird; function OnBirdCallVariant(const v: Variant): Variant; public Prefix: string; @@ -157,6 +162,7 @@ type procedure TestFuncArgMethod_Integer; procedure TestFuncArgMethod_Double; procedure TestFuncArgMethod_UnicodeString; + procedure TestFuncArgMethod_Object; procedure TestFuncArgMethod_Variant; // dictionaries @@ -199,6 +205,17 @@ begin Result:=H.AllocString(TBirdCallUnicodeString(aMethod)(v)); end; +function JOBCallTBirdCallBird(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte; +var + v: IJSBird; +begin + //writeln('JOBCallTBirdCallBird START'); + v:=H.GetObject(TJSBird) as IJSBird; + //writeln('JOBCallTBirdCallBird ',v<>nil); + Result:=H.AllocIntf(TBirdCallBird(aMethod)(v)); + //writeln('JOBCallTBirdCallBird ',ptruint(Result)); +end; + function JOBCallTBirdCallVariant(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte; var v: Variant; @@ -242,6 +259,11 @@ begin Result:=v; end; +function TWasmApp.OnBirdCallBird(const v: IJSBird): IJSBird; +begin + Result:=v; +end; + function TWasmApp.OnBirdCallVariant(const v: Variant): Variant; begin Result:=v; @@ -274,6 +296,7 @@ begin TestFuncArgMethod_Integer; TestFuncArgMethod_Double; TestFuncArgMethod_UnicodeString; + TestFuncArgMethod_Object; TestFuncArgMethod_Variant; end; @@ -742,19 +765,15 @@ begin Prefix:='TWasmApp.TestFuncArgMethod_UnicodeString'; Bird.Name:='TestFuncArgMethod_UnicodeString'; - writeln('AAA1 TWasmApp.TestFuncArgMethod_UnicodeString '); v:=Bird.EchoUnicodeString('',@OnBirdCallUnicodeString); AssertEqualUS('Bird.EchoUnicodeString('''',...)','',v); - writeln('AAA2 TWasmApp.TestFuncArgMethod_UnicodeString '); v:=Bird.EchoUnicodeString('c',@OnBirdCallUnicodeString); AssertEqualUS('Bird.EchoUnicodeString(''c'',...)','c',v); - writeln('AAA3 TWasmApp.TestFuncArgMethod_UnicodeString '); v:=Bird.EchoUnicodeString('abc',@OnBirdCallUnicodeString); AssertEqualUS('Bird.EchoUnicodeString(''abc'',...)','abc',v); - writeln('AAA4 TWasmApp.TestFuncArgMethod_UnicodeString '); v:=Bird.EchoUnicodeString(#10,@OnBirdCallUnicodeString); AssertEqualUS('Bird.EchoUnicodeString(#10,...)',#10,v); @@ -765,6 +784,24 @@ begin AssertEqualUS('Bird.EchoUnicodeString(''😄'',...)','😄',v); end; +procedure TWasmApp.TestFuncArgMethod_Object; +var + v, Lisa: IJSBird; +begin + Prefix:='TWasmApp.TestFuncArgMethod_Object'; + Bird.Name:='TestFuncArgMethod_Object'; + + v:=Bird.EchoBird(nil,@OnBirdCallBird); + AssertEqual('Bird.EchoBird(nil,...)',nil,v); + + v:=Bird.EchoBird(Bird,@OnBirdCallBird); + AssertEqual('Bird.EchoBird(Bird,...)',Bird,v); + + Lisa:=Bird.CreateBird('Lisa'); + v:=Bird.EchoBird(Lisa,@OnBirdCallBird); + AssertEqual('Bird.EchoBird(Lisa,...)',Lisa,v); +end; + procedure TWasmApp.TestFuncArgMethod_Variant; var v: Variant; @@ -772,6 +809,15 @@ begin Prefix:='TWasmApp.TestFuncArgMethod_Variant;'; Bird.Name:='TestFuncArgMethod_Variant;'; + v:=Bird.EchoVariant(true,@OnBirdCallVariant); + AssertEqual('Bird.EchoVariant(true,...)',true,v); + + v:=Bird.EchoVariant(false,@OnBirdCallVariant); + AssertEqual('Bird.EchoVariant(false,...)',false,v); + +// v:=Bird.EchoVariant(Variants.Null,@OnBirdCallVariant); +// AssertEqual('Bird.EchoVariant(Variants.Null,...)',Variants.Null,v); + v:=Bird.EchoVariant(0.5,@OnBirdCallVariant); AssertEqual('Bird.EchoVariant(0.5,...)',0.5,v); end; @@ -944,6 +990,18 @@ begin end; end; +function TJSBird.EchoBird(const v: IJSBird; const Call: TBirdCallBird): IJSBird; +var + m: TJOB_Method; +begin + m:=TJOB_Method.Create(TMethod(Call),@JOBCallTBirdCallBird); + try + Result:=InvokeJSObjectResult('EchoCall',[v,m],TJSBird) as IJSBird; + finally + m.Free; + end; +end; + function TJSBird.EchoVariant(const v: Variant; const Call: TBirdCallVariant ): Variant; var diff --git a/demo/wasienv/dom/job_js.pas b/demo/wasienv/dom/job_js.pas index a12182b..3f5079a 100644 --- a/demo/wasienv/dom/job_js.pas +++ b/demo/wasienv/dom/job_js.pas @@ -264,6 +264,7 @@ type private FJOBObjectID: TJOBObjectID; FJOBCastSrc: IJSObject; + FJOBObjectIDOwner: boolean; protected type TJOBInvokeNoResultFunc = function( @@ -302,7 +303,8 @@ type class function Cast(Intf: IJSObject): IJSObject; overload; destructor Destroy; override; property JOBObjectID: TJOBObjectID read FJOBObjectID; - property JOBCastSrc: IJSObject read FJOBCastSrc; // nil means it is the owner, otherwise it is a typecast + property JOBObjectIDOwner: boolean read FJOBObjectIDOwner write FJOBObjectIDOwner; + property JOBCastSrc: IJSObject read FJOBCastSrc; // nil means it is the original, otherwise it is a typecast // call a function procedure InvokeJSNoResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeType = jiCall); virtual; function InvokeJSBooleanResult(const aName: string; Const Args: Array of const; Invoke: TJOBInvokeType = jiCall): Boolean; virtual; @@ -1859,6 +1861,7 @@ begin ObjId:=PLongWord(p)^; inc(p,4); Result:=aResultClass.JOBCreateFromID(ObjId); + Result.JOBObjectIDOwner:=false; // owned by caller (JS code in browser) end else raise EJSArgParse.Create(JOBArgNames[p^]); @@ -1934,12 +1937,17 @@ var Obj: TJSObject; S: UnicodeString; begin - if (Index=Count) or (p^=JOBArgUndefined) then + if Index=Count then begin Result:=Variants.Unassigned; exit; end; case p^ of + JOBArgUndefined: + begin + Result:=Variants.Unassigned; + inc(p); + end; JOBArgTrue: begin Result:=true; @@ -1981,6 +1989,7 @@ begin ObjId:=PLongWord(p)^; inc(p,4); Obj:=TJSObject.JOBCreateFromID(ObjId); + Obj.JOBObjectIDOwner:=false; Result:=Obj as IJSObject; end; else @@ -2076,6 +2085,7 @@ end; function TJOBCallbackHelper.AllocObjId(ObjId: TJOBObjectID): PByte; begin + //writeln('TJOBCallbackHelper.AllocObjId ObjID=',ObjId); GetMem(Result,1+SizeOf(TJOBObjectID)); Result^:=JOBArgObject; PJOBObjectID(Result+1)^:=ObjId; @@ -2889,6 +2899,7 @@ end; constructor TJSObject.JOBCreateFromID(aID: TJOBObjectID); begin FJOBObjectID:=aID; + FJOBObjectIDOwner:=true; end; constructor TJSObject.JOBCreateGlobal(const aID: UnicodeString); @@ -2896,6 +2907,7 @@ begin FJOBObjectID:=__job_get_global(PWideChar(aID),length(aID)); if FJOBObjectID=0 then raise EJSObject.Create('JS object "'+String(aID)+'" is not registered'); + FJOBObjectIDOwner:=true; end; class function TJSObject.Cast(Intf: IJSObject): IJSObject; @@ -2907,7 +2919,7 @@ destructor TJSObject.Destroy; begin if FJOBCastSrc<>nil then FJOBCastSrc:=nil - else if JOBObjectID>=0 then + else if (JOBObjectID>=0) and JOBObjectIDOwner then __job_release_object(JOBObjectID); FJOBObjectID:=0; inherited Destroy; diff --git a/packages/job/job_browser.pp b/packages/job/job_browser.pp index fc3394e..b78db84 100644 --- a/packages/job/job_browser.pp +++ b/packages/job/job_browser.pp @@ -31,7 +31,7 @@ Type Protected function Invoke_JSResult(ObjId: TJOBObjectID; NameP, NameLen, Invoke, ArgsP: NativeInt; out JSResult: JSValue): TJOBResult; virtual; function GetInvokeArguments(View: TJSDataView; ArgsP: NativeInt): TJSValueDynArray; virtual; - function CreateCallbackArgs(View: TJSDataView; const Args: TJSFunctionArguments): TWasmNativeInt; virtual; + function CreateCallbackArgs(View: TJSDataView; const Args: TJSFunctionArguments; TempObjIds: TJOBObjectIDArray): TWasmNativeInt; virtual; function EatCallbackResult(View: TJSDataView; ResultP: TWasmNativeInt): jsvalue; virtual; // exports function Get_GlobalID(NameP, NameLen: NativeInt): TJOBObjectID; virtual; @@ -487,13 +487,14 @@ var function ReadWasmNativeInt: TWasmNativeInt; begin - Result:=View.getUint32(p,env.IsLittleEndian); + Result:=View.getInt32(p,env.IsLittleEndian); inc(p,4); end; function ReadArgMethod: TProxyFunc; var aCall, aData, aCode: TWasmNativeInt; + i: Integer; begin aCall:=ReadWasmNativeInt; aData:=ReadWasmNativeInt; @@ -502,14 +503,21 @@ var Result:=function: jsvalue var Args, ResultP: TWasmNativeInt; + TempObjIds: TJOBObjectIDArray; begin //writeln('TJSObjectBridge called JS Method Call=',aCall,' Data=',aData,' Code=',aCode,' Args=',JSArguments.length); - Args:=CreateCallbackArgs(View,JSArguments); - ResultP:=CallbackHandler(aCall,aData,aCode,Args); // this frees Args, and may detach View - View:=getModuleMemoryDataView(); - //writeln('TJSObjectBridge called Wasm Call=',aCall,' Data=',aData,' Code=',aCode,' ResultP=',ResultP); - Result:=EatCallbackResult(View,ResultP); // this frees ResultP - //writeln('TJSObjectBridge Result=',Result); + Args:=CreateCallbackArgs(View,JSArguments,TempObjIds); + try + ResultP:=CallbackHandler(aCall,aData,aCode,Args); // this frees Args, and may detach View + View:=getModuleMemoryDataView(); + //writeln('TJSObjectBridge called Wasm Call=',aCall,' Data=',aData,' Code=',aCode,' ResultP=',ResultP); + Result:=EatCallbackResult(View,ResultP); // this frees ResultP + //writeln('TJSObjectBridge Result=',Result); + finally + //writeln('After CallbackHandler: TempObjIds=',length(TempObjIds),' ',TempObjIds); + for i:=0 to length(TempObjIds)-1 do + ReleaseObject(TempObjIds[i]); + end; end; end; @@ -653,7 +661,8 @@ begin end; function TJSObjectBridge.CreateCallbackArgs(View: TJSDataView; - const Args: TJSFunctionArguments): TWasmNativeInt; + const Args: TJSFunctionArguments; TempObjIds: TJOBObjectIDArray + ): TWasmNativeInt; var i, Len, j: Integer; Arg: JSValue; @@ -694,7 +703,7 @@ begin begin Arg:=Args[i]; r:=GetJOBResult(Arg); - //writeln('TJSObjectBridge.CreateCallbackArgs ',i,'/',Args.Length,' r=',r); + writeln('TJSObjectBridge.CreateCallbackArgs ',i,'/',Args.Length,' r=',r); case r of JOBResult_Null: begin @@ -735,7 +744,9 @@ begin View.setUint8(p,JOBArgObject); inc(p); NewId:=RegisterLocalObject(TJSObject(Arg)); - View.setUint32(p, longword(NewId), env.IsLittleEndian); + TJSArray(TempObjIds).push(NewId); + writeln('TJSObjectBridge.CreateCallbackArgs Object ID=',NewID); + View.setInt32(p, NewId, env.IsLittleEndian); inc(p,4); end; else @@ -788,6 +799,7 @@ begin begin ObjId:=View.getInt32(p,env.IsLittleEndian); Result:=FindObject(ObjId); + writeln('TJSObjectBridge.EatCallbackResult ObjID=',ObjId,' Result=',Result<>nil); end; else Result:=Undefined; diff --git a/packages/job/job_shared.pp b/packages/job/job_shared.pp index 90d730e..b61d964 100644 --- a/packages/job/job_shared.pp +++ b/packages/job/job_shared.pp @@ -9,6 +9,7 @@ interface type TJOBObjectID = NativeInt; + TJOBObjectIDArray = array of TJOBObjectID; // invoke results type