diff options
| author | Simon Marlow <marlowsd@gmail.com> | 2012-03-06 12:24:40 +0000 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-03-06 13:28:32 +0000 |
| commit | 93e42a6895d2172f40d37fd13cb7405243dc4d0f (patch) | |
| tree | 61e620bdba7d5b0e37348d68ba6ab2a60959a21e /compiler/codeGen/StgCmmMonad.hs | |
| parent | 9a32e71d912985a6fd8e3491518ac357f2e8686b (diff) | |
| download | haskell-93e42a6895d2172f40d37fd13cb7405243dc4d0f.tar.gz | |
Lower safe foreign calls in the new CmmLayoutStack
We also generate much better code for safe foreign calls (and maybe
also unsafe foreign calls) than previously. See the two new Notes:
Note [lower safe foreign calls]
Note [safe foreign call convention]
Diffstat (limited to 'compiler/codeGen/StgCmmMonad.hs')
| -rw-r--r-- | compiler/codeGen/StgCmmMonad.hs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs index ccf0777906..240469c3f2 100644 --- a/compiler/codeGen/StgCmmMonad.hs +++ b/compiler/codeGen/StgCmmMonad.hs @@ -77,9 +77,6 @@ import Unique import UniqSupply import FastString import Outputable -import Util - -import Compiler.Hoopl hiding (Unique, (<*>), mkLabel, mkBranch, mkLast) import Control.Monad import Data.List @@ -614,7 +611,7 @@ emitComment :: FastString -> FCode () #if 0 /* def DEBUG */ emitComment s = emitCgStmt (CgStmt (CmmComment s)) #else -emitComment s = return () +emitComment _ = return () #endif emitAssign :: CmmReg -> CmmExpr -> FCode () @@ -707,12 +704,16 @@ mkSafeCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> FCode CmmAGraph mkSafeCall t fs as upd i = do k <- newLabelC + let (_off, copyout) = copyInOflow NativeReturn (Young k) fs + -- see Note [safe foreign call convention] return ( mkStore (CmmStackSlot (Young k) (widthInBytes wordWidth)) (CmmLit (CmmBlock k)) - <*> mkLast (CmmForeignCall {tgt=t, res=fs, args=as, succ=k, updfr=upd, intrbl=i}) - <*> mkLabel k) - + <*> mkLast (CmmForeignCall { tgt=t, res=fs, args=as, succ=k + , updfr=upd, intrbl=i }) + <*> mkLabel k + <*> copyout + ) -- ---------------------------------------------------------------------------- -- CgStmts |