Skip to content
Snippets Groups Projects
Commit 1c811959 authored by Moritz Angermann's avatar Moritz Angermann Committed by Marge Bot
Browse files

[iserv] learn -wait cli flag

Often times when attaching a debugger to iserv it's helpful to have
iserv wait a few seconds for the debugger to attach. -wait can be
passed via -opti-wait if needed.
parent c1c29808
No related branches found
No related tags found
No related merge requests found
...@@ -15,6 +15,7 @@ import GHCi.Signals ...@@ -15,6 +15,7 @@ import GHCi.Signals
import GHCi.Utils import GHCi.Utils
import Control.Exception import Control.Exception
import Control.Concurrent (threadDelay)
import Control.Monad import Control.Monad
import Data.IORef import Data.IORef
import System.Environment import System.Environment
...@@ -43,10 +44,17 @@ main = do ...@@ -43,10 +44,17 @@ main = do
return (wfd1, rfd2, rest) return (wfd1, rfd2, rest)
_ -> dieWithUsage _ -> dieWithUsage
verbose <- case rest of (verbose, rest') <- case rest of
["-v"] -> return True "-v":rest' -> return (True, rest')
[] -> return False _ -> return (False, rest)
_ -> dieWithUsage
(wait, rest'') <- case rest' of
"-wait":rest'' -> return (True, rest'')
_ -> return (False, rest')
unless (null rest'') $
dieWithUsage
when verbose $ when verbose $
printf "GHC iserv starting (in: %d; out: %d)\n" printf "GHC iserv starting (in: %d; out: %d)\n"
(fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int) (fromIntegral rfd2 :: Int) (fromIntegral wfd1 :: Int)
...@@ -55,9 +63,14 @@ main = do ...@@ -55,9 +63,14 @@ main = do
installSignalHandlers installSignalHandlers
lo_ref <- newIORef Nothing lo_ref <- newIORef Nothing
let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref} let pipe = Pipe{pipeRead = inh, pipeWrite = outh, pipeLeftovers = lo_ref}
when wait $ do
when verbose $
putStrLn "Waiting 3s"
threadDelay 3000000
uninterruptibleMask $ serv verbose hook pipe uninterruptibleMask $ serv verbose hook pipe
where hook = return -- empty hook where hook = return -- empty hook
-- we cannot allow any async exceptions while communicating, because -- we cannot allow any async exceptions while communicating, because
-- we will lose sync in the protocol, hence uninterruptibleMask. -- we will lose sync in the protocol, hence uninterruptibleMask.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment