2 % (c) The AQUA Project, Glasgow University, 1993-1998
8 genCodeInfoTable, genBitmapInfoTable,
10 bitmapToIntegers, bitmapIsSmall, livenessIsSmall
14 #include "HsVersions.h"
15 #include "../includes/config.h"
18 import AbsCSyn ( AbstractC(..), Liveness(..) )
19 import CLabel ( CLabel )
20 import StgSyn ( SRT(..) )
21 import ClosureInfo ( closurePtrsSize,
22 closureNonHdrSize, closureSMRep,
24 infoTblNeedsSRT, getSRTInfo, closureSemiTag
26 import PrimRep ( PrimRep(..) )
27 import SMRep ( getSMRepClosureTypeInt )
28 import Stix -- all of it
29 import UniqSupply ( returnUs, UniqSM )
30 import BitSet ( BitSet, intBS )
31 import Maybes ( maybeToBool )
36 #if __GLASGOW_HASKELL__ >= 404
37 import GlaExts ( fromInt )
41 Generating code for info tables (arrays of data).
46 -> UniqSM StixTreeList
48 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
49 = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
52 info_lbl = infoTableLabelFromCI cl_info
53 needs_srt = infoTblNeedsSRT cl_info
55 table | needs_srt = srt_label : rest_of_table
56 | otherwise = rest_of_table
60 {- par, prof, debug -}
61 StInt (toInteger layout_info)
62 , StInt (toInteger type_info)
65 -- sigh: building up the info table is endian-dependent.
66 -- ToDo: do this using .byte and .word directives.
68 #ifdef WORDS_BIGENDIAN
69 type_info = (fromInt closure_type `shiftL` 16) .|.
72 type_info = (fromInt closure_type) .|.
73 (fromInt srt_len `shiftL` 16)
75 srt = getSRTInfo cl_info
83 (StIndex DataPtrRep (StCLbl lbl)
84 (StInt (toInteger off)), len)
88 maybe_tag = closureSemiTag cl_info
89 is_constr = maybeToBool maybe_tag
90 (Just tag) = maybe_tag
93 #ifdef WORDS_BIGENDIAN
94 layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
96 layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
99 ptrs = closurePtrsSize cl_info
102 size = closureNonHdrSize cl_info
104 closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
112 -> Bool -- must include SRT field (i.e. it's a vector)
113 -> UniqSM StixTreeList
115 genBitmapInfoTable liveness srt closure_type include_srt
116 = returnUs (\xs -> StData PtrRep table : xs)
119 table = if srt_len == 0 && not include_srt then
122 srt_label : rest_of_table
126 {- par, prof, debug -}
128 , StInt (toInteger type_info)
131 layout_info = case liveness of
133 case bitmapToIntegers mask of
139 #ifdef WORDS_BIGENDIAN
140 type_info = (fromInt closure_type `shiftL` 16) .|.
143 type_info = (fromInt closure_type) .|.
144 (fromInt srt_len `shiftL` 16)
147 (srt_label,srt_len) =
149 (lbl, NoSRT) -> (StInt 0, 0)
150 (lbl, SRT off len) ->
151 (StIndex DataPtrRep (StCLbl lbl)
152 (StInt (toInteger off)), len)
154 bitmapToIntegers :: [BitSet] -> [Integer]
155 bitmapToIntegers = bundle . map (toInteger . intBS)
157 #if BYTES_PER_WORD == 4
161 bundle is = case splitAt (BYTES_PER_WORD/4) is of
163 ( foldr1 (\x y -> x + 4294967296 * y)
164 [x `mod` 4294967296 | x <- these]
169 bitmapIsSmall :: [BitSet] -> Bool
171 = case bitmapToIntegers bitmap of
175 livenessIsSmall :: Liveness -> Bool
176 livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask