#15225 closed bug (fixed)

`-fno-state-hack` produces incorrect results in nofib

Reported by: tdammers Owned by: tdammers
Priority: normal Milestone: 8.6.1
Component: Compiler Version: 8.5
Keywords: Cc: alpmestan
Operating System: Linux Architecture: x86_64 (amd64)
Type of failure: Incorrect result at runtime Test Case:
Blocked By: Blocking:
Related Tickets: #7411 Differential Rev(s): Phab:D4868
Wiki Page:

Description

While investigating #7411, I found that nofib fails with incorrect output from the fasta test.

A vanilla prof build behaves normally; however, with the following modifications, nofib fails:

  • Compile GHC from scratch with:
      GhcStage2HcOpts    = -O -fno-state-hack
      GhcLibHcOpts       = -O -fno-state-hack
    
  • Run nofib with EXTRA_HC_OPTS=-fno-state-hack

Doing this, the nofib test output is:

------------------------------------------------------------------------
== make all --no-print-directory;
 in /home/tobias/well-typed/devel/ghc/HEAD/nofib/shootout/fasta
------------------------------------------------------------------------
HC = /home/tobias/well-typed/devel/ghc/HEAD/inplace/bin/ghc-stage2
HC_OPTS = -O2 -Rghc-timing -H32m -hisuf hi -fno-state-hack -O2 -rtsopts -O2 -XBangPatterns -XOverloadedStrings -package bytestring
RUNTEST_OPTS = -ghc-timing
==nofib== fasta: time to compile Main follows...
/home/tobias/well-typed/devel/ghc/HEAD/inplace/bin/ghc-stage2 -O2 -Rghc-timing -H32m -hisuf hi -fno-state-hack -O2 -rtsopts -O2 -XBangPatterns -XOverloadedStrings -package bytestring -c Main.hs -o Main.o

Main.hs:30:1: warning: [-Wtabs]
    Tab character found here, and in 13 further locations.
    Please use spaces instead.
   |
30 |         let !k = min modulus (floor (fromIntegral modulus * (p::Float) + 1))
   | ^^^^^^^^
<<ghc: 401958512 bytes, 72 GCs, 10720054/28796976 avg/max bytes residency (6 samples), 61M in use, 0.001 INIT (0.001 elapsed), 0.342 MUT (0.420 elapsed), 0.240 GC (0.238 elapsed) :ghc>>
==nofib== fasta: size of Main.o follows...
   text	   data	    bss	    dec	    hex	filename
   7245	   2624	      0	   9869	   268d	Main.o
==nofib== fasta: time to link fasta follows...
<<ghc: 49626024 bytes, 45 GCs, 1356153/2672728 avg/max bytes residency (5 samples), 8M in use, 0.001 INIT (0.001 elapsed), 0.025 MUT (0.468 elapsed), 0.060 GC (0.060 elapsed) :ghc>>
==nofib== fasta: size of fasta follows...
   text	   data	    bss	    dec	    hex	filename
 708996	 127712	  16232	 852940	  d03cc	fasta
==nofib== fasta: time to run fasta follows...
../../runstdtest/runstdtest ./fasta  -o1 fasta.stdout -o1 fasta.stdout  -ghc-timing     2500000;   ../../runstdtest/runstdtest ./fasta  -o1 fasta.stdout -o1 fasta.stdout  -ghc-timing     2500000;   ../../runstdtest/runstdtest ./fasta  -o1 fasta.stdout -o1 fasta.stdout  -ghc-timing     2500000;   ../../runstdtest/runstdtest ./fasta  -o1 fasta.stdout -o1 fasta.stdout  -ghc-timing     2500000;   ../../runstdtest/runstdtest ./fasta  -o1 fasta.stdout -o1 fasta.stdout  -ghc-timing     2500000;
0.43user 0.02system 0:00.45elapsed 99%CPU (0avgtext+0avgdata 4824maxresident)k
0inputs+49656outputs (0major+608minor)pagefaults 0swaps
././fasta 2500000 < /dev/null
expected stdout not matched by reality
--- fasta.stdout	2018-06-02 03:00:43.887025433 +0200
+++ /tmp/runtest4673.1	2018-06-02 03:09:19.651755697 +0200
@@ -83337,333335 +83337,333335 @@
 cttBtatcatatgctaKggNcataaaSatgtaaaDcDRtBggDtctttataattcBgtcg
-tactDtDagcctatttSVHtHttKtgtHMaSattgWaHKHttttagacatWatgtRgaaa
-NtactMcSMtYtcMgRtacttctWBacgaaatatagScDtttgaagacacatagtVgYgt
-cattHWtMMWcStgttaggKtSgaYaaccWStcgBttgcgaMttBYatcWtgacaYcaga
-gtaBDtRacttttcWatMttDBcatWtatcttactaBgaYtcttgttttttttYaaScYa
-HgtgttNtSatcMtcVaaaStccRcctDaataataStcYtRDSaMtDttgttSagtRRca
#### ~3.1 million similar lines follow ####
-taatataagctgcgccaggggatttttccagatcatctggcctgtgtatatgttcaaatc
+gacgaatatattagttatagtttactatccaaataaattaagcgaatcgaaataaactgt
+gacgaatatattagttatagtttactatccaaataaattaagcgaatcgaaataaactgt
+gacgaatatattagttatagtttactatccaaataaattaagcgaatcgaaataaactgt
#### ~208k identical lines follow
+gacgaatatattagttatagtttactatccaaataaattaagcgaatcgaaataaactgt
 taatagccgagagaaattac
