ptx: Fix synchronisation of stencil border kernels

The border kernels did synchronise with the parent stream at the _end_
of the border kernel (so that the Future that contains the result of the
stencil operation is dependent on the borders too), but not at the
_start_ of the border kernel (meaning that the borders can start
executing in parallel with the computation of the argument of the
stencil operation). The latter is clearly wrong, and this commit fixes
it. This fixes a stencil nondeterminism bug that we were having
(nondet-stencil in https://github.com/tomsmeding/accelerate-tests).

Author: tomsmeding

accelerate-llvm-ptx/src/Data/Array/Accelerate/LLVM/PTX/Execute.hs

@@ -709,6 +709,7 @@ stencilCore repr@(ArrayR shr _) exe gamma aenv halo shOut paramsR params =
     future  <- new
     result  <- allocateRemote repr shOut
     parent  <- asks ptxStream
+    parentStartPoint <- liftPar (Event.waypoint parent)
 
     -- interior (no bounds checking)
     let paramsRinside = TupRsingle (ParamRshape shr) `TupRpair` TupRsingle (ParamRarray repr) `TupRpair` paramsR
@@ -719,15 +720,19 @@ stencilCore repr@(ArrayR shr _) exe gamma aenv halo shOut paramsR params =
     -- and each other, as individually they will not saturate the device
     forM_ (stencilBorders (arrayRshape repr) shOut halo) $ \(u, v) ->
       fork $ do
+        -- synchronise with start of stencil computation, so that the arguments
+        -- are available
+        child <- asks ptxStream
+        liftIO (Event.after parentStartPoint child)
+
         -- launch in a separate stream
         let sh = trav (-) v u
         let paramsRborder = TupRsingle (ParamRshape shr) `TupRpair` TupRsingle (ParamRshape shr)
                               `TupRpair` TupRsingle (ParamRarray repr)
                               `TupRpair` paramsR
         executeOp border gamma aenv shr sh paramsRborder (((u, sh), result), params)
 
-        -- synchronisation with main stream
-        child <- asks ptxStream
+        -- make remainder of the parent stream depend on the border results
         event <- liftPar (Event.waypoint child)
         ready <- liftIO  (Event.query event)
         if ready then return ()