{-# LANGUAGE CPP #-}

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

{-# OPTIONS_GHC -fno-warn-orphans #-}

module SPARC.Ppr (
        pprNatCmmDecl,
        pprBasicBlock,
        pprData,
        pprInstr,
        pprFormat,
        pprImm,
        pprDataItem
)

where

#include "HsVersions.h"
#include "nativeGen/NCG.h"

import GhcPrelude

import SPARC.Regs
import SPARC.Instr
import SPARC.Cond
import SPARC.Imm
import SPARC.AddrMode
import SPARC.Base
import Instruction
import Reg
import Format
import PprBase

import Cmm hiding (topInfoTable)
import PprCmm()
import BlockId
import CLabel
import Hoopl.Label
import Hoopl.Collections

import Unique           ( pprUniqueAlways )
import Outputable
import Platform
import FastString
import Data.Word

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

pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
pprNatCmmDecl (CmmData section :: Section
section dats :: CmmStatics
dats) =
  Section -> SDoc
pprSectionAlign Section
section SDoc -> SDoc -> SDoc
$$ CmmStatics -> SDoc
pprDatas CmmStatics
dats

pprNatCmmDecl proc :: NatCmmDecl CmmStatics Instr
proc@(CmmProc top_info :: LabelMap CmmStatics
top_info lbl :: CLabel
lbl _ (ListGraph blocks :: [GenBasicBlock Instr]
blocks)) =
  case NatCmmDecl CmmStatics Instr -> Maybe CmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl CmmStatics Instr
proc of
    Nothing ->
       case [GenBasicBlock Instr]
blocks of
         []     -> -- special case for split markers:
           CLabel -> SDoc
pprLabel CLabel
lbl
         blocks :: [GenBasicBlock Instr]
blocks -> -- special case for code without info table:
           Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) SDoc -> SDoc -> SDoc
$$
           CLabel -> SDoc
pprLabel 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 (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
top_info) [GenBasicBlock Instr]
blocks)

    Just (Statics info_lbl :: CLabel
info_lbl _) ->
      (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
          then Section -> SDoc
pprSectionAlign Section
dspSection SDoc -> SDoc -> SDoc
$$
               CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':'
          else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
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 "\t.long "
            SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
info_lbl
            SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '-'
            SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (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 "subsections-via-symbols doesn't combine with split-sections"

pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock :: LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock info_env :: LabelMap CmmStatics
info_env (BasicBlock blockid :: BlockId
blockid instrs :: [Instr]
instrs)
  = SDoc
maybe_infotable SDoc -> SDoc -> SDoc
$$
    CLabel -> SDoc
pprLabel (BlockId -> CLabel
blockLbl BlockId
blockid) SDoc -> SDoc -> SDoc
$$
    [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Instr -> SDoc
pprInstr [Instr]
instrs)
  where
    maybe_infotable :: SDoc
maybe_infotable = case KeyOf LabelMap -> LabelMap CmmStatics -> Maybe CmmStatics
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockid LabelMap CmmStatics
info_env of
       Nothing   -> SDoc
empty
       Just (Statics info_lbl :: CLabel
info_lbl info :: [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 CmmStatic -> SDoc
pprData [CmmStatic]
info) SDoc -> SDoc -> SDoc
$$
           CLabel -> SDoc
pprLabel CLabel
info_lbl


pprDatas :: CmmStatics -> SDoc
pprDatas :: CmmStatics -> SDoc
pprDatas (Statics lbl :: CLabel
lbl dats :: [CmmStatic]
dats) = [SDoc] -> SDoc
vcat (CLabel -> SDoc
pprLabel CLabel
lbl SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> SDoc
pprData [CmmStatic]
dats)

pprData :: CmmStatic -> SDoc
pprData :: CmmStatic -> SDoc
pprData (CmmString str :: [Word8]
str)
  = [SDoc] -> SDoc
vcat ((Word8 -> SDoc) -> [Word8] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> SDoc
do1 [Word8]
str) SDoc -> SDoc -> SDoc
$$ Word8 -> SDoc
do1 0
    where
       do1 :: Word8 -> SDoc
       do1 :: Word8 -> SDoc
do1 w :: Word8
w = String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w)
pprData (CmmUninitialised bytes :: Int
bytes) = String -> SDoc
text ".skip " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
pprData (CmmStaticLit lit :: CmmLit
lit)       = CmmLit -> SDoc
pprDataItem CmmLit
lit

pprGloblDecl :: CLabel -> SDoc
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl lbl :: CLabel
lbl
  | Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = SDoc
empty
  | Bool
otherwise = String -> SDoc
text ".global " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl

pprTypeAndSizeDecl :: CLabel -> SDoc
pprTypeAndSizeDecl :: CLabel -> SDoc
pprTypeAndSizeDecl lbl :: CLabel
lbl
    = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
      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 ".type " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit ", @object")
      else SDoc
empty

pprLabel :: CLabel -> SDoc
pprLabel :: CLabel -> SDoc
pprLabel lbl :: CLabel
lbl = CLabel -> SDoc
pprGloblDecl CLabel
lbl
            SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
pprTypeAndSizeDecl CLabel
lbl
            SDoc -> SDoc -> SDoc
$$ (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':')

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

instance Outputable Instr where
    ppr :: Instr -> SDoc
ppr instr :: Instr
instr = Instr -> SDoc
pprInstr Instr
instr


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

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

                RealRegPair r1 :: Int
r1 r2 :: Int
r2
                 -> String -> SDoc
text "(" 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 ")"



-- | 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 i :: Int
i
 = PtrString -> SDoc
ptext
    (case Int
i of {
         0 -> String -> PtrString
sLit "%g0";   1 -> String -> PtrString
sLit "%g1";
         2 -> String -> PtrString
sLit "%g2";   3 -> String -> PtrString
sLit "%g3";
         4 -> String -> PtrString
sLit "%g4";   5 -> String -> PtrString
sLit "%g5";
         6 -> String -> PtrString
sLit "%g6";   7 -> String -> PtrString
sLit "%g7";
         8 -> String -> PtrString
sLit "%o0";   9 -> String -> PtrString
sLit "%o1";
        10 -> String -> PtrString
sLit "%o2";  11 -> String -> PtrString
sLit "%o3";
        12 -> String -> PtrString
sLit "%o4";  13 -> String -> PtrString
sLit "%o5";
        14 -> String -> PtrString
sLit "%o6";  15 -> String -> PtrString
sLit "%o7";
        16 -> String -> PtrString
sLit "%l0";  17 -> String -> PtrString
sLit "%l1";
        18 -> String -> PtrString
sLit "%l2";  19 -> String -> PtrString
sLit "%l3";
        20 -> String -> PtrString
sLit "%l4";  21 -> String -> PtrString
sLit "%l5";
        22 -> String -> PtrString
sLit "%l6";  23 -> String -> PtrString
sLit "%l7";
        24 -> String -> PtrString
sLit "%i0";  25 -> String -> PtrString
sLit "%i1";
        26 -> String -> PtrString
sLit "%i2";  27 -> String -> PtrString
sLit "%i3";
        28 -> String -> PtrString
sLit "%i4";  29 -> String -> PtrString
sLit "%i5";
        30 -> String -> PtrString
sLit "%i6";  31 -> String -> PtrString
sLit "%i7";
        32 -> String -> PtrString
sLit "%f0";  33 -> String -> PtrString
sLit "%f1";
        34 -> String -> PtrString
sLit "%f2";  35 -> String -> PtrString
sLit "%f3";
        36 -> String -> PtrString
sLit "%f4";  37 -> String -> PtrString
sLit "%f5";
        38 -> String -> PtrString
sLit "%f6";  39 -> String -> PtrString
sLit "%f7";
        40 -> String -> PtrString
sLit "%f8";  41 -> String -> PtrString
sLit "%f9";
        42 -> String -> PtrString
sLit "%f10"; 43 -> String -> PtrString
sLit "%f11";
        44 -> String -> PtrString
sLit "%f12"; 45 -> String -> PtrString
sLit "%f13";
        46 -> String -> PtrString
sLit "%f14"; 47 -> String -> PtrString
sLit "%f15";
        48 -> String -> PtrString
sLit "%f16"; 49 -> String -> PtrString
sLit "%f17";
        50 -> String -> PtrString
sLit "%f18"; 51 -> String -> PtrString
sLit "%f19";
        52 -> String -> PtrString
sLit "%f20"; 53 -> String -> PtrString
sLit "%f21";
        54 -> String -> PtrString
sLit "%f22"; 55 -> String -> PtrString
sLit "%f23";
        56 -> String -> PtrString
sLit "%f24"; 57 -> String -> PtrString
sLit "%f25";
        58 -> String -> PtrString
sLit "%f26"; 59 -> String -> PtrString
sLit "%f27";
        60 -> String -> PtrString
sLit "%f28"; 61 -> String -> PtrString
sLit "%f29";
        62 -> String -> PtrString
sLit "%f30"; 63 -> String -> PtrString
sLit "%f31";
        _  -> String -> PtrString
sLit "very naughty sparc register" })


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


-- | 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 x :: Format
x
 = PtrString -> SDoc
ptext
    (case Format
x of
        II8   -> String -> PtrString
sLit "b"
        II16  -> String -> PtrString
sLit "h"
        II32  -> String -> PtrString
sLit ""
        II64  -> String -> PtrString
sLit "x"
        FF32  -> String -> PtrString
sLit ""
        FF64  -> String -> PtrString
sLit "d"
        _       -> String -> PtrString
forall a. String -> a
panic "SPARC.Ppr.pprFormat: no match")


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


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

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

        AddrRegImm r1 :: Reg
r1 (ImmInt i :: Int
i)
         | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
> 0 then Char -> SDoc
char '+' else SDoc
empty

        AddrRegImm r1 :: Reg
r1 (ImmInteger i :: Integer
i)
         | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 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
> 0 then Char -> SDoc
char '+' else SDoc
empty

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


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

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

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

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

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

        -- these should have been converted to bytes and placed
        --      in the data section.
        ImmFloat _      -> String -> SDoc
text "naughty float immediate"
        ImmDouble _     -> String -> SDoc
text "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 :: Section -> SDoc
pprSectionAlign :: Section -> SDoc
pprSectionAlign sec :: Section
sec@(Section seg :: SectionType
seg _) =
  (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    Platform -> Section -> SDoc
pprSectionHeader Platform
platform 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 seg :: SectionType
seg =
    PtrString -> SDoc
ptext (case SectionType
seg of
      Text              -> String -> PtrString
sLit ".align 4"
      Data              -> String -> PtrString
sLit ".align 8"
      ReadOnlyData      -> String -> PtrString
sLit ".align 8"
      RelocatableReadOnlyData
                        -> String -> PtrString
sLit ".align 8"
      UninitialisedData -> String -> PtrString
sLit ".align 8"
      ReadOnlyData16    -> String -> PtrString
sLit ".align 16"
      -- TODO: This is copied from the ReadOnlyData case, but it can likely be
      -- made more efficient.
      CString           -> String -> PtrString
sLit ".align 8"
      OtherSection _    -> String -> PtrString
forall a. String -> a
panic "PprMach.pprSectionHeader: unknown section")

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

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

        ppr_item FF32  (CmmFloat r :: Rational
r _)
         = 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 (\b :: Int
b -> String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs

        ppr_item FF64 (CmmFloat r :: Rational
r _)
         = 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 (\b :: Int
b -> String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs

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


-- | Pretty print an instruction.
pprInstr :: Instr -> SDoc

-- nuke comments.
pprInstr :: Instr -> SDoc
pprInstr (COMMENT _)
        = SDoc
empty

pprInstr (DELTA d :: Int
d)
        = Instr -> SDoc
pprInstr (FastString -> Instr
COMMENT (String -> FastString
mkFastString ("\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.
pprInstr (NEWBLOCK _)
        = String -> SDoc
forall a. String -> a
panic "X86.Ppr.pprInstr: NEWBLOCK"

pprInstr (LDATA _ _)
        = String -> SDoc
forall a. String -> a
panic "PprMach.pprInstr: LDATA"

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

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

-- 64 bit FP stores are expanded into individual instructions in CodeGen.Expand
pprInstr (ST FF64 reg :: Reg
reg _)
        | RegReal (RealRegSingle{}) <- Reg
reg
        = String -> SDoc
forall a. String -> a
panic "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..
pprInstr (ST format :: Format
format reg :: Reg
reg addr :: AddrMode
addr)
        = [SDoc] -> SDoc
hcat [
               String -> SDoc
text "\tst",
               Format -> SDoc
pprStFormat Format
format,
               Char -> SDoc
char '\t',
               Reg -> SDoc
pprReg Reg
reg,
               SDoc
pp_comma_lbracket,
               AddrMode -> SDoc
pprAddr AddrMode
addr,
               SDoc
rbrack
            ]


pprInstr (ADD x :: Bool
x cc :: Bool
cc reg1 :: Reg
reg1 ri :: RI
ri reg2 :: 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 "\tmov\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]

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


pprInstr (SUB x :: Bool
x cc :: Bool
cc reg1 :: Reg
reg1 ri :: RI
ri reg2 :: 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 "\tcmp\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, RI -> SDoc
pprRI 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 "\tmov\t", Reg -> SDoc
pprReg Reg
reg1, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]

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

pprInstr (AND  b :: Bool
b reg1 :: Reg
reg1 ri :: RI
ri reg2 :: Reg
reg2) = PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg (String -> PtrString
sLit "and")  Bool
b Reg
reg1 RI
ri Reg
reg2

pprInstr (ANDN b :: Bool
b reg1 :: Reg
reg1 ri :: RI
ri reg2 :: Reg
reg2) = PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg (String -> PtrString
sLit "andn") Bool
b Reg
reg1 RI
ri Reg
reg2

pprInstr (OR b :: Bool
b reg1 :: Reg
reg1 ri :: RI
ri reg2 :: 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 "\tmov\t", RI -> SDoc
pprRI RI
ri, SDoc
comma, Reg -> SDoc
pprReg Reg
reg2 ]
          in  case RI
ri of
                   RIReg rrr :: Reg
rrr | Reg
rrr Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2 -> SDoc
empty
                   _                       -> SDoc
doit

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

pprInstr (ORN b :: Bool
b reg1 :: Reg
reg1 ri :: RI
ri reg2 :: Reg
reg2)  = PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg (String -> PtrString
sLit "orn") Bool
b Reg
reg1 RI
ri Reg
reg2

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

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

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

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

pprInstr (SETHI imm :: Imm
imm reg :: Reg
reg)
  = [SDoc] -> SDoc
hcat [
        String -> SDoc
text "\tsethi\t",
        Imm -> SDoc
pprImm Imm
imm,
        SDoc
comma,
        Reg -> SDoc
pprReg Reg
reg
    ]

pprInstr NOP
        = String -> SDoc
text "\tnop"

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

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

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

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

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

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

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

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

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

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


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

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

pprInstr (JMP addr :: AddrMode
addr) = String -> SDoc
text "\tjmp\t" SDoc -> SDoc -> SDoc
<> AddrMode -> SDoc
pprAddr AddrMode
addr
pprInstr (JMP_TBL op :: AddrMode
op _ _)  = Instr -> SDoc
pprInstr (AddrMode -> Instr
JMP AddrMode
op)

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

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


-- | Pretty print a RI
pprRI :: RI -> SDoc
pprRI :: RI -> SDoc
pprRI (RIReg r :: Reg
r) = Reg -> SDoc
pprReg Reg
r
pprRI (RIImm r :: Imm
r) = Imm -> SDoc
pprImm Imm
r


-- | Pretty print a two reg instruction.
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg name :: PtrString
name format :: Format
format reg1 :: Reg
reg1 reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        (case Format
format of
            FF32 -> String -> SDoc
text "s\t"
            FF64 -> String -> SDoc
text "d\t"
            _    -> String -> SDoc
forall a. String -> a
panic "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 name :: PtrString
name format :: Format
format reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        (case Format
format of
            FF32  -> String -> SDoc
text "s\t"
            FF64  -> String -> SDoc
text "d\t"
            _    -> String -> SDoc
forall a. String -> a
panic "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 :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg :: PtrString -> Bool -> Reg -> RI -> Reg -> SDoc
pprRegRIReg name :: PtrString
name b :: Bool
b reg1 :: Reg
reg1 ri :: RI
ri reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        if Bool
b then String -> SDoc
text "cc\t" else Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        SDoc
comma,
        RI -> SDoc
pprRI 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 "],"


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


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