Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4

[ghc-hetmet.git] / compiler / ghci / ByteCodeAsm.lhs

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index d5ffae1..6f6e51d 100644 (file)
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -23,7 +23,6 @@ import ByteCodeItbls
 
 import Name
 import NameSet
 
 import Name
 import NameSet

-import FiniteMap

 import Literal
 import TyCon
 import PrimOp
 import Literal
 import TyCon
 import PrimOp

@@ -42,6 +41,8 @@ import Data.Array.ST    ( castSTUArray )
 import Foreign
 import Data.Char        ( ord )
 import Data.List
 import Foreign
 import Data.Char        ( ord )
 import Data.List

+import Data.Map (Map)
+import qualified Data.Map as Map

 
 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
 
 
 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
 

@@ -128,19 +129,19 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced)
           | wORD_SIZE_IN_BITS == 64 = 4
           | wORD_SIZE_IN_BITS == 32 = 2
           | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
           | wORD_SIZE_IN_BITS == 64 = 4
           | wORD_SIZE_IN_BITS == 32 = 2
           | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"

-         label_env = mkLabelEnv emptyFM lableInitialOffset instrs
+         label_env = mkLabelEnv Map.empty lableInitialOffset instrs

 
 

-         mkLabelEnv :: FiniteMap Word16 Word -> Word -> [BCInstr]
-                    -> FiniteMap Word16 Word
+         mkLabelEnv :: Map Word16 Word -> Word -> [BCInstr]
+                    -> Map Word16 Word

          mkLabelEnv env _ [] = env
          mkLabelEnv env i_offset (i:is)
             = let new_env
          mkLabelEnv env _ [] = env
          mkLabelEnv env i_offset (i:is)
             = let new_env

-                     = case i of LABEL n -> addToFM env n i_offset ; _ -> env
+                     = case i of LABEL n -> Map.insert n i_offset env ; _ -> env

               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 
          findLabel :: Word16 -> Word
          findLabel lab
               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 
          findLabel :: Word16 -> Word
          findLabel lab

-            = case lookupFM label_env lab of
+            = case Map.lookup lab label_env of

                  Just bco_offset -> bco_offset
                  Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
      in
                  Just bco_offset -> bco_offset
                  Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
      in

@@ -308,8 +309,8 @@ mkBits findLabel st proto_insns
                ENTER              -> instr1 st bci_ENTER
                RETURN             -> instr1 st bci_RETURN
                RETURN_UBX rep     -> instr1 st (return_ubx rep)
                ENTER              -> instr1 st bci_ENTER
                RETURN             -> instr1 st bci_RETURN
                RETURN_UBX rep     -> instr1 st (return_ubx rep)

-               CCALL off m_addr   -> do (np, st2) <- addr st m_addr
-                                        instr3 st2 bci_CCALL off np
+               CCALL off m_addr int -> do (np, st2) <- addr st m_addr
+                                          instr4 st2 bci_CCALL off np int

                BRK_FUN array index info -> do
                   (p1, st2) <- ptr st  (BCOPtrArray array)
                   (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
                BRK_FUN array index info -> do
                   (p1, st2) <- ptr st  (BCOPtrArray array)
                   (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)

@@ -477,7 +478,7 @@ instrSize16s instr
         ENTER{}                 -> 1
         RETURN{}                -> 1
         RETURN_UBX{}            -> 1
         ENTER{}                 -> 1
         RETURN{}                -> 1
         RETURN_UBX{}            -> 1

-        CCALL{}                 -> 3
+        CCALL{}                 -> 4

         SWIZZLE{}               -> 3
         BRK_FUN{}               -> 4
 
         SWIZZLE{}               -> 3
         BRK_FUN{}               -> 4