-%************************************************************************
-%* *
-\subsection{Generating info tables}
-%* *
-%************************************************************************
-
-Here we make a concrete info table, represented as a list of CAddrMode
-(it can't be simply a list of Word, because the SRT field is
-represented by a label+offset expression).
-
-\begin{code}
-#if SIZEOF_HSWORD == 4
-type StgWord = Word32
-#define HALF_WORD 16
-#elif SIZEOF_HSWORD == 8
-type StgWord = Word64
-#define HALF_WORD 32
-#endif
-
-mkInfoTable :: ClosureInfo -> [CAddrMode]
-mkInfoTable cl_info
- | opt_Unregisterised = std_info ++ extra_bits
- | otherwise = extra_bits ++ std_info
- where
- std_info = mkStdInfoTable entry_amode
- ty_descr_amode cl_descr_amode cl_type srt_len layout_amode
-
- entry_amode = CLbl (entryLabelFromCI cl_info) CodePtrRep
-
- closure_descr =
- case cl_info of
- ClosureInfo { closureDescr = descr } -> descr
- ConInfo { closureCon = con } -> occNameUserString (getOccName con)
-
- ty_descr_amode = CLit (MachStr (mkFastString (closureTypeDescr cl_info)))
- cl_descr_amode = CLit (MachStr (mkFastString closure_descr))
-
- cl_type = getSMRepClosureTypeInt (closureSMRep cl_info)
-
- srt = closureSRT cl_info
- needs_srt = needsSRT srt
-
- semi_tag = closureSemiTag cl_info
- is_con = isJust semi_tag
-
- (srt_label,srt_len)
- | Just tag <- semi_tag = (mkIntCLit 0, tag) -- constructor
- | otherwise =
- case srt of
- NoC_SRT -> (mkIntCLit 0, 0)
- C_SRT lbl off len ->
- (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
- len)
-
- ptrs = closurePtrsSize cl_info
- nptrs = size - ptrs
- size = closureNonHdrSize cl_info
-
- layout_info :: StgWord
-#ifdef WORDS_BIGENDIAN
- layout_info = (fromIntegral ptrs `shiftL` HALF_WORD) .|. fromIntegral nptrs
-#else
- layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` HALF_WORD)
-#endif
-
- layout_amode = mkWordCLit layout_info
-
- extra_bits
- | is_fun = fun_extra_bits
- | is_con = []
- | needs_srt = [srt_label]
- | otherwise = []
-
- maybe_fun_stuff = closureFunInfo cl_info
- is_fun = isJust maybe_fun_stuff
- (Just (arity, arg_descr)) = maybe_fun_stuff
-
- fun_extra_bits
- | opt_Unregisterised = reverse reg_fun_extra_bits
- | otherwise = reg_fun_extra_bits
-
- reg_fun_extra_bits
- | ArgGen slow_lbl liveness <- arg_descr
- = [
- CLbl slow_lbl CodePtrRep,
- livenessToAddrMode liveness,
- srt_label,
- fun_amode
- ]
- | needs_srt = [srt_label, fun_amode]
- | otherwise = [fun_amode]
-
-#ifdef WORDS_BIGENDIAN
- fun_desc = (fromIntegral fun_type `shiftL` HALF_WORD) .|. fromIntegral arity
-#else
- fun_desc = (fromIntegral fun_type) .|. (fromIntegral arity `shiftL` HALF_WORD)
-#endif
-
- fun_amode = mkWordCLit fun_desc
-
- fun_type = case arg_descr of
- ArgSpec n -> n
- ArgGen _ (Liveness _ size _)
- | size <= mAX_SMALL_BITMAP_SIZE -> ARG_GEN
- | otherwise -> ARG_GEN_BIG
-
--- Return info tables come in two flavours: direct returns and
--- vectored returns.
-
-mkRetInfoTable :: CLabel -> C_SRT -> Liveness -> [CAddrMode]
-mkRetInfoTable entry_lbl srt liveness
- = mkBitmapInfoTable (CLbl entry_lbl CodePtrRep) srt liveness []
-
-mkVecInfoTable :: [CAddrMode] -> C_SRT -> Liveness -> [CAddrMode]
-mkVecInfoTable vector srt liveness
- = mkBitmapInfoTable zero_amode srt liveness vector
-
-mkBitmapInfoTable
- :: CAddrMode
- -> C_SRT -> Liveness
- -> [CAddrMode]
- -> [CAddrMode]
-mkBitmapInfoTable entry_amode srt liveness vector
- | opt_Unregisterised = std_info ++ extra_bits
- | otherwise = extra_bits ++ std_info
- where
- std_info = mkStdInfoTable entry_amode zero_amode zero_amode
- cl_type srt_len liveness_amode
-
- liveness_amode = livenessToAddrMode liveness
-
- (srt_label,srt_len) =
- case srt of
- NoC_SRT -> (mkIntCLit 0, 0)
- C_SRT lbl off len ->
- (CAddr (CIndex (CLbl lbl DataPtrRep) (mkIntCLit off) WordRep),
- len)
-
- cl_type = case (null vector, isBigLiveness liveness) of
- (True, True) -> rET_BIG
- (True, False) -> rET_SMALL
- (False, True) -> rET_VEC_BIG
- (False, False) -> rET_VEC_SMALL
-
- srt_bit | needsSRT srt || not (null vector) = [srt_label]
- | otherwise = []
-
- extra_bits | opt_Unregisterised = srt_bit ++ vector
- | otherwise = reverse vector ++ srt_bit
-
--- The standard bits of an info table. This part of the info table
--- corresponds to the StgInfoTable type defined in InfoTables.h.
-
-mkStdInfoTable
- :: CAddrMode -- entry label
- -> CAddrMode -- closure type descr (profiling)
- -> CAddrMode -- closure descr (profiling)
- -> Int -- closure type
- -> Int -- SRT length
- -> CAddrMode -- layout field
- -> [CAddrMode]
-mkStdInfoTable entry_lbl type_descr closure_descr cl_type srt_len layout_amode
- = std_info
- where
- std_info
- | opt_Unregisterised = entry_lbl : std_info'
- | otherwise = std_info'
-
- std_info' =
- -- par info
- prof_info ++
- -- ticky info
- -- debug info
- [layout_amode] ++
- CLit (MachWord (fromIntegral type_info)) :
- []
-
- prof_info
- | opt_SccProfilingOn = [ type_descr, closure_descr ]
- | otherwise = []
-
- -- sigh: building up the info table is endian-dependent.
- -- ToDo: do this using .byte and .word directives.
- type_info :: StgWord
-#ifdef WORDS_BIGENDIAN
- type_info = (fromIntegral cl_type `shiftL` HALF_WORD) .|.
- (fromIntegral srt_len)
-#else
- type_info = (fromIntegral cl_type) .|.
- (fromIntegral srt_len `shiftL` HALF_WORD)
-#endif
-
-isBigLiveness (Liveness _ size _) = size > mAX_SMALL_BITMAP_SIZE
-
-livenessToAddrMode :: Liveness -> CAddrMode
-livenessToAddrMode (Liveness lbl size bits)
- | size <= mAX_SMALL_BITMAP_SIZE = small
- | otherwise = CLbl lbl DataPtrRep
- where
- small = mkWordCLit (fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT))
- small_bits = case bits of
- [] -> 0
- [b] -> fromIntegral (intBS b)
- _ -> panic "livenessToAddrMode"
-
-mAX_SMALL_BITMAP_SIZE = (wORD_SIZE * 8) - bITMAP_BITS_SHIFT
-
-mkWordCLit :: StgWord -> CAddrMode
-mkWordCLit wd = CLit (MachWord (fromIntegral wd))
-
-zero_amode = mkIntCLit 0
-\end{code}