Commit 81c6183d authored by batterseapower's avatar batterseapower

Repair sanity of infoTableLabelFromCI in old code generator

parent 834dbd9a
......@@ -185,7 +185,7 @@ mkStaticClosureFields cl_info ccs caf_refs payload
= mkStaticClosure info_lbl ccs payload padding_wds
static_link_field saved_info_field
where
info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
info_lbl = infoTableLabelFromCI cl_info
-- CAFs must have consistent layout, regardless of whether they
-- are actually updatable or not. The layout of a CAF is:
......@@ -302,7 +302,7 @@ hpStkCheck cl_info is_fun reg_save_code code
-- Strictly speaking, we should tag node here. But if
-- node doesn't point to the closure, the code for the closure
-- cannot depend on the value of R1 anyway, so we're safe.
closure_lbl = closureLabelFromCI cl_info (clHasCafRefs cl_info)
closure_lbl = closureLabelFromCI cl_info
full_save_code = node_asst `plusStmts` reg_save_code
......@@ -570,8 +570,7 @@ allocDynClosure cl_info use_cc _blame_cc amodes_with_offsets
-- Remember, virtHp points to last allocated word,
-- ie 1 *before* the info-ptr word of new object.
info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info
(clHasCafRefs cl_info)))
info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
-- SAY WHAT WE ARE ABOUT TO DO
......
......@@ -59,7 +59,7 @@ emitClosureCodeAndInfoTable cl_info args body
; info <- mkCmmInfo cl_info
; emitInfoTableAndCode (infoLblToEntryLbl info_lbl) info args blks }
where
info_lbl = infoTableLabelFromCI cl_info $ clHasCafRefs cl_info
info_lbl = infoTableLabelFromCI cl_info
-- We keep the *zero-indexed* tag in the srt_len field of the info
-- table of a data constructor.
......@@ -105,7 +105,7 @@ mkCmmInfo cl_info = do
ThunkInfo (ptrs, nptrs) srt
_ -> panic "unexpected lambda form in mkCmmInfo"
where
info_lbl = infoTableLabelFromCI cl_info has_caf_refs
info_lbl = infoTableLabelFromCI cl_info
has_caf_refs = clHasCafRefs cl_info
cl_type = smRepClosureTypeInt (closureSMRep cl_info)
......
......@@ -47,7 +47,7 @@ module CgUtils (
packHalfWordsCLit,
blankWord,
getSRTInfo, clHasCafRefs
getSRTInfo
) where
#include "HsVersions.h"
......@@ -995,12 +995,6 @@ getSRTInfo = do
srt_escape = (-1) :: StgHalfWord
clHasCafRefs :: ClosureInfo -> CafInfo
clHasCafRefs (ClosureInfo {closureSRT = srt}) =
case srt of NoC_SRT -> NoCafRefs
_ -> MayHaveCafRefs
clHasCafRefs (ConInfo {}) = NoCafRefs
-- -----------------------------------------------------------------------------
--
-- STG/Cmm GlobalReg
......
......@@ -35,7 +35,7 @@ module ClosureInfo (
closureNeedsUpdSpace, closureIsThunk,
closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
closureFunInfo, isStandardFormThunk, isKnownFun,
funTag, funTagLFInfo, tagForArity,
funTag, funTagLFInfo, tagForArity, clHasCafRefs,
enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
......@@ -59,7 +59,6 @@ module ClosureInfo (
#include "../includes/MachDeps.h"
#include "HsVersions.h"
--import CgUtils
import StgSyn
import SMRep
......@@ -909,6 +908,12 @@ funTagLFInfo lf
tagForArity :: Int -> Maybe Int
tagForArity i | i <= mAX_PTR_TAG = Just i
| otherwise = Nothing
clHasCafRefs :: ClosureInfo -> CafInfo
clHasCafRefs (ClosureInfo {closureSRT = srt}) =
case srt of NoC_SRT -> NoCafRefs
_ -> MayHaveCafRefs
clHasCafRefs (ConInfo {}) = NoCafRefs
\end{code}
\begin{code}
......@@ -924,9 +929,9 @@ isToplevClosure _ = False
Label generation.
\begin{code}
infoTableLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
infoTableLabelFromCI (ClosureInfo { closureName = name,
closureLFInfo = lf_info }) caf
infoTableLabelFromCI :: ClosureInfo -> CLabel
infoTableLabelFromCI cl@(ClosureInfo { closureName = name,
closureLFInfo = lf_info })
= case lf_info of
LFBlackHole info -> info
......@@ -936,23 +941,23 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
LFThunk _ _ upd_flag (ApThunk arity) _ ->
mkApInfoTableLabel upd_flag arity
LFThunk{} -> mkInfoTableLabel name caf
LFThunk{} -> mkInfoTableLabel name $ clHasCafRefs cl
LFReEntrant _ _ _ _ -> mkInfoTableLabel name caf
LFReEntrant _ _ _ _ -> mkInfoTableLabel name $ clHasCafRefs cl
_ -> panic "infoTableLabelFromCI"
infoTableLabelFromCI (ConInfo { closureCon = con,
closureSMRep = rep }) caf
| isStaticRep rep = mkStaticInfoTableLabel name caf
| otherwise = mkConInfoTableLabel name caf
infoTableLabelFromCI cl@(ConInfo { closureCon = con,
closureSMRep = rep })
| isStaticRep rep = mkStaticInfoTableLabel name $ clHasCafRefs cl
| otherwise = mkConInfoTableLabel name $ clHasCafRefs cl
where
name = dataConName con
-- ClosureInfo for a closure (as opposed to a constructor) is always local
closureLabelFromCI :: ClosureInfo -> CafInfo -> CLabel
closureLabelFromCI (ClosureInfo { closureName = nm }) caf = mkLocalClosureLabel nm caf
closureLabelFromCI _ _ = panic "closureLabelFromCI"
closureLabelFromCI :: ClosureInfo -> CLabel
closureLabelFromCI cl@(ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm $ clHasCafRefs cl
closureLabelFromCI _ = panic "closureLabelFromCI"
-- thunkEntryLabel is a local help function, not exported. It's used from both
-- entryLabelFromCI and getCallMethod.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment