{-# LANGUAGE CPP #-}

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

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

where

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

import GhcPrelude

import X86.Regs
import X86.Instr
import X86.Cond
import Instruction
import Format
import Reg
import PprBase


import Hoopl.Collections
import Hoopl.Label
import BasicTypes       (Alignment)
import DynFlags
import Cmm              hiding (topInfoTable)
import BlockId
import CLabel
import Unique           ( pprUniqueAlways )
import Platform
import FastString
import Outputable

import Data.Word

import Data.Bits

-- -----------------------------------------------------------------------------
-- Printing this stuff out
--
--
-- Note [Subsections Via Symbols]
--
-- If we are using the .subsections_via_symbols directive
-- (available on recent versions of Darwin),
-- we have to make sure that there is some kind of reference
-- from the entry code to a label on the _top_ of of the info table,
-- so that the linker will not think it is unreferenced and dead-strip
-- it. That's why the label is called a DeadStripPreventer (_dsp).
--
-- The LLVM code gen already creates `iTableSuf` symbols, where
-- the X86 would generate the DeadStripPreventer (_dsp) symbol.
-- Therefore all that is left for llvm code gen, is to ensure
-- that all the `iTableSuf` symbols are marked as used.
-- As of this writing the documentation regarding the
-- .subsections_via_symbols and -dead_strip can be found at
-- <https://developer.apple.com/library/mac/documentation/DeveloperTools/Reference/Assembler/040-Assembler_Directives/asm_directives.html#//apple_ref/doc/uid/TP30000823-TPXREF101>

pprProcAlignment :: SDoc
pprProcAlignment :: SDoc
pprProcAlignment = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
  (SDoc -> (Int -> SDoc) -> Maybe Int -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty Int -> SDoc
pprAlign (Maybe Int -> SDoc) -> (DynFlags -> Maybe Int) -> DynFlags -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Maybe Int
cmmProcAlignment (DynFlags -> SDoc) -> DynFlags -> SDoc
forall a b. (a -> b) -> a -> b
$ DynFlags
dflags)

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

pprNatCmmDecl proc :: NatCmmDecl (Int, CmmStatics) Instr
proc@(CmmProc top_info :: LabelMap CmmStatics
top_info lbl :: CLabel
lbl _ (ListGraph blocks :: [GenBasicBlock Instr]
blocks)) =
  (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
  SDoc
pprProcAlignment SDoc -> SDoc -> SDoc
$$
  case NatCmmDecl (Int, CmmStatics) Instr -> Maybe CmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl (Int, 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
$$
           SDoc
pprProcAlignment 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) SDoc -> SDoc -> SDoc
$$
           (if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
            then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':' else SDoc
empty) SDoc -> SDoc -> SDoc
$$
           CLabel -> SDoc
pprSizeDecl CLabel
lbl

    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 ->
      Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
info_lbl) SDoc -> SDoc -> SDoc
$$
      SDoc
pprProcAlignment SDoc -> SDoc -> SDoc
$$
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
          then 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]
                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) SDoc -> SDoc -> SDoc
$$
      CLabel -> SDoc
pprSizeDecl CLabel
info_lbl

-- | Output the ELF .size directive.
pprSizeDecl :: CLabel -> SDoc
pprSizeDecl :: CLabel -> SDoc
pprSizeDecl lbl :: CLabel
lbl
 = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
   if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
   then String -> SDoc
text "\t.size" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit ", .-") SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
   else SDoc
empty

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)
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
    DynFlags -> SDoc -> SDoc
maybe_infotable DynFlags
dflags (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    CLabel -> SDoc
pprLabel CLabel
asmLbl SDoc -> SDoc -> SDoc
$$
    [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Instr -> SDoc
pprInstr [Instr]
instrs) SDoc -> SDoc -> SDoc
$$
    (if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
     then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
asmLbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':' else SDoc
empty)
  where
    asmLbl :: CLabel
asmLbl = BlockId -> CLabel
blockLbl BlockId
blockid
    maybe_infotable :: DynFlags -> SDoc -> SDoc
maybe_infotable dflags :: DynFlags
dflags c :: SDoc
c = 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
c
       Just (Statics infoLbl :: CLabel
infoLbl info :: [CmmStatic]
info) ->
           SectionType -> SDoc
pprAlignForSection SectionType
Text SDoc -> SDoc -> SDoc
$$
           SDoc
infoTableLoc 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
infoLbl SDoc -> SDoc -> SDoc
$$
           SDoc
c SDoc -> SDoc -> SDoc
$$
           (if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
            then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
infoLbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':' else SDoc
empty)
    -- Make sure the info table has the right .loc for the block
    -- coming right after it. See [Note: Info Offset]
    infoTableLoc :: SDoc
infoTableLoc = case [Instr]
instrs of
      (l :: Instr
l@LOCATION{} : _) -> Instr -> SDoc
pprInstr Instr
l
      _other :: [Instr]
_other             -> SDoc
empty

pprDatas :: (Alignment, CmmStatics) -> SDoc
pprDatas :: (Int, CmmStatics) -> SDoc
pprDatas (align :: Int
align, (Statics lbl :: CLabel
lbl dats :: [CmmStatic]
dats))
 = [SDoc] -> SDoc
vcat (Int -> SDoc
pprAlign Int
align SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: 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)
 = PtrString -> SDoc
ptext (String -> PtrString
sLit "\t.asciz ") SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
doubleQuotes ([Word8] -> SDoc
pprASCII [Word8]
str)

pprData (CmmUninitialised bytes :: Int
bytes)
 = (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
OSDarwin then String -> SDoc
text ".space " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
                                      else 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 ".globl " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl

pprLabelType' :: DynFlags -> CLabel -> SDoc
pprLabelType' :: DynFlags -> CLabel -> SDoc
pprLabelType' dflags :: DynFlags
dflags lbl :: CLabel
lbl =
  if CLabel -> Bool
isCFunctionLabel CLabel
lbl Bool -> Bool -> Bool
|| Bool
functionOkInfoTable then
    String -> SDoc
text "@function"
  else
    String -> SDoc
text "@object"
  where
    {-
    NOTE: This is a bit hacky.

    With the `tablesNextToCode` info tables look like this:
    ```
      <info table data>
    label_info:
      <info table code>
    ```
    So actually info table label points exactly to the code and we can mark
    the label as @function. (This is required to make perf and potentially other
    tools to work on Haskell binaries).
    This usually works well but it can cause issues with a linker.
    A linker uses different algorithms for the relocation depending on
    the symbol type.For some reason, a linker will generate JUMP_SLOT relocation
    when constructor info table is referenced from a data section.
    This only happens with static constructor call so
    we mark _con_info symbols as `@object` to avoid the issue with relocations.

    @SimonMarlow hack explanation:
    "The reasoning goes like this:

    * The danger when we mark a symbol as `@function` is that the linker will
      redirect it to point to the PLT and use a `JUMP_SLOT` relocation when
      the symbol refers to something outside the current shared object.
      A PLT / JUMP_SLOT reference only works for symbols that we jump to, not
      for symbols representing data,, nor for info table symbol references which
      we expect to point directly to the info table.
    * GHC generates code that might refer to any info table symbol from the text
      segment, but that's OK, because those will be explicit GOT references
      generated by the code generator.
    * When we refer to info tables from the data segment, it's either
      * a FUN_STATIC/THUNK_STATIC local to this module
      * a `con_info` that could be from anywhere

    So, the only info table symbols that we might refer to from the data segment
    of another shared object are `con_info` symbols, so those are the ones we
    need to exclude from getting the @function treatment.
    "

    A good place to check for more
    https://ghc.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode

    Another possible hack is to create an extra local function symbol for
    every code-like thing to give the needed information for to the tools
    but mess up with the relocation. https://phabricator.haskell.org/D4730
    -}
    functionOkInfoTable :: Bool
functionOkInfoTable = DynFlags -> Bool
tablesNextToCode DynFlags
dflags Bool -> Bool -> Bool
&&
      CLabel -> Bool
isInfoTableLabel CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (CLabel -> Bool
isConInfoTableLabel CLabel
lbl)


pprTypeDecl :: CLabel -> SDoc
pprTypeDecl :: CLabel -> SDoc
pprTypeDecl lbl :: CLabel
lbl
    = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
      if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
      then
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \df :: DynFlags
df ->
          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  ", ") SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprLabelType' DynFlags
df CLabel
lbl
      else SDoc
empty

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

pprAlign :: Int -> SDoc
pprAlign :: Int -> SDoc
pprAlign bytes :: Int
bytes
        = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
          String -> SDoc
text ".align " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Platform -> Int
alignment Platform
platform)
  where
        alignment :: Platform -> Int
