2 % (c) The AQUA Project, Glasgow University, 1993-1996
6 module StixInfo ( genCodeInfoTable ) where
8 #include "HsVersions.h"
10 import AbsCSyn ( AbstractC(..), CAddrMode, ReturnInfo,
11 RegRelative, MagicId, CStmtMacro
13 import ClosureInfo ( closurePtrsSize, closureSizeWithoutFixedHdr,
14 closureNonHdrSize, closureSemiTag, maybeSelectorInfo,
15 closureSMRep, closureLabelFromCI,
18 import HeapOffs ( hpRelToInt )
19 import Maybes ( maybeToBool )
20 import PrimRep ( PrimRep(..) )
21 import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..),
24 import Stix -- all of it
25 import StixPrim ( amodeToStix )
26 import UniqSupply ( returnUs, UniqSM )
27 import Outputable ( hcat, ptext, int, char )
30 Generating code for info tables (arrays of data).
33 static___rtbl = sStLitLbl SLIT("Static___rtbl") -- out here to avoid CAF (sigh)
34 const___rtbl = sStLitLbl SLIT("Const___rtbl")
35 charlike___rtbl = sStLitLbl SLIT("CharLike___rtbl")
36 intlike___rtbl = sStLitLbl SLIT("IntLike___rtbl")
37 gen_N___rtbl = sStLitLbl SLIT("Gen_N___rtbl")
38 gen_S___rtbl = sStLitLbl SLIT("Gen_S___rtbl")
39 gen_U___rtbl = sStLitLbl SLIT("Gen_U___rtbl")
40 tuple___rtbl = sStLitLbl SLIT("Tuple___rtbl")
41 data___rtbl = sStLitLbl SLIT("Data___rtbl")
42 dyn___rtbl = sStLitLbl SLIT("Dyn___rtbl")
46 -> UniqSM StixTreeList
48 genCodeInfoTable (CClosureInfoAndCode cl_info _ _ upd cl_descr _)
49 = returnUs (\xs -> info : lbl : xs)
52 info = StData PtrRep table
53 lbl = StLabel info_lbl
55 table = case sm_rep of
57 StInt (toInteger ptrs),
58 StInt (toInteger size),
63 SpecialisedRep ConstantRep _ _ _ -> [
69 SpecialisedRep CharLikeRep _ _ _ -> [
74 SpecialisedRep IntLikeRep _ _ _ -> [
79 SpecialisedRep _ _ _ updatable ->
82 [ptext SLIT("Select__"),
86 [ptext (case updatable of
87 SMNormalForm -> SLIT("Spec_N_")
88 SMSingleEntry -> SLIT("Spec_S_")
89 SMUpdatable -> SLIT("Spec_U_")
97 SMNormalForm -> [upd_code, StLitLbl rtbl, tag]
98 _ -> [StLitLbl rtbl, tag]
100 GenericRep _ _ updatable ->
101 let rtbl = case updatable of
102 SMNormalForm -> gen_N___rtbl
103 SMSingleEntry -> gen_S___rtbl
104 SMUpdatable -> gen_U___rtbl
106 StInt (toInteger ptrs),
107 StInt (toInteger size),
124 info_unused, -- no rep table
127 info_lbl = infoTableLabelFromCI cl_info
128 closure_lbl = closureLabelFromCI cl_info
130 sm_rep = closureSMRep cl_info
131 maybe_selector = maybeSelectorInfo cl_info
132 is_selector = maybeToBool maybe_selector
133 (Just (_, select_word)) = maybe_selector
135 tag = StInt (toInteger (closureSemiTag cl_info))
137 size = if isSpecRep sm_rep
138 then closureNonHdrSize cl_info
139 else hpRelToInt (closureSizeWithoutFixedHdr cl_info)
140 ptrs = closurePtrsSize cl_info
142 upd_code = amodeToStix upd
144 info_unused = StInt (-1)