2 % (c) The AQUA Project, Glasgow University, 1993-1995
6 #include "HsVersions.h"
15 import Maybes ( maybeToBool, Maybe(..) )
16 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
25 Generating code for info tables (arrays of data).
28 static___rtbl = sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
29 const___rtbl = sStLitLbl SLIT("Const___rtbl")
30 charlike___rtbl = sStLitLbl SLIT("CharLike___rtbl")
31 intlike___rtbl = sStLitLbl SLIT("IntLike___rtbl")
32 gen_N___rtbl = sStLitLbl SLIT("Gen_N___rtbl")
33 gen_S___rtbl = sStLitLbl SLIT("Gen_S___rtbl")
34 gen_U___rtbl = sStLitLbl SLIT("Gen_U___rtbl")
35 tuple___rtbl = sStLitLbl SLIT("Tuple___rtbl")
36 data___rtbl = sStLitLbl SLIT("Data___rtbl")
37 dyn___rtbl = sStLitLbl SLIT("Dyn___rtbl")
41 (HeapOffset -> Int) -- needed bit of Target
42 -> (CAddrMode -> StixTree) -- ditto
44 -> SUniqSM StixTreeList
46 genCodeInfoTable hp_rel amode2stix (CClosureInfoAndCode cl_info _ _ upd cl_descr _) =
47 returnSUs (\xs -> info : lbl : xs)
50 info = StData PtrKind table
51 lbl = StLabel info_lbl
53 table = case sm_rep of
55 StInt (toInteger ptrs),
56 StInt (toInteger size),
61 SpecialisedRep ConstantRep _ _ _ -> [
67 SpecialisedRep CharLikeRep _ _ _ -> [
72 SpecialisedRep IntLikeRep _ _ _ -> [
77 SpecialisedRep _ _ _ updatable ->
78 let rtbl = uppBesides (
80 [uppPStr SLIT("Select__"),
82 uppPStr SLIT("_rtbl")]
84 [uppPStr (case updatable of
85 SMNormalForm -> SLIT("Spec_N_")
86 SMSingleEntry -> SLIT("Spec_S_")
87 SMUpdatable -> SLIT("Spec_U_")
92 uppPStr SLIT("_rtbl")])
95 SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
96 _ -> [StLitLbl rtbl, tag]
98 GenericRep _ _ updatable ->
99 let rtbl = case updatable of
100 SMNormalForm -> gen_N___rtbl
101 SMSingleEntry -> gen_S___rtbl
102 SMUpdatable -> gen_U___rtbl
104 StInt (toInteger ptrs),
105 StInt (toInteger size),
122 info_unused, -- no rep table
125 info_lbl = infoTableLabelFromCI cl_info
126 closure_lbl = closureLabelFromCI cl_info
128 sm_rep = closureSMRep cl_info
129 maybe_selector = maybeSelectorInfo cl_info
130 is_selector = maybeToBool maybe_selector
131 (Just (_, select_word)) = maybe_selector
133 tag = StInt (toInteger (closureSemiTag cl_info))
135 size = if isSpecRep sm_rep
136 then closureNonHdrSize cl_info
137 else hp_rel (closureSizeWithoutFixedHdr cl_info)
138 ptrs = closurePtrsSize cl_info
140 upd_code = amode2stix upd
142 info_unused = StInt (-1)