diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2011-10-17 13:16:02 +0100 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2011-10-17 14:51:34 +0100 |
| commit | 96c80d34163fd422cbc18f4532b7556212a554b8 (patch) | |
| tree | 2f16215825f2f32388c2dde5c07d7620c60143f0 /compiler/codeGen/CgUtils.hs | |
| parent | e91ed183fdde4aa4f51b96987c7fb6fa2bfd15f5 (diff) | |
| download | haskell-96c80d34163fd422cbc18f4532b7556212a554b8.tar.gz | |
make CAFs atomic, to fix #5558
See Note [atomic CAFs] in rts/sm/Storage.c
Diffstat (limited to 'compiler/codeGen/CgUtils.hs')
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index a71702cb4c..5c52eeb2c6 100644 --- a/compiler/codeGen/CgUtils.hs +++ b/compiler/codeGen/CgUtils.hs @@ -13,6 +13,7 @@ module CgUtils ( emitRODataLits, mkRODataLits, emitIf, emitIfThenElse, emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult, + emitRtsCallGen, assignTemp, assignTemp_, newTemp, emitSimultaneously, emitSwitch, emitLitSwitch, @@ -235,22 +236,23 @@ emitRtsCall -> Bool -- ^ whether this is a safe call -> Code -- ^ cmm code -emitRtsCall pkg fun args safe = emitRtsCall' [] pkg fun args Nothing safe +emitRtsCall pkg fun args safe = emitRtsCallGen [] pkg fun args Nothing safe -- The 'Nothing' says "save all global registers" emitRtsCallWithVols :: PackageId -> FastString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code emitRtsCallWithVols pkg fun args vols safe - = emitRtsCall' [] pkg fun args (Just vols) safe + = emitRtsCallGen [] pkg fun args (Just vols) safe emitRtsCallWithResult :: LocalReg -> ForeignHint -> PackageId -> FastString -> [CmmHinted CmmExpr] -> Bool -> Code + emitRtsCallWithResult res hint pkg fun args safe - = emitRtsCall' [CmmHinted res hint] pkg fun args Nothing safe + = emitRtsCallGen [CmmHinted res hint] pkg fun args Nothing safe -- Make a call to an RTS C procedure -emitRtsCall' +emitRtsCallGen :: [CmmHinted LocalReg] -> PackageId -> FastString @@ -258,7 +260,7 @@ emitRtsCall' -> Maybe [GlobalReg] -> Bool -- True <=> CmmSafe call -> Code -emitRtsCall' res pkg fun args vols safe = do +emitRtsCallGen res pkg fun args vols safe = do safety <- if safe then getSRTInfo >>= (return . CmmSafe) else return CmmUnsafe |