[project @ 1997-03-14 07:52:06 by simonpj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / PprMach.lhs
1 %
2 % (c) The AQUA Project, Glasgow University, 1996
3 %
4 \section[PprMach]{Pretty-printing assembly language}
5
6 We start with the @pprXXX@s with some cross-platform commonality
7 (e.g., @pprReg@); we conclude with the no-commonality monster,
8 @pprInstr@.
9
10 \begin{code}
11 #include "HsVersions.h"
12 #include "nativeGen/NCG.h"
13
14 module PprMach ( pprInstr ) where
15
16 IMP_Ubiq(){-uitious-}
17 IMPORT_1_3(Char(isPrint,isDigit))
18 IMPORT_1_3(qualified GHCbase(Addr(..))) -- to see innards
19
20 import MachRegs         -- may differ per-platform
21 import MachMisc
22
23 import AbsCSyn          ( MagicId )
24 import CLabel           ( pprCLabel_asm, externallyVisibleCLabel )
25 import CStrings         ( charToC )
26 import Maybes           ( maybeToBool )
27 import OrdList          ( OrdList )
28 import Stix             ( CodeSegment(..), StixTree )
29 import Unpretty         -- all of it
30
31 #if __GLASGOW_HASKELL__ >= 200
32 a_HASH   x = GHCbase.A# x
33 pACK_STR x = packCString x
34 #else
35 a_HASH   x = A# x
36 pACK_STR x = mkFastCharString x --_packCString x
37 #endif
38 \end{code}
39
40 %************************************************************************
41 %*                                                                      *
42 \subsection{@pprReg@: print a @Reg@}
43 %*                                                                      *
44 %************************************************************************
45
46 For x86, the way we print a register name depends
47 on which bit of it we care about.  Yurgh.
48 \begin{code}
49 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Unpretty
50
51 pprReg IF_ARCH_i386(s,) r
52   = case r of
53       FixedReg  i -> ppr_reg_no IF_ARCH_i386(s,) i
54       MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
55       other       -> uppStr (show other)   -- should only happen when debugging
56   where
57 #if alpha_TARGET_ARCH
58     ppr_reg_no :: FAST_REG_NO -> Unpretty
59     ppr_reg_no i = uppPStr
60       (case i of {
61         ILIT( 0) -> SLIT("$0");   ILIT( 1) -> SLIT("$1");
62         ILIT( 2) -> SLIT("$2");   ILIT( 3) -> SLIT("$3");
63         ILIT( 4) -> SLIT("$4");   ILIT( 5) -> SLIT("$5");
64         ILIT( 6) -> SLIT("$6");   ILIT( 7) -> SLIT("$7");
65         ILIT( 8) -> SLIT("$8");   ILIT( 9) -> SLIT("$9");
66         ILIT(10) -> SLIT("$10");  ILIT(11) -> SLIT("$11");
67         ILIT(12) -> SLIT("$12");  ILIT(13) -> SLIT("$13");
68         ILIT(14) -> SLIT("$14");  ILIT(15) -> SLIT("$15");
69         ILIT(16) -> SLIT("$16");  ILIT(17) -> SLIT("$17");
70         ILIT(18) -> SLIT("$18");  ILIT(19) -> SLIT("$19");
71         ILIT(20) -> SLIT("$20");  ILIT(21) -> SLIT("$21");
72         ILIT(22) -> SLIT("$22");  ILIT(23) -> SLIT("$23");
73         ILIT(24) -> SLIT("$24");  ILIT(25) -> SLIT("$25");
74         ILIT(26) -> SLIT("$26");  ILIT(27) -> SLIT("$27");
75         ILIT(28) -> SLIT("$28");  ILIT(29) -> SLIT("$29");
76         ILIT(30) -> SLIT("$30");  ILIT(31) -> SLIT("$31");
77         ILIT(32) -> SLIT("$f0");  ILIT(33) -> SLIT("$f1");
78         ILIT(34) -> SLIT("$f2");  ILIT(35) -> SLIT("$f3");
79         ILIT(36) -> SLIT("$f4");  ILIT(37) -> SLIT("$f5");
80         ILIT(38) -> SLIT("$f6");  ILIT(39) -> SLIT("$f7");
81         ILIT(40) -> SLIT("$f8");  ILIT(41) -> SLIT("$f9");
82         ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
83         ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
84         ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
85         ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
86         ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
87         ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
88         ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
89         ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
90         ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
91         ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
92         ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
93         _ -> SLIT("very naughty alpha register")
94       })
95 #endif
96 #if i386_TARGET_ARCH
97     ppr_reg_no :: Size -> FAST_REG_NO -> Unpretty
98     ppr_reg_no B i = uppPStr
99       (case i of {
100         ILIT( 0) -> SLIT("%al");  ILIT( 1) -> SLIT("%bl");
101         ILIT( 2) -> SLIT("%cl");  ILIT( 3) -> SLIT("%dl");
102         _ -> SLIT("very naughty I386 byte register")
103       })
104
105     {- UNUSED:
106     ppr_reg_no HB i = uppPStr
107       (case i of {
108         ILIT( 0) -> SLIT("%ah");  ILIT( 1) -> SLIT("%bh");
109         ILIT( 2) -> SLIT("%ch");  ILIT( 3) -> SLIT("%dh");
110         _ -> SLIT("very naughty I386 high byte register")
111       })
112     -}
113
114 {- UNUSED:
115     ppr_reg_no S i = uppPStr
116       (case i of {
117         ILIT( 0) -> SLIT("%ax");  ILIT( 1) -> SLIT("%bx");
118         ILIT( 2) -> SLIT("%cx");  ILIT( 3) -> SLIT("%dx");
119         ILIT( 4) -> SLIT("%si");  ILIT( 5) -> SLIT("%di");
120         ILIT( 6) -> SLIT("%bp");  ILIT( 7) -> SLIT("%sp");
121         _ -> SLIT("very naughty I386 word register")
122       })
123 -}
124
125     ppr_reg_no L i = uppPStr
126       (case i of {
127         ILIT( 0) -> SLIT("%eax");  ILIT( 1) -> SLIT("%ebx");
128         ILIT( 2) -> SLIT("%ecx");  ILIT( 3) -> SLIT("%edx");
129         ILIT( 4) -> SLIT("%esi");  ILIT( 5) -> SLIT("%edi");
130         ILIT( 6) -> SLIT("%ebp");  ILIT( 7) -> SLIT("%esp");
131         _ -> SLIT("very naughty I386 double word register")
132       })
133
134     ppr_reg_no F i = uppPStr
135       (case i of {
136         --ToDo: rm these (???)
137         ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
138         ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
139         ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
140         ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
141         _ -> SLIT("very naughty I386 float register")
142       })
143
144     ppr_reg_no DF i = uppPStr
145       (case i of {
146         --ToDo: rm these (???)
147         ILIT( 8) -> SLIT("%st(0)");  ILIT( 9) -> SLIT("%st(1)");
148         ILIT(10) -> SLIT("%st(2)");  ILIT(11) -> SLIT("%st(3)");
149         ILIT(12) -> SLIT("%st(4)");  ILIT(13) -> SLIT("%st(5)");
150         ILIT(14) -> SLIT("%st(6)");  ILIT(15) -> SLIT("%st(7)");
151         _ -> SLIT("very naughty I386 float register")
152       })
153 #endif
154 #if sparc_TARGET_ARCH
155     ppr_reg_no :: FAST_REG_NO -> Unpretty
156     ppr_reg_no i = uppPStr
157       (case i of {
158         ILIT( 0) -> SLIT("%g0");  ILIT( 1) -> SLIT("%g1");
159         ILIT( 2) -> SLIT("%g2");  ILIT( 3) -> SLIT("%g3");
160         ILIT( 4) -> SLIT("%g4");  ILIT( 5) -> SLIT("%g5");
161         ILIT( 6) -> SLIT("%g6");  ILIT( 7) -> SLIT("%g7");
162         ILIT( 8) -> SLIT("%o0");  ILIT( 9) -> SLIT("%o1");
163         ILIT(10) -> SLIT("%o2");  ILIT(11) -> SLIT("%o3");
164         ILIT(12) -> SLIT("%o4");  ILIT(13) -> SLIT("%o5");
165         ILIT(14) -> SLIT("%o6");  ILIT(15) -> SLIT("%o7");
166         ILIT(16) -> SLIT("%l0");  ILIT(17) -> SLIT("%l1");
167         ILIT(18) -> SLIT("%l2");  ILIT(19) -> SLIT("%l3");
168         ILIT(20) -> SLIT("%l4");  ILIT(21) -> SLIT("%l5");
169         ILIT(22) -> SLIT("%l6");  ILIT(23) -> SLIT("%l7");
170         ILIT(24) -> SLIT("%i0");  ILIT(25) -> SLIT("%i1");
171         ILIT(26) -> SLIT("%i2");  ILIT(27) -> SLIT("%i3");
172         ILIT(28) -> SLIT("%i4");  ILIT(29) -> SLIT("%i5");
173         ILIT(30) -> SLIT("%i6");  ILIT(31) -> SLIT("%i7");
174         ILIT(32) -> SLIT("%f0");  ILIT(33) -> SLIT("%f1");
175         ILIT(34) -> SLIT("%f2");  ILIT(35) -> SLIT("%f3");
176         ILIT(36) -> SLIT("%f4");  ILIT(37) -> SLIT("%f5");
177         ILIT(38) -> SLIT("%f6");  ILIT(39) -> SLIT("%f7");
178         ILIT(40) -> SLIT("%f8");  ILIT(41) -> SLIT("%f9");
179         ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
180         ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
181         ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
182         ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
183         ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
184         ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
185         ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
186         ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
187         ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
188         ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
189         ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
190         _ -> SLIT("very naughty sparc register")
191       })
192 #endif
193 \end{code}
194
195 %************************************************************************
196 %*                                                                      *
197 \subsection{@pprSize@: print a @Size@}
198 %*                                                                      *
199 %************************************************************************
200
201 \begin{code}
202 pprSize :: Size -> Unpretty
203
204 pprSize x = uppPStr (case x of
205 #if alpha_TARGET_ARCH
206          B  -> SLIT("b")
207          BU -> SLIT("bu")
208 --       W  -> SLIT("w") UNUSED
209 --       WU -> SLIT("wu") UNUSED
210 --       L  -> SLIT("l") UNUSED
211          Q  -> SLIT("q")
212 --       FF -> SLIT("f") UNUSED
213 --       DF -> SLIT("d") UNUSED
214 --       GF -> SLIT("g") UNUSED
215 --       SF -> SLIT("s") UNUSED
216          TF -> SLIT("t")
217 #endif
218 #if i386_TARGET_ARCH
219         B  -> SLIT("b")
220 --      HB -> SLIT("b") UNUSED
221 --      S  -> SLIT("w") UNUSED
222         L  -> SLIT("l")
223         F  -> SLIT("s")
224         DF -> SLIT("l")
225 #endif
226 #if sparc_TARGET_ARCH
227         B   -> SLIT("sb")
228         BU  -> SLIT("ub")
229 --      HW  -> SLIT("hw") UNUSED
230 --      HWU -> SLIT("uhw") UNUSED
231         W   -> SLIT("")
232         F   -> SLIT("")
233 --      D   -> SLIT("d") UNUSED
234         DF  -> SLIT("d")
235 #endif
236     )
237 \end{code}
238
239 %************************************************************************
240 %*                                                                      *
241 \subsection{@pprCond@: print a @Cond@}
242 %*                                                                      *
243 %************************************************************************
244
245 \begin{code}
246 pprCond :: Cond -> Unpretty
247
248 pprCond c = uppPStr (case c of {
249 #if alpha_TARGET_ARCH
250         EQQ  -> SLIT("eq");
251         LTT  -> SLIT("lt");
252         LE  -> SLIT("le");
253         ULT -> SLIT("ult");
254         ULE -> SLIT("ule");
255         NE  -> SLIT("ne");
256         GTT  -> SLIT("gt");
257         GE  -> SLIT("ge")
258 #endif
259 #if i386_TARGET_ARCH
260         GEU     -> SLIT("ae");  LU    -> SLIT("b");
261         EQQ     -> SLIT("e");   GTT    -> SLIT("g");
262         GE      -> SLIT("ge");  GU    -> SLIT("a");
263         LTT     -> SLIT("l");   LE    -> SLIT("le");
264         LEU     -> SLIT("be");  NE    -> SLIT("ne");
265         NEG     -> SLIT("s");   POS   -> SLIT("ns");
266         ALWAYS  -> SLIT("mp")   -- hack
267 #endif
268 #if sparc_TARGET_ARCH
269         ALWAYS  -> SLIT("");    NEVER -> SLIT("n");
270         GEU     -> SLIT("geu"); LU    -> SLIT("lu");
271         EQQ     -> SLIT("e");   GTT   -> SLIT("g");
272         GE      -> SLIT("ge");  GU    -> SLIT("gu");
273         LTT     -> SLIT("l");   LE    -> SLIT("le");
274         LEU     -> SLIT("leu"); NE    -> SLIT("ne");
275         NEG     -> SLIT("neg"); POS   -> SLIT("pos");
276         VC      -> SLIT("vc");  VS    -> SLIT("vs")
277 #endif
278     })
279 \end{code}
280
281 %************************************************************************
282 %*                                                                      *
283 \subsection{@pprImm@: print an @Imm@}
284 %*                                                                      *
285 %************************************************************************
286
287 \begin{code}
288 pprImm :: Imm -> Unpretty
289
290 pprImm (ImmInt i)     = uppInt i
291 pprImm (ImmInteger i) = uppInteger i
292 pprImm (ImmCLbl l)    = pprCLabel_asm l
293 pprImm (ImmLit s)     = s
294
295 pprImm (ImmLab s) | underscorePrefix = uppBeside (uppChar '_') s
296                   | otherwise        = s
297
298 #if sparc_TARGET_ARCH
299 pprImm (LO i)
300   = uppBesides [ pp_lo, pprImm i, uppRparen ]
301   where
302     pp_lo = uppPStr (pACK_STR (a_HASH "%lo("#))
303
304 pprImm (HI i)
305   = uppBesides [ pp_hi, pprImm i, uppRparen ]
306   where
307     pp_hi = uppPStr (pACK_STR (a_HASH "%hi("#))
308 #endif
309 \end{code}
310
311 %************************************************************************
312 %*                                                                      *
313 \subsection{@pprAddr@: print an @Addr@}
314 %*                                                                      *
315 %************************************************************************
316
317 \begin{code}
318 pprAddr :: Addr -> Unpretty
319
320 #if alpha_TARGET_ARCH
321 pprAddr (AddrReg r) = uppParens (pprReg r)
322 pprAddr (AddrImm i) = pprImm i
323 pprAddr (AddrRegImm r1 i)
324   = uppBeside (pprImm i) (uppParens (pprReg r1))
325 #endif
326
327 -------------------
328
329 #if i386_TARGET_ARCH
330 pprAddr (ImmAddr imm off)
331   = let
332         pp_imm = pprImm imm
333     in
334     if (off == 0) then
335         pp_imm
336     else if (off < 0) then
337         uppBeside pp_imm (uppInt off)
338     else
339         uppBesides [pp_imm, uppChar '+', uppInt off]
340
341 pprAddr (Addr base index displacement)
342   = let
343         pp_disp  = ppr_disp displacement
344         pp_off p = uppBeside pp_disp (uppParens p)
345         pp_reg r = pprReg L r
346     in
347     case (base,index) of
348       (Nothing, Nothing)    -> pp_disp
349       (Just b,  Nothing)    -> pp_off (pp_reg b)
350       (Nothing, Just (r,i)) -> pp_off (uppBesides [pp_reg r, uppComma, uppInt i])
351       (Just b,  Just (r,i)) -> pp_off (uppBesides [pp_reg b, uppComma, pp_reg r, uppComma, uppInt i])
352   where
353     ppr_disp (ImmInt 0) = uppNil
354     ppr_disp imm        = pprImm imm
355 #endif
356
357 -------------------
358
359 #if sparc_TARGET_ARCH
360 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
361
362 pprAddr (AddrRegReg r1 r2)
363   = uppBesides [ pprReg r1, uppChar '+', pprReg r2 ]
364
365 pprAddr (AddrRegImm r1 (ImmInt i))
366   | i == 0 = pprReg r1
367   | not (fits13Bits i) = largeOffsetError i
368   | otherwise = uppBesides [ pprReg r1, pp_sign, uppInt i ]
369   where
370     pp_sign = if i > 0 then uppChar '+' else uppNil
371
372 pprAddr (AddrRegImm r1 (ImmInteger i))
373   | i == 0 = pprReg r1
374   | not (fits13Bits i) = largeOffsetError i
375   | otherwise  = uppBesides [ pprReg r1, pp_sign, uppInteger i ]
376   where
377     pp_sign = if i > 0 then uppChar '+' else uppNil
378
379 pprAddr (AddrRegImm r1 imm)
380   = uppBesides [ pprReg r1, uppChar '+', pprImm imm ]
381 #endif
382 \end{code}
383
384 %************************************************************************
385 %*                                                                      *
386 \subsection{@pprInstr@: print an @Instr@}
387 %*                                                                      *
388 %************************************************************************
389
390 \begin{code}
391 pprInstr :: Instr -> Unpretty
392
393 pprInstr (COMMENT s) = uppNil -- nuke 'em
394 --alpha:  = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
395 --i386 :  = uppBeside (uppPStr SLIT("# "))   (uppPStr s)
396 --sparc:  = uppBeside (uppPStr SLIT("! "))   (uppPStr s)
397
398 pprInstr (SEGMENT TextSegment)
399     = uppPStr
400          IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
401         ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
402         ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
403         ,)))
404
405 pprInstr (SEGMENT DataSegment)
406     = uppPStr
407          IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
408         ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
409         ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
410         ,)))
411
412 pprInstr (LABEL clab)
413   = let
414         pp_lab = pprCLabel_asm clab
415     in
416     uppBesides [
417         if not (externallyVisibleCLabel clab) then
418             uppNil
419         else
420             uppBesides [uppPStr
421                          IF_ARCH_alpha(SLIT("\t.globl\t")
422                         ,IF_ARCH_i386(SLIT(".globl ")
423                         ,IF_ARCH_sparc(SLIT("\t.global\t")
424                         ,)))
425                         , pp_lab, uppChar '\n'],
426         pp_lab,
427         uppChar ':'
428     ]
429
430 pprInstr (ASCII False{-no backslash conversion-} str)
431   = uppBesides [ uppPStr SLIT("\t.asciz \""), uppStr str, uppChar '"' ]
432
433 pprInstr (ASCII True str)
434   = uppBeside (uppPStr SLIT("\t.ascii \"")) (asciify str 60)
435   where
436     asciify :: String -> Int -> Unpretty
437
438     asciify [] _ = uppPStr SLIT("\\0\"")
439     asciify s     n | n <= 0 = uppBeside (uppPStr SLIT("\"\n\t.ascii \"")) (asciify s 60)
440     asciify ('\\':cs)      n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
441     asciify ('\"':cs)      n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
442     asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
443     asciify [c]            _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
444     asciify (c:(cs@(d:_))) n
445       | isDigit d = uppBeside (uppStr (charToC c)) (asciify cs 0)
446       | otherwise = uppBeside (uppStr (charToC c)) (asciify cs (n-1))
447
448 pprInstr (DATA s xs)
449   = uppInterleave (uppChar '\n')
450                   [uppBeside (uppPStr pp_size) (pprImm x) | x <- xs]
451   where
452     pp_size = case s of
453 #if alpha_TARGET_ARCH
454             B  -> SLIT("\t.byte\t")
455             BU -> SLIT("\t.byte\t")
456 --UNUSED:   W  -> SLIT("\t.word\t")
457 --UNUSED:   WU -> SLIT("\t.word\t")
458 --UNUSED:   L  -> SLIT("\t.long\t")
459             Q  -> SLIT("\t.quad\t")
460 --UNUSED:   FF -> SLIT("\t.f_floating\t")
461 --UNUSED:   DF -> SLIT("\t.d_floating\t")
462 --UNUSED:   GF -> SLIT("\t.g_floating\t")
463 --UNUSED:   SF -> SLIT("\t.s_floating\t")
464             TF -> SLIT("\t.t_floating\t")
465 #endif
466 #if i386_TARGET_ARCH
467             B  -> SLIT("\t.byte\t")
468 --UNUSED:   HB -> SLIT("\t.byte\t")
469 --UNUSED:   S  -> SLIT("\t.word\t")
470             L  -> SLIT("\t.long\t")
471             F  -> SLIT("\t.long\t")
472             DF -> SLIT("\t.double\t")
473 #endif
474 #if sparc_TARGET_ARCH
475             B  -> SLIT("\t.byte\t")
476             BU -> SLIT("\t.byte\t")
477             W  -> SLIT("\t.word\t")
478             DF -> SLIT("\t.double\t")
479 #endif
480
481 -- fall through to rest of (machine-specific) pprInstr...
482 \end{code}
483
484 %************************************************************************
485 %*                                                                      *
486 \subsubsection{@pprInstr@ for an Alpha}
487 %*                                                                      *
488 %************************************************************************
489
490 \begin{code}
491 #if alpha_TARGET_ARCH
492
493 pprInstr (LD size reg addr)
494   = uppBesides [
495         uppPStr SLIT("\tld"),
496         pprSize size,
497         uppChar '\t',
498         pprReg reg,
499         uppComma,
500         pprAddr addr
501     ]
502
503 pprInstr (LDA reg addr)
504   = uppBesides [
505         uppPStr SLIT("\tlda\t"),
506         pprReg reg,
507         uppComma,
508         pprAddr addr
509     ]
510
511 pprInstr (LDAH reg addr)
512   = uppBesides [
513         uppPStr SLIT("\tldah\t"),
514         pprReg reg,
515         uppComma,
516         pprAddr addr
517     ]
518
519 pprInstr (LDGP reg addr)
520   = uppBesides [
521         uppPStr SLIT("\tldgp\t"),
522         pprReg reg,
523         uppComma,
524         pprAddr addr
525     ]
526
527 pprInstr (LDI size reg imm)
528   = uppBesides [
529         uppPStr SLIT("\tldi"),
530         pprSize size,
531         uppChar '\t',
532         pprReg reg,
533         uppComma,
534         pprImm imm
535     ]
536
537 pprInstr (ST size reg addr)
538   = uppBesides [
539         uppPStr SLIT("\tst"),
540         pprSize size,
541         uppChar '\t',
542         pprReg reg,
543         uppComma,
544         pprAddr addr
545     ]
546
547 pprInstr (CLR reg)
548   = uppBesides [
549         uppPStr SLIT("\tclr\t"),
550         pprReg reg
551     ]
552
553 pprInstr (ABS size ri reg)
554   = uppBesides [
555         uppPStr SLIT("\tabs"),
556         pprSize size,
557         uppChar '\t',
558         pprRI ri,
559         uppComma,
560         pprReg reg
561     ]
562
563 pprInstr (NEG size ov ri reg)
564   = uppBesides [
565         uppPStr SLIT("\tneg"),
566         pprSize size,
567         if ov then uppPStr SLIT("v\t") else uppChar '\t',
568         pprRI ri,
569         uppComma,
570         pprReg reg
571     ]
572
573 pprInstr (ADD size ov reg1 ri reg2)
574   = uppBesides [
575         uppPStr SLIT("\tadd"),
576         pprSize size,
577         if ov then uppPStr SLIT("v\t") else uppChar '\t',
578         pprReg reg1,
579         uppComma,
580         pprRI ri,
581         uppComma,
582         pprReg reg2
583     ]
584
585 pprInstr (SADD size scale reg1 ri reg2)
586   = uppBesides [
587         uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
588         uppPStr SLIT("add"),
589         pprSize size,
590         uppChar '\t',
591         pprReg reg1,
592         uppComma,
593         pprRI ri,
594         uppComma,
595         pprReg reg2
596     ]
597
598 pprInstr (SUB size ov reg1 ri reg2)
599   = uppBesides [
600         uppPStr SLIT("\tsub"),
601         pprSize size,
602         if ov then uppPStr SLIT("v\t") else uppChar '\t',
603         pprReg reg1,
604         uppComma,
605         pprRI ri,
606         uppComma,
607         pprReg reg2
608     ]
609
610 pprInstr (SSUB size scale reg1 ri reg2)
611   = uppBesides [
612         uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
613         uppPStr SLIT("sub"),
614         pprSize size,
615         uppChar '\t',
616         pprReg reg1,
617         uppComma,
618         pprRI ri,
619         uppComma,
620         pprReg reg2
621     ]
622
623 pprInstr (MUL size ov reg1 ri reg2)
624   = uppBesides [
625         uppPStr SLIT("\tmul"),
626         pprSize size,
627         if ov then uppPStr SLIT("v\t") else uppChar '\t',
628         pprReg reg1,
629         uppComma,
630         pprRI ri,
631         uppComma,
632         pprReg reg2
633     ]
634
635 pprInstr (DIV size uns reg1 ri reg2)
636   = uppBesides [
637         uppPStr SLIT("\tdiv"),
638         pprSize size,
639         if uns then uppPStr SLIT("u\t") else uppChar '\t',
640         pprReg reg1,
641         uppComma,
642         pprRI ri,
643         uppComma,
644         pprReg reg2
645     ]
646
647 pprInstr (REM size uns reg1 ri reg2)
648   = uppBesides [
649         uppPStr SLIT("\trem"),
650         pprSize size,
651         if uns then uppPStr SLIT("u\t") else uppChar '\t',
652         pprReg reg1,
653         uppComma,
654         pprRI ri,
655         uppComma,
656         pprReg reg2
657     ]
658
659 pprInstr (NOT ri reg)
660   = uppBesides [
661         uppPStr SLIT("\tnot"),
662         uppChar '\t',
663         pprRI ri,
664         uppComma,
665         pprReg reg
666     ]
667
668 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
669 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
670 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
671 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
672 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
673 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
674
675 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
676 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
677 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
678
679 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
680 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
681
682 pprInstr (NOP) = uppPStr SLIT("\tnop")
683
684 pprInstr (CMP cond reg1 ri reg2)
685   = uppBesides [
686         uppPStr SLIT("\tcmp"),
687         pprCond cond,
688         uppChar '\t',
689         pprReg reg1,
690         uppComma,
691         pprRI ri,
692         uppComma,
693         pprReg reg2
694     ]
695
696 pprInstr (FCLR reg)
697   = uppBesides [
698         uppPStr SLIT("\tfclr\t"),
699         pprReg reg
700     ]
701
702 pprInstr (FABS reg1 reg2)
703   = uppBesides [
704         uppPStr SLIT("\tfabs\t"),
705         pprReg reg1,
706         uppComma,
707         pprReg reg2
708     ]
709
710 pprInstr (FNEG size reg1 reg2)
711   = uppBesides [
712         uppPStr SLIT("\tneg"),
713         pprSize size,
714         uppChar '\t',
715         pprReg reg1,
716         uppComma,
717         pprReg reg2
718     ]
719
720 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
721 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
722 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
723 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
724
725 pprInstr (CVTxy size1 size2 reg1 reg2)
726   = uppBesides [
727         uppPStr SLIT("\tcvt"),
728         pprSize size1,
729         case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
730         uppChar '\t',
731         pprReg reg1,
732         uppComma,
733         pprReg reg2
734     ]
735
736 pprInstr (FCMP size cond reg1 reg2 reg3)
737   = uppBesides [
738         uppPStr SLIT("\tcmp"),
739         pprSize size,
740         pprCond cond,
741         uppChar '\t',
742         pprReg reg1,
743         uppComma,
744         pprReg reg2,
745         uppComma,
746         pprReg reg3
747     ]
748
749 pprInstr (FMOV reg1 reg2)
750   = uppBesides [
751         uppPStr SLIT("\tfmov\t"),
752         pprReg reg1,
753         uppComma,
754         pprReg reg2
755     ]
756
757 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
758
759 pprInstr (BI NEVER reg lab) = uppNil
760
761 pprInstr (BI cond reg lab)
762   = uppBesides [
763         uppPStr SLIT("\tb"),
764         pprCond cond,
765         uppChar '\t',
766         pprReg reg,
767         uppComma,
768         pprImm lab
769     ]
770
771 pprInstr (BF cond reg lab)
772   = uppBesides [
773         uppPStr SLIT("\tfb"),
774         pprCond cond,
775         uppChar '\t',
776         pprReg reg,
777         uppComma,
778         pprImm lab
779     ]
780
781 pprInstr (BR lab)
782   = uppBeside (uppPStr SLIT("\tbr\t")) (pprImm lab)
783
784 pprInstr (JMP reg addr hint)
785   = uppBesides [
786         uppPStr SLIT("\tjmp\t"),
787         pprReg reg,
788         uppComma,
789         pprAddr addr,
790         uppComma,
791         uppInt hint
792     ]
793
794 pprInstr (BSR imm n)
795   = uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm imm)
796
797 pprInstr (JSR reg addr n)
798   = uppBesides [
799         uppPStr SLIT("\tjsr\t"),
800         pprReg reg,
801         uppComma,
802         pprAddr addr
803     ]
804
805 pprInstr (FUNBEGIN clab)
806   = uppBesides [
807         if (externallyVisibleCLabel clab) then
808             uppBesides [uppPStr SLIT("\t.globl\t"), pp_lab, uppChar '\n']
809         else
810             uppNil,
811         uppPStr SLIT("\t.ent "),
812         pp_lab,
813         uppChar '\n',
814         pp_lab,
815         pp_ldgp,
816         pp_lab,
817         pp_frame
818     ]
819     where
820         pp_lab = pprCLabel_asm clab
821
822         pp_ldgp  = uppPStr (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#))
823         pp_frame = uppPStr (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
824
825 pprInstr (FUNEND clab)
826   = uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
827 \end{code}
828
829 Continue with Alpha-only printing bits and bobs:
830 \begin{code}
831 pprRI :: RI -> Unpretty
832
833 pprRI (RIReg r) = pprReg r
834 pprRI (RIImm r) = pprImm r
835
836 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Unpretty
837
838 pprRegRIReg name reg1 ri reg2
839   = uppBesides [
840         uppChar '\t',
841         uppPStr name,
842         uppChar '\t',
843         pprReg reg1,
844         uppComma,
845         pprRI ri,
846         uppComma,
847         pprReg reg2
848     ]
849
850 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
851
852 pprSizeRegRegReg name size reg1 reg2 reg3
853   = uppBesides [
854         uppChar '\t',
855         uppPStr name,
856         pprSize size,
857         uppChar '\t',
858         pprReg reg1,
859         uppComma,
860         pprReg reg2,
861         uppComma,
862         pprReg reg3
863     ]
864
865 #endif {-alpha_TARGET_ARCH-}
866 \end{code}
867
868 %************************************************************************
869 %*                                                                      *
870 \subsubsection{@pprInstr@ for an I386}
871 %*                                                                      *
872 %************************************************************************
873
874 \begin{code}
875 #if i386_TARGET_ARCH
876
877 pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack
878   | src == dst
879   = uppPStr SLIT("")
880 pprInstr (MOV size src dst)
881   = pprSizeOpOp SLIT("mov") size src dst
882 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
883 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
884
885 -- here we do some patching, since the physical registers are only set late
886 -- in the code generation.
887 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
888   | reg1 == reg3
889   = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
890 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
891   | reg2 == reg3
892   = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
893 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
894   | reg1 == reg3
895   = pprInstr (ADD size (OpImm displ) dst)
896 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
897
898 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
899   = pprSizeOp SLIT("dec") size dst
900 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
901   = pprSizeOp SLIT("inc") size dst
902 pprInstr (ADD size src dst)
903   = pprSizeOpOp SLIT("add") size src dst
904 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
905 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
906 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
907
908 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
909 pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
910 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
911 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
912 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
913 pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl")  size imm dst
914 pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar")  size imm dst
915 pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr")  size imm dst
916
917 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp")  size src dst
918 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
919 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
920 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
921
922 pprInstr (NOP) = uppPStr SLIT("\tnop")
923 pprInstr (CLTD) = uppPStr SLIT("\tcltd")
924
925 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
926
927 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
928
929 pprInstr (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm imm)
930 pprInstr (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand L op)
931
932 pprInstr (CALL imm)
933   = uppBesides [ uppPStr SLIT("\tcall "), pprImm imm ]
934
935 pprInstr SAHF = uppPStr SLIT("\tsahf")
936 pprInstr FABS = uppPStr SLIT("\tfabs")
937
938 pprInstr (FADD sz src@(OpAddr _))
939   = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppSP, pprOperand sz src]
940 pprInstr (FADD sz src)
941   = uppPStr SLIT("\tfadd")
942 pprInstr FADDP
943   = uppPStr SLIT("\tfaddp")
944 pprInstr (FMUL sz src)
945   = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppSP, pprOperand sz src]
946 pprInstr FMULP
947   = uppPStr SLIT("\tfmulp")
948 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
949 pprInstr FCHS = uppPStr SLIT("\tfchs")
950 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
951 pprInstr FCOS = uppPStr SLIT("\tfcos")
952 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
953 pprInstr (FDIV sz src)
954   = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppSP, pprOperand sz src]
955 pprInstr FDIVP
956   = uppPStr SLIT("\tfdivp")
957 pprInstr (FDIVR sz src)
958   = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppSP, pprOperand sz src]
959 pprInstr FDIVRP
960   = uppPStr SLIT("\tfdivpr")
961 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
962 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
963 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
964 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
965 pprInstr (FLD sz (OpImm (ImmCLbl src)))
966   = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprCLabel_asm src]
967 pprInstr (FLD sz src)
968   = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprOperand sz src]
969 pprInstr FLD1 = uppPStr SLIT("\tfld1")
970 pprInstr FLDZ = uppPStr SLIT("\tfldz")
971 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
972 pprInstr FRNDINT = uppPStr SLIT("\tfrndint")
973 pprInstr FSIN = uppPStr SLIT("\tfsin")
974 pprInstr FSQRT = uppPStr SLIT("\tfsqrt")
975 pprInstr (FST sz dst)
976   = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppSP, pprOperand sz dst]
977 pprInstr (FSTP sz dst)
978   = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppSP, pprOperand sz dst]
979 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
980 pprInstr (FSUB sz src)
981   = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppSP, pprOperand sz src]
982 pprInstr FSUBP
983   = uppPStr SLIT("\tfsubp")
984 pprInstr (FSUBR size src)
985   = pprSizeOp SLIT("fsubr") size src
986 pprInstr FSUBRP
987   = uppPStr SLIT("\tfsubpr")
988 pprInstr (FISUBR size op)
989   = pprSizeAddr SLIT("fisubr") size op
990 pprInstr FTST = uppPStr SLIT("\tftst")
991 pprInstr (FCOMP sz op)
992   = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppSP, pprOperand sz op]
993 pprInstr FUCOMPP = uppPStr SLIT("\tfucompp")
994 pprInstr FXCH = uppPStr SLIT("\tfxch")
995 pprInstr FNSTSW = uppPStr SLIT("\tfnstsw %ax")
996 pprInstr FNOP = uppPStr SLIT("")
997 \end{code}
998
999 Continue with I386-only printing bits and bobs:
1000 \begin{code}
1001 pprDollImm :: Imm -> Unpretty
1002
1003 pprDollImm i     = uppBesides [ uppPStr SLIT("$"), pprImm i]
1004
1005 pprOperand :: Size -> Operand -> Unpretty
1006 pprOperand s (OpReg r) = pprReg s r
1007 pprOperand s (OpImm i) = pprDollImm i
1008 pprOperand s (OpAddr ea) = pprAddr ea
1009
1010 pprSizeOp :: FAST_STRING -> Size -> Operand -> Unpretty
1011 pprSizeOp name size op1
1012   = uppBesides [
1013         uppChar '\t',
1014         uppPStr name,
1015         pprSize size,
1016         uppSP,
1017         pprOperand size op1
1018     ]
1019
1020 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1021 pprSizeOpOp name size op1 op2
1022   = uppBesides [
1023         uppChar '\t',
1024         uppPStr name,
1025         pprSize size,
1026         uppSP,
1027         pprOperand size op1,
1028         uppComma,
1029         pprOperand size op2
1030     ]
1031
1032 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Unpretty
1033 pprSizeOpReg name size op1 reg
1034   = uppBesides [
1035         uppChar '\t',
1036         uppPStr name,
1037         pprSize size,
1038         uppSP,
1039         pprOperand size op1,
1040         uppComma,
1041         pprReg size reg
1042     ]
1043
1044 pprSizeAddr :: FAST_STRING -> Size -> Addr -> Unpretty
1045 pprSizeAddr name size op
1046   = uppBesides [
1047         uppChar '\t',
1048         uppPStr name,
1049         pprSize size,
1050         uppSP,
1051         pprAddr op
1052     ]
1053
1054 pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Unpretty
1055 pprSizeAddrReg name size op dst
1056   = uppBesides [
1057         uppChar '\t',
1058         uppPStr name,
1059         pprSize size,
1060         uppSP,
1061         pprAddr op,
1062         uppComma,
1063         pprReg size dst
1064     ]
1065
1066 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1067 pprOpOp name size op1 op2
1068   = uppBesides [
1069         uppChar '\t',
1070         uppPStr name, uppSP,
1071         pprOperand size op1,
1072         uppComma,
1073         pprOperand size op2
1074     ]
1075
1076 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty
1077 pprSizeOpOpCoerce name size1 size2 op1 op2
1078   = uppBesides [ uppChar '\t', uppPStr name, uppSP,
1079         pprOperand size1 op1,
1080         uppComma,
1081         pprOperand size2 op2
1082     ]
1083
1084 pprCondInstr :: FAST_STRING -> Cond -> Unpretty -> Unpretty
1085 pprCondInstr name cond arg
1086   = uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppSP, arg]
1087
1088 #endif {-i386_TARGET_ARCH-}
1089 \end{code}
1090
1091 %************************************************************************
1092 %*                                                                      *
1093 \subsubsection{@pprInstr@ for a SPARC}
1094 %*                                                                      *
1095 %************************************************************************
1096
1097 \begin{code}
1098 #if sparc_TARGET_ARCH
1099
1100 -- a clumsy hack for now, to handle possible double alignment problems
1101
1102 pprInstr (LD DF addr reg) | maybeToBool off_addr
1103   = uppBesides [
1104         pp_ld_lbracket,
1105         pprAddr addr,
1106         pp_rbracket_comma,
1107         pprReg reg,
1108
1109         uppChar '\n',
1110         pp_ld_lbracket,
1111         pprAddr addr2,
1112         pp_rbracket_comma,
1113         pprReg (fPair reg)
1114     ]
1115   where
1116     off_addr = addrOffset addr 4
1117     addr2 = case off_addr of Just x -> x
1118
1119 pprInstr (LD size addr reg)
1120   = uppBesides [
1121         uppPStr SLIT("\tld"),
1122         pprSize size,
1123         uppChar '\t',
1124         uppLbrack,
1125         pprAddr addr,
1126         pp_rbracket_comma,
1127         pprReg reg
1128     ]
1129
1130 -- The same clumsy hack as above
1131
1132 pprInstr (ST DF reg addr) | maybeToBool off_addr
1133   = uppBesides [
1134         uppPStr SLIT("\tst\t"),
1135         pprReg reg,
1136         pp_comma_lbracket,
1137         pprAddr addr,
1138
1139         uppPStr SLIT("]\n\tst\t"),
1140         pprReg (fPair reg),
1141         pp_comma_lbracket,
1142         pprAddr addr2,
1143         uppRbrack
1144     ]
1145   where
1146     off_addr = addrOffset addr 4
1147     addr2 = case off_addr of Just x -> x
1148
1149 pprInstr (ST size reg addr)
1150   = uppBesides [
1151         uppPStr SLIT("\tst"),
1152         pprSize size,
1153         uppChar '\t',
1154         pprReg reg,
1155         pp_comma_lbracket,
1156         pprAddr addr,
1157         uppRbrack
1158     ]
1159
1160 pprInstr (ADD x cc reg1 ri reg2)
1161   | not x && not cc && riZero ri
1162   = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1163   | otherwise
1164   = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1165
1166 pprInstr (SUB x cc reg1 ri reg2)
1167   | not x && cc && reg2 == g0
1168   = uppBesides [ uppPStr SLIT("\tcmp\t"), pprReg reg1, uppComma, pprRI ri ]
1169   | not x && not cc && riZero ri
1170   = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1171   | otherwise
1172   = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1173
1174 pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
1175 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1176
1177 pprInstr (OR b reg1 ri reg2)
1178   | not b && reg1 == g0
1179   = uppBesides [ uppPStr SLIT("\tmov\t"), pprRI ri, uppComma, pprReg reg2 ]
1180   | otherwise
1181   = pprRegRIReg SLIT("or") b reg1 ri reg2
1182
1183 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1184
1185 pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
1186 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1187
1188 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1189 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1190 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1191
1192 pprInstr (SETHI imm reg)
1193   = uppBesides [
1194         uppPStr SLIT("\tsethi\t"),
1195         pprImm imm,
1196         uppComma,
1197         pprReg reg
1198     ]
1199
1200 pprInstr NOP = uppPStr SLIT("\tnop")
1201
1202 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1203 pprInstr (FABS DF reg1 reg2)
1204   = uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1205     (if (reg1 == reg2) then uppNil
1206      else uppBeside (uppChar '\n')
1207           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1208
1209 pprInstr (FADD size reg1 reg2 reg3)
1210   = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1211 pprInstr (FCMP e size reg1 reg2)
1212   = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1213 pprInstr (FDIV size reg1 reg2 reg3)
1214   = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1215
1216 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1217 pprInstr (FMOV DF reg1 reg2)
1218   = uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1219     (if (reg1 == reg2) then uppNil
1220      else uppBeside (uppChar '\n')
1221           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1222
1223 pprInstr (FMUL size reg1 reg2 reg3)
1224   = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1225
1226 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1227 pprInstr (FNEG DF reg1 reg2)
1228   = uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1229     (if (reg1 == reg2) then uppNil
1230      else uppBeside (uppChar '\n')
1231           (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1232
1233 pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1234 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1235 pprInstr (FxTOy size1 size2 reg1 reg2)
1236   = uppBesides [
1237         uppPStr SLIT("\tf"),
1238         uppPStr
1239         (case size1 of
1240             W  -> SLIT("ito")
1241             F  -> SLIT("sto")
1242             DF -> SLIT("dto")),
1243         uppPStr
1244         (case size2 of
1245             W  -> SLIT("i\t")
1246             F  -> SLIT("s\t")
1247             DF -> SLIT("d\t")),
1248         pprReg reg1, uppComma, pprReg reg2
1249     ]
1250
1251
1252 pprInstr (BI cond b lab)
1253   = uppBesides [
1254         uppPStr SLIT("\tb"), pprCond cond,
1255         if b then pp_comma_a else uppNil,
1256         uppChar '\t',
1257         pprImm lab
1258     ]
1259
1260 pprInstr (BF cond b lab)
1261   = uppBesides [
1262         uppPStr SLIT("\tfb"), pprCond cond,
1263         if b then pp_comma_a else uppNil,
1264         uppChar '\t',
1265         pprImm lab
1266     ]
1267
1268 pprInstr (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr addr)
1269
1270 pprInstr (CALL imm n _)
1271   = uppBesides [ uppPStr SLIT("\tcall\t"), pprImm imm, uppComma, uppInt n ]
1272 \end{code}
1273
1274 Continue with SPARC-only printing bits and bobs:
1275 \begin{code}
1276 pprRI :: RI -> Unpretty
1277 pprRI (RIReg r) = pprReg r
1278 pprRI (RIImm r) = pprImm r
1279
1280 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
1281 pprSizeRegReg name size reg1 reg2
1282   = uppBesides [
1283         uppChar '\t',
1284         uppPStr name,
1285         (case size of
1286             F  -> uppPStr SLIT("s\t")
1287             DF -> uppPStr SLIT("d\t")),
1288         pprReg reg1,
1289         uppComma,
1290         pprReg reg2
1291     ]
1292
1293 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
1294 pprSizeRegRegReg name size reg1 reg2 reg3
1295   = uppBesides [
1296         uppChar '\t',
1297         uppPStr name,
1298         (case size of
1299             F  -> uppPStr SLIT("s\t")
1300             DF -> uppPStr SLIT("d\t")),
1301         pprReg reg1,
1302         uppComma,
1303         pprReg reg2,
1304         uppComma,
1305         pprReg reg3
1306     ]
1307
1308 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
1309 pprRegRIReg name b reg1 ri reg2
1310   = uppBesides [
1311         uppChar '\t',
1312         uppPStr name,
1313         if b then uppPStr SLIT("cc\t") else uppChar '\t',
1314         pprReg reg1,
1315         uppComma,
1316         pprRI ri,
1317         uppComma,
1318         pprReg reg2
1319     ]
1320
1321 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Unpretty
1322 pprRIReg name b ri reg1
1323   = uppBesides [
1324         uppChar '\t',
1325         uppPStr name,
1326         if b then uppPStr SLIT("cc\t") else uppChar '\t',
1327         pprRI ri,
1328         uppComma,
1329         pprReg reg1
1330     ]
1331
1332 pp_ld_lbracket    = uppPStr (pACK_STR (a_HASH "\tld\t["#))
1333 pp_rbracket_comma = uppPStr (pACK_STR (a_HASH "],"#))
1334 pp_comma_lbracket = uppPStr (pACK_STR (a_HASH ",["#))
1335 pp_comma_a        = uppPStr (pACK_STR (a_HASH ",a"#))
1336
1337 #endif {-sparc_TARGET_ARCH-}
1338 \end{code}