../../mk/target.mk:101: recipe for target 'runtests' failed
make[2]: *** [runtests] Error 1
Failed making all in fasta: 1
../mk/ghc-recurse.mk:65: recipe for target 'all' failed
make[1]: *** [all] Error 1
Failed making all in shootout: 1
mk/ghc-recurse.mk:65: recipe for target 'all' failed
make: *** [all] Error 1

Change History (9)

comment:1 Changed 16 months ago by alpmestan

Cc: alpmestan added

comment:2 Changed 16 months ago by tdammers

Owner: set to tdammers

comment:3 Changed 16 months ago by tdammers

Running only nofib with -fno-state-hack, but with GHC and libraries compiled normally, the problem does not appear.

comment:4 Changed 16 months ago by tdammers

Two more test runs:

  • GHC with state hack, libraries without state hack, nofib without state hack triggers problem
  • GHC with state hack, libraries without state hack, nofib with state hack does not trigger problem

So apparently, in order to trigger the problem, both nofib and libraries must be compiled with -fno-state-hack.

comment:5 Changed 15 months ago by tdammers

So here's a hint. The documentation to unsafeUseAsCString mentions this:

After calling this function the CString shares the underlying byte buffer with the original ByteString. Thus modifying the CString, either in C, or using poke, will cause the contents of the ByteString to change, breaking referential transparency. Other ByteStrings created by sharing (such as those produced via 'take' or 'drop') will also reflect these changes. Modifying the CString will break referential transparency. To avoid this, use useAsCString, which makes a copy of the original ByteString.

(emphasis mine).

And then in the fasta/Main.hs source code, we see this:

  unsafeUseAsCString line $ \ptr -> do
    --- snip ---
    plusPtr ptr i `poke` unsafeIndex lookupTable newseed
    --- snip ---

In other words, fasta does exactly what the documentation says not to do.

Which would suggest that the state hack itself isn't really to blame, it just causes different sharing behavior.

I'll run a few tests to get more certainty here.

comment:6 Changed 15 months ago by bgamari

Yikes! Indeed that does look quite suspicious since line is also used elsewhere in this block. Sounds like this is the culprit.

comment:7 Changed 15 months ago by tdammers

I quickly and naively tried just using useAsCString instead of unsafeUseAsCString, but of course that doesn't quite work - probably because the code relies on actually manipulating the bytestring in place, whereas useAsCString creates a copy and manipulates that. So the output no longer matches that of the C implementation, but the -fno-state-hack flag no longer causes the output to differ.

So I went a step further, and rewrote the relevant part in more idiomatic Haskell, using ByteString.unfoldrN instead of manipulating C strings in-place:

  • shootout/fasta/Main.hs

    commit dc2753f4e10fec79c02ed293b72573f1aeaa2271
    Author: Tobias Dammers <tdammers@gmail.com>
    Date:   Fri Jun 15 11:27:36 2018 +0200
    
        Rewrite fasta in more idiomatic Haskell
    
    diff --git a/shootout/fasta/Main.hs b/shootout/fasta/Main.hs
    index 4bd0849..795a470 100644
    a b import Foreign.Ptr 
    1111import Foreign.Storable
    1212import System.Environment
    1313import qualified Data.ByteString.Char8 as B
     14import qualified Data.ByteString as BS
    1415import qualified Data.ByteString.Lazy.Char8 as L
     16import Data.Word (Word8)
    1517
    1618main = do
    1719    n <- getArgs >>= readIO.head
    make name n0 tbl seed0 = do 
    2729  B.putStrLn name
    2830  let modulus = 139968
    2931      fill ((c,p):cps) j =
    30         let !k = min modulus (floor (fromIntegral modulus * (p::Float) + 1))
    31         in B.replicate (k - j) c : fill cps k
     32        let !k = min modulus (floor (fromIntegral modulus * (p::Float) + 1))
     33        in B.replicate (k - j) c : fill cps k
    3234      fill _ _ = []
    3335      lookupTable = B.concat $ fill (scanl1 (\(_,p) (c,q) -> (c,p+q)) tbl) 0
    34       line = B.replicate 60 '\0'
    35   unsafeUseAsCString line $ \ptr -> do
    36     let make' n !i seed
    37             | n > (0::Int) = do
    38                 let newseed = rem (seed * 3877 + 29573) modulus
    39                 plusPtr ptr i `poke` unsafeIndex lookupTable newseed
    40                 if i+1 >= 60
    41                     then puts line 60 >> make' (n-1) 0 newseed
    42                     else make' (n-1) (i+1) newseed
    43             | otherwise = when (i > 0) (puts line i) >> return seed
    44     make' n0 0 seed0
     36
     37  let next :: Int -> Maybe (Word8, Int)
     38      next seed =
     39        let newseed = rem (seed * 3877 + 29573) modulus
     40            val = unsafeIndex lookupTable newseed
     41        in Just (val, newseed)
     42
     43  let make' :: Int -> Int -> IO Int
     44      make' n seed = do
     45        if n <= (0 :: Int) then
     46          return seed
     47        else if n >= 60 then do
     48          let (line, Just newseed) = BS.unfoldrN 60 next seed
     49          puts line 60
     50          make' (n-60) newseed
     51        else do
     52          let (line, Just newseed) = BS.unfoldrN n next seed
     53          puts line n
     54          return newseed
     55  make' n0 seed0
    4556
    4657alu = "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGG\
    4758    \TCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGG\

The patched version produces the correct output regardless of the state hack; however, I haven't done a full profiling run yet to see how it affects performance.

However, considering that the unidiomatic version is essentially wrong, and, well, unidiomatic, I'm not so sure whether it told us anything meaningful in the first place.

comment:8 Changed 15 months ago by tdammers

Differential Rev(s): Phab:D4868

comment:9 Changed 15 months ago by bgamari

Resolution: fixed
Status: newclosed
Note: See TracTickets for help on using tickets.