* Split out webassembly host

packages/rtl/weborworker.pas

@@ -990,6 +990,12 @@ var
   Console : TJSConsole; external name 'console';
   Crypto: TJSCrypto; external name 'crypto';
 
+  function fetch(resource: String; init: TJSObject): TJSPromise; overload; external name 'fetch';
+  //function fetch(resource: String): TJSPromise; overload; external name 'fetch';
+  function fetch(resource: String): TJSResponse; {$IFNDEF SkipAsync}async;{$ENDIF} overload; external name 'fetch';
+  function fetch(resource: TJSObject; init: TJSObject): TJSPromise; overload; external name 'fetch';
+  function fetch(resource: TJSObject): TJSPromise; overload; external name 'fetch';
+
 implementation
 
 end.

packages/wasi/wasienv.pas

@@ -427,10 +427,219 @@ type
     Property Env : TPas2JSWASIEnvironment Read FEnv;
   end;
 
+  TWebAssemblyStartDescriptor = record
+    Memory : TJSWebAssemblyMemory;
+    Table : TJSWebAssemblyTable;
+    Exported : TWASIExports;
+    Instance : TJSWebAssemblyInstance;
+  end;
+
+
+  TBeforeStartCallBack = Reference to Function (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor) : Boolean;
+  TAfterStartCallBack = Reference to Procedure (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor);
+
+  TBeforeStartEvent = Procedure (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor; var aAllowRun : Boolean) of object;
+  TAfterStartEvent = Procedure (Sender : TObject; aDescriptor : TWebAssemblyStartDescriptor) of object;
+
+  TConsoleReadEvent = Procedure(Sender : TObject; Var AInput : String) of object;
+  TConsoleWriteEvent = Procedure (Sender : TObject; aOutput : string) of object;
+
+  { TWASIHost }
+
+  TWASIHost = Class(TComponent)
+  Private
+    FAfterStart: TAfterStartEvent;
+    FBeforeStart: TBeforeStartEvent;
+    FEnv: TPas2JSWASIEnvironment;
+    FExported: TWASIExports;
+    FMemoryDescriptor : TJSWebAssemblyMemoryDescriptor;
+    FOnConsoleRead: TConsoleReadEvent;
+    FOnConsoleWrite: TConsoleWriteEvent;
+    FPredefinedConsoleInput: TStrings;
+    FReadLineCount : Integer;
+    FRunEntryFunction: String;
+    FTableDescriptor : TJSWebAssemblyTableDescriptor;
+    procedure SetPredefinedConsoleInput(AValue: TStrings);
+  protected
+    procedure DoStdRead(Sender: TObject; var AInput: string); virtual;
+    procedure DoStdWrite(Sender: TObject; const aOutput: String); virtual;
+    function CreateWebAssembly(aPath: string; aImportObject: TJSObject): TJSPromise; virtual;
+    Function CreateWasiEnvironment : TPas2JSWASIEnvironment; virtual;
+    function GetTable: TJSWebAssemblyTable; virtual;
+    function GetMemory: TJSWebAssemblyMemory; virtual;
+ public
+    Constructor Create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    // Load and start webassembly. If DoRun is true, then Webassembly entry point is called.
+    // If aBeforeStart is specified, then it is called prior to calling run, and can disable running.
+    // If aAfterStart is specified, then it is called after calling run. It is not called is running was disabled.
+    Procedure StartWebAssembly(aPath: string; DoRun : Boolean = True;  aBeforeStart : TBeforeStartCallback = Nil; aAfterStart : TAfterStartCallback = Nil);
+    // Initial memory descriptor
+    Property MemoryDescriptor : TJSWebAssemblyMemoryDescriptor Read FMemoryDescriptor Write FMemoryDescriptor;
+    // Import/export table descriptor
+    Property TableDescriptor : TJSWebAssemblyTableDescriptor Read FTableDescriptor Write FTableDescriptor;
+    // Environment to be used
+    Property WasiEnvironment : TPas2JSWASIEnvironment Read FEnv;
+    // Exported functions. Also available in start descriptor.
+    Property Exported : TWASIExports Read FExported;
+    // Default console input
+    Property PredefinedConsoleInput : TStrings Read FPredefinedConsoleInput Write SetPredefinedConsoleInput;
+    // Name of function to run. If empty, the FPC default _start is used.
+    Property RunEntryFunction : String Read FRunEntryFunction Write FRunEntryFunction;
+    // Called after webassembly start was run. Not called if webassembly was not run.
+    Property AfterStart : TAfterStartEvent Read FAfterStart Write FAfterStart;
+    // Called before running webassembly. If aAllowRun is false, running is disabled
+    Property BeforeStart : TBeforeStartEvent Read FBeforeStart Write FBeforeStart;
+    // Called when reading from console (stdin). If not set, PredefinedConsoleinput is used.
+    property OnConsoleRead : TConsoleReadEvent Read FOnConsoleRead Write FOnConsoleRead;
+    // Called when writing to console (stdout). If not set, console.log is used.
+    property OnConsoleWrite : TConsoleWriteEvent Read FOnConsoleWrite Write FOnConsoleWrite;
+  end;
+
 implementation
 
 uses weborworker;
 
