Skip to content
GitLab
Projects Groups Topics Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Register
  • Sign in
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributor statistics
    • Graph
    • Compare revisions
    • Locked files
  • Issues 5.5k
    • Issues 5.5k
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 636
    • Merge requests 636
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Artifacts
    • Schedules
    • Test cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • CI/CD
    • Code review
    • Insights
    • Issue
    • Repository
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
Collapse sidebar
  • Glasgow Haskell CompilerGlasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #20987
Closed
Open
Issue created Jan 23, 2022 by Julian Ospald@maerwald🍵Developer

`indexWord8ArrayAsWord64#` not working on ARM?

During this bytestring PR we found that the following code causes a segfault on ARM Linux (32bit) (tested with GHC-8.10.1 and 8.10.7):

reverse :: ShortByteString -> ShortByteString
reverse = \sbs ->
    let l = length sbs
        ba = asBA sbs
    in create l (\mba -> go ba mba l)
  where
    go :: BA -> MBA s -> Int -> ST s ()
    go !ba !mba !l = case l `quotRem` 8 of
      (0, r) -> void $ goWord8Chunk 0 r
      (q, 0) -> goWord64Chunk 0 0 q
      (q, r) -> do
        i' <- goWord8Chunk 0 r
        goWord64Chunk i' 0 q
     where
      goWord64Chunk !off !i !cl
        | i >= cl = return ()
        | otherwise = do
            let w = indexWord64Array ba (off + (i * 8))
            writeWord64Array mba (cl - 1 - i) (byteSwap64 w)
            goWord64Chunk off (i+1) cl

      goWord8Chunk !i !cl
        | i >= cl = return i
        | otherwise = do
            let w = indexWord8Array ba i
            writeWord8Array mba (l - 1 - i) w
            goWord8Chunk (i+1) cl

indexWord64Array :: BA -> Int -> Word64
indexWord64Array (BA# ba#) (I# i#) = W64# (indexWord8ArrayAsWord64# ba# i#)

writeWord64Array :: MBA s -> Int -> Word64 -> ST s ()
writeWord64Array (MBA# mba#) (I# i#) (W64# w#) =
  ST $ \s -> case writeWord64Array# mba# i# w# s of
               s -> (# s, () #)

When replaced with a variant that only uses indexWord8Array/writeWord8Array the issue was gone.

We've been speculating about issues due to unaligned access, for which a CPP like this is used in other places. However @Bodigrim suggested this should maybe be handled by indexWord8ArrayAsWord64#?

Is this expected?

Edited Jan 23, 2022 by Julian Ospald
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking