[GHC] #14677: Code generator does not correctly tag a pointer

[GHC]

#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