{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}


-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -fno-warn-orphans #-}
module GHC.CmmToAsm.SPARC.Ppr (
        pprNatCmmDecl,
        pprBasicBlock,
        pprData,
        pprInstr,
        pprFormat,
        pprImm,
        pprDataItem
)

where

#include "HsVersions.h"

import GHC.Prelude

import Data.Word
import qualified Data.Array.Unsafe as U ( castSTUArray )
import Data.Array.ST

import Control.Monad.ST

import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Cond
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Base
import GHC.Platform.Reg
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils

import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Ppr() -- For Outputable instances
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections

import GHC.Types.Unique ( pprUniqueAlways )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Platform
import GHC.Data.FastString

-- -----------------------------------------------------------------------------
-- Printing this stuff out

pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl NCGConfig
config (CmmData Section
section RawCmmStatics
dats) =
  NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config Section
section
  SDoc -> SDoc -> SDoc
$$ Platform -> RawCmmStatics -> SDoc
pprDatas (NCGConfig -> Platform
ncgPlatform NCGConfig
config) RawCmmStatics
dats

pprNatCmmDecl NCGConfig
config proc :: NatCmmDecl RawCmmStatics Instr
proc@(CmmProc LabelMap RawCmmStatics
top_info CLabel
lbl [GlobalReg]
_ (ListGraph [GenBasicBlock Instr]
blocks)) =
  let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config in
  case NatCmmDecl RawCmmStatics Instr -> Maybe RawCmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl RawCmmStatics Instr
proc of
    Maybe RawCmmStatics
Nothing ->
        -- special case for code without info table:
        NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) SDoc -> SDoc -> SDoc
$$
        Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
$$ -- blocks guaranteed not null, so label needed
        [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock Platform
platform LabelMap RawCmmStatics
top_info) [GenBasicBlock Instr]
blocks)

    Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) ->
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
          then NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config Section
dspSection SDoc -> SDoc -> SDoc
$$
               Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
          else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock Platform
platform LabelMap RawCmmStatics
top_info) [GenBasicBlock Instr]
blocks) SDoc -> SDoc -> SDoc
$$
      -- above: Even the first block gets a label, because with branch-chain
      -- elimination, it might be the target of a goto.
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
       then
       -- See Note [Subsections Via Symbols] in X86/Ppr.hs
                String -> SDoc
text String
"\t.long "
            SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
info_lbl
            SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'-'
            SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl)
       else SDoc
empty)

dspSection :: Section
dspSection :: Section
dspSection = SectionType -> CLabel -> Section
Section SectionType
Text (CLabel -> Section) -> CLabel -> Section
forall a b. (a -> b) -> a -> b
$
    String -> CLabel
forall a. String -> a
panic String
"subsections-via-symbols doesn't combine with split-sections"

pprBasicBlock :: Platform -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock :: Platform -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock Platform
platform LabelMap RawCmmStatics
info_env (BasicBlock BlockId
blockid [Instr]
instrs)
  = SDoc
maybe_infotable SDoc -> SDoc -> SDoc
$$
    Platform -> CLabel -> SDoc
pprLabel Platform
platform (BlockId -> CLabel
blockLbl BlockId
blockid) SDoc -> SDoc -> SDoc
$$
    [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Instr -> SDoc
pprInstr Platform
platform) [Instr]
instrs)
  where
    maybe_infotable :: SDoc
maybe_infotable = case KeyOf LabelMap -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockid LabelMap RawCmmStatics
info_env of
       Maybe RawCmmStatics
Nothing   -> SDoc
empty
       Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
info) ->
           SectionType -> SDoc
pprAlignForSection SectionType
Text SDoc -> SDoc -> SDoc
$$
           [SDoc] -> SDoc
vcat ((CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> SDoc
pprData Platform
platform) [CmmStatic]
info) SDoc -> SDoc -> SDoc
$$
           Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
info_lbl


pprDatas :: Platform -> RawCmmStatics -> SDoc
-- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
pprDatas :: Platform -> RawCmmStatics -> SDoc
pprDatas Platform
platform (CmmStaticsRaw CLabel
alias [CmmStaticLit (CmmLabel CLabel
lbl), CmmStaticLit CmmLit
ind, CmmStatic
_, CmmStatic
_])
  | CLabel
lbl CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
mkIndStaticInfoLabel
  , let labelInd :: CmmLit -> Maybe CLabel
