Commit eaa37a0f authored by Simon Marlow's avatar Simon Marlow

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.
parent 11f5cd94
......@@ -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 ),
......
......@@ -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
......
......@@ -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);
/* Perform the operation */
ccall __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
mp_result1 "ptr", mp_result2 "ptr",
arg);
reserve 4 = tmp {
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);
}
/* -----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment