[commit: ghc] ghc-8.0: rts: fix threadStackUnderflow type in cmm (bd45497)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.0
Link       : http://ghc.haskell.org/trac/ghc/changeset/bd454972e94a639f57cf16a2d419e879f023e80e/ghc

>---------------------------------------------------------------

commit bd454972e94a639f57cf16a2d419e879f023e80e
Author: Sergei Trofimovich <siarheit at google.com>
Date:   Fri Mar 11 22:31:58 2016 +0000

    rts: fix threadStackUnderflow type in cmm
    
    stg_stack_underflow_frame had an incorrect
    call of C function 'threadStackUnderflow':
        ("ptr" ret_off) =
          foreign "C" threadStackUnderflow(
            MyCapability(),
            CurrentTSO);
    
    Which means it's prototype is:
        void * (*) (W_, void*);
    While real prototype is:
        W_ (*) (Capability *cap, StgTSO *tso);
    
    The fix is simple. Fix type annotations:
        (ret_off) =
          foreign "C" threadStackUnderflow(
            MyCapability() "ptr",
            CurrentTSO "ptr");
    
    Noticed when debugged T9045 test failure
    on m68k target which distincts between
    pointer and non pointer return types
    (uses different registers)
    
    While at it noticed and fixed return types
    for 'throwTo' and 'findSpark'.
    
    Trac #11395
    
    Signed-off-by: Sergei Trofimovich <siarheit at google.com>
    (cherry picked from commit e46742f5c51938bc7c992ac37fecc6df8cab7647)


>---------------------------------------------------------------

bd454972e94a639f57cf16a2d419e879f023e80e
 rts/Exception.cmm       | 2 +-
 rts/PrimOps.cmm         | 2 +-
 rts/StgMiscClosures.cmm | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index a89bd19..2a07eaa 100644
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -307,7 +307,7 @@ stg_killThreadzh (P_ target, P_ exception)
     } else {
         W_ msg;
 
-        (msg) = ccall throwTo(MyCapability() "ptr",
+        ("ptr" msg) = ccall throwTo(MyCapability() "ptr",
                                     CurrentTSO "ptr",
                                     target "ptr",
                                     exception "ptr");
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 7add835..a802e67 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -2344,7 +2344,7 @@ stg_getSparkzh ()
 #ifndef THREADED_RTS
     return (0,ghczmprim_GHCziTypes_False_closure);
 #else
-    (spark) = ccall findSpark(MyCapability());
+    ("ptr" spark) = ccall findSpark(MyCapability() "ptr");
     if (spark != 0) {
         return (1,spark);
     } else {
diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index e3be2cb..871199c 100644
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -32,8 +32,8 @@ INFO_TABLE_RET (stg_stack_underflow_frame, UNDERFLOW_FRAME,
     SAVE_STGREGS
 
     SAVE_THREAD_STATE();
-    ("ptr" ret_off) = foreign "C" threadStackUnderflow(MyCapability(),
-                                                       CurrentTSO);
+    (ret_off) = foreign "C" threadStackUnderflow(MyCapability() "ptr",
+                                                 CurrentTSO);
     LOAD_THREAD_STATE();
 
     RESTORE_STGREGS