labelInd (CmmLabelOff CLabel
l Int
_) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd (CmmLabel CLabel
l) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd CmmLit
_ = Maybe CLabel
forall a. Maybe a
Nothing
  , Just CLabel
ind' <- CmmLit -> Maybe CLabel
labelInd CmmLit
ind
  , CLabel
alias CLabel -> CLabel -> Bool
`mayRedirectTo` CLabel
ind'
  = Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
alias
    SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
".equiv" SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
alias SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Platform -> CmmLit -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CmmLit
CmmLabel CLabel
ind')
pprDatas Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
dats) = [SDoc] -> SDoc
vcat (Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
lbl SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> SDoc
pprData Platform
platform) [CmmStatic]
dats)

pprData :: Platform -> CmmStatic -> SDoc
pprData :: Platform -> CmmStatic -> SDoc
pprData Platform
platform CmmStatic
d = case CmmStatic
d of
   CmmString ByteString
str          -> ByteString -> SDoc
pprString ByteString
str
   CmmFileEmbed String
path      -> String -> SDoc
pprFileEmbed String
path
   CmmUninitialised Int
bytes -> String -> SDoc
text String
".skip " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
   CmmStaticLit CmmLit
lit       -> Platform -> CmmLit -> SDoc
pprDataItem Platform
platform CmmLit
lit

pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
lbl
  | Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = SDoc
empty
  | Bool
otherwise = String -> SDoc
text String
".global " SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl

pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl Platform
platform CLabel
lbl
    = if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSLinux Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
      then String -> SDoc
text String
".type " SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
", @object")
      else SDoc
empty

pprLabel :: Platform -> CLabel -> SDoc
pprLabel :: Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
lbl =
   Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
lbl
   SDoc -> SDoc -> SDoc
$$ Platform -> CLabel -> SDoc
pprTypeAndSizeDecl Platform
platform CLabel
lbl
   SDoc -> SDoc -> SDoc
$$ (Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':')

-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'

instance OutputableP Platform Instr where
    pdoc :: Platform -> Instr -> SDoc
pdoc = Platform -> Instr -> SDoc
pprInstr


-- | Pretty print a register.
pprReg :: Reg -> SDoc
pprReg :: Reg -> SDoc
pprReg Reg
reg
 = case Reg
reg of
        RegVirtual VirtualReg
vr
         -> case VirtualReg
vr of
                VirtualRegI   Unique
u -> String -> SDoc
text String
"%vI_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegHi  Unique
u -> String -> SDoc
text String
"%vHi_"  SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegF   Unique
u -> String -> SDoc
text String
"%vF_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
                VirtualRegD   Unique
u -> String -> SDoc
text String
"%vD_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u


        RegReal RealReg
rr
         -> case RealReg
rr of
                RealRegSingle Int
r1
                 -> Int -> SDoc
pprReg_ofRegNo Int
r1

                RealRegPair Int
r1 Int
r2
                 -> String -> SDoc
text String
"(" SDoc -> SDoc -> SDoc
<> Int -> SDoc
pprReg_ofRegNo Int
r1
                 SDoc -> SDoc -> SDoc
<> SDoc
vbar     SDoc -> SDoc -> SDoc
<> Int -> SDoc
pprReg_ofRegNo Int
r2
                 SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
")"



-- | Pretty print a register name, based on this register number.
--   The definition has been unfolded so we get a jump-table in the
--   object code. This function is called quite a lot when emitting
--   the asm file..
--
pprReg_ofRegNo :: Int -> SDoc
pprReg_ofRegNo :: Int -> SDoc
pprReg_ofRegNo Int
i
 = PtrString -> SDoc
ptext
    (case Int
i of {
         Int
0 -> String -> PtrString
sLit String
"%g0";   Int
1 -> String -> PtrString
sLit String
"%g1";
         Int
2 -> String -> PtrString
sLit String
"%g2";   Int
3 -> String -> PtrString
sLit String
"%g3";
         Int
4 -> String -> PtrString
sLit String
"%g4";   Int
5 -> String -> PtrString
sLit String
"%g5";
         Int
6 -> String -> PtrString
sLit String
"%g6";   Int
7 -> String -> PtrString
sLit String
"%g7";
         Int
8 -> String -> PtrString
sLit String
"%o0";   Int
9 -> String -> PtrString
sLit String
"%o1";
        Int
10 -> String -> PtrString
sLit String
"%o2";  Int
11 -> String -> PtrString
sLit String
"%o3";
        Int
12 -> String -> PtrString
sLit String
"%o4";  Int
13 -> String -> PtrString
sLit String
"%o5";
        Int
14 -> String -> PtrString
sLit String
"%o6";  Int
15 -> String -> PtrString
sLit String
"%o7";
        Int
16 -> String -> PtrString
sLit String
"%l0";  Int
17 -> String -> PtrString
sLit String
"%l1";
        Int
18 -> String -> PtrString
sLit String
"%l2";  Int
19 -> String -> PtrString
sLit String
"%l3";
        Int
20 -> String -> PtrString
sLit String
"%l4";  Int
21 -> String -> PtrString
sLit String
"%l5";
        Int
22 -> String -> PtrString
sLit String
"%l6";  Int
23 -> String -> PtrString
sLit String
"%l7";
        Int
24 -> String -> PtrString
sLit String
"%i0";  Int
25 -> String -> PtrString
sLit String
"%i1";
        Int
26 -> String -> PtrString
sLit String
"%i2";  Int
27 -> String -> PtrString
sLit String
"%i3";
        Int
28 -> String -> PtrString
sLit String
"%i4";  Int
29 -> String -> PtrString
sLit String
"%i5";
        Int
30 -> String -> PtrString
sLit String
"%i6";  Int
31 -> String -> PtrString
sLit String
"%i7";
        Int
32 -> String -> PtrString
sLit String
"%f0";  Int
33 -> String -> PtrString
sLit String
"%f1";
        Int
34 -> String -> PtrString
sLit String
"%f2";  Int
35 -> String -> PtrString
sLit String
"%f3";
        Int
36 -> String -> PtrString
sLit String
"%f4";  Int
37 -> String -> PtrString
sLit String
"%f5";
        Int
38 -> String -> PtrString
sLit String
"%f6";  Int
39 -> String -> PtrString
sLit String
"%f7";
        Int
40 -> String -> PtrString
sLit String
"%f8";  Int
41 -> String -> PtrString
sLit String
"%f9";
        Int
42 -> String -> PtrString
sLit String
"%f10"; Int
43 -> String -> PtrString
sLit String
"%f11";
        Int
44 -> String -> PtrString
sLit String
"%f12"; Int
45 -> String -> PtrString
sLit String
"%f13";
        Int
46 -> String -> PtrString
sLit String
"%f14"; Int
47 -> String -> PtrString
sLit String
"%f15";
        Int
48 -> String -> PtrString
sLit String
"%f16"; Int
49 -> String -> PtrString
sLit String
"%f17";
        Int
50 -> String -> PtrString
sLit String
"%f18"; Int
51 -> String -> PtrString
sLit String
"%f19";
        Int
52 -> String -> PtrString
sLit String
"%f20"; Int
53 -> String -> PtrString
sLit String
"%f21";
        Int
54 -> String -> PtrString
sLit String
"%f22"; Int
55 -> String -> PtrString
sLit String
"%f23";
        Int
56 -> String -> PtrString
sLit String
"%f24"; Int
57 -> String -> PtrString
sLit String
"%f25";
        Int
58 -> String -> PtrString
sLit String
"%f26"; Int
59 -> String -> PtrString
sLit String
"%f27";
        Int
60 -> String -> PtrString
sLit String
"%f28"; Int
61 -> String -> PtrString
sLit String
"%f29";
        Int
62 -> String -> PtrString
sLit String
"%f30"; Int
63 -> String -> PtrString
sLit String
"%f31";
        Int
_  -> String -> PtrString
sLit String
"very naughty sparc register" })


-- | Pretty print a format for an instruction suffix.
pprFormat :: Format -> SDoc
pprFormat :: Format -> SDoc
pprFormat Format
x
 = PtrString -> SDoc
ptext
    (case Format
x of
        Format
II8     -> String -> PtrString
sLit String
"ub"
        Format
II16    -> String -> PtrString
sLit String
"uh"
        Format
II32    -> String -> PtrString
sLit String
""
        Format
II64    -> String -> PtrString
sLit String
"d"
        Format
FF32    -> String -> PtrString
sLit String
""
        Format
FF64    -> String -> PtrString
sLit String
"d")


-- | Pretty print a format for an instruction suffix.
--      eg LD is 32bit on sparc, but LDD is 64 bit.
pprStFormat :: Format -> SDoc
pprStFormat :: Format -> SDoc
pprStFormat Format
x
 = PtrString -> SDoc