alignment platform :: Platform
platform = if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
                             then Int -> Int
log2 Int
bytes
                             else      Int
bytes

        log2 :: Int -> Int  -- cache the common ones
        log2 :: Int -> Int
log2 1 = 0
        log2 2 = 1
        log2 4 = 2
        log2 8 = 3
        log2 n :: Int
n = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
log2 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` 2)

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

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


pprReg :: Format -> Reg -> SDoc
pprReg :: Format -> Reg -> SDoc
pprReg f :: Format
f r :: Reg
r
  = case Reg
r of
      RegReal    (RealRegSingle i :: Int
i) ->
          (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
          if Platform -> Bool
target32Bit Platform
platform then Format -> Int -> SDoc
ppr32_reg_no Format
f Int
i
                                  else Format -> Int -> SDoc
ppr64_reg_no Format
f Int
i
      RegReal    (RealRegPair _ _) -> String -> SDoc
forall a. String -> a
panic "X86.Ppr: no reg pairs on this arch"
      RegVirtual (VirtualRegI  u :: Unique
u)  -> String -> SDoc
text "%vI_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegHi u :: Unique
u)  -> String -> SDoc
text "%vHi_"  SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegF  u :: Unique
u)  -> String -> SDoc
text "%vF_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegD  u :: Unique
u)  -> String -> SDoc
text "%vD_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegSSE u :: Unique
u) -> String -> SDoc
text "%vSSE_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
  where
    ppr32_reg_no :: Format -> Int -> SDoc
    ppr32_reg_no :: Format -> Int -> SDoc
ppr32_reg_no II8   = Int -> SDoc
forall a. (Eq a, Num a, Show a) => a -> SDoc
ppr32_reg_byte
    ppr32_reg_no II16  = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr32_reg_word
    ppr32_reg_no _     = Int -> SDoc
ppr32_reg_long

    ppr32_reg_byte :: a -> SDoc
ppr32_reg_byte i :: a
i = PtrString -> SDoc
ptext
      (case a
i of {
         0 -> String -> PtrString
sLit "%al";     1 -> String -> PtrString
sLit "%bl";
         2 -> String -> PtrString
sLit "%cl";     3 -> String -> PtrString
sLit "%dl";
        _  -> String -> PtrString
sLit (String -> PtrString) -> String -> PtrString
forall a b. (a -> b) -> a -> b
$ "very naughty I386 byte register: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
      })

    ppr32_reg_word :: a -> SDoc
ppr32_reg_word i :: a
i = PtrString -> SDoc
ptext
      (case a
i of {
         0 -> String -> PtrString
sLit "%ax";     1 -> String -> PtrString
sLit "%bx";
         2 -> String -> PtrString
sLit "%cx";     3 -> String -> PtrString
sLit "%dx";
         4 -> String -> PtrString
sLit "%si";     5 -> String -> PtrString
sLit "%di";
         6 -> String -> PtrString
sLit "%bp";     7 -> String -> PtrString
sLit "%sp";
        _  -> String -> PtrString
sLit "very naughty I386 word register"
      })

    ppr32_reg_long :: Int -> SDoc
ppr32_reg_long i :: Int
i = PtrString -> SDoc
ptext
      (case Int
i of {
         0 -> String -> PtrString
sLit "%eax";    1 -> String -> PtrString
sLit "%ebx";
         2 -> String -> PtrString
sLit "%ecx";    3 -> String -> PtrString
sLit "%edx";
         4 -> String -> PtrString
sLit "%esi";    5 -> String -> PtrString
sLit "%edi";
         6 -> String -> PtrString
sLit "%ebp";    7 -> String -> PtrString
sLit "%esp";
         _  -> Int -> PtrString
ppr_reg_float Int
i
      })

    ppr64_reg_no :: Format -> Int -> SDoc
    ppr64_reg_no :: Format -> Int -> SDoc
ppr64_reg_no II8   = Int -> SDoc
forall a. (Eq a, Num a, Show a) => a -> SDoc
ppr64_reg_byte
    ppr64_reg_no II16  = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr64_reg_word
    ppr64_reg_no II32  = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr64_reg_long
    ppr64_reg_no _     = Int -> SDoc
ppr64_reg_quad

    ppr64_reg_byte :: a -> SDoc
ppr64_reg_byte i :: a
i = PtrString -> SDoc
ptext
      (case a
i of {
         0 -> String -> PtrString
sLit "%al";     1 -> String -> PtrString
sLit "%bl";
         2 -> String -> PtrString
sLit "%cl";     3 -> String -> PtrString
sLit "%dl";
         4 -> String -> PtrString
sLit "%sil";    5 -> String -> PtrString
sLit "%dil"; -- new 8-bit regs!
         6 -> String -> PtrString
sLit "%bpl";    7 -> String -> PtrString
sLit "%spl";
         8 -> String -> PtrString
sLit "%r8b";    9  -> String -> PtrString
sLit "%r9b";
        10 -> String -> PtrString
sLit "%r10b";   11 -> String -> PtrString
sLit "%r11b";
        12 -> String -> PtrString
sLit "%r12b";   13 -> String -> PtrString
sLit "%r13b";
        14 -> String -> PtrString
sLit "%r14b";   15 -> String -> PtrString
sLit "%r15b";
        _  -> String -> PtrString
sLit (String -> PtrString) -> String -> PtrString
forall a b. (a -> b) -> a -> b
$ "very naughty x86_64 byte register: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
      })

    ppr64_reg_word :: a -> SDoc
ppr64_reg_word i :: a
i = PtrString -> SDoc
ptext
      (case a
i of {
         0 -> String -> PtrString
sLit "%ax";     1 -> String -> PtrString
sLit "%bx";
         2 -> String -> PtrString
sLit "%cx";     3 -> String -> PtrString
sLit "%dx";
         4 -> String -> PtrString
sLit "%si";     5 -> String -> PtrString
sLit "%di";
         6 -> String -> PtrString
sLit "%bp";     7 -> String -> PtrString
sLit "%sp";
         8 -> String -> PtrString
sLit "%r8w";    9  -> String -> PtrString
sLit "%r9w";
        10 -> String -> PtrString
sLit "%r10w";   11 -> String -> PtrString
sLit "%r11w";
        12 -> String -> PtrString
sLit "%r12w";   13 -> String -> PtrString
sLit "%r13w";
        14 -> String -> PtrString
sLit "%r14w";   15 -> String -> PtrString
sLit "%r15w";
        _  -> String -> PtrString
sLit "very naughty x86_64 word register"
      })

    ppr64_reg_long :: a -> SDoc
ppr64_reg_long i :: a
i = PtrString -> SDoc
ptext
      (case a
i of {
         0 -> String -> PtrString
sLit "%eax";    1  -> String -> PtrString
sLit "%ebx";
         2 -> String -> PtrString
sLit "%ecx";    3  -> String -> PtrString
sLit "%edx";
         4 -> String -> PtrString
sLit "%esi";    5  -> String -> PtrString
sLit "%edi";
         6 -> String -> PtrString
sLit "%ebp";    7  -> String -> PtrString
sLit "%esp";
         8 -> String -> PtrString
sLit "%r8d";    9  -> String -> PtrString
sLit "%r9d";
        10 -> String -> PtrString
sLit "%r10d";   11 -> String -> PtrString
sLit "%r11d";
        12 -> String -> PtrString
sLit "%r12d";   13 -> String -> PtrString
sLit "%r13d";
        14 -> String -> PtrString
sLit "%r14d";   15 -> String -> PtrString
sLit "%r15d";
        _  -> String -> PtrString
sLit "very naughty x86_64 register"
      })

    ppr64_reg_quad :: Int -> SDoc
ppr64_reg_quad i :: Int
i = PtrString -> SDoc
ptext
      (case Int
i of {
         0 -> String -> PtrString
sLit "%rax";      1 -> String -> PtrString
sLit "%rbx";
         2 -> String -> PtrString
sLit "%rcx";      3 -> String -> PtrString
sLit "%rdx";
         4 -> String -> PtrString
sLit "%rsi";      5 -> String -> PtrString
sLit "%rdi";
         6 -> String -> PtrString
sLit "%rbp";      7 -> String -> PtrString
sLit "%rsp";
         8 -> String -> PtrString
sLit "%r8";       9 -> String -> PtrString
sLit "%r9";
        10 -> String -> PtrString
sLit "%r10";    11 -> String -> PtrString
sLit "%r11";
        12 -> String -> PtrString
sLit "%r12";    13 -> String -> PtrString
sLit "%r13";
        14 -> String -> PtrString
sLit "%r14";    15 -> String -> PtrString
sLit "%r15";
        _  -> Int -> PtrString
ppr_reg_float Int
i
      })

ppr_reg_float :: Int -> PtrString
ppr_reg_float :: Int -> PtrString
ppr_reg_float i :: Int
i = case Int
i of
        16 -> String -> PtrString
sLit "%fake0";  17 -> String -> PtrString
sLit "%fake1"
        18 -> String -> PtrString
sLit "%fake2";  19 -> String -> PtrString
sLit "%fake3"
        20 -> String -> PtrString
sLit "%fake4";  21 -> String -> PtrString
sLit "%fake5"
        24 -> String -> PtrString
sLit "%xmm0";   25 -> String -> PtrString
sLit "%xmm1"
        26 -> String -> PtrString
sLit "%xmm2";   27 -> String -> PtrString
sLit "%xmm3"
        28 -> String -> PtrString
sLit "%xmm4";   29 -> String -> PtrString
sLit "%xmm5"
        30 -> String -> PtrString
sLit "%xmm6";   31 -> String -> PtrString
sLit "%xmm7"
        32 -> String -> PtrString
sLit "%xmm8";   33 -> String -> PtrString
sLit "%xmm9"
        34 -> String -> PtrString
sLit "%xmm10";  35 -> String -> PtrString
sLit "%xmm11"
        36 -> String -> PtrString
sLit "%xmm12";  37 -> String -> PtrString
sLit "%xmm13"
        38 -> String -> PtrString
sLit "%xmm14";  39 -> String -> PtrString
sLit "%xmm15"
        _  -> String -> PtrString
sLit "very naughty x86 register"

pprFormat :: Format -> SDoc
pprFormat :: Format -> SDoc
pprFormat x :: Format
x
 = PtrString -> SDoc
ptext (case Format
x of
                II8   -> String -> PtrString
sLit "b"
                II16  -> String -> PtrString
sLit "w"
                II32  -> String -> PtrString
sLit "l"
                II64  -> String -> PtrString
sLit "q"
                FF32  -> String -> PtrString
sLit "ss"      -- "scalar single-precision float" (SSE2)
                FF64  -> String -> PtrString
sLit "sd"      -- "scalar double-precision float" (SSE2)
                FF80  -> String -> PtrString
sLit "t"
                )

pprFormat_x87 :: Format -> SDoc
pprFormat_x87 :: Format -> SDoc
pprFormat_x87 x :: Format
x
  = PtrString -> SDoc
ptext (PtrString -> SDoc) -> PtrString -> SDoc
forall a b. (a -> b) -> a -> b
$ case Format
x of
                FF32  -> String -> PtrString
sLit "s"
                FF64  -> String -> PtrString
sLit "l"
                FF80  -> String -> PtrString
sLit "t"
                _     -> String -> PtrString
forall a. String -> a
panic "X86.Ppr.pprFormat_x87"

pprCond :: Cond -> SDoc
pprCond :: Cond -> SDoc
pprCond c :: Cond
c
 = PtrString -> SDoc
ptext (case Cond
c of {
                GEU     -> String -> PtrString
sLit "ae";   LU    -> String -> PtrString
sLit "b";
                EQQ     -> String -> PtrString
sLit "e";    GTT   -> String -> PtrString
sLit "g";
                GE      -> String -> PtrString
sLit "ge";   GU    -> String -> PtrString
sLit "a";
                LTT     -> String -> PtrString
sLit "l";    LE    -> String -> PtrString
sLit "le";
                LEU     -> String -> PtrString
sLit "be";   NE    -> String -> PtrString
sLit "ne";
                NEG     -> String -> PtrString
sLit "s";    POS   -> String -> PtrString
sLit "ns";
                CARRY   -> String -> PtrString
sLit "c";   OFLO  -> String -> PtrString
sLit "o";
                PARITY  -> String -> PtrString
sLit "p";   NOTPARITY -> String -> PtrString
sLit "np";
                ALWAYS  -> String -> PtrString
sLit "mp"})


pprImm :: Imm -> SDoc
pprImm :: Imm -> SDoc
pprImm (ImmInt i :: Int
i)     = Int -> SDoc
int Int
i
pprImm (ImmInteger i :: Integer
i) = Integer -> SDoc
integer Integer
i
pprImm (ImmCLbl l :: CLabel
l)    = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l
pprImm (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
pprImm (ImmLit s :: SDoc
s)     = SDoc
s

pprImm (ImmFloat _)  = String -> SDoc
text "naughty float immediate"
pprImm (ImmDouble _) = String -> SDoc
text "naughty double immediate"

pprImm (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
pprImm (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



pprAddr :: AddrMode -> SDoc
pprAddr :: AddrMode -> SDoc
pprAddr (ImmAddr imm :: Imm
imm off :: Int
off)
  = let pp_imm :: SDoc
pp_imm = Imm -> SDoc
pprImm Imm
imm
    in
    if (Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) then
        SDoc
pp_imm
    else if (Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0) then
        SDoc
pp_imm SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
off
    else
        SDoc
pp_imm SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
off

pprAddr (AddrBaseIndex base :: EABase
base index :: EAIndex
index displacement :: Imm
displacement)
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    let
        pp_disp :: SDoc
pp_disp  = Imm -> SDoc
ppr_disp Imm
displacement
        pp_off :: SDoc -> SDoc
pp_off p :: SDoc
p = SDoc
pp_disp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '(' SDoc -> SDoc -> SDoc
<> SDoc
p SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ')'
        pp_reg :: Reg -> SDoc
pp_reg r :: Reg
r = Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
r
    in
    case (EABase
base, EAIndex
index) of
      (EABaseNone,  EAIndexNone) -> SDoc
pp_disp
      (EABaseReg b :: Reg
b, EAIndexNone) -> SDoc -> SDoc
pp_off (Reg -> SDoc
pp_reg Reg
b)
      (EABaseRip,   EAIndexNone) -> SDoc -> SDoc
pp_off (String -> SDoc
text "%rip")
      (EABaseNone,  EAIndex r :: Reg
r i :: Int
i) -> SDoc -> SDoc
pp_off (SDoc
comma SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pp_reg Reg
r SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i)
      (EABaseReg b :: Reg
b, EAIndex r :: Reg
r i :: Int
i) -> SDoc -> SDoc
pp_off (Reg -> SDoc
pp_reg Reg
b SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pp_reg Reg
r
                                       SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i)
      _                         -> String -> SDoc
forall a. String -> a
panic "X86.Ppr.pprAddr: no match"

  where
    ppr_disp :: Imm -> SDoc
ppr_disp (ImmInt 0) = SDoc
empty
    ppr_disp imm :: Imm
imm        = Imm -> SDoc
pprImm Imm
imm

-- | Print section header and appropriate alignment for that section.
pprSectionAlign :: Section -> SDoc
pprSectionAlign :: Section -> SDoc
pprSectionAlign (Section (OtherSection _) _) =
     String -> SDoc
forall a. String -> a
panic "X86.Ppr.pprSectionAlign: unknown section"
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 =
  (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    String -> SDoc
text ".align " SDoc -> SDoc -> SDoc
<>
    case Platform -> OS
platformOS Platform
platform of
      -- Darwin: alignments are given as shifts.
      OSDarwin
       | Platform -> Bool
target32Bit Platform
platform ->
          case SectionType
seg of
           ReadOnlyData16    -> Int -> SDoc
int 4
           CString           -> Int -> SDoc
int 1
           _                 -> Int -> SDoc
int 2
       | Bool
otherwise ->
          case SectionType
seg of
           ReadOnlyData16    -> Int -> SDoc
int 4
           CString           -> Int -> SDoc
int 1
           _                 -> Int -> SDoc
int 3
      -- Other: alignments are given as bytes.
      _
       | Platform -> Bool
target32Bit Platform
platform ->
          case SectionType
seg of
           Text              -> String -> SDoc
text "4,0x90"
           ReadOnlyData16    -> Int -> SDoc
int 16
           CString           -> Int -> SDoc
int 1
           _                 -> Int -> SDoc
int 4
       | Bool
otherwise ->
          case SectionType
seg of
           ReadOnlyData16    -> Int -> SDoc
int 16
           CString           -> Int -> SDoc
int 1
           _                 -> Int -> SDoc
int 8

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 -> DynFlags -> CmmLit -> SDoc
pprDataItem' DynFlags
dflags CmmLit
lit

pprDataItem' :: DynFlags -> CmmLit -> SDoc
pprDataItem' :: DynFlags -> CmmLit -> SDoc
pprDataItem' dflags :: DynFlags
dflags lit :: CmmLit
lit
  = [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
        platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
        imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit

        -- These seem to be common:
        ppr_item :: Format -> CmmLit -> [SDoc]
ppr_item II8   _ = [String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
        ppr_item II16  _ = [String -> SDoc
text "\t.word\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 II64 _
            = case Platform -> OS
platformOS Platform
platform of
              OSDarwin
               | Platform -> Bool
target32Bit Platform
platform ->
                  case CmmLit
lit of
                  CmmInt x :: Integer
x _ ->
                      [String -> SDoc
text "\t.long\t"
                          SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word32)),
                       String -> SDoc
text "\t.long\t"
                          SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                              (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` 32) :: Word32))]
                  _ -> String -> [SDoc]
