diff options
| author | Simon Marlow <simonmar@microsoft.com> | 2006-03-14 11:21:19 +0000 |
|---|---|---|
| committer | Simon Marlow <simonmar@microsoft.com> | 2006-03-14 11:21:19 +0000 |
| commit | a9dc96582699e24c7d67eec9e4296b80dee53e92 (patch) | |
| tree | 38001cea901a489c7b9599ba3e952a60df975d7d | |
| parent | 2f861d149686a96d7783ce984afa7c263a39c355 (diff) | |
| download | haskell-a9dc96582699e24c7d67eec9e4296b80dee53e92.tar.gz | |
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.
| -rw-r--r-- | ghc/compiler/cmm/CmmParse.y | 4 | ||||
| -rw-r--r-- | ghc/utils/genapply/GenApply.hs | 12 |
2 files changed, 11 insertions, 5 deletions
diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y index aee1516708..73618bc35b 100644 --- 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 1bdcad7533..a91226632c 100644 --- 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 "}", |