[commit: ghc] master: Add a way to reserve temporary stack space in high-level Cmm (eaa37a0)
git at git.haskell.org
git at git.haskell.org
Thu Jan 16 13:19:13 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/eaa37a0f69df28f051e7511d62dc104eb50a2a6b/ghc
>---------------------------------------------------------------
commit eaa37a0f69df28f051e7511d62dc104eb50a2a6b
Author: Simon Marlow <marlowsd at gmail.com>
Date: Thu Jan 16 11:55:25 2014 +0000
Add a way to reserve temporary stack space in high-level Cmm
We occasionally need to reserve some temporary memory in a primop for
passing to a foreign function. We've been using the stack for this,
but when we moved to high-level Cmm it became quite fragile because
primops are in high-level Cmm and the stack is supposed to be under
the control of the Cmm pipeline.
So this change puts things on a firmer footing by adding a new Cmm
construct 'reserve'. e.g. in decodeFloat_Int#:
reserve 2 = tmp {
mp_tmp1 = tmp + WDS(1);
mp_tmp_w = tmp;
/* Perform the operation */
ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
r1 = W_[mp_tmp1];
r2 = W_[mp_tmp_w];
}
reserve is described in CmmParse.y.
Unfortunately the argument to reserve must be a compile-time constant.
We might have to extend the parser to allow expressions with
arithmetic operators if this is too restrictive.
Note also that the return instruction for the procedure must be
outside the scope of the reserved stack area, so we have to extract
the values from the reserved area before we close the scope. This
means some more local variables (r1, r2 in the example above). The
generated code is more or less identical to what we had before though.
>---------------------------------------------------------------
eaa37a0f69df28f051e7511d62dc104eb50a2a6b
compiler/cmm/CmmLex.x | 4 +++-
compiler/cmm/CmmParse.y | 25 ++++++++++++++++++++++
rts/PrimOps.cmm | 53 ++++++++++++++++++++++++++++-------------------
3 files changed, 60 insertions(+), 22 deletions(-)
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index 1b823cc..bb5b4e3 100644
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -152,6 +152,7 @@ data CmmToken
| CmmT_foreign
| CmmT_never
| CmmT_prim
+ | CmmT_reserve
| CmmT_return
| CmmT_returns
| CmmT_import
@@ -234,7 +235,8 @@ reservedWordsFM = listToUFM $
( "foreign", CmmT_foreign ),
( "never", CmmT_never ),
( "prim", CmmT_prim ),
- ( "return", CmmT_return ),
+ ( "reserve", CmmT_reserve ),
+ ( "return", CmmT_return ),
( "returns", CmmT_returns ),
( "import", CmmT_import ),
( "switch", CmmT_switch ),
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index a0c9bc4..8438198 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -89,6 +89,19 @@ High-level only:
- pushing stack frames:
push (info_ptr, field1, ..., fieldN) { ... statements ... }
+ - reserving temporary stack space:
+
+ reserve N = x { ... }
+
+ this reserves an area of size N (words) on the top of the stack,
+ and binds its address to x (a local register). Typically this is
+ used for allocating temporary storage for passing to foreign
+ functions.
+
+ Note that if you make any native calls or invoke the GC in the
+ scope of the reserve block, you are responsible for ensuring that
+ the stack you reserved is laid out correctly with an info table.
+
Low-level only:
- References to Sp, R1-R8, F1-F4 etc.
@@ -302,6 +315,7 @@ import Data.Maybe
'foreign' { L _ (CmmT_foreign) }
'never' { L _ (CmmT_never) }
'prim' { L _ (CmmT_prim) }
+ 'reserve' { L _ (CmmT_reserve) }
'return' { L _ (CmmT_return) }
'returns' { L _ (CmmT_returns) }
'import' { L _ (CmmT_import) }
@@ -614,6 +628,8 @@ stmt :: { CmmParse () }
{ cmmIfThenElse $2 $4 $6 }
| 'push' '(' exprs0 ')' maybe_body
{ pushStackFrame $3 $5 }
+ | 'reserve' INT '=' lreg maybe_body
+ { reserveStackFrame (fromIntegral $2) $4 $5 }
foreignLabel :: { CmmParse CmmExpr }
: NAME { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
@@ -1060,6 +1076,15 @@ pushStackFrame fields body = do
emit g
withUpdFrameOff new_updfr_off body
+reserveStackFrame :: Int -> CmmParse CmmReg -> CmmParse () -> CmmParse ()
+reserveStackFrame size preg body = do
+ dflags <- getDynFlags
+ old_updfr_off <- getUpdFrameOff
+ reg <- preg
+ let frame = old_updfr_off + wORD_SIZE dflags * size
+ emitAssign reg (CmmStackSlot Old frame)
+ withUpdFrameOff frame body
+
profilingInfo dflags desc_str ty_str
= if not (gopt Opt_SccProfilingOn dflags)
then NoProfilingInfo
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index e539c7c..db65a4a 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -571,44 +571,55 @@ stg_deRefWeakzh ( gcptr w )
stg_decodeFloatzuIntzh ( F_ arg )
{
W_ p;
- W_ mp_tmp1;
- W_ mp_tmp_w;
+ W_ tmp, mp_tmp1, mp_tmp_w, r1, r2;
STK_CHK_GEN_N (WDS(2));
- mp_tmp1 = Sp - WDS(1);
- mp_tmp_w = Sp - WDS(2);
+ reserve 2 = tmp {
- /* Perform the operation */
- ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
+ mp_tmp1 = tmp + WDS(1);
+ mp_tmp_w = tmp;
+
+ /* Perform the operation */
+ ccall __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg);
+
+ r1 = W_[mp_tmp1];
+ r2 = W_[mp_tmp_w];
+ }
/* returns: (Int# (mantissa), Int# (exponent)) */
- return (W_[mp_tmp1], W_[mp_tmp_w]);
+ return (r1, r2);
}
stg_decodeDoublezu2Intzh ( D_ arg )
{
- W_ p;
- W_ mp_tmp1;
- W_ mp_tmp2;
- W_ mp_result1;
- W_ mp_result2;
+ W_ p, tmp;
+ W_ mp_tmp1, mp_tmp2, mp_result1, mp_result2;
+ W_ r1, r2, r3, r4;
STK_CHK_GEN_N (WDS(4));
- mp_tmp1 = Sp - WDS(1);
- mp_tmp2 = Sp - WDS(2);
- mp_result1 = Sp - WDS(3);
- mp_result2 = Sp - WDS(4);
+ reserve 4 = tmp {
- /* Perform the operation */
- ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
- mp_result1 "ptr", mp_result2 "ptr",
- arg);
+ mp_tmp1 = tmp + WDS(3);
+ mp_tmp2 = tmp + WDS(2);
+ mp_result1 = tmp + WDS(1);
+ mp_result2 = tmp;
+
+ /* Perform the operation */
+ ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
+ mp_result1 "ptr", mp_result2 "ptr",
+ arg);
+
+ r1 = W_[mp_tmp1];
+ r2 = W_[mp_tmp2];
+ r3 = W_[mp_result1];
+ r4 = W_[mp_result2];
+ }
/* returns:
(Int# (mant sign), Word# (mant high), Word# (mant low), Int# (expn)) */
- return (W_[mp_tmp1], W_[mp_tmp2], W_[mp_result1], W_[mp_result2]);
+ return (r1, r2, r3, r4);
}
/* -----------------------------------------------------------------------------
More information about the ghc-commits
mailing list