Commit 5861bb81 authored by sewardj's avatar sewardj
Browse files

[project @ 2001-12-07 11:34:48 by sewardj]

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.
parent a523b9fb
-----------------------------------------------------------------------
-- $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
--
......@@ -226,12 +226,15 @@ primop Int2IntegerOp "int2Integer#"
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#"
......@@ -263,10 +266,12 @@ primop XorOp "xor#" Dyadic Word# -> Word# -> 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
*
......@@ -210,11 +210,11 @@ LW_ stg_or64 (StgWord64, StgWord64);
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
%
......@@ -746,18 +746,18 @@ unpackCStringUtf8# addr
| 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
......
......@@ -61,15 +61,21 @@ instance Bits Int 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}
......@@ -90,9 +90,9 @@ __export PrelGHC
remIntzh
gcdIntzh
negateIntzh
iShiftLzh
iShiftRAzh
iShiftRLzh
uncheckedIShiftLzh
uncheckedIShiftRAzh
uncheckedIShiftRLzh
addIntCzh
subIntCzh
mulIntCzh
......@@ -113,8 +113,8 @@ __export PrelGHC
orzh
notzh
xorzh
shiftLzh
shiftRLzh
uncheckedShiftLzh
uncheckedShiftRLzh
int2Wordzh
word2Intzh
......
......@@ -110,14 +110,17 @@ instance Bits Int8 where
(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#)
......@@ -218,14 +221,17 @@ instance Bits Int16 where
(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#)
......@@ -339,14 +345,17 @@ instance Bits Int32 where
(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#)
......@@ -374,10 +383,10 @@ foreign import "stg_and32" unsafe and32# :: Word32# -> Word32# -
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#)
......@@ -466,14 +475,17 @@ instance Bits Int32 where
(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#)
......@@ -608,14 +620,17 @@ instance Bits Int64 where
(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#)
......@@ -643,10 +658,10 @@ foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -
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#
......@@ -726,14 +741,17 @@ instance Bits Int64 where
(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#)
......
......@@ -154,14 +154,21 @@ instance Bits Word where
(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
......@@ -255,12 +262,14 @@ instance Bits Word8 where
(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
......@@ -357,12 +366,14 @@ instance Bits Word16 where
(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
......@@ -453,12 +464,14 @@ instance Bits Word32 where
(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
......@@ -485,8 +498,8 @@ foreign import "stg_and32" unsafe and32# :: Word32# -> Word32# -
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#))
......@@ -581,12 +594,14 @@ instance Bits Word32 where
(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
......@@ -711,12 +726,14 @@ instance Bits Word64 where
(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
......@@ -743,8 +760,8 @@ foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -
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#
......@@ -826,12 +843,14 @@ instance Bits Word64 where
(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
*
......@@ -63,16 +63,17 @@ StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;}
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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment