* Promise implementation and demo

packages/wasm-job/examples/promisedemo.lpi

@@ -0,0 +1,70 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="promisedemo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <Units>
+      <Unit>
+        <Filename Value="promisedemo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="promisedemo.wasm" ApplyConventions="False"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <TargetCPU Value="wasm32"/>
+      <TargetOS Value="wasi"/>
+      <Subtarget Value="browser"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+      </Debugging>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/wasm-job/examples/promisedemo.lpr

@@ -0,0 +1,60 @@
+library promisedemo;
+{$mode objfpc}
+{$h+}
+uses nothreads, sysutils, job.js, variants;
+
+
+Type
+  TApp = Class(TObject)
+    function DoResolve(const aValue: Variant): Variant;
+    procedure DoPromiseExecutor(const OnResolve, OnReject:TJSPromiseResolver);
+    function ResolveTest: TJSPromise;
+    procedure Run;
+  end;
+
+function TApp.DoResolve(const aValue: Variant): Variant;
+begin
+  Writeln('Wasm: in DoResolve: success. Argument vartype: ', vartype(aValue));
+  if vartype(aValue)=varOleStr then
+    Writeln('Wasm: DoResolve received value: ', VarToStr(aValue));
+  result:=unassigned;
+end;
+
+procedure TApp.DoPromiseExecutor(const OnResolve, OnReject: TJSPromiseResolver);
+begin
+  Writeln('Wasm: in promise executor');
+  if not Assigned(OnResolve) then
+    Writeln('Wasm ERROR: no resolve callback');
+  if not Assigned(OnReject) then
+    Writeln('Wasm ERROR: no reject callback');
+ if Assigned(OnResolve) then
+    OnResolve('This is a success value');
+end;
+
+function TApp.ResolveTest: TJSPromise;
+begin
+  Result:=TJSPromise.Create(@DoPromiseExecutor);
+end;
+
+procedure TApp.Run;
+
+Var
+  P : TJSPromise;
+
+begin
+  try
+    P:=ResolveTest;
+    P._then(@DoResolve);
+  except
+    on E: Exception do
+      Writeln(e.Message);
+  end;
+end;
+
+var
+  App : TApp;
+begin
+  App:=TApp.Create;
+  App.Run;
+end.
+

packages/wasm-job/src/job.js.pas

@@ -13,7 +13,7 @@ unit job.js;
 {$H+}
 {$ModeSwitch advancedrecords}
 
-{off $define VerboseJOB}
+{ $define VerboseJOB}
 
 interface
 
@@ -81,6 +81,7 @@ type
     Kind: TJOB_JSValueKind;
     constructor Create(aKind: TJOB_JSValueKind);
     function AsString: UTF8String; virtual;
+    function AsVariant : Variant; virtual;
   end;
   TJOB_JSValueClass = class of TJOB_JSValue;
   TJOB_JSValueArray = array of TJOB_JSValue;
@@ -92,6 +93,7 @@ type
     Value: Boolean;
     constructor Create(aValue: Boolean);
     function AsString: UTF8string; override;
+    function AsVariant : Variant; override;
   end;
 
   { TJOB_Double }
@@ -101,6 +103,7 @@ type
     Value: Double;
     constructor Create(const aValue: Double);
     function AsString: UTF8String; override;
+    function AsVariant : Variant; override;
   end;
 
   { TJOB_String }
@@ -110,6 +113,7 @@ type
     Value: UnicodeString;
     constructor Create(const aValue: UnicodeString);
     function AsString: UTF8string; override;
+    function AsVariant : Variant; override;
   end;
 
 
@@ -122,8 +126,21 @@ type
     Value: IJSObject;
     constructor Create(aValue: IJSObject);
     function AsString: UTF8String; override;
+    function AsVariant : Variant; override;
   end;
 
