summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp106
-rw-r--r--compiler/GHC/Core/TyCon.hs4
-rw-r--r--compiler/GHC/Platform.hs2
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs48
-rw-r--r--compiler/GHC/Tc/Deriv/Generate.hs38
5 files changed, 180 insertions, 18 deletions
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index e9a9e96cee..37a3b33979 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -214,18 +214,16 @@ section "The word size story."
represented as {\tt Int\#} and {\tt Word\#}, and the
operations implemented in terms of the primops on these
types, with suitable range restrictions on the results (using
- the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families
- of primops. The 32-bit sizes are represented using {\tt
- Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS}
- $\geq$ 32; otherwise, these are represented using distinct
- primitive types {\tt Int32\#} and {\tt Word32\#}. These (when
- needed) have a complete set of corresponding operations;
- however, nearly all of these are implemented as external C
- functions rather than as primops. Exactly the same story
- applies to the 64-bit sizes. All of these details are hidden
+ the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families of
+ primops. The 64-bit sizes are represented using {\tt Int\#}
+ and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS} $\geq$ 64;
+ otherwise, these are represented using distinct primitive
+ types {\tt Int64\#} and {\tt Word64\#}. These (when needed)
+ have a complete set of corresponding operations; however,
+ nearly all of these are implemented as external C functions
+ rather than as primops. All of these details are hidden
under the {\tt PrelInt} and {\tt PrelWord} modules, which use
- {\tt \#if}-defs to invoke the appropriate types and
- operators.
+ {\tt \#if}-defs to invoke the appropriate types and operators.
Word size also matters for the families of primops for
indexing/reading/writing fixed-size quantities at offsets
@@ -458,9 +456,47 @@ primtype Int32#
primop Int32ToIntOp "extendInt32#" GenPrimOp Int32# -> Int#
primop IntToInt32Op "narrowInt32#" GenPrimOp Int# -> Int32#
+primop Int32NegOp "negateInt32#" GenPrimOp Int32# -> Int32#
+
+primop Int32AddOp "plusInt32#" GenPrimOp Int32# -> Int32# -> Int32#
+ with
+ commutable = True
+
+primop Int32SubOp "subInt32#" GenPrimOp Int32# -> Int32# -> Int32#
+
+primop Int32MulOp "timesInt32#" GenPrimOp Int32# -> Int32# -> Int32#
+ with
+ commutable = True
+
+primop Int32QuotOp "quotInt32#" GenPrimOp Int32# -> Int32# -> Int32#
+ with
+ can_fail = True
+
+primop Int32RemOp "remInt32#" GenPrimOp Int32# -> Int32# -> Int32#
+ with
+ can_fail = True
+
+primop Int32QuotRemOp "quotRemInt32#" GenPrimOp Int32# -> Int32# -> (# Int32#, Int32# #)
+ with
+ can_fail = True
+
+primop Int32SllOp "uncheckedShiftLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+primop Int32SraOp "uncheckedShiftRAInt32#" GenPrimOp Int32# -> Int# -> Int32#
+primop Int32SrlOp "uncheckedShiftRLInt32#" GenPrimOp Int32# -> Int# -> Int32#
+
+primop Int32ToWord32Op "int32ToWord32#" GenPrimOp Int32# -> Word32#
+ with code_size = 0
+
+primop Int32EqOp "eqInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32GeOp "geInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32GtOp "gtInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32LeOp "leInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32LtOp "ltInt32#" Compare Int32# -> Int32# -> Int#
+primop Int32NeOp "neInt32#" Compare Int32# -> Int32# -> Int#
+
------------------------------------------------------------------------
section "Word32#"
- {Operations on 32-bit unsigned integers.}
+ {Operations on 32-bit unsigned words.}
------------------------------------------------------------------------
primtype Word32#
@@ -468,6 +504,52 @@ primtype Word32#
primop Word32ToWordOp "extendWord32#" GenPrimOp Word32# -> Word#
primop WordToWord32Op "narrowWord32#" GenPrimOp Word# -> Word32#
+primop Word32AddOp "plusWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with
+ commutable = True
+
+primop Word32SubOp "subWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+
+primop Word32MulOp "timesWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with
+ commutable = True
+
+primop Word32QuotOp "quotWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with
+ can_fail = True
+
+primop Word32RemOp "remWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with
+ can_fail = True
+
+primop Word32QuotRemOp "quotRemWord32#" GenPrimOp Word32# -> Word32# -> (# Word32#, Word32# #)
+ with
+ can_fail = True
+
+primop Word32AndOp "andWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32OrOp "orWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32XorOp "xorWord32#" GenPrimOp Word32# -> Word32# -> Word32#
+ with commutable = True
+
+primop Word32NotOp "not32Word#" GenPrimOp Word32# -> Word32#
+
+primop Word32SllOp "uncheckedShiftLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+primop Word32SrlOp "uncheckedShiftRLWord32#" GenPrimOp Word32# -> Int# -> Word32#
+
+primop Word32ToInt32Op "word32ToInt32#" GenPrimOp Word32# -> Int32#
+ with code_size = 0
+
+primop Word32EqOp "eqWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32GeOp "geWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32GtOp "gtWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32LeOp "leWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32LtOp "ltWord32#" Compare Word32# -> Word32# -> Int#
+primop Word32NeOp "neWord32#" Compare Word32# -> Word32# -> Int#
+
#if WORD_SIZE_IN_BITS < 64
------------------------------------------------------------------------
section "Int64#"
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index 0cd1463b46..4db3167bd7 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -1517,11 +1517,11 @@ primRepSizeB platform = \case
Int8Rep -> 1
Int16Rep -> 2
Int32Rep -> 4
- Int64Rep -> wORD64_SIZE
+ Int64Rep -> 8
Word8Rep -> 1
Word16Rep -> 2
Word32Rep -> 4
- Word64Rep -> wORD64_SIZE
+ Word64Rep -> 8
FloatRep -> fLOAT_SIZE
DoubleRep -> dOUBLE_SIZE
AddrRep -> platformWordSizeInBytes platform
diff --git a/compiler/GHC/Platform.hs b/compiler/GHC/Platform.hs
index 858d5a4101..1e6add2b46 100644
--- a/compiler/GHC/Platform.hs
+++ b/compiler/GHC/Platform.hs
@@ -74,7 +74,7 @@ data Platform = Platform
data PlatformWordSize
= PW4 -- ^ A 32-bit platform
| PW8 -- ^ A 64-bit platform
- deriving (Eq)
+ deriving (Eq, Ord)
instance Show PlatformWordSize where
show PW4 = "4"
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index ef7b0feddc..afb495e9e7 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -1079,6 +1079,8 @@ emitPrimOp dflags primop = case primop of
-- The rest just translate straightforwardly
+ Int32ToWord32Op -> \args -> opNop args
+ Word32ToInt32Op -> \args -> opNop args
IntToWordOp -> \args -> opNop args
WordToIntOp -> \args -> opNop args
IntToAddrOp -> \args -> opNop args
@@ -1269,11 +1271,47 @@ emitPrimOp dflags primop = case primop of
Int32ToIntOp -> \args -> opTranslate args (MO_SS_Conv W32 (wordWidth platform))
IntToInt32Op -> \args -> opTranslate args (MO_SS_Conv (wordWidth platform) W32)
+ Int32NegOp -> \args -> opTranslate args (MO_S_Neg W32)
+ Int32AddOp -> \args -> opTranslate args (MO_Add W32)
+ Int32SubOp -> \args -> opTranslate args (MO_Sub W32)
+ Int32MulOp -> \args -> opTranslate args (MO_Mul W32)
+ Int32QuotOp -> \args -> opTranslate args (MO_S_Quot W32)
+ Int32RemOp -> \args -> opTranslate args (MO_S_Rem W32)
+
+ Int32SllOp -> \args -> opTranslate args (MO_Shl W32)
+ Int32SraOp -> \args -> opTranslate args (MO_S_Shr W32)
+ Int32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
+
+ Int32EqOp -> \args -> opTranslate args (MO_Eq W32)
+ Int32GeOp -> \args -> opTranslate args (MO_S_Ge W32)
+ Int32GtOp -> \args -> opTranslate args (MO_S_Gt W32)
+ Int32LeOp -> \args -> opTranslate args (MO_S_Le W32)
+ Int32LtOp -> \args -> opTranslate args (MO_S_Lt W32)
+ Int32NeOp -> \args -> opTranslate args (MO_Ne W32)
-- Word32# unsigned ops
Word32ToWordOp -> \args -> opTranslate args (MO_UU_Conv W32 (wordWidth platform))
WordToWord32Op -> \args -> opTranslate args (MO_UU_Conv (wordWidth platform) W32)
+ Word32AddOp -> \args -> opTranslate args (MO_Add W32)
+ Word32SubOp -> \args -> opTranslate args (MO_Sub W32)
+ Word32MulOp -> \args -> opTranslate args (MO_Mul W32)
+ Word32QuotOp -> \args -> opTranslate args (MO_U_Quot W32)
+ Word32RemOp -> \args -> opTranslate args (MO_U_Rem W32)
+
+ Word32AndOp -> \args -> opTranslate args (MO_And W32)
+ Word32OrOp -> \args -> opTranslate args (MO_Or W32)
+ Word32XorOp -> \args -> opTranslate args (MO_Xor W32)
+ Word32NotOp -> \args -> opTranslate args (MO_Not W32)
+ Word32SllOp -> \args -> opTranslate args (MO_Shl W32)
+ Word32SrlOp -> \args -> opTranslate args (MO_U_Shr W32)
+
+ Word32EqOp -> \args -> opTranslate args (MO_Eq W32)
+ Word32GeOp -> \args -> opTranslate args (MO_U_Ge W32)
+ Word32GtOp -> \args -> opTranslate args (MO_U_Gt W32)
+ Word32LeOp -> \args -> opTranslate args (MO_U_Le W32)
+ Word32LtOp -> \args -> opTranslate args (MO_U_Lt W32)
+ Word32NeOp -> \args -> opTranslate args (MO_Ne W32)
-- Char# ops
@@ -1380,6 +1418,11 @@ emitPrimOp dflags primop = case primop of
then Left (MO_S_QuotRem W16)
else Right (genericIntQuotRemOp W16)
+ Int32QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_S_QuotRem W32)
+ else Right (genericIntQuotRemOp W32)
+
WordQuotRemOp -> \args -> opCallishHandledLater args $
if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
then Left (MO_U_QuotRem (wordWidth platform))
@@ -1400,6 +1443,11 @@ emitPrimOp dflags primop = case primop of
then Left (MO_U_QuotRem W16)
else Right (genericWordQuotRemOp W16)
+ Word32QuotRemOp -> \args -> opCallishHandledLater args $
+ if ncg && (x86ish || ppc) && not (quotRemCanBeOptimized args)
+ then Left (MO_U_QuotRem W32)
+ else Right (genericWordQuotRemOp W32)
+
WordAdd2Op -> \args -> opCallishHandledLater args $
if (ncg && (x86ish || ppc)) || llvm
then Left (MO_Add2 (wordWidth platform))
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 3c45c8f379..d5ecd102a2 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1511,14 +1511,18 @@ gfoldl_RDR, gunfold_RDR, toConstr_RDR, dataTypeOf_RDR, mkConstr_RDR,
eqInt_RDR , ltInt_RDR , geInt_RDR , gtInt_RDR , leInt_RDR ,
eqInt8_RDR , ltInt8_RDR , geInt8_RDR , gtInt8_RDR , leInt8_RDR ,
eqInt16_RDR , ltInt16_RDR , geInt16_RDR , gtInt16_RDR , leInt16_RDR ,
+ eqInt32_RDR , ltInt32_RDR , geInt32_RDR , gtInt32_RDR , leInt32_RDR ,
eqWord_RDR , ltWord_RDR , geWord_RDR , gtWord_RDR , leWord_RDR ,
eqWord8_RDR , ltWord8_RDR , geWord8_RDR , gtWord8_RDR , leWord8_RDR ,
eqWord16_RDR, ltWord16_RDR, geWord16_RDR, gtWord16_RDR, leWord16_RDR,
+ eqWord32_RDR, ltWord32_RDR, geWord32_RDR, gtWord32_RDR, leWord32_RDR,
eqAddr_RDR , ltAddr_RDR , geAddr_RDR , gtAddr_RDR , leAddr_RDR ,
eqFloat_RDR , ltFloat_RDR , geFloat_RDR , gtFloat_RDR , leFloat_RDR ,
eqDouble_RDR, ltDouble_RDR, geDouble_RDR, gtDouble_RDR, leDouble_RDR,
extendWord8_RDR, extendInt8_RDR,
- extendWord16_RDR, extendInt16_RDR :: RdrName
+ extendWord16_RDR, extendInt16_RDR,
+ extendWord32_RDR, extendInt32_RDR
+ :: RdrName
gfoldl_RDR = varQual_RDR gENERICS (fsLit "gfoldl")
gunfold_RDR = varQual_RDR gENERICS (fsLit "gunfold")
toConstr_RDR = varQual_RDR gENERICS (fsLit "toConstr")
@@ -1559,6 +1563,12 @@ leInt16_RDR = varQual_RDR gHC_PRIM (fsLit "leInt16#")
gtInt16_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt16#" )
geInt16_RDR = varQual_RDR gHC_PRIM (fsLit "geInt16#")
+eqInt32_RDR = varQual_RDR gHC_PRIM (fsLit "eqInt32#")
+ltInt32_RDR = varQual_RDR gHC_PRIM (fsLit "ltInt32#" )
+leInt32_RDR = varQual_RDR gHC_PRIM (fsLit "leInt32#")
+gtInt32_RDR = varQual_RDR gHC_PRIM (fsLit "gtInt32#" )
+geInt32_RDR = varQual_RDR gHC_PRIM (fsLit "geInt32#")
+
eqWord_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord#")
ltWord_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord#")
leWord_RDR = varQual_RDR gHC_PRIM (fsLit "leWord#")
@@ -1577,6 +1587,12 @@ leWord16_RDR = varQual_RDR gHC_PRIM (fsLit "leWord16#")
gtWord16_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord16#" )
geWord16_RDR = varQual_RDR gHC_PRIM (fsLit "geWord16#")
+eqWord32_RDR = varQual_RDR gHC_PRIM (fsLit "eqWord32#")
+ltWord32_RDR = varQual_RDR gHC_PRIM (fsLit "ltWord32#" )
+leWord32_RDR = varQual_RDR gHC_PRIM (fsLit "leWord32#")
+gtWord32_RDR = varQual_RDR gHC_PRIM (fsLit "gtWord32#" )
+geWord32_RDR = varQual_RDR gHC_PRIM (fsLit "geWord32#")
+
eqAddr_RDR = varQual_RDR gHC_PRIM (fsLit "eqAddr#")
ltAddr_RDR = varQual_RDR gHC_PRIM (fsLit "ltAddr#")
leAddr_RDR = varQual_RDR gHC_PRIM (fsLit "leAddr#")
@@ -1601,6 +1617,8 @@ extendInt8_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt8#")
extendWord16_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord16#")
extendInt16_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt16#")
+extendWord32_RDR = varQual_RDR gHC_PRIM (fsLit "extendWord32#")
+extendInt32_RDR = varQual_RDR gHC_PRIM (fsLit "extendInt32#")
{-
************************************************************************
@@ -2362,12 +2380,16 @@ ordOpTbl
, eqInt8_RDR , geInt8_RDR , gtInt8_RDR ))
,(int16PrimTy , (ltInt16_RDR , leInt16_RDR
, eqInt16_RDR , geInt16_RDR , gtInt16_RDR ))
+ ,(int32PrimTy , (ltInt32_RDR , leInt32_RDR
+ , eqInt32_RDR , geInt32_RDR , gtInt32_RDR ))
,(wordPrimTy , (ltWord_RDR , leWord_RDR
, eqWord_RDR , geWord_RDR , gtWord_RDR ))
,(word8PrimTy , (ltWord8_RDR , leWord8_RDR
, eqWord8_RDR , geWord8_RDR , gtWord8_RDR ))
,(word16PrimTy, (ltWord16_RDR, leWord16_RDR
, eqWord16_RDR, geWord16_RDR, gtWord16_RDR ))
+ ,(word32PrimTy, (ltWord32_RDR, leWord32_RDR
+ , eqWord32_RDR, geWord32_RDR, gtWord32_RDR ))
,(addrPrimTy , (ltAddr_RDR , leAddr_RDR
, eqAddr_RDR , geAddr_RDR , gtAddr_RDR ))
,(floatPrimTy , (ltFloat_RDR , leFloat_RDR
@@ -2390,13 +2412,19 @@ boxConTbl =
. nlHsApp (nlHsVar extendInt8_RDR))
, (word8PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord8_RDR))
+ . nlHsApp (nlHsVar extendWord8_RDR))
, (int16PrimTy,
nlHsApp (nlHsVar $ getRdrName intDataCon)
. nlHsApp (nlHsVar extendInt16_RDR))
, (word16PrimTy,
nlHsApp (nlHsVar $ getRdrName wordDataCon)
- . nlHsApp (nlHsVar extendWord16_RDR))
+ . nlHsApp (nlHsVar extendWord16_RDR))
+ , (int32PrimTy,
+ nlHsApp (nlHsVar $ getRdrName intDataCon)
+ . nlHsApp (nlHsVar extendInt32_RDR))
+ , (word32PrimTy,
+ nlHsApp (nlHsVar $ getRdrName wordDataCon)
+ . nlHsApp (nlHsVar extendWord32_RDR))
]
@@ -2412,6 +2440,8 @@ postfixModTbl
,(word8PrimTy, "##")
,(int16PrimTy, "#")
,(word16PrimTy, "##")
+ ,(int32PrimTy, "#")
+ ,(word32PrimTy, "##")
]
primConvTbl :: [(Type, String)]
@@ -2420,6 +2450,8 @@ primConvTbl =
, (word8PrimTy, "narrowWord8#")
, (int16PrimTy, "narrowInt16#")
, (word16PrimTy, "narrowWord16#")
+ , (int32PrimTy, "narrowInt32#")
+ , (word32PrimTy, "narrowWord32#")
]
litConTbl :: [(Type, LHsExpr GhcPs -> LHsExpr GhcPs)]
View Lorry Controller Status