X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgPrimOp.hs;h=c77e8e596808f4d24790985ea496d97fb579caac;hb=58de6cb725982dd1f57803cc838f233d5fd9c42c;hp=bc7c9140edb0ab5df7605d69a25c0ec5871655d2;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index bc7c914..c77e8e5 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -1,8 +1,15 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 -----------------------------------------------------------------------------
 --
 -- Code generation for PrimOps.
 --
--- (c) The University of Glasgow 2004
+-- (c) The University of Glasgow 2004-2006
 --
 -----------------------------------------------------------------------------
 
@@ -12,30 +19,27 @@ module CgPrimOp (
 
 #include "HsVersions.h"
 
-import ForeignCall	( CCallConv(CCallConv) )
-import StgSyn		( StgLiveVars, StgArg )
-import CgForeignCall	( emitForeignCall' )
-import CgBindery	( getVolatileRegs, getArgAmodes )
-import CgMonad
-import CgInfoTbls	( getConstrTag )
-import CgUtils		( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
 import ForeignCall
+import ClosureInfo
+import StgSyn
+import CgForeignCall
+import CgBindery
+import CgMonad
+import CgInfoTbls
+import CgUtils
 import Cmm
-import CLabel		( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
-			  mkDirty_MUT_VAR_Label, mkRtsCodeLabel )
+import CLabel
 import CmmUtils
 import MachOp
+import PrimOp
 import SMRep
-import PrimOp		( PrimOp(..) )
-import SMRep		( tablesNextToCode )
-import Constants 	( wORD_SIZE, wORD_SIZE_IN_BITS )
-import StaticFlags	( opt_Parallel )
+import Constants
 import Outputable
 
 -- ---------------------------------------------------------------------------
 -- Code generation for PrimOps
 
-cgPrimOp   :: [CmmReg] 		-- where to put the results
+cgPrimOp   :: CmmFormalsWithoutKinds	-- where to put the results
 	   -> PrimOp		-- the op
 	   -> [StgArg]		-- arguments
 	   -> StgLiveVars	-- live vars, in case we need to save them
@@ -47,7 +51,7 @@ cgPrimOp results op args live
        emitPrimOp results op non_void_args live
 
 
-emitPrimOp :: [CmmReg] 		-- where to put the results
+emitPrimOp :: CmmFormalsWithoutKinds	-- where to put the results
 	   -> PrimOp		-- the op
 	   -> [CmmExpr]		-- arguments
 	   -> StgLiveVars	-- live vars, in case we need to save them
@@ -78,12 +82,12 @@ emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
 
 -}
    = stmtsC [
-        CmmAssign res_r (CmmMachOp mo_wordAdd [aa,bb]),
-        CmmAssign res_c $
+        CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordAdd [aa,bb]),
+        CmmAssign (CmmLocal res_c) $
 	  CmmMachOp mo_wordUShr [
 		CmmMachOp mo_wordAnd [
 		    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-		    CmmMachOp mo_wordXor [aa, CmmReg res_r]
+		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
 		], 
 	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
 	  ]
@@ -101,12 +105,12 @@ emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
    c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
 -}
    = stmtsC [
-        CmmAssign res_r (CmmMachOp mo_wordSub [aa,bb]),
-        CmmAssign res_c $
+        CmmAssign (CmmLocal res_r) (CmmMachOp mo_wordSub [aa,bb]),
+        CmmAssign (CmmLocal res_c) $
 	  CmmMachOp mo_wordUShr [
 		CmmMachOp mo_wordAnd [
 		    CmmMachOp mo_wordXor [aa,bb],
-		    CmmMachOp mo_wordXor [aa, CmmReg res_r]
+		    CmmMachOp mo_wordXor [aa, CmmReg (CmmLocal res_r)]
 		], 
 	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
 	  ]
@@ -119,15 +123,18 @@ emitPrimOp [res] ParOp [arg] live
 	-- later, we might want to inline it.
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
-	[(res,NoHint)]
-    	(CmmForeignCall newspark CCallConv) 
-	[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] 
+	[CmmHinted res NoHint]
+    	(CmmCallee newspark CCallConv) 
+	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
+          , (CmmHinted arg PtrHint)  ] 
 	(Just vols)
+        NoC_SRT -- No SRT b/c we do PlayRisky
+        CmmMayReturn
   where
 	newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
 
 emitPrimOp [res] ReadMutVarOp [mutv] live
-   = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
+   = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize))
 
 emitPrimOp [] WriteMutVarOp [mutv,var] live
    = do
