X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgPrimOp.hs;h=d26d9c690136ec5325a4d85a0c428a8d1f14f9cc;hb=f83010b119096699d1efef2f7bb45460719c48f9;hp=3993f19197fe16bde6a3ebeeab2815025874deb1;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 3993f19..d26d9c6 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -13,28 +13,26 @@ module CgPrimOp ( #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 -- --------------------------------------------------------------------------- -- Code generation for PrimOps -cgPrimOp :: [CmmReg] -- where to put the results +cgPrimOp :: CmmFormals -- where to put the results -> PrimOp -- the op -> [StgArg] -- arguments -> StgLiveVars -- live vars, in case we need to save them @@ -46,7 +44,7 @@ cgPrimOp results op args live emitPrimOp results op non_void_args live -emitPrimOp :: [CmmReg] -- where to put the results +emitPrimOp :: CmmFormals -- where to put the results -> PrimOp -- the op -> [CmmExpr] -- arguments -> StgLiveVars -- live vars, in case we need to save them @@ -77,12 +75,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)) ] @@ -100,12 +98,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)) ] @@ -122,11 +120,12 @@ emitPrimOp [res] ParOp [arg] live (CmmForeignCall newspark CCallConv) [(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky 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 @@ -138,12 +137,13 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live CCallConv) [(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)] (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky -- #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) ]) @@ -160,31 +160,31 @@ 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)) emitPrimOp [res] DataToTagOp [arg] live - = stmtC (CmmAssign res (getConstrTag arg)) + = stmtC (CmmAssign (CmmLocal res) (getConstrTag arg)) {- Freezing arrays-of-ptrs requires changing an info table, for the benefit of the generational collector. It needs to scavenge mutable @@ -198,11 +198,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 @@ -328,10 +328,10 @@ 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 @@ -342,9 +342,10 @@ emitPrimOp [res] op args live (CmmPrim prim) [(a,NoHint) | a<-args] -- ToDo: hints? (Just vols) + NoC_SRT -- No SRT b/c we do PlayRisky | 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 _ _ @@ -557,9 +558,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