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(..), C_SRT(..), needsSRT )
19 import StgSyn ( SRT(..) )
20 import ClosureInfo ( closurePtrsSize,
21 closureNonHdrSize, closureSMRep,
23 closureSRT, closureSemiTag
25 import PrimRep ( PrimRep(..) )
26 import SMRep ( getSMRepClosureTypeInt )
27 import Stix -- all of it
28 import UniqSupply ( returnUs, UniqSM )
29 import BitSet ( BitSet, intBS )
30 import Maybes ( maybeToBool )
35 #if __GLASGOW_HASKELL__ >= 404
36 import GlaExts ( fromInt )
40 Generating code for info tables (arrays of data).
45 -> UniqSM StixTreeList
47 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
48 = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
51 info_lbl = infoTableLabelFromCI cl_info
53 table | needs_srt = srt_label : rest_of_table
54 | otherwise = rest_of_table
58 {- par, prof, debug -}
59 StInt (toInteger layout_info)
60 , StInt (toInteger type_info)
63 -- sigh: building up the info table is endian-dependent.
64 -- ToDo: do this using .byte and .word directives.
66 #ifdef WORDS_BIGENDIAN
67 type_info = (fromInt closure_type `shiftL` 16) .|.
70 type_info = (fromInt closure_type) .|.
71 (fromInt srt_len `shiftL` 16)
73 srt = closureSRT cl_info
74 needs_srt = needsSRT srt
81 NoC_SRT -> (StInt 0, 0)
82 C_SRT lbl off len -> (StIndex DataPtrRep (StCLbl lbl) (StInt (toInteger off)), len)
84 maybe_tag = closureSemiTag cl_info
85 is_constr = maybeToBool maybe_tag
86 (Just tag) = maybe_tag
89 #ifdef WORDS_BIGENDIAN
90 layout_info = (fromInt ptrs `shiftL` 16) .|. fromInt nptrs
92 layout_info = (fromInt ptrs) .|. (fromInt nptrs `shiftL` 16)
95 ptrs = closurePtrsSize cl_info
98 size = closureNonHdrSize cl_info
100 closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
108 -> Bool -- must include SRT field (i.e. it's a vector)
109 -> UniqSM StixTreeList
111 genBitmapInfoTable liveness srt closure_type include_srt
112 = returnUs (\xs -> StData PtrRep table : xs)
115 table = if srt_len == 0 && not include_srt then
118 srt_label : rest_of_table
122 {- par, prof, debug -}
124 , StInt (toInteger type_info)
127 layout_info = case liveness of
129 case bitmapToIntegers mask of
135 #ifdef WORDS_BIGENDIAN
136 type_info = (fromInt closure_type `shiftL` 16) .|.
139 type_info = (fromInt closure_type) .|.
140 (fromInt srt_len `shiftL` 16)
143 (srt_label,srt_len) =
145 NoC_SRT -> (StInt 0, 0)
147 (StIndex DataPtrRep (StCLbl lbl)
148 (StInt (toInteger off)), len)
150 bitmapToIntegers :: [BitSet] -> [Integer]
151 bitmapToIntegers = bundle . map (toInteger . intBS)
153 #if BYTES_PER_WORD == 4
157 bundle is = case splitAt (BYTES_PER_WORD/4) is of
159 ( foldr1 (\x y -> x + 4294967296 * y)
160 [x `mod` 4294967296 | x <- these]
165 bitmapIsSmall :: [BitSet] -> Bool
167 = case bitmapToIntegers bitmap of
171 livenessIsSmall :: Liveness -> Bool
172 livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask