2 % (c) The AQUA Project, Glasgow University, 1993-1996
6 #include "HsVersions.h"
8 module StixInfo ( genCodeInfoTable ) where
12 import AbsCSyn ( AbstractC(..), CAddrMode, ReturnInfo,
13 RegRelative, MagicId, CStmtMacro
15 import ClosureInfo ( closurePtrsSize, closureSizeWithoutFixedHdr,
16 closureNonHdrSize, closureSemiTag, maybeSelectorInfo,
17 closureSMRep, closureLabelFromCI,
20 import HeapOffs ( hpRelToInt )
21 import Maybes ( maybeToBool )
22 import PrimRep ( PrimRep(..) )
23 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..),
26 import Stix -- all of it
27 import StixPrim ( amodeToStix )
28 import UniqSupply ( returnUs, SYN_IE(UniqSM) )
29 import Pretty ( hcat, ptext, int, char )
32 Generating code for info tables (arrays of data).
35 static___rtbl = sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
36 const___rtbl = sStLitLbl SLIT("Const___rtbl")
37 charlike___rtbl = sStLitLbl SLIT("CharLike___rtbl")
38 intlike___rtbl = sStLitLbl SLIT("IntLike___rtbl")
39 gen_N___rtbl = sStLitLbl SLIT("Gen_N___rtbl")
40 gen_S___rtbl = sStLitLbl SLIT("Gen_S___rtbl")
41 gen_U___rtbl = sStLitLbl SLIT("Gen_U___rtbl")
42 tuple___rtbl = sStLitLbl SLIT("Tuple___rtbl")
43 data___rtbl = sStLitLbl SLIT("Data___rtbl")
44 dyn___rtbl = sStLitLbl SLIT("Dyn___rtbl")
48 -> UniqSM StixTreeList
50 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ upd cl_descr _)
51 = returnUs (\xs -> info : lbl : xs)
54 info = StData PtrRep table
55 lbl = StLabel info_lbl
57 table = case sm_rep of
59 StInt (toInteger ptrs),
60 StInt (toInteger size),
65 SpecialisedRep ConstantRep _ _ _ -> [
71 SpecialisedRep CharLikeRep _ _ _ -> [
76 SpecialisedRep IntLikeRep _ _ _ -> [
81 SpecialisedRep _ _ _ updatable ->
84 [ptext SLIT("Select__"),
88 [ptext (case updatable of
89 SMNormalForm -> SLIT("Spec_N_")
90 SMSingleEntry -> SLIT("Spec_S_")
91 SMUpdatable -> SLIT("Spec_U_")
99 SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
100 _ -> [StLitLbl rtbl, tag]
102 GenericRep _ _ updatable ->
103 let rtbl = case updatable of
104 SMNormalForm -> gen_N___rtbl
105 SMSingleEntry -> gen_S___rtbl
106 SMUpdatable -> gen_U___rtbl
108 StInt (toInteger ptrs),
109 StInt (toInteger size),
126 info_unused, -- no rep table
129 info_lbl = infoTableLabelFromCI cl_info
130 closure_lbl = closureLabelFromCI cl_info
132 sm_rep = closureSMRep cl_info
133 maybe_selector = maybeSelectorInfo cl_info
134 is_selector = maybeToBool maybe_selector
135 (Just (_, select_word)) = maybe_selector
137 tag = StInt (toInteger (closureSemiTag cl_info))
139 size = if isSpecRep sm_rep
140 then closureNonHdrSize cl_info
141 else hpRelToInt (closureSizeWithoutFixedHdr cl_info)
142 ptrs = closurePtrsSize cl_info
144 upd_code = amodeToStix upd
146 info_unused = StInt (-1)