Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix 32 bit compilation #322

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Fix 32 bit compilation #322

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
a4757c4
Fix compilation on 32bit
amesgen Sep 10, 2023
94a856e
Support GHC >=9.2 on 32bit
amesgen Sep 10, 2023
c3b5c69
i386 CI
amesgen Jun 12, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
41 changes: 41 additions & 0 deletions .github/workflows/other.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
name: Other CI
on:
- push
- pull_request
jobs:
i386:
name: i386 - ${{ matrix.ghc }}
runs-on: ubuntu-latest
container:
image: i386/debian:bookworm
strategy:
fail-fast: false
matrix:
ghc:
- 9.8.1
- 9.6.3
- 9.4.8
- 9.2.8
- 9.0.2
- 8.10.7
- 8.8.4
- 8.6.5
- 8.4.4
steps:
- name: Install system dependencies
run: |
apt-get update -y
apt-get install -y build-essential curl libffi-dev libffi8 libgmp-dev libgmp10 libncurses-dev libncurses5 libtinfo5 zlib1g-dev
curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh
env:
BOOTSTRAP_HASKELL_NONINTERACTIVE: 1
BOOTSTRAP_HASKELL_INSTALL_NO_STACK: 1
BOOTSTRAP_HASKELL_GHC_VERSION: ${{ matrix.ghc }}
- uses: actions/checkout@v1

- name: Build and test
run: |
. ~/.ghcup/env
cabal configure --enable-tests --enable-benchmarks
cabal build all
cabal test all --test-show-details=direct
16 changes: 8 additions & 8 deletions cborg/src/Codec/CBOR/Decoding.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -315,31 +315,31 @@ getDecodeAction (Decoder k) = k (\x -> return (Done x))
toInt8 :: Int# -> Int8
toInt16 :: Int# -> Int16
toInt32 :: Int# -> Int32
toInt64 :: Int# -> Int64
toWord8 :: Word# -> Word8
toWord16 :: Word# -> Word16
toWord32 :: Word# -> Word32
#if defined(ARCH_64bit)
toInt64 :: Int# -> Int64
toWord64 :: Word# -> Word64
#else
toInt64 :: Int64# -> Int64
toWord64 :: Word64# -> Word64
#endif
#if MIN_VERSION_ghc_prim(0,8,0)
toInt8 n = I8# (intToInt8# n)
toInt16 n = I16# (intToInt16# n)
toInt32 n = I32# (intToInt32# n)
toWord8 n = W8# (wordToWord8# n)
toWord16 n = W16# (wordToWord16# n)
toWord32 n = W32# (wordToWord32# n)
#if WORD_SIZE_IN_BITS == 64
#if MIN_VERSION_base(4,17,0)
#if MIN_VERSION_base(4,17,0) && defined(ARCH_64bit)
toInt64 n = I64# (intToInt64# n)
toWord64 n = W64# (wordToWord64# n)
#else
toInt64 n = I64# n
toWord64 n = W64# n
#endif
#else
toInt64 n = I64# (intToInt64# n)
toWord64 n = W64# (wordToWord64# n)
#endif
#else
toInt8 n = I8# n
toInt16 n = I16# n
toInt32 n = I32# n
Expand Down Expand Up @@ -986,7 +986,7 @@ type ByteOffset = Int64
-- @since 0.2.2.0
peekByteOffset :: Decoder s ByteOffset
peekByteOffset = Decoder (\k -> return (PeekByteOffset (\off# -> k (I64#
#if MIN_VERSION_base(4,17,0)
#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Surely this can't be quite the right logic, because 32bit arches prior to some ghc version did need intToInt64# didn't they?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

PeekByteOffset always provides an Int64# on 32bit:

cborg/cborg/src/Codec/CBOR/Decoding.hs

Lines 191 to 195 in c8013b3

#if defined(ARCH_32bit)
| PeekByteOffset (Int64# -> ST s (DecodeAction s a))
#else
| PeekByteOffset (Int# -> ST s (DecodeAction s a))
#endif
so this seems correct to me.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

PeekByteOffset always provides an Int64# on 32bit

which would mean this logic here is wrong. The logic currently says "use intToInt64 if base >= 4.17 and only on 64bit arches".

But what you're saying above is that it should be "always use intToInt64 on 32bit arches", so the combo would be

#if MIN_VERSION_base(4,17,0) || defined(ARCH_32bit)

so that we use intToInt64 on 32bit arches (for all base versions), and we also use it on all arches from base 4.17 onwards.

Did we check this patch actually compiles on 32bit arches prior to ghc 9.2?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

PeekByteOffset always provides an Int64# on 32bit

which would mean this logic here is wrong. The logic currently says "use intToInt64 if base >= 4.17 and only on 64bit arches".

But what you're saying above is that it should be "always use intToInt64 on 32bit arches", so the combo would be

#if MIN_VERSION_base(4,17,0) || defined(ARCH_32bit)

so that we use intToInt64 on 32bit arches (for all base versions), and we also use it on all arches from base 4.17 onwards.

I think the existing logic is exactly right (it also compiles on all GHC versions >=8.4), as seen eg by a case distinction.

The purpose of this code is to fill the hole _f in PeekByteOffset $ \off# -> k (I64# (_f off#)) (where k has input type ByteOffset ~ Int64).

  • On 32bit:
    We have off# :: Int64# and I64# :: Int64# -> Int64 on all GHCs. Hence, we can fill _f = id.
  • On 64bit:
    We have off# :: Int#.
    • On GHC < 9.4, we have I64# :: Int# -> Int64.
      Hence, we can fill _f = id.
    • Since GHC >= 9.4, we have I64# :: Int64# -> Int64 (FTR: corresponding section in the migration guide for 9.4).
      Hence, we can fill _f = intToInt64# :: Int# -> Int64#

Note that we can fill _f = id except when we are on GHC >=9.4 and on 64bit, which is exactly the existing condition.

Would be neat if there were some more principled/locally understandable alternative to the current CPP maze 😅

Did we check this patch actually compiles on 32bit arches prior to ghc 9.2?

Yes, to double check once again, I pushed to a branch in my fork with the second commit (Support GHC >=9.2 on 32bit) removed: https://github.com/amesgen/cborg/actions/runs/6183531233
One can see that i686 compilation with all GHCs from 8.4 to 9.0 succeeds (as expected, compilation on >=9.2 fails as the respective commit was removed).
Also, here is the CI run that everything works on all GHCs with all three commits: https://github.com/amesgen/cborg/actions/runs/6138762687

(intToInt64# off#)
#else
off#
Expand Down
20 changes: 17 additions & 3 deletions cborg/src/Codec/CBOR/Magic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,7 @@ import qualified Numeric.Half as Half
import Data.Bits ((.|.), unsafeShiftL)
#endif

#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !MIN_VERSION_ghc_prim(0,8,0)
import GHC.IntWord64 (wordToWord64#, word64ToWord#,
intToInt64#, int64ToInt#,
leWord64#, ltWord64#, word64ToInt64#)
Expand Down Expand Up @@ -173,7 +173,7 @@ grabWord64 (Ptr ip#) = W64# (wordToWord64# (byteSwap# (word64ToWord# (indexWord6
grabWord64 (Ptr ip#) = W64# (byteSwap# (indexWord64OffAddr# ip# 0#))
#endif
#else
grabWord64 (Ptr ip#) = W64# (byteSwap64# (word64ToWord# (indexWord64OffAddr# ip# 0#)))
grabWord64 (Ptr ip#) = W64# (byteSwap64# (indexWord64OffAddr# ip# 0#))
#endif

#elif defined(MEM_UNALIGNED_OPS) && \
Expand Down Expand Up @@ -484,7 +484,7 @@ word16ToInt (W16# w#) = I# (word2Int# (word16ToWord# w#))
word32ToInt (W32# w#) = I# (word2Int# (word32ToWord# w#))
#else
word32ToInt (W32# w#) =
case isTrue# (w# `ltWord#` 0x80000000##) of
case isTrue# (word32ToWord# w# `ltWord#` 0x80000000##) of
True -> Just (I# (word2Int# (word32ToWord# w#)))
False -> Nothing
#endif
Expand Down Expand Up @@ -530,6 +530,19 @@ word64ToInt (W64# w#) =
{-# INLINE word64ToInt #-}

#if defined(ARCH_32bit)
#if MIN_VERSION_ghc_prim(0,8,0)
word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# (word8ToWord# w#)))
word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# (word16ToWord# w#)))
word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# (word32ToWord# w#)))
word64ToInt64 (W64# w#) =
case isTrue# (w# `ltWord64#` uncheckedShiftL64# (wordToWord64# 1##) 63#) of
True -> Just (I64# (word64ToInt64# w#))
False -> Nothing

word8ToWord64 (W8# w#) = W64# (wordToWord64# (word8ToWord# w#))
word16ToWord64 (W16# w#) = W64# (wordToWord64# (word16ToWord# w#))
word32ToWord64 (W32# w#) = W64# (wordToWord64# (word32ToWord# w#))
#else
word8ToInt64 (W8# w#) = I64# (intToInt64# (word2Int# w#))
word16ToInt64 (W16# w#) = I64# (intToInt64# (word2Int# w#))
word32ToInt64 (W32# w#) = I64# (word64ToInt64# (wordToWord64# w#))
Expand All @@ -541,6 +554,7 @@ word64ToInt64 (W64# w#) =
word8ToWord64 (W8# w#) = W64# (wordToWord64# w#)
word16ToWord64 (W16# w#) = W64# (wordToWord64# w#)
word32ToWord64 (W32# w#) = W64# (wordToWord64# w#)
#endif

{-# INLINE word8ToInt64 #-}
{-# INLINE word16ToInt64 #-}
Expand Down
30 changes: 15 additions & 15 deletions cborg/src/Codec/CBOR/Read.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -63,7 +63,7 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Word
import GHC.Word
#if defined(ARCH_32bit)
#if defined(ARCH_32bit) && !MIN_VERSION_ghc_prim(0,8,0)
import GHC.IntWord64
#endif
import GHC.Exts
Expand Down Expand Up @@ -510,8 +510,8 @@ go_fast !bs da@(ConsumeNegWord64Canonical k) =
go_fast !bs da@(ConsumeInt64Canonical k) =
case tryConsumeInt64 (BS.unsafeHead bs) bs of
DecodeFailure -> go_fast_end bs da
DecodedToken sz i@(I64# i#)
| isInt64Canonical sz i -> k i# >>= go_fast (BS.unsafeDrop sz bs)
DecodedToken sz (I64# i#)
| isInt64Canonical sz i# -> k i# >>= go_fast (BS.unsafeDrop sz bs)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm confused by this. Did this simply never work?

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would have to do some git blame archaeology to find out whether this worked in the past due to different type signatures or was just introduced without any testing; even more extremely, the code didn't even parse on 32bit (introduced in #273) previously, so this code went without any testing since at least then.

| otherwise -> go_fast_end bs da

go_fast !bs da@(ConsumeListLen64Canonical k) =
Expand Down Expand Up @@ -994,8 +994,8 @@ go_fast_end !bs (ConsumeNegWord64Canonical k) =
go_fast_end !bs (ConsumeInt64Canonical k) =
case tryConsumeInt64 (BS.unsafeHead bs) bs of
DecodeFailure -> return $! SlowFail bs "expected int64"
DecodedToken sz i@(I64# i#)
| isInt64Canonical sz i -> k i# >>= go_fast_end (BS.unsafeDrop sz bs)
DecodedToken sz (I64# i#)
| isInt64Canonical sz i# -> k i# >>= go_fast_end (BS.unsafeDrop sz bs)
| otherwise -> return $! SlowFail bs "non-canonical int64"

go_fast_end !bs (ConsumeListLen64Canonical k) =
Expand Down Expand Up @@ -1271,7 +1271,7 @@ go_slow da bs !offset = do

SlowPeekByteOffset bs' k ->
lift
#if MIN_VERSION_base(4,17,0)
#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit)
(k (int64ToInt# off#))
#else
(k off#)
Expand Down Expand Up @@ -1381,7 +1381,7 @@ go_slow_overlapped da sz bs_cur bs_next !offset =
SlowPeekByteOffset bs_empty k ->
assert (BS.null bs_empty) $ do
lift
#if MIN_VERSION_base(4,17,0)
#if MIN_VERSION_base(4,17,0) && !defined(ARCH_32bit)
(k (int64ToInt# off#))
#else
(k off#)
Expand Down Expand Up @@ -1565,17 +1565,17 @@ isIntCanonical sz i
{-# INLINE isWord64Canonical #-}
isWord64Canonical :: Int -> Word64 -> Bool
isWord64Canonical sz w
| sz == 2 = w > 0x17)
| sz == 3 = w > 0xff)
| sz == 5 = w > 0xffff)
| sz == 9 = w > 0xffffffff)
| sz == 2 = w > 0x17
| sz == 3 = w > 0xff
| sz == 5 = w > 0xffff
| sz == 9 = w > 0xffffffff
| otherwise = True

{-# INLINE isInt64Canonical #-}
isInt64Canonical :: Int -> Int64# -> Bool
isInt64Canonical sz i#
| isTrue# (i# `ltInt64#` intToInt64# 0#) = isWord64Canonical sz (not64# w#)
| otherwise = isWord64Canonical sz w#
| isTrue# (i# `ltInt64#` intToInt64# 0#) = isWord64Canonical sz (W64# (not64# w#))
| otherwise = isWord64Canonical sz (W64# w#)
where
w# = int64ToWord64# i#
#endif
Expand Down Expand Up @@ -1796,7 +1796,7 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of
0x1b -> let !w = eatTailWord64 bs
sz = 9
#if defined(ARCH_32bit)
in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! toInteger w)
in DecodedToken sz (BigIntToken (isWord64Canonical sz w) $! toInteger w)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also looks like this couldn't ever have been type correct.

Copy link
Author

@amesgen amesgen Sep 10, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

see #322 (comment)

#else
in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! toInteger w)
#endif
Expand Down Expand Up @@ -1838,7 +1838,7 @@ tryConsumeInteger hdr !bs = case word8ToWord hdr of
0x3b -> let !w = eatTailWord64 bs
sz = 9
#if defined(ARCH_32bit)
in DecodedToken sz (BigIntToken (isWord64Canonical sz (word64ToWord w)) $! (-1 - toInteger w))
in DecodedToken sz (BigIntToken (isWord64Canonical sz w) $! (-1 - toInteger w))
#else
in DecodedToken sz (BigIntToken (isWordCanonical sz (word64ToWord w)) $! (-1 - toInteger w))
#endif
Expand Down