2 % (c) The AQUA Project, Glasgow University, 1993-1998
7 CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
8 sStLitLbl, pprStixTrees, ppStixReg,
10 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim,
11 stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
14 fixedHS, arrWordsHS, arrPtrsHS
17 #include "HsVersions.h"
19 import Ratio ( Rational )
21 import AbsCSyn ( node, tagreg, MagicId(..) )
22 import AbsCUtils ( magicIdPrimRep )
23 import CallConv ( CallConv, pprCallConv )
24 import CLabel ( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
25 import PrimRep ( PrimRep(..), showPrimRep )
26 import PrimOp ( PrimOp, pprPrimOp )
27 import Unique ( Unique )
28 import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
29 import UniqSupply ( returnUs, thenUs, getUniqueUs, UniqSM )
33 Here is the tag at the nodes of our @StixTree@. Notice its
34 relationship with @PrimOp@ in prelude/PrimOp.
38 = -- Segment (text or data)
42 -- We can tag the leaves with constants/immediates.
44 | StInt Integer -- ** add Kind at some point
46 | StString FAST_STRING
47 | StLitLbl SDoc -- literal labels
48 -- (will be _-prefixed on some machines)
50 | StCLbl CLabel -- labels that we might index into
52 -- Abstract registers of various kinds
56 -- A typed offset from a base location
58 | StIndex PrimRep StixTree StixTree -- kind, base, offset
60 -- An indirection from an address to its contents.
62 | StInd PrimRep StixTree
64 -- Assignment is typed to determine size and register placement
66 | StAssign PrimRep StixTree StixTree -- dst, src
68 -- A simple assembly label that we might jump to.
72 -- A function header and footer
77 -- An unconditional jump. This instruction is terminal.
78 -- Dynamic targets are allowed
82 -- A fall-through, from slow to fast
84 | StFallThrough CLabel
86 -- A conditional jump. This instruction can be non-terminal :-)
87 -- Only static, local, forward labels are allowed
89 | StCondJump CLabel StixTree
91 -- Raw data (as in an info table).
93 | StData PrimRep [StixTree]
95 -- Primitive Operations
97 | StPrim PrimOp [StixTree]
99 -- Calls to C functions
101 | StCall FAST_STRING CallConv PrimRep [StixTree]
103 -- A volatile memory scratch array, which is allocated
104 -- relative to the stack pointer. It is an array of
105 -- ptr/word/int sized things. Do not expect to be preserved
106 -- beyond basic blocks or over a ccall. Current max size
107 -- is 6, used in StixInteger.
111 -- Assembly-language comments
113 | StComment FAST_STRING
115 sStLitLbl :: FAST_STRING -> StixTree
116 sStLitLbl s = StLitLbl (ptext s)
119 pprStixTrees :: [StixTree] -> SDoc
122 vcat (map ppStixTree ts),
127 paren t = char '(' <> t <> char ')'
129 ppStixTree :: StixTree -> SDoc
132 StSegment cseg -> paren (ppCodeSegment cseg)
133 StInt i -> paren (integer i)
134 StDouble rat -> paren (text "Double" <+> rational rat)
135 StString str -> paren (text "Str" <+> ptext str)
136 StComment str -> paren (text "Comment" <+> ptext str)
138 StCLbl lbl -> pprCLabel lbl
139 StReg reg -> ppStixReg reg
140 StIndex k b o -> paren (ppStixTree b <+> char '+' <>
141 pprPrimRep k <+> ppStixTree o)
142 StInd k t -> pprPrimRep k <> char '[' <> ppStixTree t <> char ']'
143 StAssign k d s -> ppStixTree d <> text " :=" <> pprPrimRep k
144 <> text " " <> ppStixTree s
145 StLabel ll -> pprCLabel ll <+> char ':'
146 StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
147 StFunEnd ll -> paren (text "FunEnd" <+> pprCLabel ll)
148 StJump t -> paren (text "Jump" <+> ppStixTree t)
149 StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
150 StCondJump l t -> paren (text "JumpC" <+> pprCLabel l <+> ppStixTree t)
151 StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
152 hsep (map ppStixTree ds))
153 StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+> hsep (map ppStixTree ts))
155 -> paren (text "Call" <+> ptext nm <+>
156 pprCallConv cc <+> pprPrimRep k <+> hsep (map ppStixTree args))
157 StScratchWord i -> text "ScratchWord" <> paren (int i)
159 pprPrimRep = text . showPrimRep
162 Stix registers can have two forms. They {\em may} or {\em may not}
163 map to real, machine-level registers.
167 = StixMagicId MagicId -- Regs which are part of the abstract machine model
169 | StixTemp Unique PrimRep -- "Regs" which model local variables (CTemps) in
172 ppStixReg (StixMagicId mid)
174 ppStixReg (StixTemp u pr)
175 = hcat [text "Temp(", ppr u, ppr pr, char ')']
178 ppMId BaseReg = text "BaseReg"
179 ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(", int (I# n), char ')']
180 ppMId (FloatReg n) = hcat [text "FltReg(", int (I# n), char ')']
181 ppMId (DoubleReg n) = hcat [text "DblReg(", int (I# n), char ')']
182 ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(", int (I# n), char ')']
185 ppMId SpLim = text "SpLim"
187 ppMId HpLim = text "HpLim"
188 ppMId CurCostCentre = text "CCC"
189 ppMId VoidReg = text "VoidReg"
192 We hope that every machine supports the idea of data segment and text
193 segment (or that it has no segments at all, and we can lump these
197 data CodeSegment = DataSegment | TextSegment deriving (Eq, Show)
198 ppCodeSegment = text . show
200 type StixTreeList = [StixTree] -> [StixTree]
203 Stix Trees for STG registers:
205 stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim
208 stgBaseReg = StReg (StixMagicId BaseReg)
209 stgNode = StReg (StixMagicId node)
210 stgTagReg = StReg (StixMagicId tagreg)
211 stgSp = StReg (StixMagicId Sp)
212 stgSu = StReg (StixMagicId Su)
213 stgSpLim = StReg (StixMagicId SpLim)
214 stgHp = StReg (StixMagicId Hp)
215 stgHpLim = StReg (StixMagicId HpLim)
216 stgR9 = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
217 stgR10 = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
219 getUniqLabelNCG :: UniqSM CLabel
221 = getUniqueUs `thenUs` \ u ->
222 returnUs (mkAsmTempLabel u)
224 fixedHS = StInt (toInteger fixedHdrSize)
225 arrWordsHS = StInt (toInteger arrWordsHdrSize)
226 arrPtrsHS = StInt (toInteger arrPtrsHdrSize)