+{-# 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.
cgPrimOp
) where
-#include "HsVersions.h"
-
import ForeignCall
import ClosureInfo
import StgSyn
import CgMonad
import CgInfoTbls
import CgUtils
-import ForeignCall
import Cmm
import CLabel
import CmmUtils
import MachOp
-import SMRep
import PrimOp
import SMRep
import Constants
-import StaticFlags
import Outputable
+import FastString
-- ---------------------------------------------------------------------------
-- Code generation for PrimOps
-cgPrimOp :: CmmFormals -- 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
emitPrimOp results op non_void_args live
-emitPrimOp :: CmmFormals -- 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
-- later, we might want to inline it.
vols <- getVolatileRegs live
emitForeignCall' PlayRisky
- [(res,NoHint)]
- (CmmForeignCall newspark CCallConv)
- [(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)]
+ [CmmKinded res NoHint]
+ (CmmCallee newspark CCallConv)
+ [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint)
+ , (CmmKinded arg PtrHint) ]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
where
- newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
+ newspark = CmmLit (CmmLabel (mkRtsCodeLabel (sLit "newSpark")))
emitPrimOp [res] ReadMutVarOp [mutv] live
= stmtC (CmmAssign (CmmLocal res) (cmmLoadIndexW mutv fixedHdrSize))
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)]
+ [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint)
+ , (CmmKinded mutv PtrHint) ]
(Just vols)
NoC_SRT -- No SRT b/c we do PlayRisky
+ CmmMayReturn
-- #define sizzeofByteArrayzh(r,a) \
-- r = (((StgArrWords *)(a))->words * sizeof(W_))
= 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 (CmmLocal 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
| Just prim <- callishOp op
= do vols <- getVolatileRegs live
emitForeignCall' PlayRisky
- [(res,NoHint)]
+ [CmmKinded res NoHint]
(CmmPrim prim)
- [(a,NoHint) | a<-args] -- ToDo: hints?
+ [CmmKinded 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 (CmmLocal res) (CmmMachOp mop args) in