diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index e887f7e4b85447f2a7c65adfb1931a1d3d96ad81..b5d80e80dcdd75277b7b0d3baa48ee15288f46a7 100644
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -58,6 +58,7 @@ data UfCon name = UfDefault
 		| UfLitLitCon FAST_STRING (HsType name)
 	        | UfPrimOp name
  	 	| UfCCallOp FAST_STRING	   -- callee
+			    Bool	   -- True => dynamic (first arg is fun. pointer)
 			    Bool	   -- True <=> casm, rather than ccall
 			    Bool	   -- True <=> might cause GC
 
@@ -115,10 +116,11 @@ instance Outputable name => Outputable (UfCon name) where
     ppr UfDefault	= text "DEFAULT"
     ppr (UfDataCon d)	= ppr d
     ppr (UfPrimOp p)	= ppr p
-    ppr (UfCCallOp str is_casm can_gc)
+    ppr (UfCCallOp str is_dyn is_casm can_gc)
       =	hcat [before, ptext str, after]
       where
-	    before = ptext (if is_casm then SLIT("_casm_ ``") else SLIT("_ccall_ "))
+	    before = (if is_dyn then ptext SLIT("_dyn_") else empty) <>
+		     ptext (if is_casm then SLIT("_casm_ ``") else SLIT("_ccall_ "))
 	    after  = if is_casm then text "'' " else space
 
 instance Outputable name => Outputable (UfBinder name) where
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 4a6e215de98b0efd70426070ba7a15e4ca27ac8d..8dd4415c2a06380cc2f7d46142ec74dd103a0917 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -2025,22 +2025,28 @@ pprPrimOp (CCallOp fun is_casm may_gc cconv)
         callconv = text "{-" <> pprCallConv cconv <> text "-}"
 
 	before
-	  | is_casm && may_gc = "__casm_GC ``"
-	  | is_casm	      = "__casm ``"
-	  | may_gc	      = "__ccall_GC "
-	  | otherwise	      = "__ccall "
+	  | is_casm && may_gc = "casm_GC ``"
+	  | is_casm	      = "casm ``"
+	  | may_gc	      = "ccall_GC "
+	  | otherwise	      = "ccall "
 
 	after
 	  | is_casm   = text "''"
 	  | otherwise = empty
+	  
+	ppr_dyn =
+	  case fun of
+	    Right _ -> text "dyn_"
+	    _	    -> empty
 
 	ppr_fun =
 	 case fun of
-	   Right _ -> ptext SLIT("<dynamic>")
+	   Right _ -> text "\"\""
 	   Left fn -> ptext fn
 	 
     in
     hcat [ ifPprDebug callconv
+	 , text "__", ppr_dyn
          , text before , ppr_fun , after]
 
 pprPrimOp other_op
diff --git a/ghc/compiler/reader/Lex.lhs b/ghc/compiler/reader/Lex.lhs
index 4699de9869f912ed66607d7b1ba7410924937b99..70d6b6b0a89cff4fa481f9f50295bb3c7250a38b 100644
--- a/ghc/compiler/reader/Lex.lhs
+++ b/ghc/compiler/reader/Lex.lhs
@@ -127,7 +127,7 @@ data IfaceToken
   | ITletrec 
   | ITcoerce
   | ITinline
-  | ITccall (Bool,Bool)	-- (is_casm, may_gc)
+  | ITccall (Bool,Bool,Bool)	-- (is_dyn, is_casm, may_gc)
   | ITdefaultbranch
   | ITbottom
   | ITinteger_lit 
@@ -656,10 +656,13 @@ ifaceKeywordsFM = listToUFM $
         ("__Unot",		ITunfold IMustNotBeINLINEd),
         ("__Ux",		ITunfold IAmALoopBreaker),
 	
-        ("__ccall",		ITccall (False, False)),
-        ("__ccall_GC",		ITccall (False, True)),
-        ("__casm",		ITccall (True,  False)),
-        ("__casm_GC",		ITccall (True,  True)),
+        ("__ccall",		ITccall (False, False, False)),
+        ("__dyn_ccall",		ITccall (True,  False, False)),
+        ("__dyn_ccall_GC",	ITccall (True,  False, True)),
+        ("__casm",		ITccall (False, True,  False)),
+        ("__dyn_casm",		ITccall (True,  True,  False)),
+        ("__casm_GC",		ITccall (False, True,  True)),
+        ("__dyn_casm_GC",	ITccall (True,  True,  True)),
 
         ("/\\",			ITbiglam)
        ]
diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y
index 30c1478f264ebb963419afcbe5e8d5b2d080788f..e548c1ee3a03ca2de821b5337f2cf77429d6986c 100644
--- a/ghc/compiler/rename/ParseIface.y
+++ b/ghc/compiler/rename/ParseIface.y
@@ -572,9 +572,9 @@ con_or_primop   :: { UfCon RdrName }
 con_or_primop   : qdata_name                    { UfDataCon $1 }
                 | qvar_name			{ UfPrimOp $1 }
                 | '__ccall' ccall_string      { let
-						(is_casm, may_gc) = $1
+						(is_dyn, is_casm, may_gc) = $1
 					        in
-						UfCCallOp $2 is_casm may_gc
+						UfCCallOp $2 is_dyn is_casm may_gc
 						}
 
 rec_binds	:: { [(UfBinder RdrName, UfExpr RdrName)] }
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index 34966a75e7bc8a5ba76278e4ef20a0f23dc0aa71..01091ca6a4f82a544070fb4fb617318eeee600be 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -759,8 +759,8 @@ rnUfCon (UfPrimOp op)
   = lookupOccRn op		`thenRn` \ op' ->
     returnRn (UfPrimOp op')
 
-rnUfCon (UfCCallOp str casm gc)
-  = returnRn (UfCCallOp str casm gc)
+rnUfCon (UfCCallOp str is_dyn casm gc)
+  = returnRn (UfCCallOp str is_dyn casm gc)
 \end{code}
 
 %*********************************************************
diff --git a/ghc/compiler/typecheck/TcIfaceSig.lhs b/ghc/compiler/typecheck/TcIfaceSig.lhs
index db7ea310d6d9ad4a6db505ad72dd2e400092a363..40cc5dfc86bca853d29a85cbf08e9459a96ca144 100644
--- a/ghc/compiler/typecheck/TcIfaceSig.lhs
+++ b/ghc/compiler/typecheck/TcIfaceSig.lhs
@@ -306,8 +306,12 @@ tcUfCon (UfPrimOp name)
 	Just op -> returnTc (PrimOp op)
 	Nothing -> failWithTc (badPrimOp name)
 
-tcUfCon (UfCCallOp str casm gc)
-  = returnTc (PrimOp (CCallOp (Left str) casm gc cCallConv))
+tcUfCon (UfCCallOp str is_dyn casm gc)
+  = case is_dyn of
+       True  -> 
+          tcGetUnique `thenNF_Tc` \ u ->
+	  returnTc (PrimOp (CCallOp (Right u) casm gc cCallConv))
+       False -> returnTc (PrimOp (CCallOp (Left str) casm gc cCallConv))
 
 tcUfDataCon name
   = tcVar name		`thenTc` \ con_id ->