Skip to content

GitLab

  • Projects
  • Groups
  • Snippets
  • Help
    • Loading...
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
GHC
GHC
  • Project overview
    • Project overview
    • Details
    • Activity
    • Releases
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 4,254
    • Issues 4,254
    • List
    • Boards
    • Labels
    • Service Desk
    • Milestones
    • Iterations
  • Merge Requests 394
    • Merge Requests 394
  • Requirements
    • Requirements
    • List
  • CI / CD
    • CI / CD
    • Pipelines
    • Jobs
    • Schedules
  • Security & Compliance
    • Security & Compliance
    • Dependency List
    • License Compliance
  • Operations
    • Operations
    • Incidents
    • Environments
  • Analytics
    • Analytics
    • CI / CD
    • Code Review
    • Insights
    • Issue
    • Repository
    • Value Stream
  • Wiki
    • Wiki
  • Snippets
    • Snippets
  • Members
    • Members
  • Collapse sidebar
  • Activity
  • Graph
  • Create a new issue
  • Jobs
  • Commits
  • Issue Boards
  • Glasgow Haskell Compiler
  • GHCGHC
  • Issues
  • #6156

Closed
Open
Opened Jun 10, 2012 by erikd@trac-erikd

Optimiser bug on linux-powerpc

Found a small chunk of code in the cryptocipher package that when compiled and run, produces a difference result when optimised compared to compiling un-optimised.

Note this is only a problem with PowerPC. On x86-64 there is no difference in the output between the optimised version and the un-optimised version.

I have two simple files (Camellia.hs):

module Camellia where

import Data.Bits
import Data.Word

import Debug.Trace

fl :: Word64 -> Word64 -> Word64
fl fin sk =
	let (x1, x2) = w64tow32 fin in
	let (k1, k2) = w64tow32 sk in
	let y2 = x2 `xor` ((x1 .&. k1) `rotateL` 1) in
	let y1 = x1 `xor` (y2 .|. k2) in
	trace (show fin ++ " " ++ show sk ++ " -> " ++ show (w32tow64 (y1, y2))) $ w32tow64 (y1, y2)

w64tow32 :: Word64 -> (Word32, Word32)
w64tow32 w = (fromIntegral (w `shiftR` 32), fromIntegral (w .&. 0xffffffff))

w32tow64 :: (Word32, Word32) -> Word64
w32tow64 (x1, x2) = ((fromIntegral x1) `shiftL` 32) .|. (fromIntegral x2)

and a main program (camellia-test.hs):

import Data.Word
import qualified Camellia as Camellia

a, b :: Word64
a = 1238988323332265734
b = 11185553392205053542

main :: IO ()
main =
    putStrLn $ "Camellia.fl " ++ show a ++ " " ++ show b ++ " -> " ++ show (Camellia.fl a b)

I'm also using this Makefile:

TARGETS = camilla-test-std camilla-test-opt

check : $(TARGETS)
	./camilla-test-std
	./camilla-test-opt

clean :
	make clean-temp-files
	rm -f $(TARGETS)

clean-temp-files :
	rm -f camilla-test.o camilla-test.hi Camellia.o Camellia.hi

camilla-test-opt : camilla-test.hs Camellia.hs
	ghc -Wall -O2 --make -i:Tests $< -o $@
	make clean-temp-files

camilla-test-std : camilla-test.hs Camellia.hs
	ghc -Wall --make -i:Tests $< -o $@
	make clean-temp-files

When I run the two programs I get:

./camilla-test-std
1238988323332265734 11185553392205053542 -> 18360184157246690566
Camellia.fl 1238988323332265734 11185553392205053542 -> 18360184157246690566
./camilla-test-opt
1238988323332265734 11185553392205053542 -> 3698434091925017862
Camellia.fl 38662 15974 -> 3698434091925017862

So there are two problems here:

a) Showing Word64 values is not working correctly in the optimised version.

b) The function Camelia.fl produces the wrong result in the optimised version.

Trac metadata
Trac field Value
Version 7.4.1
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture
Assignee
Assign to
7.6.1
Milestone
7.6.1
Assign milestone
Time tracking
None
Due date
None
Reference: ghc/ghc#6156