ptext
    (case Format
x of
        Format
II8   -> String -> PtrString
sLit String
"b"
        Format
II16  -> String -> PtrString
sLit String
"h"
        Format
II32  -> String -> PtrString
sLit String
""
        Format
II64  -> String -> PtrString
sLit String
"x"
        Format
FF32  -> String -> PtrString
sLit String
""
        Format
FF64  -> String -> PtrString
sLit String
"d")



-- | Pretty print a condition code.
pprCond :: Cond -> SDoc
pprCond :: Cond -> SDoc
pprCond Cond
c
 = PtrString -> SDoc
ptext
    (case Cond
c of
        Cond
ALWAYS  -> String -> PtrString
sLit String
""
        Cond
NEVER   -> String -> PtrString
sLit String
"n"
        Cond
GEU     -> String -> PtrString
sLit String
"geu"
        Cond
LU      -> String -> PtrString
sLit String
"lu"
        Cond
EQQ     -> String -> PtrString
sLit String
"e"
        Cond
GTT     -> String -> PtrString
sLit String
"g"
        Cond
GE      -> String -> PtrString
sLit String
"ge"
        Cond
GU      -> String -> PtrString
sLit String
"gu"
        Cond
LTT     -> String -> PtrString
sLit String
"l"
        Cond
LE      -> String -> PtrString
sLit String
"le"
        Cond
LEU     -> String -> PtrString
sLit String
"leu"
        Cond
NE      -> String -> PtrString
sLit String
"ne"
        Cond
NEG     -> String -> PtrString
sLit String
"neg"
        Cond
POS     -> String -> PtrString
sLit String
"pos"
        Cond
VC      -> String -> PtrString
sLit String
"vc"
        Cond
VS      -> String -> PtrString
sLit String
"vs")


-- | Pretty print an address mode.
pprAddr :: Platform -> AddrMode -> SDoc
pprAddr :: Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
am
 = case AddrMode
am of
        AddrRegReg Reg
r1 (RegReal (RealRegSingle Int
0))
         -> Reg -> SDoc
pprReg Reg
r1

        AddrRegReg Reg
r1 Reg
r2
         -> [SDoc] -> SDoc
hcat [ Reg -> SDoc
pprReg Reg
r1, Char -> SDoc
char Char
'+', Reg -> SDoc
pprReg Reg
r2 ]

        AddrRegImm Reg
r1 (ImmInt Int
i)
         | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0               -> Reg -> SDoc
pprReg Reg
r1
         | Bool -> Bool
not (Int -> Bool
forall a. Integral a => a -> Bool
fits13Bits Int
i)   -> Int -> SDoc
forall a b. Show a => a -> b
largeOffsetError Int
i
         | Bool
otherwise            -> [SDoc] -> SDoc
hcat [ Reg -> SDoc
pprReg Reg
r1, SDoc
pp_sign, Int -> SDoc
int Int
i ]
         where
                pp_sign :: SDoc
pp_sign = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Char -> SDoc
char Char
'+' else SDoc
empty

        AddrRegImm Reg
r1 (ImmInteger Integer
i)
         | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0               -> Reg -> SDoc
pprReg Reg
r1
         | Bool -> Bool
not (Integer -> Bool
forall a. Integral a => a -> Bool
fits13Bits Integer
i)   -> Integer -> SDoc
forall a b. Show a => a -> b
largeOffsetError Integer
i
         | Bool
otherwise            -> [SDoc] -> SDoc
hcat [ Reg -> SDoc
pprReg Reg
r1, SDoc
pp_sign, Integer -> SDoc
integer Integer
i ]
         where
                pp_sign :: SDoc
pp_sign = if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Char -> SDoc
char Char
'+' else SDoc
empty

        AddrRegImm Reg
r1 Imm
imm
         -> [SDoc] -> SDoc
hcat [ Reg -> SDoc
pprReg Reg
r1, Char -> SDoc
char Char
'+', Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm ]


-- | Pretty print an immediate value.
pprImm :: Platform -> Imm -> SDoc
pprImm :: Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
 = case Imm
imm of
        ImmInt Int
i        -> Int -> SDoc
int Int
i
        ImmInteger Integer
i    -> Integer -> SDoc
integer Integer
i
        ImmCLbl CLabel
l       -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l
        ImmIndex CLabel
l Int
i    -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
        ImmLit SDoc
s        -> SDoc
s

        ImmConstantSum Imm
a Imm
b
         -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
b

        ImmConstantDiff Imm
a Imm
b
         -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
b SDoc -> SDoc -> SDoc
<> SDoc
rparen

        LO Imm
