{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
--
-- Generating machine code (instruction selection)
--
-- (c) The University of Glasgow 1996-2013
--
-----------------------------------------------------------------------------

{-# LANGUAGE GADTs #-}
module GHC.CmmToAsm.SPARC.CodeGen (
        cmmTopCodeGen,
        generateJumpTableForInstr,
        InstrBlock
)

where

#include "HsVersions.h"

-- NCG stuff:
import GHC.Prelude

import GHC.CmmToAsm.SPARC.Base
import GHC.CmmToAsm.SPARC.CodeGen.Sanity
import GHC.CmmToAsm.SPARC.CodeGen.Amode
import GHC.CmmToAsm.SPARC.CodeGen.CondCode
import GHC.CmmToAsm.SPARC.CodeGen.Gen64
import GHC.CmmToAsm.SPARC.CodeGen.Gen32
import GHC.CmmToAsm.SPARC.CodeGen.Base
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.SPARC.Stack
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Monad   ( NatM, getNewRegNat, getNewLabelNat, getPlatform, getConfig )
import GHC.CmmToAsm.Config

-- Our intermediate code:
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.CmmToAsm.PIC
import GHC.Platform.Reg
import GHC.Cmm.CLabel
import GHC.CmmToAsm.CPrim

-- The rest:
import GHC.Types.Basic
import GHC.Data.FastString
import GHC.Data.OrdList
import GHC.Utils.Panic
import GHC.Platform

import Control.Monad    ( mapAndUnzipM )

-- | Top level code generation
cmmTopCodeGen :: RawCmmDecl
              -> NatM [NatCmmDecl RawCmmStatics Instr]

cmmTopCodeGen :: RawCmmDecl -> NatM [NatCmmDecl RawCmmStatics Instr]
cmmTopCodeGen (CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live CmmGraph
graph)
 = do let blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
toBlockListEntryFirst CmmGraph
graph
      ([[NatBasicBlock Instr]]
nat_blocks,[[NatCmmDecl RawCmmStatics Instr]]
statics) <- forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM CmmBlock
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
basicBlockCodeGen [CmmBlock]
blocks

      let proc :: NatCmmDecl RawCmmStatics Instr
proc = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatBasicBlock Instr]]
nat_blocks)
      let tops :: [NatCmmDecl RawCmmStatics Instr]
tops = NatCmmDecl RawCmmStatics Instr
proc forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatCmmDecl RawCmmStatics Instr]]
statics

      forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl RawCmmStatics Instr]
tops

cmmTopCodeGen (CmmData Section
sec RawCmmStatics
dat) =
  forall (m :: * -> *) a. Monad m => a -> m a
return [forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
dat]  -- no translation, we just use CmmStatic


-- | Do code generation on a single block of CMM code.
--      code generation may introduce new basic block boundaries, which
--      are indicated by the NEWBLOCK instruction.  We must split up the
--      instruction stream into basic blocks again.  Also, we extract
--      LDATAs here too.
basicBlockCodeGen :: CmmBlock
                  -> NatM ( [NatBasicBlock Instr]
                          , [NatCmmDecl RawCmmStatics Instr])

basicBlockCodeGen :: CmmBlock
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
basicBlockCodeGen CmmBlock
block = do
  let (CmmNode C O
_, Block CmmNode O O
nodes, CmmNode O C
tail)  = forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
      id :: Label
id = forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
block
      stmts :: [CmmNode O O]
stmts = forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
nodes
  Platform
platform <- NatM Platform
getPlatform
  InstrBlock
mid_instrs <- forall (e :: Extensibility) (x :: Extensibility).
[CmmNode e x] -> NatM InstrBlock
stmtsToInstrs [CmmNode O O]
stmts
  InstrBlock
tail_instrs <- forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM InstrBlock
stmtToInstrs CmmNode O C
tail
  let instrs :: InstrBlock
instrs = InstrBlock
mid_instrs forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
tail_instrs
  let
        ([Instr]
top,[NatBasicBlock Instr]
other_blocks,[NatCmmDecl RawCmmStatics Instr]
statics)
                = forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL forall {h} {g}.
Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks ([],[],[]) InstrBlock
instrs

        mkBlocks :: Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks (NEWBLOCK Label
id) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
          = ([], forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
id [Instr]
instrs forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
blocks, [GenCmmDecl RawCmmStatics h g]
statics)

        mkBlocks (LDATA Section
sec RawCmmStatics
dat) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
          = ([Instr]
instrs, [NatBasicBlock Instr]
blocks, forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
datforall a. a -> [a] -> [a]
:[GenCmmDecl RawCmmStatics h g]
statics)

        mkBlocks Instr
instr ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
          = (Instr
instrforall a. a -> [a] -> [a]
:[Instr]
instrs, [NatBasicBlock Instr]
blocks, [GenCmmDecl RawCmmStatics h g]
statics)

        -- do intra-block sanity checking
        blocksChecked :: [NatBasicBlock Instr]
blocksChecked
                = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmBlock -> NatBasicBlock Instr -> NatBasicBlock Instr
checkBlock Platform
platform CmmBlock
block)
                forall a b. (a -> b) -> a -> b
$ forall i. Label -> [i] -> GenBasicBlock i
BasicBlock Label
id [Instr]
top forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
other_blocks

  forall (m :: * -> *) a. Monad m => a -> m a
return ([NatBasicBlock Instr]
blocksChecked, [NatCmmDecl RawCmmStatics Instr]
statics)


-- | Convert some Cmm statements to SPARC instructions.
stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
stmtsToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
[CmmNode e x] -> NatM InstrBlock
stmtsToInstrs [CmmNode e x]
stmts
   = do [InstrBlock]
instrss <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM InstrBlock
stmtToInstrs [CmmNode e x]
stmts
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [OrdList a] -> OrdList a
concatOL [InstrBlock]
instrss)


stmtToInstrs :: CmmNode e x -> NatM InstrBlock
stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM InstrBlock
stmtToInstrs CmmNode e x
stmt = do
  Platform
platform <- NatM Platform
getPlatform
  NCGConfig
config <- NatM NCGConfig
getConfig
  case CmmNode e x
stmt of
    CmmComment FastString
s   -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> OrdList a
unitOL (FastString -> Instr
COMMENT FastString
s))
    CmmTick {}     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. OrdList a
nilOL
    CmmUnwind {}   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. OrdList a
nilOL

    CmmAssign CmmReg
reg CmmExpr
src
      | CmmType -> Bool
isFloatType CmmType
ty  -> Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_FltCode Format
format CmmReg
reg CmmExpr
src
      | CmmType -> Bool
isWord64 CmmType
ty     -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code        CmmReg
reg CmmExpr
src
      | Bool
otherwise       -> Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_IntCode Format
format CmmReg
reg CmmExpr
src
        where ty :: CmmType
ty = Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg
              format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
ty

    CmmStore CmmExpr
addr CmmExpr
src AlignmentSpec
_
      | CmmType -> Bool
isFloatType CmmType
ty  -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_FltCode Format
format CmmExpr
addr CmmExpr
src
      | CmmType -> Bool
isWord64 CmmType
ty     -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code      CmmExpr
addr CmmExpr
src
      | Bool
otherwise       -> Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode Format
format CmmExpr
addr CmmExpr
src
        where ty :: CmmType
ty = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
src
              format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
ty

    CmmUnsafeForeignCall ForeignTarget
target [CmmFormal]
result_regs [CmmExpr]
args
       -> ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM InstrBlock
genCCall ForeignTarget
target [CmmFormal]
result_regs [CmmExpr]
args

    CmmBranch   Label
id              -> Label -> NatM InstrBlock
genBranch Label
id
    CmmCondBranch CmmExpr
arg Label
true Label
false Maybe Bool
_ -> do
      InstrBlock
b1 <- Label -> CmmExpr -> NatM InstrBlock
genCondJump Label
true CmmExpr
arg
      InstrBlock
b2 <- Label -> NatM InstrBlock
genBranch Label
false
      forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
b1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
b2)
    CmmSwitch CmmExpr
arg SwitchTargets
ids   -> NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch NCGConfig
config CmmExpr
arg SwitchTargets
ids
    CmmCall { cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
arg } -> CmmExpr -> NatM InstrBlock
genJump CmmExpr
arg

    CmmNode e x
_
     -> forall a. String -> a
panic String
"stmtToInstrs: statement should have been cps'd away"


{-
Now, given a tree (the argument to a CmmLoad) that references memory,
produce a suitable addressing mode.

A Rule of the Game (tm) for Amodes: use of the addr bit must
immediately follow use of the code part, since the code part puts
values in registers which the addr then refers to.  So you can't put
anything in between, lest it overwrite some of those registers.  If
you need to do some other computation between the code part and use of
the addr bit, first store the effective address from the amode in a
temporary, then do the other computation, and then use the temporary:

    code
    LEA amode, tmp
    ... other computation ...
    ... (tmp) ...
-}



-- | Convert a BlockId to some CmmStatic data
jumpTableEntry :: Platform -> Maybe BlockId -> CmmStatic
jumpTableEntry :: Platform -> Maybe Label -> CmmStatic
jumpTableEntry Platform
platform Maybe Label
Nothing = CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (Platform -> Width
wordWidth Platform
platform))
jumpTableEntry Platform
_ (Just Label
blockid) = CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CmmLit
CmmLabel CLabel
blockLabel)
    where blockLabel :: CLabel
blockLabel = Label -> CLabel
blockLbl Label
blockid



-- -----------------------------------------------------------------------------
-- Generating assignments

-- Assignments are really at the heart of the whole code generation
-- business.  Almost all top-level nodes of any real importance are
-- assignments, which correspond to loads, stores, or register
-- transfers.  If we're really lucky, some of the register transfers
-- will go away, because we can use the destination register to
-- complete the code generation for the right hand side.  This only
-- fails when the right hand side is forced into a fixed register
-- (e.g. the result of a call).

assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_IntCode Format
pk CmmExpr
addr CmmExpr
src = do
    (Reg
srcReg, InstrBlock
code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
src
    Amode AddrMode
dstAddr InstrBlock
addr_code <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
pk Reg
srcReg AddrMode
dstAddr


assignReg_IntCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_IntCode Format
_ CmmReg
reg CmmExpr
src = do
    Platform
platform <- NatM Platform
getPlatform
    Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
src
    let dst :: Reg
dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Register
r of
        Any Format
_ Reg -> InstrBlock
code         -> Reg -> InstrBlock
code Reg
dst
        Fixed Format
_ Reg
freg InstrBlock
fcode -> InstrBlock
fcode forall a. OrdList a -> a -> OrdList a
`snocOL` Bool -> Reg -> RI -> Reg -> Instr
OR Bool
False Reg
g0 (Reg -> RI
RIReg Reg
freg) Reg
dst



-- Floating point assignment to memory
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_FltCode Format
pk CmmExpr
addr CmmExpr
src = do
    Platform
platform <- NatM Platform
getPlatform
    Amode AddrMode
dst__2 InstrBlock
code1 <- CmmExpr -> NatM Amode
getAmode CmmExpr
addr
    (Reg
src__2, InstrBlock
code2) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
src
    Reg
tmp1 <- Format -> NatM Reg
getNewRegNat Format
pk
    let
        pk__2 :: CmmType
pk__2   = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
src
        code__2 :: InstrBlock
code__2 = InstrBlock
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` InstrBlock
code2 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
            if   Format -> Width
formatToWidth Format
pk forall a. Eq a => a -> a -> Bool
== CmmType -> Width
typeWidth CmmType
pk__2
            then forall a. a -> OrdList a
unitOL (Format -> Reg -> AddrMode -> Instr
ST Format
pk Reg
src__2 AddrMode
dst__2)
            else forall a. [a] -> OrdList a
toOL   [ Format -> Format -> Reg -> Reg -> Instr
FxTOy (CmmType -> Format
cmmTypeFormat CmmType
pk__2) Format
pk Reg
src__2 Reg
tmp1
                        , Format -> Reg -> AddrMode -> Instr
ST    Format
pk Reg
tmp1 AddrMode
dst__2]
    forall (m :: * -> *) a. Monad m => a -> m a
return InstrBlock
code__2

-- Floating point assignment to a register/temporary
assignReg_FltCode :: Format -> CmmReg  -> CmmExpr -> NatM InstrBlock
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_FltCode Format
pk CmmReg
dstCmmReg CmmExpr
srcCmmExpr = do
    Platform
platform <- NatM Platform
getPlatform
    Register
srcRegister <- CmmExpr -> NatM Register
getRegister CmmExpr
srcCmmExpr
    let dstReg :: Reg
dstReg  = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
dstCmmReg

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Register
srcRegister of
        Any Format
_ Reg -> InstrBlock
code                  -> Reg -> InstrBlock
code Reg
dstReg
        Fixed Format
_ Reg
srcFixedReg InstrBlock
srcCode -> InstrBlock
srcCode forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> Instr
FMOV Format
pk Reg
srcFixedReg Reg
dstReg




genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock

genJump :: CmmExpr -> NatM InstrBlock
genJump (CmmLit (CmmLabel CLabel
lbl))
  = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> OrdList a
toOL [Either Imm Reg -> Int -> Bool -> Instr
CALL (forall a b. a -> Either a b
Left Imm
target) Int
0 Bool
True, Instr
NOP])
  where
    target :: Imm
target = CLabel -> Imm
ImmCLbl CLabel
lbl

genJump CmmExpr
tree
  = do
        (Reg
target, InstrBlock
code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
tree
        forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
code forall a. OrdList a -> a -> OrdList a
`snocOL` AddrMode -> Instr
JMP (Reg -> Reg -> AddrMode
AddrRegReg Reg
target Reg
g0)  forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
NOP)

-- -----------------------------------------------------------------------------
--  Unconditional branches

genBranch :: BlockId -> NatM InstrBlock
genBranch :: Label -> NatM InstrBlock
genBranch = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> OrdList a
toOL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label -> [Instr]
mkJumpInstr


-- -----------------------------------------------------------------------------
--  Conditional jumps

{-
Conditional jumps are always to local labels, so we can use branch
instructions.  We peek at the arguments to decide what kind of
comparison to do.

SPARC: First, we have to ensure that the condition codes are set
according to the supplied comparison operation.  We generate slightly
different code for floating point comparisons, because a floating
point operation cannot directly precede a @BF@.  We assume the worst
and fill that slot with a @NOP@.

SPARC: Do not fill the delay slots here; you will confuse the register
allocator.
-}


genCondJump
    :: BlockId      -- the branch target
    -> CmmExpr      -- the condition on which to branch
    -> NatM InstrBlock



genCondJump :: Label -> CmmExpr -> NatM InstrBlock
genCondJump Label
bid CmmExpr
bool = do
  CondCode Bool
is_float Cond
cond InstrBlock
code <- CmmExpr -> NatM CondCode
getCondCode CmmExpr
bool
  forall (m :: * -> *) a. Monad m => a -> m a
return (
       InstrBlock
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
       forall a. [a] -> OrdList a
toOL (
         if   Bool
is_float
         then [Instr
NOP, Cond -> Bool -> Label -> Instr
BF Cond
cond Bool
False Label
bid, Instr
NOP]
         else [Cond -> Bool -> Label -> Instr
BI Cond
cond Bool
False Label
bid, Instr
NOP]
       )
    )



-- -----------------------------------------------------------------------------
-- Generating a table-branch

genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch NCGConfig
config CmmExpr
expr SwitchTargets
targets
        | NCGConfig -> Bool
ncgPIC NCGConfig
config
        = forall a. HasCallStack => String -> a
error String
"MachCodeGen: sparc genSwitch PIC not finished\n"

        | Bool
otherwise
        = do    (Reg
e_reg, InstrBlock
e_code) <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset (NCGConfig -> Platform
ncgPlatform NCGConfig
config) CmmExpr
expr Int
offset)

                Reg
base_reg        <- Format -> NatM Reg
getNewRegNat Format
II32
                Reg
offset_reg      <- Format -> NatM Reg
getNewRegNat Format
II32
                Reg
dst             <- Format -> NatM Reg
getNewRegNat Format
II32

                CLabel
label           <- NatM CLabel
getNewLabelNat

                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ InstrBlock
e_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                 forall a. [a] -> OrdList a
toOL
                        [ -- load base of jump table
                          Imm -> Reg -> Instr
SETHI (Imm -> Imm
HI (CLabel -> Imm
ImmCLbl CLabel
label)) Reg
base_reg
                        , Bool -> Reg -> RI -> Reg -> Instr
OR    Bool
False Reg
base_reg (Imm -> RI
RIImm forall a b. (a -> b) -> a -> b
$ Imm -> Imm
LO forall a b. (a -> b) -> a -> b
$ CLabel -> Imm
ImmCLbl CLabel
label) Reg
base_reg

                        -- the addrs in the table are 32 bits wide..
                        , Reg -> RI -> Reg -> Instr
SLL   Reg
e_reg (Imm -> RI
RIImm forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt Int
2) Reg
offset_reg

                        -- load and jump to the destination
                        , Format -> AddrMode -> Reg -> Instr
LD      Format
II32 (Reg -> Reg -> AddrMode
AddrRegReg Reg
base_reg Reg
offset_reg) Reg
dst
                        , AddrMode -> [Maybe Label] -> CLabel -> Instr
JMP_TBL (Reg -> Imm -> AddrMode
AddrRegImm Reg
dst (Int -> Imm
ImmInt Int
0)) [Maybe Label]
ids CLabel
label
                        , Instr
NOP ]
  where (Int
offset, [Maybe Label]
ids) = SwitchTargets -> (Int, [Maybe Label])
switchTargetsToTable SwitchTargets
targets

generateJumpTableForInstr :: Platform -> Instr
                          -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr :: Platform -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr Platform
platform (JMP_TBL AddrMode
_ [Maybe Label]
ids CLabel
label) =
  let jumpTable :: [CmmStatic]
jumpTable = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Maybe Label -> CmmStatic
jumpTableEntry Platform
platform) [Maybe Label]
ids
  in forall a. a -> Maybe a
Just (forall d h g. Section -> d -> GenCmmDecl d h g
CmmData (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
label) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
label [CmmStatic]
jumpTable))
generateJumpTableForInstr Platform
_ Instr
_ = forall a. Maybe a
Nothing



-- -----------------------------------------------------------------------------
-- Generating C calls

{-
   Now the biggest nightmare---calls.  Most of the nastiness is buried in
   @get_arg@, which moves the arguments to the correct registers/stack
   locations.  Apart from that, the code is easy.

   The SPARC calling convention is an absolute
   nightmare.  The first 6x32 bits of arguments are mapped into
   %o0 through %o5, and the remaining arguments are dumped to the
   stack, beginning at [%sp+92].  (Note that %o6 == %sp.)

   If we have to put args on the stack, move %o6==%sp down by
   the number of words to go on the stack, to ensure there's enough space.

   According to Fraser and Hanson's lcc book, page 478, fig 17.2,
   16 words above the stack pointer is a word for the address of
   a structure return value.  I use this as a temporary location
   for moving values from float to int regs.  Certainly it isn't
   safe to put anything in the 16 words starting at %sp, since
   this area can get trashed at any time due to window overflows
   caused by signal handlers.

   A final complication (if the above isn't enough) is that
   we can't blithely calculate the arguments one by one into
   %o0 .. %o5.  Consider the following nested calls:

       fff a (fff b c)

   Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately
   the inner call will itself use %o0, which trashes the value put there
   in preparation for the outer call.  Upshot: we need to calculate the
   args into temporary regs, and move those to arg regs or onto the
   stack only immediately prior to the call proper.  Sigh.
-}

genCCall
    :: ForeignTarget            -- function to call
    -> [CmmFormal]        -- where to put the result
    -> [CmmActual]        -- arguments (of mixed type)
    -> NatM InstrBlock



-- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream
-- are guaranteed to take place before writes afterwards (unlike on PowerPC).
-- Ref: Section 8.4 of the SPARC V9 Architecture manual.
--
-- In the SPARC case we don't need a barrier.
--
genCCall :: ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM InstrBlock
genCCall (PrimTarget CallishMachOp
MO_ReadBarrier) [CmmFormal]
_ [CmmExpr]
_
 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. OrdList a
nilOL
genCCall (PrimTarget CallishMachOp
MO_WriteBarrier) [CmmFormal]
_ [CmmExpr]
_
 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. OrdList a
nilOL

genCCall (PrimTarget (MO_Prefetch_Data Int
_)) [CmmFormal]
_ [CmmExpr]
_
 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. OrdList a
nilOL

genCCall ForeignTarget
target [CmmFormal]
dest_regs [CmmExpr]
args
 = do   -- work out the arguments, and assign them to integer regs
        [(InstrBlock, [Reg])]
argcode_and_vregs       <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs [CmmExpr]
args
        let ([InstrBlock]
argcodes, [[Reg]]
vregss)  = forall a b. [(a, b)] -> ([a], [b])
unzip [(InstrBlock, [Reg])]
argcode_and_vregs
        let vregs :: [Reg]
vregs               = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Reg]]
vregss

        let n_argRegs :: Int
n_argRegs           = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
allArgRegs
        let n_argRegs_used :: Int
n_argRegs_used      = forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
vregs) Int
n_argRegs


        -- deal with static vs dynamic call targets
        InstrBlock
callinsns <- case ForeignTarget
target of
                ForeignTarget (CmmLit (CmmLabel CLabel
lbl)) ForeignConvention
_ ->
                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> OrdList a
unitOL (Either Imm Reg -> Int -> Bool -> Instr
CALL (forall a b. a -> Either a b
Left (CmmLit -> Imm
litToImm (CLabel -> CmmLit
CmmLabel CLabel
lbl))) Int
n_argRegs_used Bool
False))

                ForeignTarget CmmExpr
expr ForeignConvention
_
                 -> do  (InstrBlock
dyn_c, [Reg]
dyn_rs) <- CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs CmmExpr
expr
                        let dyn_r :: Reg
dyn_r = case [Reg]
dyn_rs of
                                      [Reg
dyn_r'] -> Reg
dyn_r'
                                      [Reg]
_ -> forall a. String -> a
panic String
"SPARC.CodeGen.genCCall: arg_to_int"
                        forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
dyn_c forall a. OrdList a -> a -> OrdList a
`snocOL` Either Imm Reg -> Int -> Bool -> Instr
CALL (forall a b. b -> Either a b
Right Reg
dyn_r) Int
n_argRegs_used Bool
False)

                PrimTarget CallishMachOp
mop
                 -> do  Either CLabel CmmExpr
res     <- CallishMachOp -> NatM (Either CLabel CmmExpr)
outOfLineMachOp CallishMachOp
mop
                        case Either CLabel CmmExpr
res of
                                Left CLabel
lbl ->
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> OrdList a
unitOL (Either Imm Reg -> Int -> Bool -> Instr
CALL (forall a b. a -> Either a b
Left (CmmLit -> Imm
litToImm (CLabel -> CmmLit
CmmLabel CLabel
lbl))) Int
n_argRegs_used Bool
False))

                                Right CmmExpr
mopExpr -> do
                                        (InstrBlock
dyn_c, [Reg]
dyn_rs) <- CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs CmmExpr
mopExpr
                                        let dyn_r :: Reg
dyn_r = case [Reg]
dyn_rs of
                                                      [Reg
dyn_r'] -> Reg
dyn_r'
                                                      [Reg]
_ -> forall a. String -> a
panic String
"SPARC.CodeGen.genCCall: arg_to_int"
                                        forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
dyn_c forall a. OrdList a -> a -> OrdList a
`snocOL` Either Imm Reg -> Int -> Bool -> Instr
CALL (forall a b. b -> Either a b
Right Reg
dyn_r) Int
n_argRegs_used Bool
False)

        let argcode :: InstrBlock
argcode = forall a. [OrdList a] -> OrdList a
concatOL [InstrBlock]
argcodes

        let (InstrBlock
move_sp_down, InstrBlock
move_sp_up)
                   = let diff :: Int
diff = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
vregs forall a. Num a => a -> a -> a
- Int
n_argRegs
                         nn :: Int
nn   = if forall a. Integral a => a -> Bool
odd Int
diff then Int
diff forall a. Num a => a -> a -> a
+ Int
1 else Int
diff -- keep 8-byte alignment
                     in  if   Int
nn forall a. Ord a => a -> a -> Bool
<= Int
0
                         then (forall a. OrdList a
nilOL, forall a. OrdList a
nilOL)
                         else (forall a. a -> OrdList a
unitOL (Int -> Instr
moveSp (-Int
1forall a. Num a => a -> a -> a
*Int
nn)), forall a. a -> OrdList a
unitOL (Int -> Instr
moveSp (Int
1forall a. Num a => a -> a -> a
*Int
nn)))

        let transfer_code :: InstrBlock
transfer_code
                = forall a. [a] -> OrdList a
toOL ([Reg] -> [Reg] -> Int -> [Instr]
move_final [Reg]
vregs [Reg]
allArgRegs Int
extraStackArgsHere)

        Platform
platform <- NatM Platform
getPlatform
        forall (m :: * -> *) a. Monad m => a -> m a
return
         forall a b. (a -> b) -> a -> b
$      InstrBlock
argcode                 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                InstrBlock
move_sp_down            forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                InstrBlock
transfer_code           forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                InstrBlock
callinsns               forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                forall a. a -> OrdList a
unitOL Instr
NOP              forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                InstrBlock
move_sp_up              forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                Platform -> [CmmFormal] -> InstrBlock
assign_code Platform
platform [CmmFormal]
dest_regs


-- | Generate code to calculate an argument, and move it into one
--      or two integer vregs.
arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
arg_to_int_vregs :: CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs CmmExpr
arg = do Platform
platform <- NatM Platform
getPlatform
                          Platform -> CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs' Platform
platform CmmExpr
arg

arg_to_int_vregs' :: Platform -> CmmExpr -> NatM (OrdList Instr, [Reg])
arg_to_int_vregs' :: Platform -> CmmExpr -> NatM (InstrBlock, [Reg])
arg_to_int_vregs' Platform
platform CmmExpr
arg

        -- If the expr produces a 64 bit int, then we can just use iselExpr64
        | CmmType -> Bool
isWord64 (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg)
        = do    (ChildCode64 InstrBlock
code Reg
r_lo) <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
arg
                let r_hi :: Reg
r_hi                = Reg -> Reg
getHiVRegFromLo Reg
r_lo
                forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
code, [Reg
r_hi, Reg
r_lo])

        | Bool
otherwise
        = do    (Reg
src, InstrBlock
code)     <- CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg CmmExpr
arg
                let pk :: CmmType
pk          = Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform CmmExpr
arg

                case CmmType -> Format
cmmTypeFormat CmmType
pk of

                 -- Load a 64 bit float return value into two integer regs.
                 Format
FF64 -> do
                        Reg
v1 <- Format -> NatM Reg
getNewRegNat Format
II32
                        Reg
v2 <- Format -> NatM Reg
getNewRegNat Format
II32

                        let code2 :: InstrBlock
code2 =
                                InstrBlock
code                            forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> Reg -> Reg -> Instr
FMOV Format
FF64 Reg
src Reg
f0                forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> Reg -> AddrMode -> Instr
ST   Format
FF32  Reg
f0 (Int -> AddrMode
spRel Int
16)        forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> AddrMode -> Reg -> Instr
LD   Format
II32  (Int -> AddrMode
spRel Int
16) Reg
v1        forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> Reg -> AddrMode -> Instr
ST   Format
FF32  Reg
f1 (Int -> AddrMode
spRel Int
16)        forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> AddrMode -> Reg -> Instr
LD   Format
II32  (Int -> AddrMode
spRel Int
16) Reg
v2

                        forall (m :: * -> *) a. Monad m => a -> m a
return  (InstrBlock
code2, [Reg
v1,Reg
v2])

                 -- Load a 32 bit float return value into an integer reg
                 Format
FF32 -> do
                        Reg
v1 <- Format -> NatM Reg
getNewRegNat Format
II32

                        let code2 :: InstrBlock
code2 =
                                InstrBlock
code                            forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> Reg -> AddrMode -> Instr
ST   Format
FF32  Reg
src (Int -> AddrMode
spRel Int
16)       forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Format -> AddrMode -> Reg -> Instr
LD   Format
II32  (Int -> AddrMode
spRel Int
16) Reg
v1

                        forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
code2, [Reg
v1])

                 -- Move an integer return value into its destination reg.
                 Format
_ -> do
                        Reg
v1 <- Format -> NatM Reg
getNewRegNat Format
II32

                        let code2 :: InstrBlock
code2 =
                                InstrBlock
code                            forall a. OrdList a -> a -> OrdList a
`snocOL`
                                Bool -> Reg -> RI -> Reg -> Instr
OR Bool
False Reg
g0 (Reg -> RI
RIReg Reg
src) Reg
v1

                        forall (m :: * -> *) a. Monad m => a -> m a
return (InstrBlock
code2, [Reg
v1])


-- | Move args from the integer vregs into which they have been
--      marshalled, into %o0 .. %o5, and the rest onto the stack.
--
move_final :: [Reg] -> [Reg] -> Int -> [Instr]

-- all args done
move_final :: [Reg] -> [Reg] -> Int -> [Instr]
move_final [] [Reg]
_ Int
_
        = []

-- out of aregs; move to stack
move_final (Reg
v:[Reg]
vs) [] Int
offset
        = Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
v (Int -> AddrMode
spRel Int
offset)
        forall a. a -> [a] -> [a]
: [Reg] -> [Reg] -> Int -> [Instr]
move_final [Reg]
vs [] (Int
offsetforall a. Num a => a -> a -> a
+Int
1)

-- move into an arg (%o[0..5]) reg
move_final (Reg
v:[Reg]
vs) (Reg
a:[Reg]
az) Int
offset
        = Bool -> Reg -> RI -> Reg -> Instr
OR Bool
False Reg
g0 (Reg -> RI
RIReg Reg
v) Reg
a
        forall a. a -> [a] -> [a]
: [Reg] -> [Reg] -> Int -> [Instr]
move_final [Reg]
vs [Reg]
az Int
offset


-- | Assign results returned from the call into their
--      destination regs.
--
assign_code :: Platform -> [LocalReg] -> OrdList Instr

assign_code :: Platform -> [CmmFormal] -> InstrBlock
assign_code Platform
_ [] = forall a. OrdList a
nilOL

assign_code Platform
platform [CmmFormal
dest]
 = let  rep :: CmmType
rep     = CmmFormal -> CmmType
localRegType CmmFormal
dest
        width :: Width
width   = CmmType -> Width
typeWidth CmmType
rep
        r_dest :: Reg
r_dest  = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dest)

        result :: InstrBlock
result
                | CmmType -> Bool
isFloatType CmmType
rep
                , Width
W32   <- Width
width
                = forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
FMOV Format
FF32 (Int -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ Int -> Int
fReg Int
0) Reg
r_dest

                | CmmType -> Bool
isFloatType CmmType
rep
                , Width
W64   <- Width
width
                = forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
FMOV Format
FF64 (Int -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ Int -> Int
fReg Int
0) Reg
r_dest

                | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CmmType -> Bool
isFloatType CmmType
rep
                , Width
W32   <- Width
width
                = forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform (Int -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ Int -> Int
oReg Int
0) Reg
r_dest

                | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CmmType -> Bool
isFloatType CmmType
rep
                , Width
W64           <- Width
width
                , Reg
r_dest_hi     <- Reg -> Reg
getHiVRegFromLo Reg
r_dest
                = forall a. [a] -> OrdList a
toOL  [ Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform (Int -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ Int -> Int
oReg Int
0) Reg
r_dest_hi
                        , Platform -> Reg -> Reg -> Instr
mkRegRegMoveInstr Platform
platform (Int -> Reg
regSingle forall a b. (a -> b) -> a -> b
$ Int -> Int
oReg Int
1) Reg
r_dest]

                | Bool
otherwise
                = forall a. String -> a
panic String
"SPARC.CodeGen.GenCCall: no match"

   in   InstrBlock
result

assign_code Platform
_ [CmmFormal]
_
        = forall a. String -> a
panic String
"SPARC.CodeGen.GenCCall: no match"



-- | Generate a call to implement an out-of-line floating point operation
outOfLineMachOp
        :: CallishMachOp
        -> NatM (Either CLabel CmmExpr)

outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr)
outOfLineMachOp CallishMachOp
mop
 = do   let functionName :: FastString
functionName
                = CallishMachOp -> FastString
outOfLineMachOp_table CallishMachOp
mop

        NCGConfig
config  <- NatM NCGConfig
getConfig
        CmmExpr
mopExpr <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference
                forall a b. (a -> b) -> a -> b
$  FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
functionName forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInExternalPackage FunctionOrData
IsFunction

        let mopLabelOrExpr :: Either CLabel CmmExpr
mopLabelOrExpr
                = case CmmExpr
mopExpr of
                        CmmLit (CmmLabel CLabel
lbl)   -> forall a b. a -> Either a b
Left CLabel
lbl
                        CmmExpr
_                       -> forall a b. b -> Either a b
Right CmmExpr
mopExpr

        forall (m :: * -> *) a. Monad m => a -> m a
return Either CLabel CmmExpr
mopLabelOrExpr


-- | Decide what C function to use to implement a CallishMachOp
--
outOfLineMachOp_table
        :: CallishMachOp
        -> FastString

outOfLineMachOp_table :: CallishMachOp -> FastString
outOfLineMachOp_table CallishMachOp
mop
 = case CallishMachOp
mop of
        CallishMachOp
MO_F32_Exp    -> String -> FastString
fsLit String
"expf"
        CallishMachOp
MO_F32_ExpM1  -> String -> FastString
fsLit String
"expm1f"
        CallishMachOp
MO_F32_Log    -> String -> FastString
fsLit String
"logf"
        CallishMachOp
MO_F32_Log1P  -> String -> FastString
fsLit String
"log1pf"
        CallishMachOp
MO_F32_Sqrt   -> String -> FastString
fsLit String
"sqrtf"
        CallishMachOp
MO_F32_Fabs   -> FastString
unsupported
        CallishMachOp
MO_F32_Pwr    -> String -> FastString
fsLit String
"powf"

        CallishMachOp
MO_F32_Sin    -> String -> FastString
fsLit String
"sinf"
        CallishMachOp
MO_F32_Cos    -> String -> FastString
fsLit String
"cosf"
        CallishMachOp
MO_F32_Tan    -> String -> FastString
fsLit String
"tanf"

        CallishMachOp
MO_F32_Asin   -> String -> FastString
fsLit String
"asinf"
        CallishMachOp
MO_F32_Acos   -> String -> FastString
fsLit String
"acosf"
        CallishMachOp
MO_F32_Atan   -> String -> FastString
fsLit String
"atanf"

        CallishMachOp
MO_F32_Sinh   -> String -> FastString
fsLit String
"sinhf"
        CallishMachOp
MO_F32_Cosh   -> String -> FastString
fsLit String
"coshf"
        CallishMachOp
MO_F32_Tanh   -> String -> FastString
fsLit String
"tanhf"

        CallishMachOp
MO_F32_Asinh  -> String -> FastString
fsLit String
"asinhf"
        CallishMachOp
MO_F32_Acosh  -> String -> FastString
fsLit String
"acoshf"
        CallishMachOp
MO_F32_Atanh  -> String -> FastString
fsLit String
"atanhf"

        CallishMachOp
MO_F64_Exp    -> String -> FastString
fsLit String
"exp"
        CallishMachOp
MO_F64_ExpM1  -> String -> FastString
fsLit String
"expm1"
        CallishMachOp
MO_F64_Log    -> String -> FastString
fsLit String
"log"
        CallishMachOp
MO_F64_Log1P  -> String -> FastString
fsLit String
"log1p"
        CallishMachOp
MO_F64_Sqrt   -> String -> FastString
fsLit String
"sqrt"
        CallishMachOp
MO_F64_Fabs   -> FastString
unsupported
        CallishMachOp
MO_F64_Pwr    -> String -> FastString
fsLit String
"pow"

        CallishMachOp
MO_F64_Sin    -> String -> FastString
fsLit String
"sin"
        CallishMachOp
MO_F64_Cos    -> String -> FastString
fsLit String
"cos"
        CallishMachOp
MO_F64_Tan    -> String -> FastString
fsLit String
"tan"

        CallishMachOp
MO_F64_Asin   -> String -> FastString
fsLit String
"asin"
        CallishMachOp
MO_F64_Acos   -> String -> FastString
fsLit String
"acos"
        CallishMachOp
MO_F64_Atan   -> String -> FastString
fsLit String
"atan"

        CallishMachOp
MO_F64_Sinh   -> String -> FastString
fsLit String
"sinh"
        CallishMachOp
MO_F64_Cosh   -> String -> FastString
fsLit String
"cosh"
        CallishMachOp
MO_F64_Tanh   -> String -> FastString
fsLit String
"tanh"

        CallishMachOp
MO_F64_Asinh  -> String -> FastString
fsLit String
"asinh"
        CallishMachOp
MO_F64_Acosh  -> String -> FastString
fsLit String
"acosh"
        CallishMachOp
MO_F64_Atanh  -> String -> FastString
fsLit String
"atanh"

        CallishMachOp
MO_I64_ToI   -> String -> FastString
fsLit String
"hs_int64ToInt"
        CallishMachOp
MO_I64_FromI -> String -> FastString
fsLit String
"hs_intToInt64"
        CallishMachOp
MO_W64_ToW   -> String -> FastString
fsLit String
"hs_word64ToWord"
        CallishMachOp
MO_W64_FromW -> String -> FastString
fsLit String
"hs_wordToWord64"
        CallishMachOp
MO_x64_Neg   -> String -> FastString
fsLit String
"hs_neg64"
        CallishMachOp
MO_x64_Add   -> String -> FastString
fsLit String
"hs_add64"
        CallishMachOp
MO_x64_Sub   -> String -> FastString
fsLit String
"hs_sub64"
        CallishMachOp
MO_x64_Mul   -> String -> FastString
fsLit String
"hs_mul64"
        CallishMachOp
MO_I64_Quot  -> String -> FastString
fsLit String
"hs_quotInt64"
        CallishMachOp
MO_I64_Rem   -> String -> FastString
fsLit String
"hs_remInt64"
        CallishMachOp
MO_W64_Quot  -> String -> FastString
fsLit String
"hs_quotWord64"
        CallishMachOp
MO_W64_Rem   -> String -> FastString
fsLit String
"hs_remWord64"
        CallishMachOp
MO_x64_And   -> String -> FastString
fsLit String
"hs_and64"
        CallishMachOp
MO_x64_Or    -> String -> FastString
fsLit String
"hs_or64"
        CallishMachOp
MO_x64_Xor   -> String -> FastString
fsLit String
"hs_xor64"
        CallishMachOp
MO_x64_Not   -> String -> FastString
fsLit String
"hs_not64"
        CallishMachOp
MO_x64_Shl   -> String -> FastString
fsLit String
"hs_uncheckedShiftL64"
        CallishMachOp
MO_I64_Shr   -> String -> FastString
fsLit String
"hs_uncheckedIShiftRA64"
        CallishMachOp
MO_W64_Shr   -> String -> FastString
fsLit String
"hs_uncheckedShiftRL64"
        CallishMachOp
MO_x64_Eq    -> String -> FastString
fsLit String
"hs_eq64"
        CallishMachOp
MO_x64_Ne    -> String -> FastString
fsLit String
"hs_ne64"
        CallishMachOp
MO_I64_Ge    -> String -> FastString
fsLit String
"hs_geInt64"
        CallishMachOp
MO_I64_Gt    -> String -> FastString
fsLit String
"hs_gtInt64"
        CallishMachOp
MO_I64_Le    -> String -> FastString
fsLit String
"hs_leInt64"
        CallishMachOp
MO_I64_Lt    -> String -> FastString
fsLit String
"hs_ltInt64"
        CallishMachOp
MO_W64_Ge    -> String -> FastString
fsLit String
"hs_geWord64"
        CallishMachOp
MO_W64_Gt    -> String -> FastString
fsLit String
"hs_gtWord64"
        CallishMachOp
MO_W64_Le    -> String -> FastString
fsLit String
"hs_leWord64"
        CallishMachOp
MO_W64_Lt    -> String -> FastString
fsLit String
"hs_ltWord64"

        MO_UF_Conv Width
w -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
word2FloatLabel Width
w

        MO_Memcpy Int
_  -> String -> FastString
fsLit String
"memcpy"
        MO_Memset Int
_  -> String -> FastString
fsLit String
"memset"
        MO_Memmove Int
_ -> String -> FastString
fsLit String
"memmove"
        MO_Memcmp Int
_  -> String -> FastString
fsLit String
"memcmp"

        MO_BSwap Width
w   -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
bSwapLabel Width
w
        MO_BRev Width
w    -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
bRevLabel Width
w
        MO_PopCnt Width
w  -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
popCntLabel Width
w
        MO_Pdep Width
w    -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
pdepLabel Width
w
        MO_Pext Width
w    -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
pextLabel Width
w
        MO_Clz Width
w     -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
clzLabel Width
w
        MO_Ctz Width
w     -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
ctzLabel Width
w
        MO_AtomicRMW Width
w AtomicMachOp
amop -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> AtomicMachOp -> String
atomicRMWLabel Width
w AtomicMachOp
amop
        MO_Cmpxchg Width
w -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
cmpxchgLabel Width
w
        MO_Xchg Width
w -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
xchgLabel Width
w
        MO_AtomicRead Width
w -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
atomicReadLabel Width
w
        MO_AtomicWrite Width
w -> String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
atomicWriteLabel Width
w

        MO_S_Mul2    {}  -> FastString
unsupported
        MO_S_QuotRem {}  -> FastString
unsupported
        MO_U_QuotRem {}  -> FastString
unsupported
        MO_U_QuotRem2 {} -> FastString
unsupported
        MO_Add2 {}       -> FastString
unsupported
        MO_AddWordC {}   -> FastString
unsupported
        MO_SubWordC {}   -> FastString
unsupported
        MO_AddIntC {}    -> FastString
unsupported
        MO_SubIntC {}    -> FastString
unsupported
        MO_U_Mul2 {}     -> FastString
unsupported
        CallishMachOp
MO_ReadBarrier   -> FastString
unsupported
        CallishMachOp
MO_WriteBarrier  -> FastString
unsupported
        CallishMachOp
MO_Touch         -> FastString
unsupported
        (MO_Prefetch_Data Int
_) -> FastString
unsupported
    where unsupported :: FastString
unsupported = forall a. String -> a
panic (String
"outOfLineCmmOp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CallishMachOp
mop
                            forall a. [a] -> [a] -> [a]
++ String
" not supported here")