
#14677: Code generator does not correctly tag a pointer -------------------------------------+------------------------------------- Reporter: simonpj | Owner: (none) Type: bug | Status: new Priority: normal | Milestone: Component: Compiler | Version: 8.2.2 Resolution: | Keywords: Operating System: Unknown/Multiple | Architecture: | Unknown/Multiple Type of failure: None/Unknown | Test Case: Blocked By: | Blocking: 14626 Related Tickets: | Differential Rev(s): Wiki Page: | -------------------------------------+------------------------------------- Comment (by alexbiehl): Ha, got it! `evtWrite` is defined as {{{ -- | The file descriptor is ready to accept a write. evtWrite :: Event evtWrite = Event 2 }}} This compiles to this CMM: {{{ ==================== Optimised Cmm ==================== 2018-01-26 08:16:02.207998 UTC section ""data" . evtWrite1_r3aU_closure" { evtWrite1_r3aU_closure: const GHC.Types.I#_con_info; const 2; } ==================== Optimised Cmm ==================== 2018-01-26 08:16:02.209627 UTC section ""data" . T14677_1.evtWrite_closure" { T14677_1.evtWrite_closure: const stg_IND_STATIC_info; const evtWrite1_r3aU_closure+1; const 0; const 0; } }}} Now as seen in my previous comment we refer to `evtWrite_closure` like this: ``` ... R2 = PicBaseReg + (GHC.Event.Internal.evtWrite_closure+1); call Main.f1_info(R2) args: 8, res: 0, upd: 8; ... ``` Now, take a look at the CMM for `evtWrite_closure` again. `evtWrite_closure` is basically an IND_STATIC closure pointing to the actual closure data! So by tagging the pointer we don't enter and never get the desired value! Our tests were working on the address of `evtWrite1_r3aU_closure+1`. What follows is a test which confirms the theory: T14677_1.hs {{{ module T14677_1 where import Data.Bits import Data.List newtype Event = Event { toInt :: Int } deriving (Eq) evtNothing :: Event evtNothing = Event 0 {-# INLINE evtNothing #-} -- | Data is available to be read. evtRead :: Event evtRead = Event 1 {-# INLINE evtRead #-} -- | The file descriptor is ready to accept a write. evtWrite :: Event evtWrite = Event 2 {-# INLINE evtWrite #-} -- | Another thread closed the file descriptor. evtClose :: Event evtClose = Event 4 {-# INLINE evtClose #-} eventIs :: Event -> Event -> Bool eventIs (Event a) (Event b) = a .&. b /= 0 -- | @since 4.3.1.0 instance Show Event where show e = '[' : (intercalate "," . filter (not . null) $ [evtRead `so` "evtRead", evtWrite `so` "evtWrite", evtClose `so` "evtClose"]) ++ "]" where ev `so` disp | e `eventIs` ev = disp | otherwise = "" }}} T14677_2 {{{ module Main where import T14677_1 f e2 = do print (toInt e2) print e2 print (e2 == evtRead) main = f evtWrite }}} This prints for my machine: {{{ $ inplace/bin/ghc-stage1 T14677_2.hs T14677_1.hs -O2 $ ./T14677_2 4307143777 [evtRead] False }}} -- Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/14677#comment:15 GHC http://www.haskell.org/ghc/ The Glasgow Haskell Compiler