+  { TJOB_Function }
+  IJSFunction = interface;
+
+  TJOB_Function = class(TJOB_JSValue)
+  public
+    Value: IJSFunction;
+    constructor Create(aValue: IJSFunction);
+    function AsString: UTF8String; override;
+    function AsVariant : Variant; override;
+  end;
+
+
   TJOBInvokeType = (
     jiCall,  // call function
     jiGet, // read property
@@ -135,6 +152,7 @@ type
 
   TJSObject = class;
   TJSArray = class;
+  TJSFunction = class;
   TJSObjectClass = class of TJSObject;
 
   { TJOBCallbackHelper - parse callback arguments and create result }
@@ -155,6 +173,7 @@ type
     function GetLongInt: longint;
     function GetMaxInt: int64;
     function GetArray : TJSArray;
+    function GetFunction : TJSFunction;
 
     function AllocUndefined: PByte;
     function AllocBool(b: boolean): PByte;
@@ -210,6 +229,7 @@ type
     constructor Create(const TheValues: array of const);
     destructor Destroy; override;
     procedure Clear;
+    function AsVariant : Variant; override;
   end;
 
   { TJOB_ArrayOfDouble }
@@ -218,6 +238,7 @@ type
   public
     Values: TDoubleDynArray;
     constructor Create(const TheValues: TDoubleDynArray);
+    function AsVariant : Variant; override;
   end;
 
   { TJOB_ArrayOfDouble }
@@ -230,6 +251,7 @@ type
     Len : NativeUInt;
     constructor Create(const TheValues: PByte; TheLen : NativeUInt);
     constructor Create(const TheValues: TBytes);
+    function AsVariant : Variant; override;
   end;
 
 
@@ -431,7 +453,7 @@ type
     property name: UnicodeString read _GetName write _SetName;
     property prototyp: IJSFunction read _GetPrototyp;
     property length: NativeInt read _GetLength;
-    //function apply(thisArg: TJSObject; const ArgArray: TJSValueDynArray): JSValue; varargs;
+    function apply(thisArg: TJSObject; const ArgArray: Array of const): Variant;
     //function bind(thisArg: TJSObject): JSValue; varargs;
     //function call(thisArg: TJSObject): JSValue; varargs;
   end;
@@ -439,7 +461,11 @@ type
   { TJSFunction }
 
   TJSFunction = class(TJSObject,IJSFunction)
+  private
+    FThisID: TJOBObjectID;
   public
+    Constructor Create(aObjectID : TJOBObjectID);
+    Constructor Create(aObjectID,aThisID : TJOBObjectID);
     function _GetLength: NativeInt;
     function _GetName: UnicodeString;
     function _GetPrototyp: IJSFunction;
@@ -447,7 +473,10 @@ type
     property name: UnicodeString read _GetName write _SetName;
     property prototyp: IJSFunction read _GetPrototyp;
     property length: NativeInt read _GetLength;
+    function apply(thisArg: TJSObject; const ArgArray: Array of const): Variant;
+    function apply(const ArgArray: Array of const): Variant;
     class function Cast(const Intf: IJSObject): IJSFunction; overload;
+    Property ThisID : TJOBObjectID Read FThisID Write FThisID;
   end;
 
   { IJSDate }
@@ -672,6 +701,7 @@ type
     Property Length: NativeInt Read _GetLength Write _SetLength;
     property Elements[Index: NativeInt]: TJOB_JSValue read _GetElements write _SetElements; default;
     class function Cast(const Intf: IJSObject): IJSArray; overload;
+    class function JSClassName: UnicodeString; override;
   end;
 
   { IJSArrayBuffer }
@@ -1132,7 +1162,9 @@ var
 begin
   Result:=nil;
   try
-    //writeln('JOBCallback');
+    {$IFDEF VERBOSEJOB}
+    writeln('In JOBCallback');
+    {$ENDIF}
     m.Data:=Data;
     m.Code:=Code;
     h.Init(Args);
@@ -1236,18 +1268,73 @@ begin
   TJSPromiseFinallyHandler(aMethod)();
 end;
 
+Type
+
+  { TPromiseHelper }
+
+  TPromiseHelper = Class(TObject)
+    FResolveCallback : TJSFunction;
+    FRejectCallback : TJSFunction;
+    constructor create (aResolve,aReject : TJSFunction);
+    function HandleResolve(const aValue : Variant): variant;
+    function HandleReject(const aValue : Variant): variant;
+  end;
+
 function JOBCallTJSPromiseExecutor(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;
 
 var
-  Resolve,Reject : TMethod;
+  F1,F2 : TJSFunction;
+  Helper : TPromiseHelper;
 
 begin
-//  Resolve:=TJSPromiseResolver(H.GetMethod);
-//  Reject:=TJSPromiseResolver(H.GetMethod);
-//  TJSPromiseExecutor(aMethod)(Resolve, Reject);
+  F1:=H.GetFunction;
+  F2:=H.GetFunction;
+  Helper:=TPromiseHelper.Create(F1,F2);
+  try
+     TJSPromiseExecutor(aMethod)(@Helper.HandleResolve, @Helper.HandleReject);
+     Helper.Free;
+  except
+    on E : Exception do
+      begin
+      {$IFDEF VerboseJOB}
+      Writeln('Wasm error calling promise executor : ',E.Message);
+      {$ENDIF}
+      Helper.Free;
+      Raise;
+      end;
+    on O : TObject do
+      begin
+      {$IFDEF VerboseJOB}
+      Writeln('Wasm error calling promise executor : ',O.ClassName);
+      {$ENDIF}
+      Helper.Free;
+      Raise;
+      end;
+  end;
+  {$IFDEF VerboseJOB}
+  Writeln('Wasm: Making function result');
+  {$ENDIF}
   Result:=H.AllocUndefined;
 end;
 
+{ TPromiseHelper }
+
+constructor TPromiseHelper.create(aResolve, aReject: TJSFunction);
+begin
+  FResolveCallback:=aResolve;
+  FRejectCallback:=aReject;
+end;
+
+function TPromiseHelper.HandleResolve(const aValue: Variant): variant;
+begin
+  result:=FResolveCallback.apply([aValue]);
+end;
+
+function TPromiseHelper.HandleReject(const aValue: Variant): variant;
+begin
+  Result:=FRejectCallback.apply([aValue]);
+end;
+
 
 { TJSTextEncoder }
 
@@ -1740,6 +1827,11 @@ begin
   Result:=TJSArray.Cast(Intf);
 end;
 
+class function TJSArray.JSClassName: UnicodeString;
+begin
+  Result:='Array';
+end;
+
 { TJSString }
 
 class function TJSString.Cast(const Intf: IJSObject): IJSString;
@@ -1826,6 +1918,17 @@ end;
 
 { TJSFunction }
 
+constructor TJSFunction.Create(aObjectID: TJOBObjectID);
+begin
+  Create(aObjectID,0);
+end;
+
+constructor TJSFunction.Create(aObjectID, aThisID: TJOBObjectID);
+begin
+  JOBCreateFromID(aObjectID);
+  FThisID:=aThisID;
+end;
+
 function TJSFunction._GetLength: NativeInt;
 begin
   Result:=ReadJSPropertyLongInt('length');
@@ -1846,6 +1949,59 @@ begin
   WriteJSPropertyUnicodeString('length',AValue);
 end;
 
+function TJSFunction.apply(thisArg: TJSObject; const ArgArray: array of const): Variant;
+
+Var
+  Arr : IJSArray;
+  J : TJOB_JSValue;
+
+begin
+  {$IFDEF VerboseJOB}
+  Writeln('Wasm: in TJSFunction.apply with this. Creating argument array');
+  {$ENDIF}
+  Arr:=TJSArray.Create(ArgArray);
+  {$IFDEF VerboseJOB}
+  Writeln('Wasm: invoking apply');
+  {$ENDIF}
+  J:=InvokeJSValueResult('apply',[thisArg,Arr]);
+  try
+    Result:=J.AsVariant;
+  finally
+    J.Free;
+  end;
+end;
+
+function TJSFunction.apply(const ArgArray: array of const): Variant;
+
+var
+  aThis : TJSObject;
+  iThis : IJSObject;
+
+begin
+  {$IFDEF VerboseJOB}
+  Writeln('Wasm: in TJSFunction.apply without this');
+  {$ENDIF}
+  if FThisID>0 then
+    begin
+    aThis:=TJSObject.JOBCreateFromID(FThisID);
+    iThis:=aThis
+    end
+  else
+    aThis:=Nil;
+  {$IFDEF VerboseJOB}
+  Writeln('Wasm: have this for apply: ',Assigned(aThis));
+  {$ENDIF}
+  aThis.FJOBObjectIDOwner:=False;
+  try
+    {$IFDEF VerboseJOB}
+    Writeln('Wasm: calling apply: ',Assigned(aThis));
+    {$ENDIF}
+    Result:=Apply(aThis,ArgArray);
+  finally
+    aThis.Free;
+  end;
+end;
+
 class function TJSFunction.Cast(const Intf: IJSObject): IJSFunction;
 begin
   Result:=TJSFunction.Cast(Intf);
@@ -1898,6 +2054,7 @@ begin
   JOBArgFalse,
   JOBArgNil: inc(p);
   JOBArgDouble: inc(p,9);
+  JOBArgMethod: inc(p,3*SizeOf(Pointer));
   JOBArgUnicodeString:
     begin
       inc(p);
@@ -2028,6 +2185,32 @@ begin
   inc(Index);
 end;
 
+function TJOBCallbackHelper.GetFunction: TJSFunction;
+var
+  aType : byte;
+  ObjId,ThisId: LongWord;
+
+begin
+  {$IFDEF VerboseJOB}
+  writeln('TJOBCallbackHelper.GetFunction ',Index,' Count=',Count);
+  {$ENDIF}
+  Result:=Nil;
+  aType:=p^;
+  if not (aType in [JOBArgObject,JOBArgFunction]) then
+    raise EJSArgParse.Create(JOBArgNames[aType]);
+  Inc(p);
+  ThisId:=0;
+  ObjId:=PLongWord(p)^;
+  inc(p,4);
+  if (aType=JOBArgFunction) then
+    begin
+    ThisId:=PLongWord(p)^;
+    inc(p,4);
+    end;
+  Result:=TJSFunction.Create(ObjId,ThisId);
+  Result.JOBObjectIDOwner:=false; // owned by caller (JS code in browser)
+end;
+
 function TJOBCallbackHelper.GetValue: TJOB_JSValue;
 var
   ObjId, Len: LongWord;
@@ -2315,6 +2498,11 @@ begin
   end;
 end;
 
+function TJOB_JSValue.AsVariant: Variant;
+begin
+  Result:=Unassigned;
+end;
+
 { TJOB_Boolean }
 
 constructor TJOB_Boolean.Create(aValue: Boolean);
@@ -2328,6 +2516,11 @@ begin
   str(Value,Result);
 end;
 
+function TJOB_Boolean.AsVariant: Variant;
+begin
+  Result:=Value;
+end;
+
 { TJOB_Double }
 
 constructor TJOB_Double.Create(const aValue: Double);
@@ -2341,12 +2534,18 @@ begin
   str(Value,Result);
 end;
 
+function TJOB_Double.AsVariant: Variant;
+begin
+  Result:=Value;
+end;
+
 { TJOB_String }
 
 constructor TJOB_String.Create(const aValue: UnicodeString);
 begin
   Kind:=jjvkString;
   Value:=aValue;
+  Writeln('Creating unicode string : ',aValue);
 end;
 
 function TJOB_String.AsString: UTF8string;
@@ -2354,6 +2553,11 @@ begin
   Result:=AnsiQuotedStr(String(Value),'"');
 end;
 
+function TJOB_String.AsVariant: Variant;
+begin
+  Result:=Value;
+end;
+
 { TJOB_Object }
 
 constructor TJOB_Object.Create(aValue: IJSObject);
@@ -2370,6 +2574,29 @@ begin
     Result:='['+IntToStr(Value.GetJSObjectID)+']:'+Value.GetPascalClassName;
 end;
 
+function TJOB_Object.AsVariant: Variant;
+begin
+  Result:=Value;
+end;
+
+{ TJOB_Function }
+
+constructor TJOB_Function.Create(aValue: IJSFunction);
+begin
+  Kind:=jjvkObject;
+  Value:=aValue;
+end;
+
+function TJOB_Function.AsString: UTF8String;
+begin
+  Result:=inherited AsString;
+end;
+
+function TJOB_Function.AsVariant: Variant;
+begin
+  Result:=Value;
+end;
+
 { TJOB_Method }
 
 constructor TJOB_Method.Create(const aMethod: TMethod;
@@ -2490,6 +2717,17 @@ begin
   Values:=nil;
 end;
 
+function TJOB_ArrayOfJSValue.AsVariant: Variant;
+
+var
+  I : integer;
+
+begin
+  Result:=VarArrayCreate([0,Length(Values)-1],varVariant);
+  for i:=0 to Length(Values)-1 do
+    Result[i]:=Values[i].AsVariant;
+end;
+
 { TJOB_ArrayOfDouble }
 
 constructor TJOB_ArrayOfDouble.Create(const TheValues: TDoubleDynArray);
@@ -2498,6 +2736,17 @@ begin
   Values:=TheValues;
 end;
 
+function TJOB_ArrayOfDouble.AsVariant: Variant;
+
+var
+  I : integer;
+
+begin
+  Result:=VarArrayCreate([0,Length(Values)-1],varDouble);
+  for i:=0 to Length(Values)-1 do
+    Result[i]:=Values[i];
+end;
+
 { TJOB_ArrayOfByte }
 
 constructor TJOB_ArrayOfByte.Create(const TheValues: PByte; TheLen: NativeUInt);
@@ -2512,6 +2761,16 @@ begin
   Create(PByte(TheValues),length(TheValues))
 end;
 
+function TJOB_ArrayOfByte.AsVariant: Variant;
+var
+  I : integer;
+
+begin
+  Result:=VarArrayCreate([0,Len-1],varByte);
+  for i:=0 to Len-1 do
+    Result[i]:=Values[i];
+end;
+
 { TJSObject }
 
 function TJSObject.GetJSObjectID: TJOBObjectID;
@@ -2761,7 +3020,7 @@ var
     us: UnicodeString;
     l: SizeInt;
   begin
-    //writeln('AddUTF8String s="',s,'"');
+    // writeln('AddUTF8String s="',s,'"');
     if s='' then
     begin
       AddUnicodeString(nil,0);
@@ -2769,6 +3028,7 @@ var
     end;
     us:=UTF8Decode(s);
     l:=length(us);
+    // writeln('AddUTF8String us="',us,'"');
     if l=0 then
     begin
       AddUnicodeString(nil,0);
@@ -3260,6 +3520,8 @@ var
   p: PByte;
   r: TJOBResult;
   Obj: TJSObject;
+  func : TJSFunction;
+  objid,thisid : TJOBObjectID;
 begin
   FillByte(Buf[0],length(Buf),0);
   p:=@Buf[0];
@@ -3275,7 +3537,14 @@ begin
     Result:=PDouble(p)^;
   JOBResult_String:
     Result:=FetchString(PNativeInt(p)^);
-  JOBResult_Function,
+  JOBResult_Function:
+    begin
+    objId:=PJOBObjectID(p)^;
+    inc(P,4);
+    thisId:=PJOBObjectID(p)^;
+    func:=TJSFunction.Create(Objid,ThisId);
+    Result:=func as IJSFunction;
+    end;
   JOBResult_Object:
     begin
     Obj:=TJSObject.JOBCreateFromID(PJOBObjectID(p)^);
@@ -3508,11 +3777,10 @@ begin
   Result:=InvokeJSUnicodeStringResult('toLocaleDateString',[]);
 end;
 
+exports JOBCallback;
+
 initialization
-  Writeln('x');
   JSObject:=TJSObject.JOBCreateGlobal('Object') as IJSObject;
-  Writeln('y');
   JSDate:=TJSDate.JOBCreateGlobal('Date') as IJSDate;
-
 end.
 

packages/wasm-job/src/job.shared.pas

@@ -33,7 +33,7 @@ const
   JOBResult_Symbol = 13;
   JOBResult_ArrayOfString = 14;
 
-  JOBResultLast = 14;
+  JOBResultLast = JOBResult_ArrayOfString;
 
   JOBResult_Names: array[0..JOBResultLast] of string = (
     'None',
@@ -84,6 +84,7 @@ const
   JOBArgArrayOfJSValue = 13; // followed by count and values
   JOBArgArrayOfDouble = 14; // followed by count and pointer
   JOBArgArrayOfByte = 15; // followed by count and pointer
+  JOBArgFunction = 12; // followed by Callback, Data, Code
 
   JOBArgNames: array[0..15] of string = (
     'Undefined',