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