From dc25c00f7cbfc014483bb26f5869825b373bd68a Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 30 Jul 2008 13:59:18 +0000
Subject: [PATCH] workaround #2277: turn off the RTS timer when calling into
 editline

---
 compiler/ghci/InteractiveUI.hs |   20 ++++++++++++++++----
 rts/Linker.c                   |    2 ++
 2 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index e1aced2..9e72a38 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -321,7 +321,7 @@ interactiveUI session srcs maybe_exprs = do
 
 #ifdef USE_EDITLINE
         is_tty <- hIsTerminalDevice stdin
-        when is_tty $ do
+        when is_tty $ withReadline $ do
             Readline.initialize
 
             withGhcAppData
@@ -614,9 +614,7 @@ readlineLoop = do
    io yield
    saveSession -- for use by completion
    prompt <- mkPrompt
-   l <- io (readline prompt `finally` setNonBlockingFD 0)
-                -- readline sometimes puts stdin into blocking mode,
-                -- so we need to put it back for the IO library
+   l <- io $ withReadline (readline prompt)
    splatSavedSession
    case l of
         Nothing -> return Nothing
@@ -625,6 +623,20 @@ readlineLoop = do
                    io (addHistory l)
                    str <- io $ consoleInputToUnicode True l
                    return (Just str)
+
+withReadline :: IO a -> IO a
+withReadline = bracket_ stopTimer (do startTimer; setNonBlockingFD 0)
+     -- Two problems are being worked around here:
+     -- 1. readline sometimes puts stdin into blocking mode,
+     --    so we need to put it back for the IO library
+     -- 2. editline doesn't handle some of its system calls returning
+     --    EINTR, so our timer signal confuses it, hence we turn off
+     --    the timer signal when making calls to editline. (#2277)
+     --    If editline is ever fixed, we can remove this.
+
+-- These come from the RTS
+foreign import ccall unsafe startTimer :: IO ()
+foreign import ccall unsafe stopTimer  :: IO ()
 #endif
 
 queryQueue :: GHCi (Maybe String)
diff --git a/rts/Linker.c b/rts/Linker.c
index 1a99f12..6c1446a 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -27,6 +27,7 @@
 #include "Schedule.h"
 #include "Sparks.h"
 #include "RtsTypeable.h"
+#include "Timer.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -703,6 +704,7 @@ typedef struct _RtsSymbolVal {
       SymX(stackOverflow)			\
       SymX(stg_CAF_BLACKHOLE_info)		\
       SymX(awakenBlockedQueue)			\
+      SymX(startTimer)                          \
       SymX(stg_CHARLIKE_closure)		\
       SymX(stg_MVAR_CLEAN_info)			\
       SymX(stg_MVAR_DIRTY_info)			\
-- 
1.7.10.4