Tag ForeignCalls with the package they correspond to
[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/rts/storage/FunTypes.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 blankLine $ 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 -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
276 CmmCall (CmmPrim op) results args safety ret ->
277 pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
278 results args safety ret)
279 where
280 -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
281 -- use one to get the label printed.
282 lbl = CmmLabel (mkForeignLabel
283 (mkFastString (show op))
284 Nothing ForeignLabelInThisPackage IsFunction)
285
286 CmmBranch ident -> genBranch ident
287 CmmCondBranch expr ident -> genCondBranch expr ident
288 CmmJump expr params -> genJump expr params
289 CmmReturn params -> genReturn params
290 CmmSwitch arg ids -> genSwitch arg ids
291
292 instance Outputable ForeignHint where
293 ppr NoHint = empty
294 ppr SignedHint = quotes(text "signed")
295 -- ppr AddrHint = quotes(text "address")
296 -- Temp Jan08
297 ppr AddrHint = (text "PtrHint")
298
299 -- Just look like a tuple, since it was a tuple before
300 -- ... is that a good idea? --Isaac Dupree
301 instance (Outputable a) => Outputable (CmmHinted a) where
302 ppr (CmmHinted a k) = ppr (a, k)
303
304 -- --------------------------------------------------------------------------
305 -- goto local label. [1], section 6.6
306 --
307 -- goto lbl;
308 --
309 genBranch :: BlockId -> SDoc
310 genBranch ident =
311 ptext (sLit "goto") <+> ppr ident <> semi
312
313 -- --------------------------------------------------------------------------
314 -- Conditional. [1], section 6.4
315 --
316 -- if (expr) { goto lbl; }
317 --
318 genCondBranch :: CmmExpr -> BlockId -> SDoc
319 genCondBranch expr ident =
320 hsep [ ptext (sLit "if")
321 , parens(ppr expr)
322 , ptext (sLit "goto")
323 , ppr ident <> semi ]
324
325 -- --------------------------------------------------------------------------
326 -- A tail call. [1], Section 6.9
327 --
328 -- jump foo(a, b, c);
329 --
330 genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
331 genJump expr args =
332 hcat [ ptext (sLit "jump")
333 , space
334 , if isTrivialCmmExpr expr
335 then pprExpr expr
336 else case expr of
337 CmmLoad (CmmReg _) _ -> pprExpr expr
338 _ -> parens (pprExpr expr)
339 , space
340 , parens ( commafy $ map ppr args )
341 , semi ]
342
343
344 -- --------------------------------------------------------------------------
345 -- Return from a function. [1], Section 6.8.2 of version 1.128
346 --
347 -- return (a, b, c);
348 --
349 genReturn :: [CmmHinted CmmExpr] -> SDoc
350 genReturn args =
351 hcat [ ptext (sLit "return")
352 , space
353 , parens ( commafy $ map ppr args )
354 , semi ]
355
356 -- --------------------------------------------------------------------------
357 -- Tabled jump to local label
358 --
359 -- The syntax is from [1], section 6.5
360 --
361 -- switch [0 .. n] (expr) { case ... ; }
362 --
363 genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
364 genSwitch expr maybe_ids
365
366 = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
367
368 in hang (hcat [ ptext (sLit "switch [0 .. ")
369 , int (length maybe_ids - 1)
370 , ptext (sLit "] ")
371 , if isTrivialCmmExpr expr
372 then pprExpr expr
373 else parens (pprExpr expr)
374 , ptext (sLit " {")
375 ])
376 4 (vcat ( map caseify pairs )) $$ rbrace
377
378 where
379 snds a b = (snd a) == (snd b)
380
381 caseify :: [(Int,Maybe BlockId)] -> SDoc
382 caseify ixs@((_,Nothing):_)
383 = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
384 <> ptext (sLit " */")
385 caseify as
386 = let (is,ids) = unzip as
387 in hsep [ ptext (sLit "case")
388 , hcat (punctuate comma (map int is))
389 , ptext (sLit ": goto")
390 , ppr (head [ id | Just id <- ids]) <> semi ]
391
392 -- --------------------------------------------------------------------------
393 -- Expressions
394 --
395
396 pprExpr :: CmmExpr -> SDoc
397 pprExpr e
398 = case e of
399 CmmRegOff reg i ->
400 pprExpr (CmmMachOp (MO_Add rep)
401 [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
402 where rep = typeWidth (cmmRegType reg)
403 CmmLit lit -> pprLit lit
404 _other -> pprExpr1 e
405
406 -- Here's the precedence table from CmmParse.y:
407 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
408 -- %left '|'
409 -- %left '^'
410 -- %left '&'
411 -- %left '>>' '<<'
412 -- %left '-' '+'
413 -- %left '/' '*' '%'
414 -- %right '~'
415
416 -- We just cope with the common operators for now, the rest will get
417 -- a default conservative behaviour.
418
419 -- %nonassoc '>=' '>' '<=' '<' '!=' '=='
420 pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc
421 pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
422 = pprExpr7 x <+> doc <+> pprExpr7 y
423 pprExpr1 e = pprExpr7 e
424
425 infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc
426
427 infixMachOp1 (MO_Eq _) = Just (ptext (sLit "=="))
428 infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!="))
429 infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<"))
430 infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>"))
431 infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">="))
432 infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<="))
433 infixMachOp1 (MO_U_Gt _) = Just (char '>')
434 infixMachOp1 (MO_U_Lt _) = Just (char '<')
435 infixMachOp1 _ = Nothing
436
437 -- %left '-' '+'
438 pprExpr7 (CmmMachOp (MO_Add rep1) [x, CmmLit (CmmInt i rep2)]) | i < 0
439 = pprExpr7 (CmmMachOp (MO_Sub rep1) [x, CmmLit (CmmInt (negate i) rep2)])
440 pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
441 = pprExpr7 x <+> doc <+> pprExpr8 y
442 pprExpr7 e = pprExpr8 e
443
444 infixMachOp7 (MO_Add _) = Just (char '+')
445 infixMachOp7 (MO_Sub _) = Just (char '-')
446 infixMachOp7 _ = Nothing
447
448 -- %left '/' '*' '%'
449 pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
450 = pprExpr8 x <+> doc <+> pprExpr9 y
451 pprExpr8 e = pprExpr9 e
452
453 infixMachOp8 (MO_U_Quot _) = Just (char '/')
454 infixMachOp8 (MO_Mul _) = Just (char '*')
455 infixMachOp8 (MO_U_Rem _) = Just (char '%')
456 infixMachOp8 _ = Nothing
457
458 pprExpr9 :: CmmExpr -> SDoc
459 pprExpr9 e =
460 case e of
461 CmmLit lit -> pprLit1 lit
462 CmmLoad expr rep -> ppr rep <> brackets( ppr expr )
463 CmmReg reg -> ppr reg
464 CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off)
465 CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off)
466 CmmMachOp mop args -> genMachOp mop args
467
468 genMachOp :: MachOp -> [CmmExpr] -> SDoc
469 genMachOp mop args
470 | Just doc <- infixMachOp mop = case args of
471 -- dyadic
472 [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
473
474 -- unary
475 [x] -> doc <> pprExpr9 x
476
477 _ -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
478 (pprMachOp mop <+>
479 parens (hcat $ punctuate comma (map pprExpr args)))
480 empty
481
482 | isJust (infixMachOp1 mop)
483 || isJust (infixMachOp7 mop)
484 || isJust (infixMachOp8 mop) = parens (pprExpr (CmmMachOp mop args))
485
486 | otherwise = char '%' <> ppr_op <> parens (commafy (map pprExpr args))
487 where ppr_op = text (map (\c -> if c == ' ' then '_' else c)
488 (show mop))
489 -- replace spaces in (show mop) with underscores,
490
491 --
492 -- Unsigned ops on the word size of the machine get nice symbols.
493 -- All else get dumped in their ugly format.
494 --
495 infixMachOp :: MachOp -> Maybe SDoc
496 infixMachOp mop
497 = case mop of
498 MO_And _ -> Just $ char '&'
499 MO_Or _ -> Just $ char '|'
500 MO_Xor _ -> Just $ char '^'
501 MO_Not _ -> Just $ char '~'
502 MO_S_Neg _ -> Just $ char '-' -- there is no unsigned neg :)
503 _ -> Nothing
504
505 -- --------------------------------------------------------------------------
506 -- Literals.
507 -- To minimise line noise we adopt the convention that if the literal
508 -- has the natural machine word size, we do not append the type
509 --
510 pprLit :: CmmLit -> SDoc
511 pprLit lit = case lit of
512 CmmInt i rep ->
513 hcat [ (if i < 0 then parens else id)(integer i)
514 , ppUnless (rep == wordWidth) $
515 space <> dcolon <+> ppr rep ]
516
517 CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ]
518 CmmLabel clbl -> pprCLabel clbl
519 CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
520 CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'
521 <> pprCLabel clbl2 <> ppr_offset i
522 CmmBlock id -> ppr id
523 CmmHighStackMark -> text "<highSp>"
524
525 pprLit1 :: CmmLit -> SDoc
526 pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit)
527 pprLit1 lit = pprLit lit
528
529 ppr_offset :: Int -> SDoc
530 ppr_offset i
531 | i==0 = empty
532 | i>=0 = char '+' <> int i
533 | otherwise = char '-' <> int (-i)
534
535 -- --------------------------------------------------------------------------
536 -- Static data.
537 -- Strings are printed as C strings, and we print them as I8[],
538 -- following C--
539 --
540 pprStatic :: CmmStatic -> SDoc
541 pprStatic s = case s of
542 CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi
543 CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
544 CmmAlign i -> nest 4 $ text "align" <+> int i
545 CmmDataLabel clbl -> pprCLabel clbl <> colon
546 CmmString s' -> nest 4 $ text "I8[]" <+> text (show s')
547
548 -- --------------------------------------------------------------------------
549 -- Registers, whether local (temps) or global
550 --
551 pprReg :: CmmReg -> SDoc
552 pprReg r
553 = case r of
554 CmmLocal local -> pprLocalReg local
555 CmmGlobal global -> pprGlobalReg global
556
557 --
558 -- We only print the type of the local reg if it isn't wordRep
559 --
560 pprLocalReg :: LocalReg -> SDoc
561 pprLocalReg (LocalReg uniq rep)
562 -- = ppr rep <> char '_' <> ppr uniq
563 -- Temp Jan08
564 = char '_' <> ppr uniq <>
565 (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh
566 then dcolon <> ptr <> ppr rep
567 else dcolon <> ptr <> ppr rep)
568 where
569 ptr = empty
570 --if isGcPtrType rep
571 -- then doubleQuotes (text "ptr")
572 -- else empty
573
574 -- Stack areas
575 pprArea :: Area -> SDoc
576 pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ]
577 pprArea (CallArea id) = pprAreaId id
578
579 pprAreaId :: AreaId -> SDoc
580 pprAreaId Old = text "old"
581 pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ]
582
583 -- needs to be kept in syn with Cmm.hs.GlobalReg
584 --
585 pprGlobalReg :: GlobalReg -> SDoc
586 pprGlobalReg gr
587 = case gr of
588 VanillaReg n _ -> char 'R' <> int n
589 -- Temp Jan08
590 -- VanillaReg n VNonGcPtr -> char 'R' <> int n
591 -- VanillaReg n VGcPtr -> char 'P' <> int n
592 FloatReg n -> char 'F' <> int n
593 DoubleReg n -> char 'D' <> int n
594 LongReg n -> char 'L' <> int n
595 Sp -> ptext (sLit "Sp")
596 SpLim -> ptext (sLit "SpLim")
597 Hp -> ptext (sLit "Hp")
598 HpLim -> ptext (sLit "HpLim")
599 CurrentTSO -> ptext (sLit "CurrentTSO")
600 CurrentNursery -> ptext (sLit "CurrentNursery")
601 HpAlloc -> ptext (sLit "HpAlloc")
602 EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info")
603 GCEnter1 -> ptext (sLit "stg_gc_enter_1")
604 GCFun -> ptext (sLit "stg_gc_fun")
605 BaseReg -> ptext (sLit "BaseReg")
606 PicBaseReg -> ptext (sLit "PicBaseReg")
607
608 -- --------------------------------------------------------------------------
609 -- data sections
610 --
611 pprSection :: Section -> SDoc
612 pprSection s = case s of
613 Text -> section <+> doubleQuotes (ptext (sLit "text"))
614 Data -> section <+> doubleQuotes (ptext (sLit "data"))
615 ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly"))
616 ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16"))
617 RelocatableReadOnlyData
618 -> section <+> doubleQuotes (ptext (sLit "relreadonly"))
619 UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised"))
620 OtherSection s' -> section <+> doubleQuotes (text s')
621 where
622 section = ptext (sLit "section")
623
624 -----------------------------------------------------------------------------
625
626 commafy :: [SDoc] -> SDoc
627 commafy xs = fsep $ punctuate comma xs