mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-05 00:47:47 +02:00
* Demo for mem grow notification
This commit is contained in:
Michael Van Canneyt
parent
a45c779bfc
commit
bd0fdc19f2
1
demo/wasienv/memutils/bulma.min.css
vendored
Normal file
1
demo/wasienv/memutils/bulma.min.css
vendored
Normal file
File diff suppressed because one or more lines are too long
49
demo/wasienv/memutils/index.html
Normal file
49
demo/wasienv/memutils/index.html
Normal file
@ -0,0 +1,49 @@
|
||||
|
||||
<!doctype html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<meta http-equiv="Content-type" content="text/html; charset=utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<title>FPC-Webassembly and Pas2JS Demo</title>
|
||||
<link href="bulma.min.css" rel="stylesheet">
|
||||
<!-- <link rel="stylesheet" href="https://cdn.jsdelivr.net/npm/bulma@0.9.3/css/bulma.min.css"> -->
|
||||
<script src="memtesthost.js"></script>
|
||||
<style>
|
||||
|
||||
.source {
|
||||
/* width: 730px; */
|
||||
margin: -45px auto;
|
||||
font-size: 0.9em;
|
||||
}
|
||||
|
||||
.source-inner {
|
||||
display: flex;
|
||||
justify-content: space-between;
|
||||
align-items: center;
|
||||
/* width: 482px; */
|
||||
}
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<div class="section pb-4">
|
||||
<h1 class="title is-4">FPC compiled wasm program console output:</h1>
|
||||
<div class="box" id="pasjsconsole"></div>
|
||||
</div>
|
||||
<!-- <hr> -->
|
||||
<div class="section">
|
||||
<div class="source">
|
||||
<div class="source-inner">
|
||||
<div>
|
||||
<p>Created using <a target="_blank" href="https://wiki.freepascal.org/pas2js">pas2js.</a> </p>
|
||||
<p>Pas2JS Sources: <a target="new" href="demowasienv.lpr">Pas2JS Program</a></p>
|
||||
<p>Webassembly Sources: <a target="new" href="helloworld.pp">FPC Program</a></p>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<script>
|
||||
rtl.showUncaughtExceptions=true;
|
||||
rtl.run();
|
||||
</script>
|
||||
</body>
|
||||
</html>
|
||||
92
demo/wasienv/memutils/memtesthost.lpi
Normal file
92
demo/wasienv/memutils/memtesthost.lpi
Normal file
@ -0,0 +1,92 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<Runnable Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="memtesthost"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<CustomData Count="2">
|
||||
<Item0 Name="MaintainHTML" Value="1"/>
|
||||
<Item1 Name="PasJSWebBrowserProject" Value="1"/>
|
||||
</CustomData>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="memtesthost.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="index.html"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<CustomData Count="1">
|
||||
<Item0 Name="PasJSIsProjectHTMLFile" Value="1"/>
|
||||
</CustomData>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="../../../packages/wasm-utils/src/wasm.pas2js.memutils.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target FileExt=".js">
|
||||
<Filename Value="memtesthost"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="js"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<AllowLabel Value="False"/>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
<CPPInline Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<CodeGeneration>
|
||||
<TargetOS Value="browser"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
<UseLineInfoUnit Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/>
|
||||
<CompilerPath Value="$(pas2js)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
126
demo/wasienv/memutils/memtesthost.lpr
Normal file
126
demo/wasienv/memutils/memtesthost.lpr
Normal file
@ -0,0 +1,126 @@
|
||||
program memtesthost;
|
||||
|
||||
{$mode objfpc}
|
||||
|
||||
uses
|
||||
browserconsole, browserapp, JS, Classes, SysUtils, Web, WebAssembly, types, wasienv, wasm.pas2js.memutils;
|
||||
|
||||
Type
|
||||
|
||||
{ TMyApplication }
|
||||
|
||||
TMyApplication = class(TBrowserApplication)
|
||||
Private
|
||||
FWasiEnv: TPas2JSWASIEnvironment;
|
||||
FMemUtils : TWasiMemUtils;
|
||||
FMemory : TJSWebAssemblyMemory; // Memory of webassembly
|
||||
FTable : TJSWebAssemblyTable; // exported functions.
|
||||
function CreateWebAssembly(Path: string; ImportObject: TJSObject
|
||||
): TJSPromise;
|
||||
procedure DoWrite(Sender: TObject; const aOutput: String);
|
||||
procedure HandleMemoryGrow(aPages: Integer);
|
||||
function initEnv(aValue: JSValue): JSValue;
|
||||
procedure InitWebAssembly;
|
||||
Public
|
||||
Constructor Create(aOwner : TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
procedure doRun; override;
|
||||
end;
|
||||
|
||||
function TMyApplication.InitEnv(aValue: JSValue): JSValue;
|
||||
|
||||
Var
|
||||
Module : TJSInstantiateResult absolute aValue;
|
||||
exps : TWASIExports;
|
||||
|
||||
begin
|
||||
Result:=True;
|
||||
Exps := TWASIExports(TJSObject(Module.Instance.exports_));
|
||||
FWasiEnv.Instance:=Module.Instance;
|
||||
Exps.Start;
|
||||
end;
|
||||
|
||||
procedure TMyApplication.DoWrite(Sender: TObject; const aOutput: String);
|
||||
begin
|
||||
Writeln(aOutput);
|
||||
end;
|
||||
|
||||
procedure TMyApplication.HandleMemoryGrow(aPages: Integer);
|
||||
begin
|
||||
Writeln('Webassembly host: memory has grown with ',aPages,' pages of 64k');
|
||||
end;
|
||||
|
||||
constructor TMyApplication.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
FWasiEnv:=TPas2JSWASIEnvironment.Create;
|
||||
FWasiEnv.OnStdErrorWrite:=@DoWrite;
|
||||
FWasiEnv.OnStdOutputWrite:=@DoWrite;
|
||||
FMemUtils:=TWasiMemUtils.Create(FWasiEnv);
|
||||
FMemUtils.OnMemoryGrow:=@HandleMemoryGrow;
|
||||
end;
|
||||
|
||||
function TMyApplication.CreateWebAssembly(Path: string; ImportObject: TJSObject): TJSPromise;
|
||||
|
||||
begin
|
||||
Result:=window.fetch(Path)._then(Function (res : jsValue) : JSValue
|
||||
begin
|
||||
Result:=TJSResponse(Res).arrayBuffer._then(Function (res2 : jsValue) : JSValue
|
||||
begin
|
||||
Result:=TJSWebAssembly.instantiate(TJSArrayBuffer(res2),ImportObject);
|
||||
end,Nil)
|
||||
end,Nil
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMyApplication.InitWebAssembly;
|
||||
|
||||
Var
|
||||
mDesc : TJSWebAssemblyMemoryDescriptor;
|
||||
tDesc: TJSWebAssemblyTableDescriptor;
|
||||
ImportObj : TJSObject;
|
||||
|
||||
begin
|
||||
// Setup memory
|
||||
mDesc.initial:=256;
|
||||
mDesc.maximum:=256;
|
||||
FMemory:=TJSWebAssemblyMemory.New(mDesc);
|
||||
// Setup table
|
||||
tDesc.initial:=0;
|
||||
tDesc.maximum:=0;
|
||||
tDesc.element:='anyfunc';
|
||||
FTable:=TJSWebAssemblyTable.New(tDesc);
|
||||
// Setup ImportObject
|
||||
ImportObj:=new([
|
||||
'js', new([
|
||||
'mem', FMemory,
|
||||
'tbl', FTable
|
||||
])
|
||||
]);
|
||||
FWasiEnv.AddImports(ImportObj);
|
||||
CreateWebAssembly('memtest.wasm',ImportObj)._then(@initEnv)
|
||||
end;
|
||||
|
||||
|
||||
destructor TMyApplication.Destroy;
|
||||
begin
|
||||
FreeAndNil(FWasiEnv);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMyApplication.doRun;
|
||||
|
||||
begin
|
||||
// Your code here
|
||||
Terminate;
|
||||
InitWebAssembly;
|
||||
end;
|
||||
|
||||
var
|
||||
Application : TMyApplication;
|
||||
|
||||
begin
|
||||
Application:=TMyApplication.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
end.
|
||||
60
demo/wasienv/memutils/testmem.lpi
Normal file
60
demo/wasienv/memutils/testmem.lpi
Normal file
@ -0,0 +1,60 @@
|
||||
<?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="testmem"/>
|
||||
<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="testmem.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="wasm.memutils.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testmem.wasm"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
20
demo/wasienv/memutils/testmem.lpr
Normal file
20
demo/wasienv/memutils/testmem.lpr
Normal file
@ -0,0 +1,20 @@
|
||||
program testmem;
|
||||
|
||||
uses wasmtypes, webassembly, wasm.http.api, wasm.memutils;
|
||||
|
||||
procedure DoGrow(aPages : longint);
|
||||
|
||||
begin
|
||||
writeln('Growing wasm memory with ',aPages,' pages of 64k');
|
||||
end;
|
||||
|
||||
var
|
||||
i : integer;
|
||||
p : pointer;
|
||||
|
||||
begin
|
||||
MemGrowNotifyCallBack:=@DoGrow;
|
||||
for I:=1 to 20 do
|
||||
getmem(p,1024*256*i);
|
||||
end.
|
||||
|
||||
46
packages/wasm-utils/src/wasm.pas2js.memutils.pas
Normal file
46
packages/wasm-utils/src/wasm.pas2js.memutils.pas
Normal file
@ -0,0 +1,46 @@
|
||||
unit wasm.pas2js.memutils;
|
||||
|
||||
{$mode ObjFPC}
|
||||
|
||||
interface
|
||||
|
||||
uses js, wasienv;
|
||||
|
||||
type
|
||||
|
||||
{ TWasiMemUtils }
|
||||
TMemoryGrowHandler = reference to procedure(aPages : Integer);
|
||||
|
||||
TWasiMemUtils = class(TImportExtension)
|
||||
private
|
||||
FOnMemoryGrow: TMemoryGrowHandler;
|
||||
Protected
|
||||
procedure MemoryGrowNotification(aPages : integer); virtual;
|
||||
Public
|
||||
procedure FillImportObject(aObject: TJSObject); override;
|
||||
function ImportName: String; override;
|
||||
property OnMemoryGrow : TMemoryGrowHandler Read FOnMemoryGrow Write FOnMemoryGrow;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TWasiMemUtils }
|
||||
|
||||
procedure TWasiMemUtils.MemoryGrowNotification(aPages: integer);
|
||||
begin
|
||||
if assigned(OnMemoryGrow) then
|
||||
OnMemoryGrow(aPages);
|
||||
end;
|
||||
|
||||
procedure TWasiMemUtils.FillImportObject(aObject: TJSObject);
|
||||
begin
|
||||
aObject['wasm_memory_grow_notification']:=@MemoryGrowNotification;
|
||||
end;
|
||||
|
||||
function TWasiMemUtils.ImportName: String;
|
||||
begin
|
||||
Result:='wasmmem';
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user