Big collection of patches for the new codegen branch.
[ghc.git] / compiler / cmm / PprCmm.hs
1 ----------------------------------------------------------------------------
2 --
3 -- Pretty-printing of Cmm as (a superset of) C--
4 --
5 -- (c) The University of Glasgow 2004-2006
6 --
7 -----------------------------------------------------------------------------
8
9 --
10 -- This is where we walk over Cmm emitting an external representation,
11 -- suitable for parsing, in a syntax strongly reminiscent of C--. This
12 -- is the "External Core" for the Cmm layer.
13 --
14 -- As such, this should be a well-defined syntax: we want it to look nice.
15 -- Thus, we try wherever possible to use syntax defined in [1],
16 -- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
17 -- slightly, in some cases. For one, we use I8 .. I64 for types, rather
18 -- than C--'s bits8 .. bits64.
19 --
20 -- We try to ensure that all information available in the abstract
21 -- syntax is reproduced, or reproducible, in the concrete syntax.
22 -- Data that is not in printed out can be reconstructed according to
23 -- conventions used in the pretty printer. There are at least two such
24 -- cases:
25 -- 1) if a value has wordRep type, the type is not appended in the
26 -- output.
27 -- 2) MachOps that operate over wordRep type are printed in a
28 -- C-style, rather than as their internal MachRep name.
29 --
30 -- These conventions produce much more readable Cmm output.
31 --
32 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
33 --
34
35 module PprCmm
36 ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr,
37 pprSection, pprStatic, pprLit
38 )
39 where
40
41 import BlockId
42 import Cmm
43 import CmmUtils
44 import CLabel
45
46
47 import ForeignCall
48 import Outputable
49 import FastString
50
51 import Data.List
52 import System.IO
53 import Data.Maybe
54
55 -- Temp Jan08
56 import SMRep
57 import ClosureInfo
58 #include "../includes/StgFun.h"
59
60
61 pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc
62 pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
63 where
64 separator = space $$ ptext (sLit "-------------------") $$ space
65
66 writeCmms :: Handle -> [Cmm] -> IO ()
67 writeCmms handle cmms = printForC handle (pprCmms cmms)
68
69 -----------------------------------------------------------------------------
70
71 instance (Outputable d, Outputable info, Outputable g)
72 => Outputable (GenCmm d info g) where
73 ppr c = pprCmm c
74
75 instance (Outputable d, Outputable info, Outputable i)
76 => Outputable (GenCmmTop d info i) where
77 ppr t = pprTop t
78
79 instance (Outputable instr) => Outputable (ListGraph instr) where
80 ppr (ListGraph blocks) = vcat (map ppr blocks)
81
82 instance (Outputable instr) => Outputable (GenBasicBlock instr) where
83 ppr b = pprBBlock b
84
85 instance Outputable CmmStmt where
86 ppr s = pprStmt s
87
88 instance Outputable CmmExpr where
89 ppr e = pprExpr e
90
91 instance Outputable CmmReg where
92 ppr e = pprReg e
93
94 instance Outputable CmmLit where
95 ppr l = pprLit l
96
97 instance Outputable LocalReg where
98 ppr e = pprLocalReg e
99
100 instance Outputable Area where
101 ppr e = pprArea e
102
103 instance Outputable GlobalReg where
104 ppr e = pprGlobalReg e
105
106 instance Outputable CmmStatic where
107 ppr e = pprStatic e
108
109 instance Outputable CmmInfo where
110 ppr e = pprInfo e
111
112
113
114 -----------------------------------------------------------------------------
115
116 pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc
117 pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
118
119 -- --------------------------------------------------------------------------
120 -- Top level `procedure' blocks.
121 --
122 pprTop :: (Outputable d, Outputable info, Outputable i)
123 => GenCmmTop d info i -> SDoc
124
125 pprTop (CmmProc info lbl params graph )
126
127 = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params)
128 , nest 8 $ lbrace <+> ppr info $$ rbrace
129 , nest 4 $ ppr graph
130 , rbrace ]
131
132 -- --------------------------------------------------------------------------
133 -- We follow [1], 4.5
134 --
135 -- section "data" { ... }
136 --
137 pprTop (CmmData section ds) =
138 (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds)))
139 $$ rbrace
140
141 -- --------------------------------------------------------------------------
142 instance Outputable CmmSafety where
143 ppr CmmUnsafe = ptext (sLit "_unsafe_call_")
144 ppr (CmmSafe srt) = ppr srt
145
146 -- --------------------------------------------------------------------------
147 -- Info tables. The current pretty printer needs refinement
148 -- but will work for now.
149 --
150 -- For ideas on how to refine it, they used to be printed in the
151 -- style of C--'s 'stackdata' declaration, just inside the proc body,
152 -- and were labelled with the procedure name ++ "_info".
153 pprInfo :: CmmInfo -> SDoc
154 pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) =
155 vcat [{-ptext (sLit "gc_target: ") <>
156 maybe (ptext (sLit "<none>")) ppr gc_target,-}
157 ptext (sLit "update_frame: ") <>
158 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame]
159 pprInfo (CmmInfo _gc_target update_frame
160 (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) =
161 vcat [{-ptext (sLit "gc_target: ") <>
162 maybe (ptext (sLit "<none>")) ppr gc_target,-}
163 ptext (sLit "has static closure: ") <> ppr stat_clos <+>
164 ptext (sLit "update_frame: ") <>
165 maybe (ptext (sLit "<none>")) pprUpdateFrame update_frame,
166 ptext (sLit "type: ") <> pprLit closure_type,
167 ptext (sLit "desc: ") <> pprLit closure_desc,
168 ptext (sLit "tag: ") <> integer (toInteger tag),
169 pprTypeInfo info]
170
171 pprTypeInfo :: ClosureTypeInfo -> SDoc
172 pprTypeInfo (ConstrInfo layout constr descr) =
173 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
174 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
175 ptext (sLit "constructor: ") <> integer (toInteger constr),
176 pprLit descr]
177 pprTypeInfo (FunInfo layout srt arity _args slow_entry) =
178 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
179 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
180 ptext (sLit "srt: ") <> ppr srt,
181 -- Temp Jan08
182 ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)),
183
184 ptext (sLit "arity: ") <> integer (toInteger arity),
185 --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed
186 ptext (sLit "slow: ") <> pprLit slow_entry
187 ]
188 pprTypeInfo (ThunkInfo layout srt) =
189 vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)),
190 ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)),
191 ptext (sLit "srt: ") <> ppr srt]
192 pprTypeInfo (ThunkSelectorInfo offset srt) =
193 vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset),
194 ptext (sLit "srt: ") <> ppr srt]
195 pprTypeInfo (ContInfo stack srt) =
196 vcat [ptext (sLit "stack: ") <> ppr stack,
197 ptext (sLit "srt: ") <> ppr srt]
198
199 -- Temp Jan08
200 argDescrType :: ArgDescr -> StgHalfWord
201 -- The "argument type" RTS field type
202 argDescrType (ArgSpec n) = n
203 argDescrType (ArgGen liveness)
204 | isBigLiveness liveness = ARG_GEN_BIG
205 | otherwise = ARG_GEN
206
207 -- Temp Jan08
208 isBigLiveness :: Liveness -> Bool
209 isBigLiveness (BigLiveness _) = True
210 isBigLiveness (SmallLiveness _) = False
211
212
213 pprUpdateFrame :: UpdateFrame -> SDoc
214 pprUpdateFrame (UpdateFrame expr args) =
215 hcat [ ptext (sLit "jump")
216 , space
217 , if isTrivialCmmExpr expr
218 then pprExpr expr
219 else case expr of
220 CmmLoad (CmmReg _) _ -> pprExpr expr
221 _ -> parens (pprExpr expr)
222 , space
223 , parens ( commafy $ map ppr args ) ]
224
225
226 -- --------------------------------------------------------------------------
227 -- Basic blocks look like assembly blocks.
228 -- lbl: stmt ; stmt ; ..
229 pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc
230 pprBBlock (BasicBlock ident stmts) =
231 hang (ppr ident <> colon) 4 (vcat (map ppr stmts))
232
233 -- --------------------------------------------------------------------------
234 -- Statements. C-- usually, exceptions to this should be obvious.
235 --
236 pprStmt :: CmmStmt -> SDoc
237 pprStmt stmt = case stmt of
238
239 -- ;
240 CmmNop -> semi
241
242 -- // text
243 CmmComment s -> text "//" <+> ftext s
244
245 -- reg = expr;
246 CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
247
248 -- rep[lv] = expr;
249 CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
250 where
251 rep = ppr ( cmmExprType expr )
252
253 -- call "ccall" foo(x, y)[r1, r2];
254 -- ToDo ppr volatile
255 CmmCall (CmmCallee fn cconv) results args safety ret ->
256 sep [ pp_lhs <+> pp_conv
257 , nest 2 (pprExpr9 fn <>
258 parens (commafy (map ppr_ar args)))
259 <> brackets (ppr safety)
260 , case ret of CmmMayReturn -> empty
261 CmmNeverReturns -> ptext $ sLit (" never returns")
262 ] <> semi
263 where
264 pp_lhs | null results = empty
265 | otherwise = commafy (map ppr_ar results) <+> equals
266 -- Don't print the hints on a native C-- call
267 ppr_ar (CmmHinted ar k) = case cconv of
268 CmmCallConv -> ppr ar
269 _ -> ppr (ar,k)
270 pp_conv = case cconv of
271 CmmCallConv -> empty
272 _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
273
274 CmmCall (CmmPrim op) results args safety ret ->
275 pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
276 results args safety ret)
277 where
278 lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
279
280 CmmBranch ident -> genBranch ident
281 CmmCondBranch expr ident -> genCondBranch expr ident
282 CmmJump expr params -> genJump expr params
283 CmmReturn params -> genReturn params
284 CmmSwitch arg ids -> genSwitch arg ids
285
286 instance Outputable ForeignHint where
287 ppr NoHint = empty
288 ppr SignedHint = quotes(text "signed")
289 -- ppr AddrHint = quotes(text "address")
290 -- Temp Jan08
291 ppr AddrHint = (text "PtrHint")
292
293 -- Just look like a tuple, since it was a tuple before
294 -- ... is that a good idea? --Isaac Dupree
295 instance (Outputable a) => Outputable (CmmHinted a) where
296 ppr (CmmHinted a k) = ppr (a, k)
297
298 -- --------------------------------------------------------------------------
299 -- goto local label. [1], section 6.6
300 --
301 -- goto lbl;
302 --
303 genBranch :: BlockId -> SDoc
304 genBranch ident =
305 ptext (sLit "goto") <+> ppr ident <> semi
306
307 -- --------------------------------------------------------------------------
308 -- Conditional. [1], section 6.4
309 --
310 -- if (expr) { goto lbl; }
311 --
312 genCondBranch :: CmmExpr -> BlockId -> SDoc
313 genCondBranch expr ident =
314 hsep [ ptext (sLit "if")
315 , parens(ppr expr)
316 , ptext (sLit "goto")
317 , ppr ident <> semi ]
318
319 -- --------------------------------------------------------------------------
320 -- A tail call. [1], Section 6.9
321 --
322 -- jump foo(a, b, c);
323 --
324 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
325 genJump expr args =
326 hcat [ ptext (sLit "jump")
327 , space
328 , if isTrivialCmmExpr expr
329 then pprExpr expr
330 else case expr of
331 CmmLoad (CmmReg _) _ -> pprExpr expr
332 _ -> parens (pprExpr expr)
333 , space
334 , parens ( commafy $ map ppr args )
335 , semi ]
336
337
338 -- --------------------------------------------------------------------------
339 -- Return from a function. [1], Section 6.8.2 of version 1.128
340 --
341 -- return (a, b, c);
342 --
343 genReturn :: [CmmHinted CmmExpr] -> SDoc
344 genReturn args =
345 hcat [ ptext (sLit "return")
346 , space
347 , parens ( commafy $ map ppr args )
348 , semi ]
349
350 -- --------------------------------------------------------------------------
351 -- Tabled jump to local label
352 --
353 -- The syntax is from [1], section 6.5
354 --
355 -- switch [0 .. n] (expr) { case ... ; }
356 --
357 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
358 genSwitch expr maybe_ids
359
360 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
361
362 in hang (hcat [ ptext (sLit "switch [0 .. ")
363 , int (length maybe_ids - 1)
364 , ptext (sLit "] ")
365 , if isTrivialCmmExpr expr
366 then pprExpr expr
367 else parens (pprExpr expr)
368 , ptext (sLit " {")
369 ])
370 4 (vcat ( map caseify pairs )) $$ rbrace
371
372 where
373 snds a b = (snd a) == (snd b)
374
375 caseify :: [(Int,Maybe BlockId)] -> SDoc
376 caseify ixs@((_,Nothing):_)
377 = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
378 <> ptext (sLit " */")
379 caseify as
380 = let (is,ids) = unzip as
381 in hsep [ ptext (sLit "case")
382 , hcat (punctuate comma (map int is))
383 , ptext (sLit ": goto")
384 , ppr (head [ id | Just id <- ids]) <> semi ]
385
386 -- --------------------------------------------------------------------------
387 -- Expressions
388 --
389
390 pprExpr :: CmmExpr -> SDoc
391 pprExpr e
392 = case e of
393 CmmRegOff reg i ->
394 pprExpr (CmmMachOp (MO_Add rep)
395 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
396 where rep = typeWidth (cmmRegType reg)
397 CmmLit lit -> pprLit lit
398 _other -> pprExpr1 e
399
400 -- Here's the precedence table from CmmParse.y:
401 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
402 -- %left '|'
403 -- %left '^'
404 -- %left '&'
405 -- %left '>>' '<<'
406 -- %left '-' '+'
407 -- %left '/' '*' '%'
408 -- %right '~'
409
410 -- We just cope with the common operators for now, the rest will get
411 -- a default conservative behaviour.
412
413 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
414 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
415 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
416 = pprExpr7 x <+> doc <+> pprExpr7 y
417 pprExpr1 e = pprExpr7 e
418
419 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
420
421 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
422 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
423 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
424 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
425 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
426 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
427 infixMachOp1 (MO_U_Gt _) = Just (char '>')
428 infixMachOp1 (MO_U_Lt _) = Just (char '<')
429 infixMachOp1 _ = Nothing
430
431 -- %left '-' '+'
432 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
433 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
434 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
435 = pprExpr7 x <+> doc <+> pprExpr8 y
436 pprExpr7 e = pprExpr8 e
437
438 infixMachOp7 (MO_Add _) = Just (char '+')
439 infixMachOp7 (MO_Sub _) = Just (char '-')
440 infixMachOp7 _ = Nothing
441
442 -- %left '/' '*' '%'
443 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
444 = pprExpr8 x <+> doc <+> pprExpr9 y
445 pprExpr8 e = pprExpr9 e
446
447 infixMachOp8 (MO_U_Quot _) = Just (char '/')
448 infixMachOp8 (MO_Mul _) = Just (char '*')
449 infixMachOp8 (MO_U_Rem _) = Just (char '%')
450 infixMachOp8 _ = Nothing
451
452 pprExpr9 :: CmmExpr -> SDoc
453 pprExpr9 e =
454 case e of
455 CmmLit lit -> pprLit1 lit
456 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
457 CmmReg reg -> ppr reg
458 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
459 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
460 CmmMachOp mop args -> genMachOp mop args
461
462 genMachOp :: MachOp -> [CmmExpr] -> SDoc
463 genMachOp mop args
464 | Just doc <- infixMachOp mop = case args of
465 -- dyadic
466 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
467
468 -- unary
469 [x] -> doc <> pprExpr9 x
470
471 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
472 (pprMachOp mop <+>
473 parens (hcat $ punctuate comma (map pprExpr args)))
474 empty
475
476 | isJust (infixMachOp1 mop)
477 || isJust (infixMachOp7 mop)
478 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
479
480 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
481 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
482 (show mop))
483 -- replace spaces in (show mop) with underscores,
484
485 --
486 -- Unsigned ops on the word size of the machine get nice symbols.
487 -- All else get dumped in their ugly format.
488 --
489 infixMachOp :: MachOp -> Maybe SDoc
490 infixMachOp mop
491 = case mop of
492 MO_And _ -> Just $ char '&'
493 MO_Or _ -> Just $ char '|'
494 MO_Xor _ -> Just $ char '^'
495 MO_Not _ -> Just $ char '~'
496 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
497 _ -> Nothing
498
499 -- --------------------------------------------------------------------------
500 -- Literals.
501 -- To minimise line noise we adopt the convention that if the literal
502 -- has the natural machine word size, we do not append the type
503 --
504 pprLit :: CmmLit -> SDoc
505 pprLit lit = case lit of
506 CmmInt i rep ->
507 hcat [ (if i < 0 then parens else id)(integer i)
508 , (if rep == wordWidth
509 then empty
510 else space <> dcolon <+> ppr rep) ]
511
512 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
513 CmmLabel clbl -> pprCLabel clbl
514 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
515 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
516 <> pprCLabel clbl2 <> ppr_offset i
517 CmmBlock id -> ppr id
518 CmmHighStackMark -> text "<highSp>"
519
520 pprLit1 :: CmmLit -> SDoc
521 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
522 pprLit1 lit = pprLit lit
523
524 ppr_offset :: Int -> SDoc
525 ppr_offset i
526 | i==0 = empty
527 | i>=0 = char '+' <> int i
528 | otherwise = char '-' <> int (-i)
529
530 -- --------------------------------------------------------------------------
531 -- Static data.
532 -- Strings are printed as C strings, and we print them as I8[],
533 -- following C--
534 --
535 pprStatic :: CmmStatic -> SDoc
536 pprStatic s = case s of
537 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
538 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
539 CmmAlign i -> nest 4 $ text "align" <+> int i
540 CmmDataLabel clbl -> pprCLabel clbl <> colon
541 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
542
543 -- --------------------------------------------------------------------------
544 -- Registers, whether local (temps) or global
545 --
546 pprReg :: CmmReg -> SDoc
547 pprReg r
548 = case r of
549 CmmLocal local -> pprLocalReg local
550 CmmGlobal global -> pprGlobalReg global
551
552 --
553 -- We only print the type of the local reg if it isn't wordRep
554 --
555 pprLocalReg :: LocalReg -> SDoc
556 pprLocalReg (LocalReg uniq rep)
557 -- = ppr rep <> char '_' <> ppr uniq
558 -- Temp Jan08
559 = char '_' <> ppr uniq <>
560 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
561 then dcolon <> ptr <> ppr rep
562 else dcolon <> ptr <> ppr rep)
563 where
564 ptr = empty
565 --if isGcPtrType rep
566 -- then doubleQuotes (text "ptr")
567 -- else empty
568
569 -- Stack areas
570 pprArea :: Area -> SDoc
571 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
572 pprArea (CallArea id) = pprAreaId id
573
574 pprAreaId :: AreaId -> SDoc
575 pprAreaId Old = text "old"
576 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
577
578 -- needs to be kept in syn with Cmm.hs.GlobalReg
579 --
580 pprGlobalReg :: GlobalReg -> SDoc
581 pprGlobalReg gr
582 = case gr of
583 VanillaReg n _ -> char 'R' <> int n
584 -- Temp Jan08
585 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
586 -- VanillaReg n VGcPtr -> char 'P' <> int n
587 FloatReg n -> char 'F' <> int n
588 DoubleReg n -> char 'D' <> int n
589 LongReg n -> char 'L' <> int n
590 Sp -> ptext (sLit "Sp")
591 SpLim -> ptext (sLit "SpLim")
592 Hp -> ptext (sLit "Hp")
593 HpLim -> ptext (sLit "HpLim")
594 CurrentTSO -> ptext (sLit "CurrentTSO")
595 CurrentNursery -> ptext (sLit "CurrentNursery")
596 HpAlloc -> ptext (sLit "HpAlloc")
597 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
598 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
599 GCFun -> ptext (sLit "stg_gc_fun")
600 BaseReg -> ptext (sLit "BaseReg")
601 PicBaseReg -> ptext (sLit "PicBaseReg")
602
603 -- --------------------------------------------------------------------------
604 -- data sections
605 --
606 pprSection :: Section -> SDoc
607 pprSection s = case s of
608 Text -> section <+> doubleQuotes (ptext (sLit "text"))
609 Data -> section <+> doubleQuotes (ptext (sLit "data"))
610 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
611 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
612 RelocatableReadOnlyData
613 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
614 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
615 OtherSection s' -> section <+> doubleQuotes (text s')
616 where
617 section = ptext (sLit "section")
618
619 -----------------------------------------------------------------------------
620
621 commafy :: [SDoc] -> SDoc
622 commafy xs = fsep $ punctuate comma xs