%
\begin{code}
-module StixInfo ( genCodeInfoTable, genBitmapInfoTable ) where
+module StixInfo (
+
+ genCodeInfoTable, genBitmapInfoTable,
+
+ bitmapToIntegers, bitmapIsSmall, livenessIsSmall
+
+ ) where
#include "HsVersions.h"
#include "../includes/config.h"
+#include "NCG.h"
-import AbsCSyn ( AbstractC(..), Liveness(..) )
-import CLabel ( CLabel )
-import StgSyn ( SRT(..) )
+import AbsCSyn ( AbstractC(..), Liveness(..), C_SRT(..), needsSRT )
import ClosureInfo ( closurePtrsSize,
closureNonHdrSize, closureSMRep,
infoTableLabelFromCI,
- infoTblNeedsSRT, getSRTInfo
+ closureSRT, closureSemiTag
)
import PrimRep ( PrimRep(..) )
-import SMRep ( SMRep(..), getSMRepClosureTypeInt )
+import SMRep ( getSMRepClosureTypeInt )
import Stix -- all of it
import UniqSupply ( returnUs, UniqSM )
-import Outputable ( int )
-import BitSet ( intBS )
+import BitSet ( BitSet, intBS )
+import Maybes ( maybeToBool )
import Bits
import Word
\begin{code}
genCodeInfoTable
:: AbstractC
- -> UniqSM StixTreeList
+ -> UniqSM StixStmtList
genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
= returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
where
- info_lbl = infoTableLabelFromCI cl_info
+ info_lbl = infoTableLabelFromCI cl_info
- table | infoTblNeedsSRT cl_info = srt_label : rest_of_table
- | otherwise = rest_of_table
+ table | needs_srt = srt_label : rest_of_table
+ | otherwise = rest_of_table
rest_of_table =
[
-- ToDo: do this using .byte and .word directives.
type_info :: Word32
#ifdef WORDS_BIGENDIAN
- type_info = (fromInt flags `shiftL` 24) .|.
- (fromInt closure_type `shiftL` 16) .|.
- (fromInt srt_len)
+ type_info = (fromIntegral closure_type `shiftL` 16) .|.
+ (fromIntegral srt_len)
#else
- type_info = (fromInt flags) .|.
- (fromInt closure_type `shiftL` 8) .|.
- (fromInt srt_len `shiftL` 16)
+ type_info = (fromIntegral closure_type) .|.
+ (fromIntegral srt_len `shiftL` 16)
#endif
- srt = getSRTInfo cl_info
+ srt = closureSRT cl_info
+ needs_srt = needsSRT srt
- (srt_label,srt_len) =
- case srt of
- (lbl, NoSRT) -> (StInt 0, 0)
- (lbl, SRT off len) ->
- (StIndex DataPtrRep (StCLbl lbl)
- (StInt (toInteger off)), len)
+ (srt_label,srt_len)
+ | is_constr
+ = (StInt 0, tag)
+ | otherwise
+ = case srt of
+ NoC_SRT -> (StInt 0, 0)
+ C_SRT lbl off len -> (StIndex DataPtrRep (StCLbl lbl) (StInt (toInteger off)), len)
+
+ maybe_tag = closureSemiTag cl_info
+ is_constr = maybeToBool maybe_tag
+ (Just tag) = maybe_tag
layout_info :: Word32
#ifdef WORDS_BIGENDIAN
- layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
+ layout_info = (fromIntegral ptrs `shiftL` 16) .|. fromIntegral nptrs
#else
- layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
+ layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` 16)
#endif
ptrs = closurePtrsSize cl_info
closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
- flags = 0 -- for now
genBitmapInfoTable
:: Liveness
- -> (CLabel, SRT)
+ -> C_SRT
-> Int
-> Bool -- must include SRT field (i.e. it's a vector)
- -> UniqSM StixTreeList
+ -> UniqSM StixStmtList
genBitmapInfoTable liveness srt closure_type include_srt
= returnUs (\xs -> StData PtrRep table : xs)
]
layout_info = case liveness of
- LvSmall mask -> StInt (toInteger (intBS mask))
- LvLarge lbl -> StCLbl lbl
+ Liveness lbl mask ->
+ case bitmapToIntegers mask of
+ [ ] -> StInt 0
+ [i] -> StInt i
+ _ -> StCLbl lbl
type_info :: Word32
#ifdef WORDS_BIGENDIAN
- type_info = (fromInt flags `shiftL` 24) .|.
- (fromInt closure_type `shiftL` 16) .|.
- (fromInt srt_len)
+ type_info = (fromIntegral closure_type `shiftL` 16) .|.
+ (fromIntegral srt_len)
#else
- type_info = (fromInt flags) .|.
- (fromInt closure_type `shiftL` 8) .|.
- (fromInt srt_len `shiftL` 16)
+ type_info = (fromIntegral closure_type) .|.
+ (fromIntegral srt_len `shiftL` 16)
#endif
(srt_label,srt_len) =
case srt of
- (lbl, NoSRT) -> (StInt 0, 0)
- (lbl, SRT off len) ->
+ NoC_SRT -> (StInt 0, 0)
+ C_SRT lbl off len ->
(StIndex DataPtrRep (StCLbl lbl)
(StInt (toInteger off)), len)
- flags = 0 -- for now
+bitmapToIntegers :: [BitSet] -> [Integer]
+bitmapToIntegers = bundle . map (toInteger . intBS)
+ where
+#if BYTES_PER_WORD == 4
+ bundle = id
+#else
+ bundle [] = []
+ bundle is = case splitAt (BYTES_PER_WORD/4) is of
+ (these, those) ->
+ ( foldr1 (\x y -> x + 4294967296 * y)
+ [x `mod` 4294967296 | x <- these]
+ : bundle those
+ )
+#endif
+
+bitmapIsSmall :: [BitSet] -> Bool
+bitmapIsSmall bitmap
+ = case bitmapToIntegers bitmap of
+ _:_:_ -> False
+ _ -> True
+
+livenessIsSmall :: Liveness -> Bool
+livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask
\end{code}