--- A low-level way to generate the variable part of a fun-style info table.
--- (must match fun_extra_bits above). Used by the C-- parser.
-mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
-mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
- = [ packHalfWordsCLit fun_type arity,
- srt_label,
- liveness,
- slow_entry ]
+-- Convert from 'ClosureInfo' to 'CmmInfo'.
+-- Not used for return points. (The 'smRepClosureTypeInt' call would panic.)
+mkCmmInfo :: ClosureInfo -> FCode CmmInfo
+mkCmmInfo cl_info = do
+ prof <-
+ if opt_SccProfilingOn
+ then do ty_descr_lit <- mkStringCLit (closureTypeDescr cl_info)
+ cl_descr_lit <- mkStringCLit (closureValDescr cl_info)
+ return $ ProfilingInfo ty_descr_lit cl_descr_lit
+ else return $ ProfilingInfo (mkIntCLit 0) (mkIntCLit 0)
+
+ case cl_info of
+ ConInfo { closureCon = con } -> do
+ cstr <- mkByteStringCLit $ dataConIdentity con
+ let conName = makeRelativeRefTo info_lbl cstr
+ info = ConstrInfo (ptrs, nptrs)
+ (fromIntegral (dataConTagZ con))
+ conName
+ return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
+
+ ClosureInfo { closureName = name,
+ closureLFInfo = lf_info,
+ closureSRT = srt } ->
+ return $ CmmInfo gc_target Nothing (CmmInfoTable False prof cl_type info)
+ where
+ info =
+ case lf_info of
+ LFReEntrant _ arity _ arg_descr ->
+ FunInfo (ptrs, nptrs)
+ srt
+ (fromIntegral arity)
+ arg_descr
+ (CmmLabel (mkSlowEntryLabel name has_caf_refs))
+ LFThunk _ _ _ (SelectorThunk offset) _ ->
+ ThunkSelectorInfo (fromIntegral offset) srt
+ LFThunk _ _ _ _ _ ->
+ ThunkInfo (ptrs, nptrs) srt
+ _ -> panic "unexpected lambda form in mkCmmInfo"
+ where
+ info_lbl = infoTableLabelFromCI cl_info has_caf_refs
+ has_caf_refs = clHasCafRefs cl_info
+
+ cl_type = smRepClosureTypeInt (closureSMRep cl_info)
+
+ ptrs = fromIntegral $ closurePtrsSize cl_info
+ size = fromIntegral $ closureNonHdrSize cl_info
+ nptrs = size - ptrs
+
+ -- The gc_target is to inform the CPS pass when it inserts a stack check.
+ -- Since that pass isn't used yet we'll punt for now.
+ -- When the CPS pass is fully integrated, this should
+ -- be replaced by the label that any heap check jumped to,
+ -- so that branch can be shared by both the heap (from codeGen)
+ -- and stack checks (from the CPS pass).
+ gc_target = panic "TODO: gc_target"