summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
Diffstat (limited to 'utils')
-rw-r--r--utils/iserv-proxy/Makefile15
-rw-r--r--utils/iserv-proxy/ghc.mk113
-rw-r--r--utils/iserv-proxy/iserv-proxy.cabal78
-rw-r--r--utils/iserv-proxy/src/Main.hs262
-rw-r--r--utils/iserv/Makefile15
-rw-r--r--utils/iserv/cbits/iservmain.c17
-rw-r--r--utils/iserv/ghc.mk113
-rw-r--r--utils/iserv/iserv.cabal44
-rw-r--r--utils/iserv/src/Main.hs63
9 files changed, 720 insertions, 0 deletions
diff --git a/utils/iserv-proxy/Makefile b/utils/iserv-proxy/Makefile
new file mode 100644
index 0000000000..f160978c19
--- /dev/null
+++ b/utils/iserv-proxy/Makefile
@@ -0,0 +1,15 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+dir = iserv
+TOP = ..
+include $(TOP)/mk/sub-makefile.mk
diff --git a/utils/iserv-proxy/ghc.mk b/utils/iserv-proxy/ghc.mk
new file mode 100644
index 0000000000..b90a96a1fa
--- /dev/null
+++ b/utils/iserv-proxy/ghc.mk
@@ -0,0 +1,113 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009-2012 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/iserv-proxy_USES_CABAL = YES
+utils/iserv-proxy_PACKAGE = iserv-proxy
+utils/iserv-proxy_EXECUTABLE = iserv-proxy
+
+ifeq "$(GhcDebugged)" "YES"
+utils/iserv-proxy_stage2_MORE_HC_OPTS += -debug
+utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -debug
+utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -debug
+endif
+
+ifeq "$(GhcThreaded)" "YES"
+utils/iserv-proxy_stage2_MORE_HC_OPTS += -threaded
+utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -threaded
+utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -threaded
+endif
+
+# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
+# refer to the RTS. This is harmless if you don't use it (adds a bit
+# of overhead to startup and increases the binary sizes) but if you
+# need it there's no alternative.
+ifeq "$(TargetElf)" "YES"
+ifneq "$(TargetOS_CPP)" "solaris2"
+# The Solaris linker does not support --export-dynamic option. It also
+# does not need it since it exports all dynamic symbols by default
+utils/iserv-proxy_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+endif
+endif
+
+# Override the default way, because we want a specific version of this
+# program for each way. Note that it's important to do this even for
+# the vanilla version, otherwise we get a dynamic executable when
+# DYNAMIC_GHC_PROGRAMS=YES.
+utils/iserv-proxy_stage2_PROGRAM_WAY = v
+utils/iserv-proxy_stage2_p_PROGRAM_WAY = p
+utils/iserv-proxy_stage2_dyn_PROGRAM_WAY = dyn
+
+utils/iserv-proxy_stage2_PROGNAME = ghc-iserv
+utils/iserv-proxy_stage2_p_PROGNAME = ghc-iserv-prof
+utils/iserv-proxy_stage2_dyn_PROGNAME = ghc-iserv-dyn
+
+utils/iserv-proxy_stage2_MORE_HC_OPTS += -no-hs-main
+utils/iserv-proxy_stage2_p_MORE_HC_OPTS += -no-hs-main
+utils/iserv-proxy_stage2_dyn_MORE_HC_OPTS += -no-hs-main
+
+utils/iserv-proxy_stage2_INSTALL = YES
+utils/iserv-proxy_stage2_p_INSTALL = YES
+utils/iserv-proxy_stage2_dyn_INSTALL = YES
+
+# Install in $(libexec), not in $(bindir)
+utils/iserv-proxy_stage2_TOPDIR = YES
+utils/iserv-proxy_stage2_p_TOPDIR = YES
+utils/iserv-proxy_stage2_dyn_TOPDIR = YES
+
+utils/iserv-proxy_stage2_INSTALL_INPLACE = YES
+utils/iserv-proxy_stage2_p_INSTALL_INPLACE = YES
+utils/iserv-proxy_stage2_dyn_INSTALL_INPLACE = YES
+
+ifeq "$(CLEANING)" "YES"
+
+NEED_iserv = YES
+NEED_iserv_p = YES
+NEED_iserv_dyn = YES
+
+else
+
+ifneq "$(findstring v, $(GhcLibWays))" ""
+NEED_iserv = YES
+else
+NEED_iserv = NO
+endif
+
+ifneq "$(findstring p, $(GhcLibWays))" ""
+NEED_iserv_p = YES
+else
+NEED_iserv_p = NO
+endif
+
+ifneq "$(findstring dyn, $(GhcLibWays))" ""
+NEED_iserv_dyn = YES
+else
+NEED_iserv_dyn = NO
+endif
+endif
+
+ifeq "$(NEED_iserv)" "YES"
+$(eval $(call build-prog,utils/iserv-proxy,stage2,1))
+endif
+
+ifeq "$(NEED_iserv_p)" "YES"
+$(eval $(call build-prog,utils/iserv-proxy,stage2_p,1))
+endif
+
+ifeq "$(NEED_iserv_dyn)" "YES"
+$(eval $(call build-prog,utils/iserv-proxy,stage2_dyn,1))
+endif
+
+all_ghc_stage2 : $(iserv-proxy-stage2_INPLACE)
+all_ghc_stage2 : $(iserv-proxy-stage2_p_INPLACE)
+all_ghc_stage2 : $(iserv-proxy-stage2_dyn_INPLACE)
diff --git a/utils/iserv-proxy/iserv-proxy.cabal b/utils/iserv-proxy/iserv-proxy.cabal
new file mode 100644
index 0000000000..1d1a2d499f
--- /dev/null
+++ b/utils/iserv-proxy/iserv-proxy.cabal
@@ -0,0 +1,78 @@
+Name: iserv-proxy
+Version: 8.5
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: iserv allows GHC to delegate Tempalte Haskell computations
+Description:
+ GHC can be provided with a path to the iserv binary with
+ @-pgmi=/path/to/iserv-bin@, and will in combination with
+ @-fexternal-interpreter@, compile Template Haskell though the
+ @iserv-bin@ delegate. This is very similar to how ghcjs has been
+ compiling Template Haskell, by spawning a separate delegate (so
+ called runner on the javascript vm) and evaluating the splices
+ there.
+ .
+ iserv can also be used in combination with cross compilation. For
+ this, the @iserv-proxy@ needs to be built on the host, targeting the
+ host (as it is running on the host). @cabal install -flibrary
+ -fproxy@ will yield the proxy.
+ .
+ Using the cabal for the target @arch-platform-target-cabal install
+ -flibrary@ will build the required library that contains the ffi
+ @startSlave@ function, which needs to be invoked on the target
+ (e.g. in an iOS application) to start the remote iserv slave.
+ .
+ calling the GHC cross compiler with @-fexternal-interpreter
+ -pgmi=$HOME/.cabal/bin/iserv-proxy -opti\<ip address\> -opti\<port\>@
+ will cause it to compile Template Haskell via the remote at \<ip address\>.
+ .
+ Thus to get cross compilation with Template Haskell follow the
+ following receipt:
+ .
+ * compile the iserv library for your target
+ .
+ > iserv $ arch-platform-target-cabal install -flibrary
+ .
+ * setup an application for your target that calls the
+ * startSlave function. This could be either haskell or your
+ * targets ffi capable language, if needed.
+ .
+ > void startSlave(false /* verbose */, 5000 /* port */,
+ > "/path/to/storagelocation/on/target");
+ .
+ * build the iserv-proxy
+ .
+ > iserv $ cabal install -flibrary -fproxy
+ * Start your iserv-slave app on your target running on say @10.0.0.1:5000@
+ * compiler your sources with -fexternal-interpreter and the proxy
+ .
+ > project $ arch-platform-target-ghc ModuleContainingTH.hs \
+ > -fexternal-interpreter \
+ > -pgmi=$HOME/.cabal/bin/iserv-proxy \
+ > -opti10.0.0.1 -opti5000
+ .
+ Should something not work as expected, provide @-opti-v@ for verbose
+ logging of the @iserv-proxy@.
+
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable iserv-proxy
+ Default-Language: Haskell2010
+ Main-Is: Main.hs
+ Hs-Source-Dirs: src
+ Build-Depends: array >= 0.5 && < 0.6,
+ base >= 4 && < 5,
+ binary >= 0.7 && < 0.9,
+ bytestring >= 0.10 && < 0.11,
+ containers >= 0.5 && < 0.6,
+ deepseq >= 1.4 && < 1.5,
+ ghci == 8.5,
+ directory >= 1.3 && < 1.4,
+ network >= 2.6,
+ filepath >= 1.4 && < 1.5,
+ libiserv == 8.5
diff --git a/utils/iserv-proxy/src/Main.hs b/utils/iserv-proxy/src/Main.hs
new file mode 100644
index 0000000000..c91b2d08c6
--- /dev/null
+++ b/utils/iserv-proxy/src/Main.hs
@@ -0,0 +1,262 @@
+{-# LANGUAGE CPP, GADTs, OverloadedStrings #-}
+
+{-
+This is the proxy portion of iserv.
+
+It acts as local bridge for GHC to call
+a remote slave. This all might sound
+confusing, so let's try to get some
+naming down.
+
+GHC is the actual Haskell compiler, that
+acts as frontend to the code to be compiled.
+
+iserv is the slave, that GHC delegates compilation
+of TH to. As such it needs to be compiled for
+and run on the Target. In the special case
+where the Host and the Target are the same,
+no proxy is needed. GHC and iserv communicate
+via pipes.
+
+iserv-proxy is the proxy instance to iserv.
+The following illustration should make this
+somewhat clear:
+
+ .----- Host -----. .- Target -.
+ | GHC <--> proxy<+-----+> iserv |
+ '----------------' ^ '----------'
+ ^ |
+ | '-- communication via sockets
+ '--- communication via pipes
+
+For now, we won't support multiple concurrent
+invocations of the proxy instance, and that
+behavior will be undefined, as this largely
+depends on the capability of the iserv on the
+target to spawn multiple process. Spawning
+multiple threads won't be sufficient, as the
+GHC runtime has global state.
+
+Also the GHC runtime needs to be able to
+use the linker on the Target to link archives
+and object files.
+
+-}
+
+module Main (main) where
+
+import System.IO
+import GHCi.Message
+import GHCi.Utils
+import GHCi.Signals
+
+import Remote.Message
+
+import Network.Socket
+import Data.IORef
+import Control.Monad
+import System.Environment
+import System.Exit
+import Text.Printf
+import GHC.Fingerprint (getFileHash)
+import System.Directory
+import System.FilePath (isAbsolute)
+
+import Data.Binary
+import qualified Data.ByteString as BS
+
+dieWithUsage :: IO a
+dieWithUsage = do
+ prog <- getProgName
+ die $ prog ++ ": " ++ msg
+ where
+#if defined(WINDOWS)
+ msg = "usage: iserv <write-handle> <read-handle> <slave ip> [-v]"
+#else
+ msg = "usage: iserv <write-fd> <read-fd> <slave ip> [-v]"
+#endif
+
+main :: IO ()
+main = do
+ args <- getArgs
+ (wfd1, rfd2, host_ip, port, rest) <-
+ case args of
+ arg0:arg1:arg2:arg3:rest -> do
+ let wfd1 = read arg0
+ rfd2 = read arg1
+ ip = arg2
+ port = read arg3
+ return (wfd1, rfd2, ip, port, rest)
+ _ -> dieWithUsage
+
+ verbose <- case rest of
+ ["-v"] -> return True
+ [] -> return False
+ _ -> dieWithUsage
+
+ when verbose $
+ printf "GHC iserv starting (in: %d; out: %d)\n"
+ (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
+ inh <- getGhcHandle rfd2
+ outh <- getGhcHandle wfd1
+ installSignalHandlers
+ lo_ref <- newIORef Nothing
+ let in_pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}
+
+ when verbose $
+ putStrLn ("Trying to connect to " ++ host_ip ++ ":" ++ (show port))
+ out_pipe <- connectTo host_ip port >>= socketToPipe
+
+ putStrLn "Starting proxy"
+ proxy verbose in_pipe out_pipe
+
+-- | A hook, to transform outgoing (proxy -> slave)
+-- messages prior to sending them to the slave.
+hook :: Msg -> IO Msg
+hook = return
+
+-- | Forward a single @THMessage@ from the slave
+-- to ghc, and read back the result from GHC.
+--
+-- @Message@s go from ghc to the slave.
+-- ghc --- proxy --> slave (@Message@)
+-- @THMessage@s go from the slave to ghc
+-- ghc <-- proxy --- slave (@THMessage@)
+--
+fwdTHMsg :: (Binary a) => Pipe -> THMessage a -> IO a
+fwdTHMsg local msg = do
+ writePipe local (putTHMessage msg)
+ readPipe local get
+
+-- | Fowarard a @Message@ call and handle @THMessages@.
+fwdTHCall :: (Binary a) => Bool -> Pipe -> Pipe -> Message a -> IO a
+fwdTHCall verbose local remote msg = do
+ writePipe remote (putMessage msg)
+ -- wait for control instructions
+ loopTH
+ readPipe remote get
+ where
+ loopTH :: IO ()
+ loopTH = do
+ THMsg msg' <- readPipe remote getTHMessage
+ when verbose $
+ putStrLn ("| TH Msg: ghc <- proxy -- slave: " ++ show msg')
+ res <- fwdTHMsg local msg'
+ when verbose $
+ putStrLn ("| Resp.: ghc -- proxy -> slave: " ++ show res)
+ writePipe remote (put res)
+ case msg' of
+ RunTHDone -> return ()
+ _ -> loopTH
+
+-- | Forwards a @Message@ call, and handle @SlaveMessage@.
+-- Similar to @THMessages@, but @SlaveMessage@ are between
+-- the slave and the proxy, and are not forwarded to ghc.
+-- These message allow the Slave to query the proxy for
+-- files.
+--
+-- ghc --- proxy --> slave (@Message@)
+--
+-- proxy <-- slave (@SlaveMessage@)
+--
+fwdLoadCall :: (Binary a, Show a) => Bool -> Pipe -> Pipe -> Message a -> IO a
+fwdLoadCall verbose _ remote msg = do
+ writePipe remote (putMessage msg)
+ loopLoad
+ readPipe remote get
+ where
+ truncateMsg :: Int -> String -> String
+ truncateMsg n s | length s > n = take n s ++ "..."
+ | otherwise = s
+ reply :: (Binary a, Show a) => a -> IO ()
+ reply m = do
+ when verbose $
+ putStrLn ("| Resp.: proxy -> slave: "
+ ++ truncateMsg 80 (show m))
+ writePipe remote (put m)
+ loopLoad :: IO ()
+ loopLoad = do
+ SlaveMsg msg' <- readPipe remote getSlaveMessage
+ when verbose $
+ putStrLn ("| Sl Msg: proxy <- slave: " ++ show msg')
+ case msg' of
+ Done -> return ()
+ Missing path -> do
+ reply =<< BS.readFile path
+ loopLoad
+ Have path remoteHash -> do
+ localHash <- getFileHash path
+ reply =<< if localHash == remoteHash
+ then return Nothing
+ else Just <$> BS.readFile path
+ loopLoad
+
+-- | The actual proxy. Conntect local and remote pipe,
+-- and does some message handling.
+proxy :: Bool -> Pipe -> Pipe -> IO ()
+proxy verbose local remote = loop
+ where
+ fwdCall :: (Binary a, Show a) => Message a -> IO a
+ fwdCall msg = do
+ writePipe remote (putMessage msg)
+ readPipe remote get
+
+ -- reply to ghc.
+ reply :: (Show a, Binary a) => a -> IO ()
+ reply msg = do
+ when verbose $
+ putStrLn ("Resp.: ghc <- proxy -- slave: " ++ show msg)
+ writePipe local (put msg)
+
+ loop = do
+ (Msg msg) <- readPipe local getMessage
+ when verbose $
+ putStrLn ("Msg: ghc -- proxy -> slave: " ++ show msg)
+ (Msg msg') <- hook (Msg msg)
+ case msg' of
+ -- TH might send some message back to ghc.
+ RunTH{} -> do
+ resp <- fwdTHCall verbose local remote msg'
+ reply resp
+ loop
+ RunModFinalizers{} -> do
+ resp <- fwdTHCall verbose local remote msg'
+ reply resp
+ loop
+ -- Load messages might send some messages back to the proxy, to
+ -- requrest files that are not present on the device.
+ LoadArchive{} -> do
+ resp <- fwdLoadCall verbose local remote msg'
+ reply resp
+ loop
+ LoadObj{} -> do
+ resp <- fwdLoadCall verbose local remote msg'
+ reply resp
+ loop
+ LoadDLL path | isAbsolute path -> do
+ resp <- fwdLoadCall verbose local remote msg'
+ reply resp
+ loop
+ Shutdown{} -> fwdCall msg' >> return ()
+ _other -> fwdCall msg' >>= reply >> loop
+
+
+connectTo :: String -> PortNumber -> IO Socket
+connectTo host port = do
+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV]
+ , addrSocketType = Stream }
+ addr:_ <- getAddrInfo (Just hints) (Just host) (Just (show port))
+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+ putStrLn $ "Created socket for " ++ host ++ ":" ++ show port
+ connect sock (addrAddress addr)
+ putStrLn "connected"
+ return sock
+
+-- | Turn a socket into an unbuffered pipe.
+socketToPipe :: Socket -> IO Pipe
+socketToPipe sock = do
+ hdl <- socketToHandle sock ReadWriteMode
+ hSetBuffering hdl NoBuffering
+
+ lo_ref <- newIORef Nothing
+ pure Pipe{ pipeRead = hdl, pipeWrite = hdl, pipeLeftovers = lo_ref }
diff --git a/utils/iserv/Makefile b/utils/iserv/Makefile
new file mode 100644
index 0000000000..361985852f
--- /dev/null
+++ b/utils/iserv/Makefile
@@ -0,0 +1,15 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+dir = utils/iserv
+TOP = ../..
+include $(TOP)/mk/sub-makefile.mk
diff --git a/utils/iserv/cbits/iservmain.c b/utils/iserv/cbits/iservmain.c
new file mode 100644
index 0000000000..daefd35251
--- /dev/null
+++ b/utils/iserv/cbits/iservmain.c
@@ -0,0 +1,17 @@
+#include "../rts/PosixSource.h"
+#include "Rts.h"
+
+#include "HsFFI.h"
+
+int main (int argc, char *argv[])
+{
+ RtsConfig conf = defaultRtsConfig;
+
+ // We never know what symbols GHC will look up in the future, so
+ // we must retain CAFs for running interpreted code.
+ conf.keep_cafs = 1;
+
+ conf.rts_opts_enabled = RtsOptsAll;
+ extern StgClosure ZCMain_main_closure;
+ hs_main(argc, argv, &ZCMain_main_closure, conf);
+}
diff --git a/utils/iserv/ghc.mk b/utils/iserv/ghc.mk
new file mode 100644
index 0000000000..194621a85c
--- /dev/null
+++ b/utils/iserv/ghc.mk
@@ -0,0 +1,113 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009-2012 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Architecture
+# http://ghc.haskell.org/trac/ghc/wiki/Building/Modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/iserv_USES_CABAL = YES
+utils/iserv_PACKAGE = iserv
+utils/iserv_EXECUTABLE = iserv
+
+ifeq "$(GhcDebugged)" "YES"
+utils/iserv_stage2_MORE_HC_OPTS += -debug
+utils/iserv_stage2_p_MORE_HC_OPTS += -debug
+utils/iserv_stage2_dyn_MORE_HC_OPTS += -debug
+endif
+
+ifeq "$(GhcThreaded)" "YES"
+utils/iserv_stage2_MORE_HC_OPTS += -threaded
+utils/iserv_stage2_p_MORE_HC_OPTS += -threaded
+utils/iserv_stage2_dyn_MORE_HC_OPTS += -threaded
+endif
+
+# Add -Wl,--export-dynamic enables GHCi to load dynamic objects that
+# refer to the RTS. This is harmless if you don't use it (adds a bit
+# of overhead to startup and increases the binary sizes) but if you
+# need it there's no alternative.
+ifeq "$(TargetElf)" "YES"
+ifneq "$(TargetOS_CPP)" "solaris2"
+# The Solaris linker does not support --export-dynamic option. It also
+# does not need it since it exports all dynamic symbols by default
+utils/iserv_stage2_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+utils/iserv_stage2_p_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+utils/iserv_stage2_dyn_MORE_HC_OPTS += -optl-Wl,--export-dynamic
+endif
+endif
+
+# Override the default way, because we want a specific version of this
+# program for each way. Note that it's important to do this even for
+# the vanilla version, otherwise we get a dynamic executable when
+# DYNAMIC_GHC_PROGRAMS=YES.
+utils/iserv_stage2_PROGRAM_WAY = v
+utils/iserv_stage2_p_PROGRAM_WAY = p
+utils/iserv_stage2_dyn_PROGRAM_WAY = dyn
+
+utils/iserv_stage2_PROGNAME = ghc-iserv
+utils/iserv_stage2_p_PROGNAME = ghc-iserv-prof
+utils/iserv_stage2_dyn_PROGNAME = ghc-iserv-dyn
+
+utils/iserv_stage2_MORE_HC_OPTS += -no-hs-main
+utils/iserv_stage2_p_MORE_HC_OPTS += -no-hs-main
+utils/iserv_stage2_dyn_MORE_HC_OPTS += -no-hs-main
+
+utils/iserv_stage2_INSTALL = YES
+utils/iserv_stage2_p_INSTALL = YES
+utils/iserv_stage2_dyn_INSTALL = YES
+
+# Install in $(libexec), not in $(bindir)
+utils/iserv_stage2_TOPDIR = YES
+utils/iserv_stage2_p_TOPDIR = YES
+utils/iserv_stage2_dyn_TOPDIR = YES
+
+utils/iserv_stage2_INSTALL_INPLACE = YES
+utils/iserv_stage2_p_INSTALL_INPLACE = YES
+utils/iserv_stage2_dyn_INSTALL_INPLACE = YES
+
+ifeq "$(CLEANING)" "YES"
+
+NEED_iserv = YES
+NEED_iserv_p = YES
+NEED_iserv_dyn = YES
+
+else
+
+ifneq "$(findstring v, $(GhcLibWays))" ""
+NEED_iserv = YES
+else
+NEED_iserv = NO
+endif
+
+ifneq "$(findstring p, $(GhcLibWays))" ""
+NEED_iserv_p = YES
+else
+NEED_iserv_p = NO
+endif
+
+ifneq "$(findstring dyn, $(GhcLibWays))" ""
+NEED_iserv_dyn = YES
+else
+NEED_iserv_dyn = NO
+endif
+endif
+
+ifeq "$(NEED_iserv)" "YES"
+$(eval $(call build-prog,utils/iserv,stage2,1))
+endif
+
+ifeq "$(NEED_iserv_p)" "YES"
+$(eval $(call build-prog,utils/iserv,stage2_p,1))
+endif
+
+ifeq "$(NEED_iserv_dyn)" "YES"
+$(eval $(call build-prog,utils/iserv,stage2_dyn,1))
+endif
+
+all_ghc_stage2 : $(iserv-stage2_INPLACE)
+all_ghc_stage2 : $(iserv-stage2_p_INPLACE)
+all_ghc_stage2 : $(iserv-stage2_dyn_INPLACE)
diff --git a/utils/iserv/iserv.cabal b/utils/iserv/iserv.cabal
new file mode 100644
index 0000000000..f02d208262
--- /dev/null
+++ b/utils/iserv/iserv.cabal
@@ -0,0 +1,44 @@
+Name: iserv
+Version: 8.5
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: iserv allows GHC to delegate Tempalte Haskell computations
+Description:
+ GHC can be provided with a path to the iserv binary with
+ @-pgmi=/path/to/iserv-bin@, and will in combination with
+ @-fexternal-interpreter@, compile Template Haskell though the
+ @iserv-bin@ delegate. This is very similar to how ghcjs has been
+ compiling Template Haskell, by spawning a separate delegate (so
+ called runner on the javascript vm) and evaluating the splices
+ there.
+ .
+ To use iserv with cross compilers, please see @libraries/libiserv@
+ and @utils/iserv-proxy@.
+
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable iserv
+ Default-Language: Haskell2010
+ ghc-options: -no-hs-main
+ Main-Is: Main.hs
+ C-Sources: cbits/iservmain.c
+ Hs-Source-Dirs: src
+ include-dirs: .
+ Build-Depends: array >= 0.5 && < 0.6,
+ base >= 4 && < 5,
+ binary >= 0.7 && < 0.9,
+ bytestring >= 0.10 && < 0.11,
+ containers >= 0.5 && < 0.6,
+ deepseq >= 1.4 && < 1.5,
+ ghci == 8.5.*,
+ libiserv == 8.5
+
+ if os(windows)
+ Cpp-Options: -DWINDOWS
+ else
+ Build-Depends: unix >= 2.7 && < 2.9
diff --git a/utils/iserv/src/Main.hs b/utils/iserv/src/Main.hs
new file mode 100644
index 0000000000..858cee8e94
--- /dev/null
+++ b/utils/iserv/src/Main.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE CPP, GADTs #-}
+
+-- |
+-- The Remote GHCi server.
+--
+-- For details on Remote GHCi, see Note [Remote GHCi] in
+-- compiler/ghci/GHCi.hs.
+--
+module Main (main) where
+
+import Lib (serv)
+
+import GHCi.Message
+import GHCi.Signals
+import GHCi.Utils
+
+import Control.Exception
+import Control.Monad
+import Data.IORef
+import System.Environment
+import System.Exit
+import Text.Printf
+
+dieWithUsage :: IO a
+dieWithUsage = do
+ prog <- getProgName
+ die $ prog ++ ": " ++ msg
+ where
+#ifdef WINDOWS
+ msg = "usage: iserv <write-handle> <read-handle> [-v]"
+#else
+ msg = "usage: iserv <write-fd> <read-fd> [-v]"
+#endif
+
+main :: IO ()
+main = do
+ args <- getArgs
+ (wfd1, rfd2, rest) <-
+ case args of
+ arg0:arg1:rest -> do
+ let wfd1 = read arg0
+ rfd2 = read arg1
+ return (wfd1, rfd2, rest)
+ _ -> dieWithUsage
+
+ verbose <- case rest of
+ ["-v"] -> return True
+ [] -> return False
+ _ -> dieWithUsage
+ when verbose $
+ printf "GHC iserv starting (in: %d; out: %d)\n"
+ (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
+ inh <- getGhcHandle rfd2
+ outh <- getGhcHandle wfd1
+ installSignalHandlers
+ lo_ref <- newIORef Nothing
+ let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}
+ uninterruptibleMask $ serv verbose hook pipe
+
+ where hook = return -- empty hook
+ -- we cannot allow any async exceptions while communicating, because
+ -- we will lose sync in the protocol, hence uninterruptibleMask.
+
View Lorry Controller Status