Add bump allocator

wasm-calc4/src/Calc/Wasm/Allocator.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Calc.Wasm.Allocator (moduleWithAllocator) where
+
+import qualified Language.Wasm as Wasm
+import Data.FileEmbed
+import qualified Data.ByteString.Lazy as LB
+
+-- these are saved in a file that is included in compilation
+allocatorSource ::LB.ByteString
+allocatorSource =
+  LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
+
+-- we have an allocator, we need to import it
+moduleWithAllocator :: Wasm.Module
+moduleWithAllocator = case Wasm.parse allocatorSource of
+                        Right mod' -> mod'
+                        Left e -> error (show e)

wasm-calc4/src/Calc/Wasm/FromExpr.hs

@@ -88,7 +88,7 @@ fromFunction funcMap (Function {fnBody, fnArgs, fnFunctionName}) = do
 
 fromModule :: (Show ann) => Module ann -> Either FromWasmError WasmModule
 fromModule (Module {mdExpr, mdFunctions}) = do
-  let funcMap = M.fromList $ (\(i, Function {fnFunctionName}) -> (fnFunctionName, i + 1)) <$> zip [0 ..] mdFunctions
+  let funcMap = M.fromList $ (\(i, Function {fnFunctionName}) -> (fnFunctionName, i + 1)) <$> zip [1 ..] mdFunctions
 
   expr <- runReaderT (fromExpr mdExpr) (FromExprEnv mempty funcMap)
 

wasm-calc4/src/Calc/Wasm/ToWasm.hs

@@ -2,6 +2,7 @@
 
 module Calc.Wasm.ToWasm (moduleToWasm) where
 
+import Calc.Wasm.Allocator
 import Calc.Types.Expr
 import Calc.Types.FunctionName
 import Calc.Types.Prim
@@ -12,23 +13,23 @@ import GHC.Natural
 import qualified Language.Wasm.Structure as Wasm
 
 mapWithIndex :: ((Int, a) -> b) -> [a] -> [b]
-mapWithIndex f = fmap f . zip [0 ..]
+mapWithIndex f = fmap f . zip [0..]
 
 fromType :: WasmType -> Wasm.ValueType
 fromType I32 = Wasm.I32
 fromType Pointer = Wasm.I64
 
 fromFunction :: Int -> WasmFunction -> Wasm.Function
 fromFunction wfIndex (WasmFunction {wfExpr, wfArgs}) =
-  Wasm.Function (fromIntegral wfIndex) (fromType <$> wfArgs) (fromExpr wfExpr)
+  Wasm.Function (fromIntegral $ wfIndex + 1) (fromType <$> wfArgs) (fromExpr wfExpr)
 
 typeFromFunction :: WasmFunction -> Wasm.FuncType
 typeFromFunction (WasmFunction {wfArgs, wfReturnType}) =
   Wasm.FuncType (fromType <$> wfArgs) [fromType wfReturnType]
 
 exportFromFunction :: Int -> WasmFunction -> Maybe Wasm.Export
 exportFromFunction wfIndex (WasmFunction {wfName = FunctionName fnName, wfPublic = True}) =
-  Just $ Wasm.Export (TL.fromStrict fnName) (Wasm.ExportFunc (fromIntegral wfIndex))
+  Just $ Wasm.Export (TL.fromStrict fnName) (Wasm.ExportFunc (fromIntegral wfIndex + 1))
 exportFromFunction _ _ = Nothing
 
 bitsizeFromType :: WasmType -> Wasm.BitSize
@@ -56,17 +57,16 @@ fromExpr (WVar i) = [Wasm.GetLocal i]
 fromExpr (WApply fnIndex args) =
   foldMap fromExpr args <> [Wasm.Call fnIndex]
 
+-- | we load the bump allocator module and build on top of it
 moduleToWasm :: WasmModule -> Wasm.Module
 moduleToWasm (WasmModule {wmFunctions}) =
   let functions = mapWithIndex (uncurry fromFunction) wmFunctions
       types = typeFromFunction <$> wmFunctions
       exports = catMaybes $ mapWithIndex (uncurry exportFromFunction) wmFunctions
-   in Wasm.Module
-        { Wasm.types = types,
-          Wasm.functions = functions,
+   in moduleWithAllocator
+        { Wasm.types = (Wasm.types moduleWithAllocator !! 0) : types,
+          Wasm.functions = (head (Wasm.functions moduleWithAllocator)) : functions,
           Wasm.tables = mempty,
-          Wasm.mems = mempty,
-          Wasm.globals = mempty,
           Wasm.elems = mempty,
           Wasm.datas = mempty,
           Wasm.start = Nothing,

wasm-calc4/static/bump-allocator.wat

@@ -0,0 +1,65 @@
+;; taken entirely from https://gist.github.com/bryanburgers/2b0f08fd583cf0401a958d7e8edc7552#file-figure-06-wat
+(module
+    ;; Create memory with at least 1 page of 64k of memory
+    (memory $mem 1)
+
+    ;; the pointer of the next allocation
+    (global $alloc.offset (mut i32) (i32.const 32))
+    (func $alloc (param $size i32) (result (;pointer;) i32)
+        (local $this_alloc_ptr i32)
+        (local $next_alloc_ptr i32)
+        (local $current_capacity i32)
+
+        ;; If the requested size is more than a 64k page, fail.
+        local.get $size
+        i32.const 65536
+        i32.gt_u
+        (if
+            (then
+                i32.const 0x01
+                unreachable
+            )
+        )
+
+        ;; calculate the current ptr and the next ptr
+        global.get $alloc.offset
+        local.tee $this_alloc_ptr
+        local.get $size
+        i32.add
+        local.set $next_alloc_ptr
+
+        ;; If this allocation extends into a page of memory we haven't reserved
+        ;; we need to reserve more memory
+        memory.size
+        i32.const 65536
+        i32.mul
+        local.set $current_capacity
+
+        local.get $next_alloc_ptr
+        local.get $current_capacity
+        i32.gt_u
+        (if
+            (then
+                i32.const 1
+                memory.grow
+
+                ;; if memory couldn't grow, panic
+                i32.const -1
+                i32.eq
+                (if
+                    (then
+                        i32.const 0x02
+                        unreachable
+                    )
+                )
+            )
+        )
+
+        ;; store the ptr to the next allocation
+        local.get $next_alloc_ptr
+        global.set $alloc.offset
+
+        ;; and return the current pointer
+        local.get $this_alloc_ptr
+    )
+)

wasm-calc4/wasm-calc4.cabal

@@ -32,9 +32,9 @@ common shared
 
   build-depends:
     , base
+    , bytestring
     , containers
     , diagnose
-    , wasm
     , directory
     , file-embed
     , hashable
@@ -48,6 +48,7 @@ common shared
     , text
     , unix
     , unordered-containers
+    , wasm
 
   other-modules:
     Calc
@@ -107,9 +108,9 @@ test-suite wasm-calc4-tests
   default-language: Haskell2010
   other-modules:
     Test.Interpreter.InterpreterSpec
-    Test.Wasm.WasmSpec
     Test.Parser.ParserSpec
     Test.Typecheck.TypecheckSpec
+    Test.Wasm.WasmSpec
 
 executable wasm-calc4
   import:           shared
@@ -125,7 +126,6 @@ executable wasm-calc4
     , file-embed
     , hashable
     , haskeline
-    , wasm-calc4
     , megaparsec
     , mtl
     , parser-combinators
@@ -135,5 +135,6 @@ executable wasm-calc4
     , text
     , unix
     , unordered-containers
+    , wasm-calc4
 
   default-language: Haskell2010