In CMM, only allow foreign calls to labels, not arbitrary expressions

I'm not sure if we want to make this change permanently, but for now it
fixes the unreg build.

I've also removed some redundant special-case code that generated
prototypes for foreign functions. The standard pprTempAndExternDecls
now generates them.

3 files changed, 8 insertions, 10 deletions

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 1e5d6b9f4f..c070e80199 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -731,7 +731,7 @@ link_caf node _is_upd = do
         -- This must be done *before* the info table pointer is overwritten,
         -- because the old info table ptr is needed for reversion
   ; ret <- newTemp (bWord dflags)
-  ; emitRtsCallGen [(ret,NoHint)] rtsPackageId (fsLit "newCAF")
+  ; emitRtsCallGen [(ret,NoHint)] (mkForeignLabel (fsLit "newCAF") Nothing ForeignLabelInExternalPackage IsFunction)
       [ (CmmReg (CmmGlobal BaseReg),  AddrHint),
         (CmmReg (CmmLocal node), AddrHint),
         (hp_rel, AddrHint) ]
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index fb5acde956..54002e8171 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -36,7 +36,6 @@ import CLabel
 import CmmUtils
 import PrimOp
 import SMRep
-import Module
 import FastString
 import Outputable
 import Util
@@ -214,7 +213,7 @@ emitPrimOp _ [res] ParOp [arg]
         -- later, we might want to inline it.
     emitCCall
         [(res,NoHint)]
-        (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
+        (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
         [(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)]
 
 emitPrimOp dflags [res] SparkOp [arg]
@@ -226,7 +225,7 @@ emitPrimOp dflags [res] SparkOp [arg]
         tmp2 <- newTemp (bWord dflags)
         emitCCall
             [(tmp2,NoHint)]
-            (CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
+            (CmmLit (CmmLabel (mkForeignLabel (fsLit "newSpark") Nothing ForeignLabelInExternalPackage IsFunction)))
             [(CmmReg (CmmGlobal BaseReg), AddrHint), ((CmmReg (CmmLocal tmp)), AddrHint)]
         emitAssign (CmmLocal res) (CmmReg (CmmLocal tmp))
 
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 3df75ceaa2..45b0f0c785 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -173,22 +173,21 @@ tagToClosure dflags tycon tag
 -------------------------------------------------------------------------
 
 emitRtsCall :: PackageId -> FastString -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
-emitRtsCall pkg fun args safe = emitRtsCallGen [] pkg fun args safe
+emitRtsCall pkg fun args safe = emitRtsCallGen [] (mkCmmCodeLabel pkg fun) args safe
 
 emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString
         -> [(CmmExpr,ForeignHint)] -> Bool -> FCode ()
 emitRtsCallWithResult res hint pkg fun args safe
-   = emitRtsCallGen [(res,hint)] pkg fun args safe
+   = emitRtsCallGen [(res,hint)] (mkCmmCodeLabel pkg fun) args safe
 
 -- Make a call to an RTS C procedure
 emitRtsCallGen
    :: [(LocalReg,ForeignHint)]
-   -> PackageId
-   -> FastString
+   -> CLabel
    -> [(CmmExpr,ForeignHint)]
    -> Bool -- True <=> CmmSafe call
    -> FCode ()
-emitRtsCallGen res pkg fun args safe
+emitRtsCallGen res lbl args safe
   = do { dflags <- getDynFlags
        ; updfr_off <- getUpdFrameOff
        ; let (caller_save, caller_load) = callerSaveVolatileRegs dflags
@@ -204,7 +203,7 @@ emitRtsCallGen res pkg fun args safe
         emit $ mkUnsafeCall (ForeignTarget fun_expr conv) res' args'
     (args', arg_hints) = unzip args
     (res',  res_hints) = unzip res
-    fun_expr = mkLblExpr (mkCmmCodeLabel pkg fun)
+    fun_expr = mkLblExpr lbl
 
 
 -----------------------------------------------------------------------------