Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4

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

diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index 2082826..d44a00b 100644 (file)
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -108,6 +108,8 @@ data BCInstr
    | LABEL     LocalLabel
    | TESTLT_I  Int    LocalLabel
    | TESTEQ_I  Int    LocalLabel
+   | TESTLT_W  Word   LocalLabel
+   | TESTEQ_W  Word   LocalLabel
    | TESTLT_F  Float  LocalLabel
    | TESTEQ_F  Float  LocalLabel
    | TESTLT_D  Double LocalLabel
@@ -125,6 +127,9 @@ data BCInstr
    -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
    | CCALL            Word16    -- stack frame size
                       (Ptr ())  -- addr of the glue code
+                      Word16    -- whether or not the call is interruptible
+                                -- (XXX: inefficient, but I don't know
+                                -- what the alignment constraints are.)
 
    -- For doing magic ByteArray passing to foreign calls
    | SWIZZLE          Word16 -- to the ptr N words down the stack,
@@ -205,6 +210,8 @@ instance Outputable BCInstr where
    ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
+   ppr (TESTLT_W  i lab)     = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
+   ppr (TESTEQ_W  i lab)     = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
@@ -213,9 +220,12 @@ instance Outputable BCInstr where
    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
    ppr CASEFAIL              = text "CASEFAIL"
    ppr (JMP lab)             = text "JMP"      <+> ppr lab
-   ppr (CCALL off marshall_addr) = text "CCALL   " <+> ppr off 
+   ppr (CCALL off marshall_addr int) = text "CCALL   " <+> ppr off 
                                                <+> text "marshall code at" 
                                                <+> text (show marshall_addr)
+                                               <+> (if int == 1
+                                                    then text "(interruptible)"
+                                                    else empty)
    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
                                                <+> text "by" <+> ppr n
    ppr ENTER                 = text "ENTER"
@@ -265,6 +275,8 @@ bciStackUse (UNPACK sz)           = fromIntegral sz
 bciStackUse LABEL{}              = 0
 bciStackUse TESTLT_I{}           = 0
 bciStackUse TESTEQ_I{}           = 0
+bciStackUse TESTLT_W{}           = 0
+bciStackUse TESTEQ_W{}           = 0
 bciStackUse TESTLT_F{}           = 0
 bciStackUse TESTEQ_F{}           = 0
 bciStackUse TESTLT_D{}           = 0