i
         -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"%lo(", Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i, SDoc
rparen ]

        HI Imm
i
         -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"%hi(", Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i, SDoc
rparen ]

        -- these should have been converted to bytes and placed
        --      in the data section.
        ImmFloat Rational
_      -> String -> SDoc
text String
"naughty float immediate"
        ImmDouble Rational
_     -> String -> SDoc
text String
"naughty double immediate"


-- | Pretty print a section \/ segment header.
--      On SPARC all the data sections must be at least 8 byte aligned
--      incase we store doubles in them.
--
pprSectionAlign :: NCGConfig -> Section -> SDoc
pprSectionAlign :: NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config sec :: Section
sec@(Section SectionType
seg CLabel
_) =
    NCGConfig -> Section -> SDoc
pprSectionHeader NCGConfig
config Section
sec SDoc -> SDoc -> SDoc
$$
    SectionType -> SDoc
pprAlignForSection SectionType
seg

-- | Print appropriate alignment for the given section type.
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection SectionType
seg =
    PtrString -> SDoc
ptext (case SectionType
seg of
      SectionType
Text              -> String -> PtrString
sLit String
".align 4"
      SectionType
Data              -> String -> PtrString
sLit String
".align 8"
      SectionType
ReadOnlyData      -> String -> PtrString
sLit String
".align 8"
      SectionType
RelocatableReadOnlyData
                        -> String -> PtrString
sLit String
".align 8"
      SectionType
UninitialisedData -> String -> PtrString
sLit String
".align 8"
      SectionType
ReadOnlyData16    -> String -> PtrString
sLit String
".align 16"
      -- TODO: This is copied from the ReadOnlyData case, but it can likely be
      -- made more efficient.
      SectionType
CString           -> String -> PtrString
sLit String
".align 8"
      OtherSection String
_    -> String -> PtrString
forall a. String -> a
panic String
"PprMach.pprSectionHeader: unknown section")

-- | Pretty print a data item.
pprDataItem :: Platform -> CmmLit -> SDoc
pprDataItem :: Platform -> CmmLit -> SDoc
pprDataItem Platform
platform CmmLit
lit
  = [SDoc] -> SDoc
vcat (Format -> CmmLit -> [SDoc]
ppr_item (CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit) CmmLit
lit)
    where
        imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit

        ppr_item :: Format -> CmmLit -> [SDoc]
ppr_item Format
II8   CmmLit
_        = [String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
II32  CmmLit
_        = [String -> SDoc
text String
"\t.long\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]

        ppr_item Format
FF32  (CmmFloat Rational
r Width
_)
         = let bs :: [Int]
bs = Float -> [Int]
floatToBytes (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r)
           in  (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform (Int -> Imm
ImmInt Int
b)) [Int]
bs

        ppr_item Format
FF64 (CmmFloat Rational
r Width
_)
         = let bs :: [Int]
bs = Double -> [Int]
doubleToBytes (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
           in  (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform (Int -> Imm
ImmInt Int
b)) [Int]
bs

        ppr_item Format
II16  CmmLit
_        = [String -> SDoc
text String
"\t.short\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
II64  CmmLit
_        = [String -> SDoc
text String
"\t.quad\t"  SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
_ CmmLit
_            = String -> [SDoc]
forall a. String -> a
panic String
"SPARC.Ppr.pprDataItem: no match"

floatToBytes :: Float -> [Int]
floatToBytes :: Float -> [Int]
floatToBytes Float
f
   = (forall s. ST s [Int]) -> [Int]
forall a. (forall s. ST s a) -> a
runST (do
        STUArray s Int Float
arr <- (Int, Int) -> ST s (STUArray s Int Float)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
newArray_ ((Int
0::Int),Int
3)
        STUArray s Int Float -> Int -> Float -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Float
arr Int
0 Float
f
        STUArray s Int Word8
arr <- STUArray s Int Float -> ST s (STUArray s Int Word8)
forall s. STUArray s Int Float -> ST s (STUArray s Int Word8)
castFloatToWord8Array STUArray s Int Float
arr
        Word8
i0 <- STUArray s Int Word8 -> Int -> ST s Word8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
0
        Word8
i1 <- STUArray s Int Word8 -> Int -> ST s Word8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
1
        Word8
i2 <- STUArray s Int Word8 -> Int -> ST s Word8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
2
        Word8
i3 <- STUArray s Int Word8 -> Int -> ST s Word8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Word8
arr Int
3
        [Int] -> ST s [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Word8 -> Int) -> [Word8] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word8
i0,Word8
i1,Word8
i2,Word8
i3])
     )

castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
castFloatToWord8Array :: forall s. STUArray s Int Float -> ST s (STUArray s Int Word8)
castFloatToWord8Array = STUArray s Int Float -> ST s (STUArray s Int Word8)
forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
U.castSTUArray


-- | Pretty print an instruction.
pprInstr :: Platform -> Instr -> SDoc
pprInstr :: Platform -> Instr -> SDoc
pprInstr Platform
platform = \case
   COMMENT FastString
_ -> SDoc
empty -- nuke comments.
   DELTA Int
d   -> Platform -> Instr -> SDoc
pprInstr Platform
platform (FastString -> Instr
COMMENT (String -> FastString
mkFastString (String
"\tdelta = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)))

   -- Newblocks and LData should have been slurped out before producing the .s file.
   NEWBLOCK BlockId
_ -> String -> SDoc
forall a. String -> a
panic String
"X86.Ppr.pprInstr: NEWBLOCK"
   LDATA Section
_ RawCmmStatics
_  -> String -> SDoc
forall a. String -> a
panic String
"PprMach.pprInstr: LDATA"

   -- 64 bit FP loads are expanded into individual instructions in CodeGen.Expand
   LD Format
FF64 AddrMode
_ Reg
reg
        | RegReal (RealRegSingle{})     <- Reg
reg
        -> String -> SDoc
forall a. String -> a
panic String
"SPARC.Ppr: not emitting potentially misaligned LD FF64 instr"

   LD Format
format AddrMode
addr Reg
reg
        -> [SDoc] -> SDoc
hcat [
               String -> SDoc
text String
"\tld",
               Format -> SDoc
pprFormat Format
format,
               Char -> SDoc
char Char
'\t',
               SDoc
lbrack,
               Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr,
               SDoc
pp_rbracket_comma,
               Reg -> SDoc
pprReg Reg
reg
            ]

   -- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand
   ST Format
FF64 Reg
reg AddrMode
_
        | RegReal (RealRegSingle{}) <- Reg
reg
        -> String -> SDoc
forall a. String -> a
panic String
"SPARC.Ppr: not emitting potentially misaligned ST FF64 instr"

   -- no distinction is made between signed and unsigned bytes on stores for the
   -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
   -- so we call a special-purpose pprFormat for ST..
   ST Format
format Reg
reg AddrMode
addr
        -> [SDoc] -> SDoc
hcat [
               String -> SDoc
text String
"\tst",
               Format -> SDoc
pprStFormat Format
format,
               Char -> SDoc
char Char
'\t',
               Reg -> SDoc
pprReg Reg
reg,
               SDoc
pp_comma_lbracket,
               Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr,
               SDoc
rbrack
            ]


   ADD Bool
x Bool
cc Reg
reg1 RI
ri Reg
reg2
        | Bool -> Bool
not Bool
x Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cc Bool -> Bool -> Bool
&& RI -> Bool
riZero RI
ri
        -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tmov\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]

        | Bool
otherwise
        -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (if Bool
x then String -> PtrString
sLit String
"addx" else String -> PtrString
sLit String
"add") Bool
cc Reg
reg1 RI
ri Reg
reg2


   SUB Bool
x Bool
cc Reg
reg1 RI
ri Reg
reg2
        | Bool -> Bool
not Bool
x Bool -> Bool -> Bool
&& Bool
cc Bool -> Bool -> Bool
&& Reg
reg2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
g0
        -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tcmp\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Platform -> RI -> SDoc
pprRI Platform
platform RI
ri ]

        | Bool -> Bool
not Bool
x Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cc Bool -> Bool -> Bool
&& RI -> Bool
riZero RI
ri
        -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tmov\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]

        | Bool
otherwise
        -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (if Bool
x then String -> PtrString
sLit String
"subx" else String -> PtrString
sLit String
"sub") Bool
cc Reg
reg1 RI
ri Reg
reg2

   AND  Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"and")  Bool
b Reg
reg1 RI
ri Reg
reg2

   ANDN Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"andn") Bool
b Reg
reg1 RI
ri Reg
reg2

   OR Bool
b Reg
reg1 RI
ri Reg
reg2
        | Bool -> Bool
not Bool
b Bool -> Bool -> Bool
&& Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
g0
        -> let doit :: SDoc
doit = [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tmov\t", Platform -> RI -> SDoc
pprRI Platform
platform RI
ri, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]
           in  case RI
ri of
                   RIReg Reg
rrr | Reg
rrr Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2 -> SDoc
empty
                   RI
_                       -> SDoc
doit

        | Bool
otherwise
        -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"or") Bool
