Interruptible FFI calls with pthread_kill and CancelSynchronousIO. v4

[ghc-hetmet.git] / compiler / cmm / CmmCPSGen.hs

diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index b5f51a9..924ce9d 100644 (file)
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -20,11 +20,11 @@ import CgInfoTbls
 import SMRep
 import ForeignCall
 
+import Module
 import Constants
 import StaticFlags
 import Unique
-import Maybe
-import List
+import Data.Maybe
 import FastString
 
 import Panic
@@ -232,7 +232,9 @@ foreignCall uniques call results arguments =
     caller_save ++
     [CmmCall (CmmCallee suspendThread CCallConv)
                 [ CmmHinted id AddrHint ]
-                [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint ]
+                [ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint
+                -- XXX: allow for interruptible suspension
+                , CmmHinted (CmmLit (CmmInt 0 wordWidth)) NoHint ]
                 CmmUnsafe
                  CmmMayReturn,
      CmmCall call results new_args CmmUnsafe CmmMayReturn,
@@ -260,8 +262,8 @@ foreignCall uniques call results arguments =
 -- Save/restore the thread state in the TSO
 
 suspendThread, resumeThread :: CmmExpr
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
 
 -- This stuff can't be done in suspendThread/resumeThread, because it
 -- refers to global registers which aren't available in the C world.