+{ TWASIHost }
+
+procedure TWASIHost.DoStdRead(Sender: TObject; var AInput: string);
+
+Var
+  S : String;
+begin
+  S:='';
+  if Assigned(FOnConsoleRead) then
+    FOnConsoleRead(Self,S)
+  else
+    begin
+    if (FReadLineCount<FPredefinedConsoleInput.Count) then
+      begin
+      S:=FPredefinedConsoleInput[FReadLineCount];
+      Inc(FReadLineCount);
+      end;
+    end;
+  aInput:=S;
+end;
+
+procedure TWASIHost.SetPredefinedConsoleInput(AValue: TStrings);
+begin
+  if FPredefinedConsoleInput=AValue then Exit;
+  FPredefinedConsoleInput.Assign(AValue);
+end;
+
+procedure TWASIHost.DoStdWrite(Sender: TObject; const aOutput: String);
+begin
+  if assigned(FOnConsoleWrite) then
+    FOnConsoleWrite(Self,aOutput)
+  else
+    Console.log('Webassembly output: ', aOutput);
+end;
+
+function TWASIHost.CreateWebAssembly(aPath: string; aImportObject: TJSObject
+  ): TJSPromise;
+
+  Function ArrayOK(res2 : jsValue) : JSValue;
+
+  begin
+     Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),aImportObject);
+  end;
+
+  function fetchOK(res : jsValue) : JSValue;
+  begin
+    Result:=TJSResponse(Res).arrayBuffer._then(@ArrayOK,Nil)
+  end;
+
+begin
+  Result:=fetch(aPath)._then(@fetchOK,Nil);
+end;
+
+function TWASIHost.CreateWasiEnvironment: TPas2JSWASIEnvironment;
+begin
+  Result:=TPas2JSWASIEnvironment.Create;
+end;
+
+function TWASIHost.GetTable: TJSWebAssemblyTable;
+begin
+  Result:=TJSWebAssemblyTable.New(FTableDescriptor);
+end;
+
+function TWASIHost.GetMemory: TJSWebAssemblyMemory;
+begin
+  Result:=TJSWebAssemblyMemory.New(FMemoryDescriptor);
+end;
+
+constructor TWASIHost.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FEnv:=CreateWasiEnvironment;
+  FEnv.OnStdErrorWrite:=@DoStdWrite;
+  FEnv.OnStdOutputWrite:=@DoStdWrite;
+  Fenv.OnGetConsoleInputString:=@DoStdRead;
+  FMemoryDescriptor.initial:=256;
+  FMemoryDescriptor.maximum:=256;
+  FTableDescriptor.initial:=0;
+  FTableDescriptor.maximum:=0;
+  FTableDescriptor.element:='anyfunc';
+  FPredefinedConsoleInput:=TStringList.Create;
+end;
+
+destructor TWASIHost.Destroy;
+begin
+  FreeAndNil(FPredefinedConsoleInput);
+  FreeAndNil(FEnv);
+  inherited Destroy;
+end;
+
+procedure TWASIHost.StartWebAssembly(aPath: string; DoRun: Boolean;
+  aBeforeStart: TBeforeStartCallback; aAfterStart: TAfterStartCallback);
+Var
+  ImportObj : TJSObject;
+  Res : TWebAssemblyStartDescriptor;
+
+  function InitEnv(aValue: JSValue): JSValue;
+
+  Var
+    Module : TJSInstantiateResult absolute aValue;
+
+  begin
+    Result:=True;
+    Res.Instance:=Module.Instance;
+    Res.Exported:=TWASIExports(TJSObject(Module.Instance.exports_));
+    // These 2 prevent running different instances simultaneously.
+    FExported:=Res.Exported;
+    WasiEnvironment.Instance:=Module.Instance;
+    if Assigned(aBeforeStart) then
+      DoRun:=aBeforeStart(Self,Res) and DoRun;
+    if Assigned(FBeforeStart) then
+      FBeforeStart(Self,Res,DoRun);
+    if DoRun then
+      begin
+      if FRunEntryFunction='' then
+        Res.Exported.Start
+      else
+        TProcedure(Res.Exported[RunEntryFunction])();
+      if Assigned(aAfterStart) then
+        aAfterStart(Self,Res);
+      if Assigned(FAfterStart) then
+        FAfterStart(Self,Res)
+      end;
+  end;
+
+
+begin
+  FReadLineCount:=0;
+  Res.Memory:=GetMemory;
+  Res.Table:=GetTable;
+  ImportObj:=new([
+    'js', new([
+      'mem', Res.Memory,
+      'tbl', Res.Table
+    ])
+  ]);
+  FEnv.AddImports(ImportObj);
+  CreateWebAssembly(aPath,ImportObj)._then(@initEnv)
+end;
+
 function TImportExtension.getModuleMemoryDataView : TJSDataView;  
 
 begin

