2 % (c) The AQUA Project, Glasgow University, 1993-1995
6 #include "HsVersions.h"
15 import Maybes ( maybeToBool, Maybe(..) )
16 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
24 Generating code for info tables (arrays of data).
27 static___rtbl = sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
28 const___rtbl = sStLitLbl SLIT("Const___rtbl")
29 charlike___rtbl = sStLitLbl SLIT("CharLike___rtbl")
30 intlike___rtbl = sStLitLbl SLIT("IntLike___rtbl")
31 gen_N___rtbl = sStLitLbl SLIT("Gen_N___rtbl")
32 gen_S___rtbl = sStLitLbl SLIT("Gen_S___rtbl")
33 gen_U___rtbl = sStLitLbl SLIT("Gen_U___rtbl")
34 tuple___rtbl = sStLitLbl SLIT("Tuple___rtbl")
35 data___rtbl = sStLitLbl SLIT("Data___rtbl")
36 dyn___rtbl = sStLitLbl SLIT("Dyn___rtbl")
40 (HeapOffset -> Int) -- needed bit of Target
41 -> (CAddrMode -> StixTree) -- ditto
43 -> UniqSM StixTreeList
45 genCodeInfoTable hp_rel amode2stix (CClosureInfoAndCode cl_info _ _ upd cl_descr _) =
46 returnUs (\xs -> info : lbl : xs)
49 info = StData PtrRep table
50 lbl = StLabel info_lbl
52 table = case sm_rep of
54 StInt (toInteger ptrs),
55 StInt (toInteger size),
60 SpecialisedRep ConstantRep _ _ _ -> [
66 SpecialisedRep CharLikeRep _ _ _ -> [
71 SpecialisedRep IntLikeRep _ _ _ -> [
76 SpecialisedRep _ _ _ updatable ->
77 let rtbl = uppBesides (
79 [uppPStr SLIT("Select__"),
81 uppPStr SLIT("_rtbl")]
83 [uppPStr (case updatable of
84 SMNormalForm -> SLIT("Spec_N_")
85 SMSingleEntry -> SLIT("Spec_S_")
86 SMUpdatable -> SLIT("Spec_U_")
91 uppPStr SLIT("_rtbl")])
94 SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
95 _ -> [StLitLbl rtbl, tag]
97 GenericRep _ _ updatable ->
98 let rtbl = case updatable of
99 SMNormalForm -> gen_N___rtbl
100 SMSingleEntry -> gen_S___rtbl
101 SMUpdatable -> gen_U___rtbl
103 StInt (toInteger ptrs),
104 StInt (toInteger size),
121 info_unused, -- no rep table
124 info_lbl = infoTableLabelFromCI cl_info
125 closure_lbl = closureLabelFromCI cl_info
127 sm_rep = closureSMRep cl_info
128 maybe_selector = maybeSelectorInfo cl_info
129 is_selector = maybeToBool maybe_selector
130 (Just (_, select_word)) = maybe_selector
132 tag = StInt (toInteger (closureSemiTag cl_info))
134 size = if isSpecRep sm_rep
135 then closureNonHdrSize cl_info
136 else hp_rel (closureSizeWithoutFixedHdr cl_info)
137 ptrs = closurePtrsSize cl_info
139 upd_code = amode2stix upd
141 info_unused = StInt (-1)