Fix getArgs support for node (#645)

.buildkite/test.sh

@@ -61,3 +61,5 @@ stack --no-terminal test asterius:nomain --test-arguments="--tail-calls"
 stack --no-terminal test asterius:th
 
 stack --no-terminal test asterius:primitive
+
+stack --no-terminal test asterius:argv

asterius/package.yaml

@@ -36,6 +36,7 @@ extra-source-files:
   - test/nodeio/**/*.hs
   - test/time/**/*.hs
   - test/primitive/**/*.hs
+  - test/argv/**/*.hs
 
 data-files:
   - rts/**/*.mjs
@@ -321,3 +322,10 @@ tests:
     ghc-options: *exe-ghc-options
     dependencies:
       - asterius
+
+  argv:
+    source-dirs: test
+    main: argv.hs
+    ghc-options: *exe-ghc-options
+    dependencies:
+      - asterius

asterius/rts/browser/default.mjs

@@ -3,6 +3,13 @@
  */
 
 class Posix {
+  constructor(memory, rtsConstants) {
+    this.memory = memory;
+    Object.seal(this);
+  }
+  getProgArgv(argc, argv_buf) {
+    this.memory.i64Store(argc, 1);
+  }
   get_errno() {
     throw WebAssembly.RuntimeError("Unsupported rts interface: get_errno");
   }

asterius/rts/node/default.mjs

@@ -13,6 +13,34 @@ class Posix {
     this.errno = 0;
     Object.seal(this);
   }
+  getProgArgv(argc, argv_buf) {
+    const e = new TextEncoder(),
+      arg_bufs = process.argv.slice(2).map((s) => e.encode(s)),
+      argv_header_size = (1 + arg_bufs.length) * 8,
+      argv_total_size =
+        argv_header_size +
+        // All strings are \0-terminated, hence the +1
+        arg_bufs.reduce((acc, buf) => acc + buf.byteLength + 1, 0); 
+    // The total size (in bytes) of the runtime arguments cannot exceed the 1KB
+    // size of the data segment we have reserved. If you wish to change this
+    // number, you should also update envArgvBuf in Asterius.Builtins.Env.
+    if (argv_total_size > 1024) {
+      throw new WebAssembly.RuntimeError(
+        `getProgArgv: exceeding buffer size for ${process.argv}`
+      );
+    }
+    this.memory.i64Store(argc, 1 + arg_bufs.length);
+    let p0 = argv_buf + 8,
+      p1 = argv_buf + argv_header_size;
+    arg_bufs.forEach(arg_buf => {
+      this.memory.i64Store(p0, p1);
+      p0 += 8;
+      this.memory.expose(p1, arg_buf.byteLength, Uint8Array).set(arg_buf);
+      p1 += arg_buf.byteLength;
+      this.memory.i8Store(p1, 0);
+      p1 += 1;
+    });
+  }
   get_errno() {
     return this.errno;
   }

asterius/src/Asterius/Builtins.hs

@@ -19,6 +19,7 @@ where
 
 import Asterius.Builtins.Blackhole
 import Asterius.Builtins.CMath
+import Asterius.Builtins.Env
 import Asterius.Builtins.Exports
 import Asterius.Builtins.Hashable
 import Asterius.Builtins.MD5
@@ -101,12 +102,6 @@ rtsAsteriusModule opts =
                     ]
                 }
             ),
-            ( "prog_argv",
-              AsteriusStatics
-                { staticsType = ConstBytes,
-                  asteriusStatics = [SymbolStatic "prog_name" 0]
-                }
-            ),
             ( "__asterius_localeEncoding",
               AsteriusStatics
                 { staticsType = ConstBytes,
@@ -162,7 +157,6 @@ rtsAsteriusModule opts =
     <> tryWakeupThreadFunction opts
     <> raiseExceptionHelperFunction opts
     <> barfFunction opts
-    <> getProgArgvFunction opts
     <> suspendThreadFunction opts
     <> scheduleThreadFunction opts
     <> scheduleThreadOnFunction opts
@@ -190,6 +184,7 @@ rtsAsteriusModule opts =
     <> cmathCBits
     <> hashableCBits
     <> md5CBits
+    <> envCBits
     <> posixCBits
     <> sptCBits
     <> stgPrimFloatCBits
@@ -618,6 +613,7 @@ rtsFunctionImports debug =
       )
     <> schedulerImports
     <> exportsImports
+    <> envImports
     <> posixImports
     <> sptImports
     <> timeImports
@@ -1401,12 +1397,6 @@ unicodeCBits =
       ("u_iswprint", [I64], [I64])
     ]
 
-getProgArgvFunction :: BuiltinsOptions -> AsteriusModule
-getProgArgvFunction _ = runEDSL "getProgArgv" $ do
-  [argc, argv] <- params [I64, I64]
-  storeI64 argc 0 $ constI64 1
-  storeI64 argv 0 $ symbol "prog_argv"
-
 suspendThreadFunction :: BuiltinsOptions -> AsteriusModule
 suspendThreadFunction _ = runEDSL "suspendThread" $ do
   setReturnTypes [I64]

asterius/src/Asterius/Builtins/Env.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Asterius.Builtins.Env
+  ( envImports,
+    envCBits,
+  )
+where
+
+import Asterius.EDSL
+import Asterius.Types
+import qualified Asterius.Types.SymbolMap as SM
+
+envImports :: [FunctionImport]
+envImports =
+  [ FunctionImport
+      { internalName = "__asterius_getProgArgv",
+        externalModuleName = "posix",
+        externalBaseName = "getProgArgv",
+        functionType =
+          FunctionType
+            { paramTypes = [F64, F64],
+              returnTypes = []
+            }
+      }
+  ]
+
+envCBits :: AsteriusModule
+envCBits = envArgvBuf <> envGetProgArgv
+
+-- | Data segment used to store runtime arguments. In normal native programs,
+-- the arguments passed to a program @argv@ exist in special memory pages and are
+-- managed by the OS kernel. Since we cannot do this here, we instead reserve a
+-- data segment of 1KB of memory to be used for this purpose (see @getProgArgv@ in
+-- @rts/node/default.mjs@).
+envArgvBuf :: AsteriusModule
+envArgvBuf =
+  mempty
+    { staticsMap =
+        SM.singleton
+          "__asterius_argv_buf"
+          AsteriusStatics
+            { staticsType = Bytes,
+              asteriusStatics = [Uninitialized 1024]
+            }
+    }
+
+envGetProgArgv :: AsteriusModule
+envGetProgArgv = runEDSL "getProgArgv" $ do
+  [argc, argv] <- params [I64, I64]
+  callImport "__asterius_getProgArgv" $
+    map convertUInt64ToFloat64 [argc, symbol "__asterius_argv_buf"]
+  storeI64 (symbol "__asterius_argv_buf") 0 (symbol "prog_name")
+  storeI64 argv 0 $ symbol "__asterius_argv_buf"

asterius/test/argv.hs

@@ -0,0 +1,11 @@
+import System.Environment
+import System.Directory
+import System.Process
+
+main :: IO ()
+main = do
+  args <- getArgs
+  callProcess "ahc-link" $ ["--input-hs", "test/argv/argv.hs"] <> args
+  withCurrentDirectory "test/argv" $ do
+    callProcess "node" ["argv.mjs", "extra", "flags"]
+

asterius/test/argv/argv.hs

@@ -0,0 +1,4 @@
+import System.Environment
+
+main :: IO ()
+main = getArgs >>= print  -- expected output: ["extra","flags"]