Fix a really nasty bug in SMP

In SMP mode a THUNK can change to an IND at any time.  The generic
apply code (stg_ap_p etc.) examines a closure to determine how to
apply it to its arguments, if it is a THUNK it must enter it first in
order to evaluate it.  The problem was that in order to enter the
THUNK, we were re-reading the info pointer, and possibly ending up
with an IND instead of the original THUNK.  It isn't safe to enter the
IND, because it points to a function (functions are never "entered",
only applied).  Solution: we must not re-read the info pointer.

diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y
index aee1516..73618bc 100644 (file)
--- a/ghc/compiler/cmm/CmmParse.y
+++ b/ghc/compiler/cmm/CmmParse.y
@@ -464,8 +464,10 @@ exprOp name args_code =
 exprMacros :: UniqFM ([CmmExpr] -> CmmExpr)
 exprMacros = listToUFM [
   ( FSLIT("ENTRY_CODE"),   \ [x] -> entryCode x ),
-  ( FSLIT("GET_ENTRY"),    \ [x] -> entryCode (closureInfoPtr x) ),
+  ( FSLIT("INFO_PTR"),     \ [x] -> closureInfoPtr x ),
   ( FSLIT("STD_INFO"),     \ [x] -> infoTable x ),
+  ( FSLIT("FUN_INFO"),     \ [x] -> funInfoTable x ),
+  ( FSLIT("GET_ENTRY"),    \ [x] -> entryCode (closureInfoPtr x) ),
   ( FSLIT("GET_STD_INFO"), \ [x] -> infoTable (closureInfoPtr x) ),
   ( FSLIT("GET_FUN_INFO"), \ [x] -> funInfoTable (closureInfoPtr x) ),
   ( FSLIT("INFO_TYPE"),    \ [x] -> infoTableClosureType x ),

diff --git a/ghc/utils/genapply/GenApply.hs b/ghc/utils/genapply/GenApply.hs
index 1bdcad7..a912266 100644 (file)
--- a/ghc/utils/genapply/GenApply.hs
+++ b/ghc/utils/genapply/GenApply.hs
@@ -409,12 +409,12 @@ genApply regstatus args =
        vcat (do_assert args 1),
 
        text  "again:",
-       text  "info = %GET_STD_INFO(R1);",
+       text  "info = %INFO_PTR(R1);",
 
 --    if fast == 1:
 --        print "    goto *lbls[info->type];";
 --    else:
-        text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(info)) {",
+        text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(%STD_INFO(info))) {",
        nest 4 (vcat [
 
 --    if fast == 1:
@@ -441,7 +441,7 @@ genApply regstatus args =
         text "     FUN_0_2,",
         text "     FUN_STATIC: {",
        nest 4 (vcat [
-         text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
+         text "arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));",
          text "ASSERT(arity > 0);",
           genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(R1)" "FUN" "FUN"
                False{-reg apply-} False{-args on stack-} False{-not a PAP-}
@@ -485,7 +485,11 @@ genApply regstatus args =
        nest 4 (vcat [
           text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
          text "Sp(0) = " <> fun_info_label <> text ";",
-         text "jump %GET_ENTRY(R1);",
+         -- CAREFUL! in SMP mode, the info table may already have been
+         -- overwritten by an indirection, so we must enter the original
+         -- info pointer we read, don't read it again, because it might
+         -- not be enterable any more.
+         text "jump %ENTRY_CODE(info);",
          text ""
         ]),
        text "}",