Skip to content
Browse files

Debugging a strange segfault.

  • Loading branch information...
1 parent a945176 commit e1dc7b3c7e66cdd21a5aa46f9f96ca9448c52407 @waldheinz committed Aug 24, 2012
View
4 bling.cabal
@@ -39,10 +39,10 @@ Library
vector-algorithms >= 0.5
Ghc-Options:
- -Wall -O2 -fexcess-precision -fllvm
+ -Wall -O2
Ghc-Prof-Options:
- -O2 -fexcess-precision -prof
+ -prof
Exposed-Modules:
Graphics.Bling.AABB,
View
22 src/Graphics/Bling/Image.hs
@@ -144,12 +144,12 @@ addTile (MImage w h (ox, oy) _ px ps) (Img tw th _ px' ps', (dx, dy)) = {-# SCC
unless ((y - oy + dy) >= h || (x - ox + dx) >= w) $ do
-- the splats
- MV.unsafeRead ps od >>= \old -> MV.unsafeWrite ps od $ spAdd old (V.unsafeIndex ps' os)
+ MV.read ps od >>= \old -> MV.write ps od $ spAdd old (ps' V.! os)
-- the pixels
forM_ [0..3] $ \o -> do
- old <- MV.unsafeRead px (od' + o)
- MV.unsafeWrite px (od' + o) (old + V.unsafeIndex px' (os' + o))
+ old <- MV.read px (od' + o)
+ MV.write px (od' + o) (old + px' V.! (os' + o))
spAdd :: SplatPixel -> SplatPixel -> SplatPixel
spAdd (r1, g1, b1) (r2, g2, b2) = (r1 + r2, g1 + g2, b1 + b2)
@@ -162,8 +162,8 @@ addPixel !(MImage !w !h (!ox, !oy) _ !p _) (!x, !y, WS !sw !s)
| otherwise = do
let
o' = 4 * ((x - ox) + (y - oy) * w)
- (r', g', b') = toRGB s
-
+ ( r', g', b' ) = toRGB s
+ {-
ow <- MV.unsafeRead p o'
r <- MV.unsafeRead p $ (o' + 1)
g <- MV.unsafeRead p $ (o' + 2)
@@ -173,11 +173,14 @@ addPixel !(MImage !w !h (!ox, !oy) _ !p _) (!x, !y, WS !sw !s)
MV.unsafeWrite p (o' + 1) $ (r + r')
MV.unsafeWrite p (o' + 2) $ (g + g')
MV.unsafeWrite p (o' + 3) $ (b + b')
+ -}
+ return ()
splatSample :: PrimMonad m => MImage m -> ImageSample -> m ()
{-# INLINE splatSample #-}
splatSample (MImage w h (iox, ioy) _ _ p) (sx, sy, WS sw ss)
- | floor sx >= w || floor sy >= h || sx < 0 || sy < 0 = return ()
+ | (fx - iox) < 0 || (fy - ioy) < 0 = return ()
+ | fx >= (w + iox) || fy >= (h + ioy) = return ()
| sNaN ss = trace ("not splatting NaN sample at ("
++ show sx ++ ", " ++ show sy ++ ")") (return () )
| sInfinite ss = trace ("not splatting infinite sample at ("
@@ -187,10 +190,11 @@ splatSample (MImage w h (iox, ioy) _ _ p) (sx, sy, WS sw ss)
| isInfinite sw = trace ("not splatting infinite weight sample at ("
++ show sx ++ ", " ++ show sy ++ ")") (return () )
| otherwise = {-# SCC "splatSample" #-} do
- (ox, oy, oz) <- MV.unsafeRead p o
- MV.unsafeWrite p o (ox + dx, oy + dy, oz + dz)
+ (ox, oy, oz) <- MV.read p o
+ MV.write p o (ox + dx, oy + dy, oz + dz)
where
- o = ((floor sx - iox) + (floor sy - ioy) * w)
+ (# fx, fy #) = (#floor sx, floor sy #)
+ o = ((fx - iox) + (fy - ioy) * w)
(dx, dy, dz) = (\(x, y, z) -> (x * sw, y * sw, z * sw)) $ toRGB ss
-- | adds a sample to the specified image
View
2 src/Graphics/Bling/KdTree.hs
@@ -45,7 +45,7 @@ Node (7,2)
mkKdTree :: forall a m v. (PrimMonad m, MV.MVector v a, Dimensional a, Show a) => Int -> v (PrimState m) a -> m (KdTree a)
mkKdTree depth v
| MV.null v = return Empty
- | MV.length v == 1 = MV.unsafeRead v 0 >>= \e -> return $ Node e Empty Empty
+ | MV.length v == 1 = MV.read v 0 >>= \e -> return $ Node e Empty Empty
| otherwise = do
let
median = MV.length v `div` 2
View
28 src/Graphics/Bling/Math.hs
@@ -220,28 +220,28 @@ instance MV.MVector V.MVector Vector where
{-# INLINE basicLength #-}
basicUnsafeSlice s l (MV_Vector v) =
- MV_Vector $ (MV.unsafeSlice (s * 3) (l * 3) v)
+ MV_Vector $ (MV.slice (s * 3) (l * 3) v)
{-# INLINE basicUnsafeSlice #-}
- basicUnsafeNew l = MV_Vector `liftM` MV.unsafeNew (l * 3)
+ basicUnsafeNew l = MV_Vector `liftM` MV.new (l * 3)
{-# INLINE basicUnsafeNew #-}
basicOverlaps (MV_Vector v1) (MV_Vector v2) = MV.overlaps v1 v2
{-# INLINE basicOverlaps #-}
basicUnsafeRead (MV_Vector v) idx = do
- x <- MV.unsafeRead v idx'
- y <- MV.unsafeRead v (idx' + 1)
- z <- MV.unsafeRead v (idx' + 2)
+ x <- MV.read v idx'
+ y <- MV.read v (idx' + 1)
+ z <- MV.read v (idx' + 2)
return $ Vector x y z
where
idx' = idx * 3
{-# INLINE basicUnsafeRead #-}
basicUnsafeWrite (MV_Vector v) idx (Vector x y z) = do
- MV.unsafeWrite v (idx' + 0) x
- MV.unsafeWrite v (idx' + 1) y
- MV.unsafeWrite v (idx' + 2) z
+ MV.write v (idx' + 0) x
+ MV.write v (idx' + 1) y
+ MV.write v (idx' + 2) z
where
idx' = idx * 3
{-# INLINE basicUnsafeWrite #-}
@@ -251,19 +251,19 @@ instance GV.Vector V.Vector Vector where
{-# INLINE basicLength #-}
basicUnsafeSlice s l (V_Vector v) =
- V_Vector $ (GV.unsafeSlice (s * 3) (l * 3) v)
+ V_Vector $ (GV.slice (s * 3) (l * 3) v)
{-# INLINE basicUnsafeSlice #-}
- basicUnsafeFreeze (MV_Vector v) = V_Vector `liftM` (GV.unsafeFreeze v)
+ basicUnsafeFreeze (MV_Vector v) = V_Vector `liftM` (GV.freeze v)
{-# INLINE basicUnsafeFreeze #-}
- basicUnsafeThaw (V_Vector v) = MV_Vector `liftM` (GV.unsafeThaw v)
+ basicUnsafeThaw (V_Vector v) = MV_Vector `liftM` (GV.thaw v)
{-# INLINE basicUnsafeThaw #-}
basicUnsafeIndexM (V_Vector v) idx = do
- x <- GV.unsafeIndexM v (idx' + 0)
- y <- GV.unsafeIndexM v (idx' + 1)
- z <- GV.unsafeIndexM v (idx' + 2)
+ x <- GV.indexM v (idx' + 0)
+ y <- GV.indexM v (idx' + 1)
+ z <- GV.indexM v (idx' + 2)
return $ Vector x y z
where
idx' = idx * 3
View
2 src/Graphics/Bling/Montecarlo.hs
@@ -59,7 +59,7 @@ sampleDiscrete1D d@(MkDist1D f c fi) u
| u >= 1 = error "sampleDiscrete1D : u >= 1"
| otherwise = (offset, pdf) where
offset = upperBound c u
- pdf = V.unsafeIndex f offset / (fi * fromIntegral (count d))
+ pdf = f V.! offset / (fi * fromIntegral (count d))
sampleContinuous1D :: Dist1D -> Float -> (Float, Float, Int)
sampleContinuous1D (MkDist1D func cdf fi) u = (x, pdf, offset) where
View
2 src/Graphics/Bling/Random.hs
@@ -83,7 +83,7 @@ shuffle v
-- the obvious alternative would be to use something like
-- "rndIntR (0, n - i - 1)", but this performs *much* better
other <- rndInt
- liftR $ MV.unsafeSwap v i (abs other `rem` (n - 1))
+ liftR $ MV.swap v i (abs other `rem` (n - 1))
where
n = MV.length v
View
2 src/Graphics/Bling/Reflection.hs
@@ -447,7 +447,7 @@ sampleBsdf'' adj flags (Bsdf bs cs _ ng) woW uComp uDir
bsm = V.filter (\b -> bxdfMatches b flags) bs
cntm = V.length bsm
sNum = max 0 $ min (cntm-1) (floor (uComp * fromIntegral cntm)) -- index to sample
- bxdf = V.unsafeIndex bsm sNum
+ bxdf = bsm V.! sNum
-- sample chosen BxDF
(f', wi, pdf') = let fun = if adj then bxdfSample' else bxdfSample
View
12 src/Graphics/Bling/Renderer/SPPM.hs
@@ -217,11 +217,11 @@ sIdx (PS _ wnd) (px, py) = w * (iy - yStart wnd) + (ix - xStart wnd) where
slup :: PixelStats s -> HitPoint -> ST s Stats
{-# INLINE slup #-}
-slup (PS v _) hit = UMV.unsafeRead v (hpStatIdx hit)
+slup (PS v _) hit = UMV.read v (hpStatIdx hit)
sUpdate :: PixelStats s -> HitPoint -> Stats -> ST s ()
{-# INLINE sUpdate #-}
-sUpdate (PS v _) hit = UMV.unsafeWrite v (hpStatIdx hit)
+sUpdate (PS v _) hit = UMV.write v (hpStatIdx hit)
--------------------------------------------------------------------------------
-- Spatial Hashing for the Hitpoints
@@ -242,7 +242,7 @@ hashLookup sh p n ps fun = {-# SCC "hashLookup" #-}
let
Vector x y z = abs $ (p - aabbMin (shBounds sh)) * vpromote (shScale sh)
idx = hash (floor x, floor y, floor z) `rem` V.length (shEntries sh)
- hits = V.unsafeIndex (shEntries sh) idx
+ hits = (shEntries sh) V.! idx
in V.forM_ hits $ \hit -> do
stats <- slup ps hit
let
@@ -264,7 +264,7 @@ mkHash hits ps = {-# SCC "mkHash" #-} do
go b h = let p = bsdfShadingPoint $ hpBsdf h
in extendAABB b $ mkAABB (p - vpromote r) (p + vpromote r)
- v' <- MV.replicate cnt []
@waldheinz
Owner
waldheinz added a note Aug 24, 2012

The trouble started here.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
+ v' <- MV.replicateM cnt gvNew
V.forM_ hits $ \hp -> do
stats <- slup ps hp
let
@@ -281,10 +281,10 @@ mkHash hits ps = {-# SCC "mkHash" #-} do
unless (r2p == 0) $ forM_ [(x, y, z) | x <- xs, y <- ys, z <- zs] $ \i ->
let idx = max 0 $ min (cnt - 1) $ hash i `rem` cnt
- in MV.read v' idx >>= \o -> MV.write v' idx (hp : o)
+ in seq hp $ MV.read v' idx >>= (\gv -> gvAdd gv hp)
-- convert to an (non-mutable) array of arrays
- v <- V.generateM (MV.length v') $ \i -> fmap V.fromList (MV.read v' i)
+ v <- V.generateM (MV.length v') $ \i -> (MV.read v' i >>= gvFreeze)
return $ SH bounds v invSize
View
4 src/Graphics/Bling/Sampling.hs
@@ -214,7 +214,7 @@ rnd' n = do
case s of
(RandomSample _) -> rnd
(PrecomSample _ v _) -> if (V.length v > n)
- then liftSampled $ V.unsafeRead v n
+ then liftSampled $ V.read v n
else rnd
rnd2D' :: Int -> Sampled s R.Rand2D
@@ -224,5 +224,5 @@ rnd2D' n = do
case s of
(RandomSample _) -> rnd2D
(PrecomSample _ _ v) -> if (V.length v > n)
- then liftSampled $ V.unsafeRead v n
+ then liftSampled $ V.read v n
else rnd2D
View
4 src/Graphics/Bling/Scene.hs
@@ -114,7 +114,7 @@ sampleOneLight scene@(Scene _ _ lights _) p eps n wo bsdf smp
| lc == 0 = black
| lc == 1 = {-# SCC "sampleOneLight.single" #-} ed (V.head lights)
| otherwise = {-# SCC "sampleOneLight.many" #-} sScale ld (fromIntegral lc) where
- ld = ed $ V.unsafeIndex lights ln
+ ld = ed $ lights V.! ln
ed l = estimateDirect scene l p eps n wo bsdf smp
lc = V.length lights
ln = min (floor $ (ulNum smp) * fromIntegral lc) (lc - 1)
@@ -132,7 +132,7 @@ sampleLightRay sc@(Scene _ _ ls _) uL uO uD
| lc == 1 = sample' (V.head ls) (worldBounds sc) uO uD
| otherwise = (s, ray, n, pd')
where
- (s, ray, n, pd) = sample' (V.unsafeIndex ls ln) (worldBounds sc) uO uD
+ (s, ray, n, pd) = sample' (ls V.! ln) (worldBounds sc) uO uD
pd' = pd * fromIntegral lc
lc = V.length ls
ln = min (floor $ uL * fromIntegral lc) (lc - 1)
View
28 src/Graphics/Bling/Spectrum.hs
@@ -52,28 +52,28 @@ instance MV.MVector V.MVector Spectrum where
{-# INLINE basicLength #-}
basicUnsafeSlice s l (MV_Spectrum v) =
- MV_Spectrum $ (MV.unsafeSlice (s * bands) (l * bands) v)
+ MV_Spectrum $ (MV.slice (s * bands) (l * bands) v)
{-# INLINE basicUnsafeSlice #-}
- basicUnsafeNew l = MV_Spectrum `liftM` MV.unsafeNew (l * bands)
+ basicUnsafeNew l = MV_Spectrum `liftM` MV.new (l * bands)
{-# INLINE basicUnsafeNew #-}
basicOverlaps (MV_Spectrum v1) (MV_Spectrum v2) = MV.overlaps v1 v2
{-# INLINE basicOverlaps #-}
basicUnsafeRead (MV_Spectrum v) idx = do
- r <- MV.unsafeRead v idx'
- g <- MV.unsafeRead v (idx' + 1)
- b <- MV.unsafeRead v (idx' + 2)
+ r <- MV.read v idx'
+ g <- MV.read v (idx' + 1)
+ b <- MV.read v (idx' + 2)
return $! Spectrum r g b
where
idx' = idx * bands
{-# INLINE basicUnsafeRead #-}
basicUnsafeWrite (MV_Spectrum v) idx (Spectrum r g b) = do
- MV.unsafeWrite v (idx' + 0) r
- MV.unsafeWrite v (idx' + 1) g
- MV.unsafeWrite v (idx' + 2) b
+ MV.write v (idx' + 0) r
+ MV.write v (idx' + 1) g
+ MV.write v (idx' + 2) b
where
idx' = idx * bands
{-# INLINE basicUnsafeWrite #-}
@@ -83,19 +83,19 @@ instance GV.Vector V.Vector Spectrum where
{-# INLINE basicLength #-}
basicUnsafeSlice s l (V_Spectrum v) =
- V_Spectrum $ (GV.unsafeSlice (s * bands) (l * bands) v)
+ V_Spectrum $ (GV.slice (s * bands) (l * bands) v)
{-# INLINE basicUnsafeSlice #-}
- basicUnsafeFreeze (MV_Spectrum v) = V_Spectrum `liftM` (GV.unsafeFreeze v)
+ basicUnsafeFreeze (MV_Spectrum v) = V_Spectrum `liftM` (GV.freeze v)
{-# INLINE basicUnsafeFreeze #-}
- basicUnsafeThaw (V_Spectrum v) = MV_Spectrum `liftM` (GV.unsafeThaw v)
+ basicUnsafeThaw (V_Spectrum v) = MV_Spectrum `liftM` (GV.thaw v)
{-# INLINE basicUnsafeThaw #-}
basicUnsafeIndexM (V_Spectrum v) idx = do
- r <- GV.unsafeIndexM v (idx' + 0)
- g <- GV.unsafeIndexM v (idx' + 1)
- b <- GV.unsafeIndexM v (idx' + 2)
+ r <- GV.indexM v (idx' + 0)
+ g <- GV.indexM v (idx' + 1)
+ b <- GV.indexM v (idx' + 2)
return $! Spectrum r g b
where
idx' = idx * bands
View
4 src/Graphics/Bling/Texture.hs
@@ -217,8 +217,8 @@ gradient g t dg
where
f = t dg
idx = fromJust $ V.findIndex ((> f) . fst) (gradCols g)
- e0 = V.unsafeIndex (gradCols g) (idx-1)
- e1 = V.unsafeIndex (gradCols g) idx
+ e0 = (gradCols g) V.! (idx-1)
+ e1 = (gradCols g) V.! idx
(c0, c1) = (snd e0, snd e1)
weight = (f - fst e0) / (fst e1 - fst e0)
View
2 src/Graphics/Bling/Transform.hs
@@ -40,7 +40,7 @@ matrix a b c d e f g h i j k l m n o p = Matrix $ UV.fromList
-- | index into a matrix
mi :: Matrix -> Int -> Int -> Float
{-# INLINE mi #-}
-mi m r c = UV.unsafeIndex (unM m) ((r * 4) + c)
+mi m r c = (unM m) UV.! ((r * 4) + c)
invert :: Matrix -> Matrix
invert m = runST $ do
View
1 src/Graphics/Bling/Utils.hs
@@ -8,7 +8,6 @@ import Control.Monad.Primitive
import Data.Primitive.MutVar
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Generic.Mutable as MV
--- import qualified Data.Vector.Unboxed.Mutable as UMV
data GrowVec v s a = GV ! (MutVar s (v s a)) ! (MutVar s Int)

0 comments on commit e1dc7b3

Please sign in to comment.
Something went wrong with that request. Please try again.