forall a. String -> a
panic "X86.Ppr.ppr_item: no match for II64"
               | Bool
otherwise ->
                  [String -> SDoc
text "\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
              _
               | Platform -> Bool
target32Bit Platform
platform ->
                  [String -> SDoc
text "\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
               | Bool
otherwise ->
                  -- x86_64: binutils can't handle the R_X86_64_PC64
                  -- relocation type, which means we can't do
                  -- pc-relative 64-bit addresses. Fortunately we're
                  -- assuming the small memory model, in which all such
                  -- offsets will fit into 32 bits, so we have to stick
                  -- to 32-bit offset fields and modify the RTS
                  -- appropriately
                  --
                  -- See Note [x86-64-relative] in includes/rts/storage/InfoTables.h
                  --
                  case CmmLit
lit of
                  -- A relative relocation:
                  CmmLabelDiffOff _ _ _ _ ->
                      [String -> SDoc
text "\t.long\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm,
                       String -> SDoc
text "\t.long\t0"]
                  _ ->
                      [String -> SDoc
text "\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]

        ppr_item _ _
                = String -> [SDoc]
forall a. String -> a
panic "X86.Ppr.ppr_item: no match"


asmComment :: SDoc -> SDoc
asmComment :: SDoc -> SDoc
asmComment c :: SDoc
c = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "# " SDoc -> SDoc -> SDoc
<> SDoc
c

pprInstr :: Instr -> SDoc

pprInstr :: Instr -> SDoc
pprInstr (COMMENT s :: FastString
s)
   = SDoc -> SDoc
asmComment (FastString -> SDoc
ftext FastString
s)

pprInstr (LOCATION file :: Int
file line :: Int
line col :: Int
col _name :: String
_name)
   = String -> SDoc
text "\t.loc " SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
file SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
line SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
col

pprInstr (DELTA d :: Int
d)
   = SDoc -> SDoc
asmComment (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text ("\tdelta = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)

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

pprInstr (UNWIND lbl :: CLabel
lbl d :: UnwindTable
d)
   = SDoc -> SDoc
asmComment (String -> SDoc
text "\tunwind = " SDoc -> SDoc -> SDoc
<> UnwindTable -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnwindTable
d)
     SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc
colon

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

{-
pprInstr (SPILL reg slot)
   = hcat [
        text "\tSPILL",
        char ' ',
        pprUserReg reg,
        comma,
        text "SLOT" <> parens (int slot)]

pprInstr (RELOAD slot reg)
   = hcat [
        text "\tRELOAD",
        char ' ',
        text "SLOT" <> parens (int slot),
        comma,
        pprUserReg reg]
-}

-- Replace 'mov $0x0,%reg' by 'xor %reg,%reg', which is smaller and cheaper.
-- The code generator catches most of these already, but not all.
pprInstr (MOV format :: Format
format (OpImm (ImmInt 0)) dst :: Operand
dst@(OpReg _))
  = Instr -> SDoc
pprInstr (Format -> Operand -> Operand -> Instr
XOR Format
format' Operand
dst Operand
dst)
  where format' :: Format
format' = case Format
format of
          II64 -> Format
II32          -- 32-bit version is equivalent, and smaller
          _    -> Format
format
pprInstr (MOV format :: Format
format src :: Operand
src dst :: Operand
dst)
  = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "mov") Format
format Operand
src Operand
dst

pprInstr (CMOV cc :: Cond
cc format :: Format
format src :: Operand
src dst :: Reg
dst)
  = PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg (String -> PtrString
sLit "cmov") Format
format Cond
cc Operand
src Reg
dst

pprInstr (MOVZxL II32 src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "mov") Format
II32 Operand
src Operand
dst
        -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
        -- movl.  But we represent it as a MOVZxL instruction, because
        -- the reg alloc would tend to throw away a plain reg-to-reg
        -- move, and we still want it to do that.

pprInstr (MOVZxL formats :: Format
formats src :: Operand
src dst :: Operand
dst)
  = PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce (String -> PtrString
sLit "movz") Format
formats Format
II32 Operand
src Operand
dst
        -- zero-extension only needs to extend to 32 bits: on x86_64,
        -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
        -- instruction is shorter.

pprInstr (MOVSxL formats :: Format
formats src :: Operand
src dst :: Operand
dst)
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce (String -> PtrString
sLit "movs") Format
formats (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
src Operand
dst

-- here we do some patching, since the physical registers are only set late
-- in the code generation.
pprInstr (LEA format :: Format
format (OpAddr (AddrBaseIndex (EABaseReg reg1 :: Reg
reg1) (EAIndex reg2 :: Reg
reg2 1) (ImmInt 0))) dst :: Operand
dst@(OpReg reg3 :: Reg
reg3))
  | Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
  = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "add") Format
format (Reg -> Operand
OpReg Reg
reg2) Operand
dst

pprInstr (LEA format :: Format
format (OpAddr (AddrBaseIndex (EABaseReg reg1 :: Reg
reg1) (EAIndex reg2 :: Reg
reg2 1) (ImmInt 0))) dst :: Operand
dst@(OpReg reg3 :: Reg
reg3))
  | Reg
reg2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
  = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "add") Format
format (Reg -> Operand
OpReg Reg
reg1) Operand
dst

pprInstr (LEA format :: Format
format (OpAddr (AddrBaseIndex (EABaseReg reg1 :: Reg
reg1) EAIndexNone displ :: Imm
displ)) dst :: Operand
dst@(OpReg reg3 :: Reg
reg3))
  | Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
  = Instr -> SDoc
pprInstr (Format -> Operand -> Operand -> Instr
ADD Format
format (Imm -> Operand
OpImm Imm
displ) Operand
dst)

pprInstr (LEA format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "lea") Format
format Operand
src Operand
dst

pprInstr (ADD format :: Format
format (OpImm (ImmInt (-1))) dst :: Operand
dst)
  = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "dec") Format
format Operand
dst
pprInstr (ADD format :: Format
format (OpImm (ImmInt 1)) dst :: Operand
dst)
  = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "inc") Format
format Operand
dst
pprInstr (ADD format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "add") Format
format Operand
src Operand
dst
pprInstr (ADC format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "adc") Format
format Operand
src Operand
dst
pprInstr (SUB format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "sub") Format
format Operand
src Operand
dst
pprInstr (SBB format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "sbb") Format
format Operand
src Operand
dst
pprInstr (IMUL format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "imul") Format
format Operand
op1 Operand
op2

pprInstr (ADD_CC format :: Format
format src :: Operand
src dst :: Operand
dst)
  = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "add") Format
