diff options
Diffstat (limited to 'compiler/codeGen')
-rw-r--r-- | compiler/codeGen/StgCmmExpr.hs | 12 | ||||
-rw-r--r-- | compiler/codeGen/StgCmmPrim.hs | 6 |
2 files changed, 12 insertions, 6 deletions
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 22fcfaf412..1af8fb3376 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -65,6 +65,16 @@ cgExpr (StgApp fun args) = cgIdApp fun args cgExpr (StgOpApp (StgPrimOp SeqOp) [StgVarArg a, _] _res_ty) = cgIdApp a [] +-- dataToTag# :: a -> Int# +-- See Note [dataToTag#] in primops.txt.pp +cgExpr (StgOpApp (StgPrimOp DataToTagOp) [StgVarArg a] _res_ty) = do + dflags <- getDynFlags + emitComment (mkFastString "dataToTag#") + tmp <- newTemp (bWord dflags) + _ <- withSequel (AssignTo [tmp] False) (cgIdApp a []) + -- TODO: For small types look at the tag bits instead of reading info table + emitReturn [getConstrTag dflags (cmmUntag dflags (CmmReg (CmmLocal tmp)))] + cgExpr (StgOpApp op args ty) = cgOpApp op args ty cgExpr (StgConApp con args _)= cgConApp con args cgExpr (StgTick t e) = cgTick t >> cgExpr e @@ -550,6 +560,8 @@ isSimpleScrut _ _ = return False isSimpleOp :: StgOp -> [StgArg] -> FCode Bool -- True iff the op cannot block or allocate isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe) +-- dataToTag# evalautes its argument, see Note [dataToTag#] in primops.txt.pp +isSimpleOp (StgPrimOp DataToTagOp) _ = return False isSimpleOp (StgPrimOp op) stg_args = do arg_exprs <- getNonVoidArgAmodes stg_args dflags <- getDynFlags diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index f5437c0c3b..c90264f14f 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -37,7 +37,6 @@ import BlockId import MkGraph import StgSyn import Cmm -import CmmInfo import Type ( Type, tyConAppTyCon ) import TyCon import CLabel @@ -363,11 +362,6 @@ emitPrimOp _ [res] AddrToAnyOp [arg] emitPrimOp _ [res] AnyToAddrOp [arg] = emitAssign (CmmLocal res) arg --- #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) --- Note: argument may be tagged! -emitPrimOp dflags [res] DataToTagOp [arg] - = emitAssign (CmmLocal res) (getConstrTag dflags (cmmUntag dflags arg)) - {- Freezing arrays-of-ptrs requires changing an info table, for the benefit of the generational collector. It needs to scavenge mutable objects, even if they are in old space. When they become immutable, |