X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmPrim.hs;h=3318ec9cad215ed3808b4bb19b67f97e7eb3ba59;hb=609e7ddfb10bc04762b820e70e0487ad6c514c2e;hp=7bc75de940c5405d9c264e20ae7e840b14d94ac3;hpb=5d1c70a506f366eca47464f2a354de8cc0d9a795;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 7bc75de..3318ec9 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -28,6 +28,7 @@ import CmmUtils
 import PrimOp
 import SMRep
 import Constants
+import Module
 import FastString
 import Outputable
 
@@ -110,6 +111,11 @@ cgOpApp (StgPrimOp primop) args res_ty
   where
      result_info = getPrimOpResultInfo primop
 
+cgOpApp (StgPrimCallOp primcall) args _res_ty
+  = do	{ cmm_args <- getNonVoidArgAmodes args
+        ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall))
+        ; emitCall (PrimOpCall, PrimOpReturn) fun cmm_args }
+
 ---------------------------------------------------
 cgPrimOp   :: [LocalReg]	-- where to put the results
 	   -> PrimOp		-- the op
@@ -196,7 +202,7 @@ emitPrimOp [res] ParOp [arg]
 	-- later, we might want to inline it.
     emitCCall
 	[(res,NoHint)]
-    	(CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark"))))
+    	(CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "newSpark"))))
 	[(CmmReg (CmmGlobal BaseReg), AddrHint), (arg,AddrHint)] 
 
 emitPrimOp [res] ReadMutVarOp [mutv]
@@ -226,8 +232,8 @@ emitPrimOp [res] SizeofMutableByteArrayOp [arg]
 
 
 --  #define touchzh(o)                  /* nothing */
-emitPrimOp [] TouchOp [_arg]
-   = nopC
+emitPrimOp res@[] TouchOp args@[_arg]
+   = do emitPrimCall res MO_Touch args
 
 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 emitPrimOp [res] ByteArrayContents_Char [arg]
@@ -407,9 +413,9 @@ emitPrimOp [res] op [arg]
    = emit (mkAssign (CmmLocal res) $
 	   CmmMachOp (mop rep wordWidth) [CmmMachOp (mop wordWidth rep) [arg]])
 
-emitPrimOp [res] op args
+emitPrimOp r@[res] op args
    | Just prim <- callishOp op
-   = do emitPrimCall res prim args
+   = do emitPrimCall r prim args
 
    | Just mop <- translateOp op
    = let stmt = mkAssign (CmmLocal res) (CmmMachOp mop args) in