b Reg
reg1 RI
ri Reg
reg2

   ORN Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"orn") Bool
b Reg
reg1 RI
ri Reg
reg2

   XOR  Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"xor")  Bool
b Reg
reg1 RI
ri Reg
reg2
   XNOR Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"xnor") Bool
b Reg
reg1 RI
ri Reg
reg2

   SLL Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"sll") Bool
False Reg
reg1 RI
ri Reg
reg2
   SRL Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"srl") Bool
False Reg
reg1 RI
ri Reg
reg2
   SRA Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"sra") Bool
False Reg
reg1 RI
ri Reg
reg2

   RDY Reg
rd -> String -> SDoc
text String
"\trd\t%y," SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
rd
   WRY Reg
reg1 Reg
reg2
        -> String -> SDoc
text String
"\twr\t"
                SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
reg1
                SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
','
                SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
reg2
                SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
','
                SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"%y"

   SMUL Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"smul")  Bool
b Reg
reg1 RI
ri Reg
reg2
   UMUL Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"umul")  Bool
b Reg
reg1 RI
ri Reg
reg2
   SDIV Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"sdiv")  Bool
b Reg
reg1 RI
ri Reg
reg2
   UDIV Bool
b Reg
reg1 RI
ri Reg
reg2 -> Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform (String -> PtrString
sLit String
"udiv")  Bool
b Reg
reg1 RI
ri Reg
reg2

   SETHI Imm
imm Reg
reg
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tsethi\t",
            Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm,
            SDoc
comma,
            Reg -> SDoc
pprReg Reg
reg
         ]

   Instr
NOP -> String -> SDoc
text String
"\tnop"

   FABS Format
format Reg
reg1 Reg
reg2
        -> PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"fabs") Format
format Reg
reg1 Reg
reg2

   FADD Format
format Reg
reg1 Reg
reg2 Reg
reg3
        -> PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"fadd") Format
format Reg
reg1 Reg
reg2 Reg
reg3

   FCMP Bool
e Format
format Reg
reg1 Reg
reg2
        -> PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (if Bool
e then String -> PtrString
sLit String
"fcmpe" else String -> PtrString
sLit String
"fcmp")
                           Format
format Reg
reg1 Reg
reg2

   FDIV Format
format Reg
reg1 Reg
reg2 Reg
reg3
        -> PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"fdiv") Format
format Reg
reg1 Reg
reg2 Reg
reg3

   FMOV Format
format Reg
reg1 Reg
reg2
        -> PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"fmov") Format
format Reg
reg1 Reg
reg2

   FMUL Format
format Reg
reg1 Reg
reg2 Reg
reg3
        -> PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"fmul") Format
format Reg
reg1 Reg
reg2 Reg
reg3

   FNEG Format
format Reg
reg1 Reg
reg2
        -> PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"fneg") Format
format Reg
reg1 Reg
reg2

   FSQRT Format
format Reg
reg1 Reg
reg2
        -> PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"fsqrt") Format
format Reg
reg1 Reg
reg2

   FSUB Format
format Reg
reg1 Reg
reg2 Reg
reg3
        -> PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"fsub") Format
format Reg
reg1 Reg
reg2 Reg
reg3

   FxTOy Format
format1 Format
format2 Reg
reg1 Reg
reg2
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tf",
            PtrString -> SDoc
ptext
            (case Format
format1 of
                Format
II32  -> String -> PtrString
sLit String
"ito"
                Format
FF32  -> String -> PtrString
sLit String
"sto"
                Format
FF64  -> String -> PtrString
sLit String
"dto"
                Format
_     -> String -> PtrString
forall a. String -> a
panic String
"SPARC.Ppr.pprInstr.FxToY: no match"),
            PtrString -> SDoc
ptext
            (case Format
format2 of
                Format
II32  -> String -> PtrString
sLit String
"i\t"
                Format
II64  -> String -> PtrString
sLit String
"x\t"
                Format
FF32  -> String -> PtrString
sLit String
"s\t"
                Format
FF64  -> String -> PtrString
sLit String
"d\t"
                Format
_     -> String -> PtrString
forall a. String -> a
panic String
"SPARC.Ppr.pprInstr.FxToY: no match"),
            Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2
         ]


   BI Cond
