2 % (c) The AQUA Project, Glasgow University, 1993-1998
7 CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
8 sStLitLbl, pprStixTrees,
10 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg,
13 fixedHS, arrWordsHS, arrPtrsHS
16 #include "HsVersions.h"
18 import Ratio ( Rational )
20 import AbsCSyn ( node, tagreg, MagicId(..) )
21 import AbsCUtils ( magicIdPrimRep )
22 import CallConv ( CallConv, pprCallConv )
23 import CLabel ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
24 import PrimRep ( PrimRep, showPrimRep )
25 import PrimOp ( PrimOp, pprPrimOp )
26 import Unique ( Unique )
27 import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
28 import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
32 Here is the tag at the nodes of our @StixTree@. Notice its
33 relationship with @PrimOp@ in prelude/PrimOp.
37 = -- Segment (text or data)
41 -- We can tag the leaves with constants/immediates.
43 | StInt Integer -- ** add Kind at some point
45 | StString FAST_STRING
46 | StLitLbl SDoc -- literal labels
47 -- (will be _-prefixed on some machines)
49 | StCLbl CLabel -- labels that we might index into
51 -- Abstract registers of various kinds
55 -- A typed offset from a base location
57 | StIndex PrimRep StixTree StixTree -- kind, base, offset
59 -- An indirection from an address to its contents.
61 | StInd PrimRep StixTree
63 -- Assignment is typed to determine size and register placement
65 | StAssign PrimRep StixTree StixTree -- dst, src
67 -- A simple assembly label that we might jump to.
71 -- A function header and footer
76 -- An unconditional jump. This instruction is terminal.
77 -- Dynamic targets are allowed
81 -- A fall-through, from slow to fast
83 | StFallThrough CLabel
85 -- A conditional jump. This instruction can be non-terminal :-)
86 -- Only static, local, forward labels are allowed
88 | StCondJump CLabel StixTree
90 -- Raw data (as in an info table).
92 | StData PrimRep [StixTree]
94 -- Primitive Operations
96 | StPrim PrimOp [StixTree]
98 -- Calls to C functions
100 | StCall FAST_STRING CallConv PrimRep [StixTree]
102 -- Assembly-language comments
104 | StComment FAST_STRING
106 sStLitLbl :: FAST_STRING -> StixTree
107 sStLitLbl s = StLitLbl (ptext s)
110 pprStixTrees :: [StixTree] -> SDoc
113 vcat (map ppStixTree ts),
118 paren t = char '(' <> t <> char ')'
120 ppStixTree :: StixTree -> SDoc
123 StSegment cseg -> paren (ppCodeSegment cseg)
124 StInt i -> paren (integer i)
125 StDouble rat -> paren (text "Double" <+> rational rat)
126 StString str -> paren (text "Str" <+> ptext str)
127 StComment str -> paren (text "Comment" <+> ptext str)
129 StCLbl lbl -> pprCLabel lbl
130 StReg reg -> ppStixReg reg
131 StIndex k b o -> paren (ppStixTree b <+> char '+' <>
132 pprPrimRep k <+> ppStixTree o)
133 StInd k t -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
134 StAssign k d s -> ppStixTree d <> text " :=" <> pprPrimRep k
135 <> text " " <> ppStixTree s
136 StLabel ll -> pprCLabel ll <+> char ':'
137 StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
138 StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll)
139 StJump t -> paren (text "Jump" <+> ppStixTree t)
140 StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
141 StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
142 StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
143 hsep (map ppStixTree ds))
144 StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
146 -> paren (text "Call" <+> ptext nm <+>
147 pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
149 pprPrimRep = text . showPrimRep
152 Stix registers can have two forms. They {\em may} or {\em may not}
153 map to real, machine-level registers.
157 = StixMagicId MagicId -- Regs which are part of the abstract machine model
159 | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
162 ppStixReg (StixMagicId mid)
164 ppStixReg (StixTemp u pr)
165 = hcat [text "Temp(", ppr u, ppr pr, char ')']
168 ppMId BaseReg = text "BaseReg"
169 ppMId (VanillaReg kind n) = hcat [text "IntReg(", int (I# n), char ')']
170 ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')']
171 ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')']
172 ppMId (LongReg kind n) = hcat [text "LongReg(", int (I# n), char ')']
175 ppMId SpLim = text "SpLim"
177 ppMId HpLim = text "HpLim"
178 ppMId CurCostCentre = text "CCC"
179 ppMId VoidReg = text "VoidReg"
182 We hope that every machine supports the idea of data segment and text
183 segment (or that it has no segments at all, and we can lump these
187 data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
188 ppCodeSegment = text . show
190 type StixTreeList = [StixTree] -> [StixTree]
193 Stix Trees for STG registers:
195 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
198 stgBaseReg = StReg (StixMagicId BaseReg)
199 stgNode = StReg (StixMagicId node)
200 stgTagReg = StReg (StixMagicId tagreg)
201 stgSp = StReg (StixMagicId Sp)
202 stgSu = StReg (StixMagicId Su)
203 stgSpLim = StReg (StixMagicId SpLim)
204 stgHp = StReg (StixMagicId Hp)
205 stgHpLim = StReg (StixMagicId HpLim)
207 getUniqLabelNCG :: UniqSM CLabel
209 = getUniqueUs `thenUs` \ u ->
210 returnUs (mkAsmTempLabel u)
212 fixedHS = StInt (toInteger fixedHdrSize)
213 arrWordsHS = StInt (toInteger arrWordsHdrSize)
214 arrPtrsHS = StInt (toInteger arrPtrsHdrSize)