@@ -135,16 +142,19 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
 	vols <- getVolatileRegs live
 	emitForeignCall' PlayRisky
 		[{-no results-}]
-		(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
+		(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
 			 CCallConv)
-		[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
+		[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
+                  , (CmmHinted mutv PtrHint)  ]
 		(Just vols)
+                NoC_SRT -- No SRT b/c we do PlayRisky
+                CmmMayReturn
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = (((StgArrWords *)(a))->words * sizeof(W_))
 emitPrimOp [res] SizeofByteArrayOp [arg] live
    = stmtC $
-	CmmAssign res (CmmMachOp mo_wordMul [
+	CmmAssign (CmmLocal res) (CmmMachOp mo_wordMul [
 			  cmmLoadIndexW arg fixedHdrSize,
 			  CmmLit (mkIntCLit wORD_SIZE)
 			])
@@ -161,31 +171,32 @@ emitPrimOp [] TouchOp [arg] live
 
 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
 emitPrimOp [res] ByteArrayContents_Char [arg] live
-   = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
+   = stmtC (CmmAssign (CmmLocal res) (cmmOffsetB arg arrWordsHdrSize))
 
 --  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
 emitPrimOp [res] StableNameToIntOp [arg] live
-   = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
+   = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW arg fixedHdrSize))
 
 --  #define eqStableNamezh(r,sn1,sn2)					\
 --    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
 emitPrimOp [res] EqStableNameOp [arg1,arg2] live
-   = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [
 				cmmLoadIndexW arg1 fixedHdrSize,
 				cmmLoadIndexW arg2 fixedHdrSize
 			 ]))
 
 
 emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
-   = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp mo_wordEq [arg1,arg2]))
 
 --  #define addrToHValuezh(r,a) r=(P_)a
 emitPrimOp [res] AddrToHValueOp [arg] live
-   = stmtC (CmmAssign res arg)
+   = stmtC (CmmAssign (CmmLocal res) arg)
 
 --  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
+--  Note: argument may be tagged!
 emitPrimOp [res] DataToTagOp [arg] live
-   = stmtC (CmmAssign res (getConstrTag arg))
+   = stmtC (CmmAssign (CmmLocal res) (getConstrTag (cmmUntag arg)))
 
 {- Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
@@ -199,11 +210,11 @@ emitPrimOp [res] DataToTagOp [arg] live
 --	}
 emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
    = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
-	     CmmAssign res arg ]
+	     CmmAssign (CmmLocal res) arg ]
 
 --  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
 emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
-   = stmtC (CmmAssign res arg)
+   = stmtC (CmmAssign (CmmLocal res) arg)
 
 -- Reading/writing pointer arrays
 
@@ -329,23 +340,25 @@ emitPrimOp res WriteByteArrayOp_Word64    args live = doWriteByteArrayOp Nothing
 -- The rest just translate straightforwardly
 emitPrimOp [res] op [arg] live
    | nopOp op
-   = stmtC (CmmAssign res arg)
+   = stmtC (CmmAssign (CmmLocal res) arg)
 
    | Just (mop,rep) <- narrowOp op
-   = stmtC (CmmAssign res (CmmMachOp (mop rep wordRep) [
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp (mop rep wordRep) [
 			  CmmMachOp (mop wordRep rep) [arg]]))
 
 emitPrimOp [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
 	emitForeignCall' PlayRisky
-	   [(res,NoHint)] 
+	   [CmmHinted res NoHint] 
 	   (CmmPrim prim) 
-	   [(a,NoHint) | a<-args]  -- ToDo: hints?
+	   [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
 	   (Just vols)
+           NoC_SRT -- No SRT b/c we do PlayRisky
+           CmmMayReturn
 
    | Just mop <- translateOp op
-   = let stmt = CmmAssign res (CmmMachOp mop args) in
+   = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
      stmtC stmt
 
 emitPrimOp _ op _ _
@@ -558,9 +571,9 @@ doWritePtrArrayOp addr idx val
 
 
 mkBasicIndexedRead off Nothing read_rep res base idx
-   = stmtC (CmmAssign res (cmmLoadIndexOffExpr off read_rep base idx))
+   = stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexOffExpr off read_rep base idx))
 mkBasicIndexedRead off (Just cast) read_rep res base idx
-   = stmtC (CmmAssign res (CmmMachOp cast [
+   = stmtC (CmmAssign (CmmLocal res) (CmmMachOp cast [
 				cmmLoadIndexOffExpr off read_rep base idx]))
 
 mkBasicIndexedWrite off Nothing write_rep base idx val