cond Bool
b BlockId
blockid
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tb", Cond -> SDoc
pprCond Cond
cond,
            if Bool
b then SDoc
pp_comma_a else SDoc
empty,
            Char -> SDoc
char Char
'\t',
            Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (BlockId -> CLabel
blockLbl BlockId
blockid)
         ]

   BF Cond
cond Bool
b BlockId
blockid
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tfb", Cond -> SDoc
pprCond Cond
cond,
            if Bool
b then SDoc
pp_comma_a else SDoc
empty,
            Char -> SDoc
char Char
'\t',
            Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (BlockId -> CLabel
blockLbl BlockId
blockid)
         ]

   JMP AddrMode
addr -> String -> SDoc
text String
"\tjmp\t" SDoc -> SDoc -> SDoc
<> Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
   JMP_TBL AddrMode
op [Maybe BlockId]
_ CLabel
_ -> Platform -> Instr -> SDoc
pprInstr Platform
platform (AddrMode -> Instr
JMP AddrMode
op)

   CALL (Left Imm
imm) Int
n Bool
_
      -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tcall\t", Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm, SDoc
comma, Int -> SDoc
int Int
n ]

   CALL (Right Reg
reg) Int
n Bool
_
      -> [SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\tcall\t", Reg -> SDoc
pprReg Reg
reg, SDoc
comma, Int -> SDoc
int Int
n ]


-- | Pretty print a RI
pprRI :: Platform -> RI -> SDoc
pprRI :: Platform -> RI -> SDoc
pprRI Platform
platform = \case
   RIReg Reg
r -> Reg -> SDoc
pprReg Reg
r
   RIImm Imm
r -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
r


-- | Pretty print a two reg instruction.
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg PtrString
name Format
format Reg
reg1 Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char Char
'\t',
        PtrString -> SDoc
ptext PtrString
name,
        (case Format
format of
            Format
FF32 -> String -> SDoc
text String
"s\t"
            Format
FF64 -> String -> SDoc
text String
"d\t"
            Format
_    -> String -> SDoc
forall a. String -> a
panic String
"SPARC.Ppr.pprFormatRegReg: no match"),

        Reg -> SDoc
pprReg Reg
reg1,
        SDoc
comma,
        Reg -> SDoc
pprReg Reg
reg2
    ]


-- | Pretty print a three reg instruction.
pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg PtrString
name Format
format Reg
reg1 Reg
reg2 Reg
reg3
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char Char
'\t',
        PtrString -> SDoc
ptext PtrString
name,
        (case Format
format of
            Format
FF32  -> String -> SDoc
text String
"s\t"
            Format
FF64  -> String -> SDoc
text String
"d\t"
            Format
_    -> String -> SDoc
forall a. String -> a
panic String
"SPARC.Ppr.pprFormatRegReg: no match"),
        Reg -> SDoc
pprReg Reg
reg1,
        SDoc
comma,
        Reg -> SDoc
pprReg Reg
reg2,
        SDoc
comma,
        Reg -> SDoc
pprReg Reg
reg3
    ]


-- | Pretty print an instruction of two regs and a ri.
pprRegRIReg :: Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg :: Platform -> PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg Platform
platform PtrString
name Bool
b Reg
reg1 RI
ri Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char Char
'\t',
        PtrString -> SDoc
ptext PtrString
name,
        if Bool
b then String -> SDoc
text String
"cc\t" else Char -> SDoc
char Char
'\t',
        Reg -> SDoc
pprReg Reg
reg1,
        SDoc
comma,
        Platform -> RI -> SDoc
pprRI Platform
platform RI
ri,
        SDoc
comma,
        Reg -> SDoc
pprReg Reg
reg2
    ]

{-
pprRIReg :: PtrString -> Bool -> RI -> Reg -> SDoc
pprRIReg name b ri reg1
  = hcat [
        char '\t',
        ptext name,
        if b then text "cc\t" else char '\t',
        pprRI ri,
        comma,
        pprReg reg1
    ]
-}

{-
pp_ld_lbracket :: SDoc
pp_ld_lbracket    = text "\tld\t["
-}

pp_rbracket_comma :: SDoc
pp_rbracket_comma :: SDoc
pp_rbracket_comma = String -> SDoc
text String
"],"


pp_comma_lbracket :: SDoc
pp_comma_lbracket :: SDoc
pp_comma_lbracket = String -> SDoc
text String
",["


pp_comma_a :: SDoc
pp_comma_a :: SDoc
pp_comma_a        = String -> SDoc
text String
",a"