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 ClosureInfo ( closurePtrsSize,
20 closureNonHdrSize, closureSMRep,
22 closureSRT, closureSemiTag
24 import PrimRep ( PrimRep(..) )
25 import SMRep ( getSMRepClosureTypeInt )
26 import Stix -- all of it
27 import UniqSupply ( returnUs, UniqSM )
28 import BitSet ( BitSet, intBS )
29 import Maybes ( maybeToBool )
35 Generating code for info tables (arrays of data).
40 -> UniqSM StixStmtList
42 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ cl_descr)
43 = returnUs (\xs -> StData PtrRep table : StLabel info_lbl : xs)
46 info_lbl = infoTableLabelFromCI cl_info
48 table | needs_srt = srt_label : rest_of_table
49 | otherwise = rest_of_table
53 {- par, prof, debug -}
54 StInt (toInteger layout_info)
55 , StInt (toInteger type_info)
58 -- sigh: building up the info table is endian-dependent.
59 -- ToDo: do this using .byte and .word directives.
61 #ifdef WORDS_BIGENDIAN
62 type_info = (fromIntegral closure_type `shiftL` 16) .|.
63 (fromIntegral srt_len)
65 type_info = (fromIntegral closure_type) .|.
66 (fromIntegral srt_len `shiftL` 16)
68 srt = closureSRT cl_info
69 needs_srt = needsSRT srt
76 NoC_SRT -> (StInt 0, 0)
77 C_SRT lbl off len -> (StIndex DataPtrRep (StCLbl lbl) (StInt (toInteger off)), len)
79 maybe_tag = closureSemiTag cl_info
80 is_constr = maybeToBool maybe_tag
81 (Just tag) = maybe_tag
84 #ifdef WORDS_BIGENDIAN
85 layout_info = (fromIntegral ptrs `shiftL` 16) .|. fromIntegral nptrs
87 layout_info = (fromIntegral ptrs) .|. (fromIntegral nptrs `shiftL` 16)
90 ptrs = closurePtrsSize cl_info
93 size = closureNonHdrSize cl_info
95 closure_type = getSMRepClosureTypeInt (closureSMRep cl_info)
103 -> Bool -- must include SRT field (i.e. it's a vector)
104 -> UniqSM StixStmtList
106 genBitmapInfoTable liveness srt closure_type include_srt
107 = returnUs (\xs -> StData PtrRep table : xs)
110 table = if srt_len == 0 && not include_srt then
113 srt_label : rest_of_table
117 {- par, prof, debug -}
119 , StInt (toInteger type_info)
122 layout_info = case liveness of
124 case bitmapToIntegers mask of
130 #ifdef WORDS_BIGENDIAN
131 type_info = (fromIntegral closure_type `shiftL` 16) .|.
132 (fromIntegral srt_len)
134 type_info = (fromIntegral closure_type) .|.
135 (fromIntegral srt_len `shiftL` 16)
138 (srt_label,srt_len) =
140 NoC_SRT -> (StInt 0, 0)
142 (StIndex DataPtrRep (StCLbl lbl)
143 (StInt (toInteger off)), len)
145 bitmapToIntegers :: [BitSet] -> [Integer]
146 bitmapToIntegers = bundle . map (toInteger . intBS)
148 #if BYTES_PER_WORD == 4
152 bundle is = case splitAt (BYTES_PER_WORD/4) is of
154 ( foldr1 (\x y -> x + 4294967296 * y)
155 [x `mod` 4294967296 | x <- these]
160 bitmapIsSmall :: [BitSet] -> Bool
162 = case bitmapToIntegers bitmap of
166 livenessIsSmall :: Liveness -> Bool
167 livenessIsSmall (Liveness _ mask) = bitmapIsSmall mask