X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgPrimOp.hs;h=85a41515e650bb6423c481a881a6ecfd310211e5;hb=a385f0af5ea320a18d580f6a36c59c55b3516efd;hp=049e12a986e3f8ea3900d751e94557d1fcaef144;hpb=1c5499d4d5d506ce0cc971e98c09bfbf7bc290a1;p=ghc-hetmet.git diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 049e12a..85a4151 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -1,3 +1,10 @@ +{-# 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. @@ -10,8 +17,6 @@ module CgPrimOp ( cgPrimOp ) where -#include "HsVersions.h" - import ForeignCall import ClosureInfo import StgSyn @@ -28,11 +33,12 @@ import PrimOp import SMRep import Constants 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 @@ -44,7 +50,7 @@ cgPrimOp results op args live 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 @@ -116,13 +122,15 @@ emitPrimOp [res] ParOp [arg] live -- later, we might want to inline it. vols <- getVolatileRegs live emitForeignCall' PlayRisky - [(res,NoHint)] + [CmmKinded res NoHint] (CmmCallee newspark CCallConv) - [(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] + [ (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)) @@ -135,9 +143,11 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live [{-no results-}] (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_)) @@ -339,11 +349,12 @@ emitPrimOp [res] op args live | 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