Change the story on shifting primops: SllOp, SrlOp, ISllOp, ISraOp, ISrlOp.
In the old primop story, these were implemented by C macros which
checked that the shift amount did not exceed the word size, and if so
returns a suitable value (0 or -1). This gives consistent, defined
behaviour for any shift amount. However, these checks were not
implemented on the NCG route, an inconsistency.
New story: these primops do NOT check their args; they just do the shift.
Shift values >= word size give undefined results. To reflect this, their
Haskell names have been prefixed with 'unchecked'.
The checks are now done on the Bits instances in the Prelude. This means
all code generation routes are consistently checked, and hopefully the
simplifier will remove the checks for literal shift amounts.
I have tried to fix up the implementation for 64-bit platforms too, but
not having one to hand, I don't know if it will work as-is.
-----------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.10 2001/12/05 17:35:14 sewardj Exp $
+-- $Id: primops.txt.pp,v 1.11 2001/12/07 11:34:48 sewardj Exp $
--
-- Primitive Operations
--
GenPrimOp Int# -> (# Int#, ByteArr# #)
with out_of_line = True
-primop ISllOp "iShiftL#" GenPrimOp Int# -> Int# -> Int#
- {Shift left. Return 0 if shifted by more than size of an Int\#.}
-primop ISraOp "iShiftRA#" GenPrimOp Int# -> Int# -> Int#
- {Shift right arithemetic. Return 0 if shifted by more than size of an Int\#.}
-primop ISrlOp "iShiftRL#" GenPrimOp Int# -> Int# -> Int#
- {Shift right logical. Return 0 if shifted by more than size of an Int\#.}
+primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift left. Result undefined if shift amount equals
+ or exceeds word size.}
+primop ISraOp "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right arithmetic. Result undefined if shift amount equals
+ or exceeds word size.}
+primop ISrlOp "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
+ {Shift right logical. Result undefined if shift amount equals
+ or exceeds word size.}
------------------------------------------------------------------------
section "Word#"
primop NotOp "not#" Monadic Word# -> Word#
-primop SllOp "shiftL#" GenPrimOp Word# -> Int# -> Word#
- {Shift left logical. Return 0 if shifted by more than number of bits in a Word\#.}
-primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
- {Shift right logical. Return 0 if shifted by more than number of bits in a Word\#.}
+primop SllOp "uncheckedShiftL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift left logical. Result undefined if shift amount equals
+ or exceeds word size.}
+primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word#
+ {Shift right logical. Result undefined if shift amount equals
+ or exceeds word size.}
primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.86 2001/12/05 17:35:14 sewardj Exp $
+ * $Id: PrimOps.h,v 1.87 2001/12/07 11:34:48 sewardj Exp $
*
* (c) The GHC Team, 1998-2000
*
LW_ stg_xor64 (StgWord64, StgWord64);
LW_ stg_not64 (StgWord64);
-LW_ stg_shiftL64 (StgWord64, StgInt);
-LW_ stg_shiftRL64 (StgWord64, StgInt);
-LI_ stg_iShiftL64 (StgInt64, StgInt);
-LI_ stg_iShiftRL64 (StgInt64, StgInt);
-LI_ stg_iShiftRA64 (StgInt64, StgInt);
+LW_ stg_uncheckedShiftL64 (StgWord64, StgInt);
+LW_ stg_uncheckedShiftRL64 (StgWord64, StgInt);
+LI_ stg_uncheckedIShiftL64 (StgInt64, StgInt);
+LI_ stg_uncheckedIShiftRL64 (StgInt64, StgInt);
+LI_ stg_uncheckedIShiftRA64 (StgInt64, StgInt);
LI_ stg_intToInt64 (StgInt);
I_ stg_int64ToInt (StgInt64);
% -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.55 2001/10/17 15:40:02 simonpj Exp $
+% $Id: PrelBase.lhs,v 1.56 2001/12/07 11:34:48 sewardj Exp $
%
% (c) The University of Glasgow, 1992-2000
%
| ch `eqChar#` '\0'# = []
| ch `leChar#` '\x7F'# = C# ch : unpack (nh +# 1#)
| ch `leChar#` '\xDF'# =
- C# (chr# ((ord# ch -# 0xC0#) `iShiftL#` 6# +#
+ C# (chr# ((ord# ch -# 0xC0#) `uncheckedIShiftL#` 6# +#
(ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#))) :
unpack (nh +# 2#)
| ch `leChar#` '\xEF'# =
- C# (chr# ((ord# ch -# 0xE0#) `iShiftL#` 12# +#
- (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 6# +#
+ C# (chr# ((ord# ch -# 0xE0#) `uncheckedIShiftL#` 12# +#
+ (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 6# +#
(ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#))) :
unpack (nh +# 3#)
| otherwise =
- C# (chr# ((ord# ch -# 0xF0#) `iShiftL#` 18# +#
- (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `iShiftL#` 12# +#
- (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `iShiftL#` 6# +#
+ C# (chr# ((ord# ch -# 0xF0#) `uncheckedIShiftL#` 18# +#
+ (ord# (indexCharOffAddr# addr (nh +# 1#)) -# 0x80#) `uncheckedIShiftL#` 12# +#
+ (ord# (indexCharOffAddr# addr (nh +# 2#)) -# 0x80#) `uncheckedIShiftL#` 6# +#
(ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
unpack (nh +# 4#)
where
(I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I# x#) `shift` (I# i#)
- | i# >=# 0# = I# (x# `iShiftL#` i#)
- | otherwise = I# (x# `iShiftRA#` negateInt# i#)
+ | i# ==# 0# = I# x#
+ | i# >=# wsib = 0
+ | i# ># 0# = I# (x# `uncheckedIShiftL#` i#)
+ | i# <=# nwsib = I# (if x# <# 0# then -1# else 0#)
+ | otherwise = I# (x# `uncheckedIShiftRA#` negateInt# i#)
+ where
+ wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ nwsib = negateInt# wsib
(I# x#) `rotate` (I# i#) =
- I# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (wsib -# i'#))))
+ I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (wsib -# i'#))))
where
- x'# = int2Word# x#
- i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
- wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ x'# = int2Word# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+ wsib = WORD_SIZE_IN_BITS#
bitSize _ = WORD_SIZE_IN_BITS
isSigned _ = True
\end{code}
remIntzh
gcdIntzh
negateIntzh
- iShiftLzh
- iShiftRAzh
- iShiftRLzh
+ uncheckedIShiftLzh
+ uncheckedIShiftRAzh
+ uncheckedIShiftRLzh
addIntCzh
subIntCzh
mulIntCzh
orzh
notzh
xorzh
- shiftLzh
- shiftRLzh
+ uncheckedShiftLzh
+ uncheckedShiftRLzh
int2Wordzh
word2Intzh
(I8# x#) `xor` (I8# y#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I8# x#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I8# x#) `shift` (I# i#)
- | i# >=# 0# = I8# (narrow8Int# (x# `iShiftL#` i#))
- | otherwise = I8# (x# `iShiftRA#` negateInt# i#)
+ | i# ==# 0# = I8# x#
+ | i# >=# 8# = I8# 0#
+ | i# ># 0# = I8# (narrow8Int# (x# `uncheckedIShiftL#` i#))
+ | i# <=# -8# = I8# (if x# <# 0# then -1# else 0#)
+ | otherwise = I8# (x# `uncheckedIShiftRA#` negateInt# i#)
(I8# x#) `rotate` (I# i#)
| i'# ==# 0#
= I8# x#
| otherwise
- = I8# (narrow8Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (8# -# i'#)))))
+ = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (8# -# i'#)))))
where
x'# = narrow8Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
(I16# x#) `xor` (I16# y#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I16# x#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I16# x#) `shift` (I# i#)
- | i# >=# 0# = I16# (narrow16Int# (x# `iShiftL#` i#))
- | otherwise = I16# (x# `iShiftRA#` negateInt# i#)
+ | i# ==# 0# = I16# x#
+ | i# >=# 16# = I16# 0#
+ | i# ># 0# = I16# (narrow16Int# (x# `uncheckedIShiftL#` i#))
+ | i# <=# -16# = I16# (if x# <# 0# then -1# else 0#)
+ | otherwise = I16# (x# `uncheckedIShiftRA#` negateInt# i#)
(I16# x#) `rotate` (I# i#)
| i'# ==# 0#
= I16# x#
| otherwise
- = I16# (narrow16Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (16# -# i'#)))))
+ = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (16# -# i'#)))))
where
x'# = narrow16Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
(I32# x#) `xor` (I32# y#) = I32# (word32ToInt32# (int32ToWord32# x# `xor32#` int32ToWord32# y#))
complement (I32# x#) = I32# (word32ToInt32# (not32# (int32ToWord32# x#)))
(I32# x#) `shift` (I# i#)
- | i# >=# 0# = I32# (x# `iShiftL32#` i#)
- | otherwise = I32# (x# `iShiftRA32#` negateInt# i#)
+ | i# ==# 0# = I32# x#
+ | i# >=# 32# = I32# 0#
+ | i# ># 0# = I32# (x# `uncheckedIShiftL32#` i#)
+ | i# <=# -32# = I32# (if x# <# 0# then -1# else 0#)
+ | otherwise = I32# (x# `uncheckedIShiftRA32#` negateInt# i#)
(I32# x#) `rotate` (I# i#)
| i'# ==# 0#
= I32# x#
| otherwise
- = I32# (word32ToInt32# ((x'# `shiftL32#` i'#) `or32#`
- (x'# `shiftRL32#` (32# -# i'#))))
+ = I32# (word32ToInt32# ((x'# `uncheckedShiftL32#` i'#) `or32#`
+ (x'# `uncheckedShiftRL32#` (32# -# i'#))))
where
x'# = int32ToWord32# x#
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
foreign import "stg_or32" unsafe or32# :: Word32# -> Word32# -> Word32#
foreign import "stg_xor32" unsafe xor32# :: Word32# -> Word32# -> Word32#
foreign import "stg_not32" unsafe not32# :: Word32# -> Word32#
-foreign import "stg_iShiftL32" unsafe iShiftL32# :: Int32# -> Int# -> Int32#
-foreign import "stg_iShiftRA32" unsafe iShiftRA32# :: Int32# -> Int# -> Int32#
-foreign import "stg_shiftL32" unsafe shiftL32# :: Word32# -> Int# -> Word32#
-foreign import "stg_shiftRL32" unsafe shiftRL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_uncheckedIShiftL32" unsafe uncheckedIShiftL32# :: Int32# -> Int# -> Int32#
+foreign import "stg_uncheckedIShiftRA32" unsafe uncheckedIShiftRA32# :: Int32# -> Int# -> Int32#
+foreign import "stg_uncheckedShiftL32" unsafe uncheckedShiftL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_uncheckedShiftRL32" unsafe uncheckedShiftRL32# :: Word32# -> Int# -> Word32#
{-# RULES
"fromIntegral/Int->Int32" fromIntegral = \(I# x#) -> I32# (intToInt32# x#)
(I32# x#) `xor` (I32# y#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I32# x#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I32# x#) `shift` (I# i#)
- | i# >=# 0# = I32# (narrow32Int# (x# `iShiftL#` i#))
- | otherwise = I32# (x# `iShiftRA#` negateInt# i#)
+ | i# ==# 0# = I32# x#
+ | i# >=# 32# = I32# 0#
+ | i# ># 0# = I32# (narrow32Int# (x# `uncheckedIShiftL#` i#))
+ | i# <=# -32# = I32# (if x# <# 0# then -1# else 0#)
+ | otherwise = I32# (x# `uncheckedIShiftRA#` negateInt# i#)
(I32# x#) `rotate` (I# i#)
| i'# ==# 0#
= I32# x#
| otherwise
- = I32# (narrow32Int# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (32# -# i'#)))))
+ = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (32# -# i'#)))))
where
x'# = narrow32Word# (int2Word# x#)
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
(I64# x#) `xor` (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))
complement (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))
(I64# x#) `shift` (I# i#)
- | i# >=# 0# = I64# (x# `iShiftL64#` i#)
- | otherwise = I64# (x# `iShiftRA64#` negateInt# i#)
+ | i# ==# 0# = I64# x#
+ | i# >=# 64# = 0
+ | i# ># 0# = I64# (x# `uncheckedIShiftL64#` i#)
+ | i# <=# -64# = if (I64# x#) < 0 then -1 else 0
+ | otherwise = I64# (x# `uncheckedIShiftRA64#` negateInt# i#)
(I64# x#) `rotate` (I# i#)
| i'# ==# 0#
= I64# x#
| otherwise
- = I64# (word64ToInt64# ((x'# `shiftL64#` i'#) `or64#`
- (x'# `shiftRL64#` (64# -# i'#))))
+ = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`
+ (x'# `uncheckedShiftRL64#` (64# -# i'#))))
where
x'# = int64ToWord64# x#
i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
-foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64#
-foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64#
-foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
-foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_uncheckedIShiftL64" unsafe uncheckedIShiftL64# :: Int64# -> Int# -> Int64#
+foreign import "stg_uncheckedIShiftRA64" unsafe uncheckedIShiftRA64# :: Int64# -> Int# -> Int64#
+foreign import "stg_uncheckedShiftL64" unsafe uncheckedShiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_uncheckedShiftRL64" unsafe uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
foreign import "stg_integerToInt64" unsafe integerToInt64# :: Int# -> ByteArray# -> Int64#
(I64# x#) `xor` (I64# y#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))
complement (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
(I64# x#) `shift` (I# i#)
- | i# >=# 0# = I64# (x# `iShiftL#` i#)
- | otherwise = I64# (x# `iShiftRA#` negateInt# i#)
+ | i# ==# 0# = I64# x#
+ | i# >=# 64# = 0
+ | i# ># 0# = I64# (x# `uncheckedIShiftL#` i#)
+ | i# <=# -64# = if x# <# 0# then -1 else 0
+ | otherwise = I64# (x# `uncheckedIShiftRA#` negateInt# i#)
(I64# x#) `rotate` (I# i#)
| i'# ==# 0#
= I64# x#
| otherwise
- = I64# (word2Int# ((x'# `shiftL#` i'#) `or#`
- (x'# `shiftRL#` (64# -# i'#))))
+ = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
+ (x'# `uncheckedShiftRL#` (64# -# i'#))))
where
x'# = int2Word# x#
i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
(W# x#) `xor` (W# y#) = W# (x# `xor#` y#)
complement (W# x#) = W# (x# `xor#` mb#) where W# mb# = maxBound
(W# x#) `shift` (I# i#)
- | i# >=# 0# = W# (x# `shiftL#` i#)
- | otherwise = W# (x# `shiftRL#` negateInt# i#)
+ | i# ==# 0# = W# x#
+ | i# >=# wsib = W# (int2Word# 0#)
+ | i# ># 0# = W# (x# `uncheckedShiftL#` i#)
+ | i# <=# nwsib = W# (int2Word# 0#)
+ | otherwise = W# (x# `uncheckedShiftRL#` negateInt# i#)
+ where
+ wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ nwsib = negateInt# wsib
(W# x#) `rotate` (I# i#)
| i'# ==# 0# = W# x#
- | otherwise = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (wsib -# i'#)))
+ | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#`
+ (x# `uncheckedShiftRL#` (wsib -# i'#)))
where
- i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
- wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -}
+ i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+ wsib = WORD_SIZE_IN_BITS#
bitSize _ = WORD_SIZE_IN_BITS
isSigned _ = False
(W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#)
complement (W8# x#) = W8# (x# `xor#` mb#) where W8# mb# = maxBound
(W8# x#) `shift` (I# i#)
- | i# >=# 0# = W8# (narrow8Word# (x# `shiftL#` i#))
- | otherwise = W8# (x# `shiftRL#` negateInt# i#)
+ | i# ==# 0# = W8# x#
+ | i# >=# 8# || i# <=# -8# = W8# (int2Word# 0#)
+ | i# ># 0# = W8# (narrow8Word# (x# `uncheckedShiftL#` i#))
+ | otherwise = W8# (x# `uncheckedShiftRL#` negateInt# i#)
(W8# x#) `rotate` (I# i#)
| i'# ==# 0# = W8# x#
- | otherwise = W8# (narrow8Word# ((x# `shiftL#` i'#) `or#`
- (x# `shiftRL#` (8# -# i'#))))
+ | otherwise = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`
+ (x# `uncheckedShiftRL#` (8# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
bitSize _ = 8
(W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#)
complement (W16# x#) = W16# (x# `xor#` mb#) where W16# mb# = maxBound
(W16# x#) `shift` (I# i#)
- | i# >=# 0# = W16# (narrow16Word# (x# `shiftL#` i#))
- | otherwise = W16# (x# `shiftRL#` negateInt# i#)
+ | i# ==# 0# = W16# x#
+ | i# >=# 16# || i# <=# -16# = W16# (int2Word# 0#)
+ | i# ># 0# = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
+ | otherwise = W16# (x# `uncheckedShiftRL#` negateInt# i#)
(W16# x#) `rotate` (I# i#)
| i'# ==# 0# = W16# x#
- | otherwise = W16# (narrow16Word# ((x# `shiftL#` i'#) `or#`
- (x# `shiftRL#` (16# -# i'#))))
+ | otherwise = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`
+ (x# `uncheckedShiftRL#` (16# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
bitSize _ = 16
(W32# x#) `xor` (W32# y#) = W32# (x# `xor32#` y#)
complement (W32# x#) = W32# (not32# x#)
(W32# x#) `shift` (I# i#)
- | i# >=# 0# = W32# (x# `shiftL32#` i#)
- | otherwise = W32# (x# `shiftRL32#` negateInt# i#)
+ | i# ==# 0# = W32# x#
+ | i# >=# 32# || i# <=# -32# = W32# (int2Word# 0#)
+ | i# ># 0# = W32# (x# `uncheckedShiftL32#` i#)
+ | otherwise = W32# (x# `uncheckedShiftRL32#` negateInt# i#)
(W32# x#) `rotate` (I# i#)
| i'# ==# 0# = W32# x#
- | otherwise = W32# ((x# `shiftL32#` i'#) `or32#`
- (x# `shiftRL32#` (32# -# i'#)))
+ | otherwise = W32# ((x# `uncheckedShiftL32#` i'#) `or32#`
+ (x# `uncheckedShiftRL32#` (32# -# i'#)))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
bitSize _ = 32
foreign import "stg_or32" unsafe or32# :: Word32# -> Word32# -> Word32#
foreign import "stg_xor32" unsafe xor32# :: Word32# -> Word32# -> Word32#
foreign import "stg_not32" unsafe not32# :: Word32# -> Word32#
-foreign import "stg_shiftL32" unsafe shiftL32# :: Word32# -> Int# -> Word32#
-foreign import "stg_shiftRL32" unsafe shiftRL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_uncheckedShiftL32" unsafe uncheckedShiftL32# :: Word32# -> Int# -> Word32#
+foreign import "stg_uncheckedShiftRL32" unsafe uncheckedShiftRL32# :: Word32# -> Int# -> Word32#
{-# RULES
"fromIntegral/Int->Word32" fromIntegral = \(I# x#) -> W32# (int32ToWord32# (intToInt32# x#))
(W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#)
complement (W32# x#) = W32# (x# `xor#` mb#) where W32# mb# = maxBound
(W32# x#) `shift` (I# i#)
- | i# >=# 0# = W32# (narrow32Word# (x# `shiftL#` i#))
- | otherwise = W32# (x# `shiftRL#` negateInt# i#)
+ | i# ==# 0# = W32# x#
+ | i# >=# 32# || i# <=# -32# = W32# (int2Word# 0#)
+ | i# ># 0# = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
+ | otherwise = W32# (x# `uncheckedShiftRL#` negateInt# i#)
(W32# x#) `rotate` (I# i#)
| i'# ==# 0# = W32# x#
- | otherwise = W32# (narrow32Word# ((x# `shiftL#` i'#) `or#`
- (x# `shiftRL#` (32# -# i'#))))
+ | otherwise = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`
+ (x# `uncheckedShiftRL#` (32# -# i'#))))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
bitSize _ = 32
(W64# x#) `xor` (W64# y#) = W64# (x# `xor64#` y#)
complement (W64# x#) = W64# (not64# x#)
(W64# x#) `shift` (I# i#)
- | i# >=# 0# = W64# (x# `shiftL64#` i#)
- | otherwise = W64# (x# `shiftRL64#` negateInt# i#)
+ | i# ==# 0# = W64# x#
+ | i# >=# 64# || i# <=# -64# = 0
+ | i# ># 0# = W64# (x# `uncheckedShiftL64#` i#)
+ | otherwise = W64# (x# `uncheckedShiftRL64#` negateInt# i#)
(W64# x#) `rotate` (I# i#)
| i'# ==# 0# = W64# x#
- | otherwise = W64# ((x# `shiftL64#` i'#) `or64#`
- (x# `shiftRL64#` (64# -# i'#)))
+ | otherwise = W64# ((x# `uncheckedShiftL64#` i'#) `or64#`
+ (x# `uncheckedShiftRL64#` (64# -# i'#)))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
bitSize _ = 64
foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
-foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
-foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_uncheckedShiftL64" unsafe uncheckedShiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_uncheckedShiftRL64" unsafe uncheckedShiftRL64# :: Word64# -> Int# -> Word64#
foreign import "stg_integerToWord64" unsafe integerToWord64# :: Int# -> ByteArray# -> Word64#
(W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#)
complement (W64# x#) = W64# (x# `xor#` mb#) where W64# mb# = maxBound
(W64# x#) `shift` (I# i#)
- | i# >=# 0# = W64# (x# `shiftL#` i#)
- | otherwise = W64# (x# `shiftRL#` negateInt# i#)
+ | i# ==# 0# = W64# x#
+ | i# >=# 64# || i# <=# -64# = 0
+ | i# ># 0# = W64# (x# `uncheckedShiftL#` i#)
+ | otherwise = W64# (x# `uncheckedShiftRL#` negateInt# i#)
(W64# x#) `rotate` (I# i#)
| i'# ==# 0# = W64# x#
- | otherwise = W64# ((x# `shiftL#` i'#) `or#`
- (x# `shiftRL#` (64# -# i'#)))
+ | otherwise = W64# ((x# `uncheckedShiftL#` i'#) `or#`
+ (x# `uncheckedShiftRL#` (64# -# i'#)))
where
i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
bitSize _ = 64
/* -----------------------------------------------------------------------------
- * $Id: longlong.c,v 1.4 2001/12/05 17:35:15 sewardj Exp $
+ * $Id: longlong.c,v 1.5 2001/12/07 11:34:48 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;}
StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;}
StgWord64 stg_not64 (StgWord64 a) {return ~a;}
-StgWord64 stg_shiftL64 (StgWord64 a, StgInt b) {return a << b;}
-StgWord64 stg_shiftRL64 (StgWord64 a, StgInt b) {return a >> b;}
+
+StgWord64 stg_uncheckedShiftL64 (StgWord64 a, StgInt b) {return a << b;}
+StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;}
/* Right shifting of signed quantities is not portable in C, so
the behaviour you'll get from using these primops depends
on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
*/
-StgInt64 stg_iShiftL64 (StgInt64 a, StgInt b) {return a << b;}
-StgInt64 stg_iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;}
-StgInt64 stg_iShiftRL64 (StgInt64 a, StgInt b)
-{return (StgInt64) ((StgWord64) a >> b);}
+StgInt64 stg_uncheckedIShiftL64 (StgInt64 a, StgInt b) {return a << b;}
+StgInt64 stg_uncheckedIShiftRA64 (StgInt64 a, StgInt b) {return a >> b;}
+StgInt64 stg_uncheckedIShiftRL64 (StgInt64 a, StgInt b)
+ {return (StgInt64) ((StgWord64) a >> b);}
/* Casting between longs and longer longs.
(the primops that cast from long longs to Integers
projects / ghc-hetmet.git / commitdiff