pass arguments to unknown function calls in registers

[ghc-hetmet.git] / ghc / compiler / codeGen / CgForeignCall.hs

diff --git a/ghc/compiler/codeGen/CgForeignCall.hs b/ghc/compiler/codeGen/CgForeignCall.hs
index 9897651..e56189a 100644 (file)
--- a/ghc/compiler/codeGen/CgForeignCall.hs
+++ b/ghc/compiler/codeGen/CgForeignCall.hs
@@ -78,13 +78,19 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
     vols <- getVolatileRegs live
     id <- newTemp wordRep
     emitSaveThreadState
-    stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) [(id,NoHint)]
+    stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) 
+                       [(id,PtrHint)]
                        [ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
                        (Just vols)
                        )
     stmtC (the_call vols)
-    stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) []
-                       [ (CmmReg id, NoHint) ] (Just vols)
+    stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) 
+                       [ (CmmGlobal BaseReg, PtrHint) ]
+                               -- Assign the result to BaseReg: we
+                               -- might now have a different
+                               -- Capability!
+                       [ (CmmReg id, PtrHint) ]
+                       (Just vols)
                        )
     emitLoadThreadState
 
@@ -204,15 +210,11 @@ currentNursery      = CmmGlobal CurrentNursery
 
 -- -----------------------------------------------------------------------------
 -- For certain types passed to foreign calls, we adjust the actual
--- value passed to the call.  Two main cases: for ForeignObj# we pass
--- the pointer inside the ForeignObj# closure, and for ByteArray#/Array# we
--- pass the address of the actual array, not the address of the heap object.
+-- value passed to the call.  For ByteArray#/Array# we pass the
+-- address of the actual array, not the address of the heap object.
 
 shimForeignCallArg :: StgArg -> CmmExpr -> CmmExpr
 shimForeignCallArg arg expr
-  | tycon == foreignObjPrimTyCon
-       = cmmLoadIndexW expr fixedHdrSize
-
   | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
        = cmmOffsetB expr arrPtrsHdrSize