diff --git a/System/Process.hs b/System/Process.hs
index dbacc1491429dee9df40429a41b0feb4f303bffd..c9616a8d03cf999ae41df015c552fc0517c87620 100644
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -8,6 +8,10 @@
 
 #include <ghcplatform.h>
 
+#if defined(javascript_HOST_ARCH)
+{-# LANGUAGE JavaScriptFFI #-}
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Process
@@ -85,7 +89,11 @@ import System.Process.Internals
 
 import Control.Concurrent
 import Control.DeepSeq (rnf)
-import Control.Exception (SomeException, mask, allowInterrupt, bracket, try, throwIO)
+import Control.Exception (SomeException, mask
+#if !defined(javascript_HOST_ARCH)
+                         , allowInterrupt
+#endif
+                         , bracket, try, throwIO)
 import qualified Control.Exception as C
 import Control.Monad
 import Data.Maybe
@@ -95,7 +103,9 @@ import System.Exit      ( ExitCode(..) )
 import System.IO
 import System.IO.Error (mkIOError, ioeSetErrorString)
 
-#if defined(WINDOWS)
+#if defined(javascript_HOST_ARCH)
+import System.Process.JavaScript(getProcessId, getCurrentProcessId)
+#elif defined(WINDOWS)
 import System.Win32.Process (getProcessId, getCurrentProcessId, ProcessId)
 #else
 import System.Posix.Process (getProcessID)
@@ -114,7 +124,9 @@ import System.IO.Error
 -- This is always an integral type. Width and signedness are platform specific.
 --
 -- @since 1.6.3.0
-#if defined(WINDOWS)
+#if defined(javascript_HOST_ARCH)
+type Pid = Int
+#elif defined(WINDOWS)
 type Pid = ProcessId
 #else
 type Pid = CPid
@@ -651,7 +663,11 @@ getPid :: ProcessHandle -> IO (Maybe Pid)
 getPid (ProcessHandle mh _ _) = do
   p_ <- readMVar mh
   case p_ of
-#ifdef WINDOWS
+#if defined(javascript_HOST_ARCH)
+    OpenHandle h -> do
+      pid <- getProcessId h
+      return $ Just pid
+#elif defined(WINDOWS)
     OpenHandle h -> do
       pid <- getProcessId h
       return $ Just pid
@@ -672,7 +688,9 @@ getPid (ProcessHandle mh _ _) = do
 -- @since 1.6.12.0
 getCurrentPid :: IO Pid
 getCurrentPid =
-#ifdef WINDOWS
+#if defined(javascript_HOST_ARCH)
+    getCurrentProcessId
+#elif defined(WINDOWS)
     getCurrentProcessId
 #else
     getProcessID
@@ -753,7 +771,11 @@ waitForProcess ph@(ProcessHandle _ delegating_ctlc _) = lockWaitpid $ do
 
     waitForProcess' :: PHANDLE -> IO ExitCode
     waitForProcess' h = alloca $ \pret -> do
+#if defined(javascript_HOST_ARCH)
+      throwErrnoIfMinus1Retry_ "waitForProcess" (C.interruptible $ c_waitForProcess h pret)
+#else
       throwErrnoIfMinus1Retry_ "waitForProcess" (allowInterrupt >> c_waitForProcess h pret)
+#endif
       mkExitCode <$> peek pret
 
     mkExitCode :: CInt -> ExitCode
@@ -875,6 +897,26 @@ c_getProcessExitCode _ _ = ioError (ioeSetLocation unsupportedOperation "getProc
 c_waitForProcess :: PHANDLE -> Ptr CInt -> IO CInt
 c_waitForProcess _ _ = ioError (ioeSetLocation unsupportedOperation "waitForProcess")
 
+#elif defined(javascript_HOST_ARCH)
+
+-- XXX descriptive argument names
+foreign import javascript unsafe "h$process_terminateProcess"
+  c_terminateProcess
+        :: PHANDLE
+        -> IO Int
+
+foreign import javascript unsafe "h$process_getProcessExitCode"
+  c_getProcessExitCode
+        :: PHANDLE
+        -> Ptr Int
+        -> IO Int
+
+foreign import javascript interruptible "h$process_waitForProcess"
+  c_waitForProcess
+        :: PHANDLE
+        -> Ptr CInt
+        -> IO CInt
+
 #else
 
 foreign import ccall unsafe "terminateProcess"
diff --git a/System/Process/Common.hs b/System/Process/Common.hs
index 18a2482d2e00248e5175fa8d424412b66c6480cc..61f2f1b7d2e296bc8b02890808a7e576f0adc4c6 100644
--- a/System/Process/Common.hs
+++ b/System/Process/Common.hs
@@ -57,6 +57,10 @@ import System.IO.Error
 import Data.Typeable
 import System.IO (IOMode)
 
+#if defined(javascript_HOST_ARCH)
+import GHC.JS.Prim (JSVal)
+#endif
+
 -- We do a minimal amount of CPP here to provide uniform data types across
 -- Windows and POSIX.
 #ifdef WINDOWS
@@ -69,7 +73,9 @@ import System.Win32.Types (HANDLE)
 import System.Posix.Types
 #endif
 
-#ifdef WINDOWS
+#if defined(javascript_HOST_ARCH)
+type PHANDLE = JSVal
+#elif defined(WINDOWS)
 -- Define some missing types for Windows compatibility. Note that these values
 -- will never actually be used, as the setuid/setgid system calls are not
 -- applicable on Windows. No value of this type will ever exist.
@@ -80,7 +86,6 @@ type UserID = CGid
 #else
 type PHANDLE = CPid
 #endif
-
 data CreateProcess = CreateProcess{
   cmdspec      :: CmdSpec,                 -- ^ Executable & arguments, or shell command.  If 'cwd' is 'Nothing', relative paths are resolved with respect to the current working directory.  If 'cwd' is provided, it is implementation-dependent whether relative paths are resolved with respect to 'cwd' or the current working directory, so absolute paths should be used to ensure portability.
   cwd          :: Maybe FilePath,          -- ^ Optional path to the working directory for the new process
@@ -88,8 +93,8 @@ data CreateProcess = CreateProcess{
   std_in       :: StdStream,               -- ^ How to determine stdin
   std_out      :: StdStream,               -- ^ How to determine stdout
   std_err      :: StdStream,               -- ^ How to determine stderr
-  close_fds    :: Bool,                    -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit). This implementation will call close on every fd from 3 to the maximum of open files, which can be slow for high maximum of open files.
-  create_group :: Bool,                    -- ^ Create a new process group
+  close_fds    :: Bool,                    -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit). This implementation will call close on every fd from 3 to the maximum of open files, which can be slow for high maximum of open files. XXX verify what happens with fds in nodejs child processes
+  create_group :: Bool,                    -- ^ Create a new process group. On JavaScript this also creates a new session.
   delegate_ctlc:: Bool,                    -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details).
                                            --
                                            --   @since 1.2.0.0
@@ -101,15 +106,15 @@ data CreateProcess = CreateProcess{
                                            --   Default: @False@
                                            --
                                            --   @since 1.3.0.0
-  new_session :: Bool,                     -- ^ Use posix setsid to start the new process in a new session; does nothing on other platforms.
+  new_session :: Bool,                     -- ^ Use posix setsid to start the new process in a new session; starts process in a new session on JavaScript; does nothing on other platforms.
                                            --
                                            --   @since 1.3.0.0
-  child_group :: Maybe GroupID,            -- ^ Use posix setgid to set child process's group id; does nothing on other platforms.
+  child_group :: Maybe GroupID,            -- ^ Use posix setgid to set child process's group id; works for JavaScript when system running nodejs is posix. does nothing on other platforms.
                                            --
                                            --   Default: @Nothing@
                                            --
                                            --   @since 1.4.0.0
-  child_user :: Maybe UserID,              -- ^ Use posix setuid to set child process's user id; does nothing on other platforms.
+  child_user :: Maybe UserID,              -- ^ Use posix setuid to set child process's user id; works for JavaScript when system running nodejs is posix. does nothing on other platforms.
                                            --
                                            --   Default: @Nothing@
                                            --
@@ -243,12 +248,17 @@ mbFd _   _std CreatePipe      = return (-1)
 mbFd _fun std Inherit         = return std
 mbFd _fn _std NoStream        = return (-2)
 mbFd fun _std (UseHandle hdl) =
-  withHandle fun hdl $ \Handle__{haDevice=dev,..} ->
+  withHandle fun hdl $ \Handle__{haDevice=dev,..} -> do
     case cast dev of
       Just fd -> do
+#if !defined(javascript_HOST_ARCH)
          -- clear the O_NONBLOCK flag on this FD, if it is set, since
          -- we're exposing it externally (see #3316)
          fd' <- FD.setNonBlockingMode fd False
+#else
+         -- on the JavaScript platform we cannot change the FD flags
+         fd' <- pure fd
+#endif
          return (Handle__{haDevice=fd',..}, FD.fdFD fd')
       Nothing ->
           ioError (mkIOError illegalOperationErrorType
diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs
index d48be8b8377cd0c598e3b4b79c0037d73c58303d..97ac68412f21fa9030b2ced01d30bfc02d8d1fca 100644
--- a/System/Process/Internals.hs
+++ b/System/Process/Internals.hs
@@ -45,9 +45,11 @@ module System.Process.Internals (
     waitForJobCompletion,
     timeout_Infinite,
 #else
+#if !defined(javascript_HOST_ARCH)
     pPrPr_disableITimers, c_execvpe,
-    ignoreSignal, defaultSignal,
     runInteractiveProcess_lock,
+#endif
+    ignoreSignal, defaultSignal,
 #endif
     withFilePathException, withCEnvironment,
     translate,
@@ -64,7 +66,9 @@ import System.Posix.Internals (FD)
 
 import System.Process.Common
 
-#ifdef WINDOWS
+#if defined(javascript_HOST_ARCH)
+import System.Process.JavaScript
+#elif defined(WINDOWS)
 import System.Process.Windows
 #else
 import System.Process.Posix
diff --git a/System/Process/JavaScript.hs b/System/Process/JavaScript.hs
new file mode 100644
index 0000000000000000000000000000000000000000..5e89ed1f4eb7baabc76d03465f74c9b81deade60
--- /dev/null
+++ b/System/Process/JavaScript.hs
@@ -0,0 +1,308 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE JavaScriptFFI #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE CPP #-}
+
+{-
+  Child process support for JavaScript running on the node.js platform.
+
+  Other platforms such as browsers will accept the JavaScript code, but all
+  operations will result in unsupported operation exceptions.
+ -}
+
+#include "HsProcessConfig.h"
+
+module System.Process.JavaScript
+    ( mkProcessHandle
+    , translateInternal
+    , createProcess_Internal
+    , withCEnvironment
+    , closePHANDLE
+    , startDelegateControlC
+    , endDelegateControlC
+    , stopDelegateControlC
+    , isDefaultSignal
+    , ignoreSignal
+    , defaultSignal
+    , createPipeInternal
+    , createPipeInternalFd
+    , interruptProcessGroupOfInternal
+    , getProcessId
+    , getCurrentProcessId
+    ) where
+
+import Control.Concurrent.MVar
+import Control.Exception (throwIO)
+
+import Data.Char (isAlphaNum)
+
+import System.Exit
+import System.IO
+import System.IO.Error
+import qualified System.Posix.Internals as Posix
+
+import Foreign.C
+import Foreign.Marshal
+import Foreign.Ptr
+
+import GHC.IO.Handle.FD (mkHandleFromFD)
+import GHC.IO.Device (IODeviceType(..))
+import GHC.IO.Encoding (getLocaleEncoding)
+import GHC.IO.Exception
+import qualified GHC.IO.FD as FD
+
+import GHC.JS.Prim
+
+import System.Process.Common hiding (mb_delegate_ctlc, mbPipe)
+
+mkProcessHandle :: JSVal -> Bool -> IO ProcessHandle
+mkProcessHandle p mb_delegate_ctlc = do
+  m <- newMVar (OpenHandle p)
+  ml <- newMVar ()
+  return (ProcessHandle m mb_delegate_ctlc ml)
+
+closePHANDLE :: JSVal -> IO ()
+closePHANDLE _ = return ()
+
+getProcessId :: PHANDLE -> IO Int
+getProcessId ph =
+  throwErrnoIfMinus1 "getProcessId" (js_getProcessId ph)
+
+getCurrentProcessId :: IO Int
+getCurrentProcessId =
+  throwErrnoIfMinus1 "getCurrentProcessId" js_getCurrentProcessId
+
+startDelegateControlC :: IO ()
+startDelegateControlC =
+  throwErrnoIfMinus1_ "startDelegateControlC" js_startDelegateControlC
+
+stopDelegateControlC :: IO ()
+stopDelegateControlC =
+  throwErrnoIfMinus1_ "stopDelegateControlC" js_stopDelegateControlC
+
+endDelegateControlC :: ExitCode -> IO ()
+endDelegateControlC (ExitFailure (-2)) = throwIO UserInterrupt -- SIGINT
+endDelegateControlC _                  = pure ()
+
+ignoreSignal, defaultSignal :: CLong
+ignoreSignal  = CONST_SIG_IGN
+defaultSignal = CONST_SIG_DFL
+
+isDefaultSignal :: CLong -> Bool
+isDefaultSignal = (== defaultSignal)
+
+interruptProcessGroupOfInternal
+    :: ProcessHandle    -- ^ A process in the process group
+    -> IO ()
+interruptProcessGroupOfInternal ph =
+      withProcessHandle ph $ \p_ -> do
+        case p_ of
+            OpenExtHandle{} -> return ()
+            ClosedHandle  _ -> return ()
+            OpenHandle    h ->
+                throwErrnoIfMinus1_ "interruptProcessGroupOfInternal"
+                                    (js_interruptProcessGroupOf h)
+
+translateInternal :: String -> String
+translateInternal "" = "''"
+translateInternal str
+   -- goodChar is a pessimistic predicate, such that if an argument is
+   -- non-empty and only contains goodChars, then there is no need to
+   -- do any quoting or escaping
+ | all goodChar str = str
+ | otherwise        = '\'' : foldr escape "'" str
+  where escape '\'' = showString "'\\''"
+        escape c    = showChar c
+        goodChar c = isAlphaNum c || c `elem` "-_.,/"
+
+-- node.js does not appear to have any built-in facilities
+-- for creating pipes, so we leave this as an unsupported operation
+-- for now
+createPipeInternal :: IO (Handle, Handle)
+createPipeInternal = ioError
+  (ioeSetLocation unsupportedOperation "createPipeInternal")
+
+createPipeInternalFd :: IO (Posix.FD, Posix.FD)
+createPipeInternalFd = ioError
+  (ioeSetLocation unsupportedOperation "createPipeInternalFd")
+
+withCEnvironment :: [(String,String)] -> (Ptr CString  -> IO a) -> IO a
+withCEnvironment envir act =
+  let env' = map (\(name, val) -> name ++ ('=':val)) envir
+  in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
+
+commandToProcess :: CmdSpec -> IO (FilePath, [String])
+commandToProcess cmd =
+  case cmd of
+    ShellCommand xs   -> c2p (toJSString xs) jsNull
+    RawCommand c args -> c2p (toJSString c) =<< toJSStrings args
+  where
+    c2p c as = do
+      r <- throwErrnoIfJSNull "commandToProcess" (js_commandToProcess c as)
+      fromJSStrings r >>= \case
+        (x:xs) -> pure (x,xs)
+        _      -> error "commandToProcess: empty list"
+
+-- -----------------------------------------------------------------------------
+-- JavaScript nodejs runProcess with signal handling in the child
+
+createProcess_Internal
+  :: String
+       -- ^ Function name (for error messages).
+       --
+       --   This can be any 'String', but will typically be the name of the caller.
+       --   E.g., 'spawnProcess' passes @"spawnProcess"@ here when calling
+       --   'createProcess_'.
+  -> CreateProcess
+  -> IO ProcRetHandles
+createProcess_Internal fun CreateProcess{ cmdspec = cmdsp,
+                                  cwd = mb_cwd,
+                                  env = mb_env,
+                                  std_in = mb_stdin,
+                                  std_out = mb_stdout,
+                                  std_err = mb_stderr,
+                                  close_fds = mb_close_fds,
+                                  create_group = mb_create_group,
+                                  delegate_ctlc = mb_delegate_ctlc,
+                                  new_session = mb_new_session,
+                                  child_user = mb_child_user,
+                                  child_group = mb_child_group }
+ = do
+  (cmd, args) <- commandToProcess cmdsp
+  withFilePathException cmd $ do
+     fdin  <- mbFd fun fd_stdin  mb_stdin
+     fdout <- mbFd fun fd_stdout mb_stdout
+     fderr <- mbFd fun fd_stderr mb_stderr
+     env'  <- maybe (pure jsNull)
+                    (toJSStrings . concatMap (\(x,y) -> [x,y]))
+                    mb_env
+
+     let cwd' = maybe jsNull toJSString mb_cwd
+     let c1 = toJSString cmd
+     c2 <- case args of
+               [] -> return jsNull
+               _  -> toJSStrings args
+
+     r <- throwErrnoIfJSNull fun $
+             js_runInteractiveProcess c1
+                                      c2
+                                      cwd'
+                                      env'
+                                      fdin
+                                      fdout
+                                      fderr
+                                      mb_close_fds
+                                      mb_create_group
+                                      mb_delegate_ctlc
+                                      mb_new_session
+                                      (maybe (-1) fromIntegral mb_child_group)
+                                      (maybe (-1) fromIntegral mb_child_user)
+
+     fdin_r:fdout_r:fderr_r:_ <-
+         map (stdFD . fromIntegral) <$> (fromJSInts =<< getProp r "fds")
+
+     hndStdInput  <- mbPipe mb_stdin  fdin_r  WriteMode
+     hndStdOutput <- mbPipe mb_stdout fdout_r ReadMode
+     hndStdError  <- mbPipe mb_stderr fderr_r ReadMode
+
+     ph <- mkProcessHandle r mb_delegate_ctlc
+     return $ ProcRetHandles { hStdInput = hndStdInput
+                             , hStdOutput = hndStdOutput
+                             , hStdError = hndStdError
+                             , procHandle = ph
+                             }
+
+mbPipe :: StdStream -> FD.FD -> IOMode -> IO (Maybe Handle)
+mbPipe CreatePipe fd mode = do
+  enc <- getLocaleEncoding
+  fmap Just (mkHandleFromFD fd
+                            Stream
+                            ("fd: " ++ show fd)
+                            mode
+                            False {-is_socket-}
+                            (Just enc))
+mbPipe _ _ _ = do
+  return Nothing
+
+stdFD :: CInt -> FD.FD
+stdFD fd = FD.FD { FD.fdFD = fd
+                 , FD.fdIsNonBlocking = 0
+                 }
+
+-- -----------------------------------------------------------------------------
+-- Some helpers for dealing with JavaScript values
+
+-- JavaScript value type synonyms, for readability
+type JSArray  = JSVal
+type JSString = JSVal
+
+fromJSStrings :: JSVal -> IO [String]
+fromJSStrings x = fmap (map fromJSString) (fromJSArray x)
+
+fromJSInts :: JSVal -> IO [Int]
+fromJSInts x = map fromJSInt <$> fromJSArray x
+
+toJSStrings :: [String] -> IO JSVal
+toJSStrings xs = toJSArray (map toJSString xs)
+
+throwErrnoIfJSNull :: String -> IO JSVal -> IO JSVal
+throwErrnoIfJSNull msg m = do
+  r <- m
+  if isNull r then throwErrno msg
+              else return r
+
+-- -----------------------------------------------------------------------------
+-- Foreign imports from process.js
+
+-- run an interactive process. Note that this foreign import is asynchronous
+-- (interruptible) since it waits until the process has spawned (or an error
+-- has occurred.
+--
+-- this should only be a short time, so it should be safe to call this from
+-- an uninterruptible mask.
+
+foreign import javascript interruptible "h$process_runInteractiveProcess"
+  js_runInteractiveProcess
+        :: JSString     -- ^ command or program
+        -> JSArray      -- ^ arguments, null if it's a raw command
+        -> JSString     -- ^ working dir, null for current
+        -> JSArray      -- ^ environment, null for existing
+        -> CInt         -- ^ stdin fd
+        -> CInt         -- ^ stdout fd
+        -> CInt         -- ^ stderr fd
+        -> Bool         -- ^ close file descriptors in child (currently unsupported)
+        -> Bool         -- ^ create a new process group
+        -> Bool         -- ^ delegate ctrl-c
+        -> Bool         -- ^ create a new session
+        -> Int          -- ^ set child GID (-1 for unchanged)
+        -> Int          -- ^ set child UID (-1 for unchanged)
+        -> IO JSVal     -- ^ process handle (null if an error occurred)
+
+foreign import javascript safe "h$process_commandToProcess"
+  js_commandToProcess
+        :: JSString
+        -> JSArray
+        -> IO JSArray
+
+foreign import javascript unsafe "h$process_interruptProcessGroupOf"
+  js_interruptProcessGroupOf
+        :: PHANDLE
+        -> IO Int
+
+foreign import javascript unsafe "h$process_startDelegateControlC"
+  js_startDelegateControlC
+        :: IO Int
+
+foreign import javascript unsafe "h$process_stopDelegateControlC"
+  js_stopDelegateControlC
+        :: IO Int
+
+foreign import javascript unsafe "h$process_getCurrentProcessId"
+  js_getCurrentProcessId
+        :: IO Int
+
+foreign import javascript unsafe "h$process_getProcessId"
+  js_getProcessId
+        :: PHANDLE
+        -> IO Int
diff --git a/jsbits/process.js b/jsbits/process.js
new file mode 100644
index 0000000000000000000000000000000000000000..f4049b63c2c40aca3d30419b2bb8b67d642e4c55
--- /dev/null
+++ b/jsbits/process.js
@@ -0,0 +1,585 @@
+//#OPTIONS: CPP
+// XXX do we need this?
+#include "HsBaseConfig.h"
+
+// #define JS_TRACE_PROCESS 1
+
+#ifdef JS_TRACE_PROCESS
+function h$logProcess() { h$log.apply(h$log,arguments); }
+#define TRACE_PROCESS(args...) h$logProcess(args)
+#else
+#define TRACE_PROCESS(args...)
+#endif
+
+/*
+   Convert from a string signal name to a signal number.
+
+   To ensure consistent signal numbers between platforms we use signal
+   numbers from the emscripten SDK whenever we use a numeric signal code.
+
+   These might differ from the actual numbers of the operating system
+   on which the nodejs process is running.
+
+   list from emscripten /system/lib/libc/musl/arch/emscripten/bits/signal.h
+
+   Note: we should possibly move this into the base or rts package in the future
+  */
+var h$process_signals = {
+    'SIGHUP': 1,
+    'SIGINT': 2,
+    'SIGQUIT': 3,
+    'SIGILL': 4,
+    'SIGTRAP': 5,
+    'SIGABRT': 6,
+    'SIGIOT': 6,
+    'SIGBUS': 7,
+    'SIGFPE': 8,
+    'SIGKILL': 9,
+    'SIGUSR1': 10,
+    'SIGSEGV': 11,
+    'SIGUSR2': 12,
+    'SIGPIPE': 13,
+    'SIGALRM': 14,
+    'SIGTERM': 15,
+    'SIGSTKFLT': 16,
+    'SIGCHLD': 17,
+    'SIGCONT': 18,
+    'SIGSTOP': 19,
+    'SIGTSTP': 20,
+    'SIGTTIN': 21,
+    'SIGTTOU': 22,
+    'SIGURG': 23,
+    'SIGXCPU': 24,
+    'SIGXFSZ': 25,
+    'SIGVTALRM': 26,
+    'SIGPROF': 27,
+    'SIGWINCH': 28,
+    'SIGIO': 29,
+    'SIGPOLL': 29,
+    'SIGPWR': 30,
+    'SIGSYS': 31,
+    'SIGUNUSED': 31
+};
+
+/*
+   Create a one-directional pipe for communication with the child process
+
+     - pipe: a Readable or Writable stream from spawning the child process
+     - write: boolean - true if the pipe is for writing, false for reading
+ */
+function h$process_pipeFd(pipe, write) {
+    var fdN = h$base_fdN--, fd = {};
+    h$base_fds[fdN] = fd;
+    TRACE_PROCESS("pipe", fdN, "opened, writable:", write);
+
+    if(pipe && pipe._handle && typeof pipe._handle.fd === 'number') fd.fd = pipe._handle.fd;
+    TRACE_PROCESS("pipe real fd", fd.fd);
+
+    if(write) {
+        fd.err   = null;
+        fd.waiting = new h$Queue();
+        fd.close = function(fd, fdo, c) { delete h$base_fds[fd]; pipe.end(); c(0); };
+        fd.refs = 1;
+        pipe.on('error', function(err) {
+            TRACE_PROCESS("pipe received error", fd, err);
+            fd.err = err;
+        });
+        fd.write = function(fd, fdo, buf, buf_offset, n, c)  {
+            TRACE_PROCESS("pipe ", fd, " write:", n);
+            if(fdo.err) {
+                TRACE_PROCESS("pipe error", fdo.err);
+                h$setErrno(fdo.err);
+                c(-1);
+                return;
+            }
+            var nbuf = buf.u8.slice(buf_offset, buf_offset+n);
+            var r = pipe.write(nbuf, function() {
+                TRACE_PROCESS("pipe", fd, "flushed");
+                c(n);
+            });
+            TRACE_PROCESS("pipe write", fd, "result", r);
+        }
+    } else {
+        fd.close      = function(fd, fdo, c) { delete h$base_fds[fd]; c(0); }
+        fd.refs       = 1;
+        fd.waiting    = new h$Queue();
+        fd.chunk      = { buf: null, pos: 0, processing: false };
+        fd.eof        = false;
+        fd.err        = null;
+        fd.reading    = false;
+
+        pipe.on('end', function() {
+            TRACE_PROCESS("pipe", fdN, fd.fd, "eof");
+            fd.eof = true;
+            h$process_process_pipe(fd, pipe);
+        });
+        pipe.on('error', function(err) {
+            TRACE_PROCESS("pipe received error", fdN, fd.fd);
+            fd.err = err;
+            h$process_process_pipe(fd, pipe);
+        });
+        fd.read = function(fd, fdo, buf, buf_offset, n, c) {
+            if(!fdo.reading) {
+                /*
+                   Reading is a blocking operation (asynchronous) from the Haskell
+                   side. On the JavaScript side we rely on the 'readable' event to
+                   know when there is available data. Every time data comes in we
+                   process the queue of waiting read requests.
+
+                   We don't attach the 'readable' event handler until we actually
+                   read from the pipe, since the readable handler causes the node.js
+                   process to start buffering data from the file descriptor.
+
+                   If we don't read from the file descriptor it is unaffected by
+                   node.js buffering and we can for example pass it to another child
+                   process to allow direct communication between multiple child
+                   processes.
+                 */
+                pipe.on('readable', function() {
+                    TRACE_PROCESS("pipe", fdN, fd.fd, "readable");
+                    h$process_process_pipe(fdo, pipe);
+                });
+                fdo.reading = true;
+                h$process_process_pipe(fdo, pipe);
+            }
+            TRACE_PROCESS("pipe", fdN, fd.fd, "read", n, fdo.chunk.buf);
+            fdo.waiting.enqueue({buf: buf, off: buf_offset, n: n, c: c});
+            h$process_process_pipe(fdo, pipe);
+        }
+    }
+    TRACE_PROCESS("created pipe, fd:", fdN);
+    return fdN;
+}
+
+/*
+    Process the queue of waiting read/write requests for a pipe
+ */
+function h$process_process_pipe(fd, pipe) {
+    var c = fd.chunk;
+    var q = fd.waiting;
+    TRACE_PROCESS("processing pipe", fd);
+    if(!q || !q.length() || c.processing) return;
+    c.processing = true;
+    while(fd.err && q.length()) {
+        h$setErrno(fd.err);
+        q.dequeue().c(-1);
+    }
+    if(!c.buf) {
+        c.pos = 0;
+        c.buf = pipe.read();
+    }
+    while(c.buf && q.length()) {
+        var x = q.dequeue();
+        var n = Math.min(c.buf.length - c.pos, x.n);
+        for(var i=0;i<n;i++) {
+            x.buf.u8[i+x.off] = c.buf[c.pos+i];
+        }
+        c.pos += n;
+        x.c(n);
+        // XXX this does reorder the requests if data comes in small chunks
+        if(c.pos >= c.buf.length) c.buf = null;
+        if(!c.buf && q.length()) {
+            c.pos = 0;
+            c.buf = pipe.read();
+        }
+    }
+    while(fd.eof && q.length()) q.dequeue().c(0);
+    TRACE_PROCESS("done processing pipe, remaining queue", q.length());
+    c.processing = false;
+}
+
+/*
+    Start an interactive child process using the node.js child_prcess.spawn
+    functionality.
+
+    Even though this is mostly a non-blocking operation (we don't wait until
+    the child process has finished), this is an asynchronous function
+    (with a continuation) because we want to wait until the child process has
+    spawned before we resume the Haskell thread.
+
+    This allows us to raise exceptions if the process could not be started, for
+    example becaus of permission errors or a non-existent executable.
+
+    Calls the continuation with a process object, or null when spawning the
+    process has failed, after setting h$errno to the appropriate value.
+ */
+function h$process_runInteractiveProcess(
+      cmd           // string  - command to run
+    , args          // array of strings - arguments
+    , workingDir    // string  - working directory, null: unchanged
+    , env           // array of strings - environment [ key1, val1, key2, val2, ...]
+                    //                         null: inherit
+    , stdin_fd      // number   - stdin fd, -1: createpipe, -2: ignore
+    , stdout_fd     // number   - stdout fd, -1: createpipe, -2: ignore
+    , stderr_fd     // number   - stderr fd, -1: createpipe, -2: ignore
+    , _closeFds     // boolean  - close file descriptors in child (ignored)
+    , createGroup   // boolean  - create a new process group
+    , delegateCtlC  // boolean  - delegate control-C handling
+    , newSession    // boolean  - use posix setsid to start the process in a new session
+    , childGID      // number   - child group id, -1 for unchanged
+    , childUID      // number   - child user id, -1 for unchanged
+    , c             // function - continuation, called when the process has spawned
+    ) {
+    TRACE_PROCESS("runInteractiveProcess");
+    TRACE_PROCESS("cmd: ", cmd, " args: ", args);
+    TRACE_PROCESS("workingDir: ", workingDir, " env: ", env);
+    TRACE_PROCESS("stdin", stdin_fd, "stdout", stdout_fd, "stderr", stderr_fd);
+
+    if(h$isNode()) {
+        try {
+            var stdin_p, stdout_p, stderr_p;
+
+            function getStream(pos, spec) {
+                // CreatePipe
+                if(spec === -1) return 'pipe';
+
+                // NoStream
+                if(spec === -2) return 'ignore';
+
+                // standard streams
+                if(spec === 0) return spec == pos ? 'inherit' : process.stdin;
+                if(spec === 1) return spec == pos ? 'inherit' : process.stdout;
+                if(spec === 2) return spec == pos ? 'inherit' : process.stderr;
+
+                // registered fd
+                var stream = h$base_fds[spec];
+                if(typeof stream.fd === 'number') return stream.fd;
+
+                // raw fd
+                if(typeof spec === 'number' && spec > 0) return spec;
+
+                // unsupported stream type
+                // the exception is caught and converted to an errno status code below
+                throw new Error('EBADF');
+            }
+
+            stdin_p = getStream(0, stdin_fd);
+            stdout_p = getStream(1, stdout_fd);
+            stderr_p = getStream(2, stderr_fd);
+
+            var options = { detached: newSession || createGroup
+                          , stdio: [stdin_p, stdout_p, stderr_p]
+                          };
+            if(workingDir !== null) options.cwd = workingDir;
+            if(env !== null) {
+                var envObj = {};
+                for(var i=0;i<env.length;i+=2) envObj[env[i]] = env[i+1];
+                TRACE_PROCESS("environment: " + h$collectProps(envObj));
+                options.env = envObj;
+            }
+            if(childGID !== -1) options.gid = childGID;
+            if(childUID !== -1) options.uid = childUID;
+
+            var procObj;
+            var child;
+
+            // node.js on Windows x86 sometimes throw an EBADF exception when
+            // process.stdin is invalid, retry with ignored stdin when
+            // this happens.
+            TRACE_PROCESS("spawning process", cmd, args, options);
+
+            try {
+                child = h$child.spawn(cmd, args, options);
+            } catch(e) {
+                TRACE_PROCESS("spawning exception", e);
+
+                if(e.toString().indexOf('EBADF') !== -1 && options.stdio[0] === process.stdin) {
+                    options.stdio[0] = 'ignore';
+                    child = h$child.spawn(cmd, args, options);
+                } else {
+                    throw e;
+                }
+            }
+            TRACE_PROCESS("spawn done, setting handlers");
+
+            // keep track of whether the process has spawned, since we can get
+            // multiple events for this and we only want to call the continuation
+            // once.
+            var spawned = false;
+
+            child.on('exit', function(code, sig) {
+                TRACE_PROCESS("process finished", code, sig);
+                // if the spawn event hasn't fired we still have to call
+                // the continuation for that
+                if(!spawned) {
+                    spawned = true;
+                    c(procObj);
+                } else {
+                    if(delegateCtlC) {
+                        h$process_stopDelegateControlC();
+                    }
+                }
+                if(code === null) {
+                    // process was killed by a signal
+                    var signo = h$process_signals[sig] || 31;
+                    // The Haskell side expects a negative status if killed
+                    // by a signal
+                    code = -signo;
+                }
+                procObj.exit = code;
+
+                // notify all threads that are waiting for the exit code
+                for(var i=0;i<procObj.waiters.length;i++) {
+                    procObj.waiters[i](code);
+                }
+            });
+
+            child.on('spawn', function() {
+                TRACE_PROCESS("process spawned");
+                if(!spawned) {
+                    if(delegateCtlC) {
+                        h$process_startDelegateControlC();
+                    }
+                    spawned = true;
+                    c(procObj);
+                }
+            });
+
+            child.on('error', function(e) {
+                TRACE_PROCESS("process errored:", e);
+                if(!spawned) {
+                    // if the process hasn't spawned yet we can raise an exception
+                    // immediately
+
+                    // prevent subsequent calls to the continuation
+                    spawned = true;
+
+                    h$setErrno(e);
+                    c(null);
+                } else {
+                    /*
+                       Convert the node.js status code string to the appropriate
+                       (emscripten SDK) numeric error code.
+
+                       We should add a way to get the error code from the
+                       string without modifying the global h$errno value
+                     */
+                    var currentErrno = h$errno;
+                    h$setErrno(e.code);
+                    var code = h$errno;
+                    h$errno = currentErrno;
+
+                    procObj.exit = code;
+                    for(var i=0;i<procObj.waiters.length;i++) {
+                        procObj.waiters[i](code);
+                    }
+                }
+            });
+
+            procObj = {  fds: [ stdin_fd  === -1 ? h$process_pipeFd(child.stdio[0], true)  : null
+                              , stdout_fd === -1 ? h$process_pipeFd(child.stdio[1], false) : null
+                              , stderr_fd === -1 ? h$process_pipeFd(child.stdio[2], false) : null
+                              ]
+                        , exit: null
+                        , waiters : []
+                        , child: child
+                    };
+            TRACE_PROCESS("process object created:", procObj);
+
+            // sometimes the process has already spawned before we attach the 'spawn` event handler,
+            // check here if it already has a pid and immediately call the continuation if that's the
+            // case
+            if(typeof child.pid === 'number') {
+                TRACE_PROCESS("process spawned immediately", child.pid);
+
+                spawned = true;
+                c(procObj);
+            }
+
+        } catch(e) {
+            TRACE_PROCESS("catch:", e);
+            spawned = true;
+            h$setErrno(e);
+            c(null);
+        }
+    } else { // h$isNode
+        h$unsupported(null, c);
+    }
+}
+
+/*
+  return the thing to run as an array, first element the process,
+  followed by the the args. null if no interpreter can be found
+
+    - cmd: string - the command to run
+    - args: array of string - arguments, null to run cmd as a shell command
+              in an interpreter.
+ */
+function h$process_commandToProcess(cmd, args) {
+    if(h$isNode()) {
+        TRACE_PROCESS("commandToProcess: ", cmd, args);
+        if(process.platform === 'win32') {
+            if(args === null) { // shellcmd
+                var com = process.env['COMSPEC'];
+                /*
+                   Note: The old GHCJS code had a fallback using code from
+                         the directory package (h$directory_findExecutables).
+                         Here we just produce an error if COMSPEC is not set,
+                         since we don't have the code from the directory package
+                         available.
+                         If needed we could implement similar functionality here.
+                  */
+                if(!com) {
+                    h$setErrno('ENOENT');
+                    return null;
+                }
+                // XXX need to escape stuff
+                return [com, " /c " + cmd];
+            } else {
+                // XXX need to escape stuff
+                var r = [cmd];
+                r = r.concat(args);
+                return r;
+            }
+        } else {  // non-windows
+            if(args === null) { // shellcmd
+                return ["/bin/sh", "-c", cmd];
+            } else {
+                var r = [cmd];
+                r = r.concat(args);
+                return r;
+            }
+        }
+    } else {
+        return h$unsupported(null);
+    }
+}
+/*
+  Send the SIGTERM signal to the child process
+ */
+function h$process_terminateProcess(ph) {
+    TRACE_PROCESS("terminateProcess", ph);
+    if(h$isNode()) {
+        ph.child.kill();
+        return 0;
+    } else {
+        return h$unsupported(1);
+    }
+}
+
+/*
+   Get the process exit code. Does not block.
+
+      - returns 0 if the process has not exited yet.
+      - returns 1 and saves the exit code in the code_d pointer otherwise
+ */
+function h$process_getProcessExitCode(ph, code_d, code_o) {
+    TRACE_PROCESS("getProcessExitCode", ph);
+    if(ph.exit === null) return 0;
+    code_d.i3[code_o>>2] = ph.exit;
+    return 1;
+}
+
+/*
+    Wait for the process to finish and return the exit code.
+ */
+function h$process_waitForProcess(ph, code_d, code_o, c) {
+    TRACE_PROCESS("waitForProcess", ph);
+    if(h$isNode()) {
+        if(ph.exit !== null) {
+            h$process_getProcessExitCode(ph, code_d, code_o);
+            c(0);
+        } else {
+            ph.waiters.push(function(code) {
+		        code_d.i3[code_o>>2] = code;
+		        c(0);
+	        });
+        }
+    } else {
+        h$unsupported(-1, c);
+    }
+}
+
+function h$process_interruptProcessGroupOf(ph) {
+    TRACE_PROCESS("interruptProcessGroupOf", ph);
+    if(h$isNode()) {
+        // there doesn't appear to be a way to find the process
+        // group id from a process id (ph.child.pid) on nodejs,
+        // so this operation is unsupported.
+        return h$unsupported(-1);
+    } else {
+        return h$unsupported(-1);
+    }
+}
+
+var h$process_delegateControlCCount = 0;
+
+/*
+  We install a signal handler that ignores SIGINT/SIGQUIT while
+  delegating ctl-c handling.
+
+  This keeps the current node.js process running and propagates the
+  signal to the child processes in the same group.
+ */
+function h$process_ignoreSIG() {
+    TRACE_PROCESS("process_ignoreSIG: ignoring signal");
+    return 0;
+}
+
+/*
+   Start delegating ctl-c handling. Installs the above handler if this is the
+   first process for which delegation is needed.
+ */
+function h$process_startDelegateControlC() {
+    TRACE_PROCESS("startDelegateControlC", h$process_delegateControlCCount);
+    if(h$isNode()) {
+        if(h$process_delegateControlCCount === 0) {
+            TRACE_PROCESS("startDelegateControlC: installing handler")
+            process.on('SIGINT', h$process_ignoreSIG);
+            process.on('SIGQUIT', h$process_ignoreSIG);
+
+        }
+        h$process_delegateControlCCount++;
+        return 0;
+    } else {
+        return h$unsupported(-1);
+    }
+}
+
+/*
+   Stop delegating ctrl-c handling. Removes the above handler if this is the
+   last process for which delegation is needed.
+ */
+function h$process_stopDelegateControlC() {
+    TRACE_PROCESS("stopDelegateControlC", h$process_delegateControlCCount);
+    if(h$isNode()) {
+        if(h$process_delegateControlCCount > 0) {
+            h$process_delegateControlCCount--;
+            if(h$process_delegateControlCCount === 0) {
+                TRACE_PROCESS("stopDelegateControlC: removing handler")
+                process.off('SIGINT', h$process_ignoreSIG);
+                process.off('SIGQUIT', h$process_ignoreSIG);
+            }
+        }
+        return 0;
+    } else {
+        return h$unsupported(-1);
+    }
+}
+
+/*
+   Get the process id of the current (node.js) process
+ */
+function h$process_getCurrentProcessId() {
+    TRACE_PROCESS("getCurrentProcessId");
+    if(h$isNode()) {
+        return process.pid;
+    } else {
+        return h$unsupported(-1);
+    }
+}
+
+/*
+   Get the process id of a child process
+ */
+function h$process_getProcessId(ph) {
+    TRACE_PROCESS("getProcessId", ph);
+    if(ph && typeof ph === 'object' &&
+       ph.child && typeof ph.child == 'object' &&
+       typeof ph.child.pid == 'number') {
+        return ph.child.pid;
+    } else {
+        h$setErrno('EBADF');
+        return -1;
+    }
+}
diff --git a/process.cabal b/process.cabal
index fe7564e17c089ad396b0f889f9604f164b38868a..c37b652c712e419f879612dfd950123aa4cc8c1d 100644
--- a/process.cabal
+++ b/process.cabal
@@ -64,13 +64,18 @@ library
         extra-libraries: kernel32, ole32, rpcrt4
         cpp-options: -DWINDOWS
     else
-        c-sources:
-            cbits/posix/runProcess.c
-            cbits/posix/fork_exec.c
-            cbits/posix/posix_spawn.c
-            cbits/posix/find_executable.c
-        other-modules: System.Process.Posix
-        build-depends: unix >= 2.5 && < 2.9
+        if arch(javascript)
+            js-sources:
+                jsbits/process.js
+            other-modules: System.Process.JavaScript
+        else
+            c-sources:
+                cbits/posix/runProcess.c
+                cbits/posix/fork_exec.c
+                cbits/posix/posix_spawn.c
+                cbits/posix/find_executable.c
+            other-modules: System.Process.Posix
+            build-depends: unix >= 2.5 && < 2.9
 
     include-dirs: include
     includes: