+{-# 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.
#include "HsVersions.h"
import ForeignCall
+import ClosureInfo
import StgSyn
import CgForeignCall
import CgBindery
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 :: [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
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
-}
= 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))
]
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))
]
-- 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
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)
])
-- #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
-- }
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
-- 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 _ _
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
projects / ghc-hetmet.git / blobdiff