testsuite: Add testcase for #17206
[ghc.git] / compiler / nativeGen / SPARC / Ppr.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Pretty-printing assembly language
6 --
7 -- (c) The University of Glasgow 1993-2005
8 --
9 -----------------------------------------------------------------------------
10
11 {-# OPTIONS_GHC -fno-warn-orphans #-}
12
13 module SPARC.Ppr (
14 pprNatCmmDecl,
15 pprBasicBlock,
16 pprData,
17 pprInstr,
18 pprFormat,
19 pprImm,
20 pprDataItem
21 )
22
23 where
24
25 #include "HsVersions.h"
26
27 import GhcPrelude
28
29 import SPARC.Regs
30 import SPARC.Instr
31 import SPARC.Cond
32 import SPARC.Imm
33 import SPARC.AddrMode
34 import SPARC.Base
35 import Instruction
36 import Reg
37 import Format
38 import PprBase
39
40 import Cmm hiding (topInfoTable)
41 import PprCmm() -- For Outputable instances
42 import BlockId
43 import CLabel
44 import Hoopl.Label
45 import Hoopl.Collections
46
47 import Unique ( pprUniqueAlways )
48 import Outputable
49 import GHC.Platform
50 import FastString
51
52 -- -----------------------------------------------------------------------------
53 -- Printing this stuff out
54
55 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
56 pprNatCmmDecl (CmmData section dats) =
57 pprSectionAlign section $$ pprDatas dats
58
59 pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
60 case topInfoTable proc of
61 Nothing ->
62 -- special case for code without info table:
63 pprSectionAlign (Section Text lbl) $$
64 pprLabel lbl $$ -- blocks guaranteed not null, so label needed
65 vcat (map (pprBasicBlock top_info) blocks)
66
67 Just (Statics info_lbl _) ->
68 sdocWithPlatform $ \platform ->
69 (if platformHasSubsectionsViaSymbols platform
70 then pprSectionAlign dspSection $$
71 ppr (mkDeadStripPreventer info_lbl) <> char ':'
72 else empty) $$
73 vcat (map (pprBasicBlock top_info) blocks) $$
74 -- above: Even the first block gets a label, because with branch-chain
75 -- elimination, it might be the target of a goto.
76 (if platformHasSubsectionsViaSymbols platform
77 then
78 -- See Note [Subsections Via Symbols] in X86/Ppr.hs
79 text "\t.long "
80 <+> ppr info_lbl
81 <+> char '-'
82 <+> ppr (mkDeadStripPreventer info_lbl)
83 else empty)
84
85 dspSection :: Section
86 dspSection = Section Text $
87 panic "subsections-via-symbols doesn't combine with split-sections"
88
89 pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
90 pprBasicBlock info_env (BasicBlock blockid instrs)
91 = maybe_infotable $$
92 pprLabel (blockLbl blockid) $$
93 vcat (map pprInstr instrs)
94 where
95 maybe_infotable = case mapLookup blockid info_env of
96 Nothing -> empty
97 Just (Statics info_lbl info) ->
98 pprAlignForSection Text $$
99 vcat (map pprData info) $$
100 pprLabel info_lbl
101
102
103 pprDatas :: CmmStatics -> SDoc
104 -- See note [emit-time elimination of static indirections] in CLabel.
105 pprDatas (Statics alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
106 | lbl == mkIndStaticInfoLabel
107 , let labelInd (CmmLabelOff l _) = Just l
108 labelInd (CmmLabel l) = Just l
109 labelInd _ = Nothing
110 , Just ind' <- labelInd ind
111 , alias `mayRedirectTo` ind'
112 = pprGloblDecl alias
113 $$ text ".equiv" <+> ppr alias <> comma <> ppr (CmmLabel ind')
114 pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
115
116 pprData :: CmmStatic -> SDoc
117 pprData (CmmString str) = pprBytes str
118 pprData (CmmUninitialised bytes) = text ".skip " <> int bytes
119 pprData (CmmStaticLit lit) = pprDataItem lit
120
121 pprGloblDecl :: CLabel -> SDoc
122 pprGloblDecl lbl
123 | not (externallyVisibleCLabel lbl) = empty
124 | otherwise = text ".global " <> ppr lbl
125
126 pprTypeAndSizeDecl :: CLabel -> SDoc
127 pprTypeAndSizeDecl lbl
128 = sdocWithPlatform $ \platform ->
129 if platformOS platform == OSLinux && externallyVisibleCLabel lbl
130 then text ".type " <> ppr lbl <> ptext (sLit ", @object")
131 else empty
132
133 pprLabel :: CLabel -> SDoc
134 pprLabel lbl = pprGloblDecl lbl
135 $$ pprTypeAndSizeDecl lbl
136 $$ (ppr lbl <> char ':')
137
138 -- -----------------------------------------------------------------------------
139 -- pprInstr: print an 'Instr'
140
141 instance Outputable Instr where
142 ppr instr = pprInstr instr
143
144
145 -- | Pretty print a register.
146 pprReg :: Reg -> SDoc
147 pprReg reg
148 = case reg of
149 RegVirtual vr
150 -> case vr of
151 VirtualRegI u -> text "%vI_" <> pprUniqueAlways u
152 VirtualRegHi u -> text "%vHi_" <> pprUniqueAlways u
153 VirtualRegF u -> text "%vF_" <> pprUniqueAlways u
154 VirtualRegD u -> text "%vD_" <> pprUniqueAlways u
155
156
157 RegReal rr
158 -> case rr of
159 RealRegSingle r1
160 -> pprReg_ofRegNo r1
161
162 RealRegPair r1 r2
163 -> text "(" <> pprReg_ofRegNo r1
164 <> vbar <> pprReg_ofRegNo r2
165 <> text ")"
166
167
168
169 -- | Pretty print a register name, based on this register number.
170 -- The definition has been unfolded so we get a jump-table in the
171 -- object code. This function is called quite a lot when emitting
172 -- the asm file..
173 --
174 pprReg_ofRegNo :: Int -> SDoc
175 pprReg_ofRegNo i
176 = ptext
177 (case i of {
178 0 -> sLit "%g0"; 1 -> sLit "%g1";
179 2 -> sLit "%g2"; 3 -> sLit "%g3";
180 4 -> sLit "%g4"; 5 -> sLit "%g5";
181 6 -> sLit "%g6"; 7 -> sLit "%g7";
182 8 -> sLit "%o0"; 9 -> sLit "%o1";
183 10 -> sLit "%o2"; 11 -> sLit "%o3";
184 12 -> sLit "%o4"; 13 -> sLit "%o5";
185 14 -> sLit "%o6"; 15 -> sLit "%o7";
186 16 -> sLit "%l0"; 17 -> sLit "%l1";
187 18 -> sLit "%l2"; 19 -> sLit "%l3";
188 20 -> sLit "%l4"; 21 -> sLit "%l5";
189 22 -> sLit "%l6"; 23 -> sLit "%l7";
190 24 -> sLit "%i0"; 25 -> sLit "%i1";
191 26 -> sLit "%i2"; 27 -> sLit "%i3";
192 28 -> sLit "%i4"; 29 -> sLit "%i5";
193 30 -> sLit "%i6"; 31 -> sLit "%i7";
194 32 -> sLit "%f0"; 33 -> sLit "%f1";
195 34 -> sLit "%f2"; 35 -> sLit "%f3";
196 36 -> sLit "%f4"; 37 -> sLit "%f5";
197 38 -> sLit "%f6"; 39 -> sLit "%f7";
198 40 -> sLit "%f8"; 41 -> sLit "%f9";
199 42 -> sLit "%f10"; 43 -> sLit "%f11";
200 44 -> sLit "%f12"; 45 -> sLit "%f13";
201 46 -> sLit "%f14"; 47 -> sLit "%f15";
202 48 -> sLit "%f16"; 49 -> sLit "%f17";
203 50 -> sLit "%f18"; 51 -> sLit "%f19";
204 52 -> sLit "%f20"; 53 -> sLit "%f21";
205 54 -> sLit "%f22"; 55 -> sLit "%f23";
206 56 -> sLit "%f24"; 57 -> sLit "%f25";
207 58 -> sLit "%f26"; 59 -> sLit "%f27";
208 60 -> sLit "%f28"; 61 -> sLit "%f29";
209 62 -> sLit "%f30"; 63 -> sLit "%f31";
210 _ -> sLit "very naughty sparc register" })
211
212
213 -- | Pretty print a format for an instruction suffix.
214 pprFormat :: Format -> SDoc
215 pprFormat x
216 = ptext
217 (case x of
218 II8 -> sLit "ub"
219 II16 -> sLit "uh"
220 II32 -> sLit ""
221 II64 -> sLit "d"
222 FF32 -> sLit ""
223 FF64 -> sLit "d")
224
225
226 -- | Pretty print a format for an instruction suffix.
227 -- eg LD is 32bit on sparc, but LDD is 64 bit.
228 pprStFormat :: Format -> SDoc
229 pprStFormat x
230 = ptext
231 (case x of
232 II8 -> sLit "b"
233 II16 -> sLit "h"
234 II32 -> sLit ""
235 II64 -> sLit "x"
236 FF32 -> sLit ""
237 FF64 -> sLit "d")
238
239
240
241 -- | Pretty print a condition code.
242 pprCond :: Cond -> SDoc
243 pprCond c
244 = ptext
245 (case c of
246 ALWAYS -> sLit ""
247 NEVER -> sLit "n"
248 GEU -> sLit "geu"
249 LU -> sLit "lu"
250 EQQ -> sLit "e"
251 GTT -> sLit "g"
252 GE -> sLit "ge"
253 GU -> sLit "gu"
254 LTT -> sLit "l"
255 LE -> sLit "le"
256 LEU -> sLit "leu"
257 NE -> sLit "ne"
258 NEG -> sLit "neg"
259 POS -> sLit "pos"
260 VC -> sLit "vc"
261 VS -> sLit "vs")
262
263
264 -- | Pretty print an address mode.
265 pprAddr :: AddrMode -> SDoc
266 pprAddr am
267 = case am of
268 AddrRegReg r1 (RegReal (RealRegSingle 0))
269 -> pprReg r1
270
271 AddrRegReg r1 r2
272 -> hcat [ pprReg r1, char '+', pprReg r2 ]
273
274 AddrRegImm r1 (ImmInt i)
275 | i == 0 -> pprReg r1
276 | not (fits13Bits i) -> largeOffsetError i
277 | otherwise -> hcat [ pprReg r1, pp_sign, int i ]
278 where
279 pp_sign = if i > 0 then char '+' else empty
280
281 AddrRegImm r1 (ImmInteger i)
282 | i == 0 -> pprReg r1
283 | not (fits13Bits i) -> largeOffsetError i
284 | otherwise -> hcat [ pprReg r1, pp_sign, integer i ]
285 where
286 pp_sign = if i > 0 then char '+' else empty
287
288 AddrRegImm r1 imm
289 -> hcat [ pprReg r1, char '+', pprImm imm ]
290
291
292 -- | Pretty print an immediate value.
293 pprImm :: Imm -> SDoc
294 pprImm imm
295 = case imm of
296 ImmInt i -> int i
297 ImmInteger i -> integer i
298 ImmCLbl l -> ppr l
299 ImmIndex l i -> ppr l <> char '+' <> int i
300 ImmLit s -> s
301
302 ImmConstantSum a b
303 -> pprImm a <> char '+' <> pprImm b
304
305 ImmConstantDiff a b
306 -> pprImm a <> char '-' <> lparen <> pprImm b <> rparen
307
308 LO i
309 -> hcat [ text "%lo(", pprImm i, rparen ]
310
311 HI i
312 -> hcat [ text "%hi(", pprImm i, rparen ]
313
314 -- these should have been converted to bytes and placed
315 -- in the data section.
316 ImmFloat _ -> text "naughty float immediate"
317 ImmDouble _ -> text "naughty double immediate"
318
319
320 -- | Pretty print a section \/ segment header.
321 -- On SPARC all the data sections must be at least 8 byte aligned
322 -- incase we store doubles in them.
323 --
324 pprSectionAlign :: Section -> SDoc
325 pprSectionAlign sec@(Section seg _) =
326 sdocWithPlatform $ \platform ->
327 pprSectionHeader platform sec $$
328 pprAlignForSection seg
329
330 -- | Print appropriate alignment for the given section type.
331 pprAlignForSection :: SectionType -> SDoc
332 pprAlignForSection seg =
333 ptext (case seg of
334 Text -> sLit ".align 4"
335 Data -> sLit ".align 8"
336 ReadOnlyData -> sLit ".align 8"
337 RelocatableReadOnlyData
338 -> sLit ".align 8"
339 UninitialisedData -> sLit ".align 8"
340 ReadOnlyData16 -> sLit ".align 16"
341 -- TODO: This is copied from the ReadOnlyData case, but it can likely be
342 -- made more efficient.
343 CString -> sLit ".align 8"
344 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section")
345
346 -- | Pretty print a data item.
347 pprDataItem :: CmmLit -> SDoc
348 pprDataItem lit
349 = sdocWithDynFlags $ \dflags ->
350 vcat (ppr_item (cmmTypeFormat $ cmmLitType dflags lit) lit)
351 where
352 imm = litToImm lit
353
354 ppr_item II8 _ = [text "\t.byte\t" <> pprImm imm]
355 ppr_item II32 _ = [text "\t.long\t" <> pprImm imm]
356
357 ppr_item FF32 (CmmFloat r _)
358 = let bs = floatToBytes (fromRational r)
359 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
360
361 ppr_item FF64 (CmmFloat r _)
362 = let bs = doubleToBytes (fromRational r)
363 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
364
365 ppr_item II16 _ = [text "\t.short\t" <> pprImm imm]
366 ppr_item II64 _ = [text "\t.quad\t" <> pprImm imm]
367 ppr_item _ _ = panic "SPARC.Ppr.pprDataItem: no match"
368
369
370 -- | Pretty print an instruction.
371 pprInstr :: Instr -> SDoc
372
373 -- nuke comments.
374 pprInstr (COMMENT _)
375 = empty
376
377 pprInstr (DELTA d)
378 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
379
380 -- Newblocks and LData should have been slurped out before producing the .s file.
381 pprInstr (NEWBLOCK _)
382 = panic "X86.Ppr.pprInstr: NEWBLOCK"
383
384 pprInstr (LDATA _ _)
385 = panic "PprMach.pprInstr: LDATA"
386
387 -- 64 bit FP loads are expanded into individual instructions in CodeGen.Expand
388 pprInstr (LD FF64 _ reg)
389 | RegReal (RealRegSingle{}) <- reg
390 = panic "SPARC.Ppr: not emitting potentially misaligned LD FF64 instr"
391
392 pprInstr (LD format addr reg)
393 = hcat [
394 text "\tld",
395 pprFormat format,
396 char '\t',
397 lbrack,
398 pprAddr addr,
399 pp_rbracket_comma,
400 pprReg reg
401 ]
402
403 -- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand
404 pprInstr (ST FF64 reg _)
405 | RegReal (RealRegSingle{}) <- reg
406 = panic "SPARC.Ppr: not emitting potentially misaligned ST FF64 instr"
407
408 -- no distinction is made between signed and unsigned bytes on stores for the
409 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
410 -- so we call a special-purpose pprFormat for ST..
411 pprInstr (ST format reg addr)
412 = hcat [
413 text "\tst",
414 pprStFormat format,
415 char '\t',
416 pprReg reg,
417 pp_comma_lbracket,
418 pprAddr addr,
419 rbrack
420 ]
421
422
423 pprInstr (ADD x cc reg1 ri reg2)
424 | not x && not cc && riZero ri
425 = hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
426
427 | otherwise
428 = pprRegRIReg (if x then sLit "addx" else sLit "add") cc reg1 ri reg2
429
430
431 pprInstr (SUB x cc reg1 ri reg2)
432 | not x && cc && reg2 == g0
433 = hcat [ text "\tcmp\t", pprReg reg1, comma, pprRI ri ]
434
435 | not x && not cc && riZero ri
436 = hcat [ text "\tmov\t", pprReg reg1, comma, pprReg reg2 ]
437
438 | otherwise
439 = pprRegRIReg (if x then sLit "subx" else sLit "sub") cc reg1 ri reg2
440
441 pprInstr (AND b reg1 ri reg2) = pprRegRIReg (sLit "and") b reg1 ri reg2
442
443 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg (sLit "andn") b reg1 ri reg2
444
445 pprInstr (OR b reg1 ri reg2)
446 | not b && reg1 == g0
447 = let doit = hcat [ text "\tmov\t", pprRI ri, comma, pprReg reg2 ]
448 in case ri of
449 RIReg rrr | rrr == reg2 -> empty
450 _ -> doit
451
452 | otherwise
453 = pprRegRIReg (sLit "or") b reg1 ri reg2
454
455 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg (sLit "orn") b reg1 ri reg2
456
457 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg (sLit "xor") b reg1 ri reg2
458 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg (sLit "xnor") b reg1 ri reg2
459
460 pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") False reg1 ri reg2
461 pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") False reg1 ri reg2
462 pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") False reg1 ri reg2
463
464 pprInstr (RDY rd) = text "\trd\t%y," <> pprReg rd
465 pprInstr (WRY reg1 reg2)
466 = text "\twr\t"
467 <> pprReg reg1
468 <> char ','
469 <> pprReg reg2
470 <> char ','
471 <> text "%y"
472
473 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg (sLit "smul") b reg1 ri reg2
474 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg (sLit "umul") b reg1 ri reg2
475 pprInstr (SDIV b reg1 ri reg2) = pprRegRIReg (sLit "sdiv") b reg1 ri reg2
476 pprInstr (UDIV b reg1 ri reg2) = pprRegRIReg (sLit "udiv") b reg1 ri reg2
477
478 pprInstr (SETHI imm reg)
479 = hcat [
480 text "\tsethi\t",
481 pprImm imm,
482 comma,
483 pprReg reg
484 ]
485
486 pprInstr NOP
487 = text "\tnop"
488
489 pprInstr (FABS format reg1 reg2)
490 = pprFormatRegReg (sLit "fabs") format reg1 reg2
491
492 pprInstr (FADD format reg1 reg2 reg3)
493 = pprFormatRegRegReg (sLit "fadd") format reg1 reg2 reg3
494
495 pprInstr (FCMP e format reg1 reg2)
496 = pprFormatRegReg (if e then sLit "fcmpe" else sLit "fcmp")
497 format reg1 reg2
498
499 pprInstr (FDIV format reg1 reg2 reg3)
500 = pprFormatRegRegReg (sLit "fdiv") format reg1 reg2 reg3
501
502 pprInstr (FMOV format reg1 reg2)
503 = pprFormatRegReg (sLit "fmov") format reg1 reg2
504
505 pprInstr (FMUL format reg1 reg2 reg3)
506 = pprFormatRegRegReg (sLit "fmul") format reg1 reg2 reg3
507
508 pprInstr (FNEG format reg1 reg2)
509 = pprFormatRegReg (sLit "fneg") format reg1 reg2
510
511 pprInstr (FSQRT format reg1 reg2)
512 = pprFormatRegReg (sLit "fsqrt") format reg1 reg2
513
514 pprInstr (FSUB format reg1 reg2 reg3)
515 = pprFormatRegRegReg (sLit "fsub") format reg1 reg2 reg3
516
517 pprInstr (FxTOy format1 format2 reg1 reg2)
518 = hcat [
519 text "\tf",
520 ptext
521 (case format1 of
522 II32 -> sLit "ito"
523 FF32 -> sLit "sto"
524 FF64 -> sLit "dto"
525 _ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
526 ptext
527 (case format2 of
528 II32 -> sLit "i\t"
529 II64 -> sLit "x\t"
530 FF32 -> sLit "s\t"
531 FF64 -> sLit "d\t"
532 _ -> panic "SPARC.Ppr.pprInstr.FxToY: no match"),
533 pprReg reg1, comma, pprReg reg2
534 ]
535
536
537 pprInstr (BI cond b blockid)
538 = hcat [
539 text "\tb", pprCond cond,
540 if b then pp_comma_a else empty,
541 char '\t',
542 ppr (blockLbl blockid)
543 ]
544
545 pprInstr (BF cond b blockid)
546 = hcat [
547 text "\tfb", pprCond cond,
548 if b then pp_comma_a else empty,
549 char '\t',
550 ppr (blockLbl blockid)
551 ]
552
553 pprInstr (JMP addr) = text "\tjmp\t" <> pprAddr addr
554 pprInstr (JMP_TBL op _ _) = pprInstr (JMP op)
555
556 pprInstr (CALL (Left imm) n _)
557 = hcat [ text "\tcall\t", pprImm imm, comma, int n ]
558
559 pprInstr (CALL (Right reg) n _)
560 = hcat [ text "\tcall\t", pprReg reg, comma, int n ]
561
562
563 -- | Pretty print a RI
564 pprRI :: RI -> SDoc
565 pprRI (RIReg r) = pprReg r
566 pprRI (RIImm r) = pprImm r
567
568
569 -- | Pretty print a two reg instruction.
570 pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
571 pprFormatRegReg name format reg1 reg2
572 = hcat [
573 char '\t',
574 ptext name,
575 (case format of
576 FF32 -> text "s\t"
577 FF64 -> text "d\t"
578 _ -> panic "SPARC.Ppr.pprFormatRegReg: no match"),
579
580 pprReg reg1,
581 comma,
582 pprReg reg2
583 ]
584
585
586 -- | Pretty print a three reg instruction.
587 pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
588 pprFormatRegRegReg name format reg1 reg2 reg3
589 = hcat [
590 char '\t',
591 ptext name,
592 (case format of
593 FF32 -> text "s\t"
594 FF64 -> text "d\t"
595 _ -> panic "SPARC.Ppr.pprFormatRegReg: no match"),
596 pprReg reg1,
597 comma,
598 pprReg reg2,
599 comma,
600 pprReg reg3
601 ]
602
603
604 -- | Pretty print an instruction of two regs and a ri.
605 pprRegRIReg :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
606 pprRegRIReg name b reg1 ri reg2
607 = hcat [
608 char '\t',
609 ptext name,
610 if b then text "cc\t" else char '\t',
611 pprReg reg1,
612 comma,
613 pprRI ri,
614 comma,
615 pprReg reg2
616 ]
617
618 {-
619 pprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc
620 pprRIReg name b ri reg1
621 = hcat [
622 char '\t',
623 ptext name,
624 if b then text "cc\t" else char '\t',
625 pprRI ri,
626 comma,
627 pprReg reg1
628 ]
629 -}
630
631 {-
632 pp_ld_lbracket :: SDoc
633 pp_ld_lbracket = text "\tld\t["
634 -}
635
636 pp_rbracket_comma :: SDoc
637 pp_rbracket_comma = text "],"
638
639
640 pp_comma_lbracket :: SDoc
641 pp_comma_lbracket = text ",["
642
643
644 pp_comma_a :: SDoc
645 pp_comma_a = text ",a"