packages/wasi/wasihostapp.pas

@@ -5,7 +5,7 @@ unit wasihostapp;
 interface
 
 uses
-  Classes, SysUtils, JS, browserapp, web, webassembly, wasienv;
+  Classes, SysUtils, browserapp,  webassembly, wasienv;
 
 Type
   TStartDescriptor = record
@@ -16,30 +16,31 @@ Type
   end;
 
   { TWASIHostApplication }
-  TBeforeStartCallBack = Reference to Function (Sender : TObject; aDescriptor : TStartDescriptor) : Boolean;
-  TAfterStartCallBack = Reference to Procedure (Sender : TObject; aDescriptor : TStartDescriptor);
 
-  TBeforeStartEvent = Procedure (Sender : TObject; aDescriptor : TStartDescriptor; var aAllowRun : Boolean) of object;
-  TAfterStartEvent = Procedure (Sender : TObject; aDescriptor : TStartDescriptor) of object;
 
 
-  TWASIHostApplication = class(TBrowserApplication)
+  TBrowserWASIHostApplication = class(TBrowserApplication)
   private
-    FAfterStart: TAfterStartEvent;
-    FBeforeStart: TBeforeStartEvent;
-    FEnv: TPas2JSWASIEnvironment;
-    FExported: TWASIExports;
-    FMemoryDescriptor : TJSWebAssemblyMemoryDescriptor;
-    FRunEntryFunction: String;
-    FTableDescriptor : TJSWebAssemblyTableDescriptor;
-    procedure DoStdRead(Sender: TObject; var AInput: string);
+    FHost : TWASIHost;
+    FOnConsoleRead: TConsoleReadEvent;
+    FOnConsoleWrite: TConsoleWriteEvent;
+    FPredefinedConsoleInput: TStrings;
+    function GetAfterStart: TAfterStartEvent;
+    function GetBeforeStart: TBeforeStartEvent;
+    function GetEnv: TPas2JSWASIEnvironment;
+    function GetExported: TWASIExports;
+    function GetMemoryDescriptor: TJSWebAssemblyMemoryDescriptor;
+    function GetRunEntryFunction: String;
+    function GetTableDescriptor: TJSWebAssemblyTableDescriptor;
+    procedure SetAfterStart(AValue: TAfterStartEvent);
+    procedure SetBeforeStart(AValue: TBeforeStartEvent);
+    procedure SetMemoryDescriptor(AValue: TJSWebAssemblyMemoryDescriptor);
+    procedure SetPredefinedConsoleInput(AValue: TStrings);
+    procedure SetRunEntryFunction(AValue: String);
+    procedure SetTableDescriptor(AValue: TJSWebAssemblyTableDescriptor);
   protected
-    procedure DoStdWrite(Sender: TObject; const aOutput: String); virtual;
-    function CreateWebAssembly(aPath: string; aImportObject: TJSObject): TJSPromise; virtual;
-    Function CreateWasiEnvironment : TPas2JSWASIEnvironment; virtual;
-    function GetTable: TJSWebAssemblyTable; virtual;
-    function GetMemory: TJSWebAssemblyMemory; virtual;
- public
+    function CreateHost: TWASIHost; virtual;
+  public
     Constructor Create(aOwner : TComponent); override;
     Destructor Destroy; override;
     // Load and start webassembly. If DoRun is true, then Webassembly entry point is called.
@@ -47,140 +48,126 @@ Type
     // If aAfterStart is specified, then it is called after calling run. It is not called is running was disabled.
     Procedure StartWebAssembly(aPath: string; DoRun : Boolean = True;  aBeforeStart : TBeforeStartCallback = Nil; aAfterStart : TAfterStartCallback = Nil);
     // Initial memory descriptor
