Code review for new primop's CMM code.

29 Mar 2012

      Hi all,

In preparation for students working on concurrent data structures GSOC(s),
I wanted to make sure they could count on CAS for array elements as well as
IORefs.  The following patch represents my first attempt:

https://github.com/rrnewton/ghc/commit/18ed460be111b47a759486677960093d71eef...

It passes a simple test [Appendix 2 below], but I am very unsure as to
whether the GC write barrier is correct.  Could someone do a code-review on
the following few lines of CMM:

       if (GET_INFO(arr) == stg_MUT_ARR_PTRS_CLEAN_info) {
          SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);
          len = StgMutArrPtrs_ptrs(arr);
          // The write barrier.  We must write a byte into the mark table:
          I8[arr + SIZEOF_StgMutArrPtrs + WDS(len) + (ind >>
MUT_ARR_PTRS_CARD_BITS )] = 1;
       }

Thanks,
  -Ryan

-- Appendix 1: First draft code CMM definition for casArray#
-------------------------------------------------------------------
stg_casArrayzh
/* MutableArray# s a -> Int# -> a -> a -> State# s -> (# State# s, Int#, a
#) */
{
   W_ arr, p, ind, old, new, h, len;
   arr = R1; // anything else?
   ind = R2;
   old = R3;
   new = R4;

   p = arr + SIZEOF_StgMutArrPtrs + WDS(ind);
   (h) = foreign "C" cas(p, old, new) [];

   if (h != old) {
       // Failure, return what was there instead of 'old':
       RET_NP(1,h);
   } else {
       // Compare and Swap Succeeded:
       if (GET_INFO(arr) == stg_MUT_ARR_PTRS_CLEAN_info) {
          SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, CCCS);
          len = StgMutArrPtrs_ptrs(arr);
          // The write barrier.  We must write a byte into the mark table:
          I8[arr + SIZEOF_StgMutArrPtrs + WDS(len) + (ind >>
MUT_ARR_PTRS_CARD_BITS )] = 1;
       }
       RET_NP(0,h);
   }
}

-- Appendix 2:  Simple test file; when run it should print:
-------------------------------------------------------------------
-- Perform a CAS within a MutableArray#
--   1st try should succeed: (True,33)
-- 2nd should fail: (False,44)
-- Printing array:
--   33  33  33  44  33
-- Done.
-------------------------------------------------------------------
{-# Language MagicHash, UnboxedTuples  #-}

import GHC.IO
import GHC.IORef
import GHC.ST
import GHC.STRef
import GHC.Prim
import GHC.Base
import Data.Primitive.Array
import Control.Monad

------------------------------------------------------------------------

-- -- | Write a value to the array at the given index:
casArrayST :: MutableArray s a -> Int -> a -> a -> ST s (Bool, a)
casArrayST (MutableArray arr#) (I# i#) old new = ST$ \s1# ->
 case casArray# arr# i# old new s1# of
   (# s2#, x#, res #) -> (# s2#, (x# ==# 0#, res) #)

------------------------------------------------------------------------
{-# NOINLINE mynum #-}
mynum :: Int
mynum = 33

main = do
 putStrLn "Perform a CAS within a MutableArray#"
 arr <- newArray 5 mynum

 res  <- stToIO$ casArrayST arr 3 mynum 44
 res2 <- stToIO$ casArrayST arr 3 mynum 44
 putStrLn$ "  1st try should succeed: "++show res
 putStrLn$ "2nd should fail: "++show res2

 putStrLn "Printing array:"
 forM_ [0..4] $ \ i -> do
   x <- readArray arr i
   putStr ("  "++show x)
 putStrLn ""
 putStrLn "Done."

Ryan Newton

Simon Marlow

tags

participants (2)