[commit: ghc] master: Remove use of R9, and fix associated bugs (11b5ce5)
git at git.haskell.org
git
Tue Oct 1 10:10:24 UTC 2013
Repository : ssh://git at git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/11b5ce550d1a9bc84dd97629e1cca0b356054898/ghc
>---------------------------------------------------------------
commit 11b5ce550d1a9bc84dd97629e1cca0b356054898
Author: Simon Marlow <marlowsd at gmail.com>
Date: Tue Sep 17 21:48:39 2013 +0100
Remove use of R9, and fix associated bugs
We were passing the function address to stg_gc_prim_p in R9, which was
wrong because the call was a high-level call and didn't declare R9 as
a parameter. Passing R9 as an argument is the right way, but
unfortunately that exposed another bug: we were using the same macro
in some low-level Cmm, where it is illegal to call functions with
arguments (see Note [syntax of cmm files]). So we now have low-level
variants of STK_CHK() and STK_CHK_P() for use in low-level Cmm code.
>---------------------------------------------------------------
11b5ce550d1a9bc84dd97629e1cca0b356054898
includes/Cmm.h | 41 ++++++++++++++++++++++++++++-------------
includes/stg/MiscClosures.h | 3 +++
rts/Exception.cmm | 8 ++++----
rts/HeapStackCheck.cmm | 40 ++++++++++++++++++++++++++++------------
rts/PrimOps.cmm | 2 +-
5 files changed, 64 insertions(+), 30 deletions(-)
diff --git a/includes/Cmm.h b/includes/Cmm.h
index e4898b4..0e30c16 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -439,20 +439,32 @@
if (0) { goto __L__; }
#define GC_PRIM(fun) \
- R9 = fun; \
- jump stg_gc_prim();
-
+ jump stg_gc_prim(fun);
+
+// Version of GC_PRIM for use in low-level Cmm. We can call
+// stg_gc_prim, because it takes one argument and therefore has a
+// platform-independent calling convention (Note [Syntax of .cmm
+// files] in CmmParse.y).
+#define GC_PRIM_LL(fun) \
+ R1 = fun; \
+ jump stg_gc_prim [R1];
+
+// We pass the fun as the second argument, because the arg is
+// usually already in the first argument position (R1), so this
+// avoids moving it to a different register / stack slot.
#define GC_PRIM_N(fun,arg) \
- R9 = fun; \
- jump stg_gc_prim_n(arg);
+ jump stg_gc_prim_n(arg,fun);
#define GC_PRIM_P(fun,arg) \
- R9 = fun; \
- jump stg_gc_prim_p(arg);
+ jump stg_gc_prim_p(arg,fun);
+
+#define GC_PRIM_P_LL(fun,arg) \
+ R1 = arg; \
+ R2 = fun; \
+ jump stg_gc_prim_p_ll [R1,R2];
#define GC_PRIM_PP(fun,arg1,arg2) \
- R9 = fun; \
- jump stg_gc_prim_pp(arg1,arg2);
+ jump stg_gc_prim_pp(arg1,arg2,fun);
#define MAYBE_GC_(fun) \
if (CHECK_GC()) { \
@@ -478,23 +490,26 @@
GC_PRIM_PP(fun,arg1,arg2) \
}
-#define STK_CHK(n, fun) \
+#define STK_CHK_LL(n, fun) \
TICK_BUMP(STK_CHK_ctr); \
if (Sp - (n) < SpLim) { \
- GC_PRIM(fun) \
+ GC_PRIM_LL(fun) \
}
-#define STK_CHK_P(n, fun, arg) \
+#define STK_CHK_P_LL(n, fun, arg) \
+ TICK_BUMP(STK_CHK_ctr); \
if (Sp - (n) < SpLim) { \
- GC_PRIM_P(fun,arg) \
+ GC_PRIM_P_LL(fun,arg) \
}
#define STK_CHK_PP(n, fun, arg1, arg2) \
+ TICK_BUMP(STK_CHK_ctr); \
if (Sp - (n) < SpLim) { \
GC_PRIM_PP(fun,arg1,arg2) \
}
#define STK_CHK_ENTER(n, closure) \
+ TICK_BUMP(STK_CHK_ctr); \
if (Sp - (n) < SpLim) { \
jump __stg_gc_enter_1(closure); \
}
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 3e4f3d1..b818aa4 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -276,6 +276,9 @@ RTS_FUN_DECL(stg_gc_prim_p);
RTS_FUN_DECL(stg_gc_prim_pp);
RTS_FUN_DECL(stg_gc_prim_n);
+RTS_RET(stg_gc_prim_p_ll_ret);
+RTS_FUN_DECL(stg_gc_prim_p_ll);
+
RTS_RET(stg_enter);
RTS_FUN_DECL(__stg_gc_enter_1);
diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 25da0d6..2e18a7a 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -64,7 +64,7 @@ INFO_TABLE_RET(stg_unmaskAsyncExceptionszh_ret, RET_SMALL, W_ info_ptr)
/* Eagerly raise a blocked exception, if there is one */
if (StgTSO_blocked_exceptions(CurrentTSO) != END_TSO_QUEUE) {
- STK_CHK_P (WDS(2), stg_unmaskAsyncExceptionszh_ret_info, R1);
+ STK_CHK_P_LL (WDS(2), stg_unmaskAsyncExceptionszh_ret_info, R1);
/*
* We have to be very careful here, as in killThread#, since
* we are about to raise an async exception in the current
@@ -129,7 +129,7 @@ INFO_TABLE_RET(stg_maskUninterruptiblezh_ret, RET_SMALL, W_ info_ptr)
stg_maskAsyncExceptionszh /* explicit stack */
{
/* Args: R1 :: IO a */
- STK_CHK_P( WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
+ STK_CHK_P_LL (WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
/* avoid growing the stack unnecessarily */
@@ -157,7 +157,7 @@ stg_maskAsyncExceptionszh /* explicit stack */
stg_maskUninterruptiblezh /* explicit stack */
{
/* Args: R1 :: IO a */
- STK_CHK_P( WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
+ STK_CHK_P_LL (WDS(1)/* worst case */, stg_maskAsyncExceptionszh, R1);
if ((TO_W_(StgTSO_flags(CurrentTSO)) & TSO_BLOCKEX) == 0) {
/* avoid growing the stack unnecessarily */
@@ -191,7 +191,7 @@ stg_unmaskAsyncExceptionszh /* explicit stack */
P_ io;
io = R1;
- STK_CHK_P (WDS(4), stg_unmaskAsyncExceptionszh, io);
+ STK_CHK_P_LL (WDS(4), stg_unmaskAsyncExceptionszh, io);
/* 4 words: one for the unblock frame, 3 for setting up the
* stack to call maybePerformBlockedException() below.
*/
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index e130cb3..d826529 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -172,38 +172,54 @@ __stg_gc_enter_1 (P_ node)
code in a few common cases.
-------------------------------------------------------------------------- */
-stg_gc_prim ()
+stg_gc_prim (W_ fun)
{
- W_ fun;
- fun = R9;
call stg_gc_noregs ();
jump fun();
}
-stg_gc_prim_p (P_ arg)
+stg_gc_prim_p (P_ arg, W_ fun)
{
- W_ fun;
- fun = R9;
call stg_gc_noregs ();
jump fun(arg);
}
-stg_gc_prim_pp (P_ arg1, P_ arg2)
+stg_gc_prim_pp (P_ arg1, P_ arg2, W_ fun)
{
- W_ fun;
- fun = R9;
call stg_gc_noregs ();
jump fun(arg1,arg2);
}
-stg_gc_prim_n (W_ arg)
+stg_gc_prim_n (W_ arg, W_ fun)
{
- W_ fun;
- fun = R9;
call stg_gc_noregs ();
jump fun(arg);
}
+stg_gc_prim_p_ll_ret
+{
+ W_ fun;
+ P_ arg;
+ fun = Sp(2);
+ arg = Sp(1);
+ Sp_adj(3);
+ R1 = arg;
+ jump fun [R1];
+}
+
+stg_gc_prim_p_ll
+{
+ W_ fun;
+ P_ arg;
+ fun = R2;
+ arg = R1;
+ Sp_adj(-3);
+ Sp(2) = fun;
+ Sp(1) = arg;
+ Sp(0) = stg_gc_prim_p_ll_ret;
+ jump stg_gc_noregs [];
+}
+
/* -----------------------------------------------------------------------------
stg_enter_checkbh is just like stg_enter, except that we also call
checkBlockingQueues(). The point of this is that the GC can
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index e278bb7..e539c7c 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2069,7 +2069,7 @@ stg_noDuplicatezh /* no arg list: explicit stack layout */
jump %ENTRY_CODE(Sp(0)) [];
}
- STK_CHK(WDS(1), stg_noDuplicatezh);
+ STK_CHK_LL (WDS(1), stg_noDuplicatezh);
// leave noDuplicate frame in case the current
// computation is suspended and restarted (see above).
More information about the ghc-commits
mailing list