-    Property MemoryDescriptor : TJSWebAssemblyMemoryDescriptor Read FMemoryDescriptor Write FMemoryDescriptor;
+    Property MemoryDescriptor : TJSWebAssemblyMemoryDescriptor Read GetMemoryDescriptor Write SetMemoryDescriptor;
     // Import/export table descriptor
-    Property TableDescriptor : TJSWebAssemblyTableDescriptor Read FTableDescriptor Write FTableDescriptor;
+    Property TableDescriptor : TJSWebAssemblyTableDescriptor Read GetTableDescriptor Write SetTableDescriptor;
     // Environment to be used
-    Property WasiEnvironment : TPas2JSWASIEnvironment Read FEnv;
+    Property WasiEnvironment : TPas2JSWASIEnvironment Read GetEnv;
     // Exported functions. Also available in start descriptor.
-    Property Exported : TWASIExports Read FExported;
-    Property RunEntryFunction : String Read FRunEntryFunction Write FRunEntryFunction;
+    Property Exported : TWASIExports Read GetExported;
+    // Name of function to run, if empty default _start symbol is used.
+    Property RunEntryFunction : String Read GetRunEntryFunction Write SetRunEntryFunction;
     // Called after webassembly start was run. Not called if webassembly was not run.
-    Property AfterStart : TAfterStartEvent Read FAfterStart Write FAfterStart;
+    Property AfterStart : TAfterStartEvent Read GetAfterStart Write SetAfterStart;
     // Called before running webassembly. If aAllowRun is false, running is disabled
-    Property BeforeStart : TBeforeStartEvent Read FBeforeStart Write FBeforeStart;
+    Property BeforeStart : TBeforeStartEvent Read GetBeforeStart Write SetBeforeStart;
+    // Default console input
+    Property PredefinedConsoleInput : TStrings Read FPredefinedConsoleInput Write SetPredefinedConsoleInput;
+    // Called when reading from console (stdin). If not set, PredefinedConsoleinput is used.
+    property OnConsoleRead : TConsoleReadEvent Read FOnConsoleRead Write FOnConsoleRead;
+    // Called when writing to console (stdout). If not set, console.log is used.
+    property OnConsoleWrite : TConsoleWriteEvent Read FOnConsoleWrite Write FOnConsoleWrite;
   end;
 
+  // For backwards compatibility
+
+  TWASIHostApplication = TBrowserWASIHostApplication;
+
 implementation
 
-{ TWASIHostApplication }
+{ TBrowserWASIHostApplication }
 
-function TWASIHostApplication.CreateWasiEnvironment: TPas2JSWASIEnvironment;
+function TBrowserWASIHostApplication.GetAfterStart: TAfterStartEvent;
 begin
-  Result:=TPas2JSWASIEnvironment.Create;
+  Result:=FHost.AfterStart;
 end;
 
-constructor TWASIHostApplication.Create(aOwner: TComponent);
+function TBrowserWASIHostApplication.GetBeforeStart: TBeforeStartEvent;
 begin
-  inherited Create(aOwner);
-  FEnv:=CreateWasiEnvironment;
-  FEnv.OnStdErrorWrite:=@DoStdWrite;
-  FEnv.OnStdOutputWrite:=@DoStdWrite;
-  Fenv.OnGetConsoleInputString:=@DoStdRead;
-  FMemoryDescriptor.initial:=256;
-  FMemoryDescriptor.maximum:=256;
-  FTableDescriptor.initial:=0;
-  FTableDescriptor.maximum:=0;
-  FTableDescriptor.element:='anyfunc';
+  Result:=FHost.BeforeStart;
 end;
 
-destructor TWASIHostApplication.Destroy;
+function TBrowserWASIHostApplication.GetEnv: TPas2JSWASIEnvironment;
 begin
-  FreeAndNil(FEnv);
-  inherited Destroy;
+  Result:=FHost.WasiEnvironment;
 end;
 
-function TWASIHostApplication.GetTable : TJSWebAssemblyTable;
-
+function TBrowserWASIHostApplication.GetExported: TWASIExports;
 begin
-  Result:=TJSWebAssemblyTable.New(FTableDescriptor);
+  Result:=FHost.Exported;
 end;
 
-function TWASIHostApplication.GetMemory : TJSWebAssemblyMemory;
-
+function TBrowserWASIHostApplication.GetMemoryDescriptor: TJSWebAssemblyMemoryDescriptor;
 begin
-  Result:=TJSWebAssemblyMemory.New(FMemoryDescriptor);
+  Result:=FHost.MemoryDescriptor;
 end;
 
+function TBrowserWASIHostApplication.GetRunEntryFunction: String;
+begin
+  Result:=FHost.RunEntryFunction;
+end;
 
