diff options
Diffstat (limited to 'compiler/GHC/StgToCmm')
| -rw-r--r-- | compiler/GHC/StgToCmm/DataCon.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Prim.hs | 26 | ||||
| -rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 6 |
3 files changed, 40 insertions, 9 deletions
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs index 681f1461f1..18a8775cdd 100644 --- a/compiler/GHC/StgToCmm/DataCon.hs +++ b/compiler/GHC/StgToCmm/DataCon.hs @@ -102,6 +102,21 @@ cgTopRhsCon dflags id con args nv_args_w_offsets) = mkVirtHeapOffsetsWithPadding profile StdHeader (addArgReps args) + ; let + -- Decompose padding into units of length 8, 4, 2, or 1 bytes to + -- allow the implementation of mk_payload to use widthFromBytes, + -- which only handles these cases. + fix_padding (x@(Padding n off) : rest) + | n == 0 = fix_padding rest + | n `elem` [1,2,4,8] = x : fix_padding rest + | n > 8 = add_pad 8 + | n > 4 = add_pad 4 + | n > 2 = add_pad 2 + | otherwise = add_pad 1 + where add_pad m = Padding m off : fix_padding (Padding (n-m) (off+m) : rest) + fix_padding (x : rest) = x : fix_padding rest + fix_padding [] = [] + mk_payload (Padding len _) = return (CmmInt 0 (widthFromBytes len)) mk_payload (FieldOff arg _) = do amode <- getArgAmode arg @@ -117,7 +132,7 @@ cgTopRhsCon dflags id con args info_tbl = mkDataConInfoTable profile con True ptr_wds nonptr_wds - ; payload <- mapM mk_payload nv_args_w_offsets + ; payload <- mapM mk_payload (fix_padding nv_args_w_offsets) -- NB1: nv_args_w_offsets is sorted into ptrs then non-ptrs -- NB2: all the amodes should be Lits! -- TODO (osa): Why? diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs index 625e76f085..4d13d3960c 100644 --- a/compiler/GHC/StgToCmm/Prim.hs +++ b/compiler/GHC/StgToCmm/Prim.hs @@ -1195,8 +1195,8 @@ emitPrimOp dflags primop = case primop of -- Int8# signed ops - Int8Extend -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform)) - Int8Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8) + Int8ExtendOp -> \args -> opTranslate args (MO_SS_Conv W8 (wordWidth platform)) + Int8NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W8) Int8NegOp -> \args -> opTranslate args (MO_S_Neg W8) Int8AddOp -> \args -> opTranslate args (MO_Add W8) Int8SubOp -> \args -> opTranslate args (MO_Sub W8) @@ -1213,8 +1213,8 @@ emitPrimOp dflags primop = case primop of -- Word8# unsigned ops - Word8Extend -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform)) - Word8Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8) + Word8ExtendOp -> \args -> opTranslate args (MO_UU_Conv W8 (wordWidth platform)) + Word8NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W8) Word8NotOp -> \args -> opTranslate args (MO_Not W8) Word8AddOp -> \args -> opTranslate args (MO_Add W8) Word8SubOp -> \args -> opTranslate args (MO_Sub W8) @@ -1231,8 +1231,8 @@ emitPrimOp dflags primop = case primop of -- Int16# signed ops - Int16Extend -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform)) - Int16Narrow -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16) + Int16ExtendOp -> \args -> opTranslate args (MO_SS_Conv W16 (wordWidth platform)) + Int16NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W16) Int16NegOp -> \args -> opTranslate args (MO_S_Neg W16) Int16AddOp -> \args -> opTranslate args (MO_Add W16) Int16SubOp -> \args -> opTranslate args (MO_Sub W16) @@ -1249,8 +1249,8 @@ emitPrimOp dflags primop = case primop of -- Word16# unsigned ops - Word16Extend -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform)) - Word16Narrow -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16) + Word16ExtendOp -> \args -> opTranslate args (MO_UU_Conv W16 (wordWidth platform)) + Word16NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W16) Word16NotOp -> \args -> opTranslate args (MO_Not W16) Word16AddOp -> \args -> opTranslate args (MO_Add W16) Word16SubOp -> \args -> opTranslate args (MO_Sub W16) @@ -1265,6 +1265,16 @@ emitPrimOp dflags primop = case primop of Word16LtOp -> \args -> opTranslate args (MO_U_Lt W16) Word16NeOp -> \args -> opTranslate args (MO_Ne W16) +-- Int32# signed ops + + Int32ExtendOp -> \args -> opTranslate args (MO_SS_Conv W32 (wordWidth platform)) + Int32NarrowOp -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W32) + +-- Word32# unsigned ops + + Word32ExtendOp -> \args -> opTranslate args (MO_UU_Conv W32 (wordWidth platform)) + Word32NarrowOp -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W32) + -- Char# ops CharEqOp -> \args -> opTranslate args (MO_Eq (wordWidth platform)) diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index dbb4481d72..8cca28cc5a 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -106,8 +106,14 @@ mkSimpleLit platform = \case (wordWidth platform) LitNullAddr -> zeroCLit platform (LitNumber LitNumInt i) -> CmmInt i (wordWidth platform) + (LitNumber LitNumInt8 i) -> CmmInt i W8 + (LitNumber LitNumInt16 i) -> CmmInt i W16 + (LitNumber LitNumInt32 i) -> CmmInt i W32 (LitNumber LitNumInt64 i) -> CmmInt i W64 (LitNumber LitNumWord i) -> CmmInt i (wordWidth platform) + (LitNumber LitNumWord8 i) -> CmmInt i W8 + (LitNumber LitNumWord16 i) -> CmmInt i W16 + (LitNumber LitNumWord32 i) -> CmmInt i W32 (LitNumber LitNumWord64 i) -> CmmInt i W64 (LitFloat r) -> CmmFloat r W32 (LitDouble r) -> CmmFloat r W64 |