summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/ByteCode/Asm.hs47
-rw-r--r--compiler/GHC/ByteCode/Instr.hs50
-rw-r--r--compiler/GHC/StgToByteCode.hs66
-rw-r--r--compiler/GHC/Utils/Outputable.hs9
4 files changed, 162 insertions, 10 deletions
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 9163aeacd4..24e2645052 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -440,6 +440,38 @@ assembleI platform i = case i of
emit bci_TESTLT_W [Op np, LabelOp l]
TESTEQ_W w l -> do np <- word w
emit bci_TESTEQ_W [Op np, LabelOp l]
+ TESTLT_I64 i l -> do np <- int64 i
+ emit bci_TESTLT_I64 [Op np, LabelOp l]
+ TESTEQ_I64 i l -> do np <- int64 i
+ emit bci_TESTEQ_I64 [Op np, LabelOp l]
+ TESTLT_I32 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTLT_I32 [Op np, LabelOp l]
+ TESTEQ_I32 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTEQ_I32 [Op np, LabelOp l]
+ TESTLT_I16 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTLT_I16 [Op np, LabelOp l]
+ TESTEQ_I16 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTEQ_I16 [Op np, LabelOp l]
+ TESTLT_I8 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTLT_I8 [Op np, LabelOp l]
+ TESTEQ_I8 i l -> do np <- int (fromIntegral i)
+ emit bci_TESTEQ_I8 [Op np, LabelOp l]
+ TESTLT_W64 w l -> do np <- word64 w
+ emit bci_TESTLT_W64 [Op np, LabelOp l]
+ TESTEQ_W64 w l -> do np <- word64 w
+ emit bci_TESTEQ_W64 [Op np, LabelOp l]
+ TESTLT_W32 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTLT_W32 [Op np, LabelOp l]
+ TESTEQ_W32 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTEQ_W32 [Op np, LabelOp l]
+ TESTLT_W16 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTLT_W16 [Op np, LabelOp l]
+ TESTEQ_W16 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTEQ_W16 [Op np, LabelOp l]
+ TESTLT_W8 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTLT_W8 [Op np, LabelOp l]
+ TESTEQ_W8 w l -> do np <- word (fromIntegral w)
+ emit bci_TESTEQ_W8 [Op np, LabelOp l]
TESTLT_F f l -> do np <- float f
emit bci_TESTLT_F [Op np, LabelOp l]
TESTEQ_F f l -> do np <- float f
@@ -505,6 +537,7 @@ assembleI platform i = case i of
int16 = words . mkLitI64 platform
int32 = words . mkLitI64 platform
int64 = words . mkLitI64 platform
+ word64 = words . mkLitW64 platform
words ws = lit (map BCONPtrWord ws)
word w = words [w]
@@ -590,6 +623,7 @@ mkLitI :: Int -> [Word]
mkLitF :: Platform -> Float -> [Word]
mkLitD :: Platform -> Double -> [Word]
mkLitI64 :: Platform -> Int64 -> [Word]
+mkLitW64 :: Platform -> Word64 -> [Word]
mkLitF platform f = case platformWordSize platform of
PW4 -> runST $ do
@@ -636,13 +670,18 @@ mkLitI64 platform ii = case platformWordSize platform of
w1 <- readArray d_arr 1
return [w0 :: Word,w1]
)
- PW8 -> runST (do
- arr <- newArray_ ((0::Int),0)
- writeArray arr 0 ii
+ PW8 -> [fromIntegral ii :: Word]
+
+mkLitW64 platform ww = case platformWordSize platform of
+ PW4 -> runST (do
+ arr <- newArray_ ((0::Word),1)
+ writeArray arr 0 ww
d_arr <- castSTUArray arr
w0 <- readArray d_arr 0
- return [w0 :: Word]
+ w1 <- readArray d_arr 1
+ return [w0 :: Word,w1]
)
+ PW8 -> [fromIntegral ww :: Word]
mkLitI i = [fromIntegral i :: Word]
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index e5cd896c1c..498152c471 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -24,7 +24,9 @@ import GHC.Core.DataCon
import GHC.Builtin.PrimOps
import GHC.Runtime.Heap.Layout
+import Data.Int
import Data.Word
+
import GHC.Stack.CCS (CostCentre)
import GHC.Stg.Syntax
@@ -141,6 +143,22 @@ data BCInstr
| TESTEQ_I Int LocalLabel
| TESTLT_W Word LocalLabel
| TESTEQ_W Word LocalLabel
+ | TESTLT_I64 Int64 LocalLabel
+ | TESTEQ_I64 Int64 LocalLabel
+ | TESTLT_I32 Int32 LocalLabel
+ | TESTEQ_I32 Int32 LocalLabel
+ | TESTLT_I16 Int16 LocalLabel
+ | TESTEQ_I16 Int16 LocalLabel
+ | TESTLT_I8 Int8 LocalLabel
+ | TESTEQ_I8 Int16 LocalLabel
+ | TESTLT_W64 Word64 LocalLabel
+ | TESTEQ_W64 Word64 LocalLabel
+ | TESTLT_W32 Word32 LocalLabel
+ | TESTEQ_W32 Word32 LocalLabel
+ | TESTLT_W16 Word16 LocalLabel
+ | TESTEQ_W16 Word16 LocalLabel
+ | TESTLT_W8 Word8 LocalLabel
+ | TESTEQ_W8 Word8 LocalLabel
| TESTLT_F Float LocalLabel
| TESTEQ_F Float LocalLabel
| TESTLT_D Double LocalLabel
@@ -291,6 +309,22 @@ instance Outputable BCInstr where
ppr (TESTEQ_I i lab) = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
ppr (TESTLT_W i lab) = text "TESTLT_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
ppr (TESTEQ_W i lab) = text "TESTEQ_W" <+> int (fromIntegral i) <+> text "__" <> ppr lab
+ ppr (TESTLT_I64 i lab) = text "TESTLT_I64" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_I64 i lab) = text "TESTEQ_I64" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_I32 i lab) = text "TESTLT_I32" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_I32 i lab) = text "TESTEQ_I32" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_I16 i lab) = text "TESTLT_I16" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_I16 i lab) = text "TESTEQ_I16" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_I8 i lab) = text "TESTLT_I8" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_I8 i lab) = text "TESTEQ_I8" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_W64 i lab) = text "TESTLT_W64" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_W64 i lab) = text "TESTEQ_W64" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_W32 i lab) = text "TESTLT_W32" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_W32 i lab) = text "TESTEQ_W32" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_W16 i lab) = text "TESTLT_W16" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_W16 i lab) = text "TESTEQ_W16" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTLT_W8 i lab) = text "TESTLT_W8" <+> ppr i <+> text "__" <> ppr lab
+ ppr (TESTEQ_W8 i lab) = text "TESTEQ_W8" <+> ppr i <+> text "__" <> ppr lab
ppr (TESTLT_F f lab) = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
ppr (TESTEQ_F f lab) = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
ppr (TESTLT_D d lab) = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
@@ -380,6 +414,22 @@ bciStackUse TESTLT_I{} = 0
bciStackUse TESTEQ_I{} = 0
bciStackUse TESTLT_W{} = 0
bciStackUse TESTEQ_W{} = 0
+bciStackUse TESTLT_I64{} = 0
+bciStackUse TESTEQ_I64{} = 0
+bciStackUse TESTLT_I32{} = 0
+bciStackUse TESTEQ_I32{} = 0
+bciStackUse TESTLT_I16{} = 0
+bciStackUse TESTEQ_I16{} = 0
+bciStackUse TESTLT_I8{} = 0
+bciStackUse TESTEQ_I8{} = 0
+bciStackUse TESTLT_W64{} = 0
+bciStackUse TESTEQ_W64{} = 0
+bciStackUse TESTLT_W32{} = 0
+bciStackUse TESTEQ_W32{} = 0
+bciStackUse TESTLT_W16{} = 0
+bciStackUse TESTEQ_W16{} = 0
+bciStackUse TESTLT_W8{} = 0
+bciStackUse TESTEQ_W8{} = 0
bciStackUse TESTLT_F{} = 0
bciStackUse TESTEQ_F{} = 0
bciStackUse TESTLT_D{} = 0
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index 7cf5f477b7..b59cbfe779 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -936,12 +936,26 @@ doCase d s p scrut bndr alts
| otherwise
-> DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
LitAlt l -> case l of
- LitNumber LitNumInt i -> DiscrI (fromInteger i)
- LitNumber LitNumWord w -> DiscrW (fromInteger w)
- LitFloat r -> DiscrF (fromRational r)
- LitDouble r -> DiscrD (fromRational r)
- LitChar i -> DiscrI (ord i)
- _ -> pprPanic "schemeE(StgCase).my_discr" (ppr l)
+ LitNumber LitNumInt i -> DiscrI (fromInteger i)
+ LitNumber LitNumInt8 i -> DiscrI8 (fromInteger i)
+ LitNumber LitNumInt16 i -> DiscrI16 (fromInteger i)
+ LitNumber LitNumInt32 i -> DiscrI32 (fromInteger i)
+ LitNumber LitNumInt64 i -> DiscrI64 (fromInteger i)
+ LitNumber LitNumWord w -> DiscrW (fromInteger w)
+ LitNumber LitNumWord8 w -> DiscrW8 (fromInteger w)
+ LitNumber LitNumWord16 w -> DiscrW16 (fromInteger w)
+ LitNumber LitNumWord32 w -> DiscrW32 (fromInteger w)
+ LitNumber LitNumWord64 w -> DiscrW64 (fromInteger w)
+ LitNumber LitNumBigNat _ -> unsupported
+ LitFloat r -> DiscrF (fromRational r)
+ LitDouble r -> DiscrD (fromRational r)
+ LitChar i -> DiscrI (ord i)
+ LitString {} -> unsupported
+ LitRubbish {} -> unsupported
+ LitNullAddr {} -> unsupported
+ LitLabel {} -> unsupported
+ where
+ unsupported = pprPanic "schemeE(StgCase).my_discr:" (ppr l)
maybe_ncons
| not isAlgCase = Nothing
@@ -1841,14 +1855,30 @@ mkMultiBranch maybe_ncons raw_ways = do
notd_ways = sortBy (comparing fst) not_defaults
testLT (DiscrI i) fail_label = TESTLT_I i fail_label
+ testLT (DiscrI8 i) fail_label = TESTLT_I8 (fromIntegral i) fail_label
+ testLT (DiscrI16 i) fail_label = TESTLT_I16 (fromIntegral i) fail_label
+ testLT (DiscrI32 i) fail_label = TESTLT_I32 (fromIntegral i) fail_label
+ testLT (DiscrI64 i) fail_label = TESTLT_I64 (fromIntegral i) fail_label
testLT (DiscrW i) fail_label = TESTLT_W i fail_label
+ testLT (DiscrW8 i) fail_label = TESTLT_W8 (fromIntegral i) fail_label
+ testLT (DiscrW16 i) fail_label = TESTLT_W16 (fromIntegral i) fail_label
+ testLT (DiscrW32 i) fail_label = TESTLT_W32 (fromIntegral i) fail_label
+ testLT (DiscrW64 i) fail_label = TESTLT_W64 (fromIntegral i) fail_label
testLT (DiscrF i) fail_label = TESTLT_F i fail_label
testLT (DiscrD i) fail_label = TESTLT_D i fail_label
testLT (DiscrP i) fail_label = TESTLT_P i fail_label
testLT NoDiscr _ = panic "mkMultiBranch NoDiscr"
testEQ (DiscrI i) fail_label = TESTEQ_I i fail_label
+ testEQ (DiscrI8 i) fail_label = TESTEQ_I8 (fromIntegral i) fail_label
+ testEQ (DiscrI16 i) fail_label = TESTEQ_I16 (fromIntegral i) fail_label
+ testEQ (DiscrI32 i) fail_label = TESTEQ_I32 (fromIntegral i) fail_label
+ testEQ (DiscrI64 i) fail_label = TESTEQ_I64 (fromIntegral i) fail_label
testEQ (DiscrW i) fail_label = TESTEQ_W i fail_label
+ testEQ (DiscrW8 i) fail_label = TESTEQ_W8 (fromIntegral i) fail_label
+ testEQ (DiscrW16 i) fail_label = TESTEQ_W16 (fromIntegral i) fail_label
+ testEQ (DiscrW32 i) fail_label = TESTEQ_W32 (fromIntegral i) fail_label
+ testEQ (DiscrW64 i) fail_label = TESTEQ_W64 (fromIntegral i) fail_label
testEQ (DiscrF i) fail_label = TESTEQ_F i fail_label
testEQ (DiscrD i) fail_label = TESTEQ_D i fail_label
testEQ (DiscrP i) fail_label = TESTEQ_P i fail_label
@@ -1859,7 +1889,15 @@ mkMultiBranch maybe_ncons raw_ways = do
[] -> panic "mkMultiBranch: awesome foursome"
(discr, _):_ -> case discr of
DiscrI _ -> ( DiscrI minBound, DiscrI maxBound )
+ DiscrI8 _ -> ( DiscrI8 minBound, DiscrI8 maxBound )
+ DiscrI16 _ -> ( DiscrI16 minBound, DiscrI16 maxBound )
+ DiscrI32 _ -> ( DiscrI32 minBound, DiscrI32 maxBound )
+ DiscrI64 _ -> ( DiscrI64 minBound, DiscrI64 maxBound )
DiscrW _ -> ( DiscrW minBound, DiscrW maxBound )
+ DiscrW8 _ -> ( DiscrW8 minBound, DiscrW8 maxBound )
+ DiscrW16 _ -> ( DiscrW16 minBound, DiscrW16 maxBound )
+ DiscrW32 _ -> ( DiscrW32 minBound, DiscrW32 maxBound )
+ DiscrW64 _ -> ( DiscrW64 minBound, DiscrW64 maxBound )
DiscrF _ -> ( DiscrF minF, DiscrF maxF )
DiscrD _ -> ( DiscrD minD, DiscrD maxD )
DiscrP _ -> ( DiscrP algMinBound, DiscrP algMaxBound )
@@ -1895,7 +1933,15 @@ mkMultiBranch maybe_ncons raw_ways = do
-- Describes case alts
data Discr
= DiscrI Int
+ | DiscrI8 Int8
+ | DiscrI16 Int16
+ | DiscrI32 Int32
+ | DiscrI64 Int64
| DiscrW Word
+ | DiscrW8 Word8
+ | DiscrW16 Word16
+ | DiscrW32 Word32
+ | DiscrW64 Word64
| DiscrF Float
| DiscrD Double
| DiscrP Word16
@@ -1904,7 +1950,15 @@ data Discr
instance Outputable Discr where
ppr (DiscrI i) = int i
+ ppr (DiscrI8 i) = text (show i)
+ ppr (DiscrI16 i) = text (show i)
+ ppr (DiscrI32 i) = text (show i)
+ ppr (DiscrI64 i) = text (show i)
ppr (DiscrW w) = text (show w)
+ ppr (DiscrW8 w) = text (show w)
+ ppr (DiscrW16 w) = text (show w)
+ ppr (DiscrW32 w) = text (show w)
+ ppr (DiscrW64 w) = text (show w)
ppr (DiscrF f) = text (show f)
ppr (DiscrD d) = text (show d)
ppr (DiscrP i) = ppr i
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 0107f6fc6a..b4a21a314e 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -896,6 +896,12 @@ instance Outputable Ordering where
ppr EQ = text "EQ"
ppr GT = text "GT"
+instance Outputable Int8 where
+ ppr n = integer $ fromIntegral n
+
+instance Outputable Int16 where
+ ppr n = integer $ fromIntegral n
+
instance Outputable Int32 where
ppr n = integer $ fromIntegral n
@@ -908,6 +914,9 @@ instance Outputable Int where
instance Outputable Integer where
ppr n = integer n
+instance Outputable Word8 where
+ ppr n = integer $ fromIntegral n
+
instance Outputable Word16 where
ppr n = integer $ fromIntegral n
View Lorry Controller Status