-procedure TWASIHostApplication.StartWebAssembly(aPath: string; DoRun: Boolean;
-  aBeforeStart: TBeforeStartCallback = nil; aAfterStart: TAfterStartCallback = nil);
+function TBrowserWASIHostApplication.GetTableDescriptor: TJSWebAssemblyTableDescriptor;
+begin
+  Result:=FHost.TableDescriptor;
+end;
 
-Var
-  ImportObj : TJSObject;
-  Res : TStartDescriptor;
-
-  function InitEnv(aValue: JSValue): JSValue;
-
-  Var
-    Module : TJSInstantiateResult absolute aValue;
-
-  begin
-    Result:=True;
-    Res.Instance:=Module.Instance;
-    Res.Exported:=TWASIExports(TJSObject(Module.Instance.exports_));
-    // These 2 prevent running different instances simultaneously.
-    FExported:=Res.Exported;
-    WasiEnvironment.Instance:=Module.Instance;
-    if Assigned(aBeforeStart) then
-      DoRun:=aBeforeStart(Self,Res) and DoRun;
-    if Assigned(FBeforeStart) then
-      FBeforeStart(Self,Res,DoRun);
-    if DoRun then
-      begin
-      if FRunEntryFunction='' then
-        Res.Exported.Start
-      else
-        TProcedure(Res.Exported[RunEntryFunction])();
-      if Assigned(aAfterStart) then
-        aAfterStart(Self,Res);
-      if Assigned(FAfterStart) then
-        FAfterStart(Self,Res)
-      end;
-  end;
+procedure TBrowserWASIHostApplication.SetAfterStart(AValue: TAfterStartEvent);
+begin
+  FHost.AfterStart:=aValue;
+end;
 
+procedure TBrowserWASIHostApplication.SetBeforeStart(AValue: TBeforeStartEvent);
+begin
+  FHost.BeforeStart:=aValue;
+end;
 
+procedure TBrowserWASIHostApplication.SetMemoryDescriptor(
+  AValue: TJSWebAssemblyMemoryDescriptor);
 begin
-  Res.Memory:=GetMemory;
-  Res.Table:=GetTable;
-  ImportObj:=new([
-    'js', new([
-      'mem', Res.Memory,
-      'tbl', Res.Table
-    ])
-  ]);
-  FEnv.AddImports(ImportObj);
-  CreateWebAssembly(aPath,ImportObj)._then(@initEnv)
+  FHost.MemoryDescriptor:=aValue;
 end;
 
-procedure TWASIHostApplication.DoStdRead(Sender: TObject; var AInput: string);
+procedure TBrowserWASIHostApplication.SetPredefinedConsoleInput(AValue: TStrings);
 begin
-  aInput:=Window.prompt('Please enter the input for the running webassembly program.');
+  FHost.PredefinedConsoleInput:=aValue;
 end;
 
-procedure TWASIHostApplication.DoStdWrite(Sender: TObject; const aOutput: String
-  );
+procedure TBrowserWASIHostApplication.SetRunEntryFunction(AValue: String);
 begin
-  Console.log('Webassembly output: ', aOutput);
+  FHost.RunEntryFunction:=aValue;
 end;
 
-function TWASIHostApplication.CreateWebAssembly(aPath: string; aImportObject: TJSObject): TJSPromise;
+procedure TBrowserWASIHostApplication.SetTableDescriptor(
+  AValue: TJSWebAssemblyTableDescriptor);
+begin
+  FHost.TableDescriptor:=aValue;
+end;
 
-  Function ArrayOK(res2 : jsValue) : JSValue;
+function TBrowserWASIHostApplication.CreateHost : TWASIHost;
 
-  begin
-     Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),aImportObject);
-  end;
+begin
+  Result:=TWASIHost.Create(Nil);
+end;
 
-  function fetchOK(res : jsValue) : JSValue;
-  begin
-    Result:=TJSResponse(Res).arrayBuffer._then(@ArrayOK,Nil)
-  end;
+constructor TBrowserWASIHostApplication.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FHost:=CreateHost;
+end;
 
+destructor TBrowserWASIHostApplication.Destroy;
 begin
-  Result:=window.fetch(aPath)._then(@fetchOK,Nil);
+  FreeAndNil(FHost);
+  inherited Destroy;
 end;
 
+procedure TBrowserWASIHostApplication.StartWebAssembly(aPath: string; DoRun: Boolean;
+  aBeforeStart: TBeforeStartCallback = nil; aAfterStart: TAfterStartCallback = nil);
+
+begin
+  FHost.StartWebAssembly(aPath,DoRun,aBeforeStart,aAfterStart);
+end;
 
 end.