Skip to content
GitLab
Projects Groups Snippets
  • /
  • Help
    • Help
    • Support
    • Community forum
    • Submit feedback
  • Sign in / Register
  • GHC GHC
  • Project information
    • Project information
    • Activity
    • Labels
    • Members
  • Repository
    • Repository
    • Files
    • Commits
    • Branches
    • Tags
    • Contributors
    • Graph
    • Compare
    • Locked Files
  • Issues 5,261
    • Issues 5,261
    • List
    • Boards
    • Service Desk
    • Milestones
    • Iterations
  • Merge requests 567
    • Merge requests 567
  • CI/CD
    • CI/CD
    • Pipelines
    • Jobs
    • Schedules
    • Test Cases
  • Deployments
    • Deployments
    • Releases
  • Analytics
    • Analytics
    • Value stream
    • 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
  • #986
Closed
Open
Issue created Nov 04, 2006 by Bertram Felgenhauer@int-eReporter

SMP race condition in getContents

This is a problem mentioned in the Haskell on SMP paper in section 3.5. If a thunk contains an unsafePerformIO or was created by unsafeInterleaveIO, evaluating it multiple times is harmful. The code below triggers this problem.

import Data.List
import Data.Char
import Control.Parallel
import System.IO

{-# NOINLINE fool #-}
-- 'fool' just makes sure CSE doesn't meddle with the code below
fool :: [a] -> [a]
fool (x:xs) = xs

main = do
    hSetBuffering stdin NoBuffering
    hs <- getContents
    let -- create copies of the input
        ts = map (:hs) ['a'..'z']
        -- sum the characters of each copy
        qs = map (foldl' (+) 0 . map ord . fool) ts
        -- in parallel
        rs = foldr (\x y -> x `par` y `par` (x:y)) [] qs
    -- compare the results and print 'True' if they are all equal.
    -- This should never print 'False'
    print $ all (uncurry (==)) $ zip rs (tail rs)

Don Steward kindly tried it on an SMP machine with the following results:

<dons> $ ghc -O A.hs -threaded
<dons> /tmp/ghc5400_0/ghc5400_0.hc:275:0:
<dons>      warning: implicit declaration of function 'newSpark'
<dons> -- good sign I got the right rts
<dons> $ yes abqszzzq | head -c 100000 | ./a.out +RTS -N1
<dons> True
<dons> $ yes abqszzzq | head -c 100000 | ./a.out +RTS -N2
<dons> False
<dons> $ uname -msr
<dons> Linux 2.6.15.3-general i686
<dons> with SMP kernel
<dons> CPU7: Intel(R) Xeon(TM) CPU 2.80GHz stepping 08
<dons> Total of 8 processors activated (44807.44 BogoMIPS).

To solve this problem, we need something like the justOnce suggested in the paper. It should be used in unsafePerformIO and unsafeInterleaveIO. Non-locking versions could be provided as unlockedUnsafePerformIO and unlockedInterleaveIO. This would allow existing libraries to work on SMP without or with just minor modifications, as far as I can see. The assumption that a thunk is evaluated at most once is fairly widespread.

Trac metadata
Trac field Value
Version 6.6
Type Bug
TypeOfFailure OtherFailure
Priority normal
Resolution Unresolved
Component Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system Linux
Architecture x86
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information
Assignee
Assign to
Time tracking