diff options
| -rw-r--r-- | compiler/cmm/CmmLex.x | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmParse.y | 25 | ||||
| -rw-r--r-- | rts/PrimOps.cmm | 55 |
3 files changed, 61 insertions, 23 deletions
diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x index 1b823ccb09..bb5b4e3ae5 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 a0c9bc4eb5..8438198f7d 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 e539c7cde3..db65a4a268 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); - - /* 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); } /* ----------------------------------------------------------------------------- |