format Operand
src Operand
dst
pprInstr (SUB_CC format :: Format
format src :: Operand
src dst :: Operand
dst)
  = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "sub") Format
format Operand
src Operand
dst

{- A hack.  The Intel documentation says that "The two and three
   operand forms [of IMUL] may also be used with unsigned operands
   because the lower half of the product is the same regardless if
   (sic) the operands are signed or unsigned.  The CF and OF flags,
   however, cannot be used to determine if the upper half of the
   result is non-zero."  So there.
-}

-- Use a 32-bit instruction when possible as it saves a byte.
-- Notably, extracting the tag bits of a pointer has this form.
-- TODO: we could save a byte in a subsequent CMP instruction too,
-- but need something like a peephole pass for this
pprInstr (AND II64 src :: Operand
src@(OpImm (ImmInteger mask :: Integer
mask)) dst :: Operand
dst)
  | 0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mask Bool -> Bool -> Bool
&& Integer
mask Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0xffffffff
    = Instr -> SDoc
pprInstr (Format -> Operand -> Operand -> Instr
AND Format
II32 Operand
src Operand
dst)
pprInstr (AND FF32 src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "andps") Format
FF32 Operand
src Operand
dst
pprInstr (AND FF64 src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "andpd") Format
FF64 Operand
src Operand
dst
pprInstr (AND format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "and") Format
format Operand
src Operand
dst
pprInstr (OR  format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "or")  Format
format Operand
src Operand
dst

pprInstr (XOR FF32 src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "xorps") Format
FF32 Operand
src Operand
dst
pprInstr (XOR FF64 src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "xorpd") Format
FF64 Operand
src Operand
dst
pprInstr (XOR format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "xor")  Format
format Operand
src Operand
dst

pprInstr (POPCNT format :: Format
format src :: Operand
src dst :: Reg
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "popcnt") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
pprInstr (BSF format :: Format
format src :: Operand
src dst :: Reg
dst)    = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "bsf")    Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
pprInstr (BSR format :: Format
format src :: Operand
src dst :: Reg
dst)    = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit "bsr")    Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)

pprInstr (PDEP format :: Format
format src :: Operand
src mask :: Operand
mask dst :: Reg
dst)   = PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg (String -> PtrString
sLit "pdep") Format
format Operand
src Operand
mask Reg
dst
pprInstr (PEXT format :: Format
format src :: Operand
src mask :: Operand
mask dst :: Reg
dst)   = PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg (String -> PtrString
sLit "pext") Format
format Operand
src Operand
mask Reg
dst

pprInstr (PREFETCH NTA format :: Format
format src :: Operand
src ) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit "prefetchnta") Format
format Operand
src
pprInstr (PREFETCH Lvl0 format :: Format
format src :: Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit "prefetcht0") Format
format Operand
src
pprInstr (PREFETCH Lvl1 format :: Format
format src :: Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit "prefetcht1") Format
format Operand
src
pprInstr (PREFETCH Lvl2 format :: Format
format src :: Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit "prefetcht2") Format
format Operand
src

pprInstr (NOT format :: Format
format op :: Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "not") Format
format Operand
op
pprInstr (BSWAP format :: Format
format op :: Reg
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "bswap") Format
format (Reg -> Operand
OpReg Reg
op)
pprInstr (NEGI format :: Format
format op :: Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "neg") Format
format Operand
op

pprInstr (SHL format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit "shl") Format
format Operand
src Operand
dst
pprInstr (SAR format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit "sar") Format
format Operand
src Operand
dst
pprInstr (SHR format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit "shr") Format
format Operand
src Operand
dst

pprInstr (BT  format :: Format
format imm :: Imm
imm src :: Operand
src) = PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp (String -> PtrString
sLit "bt") Format
format Imm
imm Operand
src

pprInstr (CMP format :: Format
format src :: Operand
src dst :: Operand
dst)
  | Format -> Bool
isFloatFormat Format
format =  PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "ucomi") Format
format Operand
src Operand
dst -- SSE2
  | Bool
otherwise     =  PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "cmp")   Format
format Operand
src Operand
dst

pprInstr (TEST format :: Format
format src :: Operand
src dst :: Operand
dst) = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
  let format' :: Format
format' = case (Operand
src,Operand
dst) of
        -- Match instructions like 'test $0x3,%esi' or 'test $0x7,%rbx'.
        -- We can replace them by equivalent, but smaller instructions
        -- by reducing the size of the immediate operand as far as possible.
        -- (We could handle masks larger than a single byte too,
        -- but it would complicate the code considerably
        -- and tag checks are by far the most common case.)
        -- The mask must have the high bit clear for this smaller encoding
        -- to be completely equivalent to the original; in particular so
        -- that the signed comparison condition bits are the same as they
        -- would be if doing a full word comparison. See Trac #13425.
        (OpImm (ImmInteger mask :: Integer
mask), OpReg dstReg :: Reg
dstReg)
          | 0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mask Bool -> Bool -> Bool
&& Integer
mask Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 128 -> Platform -> Reg -> Format
minSizeOfReg Platform
platform Reg
dstReg
        _ -> Format
format
  in PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "test") Format
format' Operand
src Operand
dst
  where
    minSizeOfReg :: Platform -> Reg -> Format
minSizeOfReg platform :: Platform
platform (RegReal (RealRegSingle i :: Int
i))
      | Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 3        = Format
II8  -- al, bl, cl, dl
      | Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 7        = Format
II16 -- si, di, bp, sp
      | Bool -> Bool
not (Platform -> Bool
target32Bit Platform
platform) Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 15 = Format
II8  -- al .. r15b
    minSizeOfReg _ _ = Format
format                 -- other

pprInstr (PUSH format :: Format
format op :: Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "push") Format
format Operand
op
pprInstr (POP format :: Format
format op :: Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "pop") Format
format Operand
op

-- both unused (SDM):
-- pprInstr PUSHA = text "\tpushal"
-- pprInstr POPA = text "\tpopal"

pprInstr NOP = String -> SDoc
text "\tnop"
pprInstr (CLTD II8) = String -> SDoc
text "\tcbtw"
pprInstr (CLTD II16) = String -> SDoc
text "\tcwtd"
pprInstr (CLTD II32) = String -> SDoc
text "\tcltd"
pprInstr (CLTD II64) = String -> SDoc
text "\tcqto"
pprInstr (CLTD x :: Format
x) = String -> SDoc
forall a. String -> a
panic (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ "pprInstr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
x

pprInstr (SETCC cond :: Cond
cond op :: Operand
op) = PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit "set") Cond
cond (Format -> Operand -> SDoc
pprOperand Format
II8 Operand
op)

pprInstr (JXX cond :: Cond
cond blockid :: BlockId
blockid)
  = PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit "j") Cond
cond (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab)
  where lab :: CLabel
lab = BlockId -> CLabel
blockLbl BlockId
blockid

pprInstr        (JXX_GBL cond :: Cond
cond imm :: Imm
imm) = PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit "j") Cond
cond (Imm -> SDoc
pprImm Imm
imm)

pprInstr        (JMP (OpImm imm :: Imm
imm) _) = String -> SDoc
text "\tjmp " SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm
pprInstr (JMP op :: Operand
op _)          = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
                               String -> SDoc
text "\tjmp *"
                                   SDoc -> SDoc -> SDoc
<> Format -> Operand -> SDoc
pprOperand (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
op
pprInstr (JMP_TBL op :: Operand
op _ _ _)  = Instr -> SDoc
pprInstr (Operand -> [Reg] -> Instr
JMP Operand
op [])
pprInstr        (CALL (Left imm :: Imm
imm) _)    = String -> SDoc
text "\tcall " SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm
pprInstr (CALL (Right reg :: Reg
reg) _)   = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
                                  String -> SDoc
text "\tcall *"
                                      SDoc -> SDoc -> SDoc
<> Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg

pprInstr (IDIV fmt :: Format
fmt op :: Operand
op)   = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "idiv") Format
fmt Operand
op
pprInstr (DIV fmt :: Format
fmt op :: Operand
op)    = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "div")  Format
fmt Operand
op
pprInstr (IMUL2 fmt :: Format
fmt op :: Operand
op)  = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "imul") Format
fmt Operand
op

-- x86_64 only
pprInstr (MUL format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "mul") Format
format Operand
op1 Operand
op2
pprInstr (MUL2 format :: Format
format op :: Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit "mul") Format
format Operand
op

pprInstr (FDIV format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "div") Format
format Operand
op1 Operand
op2
pprInstr (SQRT format :: Format
format op1 :: Operand
op1 op2 :: Reg
op2) = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit "sqrt") Format
format Operand
op1 Reg
op2

pprInstr (CVTSS2SD from :: Reg
from to :: Reg
to)      = PtrString -> Reg -> Reg -> SDoc
pprRegReg (String -> PtrString
sLit "cvtss2sd") Reg
from Reg
to
pprInstr (CVTSD2SS from :: Reg
from to :: Reg
to)      = PtrString -> Reg -> Reg -> SDoc
pprRegReg (String -> PtrString
sLit "cvtsd2ss") Reg
from Reg
to
pprInstr (CVTTSS2SIQ fmt :: Format
fmt from :: Operand
from to :: Reg
to) = PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg (String -> PtrString
sLit "cvttss2si") Format
FF32 Format
fmt Operand
from Reg
to
pprInstr (CVTTSD2SIQ fmt :: Format
fmt from :: Operand
from to :: Reg
to) = PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg (String -> PtrString
sLit "cvttsd2si") Format
FF64 Format
fmt Operand
from Reg
to
pprInstr (CVTSI2SS fmt :: Format
fmt from :: Operand
from to :: Reg
to)   = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit "cvtsi2ss") Format
fmt Operand
from Reg
to
pprInstr (CVTSI2SD fmt :: Format
fmt from :: Operand
from to :: Reg
to)   = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit "cvtsi2sd") Format
fmt Operand
from Reg
to

    -- FETCHGOT for PIC on ELF platforms
pprInstr (FETCHGOT reg :: Reg
reg)
   = [SDoc] -> SDoc
vcat [ String -> SDoc
text "\tcall 1f",
            [SDoc] -> SDoc
hcat [ String -> SDoc
text "1:\tpopl\t", Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ],
            [SDoc] -> SDoc
hcat [ String -> SDoc
text "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
                   Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ]
          ]

    -- FETCHPC for PIC on Darwin/x86
    -- get the instruction pointer into a register
    -- (Terminology note: the IP is called Program Counter on PPC,
    --  and it's a good thing to use the same name on both platforms)
pprInstr (FETCHPC reg :: Reg
reg)
   = [SDoc] -> SDoc
vcat [ String -> SDoc
text "\tcall 1f",
            [SDoc] -> SDoc
hcat [ String -> SDoc
text "1:\tpopl\t", Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ]
          ]


-- -----------------------------------------------------------------------------
-- i386 floating-point

-- Simulating a flat register set on the x86 FP stack is tricky.
-- you have to free %st(7) before pushing anything on the FP reg stack
-- so as to preclude the possibility of a FP stack overflow exception.
pprInstr g :: Instr
g@(GMOV src :: Reg
src dst :: Reg
dst)
   | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = SDoc
empty
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0, SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])

-- GLD fmt addr dst ==> FLDsz addr ; FSTP (dst+1)
pprInstr g :: Instr
g@(GLD fmt :: Format
fmt addr :: AddrMode
addr dst :: Reg
dst)
 = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fld", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp,
                 AddrMode -> SDoc
pprAddr AddrMode
addr, SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])

-- GST fmt src addr ==> FLD dst ; FSTPsz addr
pprInstr g :: Instr
g@(GST fmt :: Format
fmt src :: Reg
src addr :: AddrMode
addr)
 | Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
fake0 Bool -> Bool -> Bool
&& Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
FF80 -- fstt instruction doesn't exist
 = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab,
                 String -> SDoc
text "fst", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp, AddrMode -> SDoc
pprAddr AddrMode
addr])
 | Bool
otherwise
 = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0, SDoc
gsemi,
                 String -> SDoc
text "fstp", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp, AddrMode -> SDoc
pprAddr AddrMode
addr])

pprInstr g :: Instr
g@(GLDZ dst :: Reg
dst)
 = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fldz ; ", Reg -> Int -> SDoc
gpop Reg
dst 1])
pprInstr g :: Instr
g@(GLD1 dst :: Reg
dst)
 = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fld1 ; ", Reg -> Int -> SDoc
gpop Reg
dst 1])

pprInstr (GFTOI src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc
pprInstr (Reg -> Reg -> Instr
GDTOI Reg
src Reg
dst)

pprInstr g :: Instr
g@(GDTOI src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "subl $8, %esp ; fnstcw 4(%esp)"],
         [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0],
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "movzwl 4(%esp), ", SDoc
reg,
                     String -> SDoc
text " ; orl $0xC00, ", SDoc
reg],
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "movl ", SDoc
reg, String -> SDoc
text ", 0(%esp) ; fldcw 0(%esp)"],
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fistpl 0(%esp)"],
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fldcw 4(%esp) ; movl 0(%esp), ", SDoc
reg],
         [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "addl $8, %esp"]
     ])
   where
     reg :: SDoc
reg = Format -> Reg -> SDoc
pprReg Format
II32 Reg
dst

pprInstr (GITOF src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc
pprInstr (Reg -> Reg -> Instr
GITOD Reg
src Reg
dst)

pprInstr g :: Instr
g@(GITOD src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "pushl ", Format -> Reg -> SDoc
pprReg Format
II32 Reg
src,
                   String -> SDoc
text " ; fildl (%esp) ; ",
                   Reg -> Int -> SDoc
gpop Reg
dst 1, String -> SDoc
text " ; addl $4,%esp"])

pprInstr g :: Instr
g@(GDTOF src :: Reg
src dst :: Reg
dst)
  = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [SDoc
gtab SDoc -> SDoc -> SDoc
<> Reg -> Int -> SDoc
gpush Reg
src 0,
                  SDoc
gtab SDoc -> SDoc -> SDoc
<> String -> SDoc
text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
                  SDoc
gtab SDoc -> SDoc -> SDoc
<> Reg -> Int -> SDoc
gpop Reg
dst 1])

{- Gruesome swamp follows.  If you're unfortunate enough to have ventured
   this far into the jungle AND you give a Rat's Ass (tm) what's going
   on, here's the deal.  Generate code to do a floating point comparison
   of src1 and src2, of kind cond, and set the Zero flag if true.

   The complications are to do with handling NaNs correctly.  We want the
   property that if either argument is NaN, then the result of the
   comparison is False ... except if we're comparing for inequality,
   in which case the answer is True.

   Here's how the general (non-inequality) case works.  As an
   example, consider generating the an equality test:

     pushl %eax         -- we need to mess with this
     <get src1 to top of FPU stack>
     fcomp <src2 location in FPU stack> and pop pushed src1
                -- Result of comparison is in FPU Status Register bits
                -- C3 C2 and C0
     fstsw %ax  -- Move FPU Status Reg to %ax
     sahf       -- move C3 C2 C0 from %ax to integer flag reg
     -- now the serious magic begins
     setpo %ah     -- %ah = if comparable(neither arg was NaN) then 1 else 0
     sete  %al     -- %al = if arg1 == arg2 then 1 else 0
     andb %ah,%al  -- %al &= %ah
                   -- so %al == 1 iff (comparable && same); else it holds 0
     decb %al      -- %al == 0, ZeroFlag=1  iff (comparable && same);
                      else %al == 0xFF, ZeroFlag=0
     -- the zero flag is now set as we desire.
     popl %eax

   The special case of inequality differs thusly:

     setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
     setne %al     -- %al = if arg1 /= arg2 then 1 else 0
     orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
     decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
                                                     else (%al == 0xFF, ZF=0)
-}
pprInstr g :: Instr
g@(GCMP cond :: Cond
cond src1 :: Reg
src1 src2 :: Reg
src2)
   | case Cond
cond of { NE -> Bool
True; _ -> Bool
False }
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "pushl %eax ; ",Reg -> Int -> SDoc
gpush Reg
src1 0],
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fcomp ", Reg -> Int -> SDoc
greg Reg
src2 1,
                    String -> SDoc
text "; fstsw %ax ; sahf ;  setpe %ah"],
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "setne %al ;  ",
              String -> SDoc
text "orb %ah,%al ;  decb %al ;  popl %eax"]
    ])
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "pushl %eax ; ",Reg -> Int -> SDoc
gpush Reg
src1 0],
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fcomp ", Reg -> Int -> SDoc
greg Reg
src2 1,
                    String -> SDoc
text "; fstsw %ax ; sahf ;  setpo %ah"],
        [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "set", Cond -> SDoc
pprCond (Cond -> Cond
fix_FP_cond Cond
cond), String -> SDoc
text " %al ;  ",
              String -> SDoc
text "andb %ah,%al ;  decb %al ;  popl %eax"]
    ])
    where
        {- On the 486, the flags set by FP compare are the unsigned ones!
           (This looks like a HACK to me.  WDP 96/03)
        -}
        fix_FP_cond :: Cond -> Cond
        fix_FP_cond :: Cond -> Cond
fix_FP_cond GE   = Cond
GEU
        fix_FP_cond GTT  = Cond
GU
        fix_FP_cond LTT  = Cond
LU
        fix_FP_cond LE   = Cond
LEU
        fix_FP_cond EQQ  = Cond
EQQ
        fix_FP_cond NE   = Cond
NE
        fix_FP_cond _    = String -> Cond
forall a. String -> a
panic "X86.Ppr.fix_FP_cond: no match"
        -- there should be no others


pprInstr g :: Instr
g@(GABS _ src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0, String -> SDoc
text " ; fabs ; ", Reg -> Int -> SDoc
gpop Reg
dst 1])

pprInstr g :: Instr
g@(GNEG _ src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0, String -> SDoc
text " ; fchs ; ", Reg -> Int -> SDoc
gpop Reg
dst 1])

pprInstr g :: Instr
g@(GSQRT fmt :: Format
fmt src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src 0, String -> SDoc
text " ; fsqrt"] SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Format -> SDoc
gcoerceto Format
fmt, Reg -> Int -> SDoc
gpop Reg
dst 1])

pprInstr g :: Instr
g@(GSIN fmt :: Format
fmt l1 :: CLabel
l1 l2 :: CLabel
l2 src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp "fsin" Bool
False CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)

pprInstr g :: Instr
g@(GCOS fmt :: Format
fmt l1 :: CLabel
l1 l2 :: CLabel
l2 src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp "fcos" Bool
False CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)

pprInstr g :: Instr
g@(GTAN fmt :: Format
fmt l1 :: CLabel
l1 l2 :: CLabel
l2 src :: Reg
src dst :: Reg
dst)
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp "fptan" Bool
True CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)

-- In the translations for GADD, GMUL, GSUB and GDIV,
-- the first two cases are mere optimisations.  The otherwise clause
-- generates correct code under all circumstances.

pprInstr g :: Instr
g@(GADD _ src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst)
   | Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GADD-xxxcase1" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 0,
                   String -> SDoc
text " ; faddp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 1])
   | Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GADD-xxxcase2" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; faddp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 1])
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fadd ", Reg -> Int -> SDoc
greg Reg
src2 1, String -> SDoc
text ",%st(0)",
                   SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])


pprInstr g :: Instr
g@(GMUL _ src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst)
   | Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GMUL-xxxcase1" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 0,
                   String -> SDoc
text " ; fmulp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 1])
   | Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GMUL-xxxcase2" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fmulp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 1])
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
             String -> SDoc
text " ; fmul ", Reg -> Int -> SDoc
greg Reg
src2 1, String -> SDoc
text ",%st(0)",
             SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])


pprInstr g :: Instr
g@(GSUB _ src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst)
   | Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GSUB-xxxcase1" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 0,
                   String -> SDoc
text " ; fsubrp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 1])
   | Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GSUB-xxxcase2" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fsubp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 1])
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fsub ", Reg -> Int -> SDoc
greg Reg
src2 1, String -> SDoc
text ",%st(0)",
                   SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])


pprInstr g :: Instr
g@(GDIV _ src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst)
   | Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GDIV-xxxcase1" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 0,
                   String -> SDoc
text " ; fdivrp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 1])
   | Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
   = Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text "\t#GDIV-xxxcase2" SDoc -> SDoc -> SDoc
$$
             [SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fdivp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 1])
   | Bool
otherwise
   = Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 0,
                   String -> SDoc
text " ; fdiv ", Reg -> Int -> SDoc
greg Reg
src2 1, String -> SDoc
text ",%st(0)",
                   SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst 1])


pprInstr GFREE
   = [SDoc] -> SDoc
vcat [ String -> SDoc
text "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)",
            String -> SDoc
text "\tffree %st(4) ;ffree %st(5)"
          ]

-- Atomics

pprInstr (LOCK i :: Instr
i) = String -> SDoc
text "\tlock" SDoc -> SDoc -> SDoc
$$ Instr -> SDoc
pprInstr Instr
i

pprInstr MFENCE = String -> SDoc
text "\tmfence"

pprInstr (XADD format :: Format
format src :: Operand
src dst :: Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "xadd") Format
format Operand
src Operand
dst

pprInstr (CMPXCHG format :: Format
format src :: Operand
src dst :: Operand
dst)
   = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit "cmpxchg") Format
format Operand
src Operand
dst


pprTrigOp :: String -> Bool -> CLabel -> CLabel
          -> Reg -> Reg -> Format -> SDoc
pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp op :: String
op -- fsin, fcos or fptan
          isTan :: Bool
isTan -- we need a couple of extra steps if we're doing tan
          l1 :: CLabel
l1 l2 :: CLabel
l2 -- internal labels for us to use
          src :: Reg
src dst :: Reg
dst fmt :: Format
fmt
    = -- We'll be needing %eax later on
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "pushl %eax;"] SDoc -> SDoc -> SDoc
$$
      -- tan is going to use an extra space on the FP stack
      (if Bool
isTan then [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "ffree %st(6)"] else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      -- First put the value in %st(0) and try to apply the op to it
      [SDoc] -> SDoc
hcat [Reg -> Int -> SDoc
gpush Reg
src 0, String -> SDoc
text ("; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op)] SDoc -> SDoc -> SDoc
$$
      -- Now look to see if C2 was set (overflow, |value| >= 2^63)
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fnstsw %ax"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "test   $0x400,%eax"] SDoc -> SDoc -> SDoc
$$
      -- If we were in bounds then jump to the end
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "je     " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l1] SDoc -> SDoc -> SDoc
$$
      -- Otherwise we need to shrink the value. Start by
      -- loading pi, doubleing it (by adding it to itself),
      -- and then swapping pi with the value, so the value we
      -- want to apply op to is in %st(0) again
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "ffree %st(7); fldpi"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fadd   %st(0),%st"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fxch   %st(1)"] SDoc -> SDoc -> SDoc
$$
      -- Now we have a loop in which we make the value smaller,
      -- see if it's small enough, and loop if not
      (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l2 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':') SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fprem1"] SDoc -> SDoc -> SDoc
$$
      -- My Debian libc uses fstsw here for the tan code, but I can't
      -- see any reason why it should need to be different for tan.
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fnstsw %ax"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "test   $0x400,%eax"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "jne    " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l2] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fstp   %st(1)"] SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
op] SDoc -> SDoc -> SDoc
$$
      (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':') SDoc -> SDoc -> SDoc
$$
      -- Pop the 1.0 tan gave us
      (if Bool
isTan then [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "fstp %st(0)"] else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      -- Restore %eax
      [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text "popl %eax;"] SDoc -> SDoc -> SDoc
$$
      -- And finally make the result the right size
      [SDoc] -> SDoc
hcat [SDoc
gtab, Format -> SDoc
gcoerceto Format
fmt, Reg -> Int -> SDoc
gpop Reg
dst 1]

--------------------------

-- coerce %st(0) to the specified size
gcoerceto :: Format -> SDoc
gcoerceto :: Format -> SDoc
gcoerceto FF64 = SDoc
empty
gcoerceto FF32 = SDoc
empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
gcoerceto _    = String -> SDoc
forall a. String -> a
panic "X86.Ppr.gcoerceto: no match"

gpush :: Reg -> RegNo -> SDoc
gpush :: Reg -> Int -> SDoc
gpush reg :: Reg
reg offset :: Int
offset
   = [SDoc] -> SDoc
hcat [String -> SDoc
text "fld ", Reg -> Int -> SDoc
greg Reg
reg Int
offset]

gpop :: Reg -> RegNo -> SDoc
gpop :: Reg -> Int -> SDoc
gpop reg :: Reg
reg offset :: Int
offset
   = [SDoc] -> SDoc
hcat [String -> SDoc
text "fstp ", Reg -> Int -> SDoc
greg Reg
reg Int
offset]

greg :: Reg -> RegNo -> SDoc
greg :: Reg -> Int -> SDoc
greg reg :: Reg
reg offset :: Int
offset = String -> SDoc
text "%st(" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Reg -> Int
gregno Reg
reg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
firstfakeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ')'

gsemi :: SDoc
gsemi :: SDoc
gsemi = String -> SDoc
text " ; "

gtab :: SDoc
gtab :: SDoc
gtab  = Char -> SDoc
char '\t'

gsp :: SDoc
gsp :: SDoc
gsp   = Char -> SDoc
char ' '

gregno :: Reg -> RegNo
gregno :: Reg -> Int
gregno (RegReal (RealRegSingle i :: Int
i)) = Int
i
gregno _           = --pprPanic "gregno" (ppr other)
                     999   -- bogus; only needed for debug printing

pprG :: Instr -> SDoc -> SDoc
pprG :: Instr -> SDoc -> SDoc
pprG fake :: Instr
fake actual :: SDoc
actual
   = (Char -> SDoc
char '#' SDoc -> SDoc -> SDoc
<> Instr -> SDoc
pprGInstr Instr
fake) SDoc -> SDoc -> SDoc
$$ SDoc
actual


pprGInstr :: Instr -> SDoc
pprGInstr :: Instr -> SDoc
pprGInstr (GMOV src :: Reg
src dst :: Reg
dst)   = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gmov") Format
FF64 Reg
src Reg
dst
pprGInstr (GLD fmt :: Format
fmt src :: AddrMode
src dst :: Reg
dst) = PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg (String -> PtrString
sLit "gld") Format
fmt AddrMode
src Reg
dst
pprGInstr (GST fmt :: Format
fmt src :: Reg
src dst :: AddrMode
dst) = PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr (String -> PtrString
sLit "gst") Format
fmt Reg
src AddrMode
dst

pprGInstr (GLDZ dst :: Reg
dst) = PtrString -> Format -> Reg -> SDoc
pprFormatReg (String -> PtrString
sLit "gldz") Format
FF64 Reg
dst
pprGInstr (GLD1 dst :: Reg
dst) = PtrString -> Format -> Reg -> SDoc
pprFormatReg (String -> PtrString
sLit "gld1") Format
FF64 Reg
dst

pprGInstr (GFTOI src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit "gftoi") Format
FF32 Format
II32 Reg
src Reg
dst
pprGInstr (GDTOI src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit "gdtoi") Format
FF64 Format
II32 Reg
src Reg
dst

pprGInstr (GITOF src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit "gitof") Format
II32 Format
FF32 Reg
src Reg
dst
pprGInstr (GITOD src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit "gitod") Format
II32 Format
FF64 Reg
src Reg
dst
pprGInstr (GDTOF src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit "gdtof") Format
FF64 Format
FF32 Reg
src Reg
dst

pprGInstr (GCMP co :: Cond
co src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg (String -> PtrString
sLit "gcmp_") Format
FF64 Cond
co Reg
src Reg
dst
pprGInstr (GABS fmt :: Format
fmt src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gabs") Format
fmt Reg
src Reg
dst
pprGInstr (GNEG fmt :: Format
fmt src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gneg") Format
fmt Reg
src Reg
dst
pprGInstr (GSQRT fmt :: Format
fmt src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gsqrt") Format
fmt Reg
src Reg
dst
pprGInstr (GSIN fmt :: Format
fmt _ _ src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gsin") Format
fmt Reg
src Reg
dst
pprGInstr (GCOS fmt :: Format
fmt _ _ src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gcos") Format
fmt Reg
src Reg
dst
pprGInstr (GTAN fmt :: Format
fmt _ _ src :: Reg
src dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit "gtan") Format
fmt Reg
src Reg
dst

pprGInstr (GADD fmt :: Format
fmt src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit "gadd") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GSUB fmt :: Format
fmt src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit "gsub") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GMUL fmt :: Format
fmt src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit "gmul") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GDIV fmt :: Format
fmt src1 :: Reg
src1 src2 :: Reg
src2 dst :: Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit "gdiv") Format
fmt Reg
src1 Reg
src2 Reg
dst

pprGInstr _ = String -> SDoc
forall a. String -> a
panic "X86.Ppr.pprGInstr: no match"

pprDollImm :: Imm -> SDoc
pprDollImm :: Imm -> SDoc
pprDollImm i :: Imm
i = String -> SDoc
text "$" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
i


pprOperand :: Format -> Operand -> SDoc
pprOperand :: Format -> Operand -> SDoc
pprOperand f :: Format
f (OpReg r :: Reg
r)   = Format -> Reg -> SDoc
pprReg Format
f Reg
r
pprOperand _ (OpImm i :: Imm
i)   = Imm -> SDoc
pprDollImm Imm
i
pprOperand _ (OpAddr ea :: AddrMode
ea) = AddrMode -> SDoc
pprAddr AddrMode
ea


pprMnemonic_  :: PtrString -> SDoc
pprMnemonic_ :: PtrString -> SDoc
pprMnemonic_ name :: PtrString
name =
   Char -> SDoc
char '\t' SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
name SDoc -> SDoc -> SDoc
<> SDoc
space


pprMnemonic  :: PtrString -> Format -> SDoc
pprMnemonic :: PtrString -> Format -> SDoc
pprMnemonic name :: PtrString
name format :: Format
format =
   Char -> SDoc
char '\t' SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
name SDoc -> SDoc -> SDoc
<> Format -> SDoc
pprFormat Format
format SDoc -> SDoc -> SDoc
<> SDoc
space


pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp name :: PtrString
name format :: Format
format imm :: Imm
imm op1 :: Operand
op1
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Char -> SDoc
char '$',
        Imm -> SDoc
pprImm Imm
imm,
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
    ]


pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
pprFormatOp_ name :: PtrString
name format :: Format
format op1 :: Operand
op1
  = [SDoc] -> SDoc
hcat [
        PtrString -> SDoc
pprMnemonic_ PtrString
name ,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
    ]

pprFormatOp :: PtrString -> Format -> Operand -> SDoc
pprFormatOp :: PtrString -> Format -> Operand -> SDoc
pprFormatOp name :: PtrString
name format :: Format
format op1 :: Operand
op1
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
    ]


pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp name :: PtrString
name format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op2
    ]


pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp name :: PtrString
name format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2
  = [SDoc] -> SDoc
hcat [
        PtrString -> SDoc
pprMnemonic_ PtrString
name,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op2
    ]


pprFormatReg :: PtrString -> Format -> Reg -> SDoc
pprFormatReg :: PtrString -> Format -> Reg -> SDoc
pprFormatReg name :: PtrString
name format :: Format
format reg1 :: Reg
reg1
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg1
    ]


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 [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
    ]


pprRegReg :: PtrString -> Reg -> Reg -> SDoc
pprRegReg :: PtrString -> Reg -> Reg -> SDoc
pprRegReg name :: PtrString
name reg1 :: Reg
reg1 reg2 :: Reg
reg2
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    [SDoc] -> SDoc
hcat [
        PtrString -> SDoc
pprMnemonic_ PtrString
name,
        Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
    ]


pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg name :: PtrString
name format :: Format
format op1 :: Operand
op1 reg2 :: Reg
reg2
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
    ]

pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg name :: PtrString
name format :: Format
format cond :: Cond
cond op1 :: Operand
op1 reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        Cond -> SDoc
pprCond Cond
cond,
        SDoc
space,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
    ]

pprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg name :: PtrString
name format :: Format
format cond :: Cond
cond reg1 :: Reg
reg1 reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        Cond -> SDoc
pprCond Cond
cond,
        SDoc
space,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
    ]

pprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg name :: PtrString
name format1 :: Format
format1 format2 :: Format
format2 reg1 :: Reg
reg1 reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
name,
        Format -> SDoc
pprFormat Format
format1,
        Format -> SDoc
pprFormat Format
format2,
        SDoc
space,
        Format -> Reg -> SDoc
pprReg Format
format1 Reg
reg1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format2 Reg
reg2
    ]

pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg name :: PtrString
name format1 :: Format
format1 format2 :: Format
format2 op1 :: Operand
op1 reg2 :: Reg
reg2
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format2,
        Format -> Operand -> SDoc
pprOperand Format
format1 Operand
op1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format2 Reg
reg2
    ]

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 [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg2,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg3
    ]

pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg name :: PtrString
name format :: Format
format op1 :: Operand
op1 op2 :: Operand
op2 reg3 :: Reg
reg3
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
op2,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
reg3
    ]

pprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg name :: PtrString
name format :: Format
format op :: AddrMode
op dst :: Reg
dst
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        AddrMode -> SDoc
pprAddr AddrMode
op,
        SDoc
comma,
        Format -> Reg -> SDoc
pprReg Format
format Reg
dst
    ]


pprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr name :: PtrString
name format :: Format
format src :: Reg
src op :: AddrMode
op
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Reg -> SDoc
pprReg Format
format Reg
src,
        SDoc
comma,
        AddrMode -> SDoc
pprAddr AddrMode
op
    ]


pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
pprShift name :: PtrString
name format :: Format
format src :: Operand
src dest :: Operand
dest
  = [SDoc] -> SDoc
hcat [
        PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
        Format -> Operand -> SDoc
pprOperand Format
II8 Operand
src,  -- src is 8-bit sized
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format Operand
dest
    ]


pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce name :: PtrString
name format1 :: Format
format1 format2 :: Format
format2 op1 :: Operand
op1 op2 :: Operand
op2
  = [SDoc] -> SDoc
hcat [ Char -> SDoc
char '\t', PtrString -> SDoc
ptext PtrString
name, Format -> SDoc
pprFormat Format
format1, Format -> SDoc
pprFormat Format
format2, SDoc
space,
        Format -> Operand -> SDoc
pprOperand Format
format1 Operand
op1,
        SDoc
comma,
        Format -> Operand -> SDoc
pprOperand Format
format2 Operand
op2
    ]


pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
pprCondInstr name :: PtrString
name cond :: Cond
cond arg :: SDoc
arg
  = [SDoc] -> SDoc
hcat [ Char -> SDoc
char '\t', PtrString -> SDoc
ptext PtrString
name, Cond -> SDoc
pprCond Cond
cond, SDoc
space, SDoc
arg]