{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
module GHC.CmmToAsm.PPC.CodeGen (
cmmTopCodeGen,
generateJumpTableForInstr,
InstrBlock
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Platform.Regs
import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.CPrim
import GHC.CmmToAsm.Types
import GHC.Cmm.DebugBlock
( DebugBlock(..) )
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat
, getBlockIdNat, getPicBaseNat, getNewRegPairNat
, getPicBaseMaybeNat, getPlatform, getConfig
, getDebugBlock, getFileId
)
import GHC.CmmToAsm.PIC
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Config
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.CmmToAsm.Reg.Target
import GHC.Platform
import GHC.Cmm.BlockId
import GHC.Cmm.Ppr ( pprExpr )
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Types.Tickish ( GenTickish(..) )
import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
import GHC.Data.OrdList
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Control.Monad ( mapAndUnzipM, when )
import Data.Word
import GHC.Types.Basic
import GHC.Data.FastString
import GHC.Utils.Misc
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
Platform
platform <- NatM Platform
getPlatform
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)
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
os :: OS
os = Platform -> OS
platformOS Platform
platform
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
case Arch
arch of
Arch
ArchPPC | OS
os forall a. Eq a => a -> a -> Bool
== OS
OSAIX -> forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl RawCmmStatics Instr]
tops
| Bool
otherwise -> do
Maybe Reg
picBaseMb <- NatM (Maybe Reg)
getPicBaseMaybeNat
case Maybe Reg
picBaseMb of
Just Reg
picBase -> Arch
-> OS
-> Reg
-> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
initializePicBase_ppc Arch
arch OS
os Reg
picBase [NatCmmDecl RawCmmStatics Instr]
tops
Maybe Reg
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl RawCmmStatics Instr]
tops
ArchPPC_64 PPC_64ABI
ELF_V1 -> forall {m :: * -> *} {d} {h} {i}.
MonadUnique m =>
[GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
fixup_entry [NatCmmDecl RawCmmStatics Instr]
tops
ArchPPC_64 PPC_64ABI
ELF_V2 -> forall {m :: * -> *} {d} {h} {i}.
MonadUnique m =>
[GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
fixup_entry [NatCmmDecl RawCmmStatics Instr]
tops
Arch
_ -> forall a. String -> a
panic String
"PPC.cmmTopCodeGen: unknown arch"
where
fixup_entry :: [GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
fixup_entry (CmmProc h
info CLabel
lab [GlobalReg]
live (ListGraph (GenBasicBlock i
entry:[GenBasicBlock i]
blocks)) : [GenCmmDecl d h (ListGraph i)]
statics)
= do
let BasicBlock BlockId
bID [i]
insns = GenBasicBlock i
entry
BlockId
bID' <- if CLabel
lab forall a. Eq a => a -> a -> Bool
== (BlockId -> CLabel
blockLbl BlockId
bID)
then forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
else forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
bID
let b' :: GenBasicBlock i
b' = forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID' [i]
insns
forall (m :: * -> *) a. Monad m => a -> m a
return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc h
info CLabel
lab [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph (GenBasicBlock i
b'forall a. a -> [a] -> [a]
:[GenBasicBlock i]
blocks)) forall a. a -> [a] -> [a]
: [GenCmmDecl d h (ListGraph i)]
statics)
fixup_entry [GenCmmDecl d h (ListGraph i)]
_ = forall a. String -> a
panic String
"cmmTopCodegen: Broken CmmProc"
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]
basicBlockCodeGen
:: Block CmmNode C C
-> 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 :: BlockId
id = forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
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
Maybe DebugBlock
dbg <- BlockId -> NatM (Maybe DebugBlock)
getDebugBlock (forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmBlock
block)
OrdList Instr
loc_instrs <- case DebugBlock -> Maybe CmmTickish
dblSourceTick forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe DebugBlock
dbg of
Just (SourceNote RealSrcSpan
span String
name)
-> do Int
fileid <- FastString -> NatM Int
getFileId (RealSrcSpan -> FastString
srcSpanFile RealSrcSpan
span)
let line :: Int
line = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
span; col :: Int
col =RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
span
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> String -> Instr
LOCATION Int
fileid Int
line Int
col String
name
Maybe CmmTickish
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. OrdList a
nilOL
OrdList Instr
mid_instrs <- forall (e :: Extensibility) (x :: Extensibility).
[CmmNode e x] -> NatM (OrdList Instr)
stmtsToInstrs [CmmNode O O]
stmts
OrdList Instr
tail_instrs <- forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM (OrdList Instr)
stmtToInstrs CmmNode O C
tail
let instrs :: OrdList Instr
instrs = OrdList Instr
loc_instrs forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
mid_instrs forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
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 ([],[],[]) OrdList Instr
instrs
mkBlocks :: Instr
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
-> ([Instr], [NatBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
mkBlocks (NEWBLOCK BlockId
id) ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
= ([], forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
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)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
top forall a. a -> [a] -> [a]
: [NatBasicBlock Instr]
other_blocks, [NatCmmDecl RawCmmStatics Instr]
statics)
stmtsToInstrs :: [CmmNode e x] -> NatM InstrBlock
stmtsToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
[CmmNode e x] -> NatM (OrdList Instr)
stmtsToInstrs [CmmNode e x]
stmts
= do [OrdList Instr]
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 (OrdList Instr)
stmtToInstrs [CmmNode e x]
stmts
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [OrdList a] -> OrdList a
concatOL [OrdList Instr]
instrss)
stmtToInstrs :: CmmNode e x -> NatM InstrBlock
stmtToInstrs :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM (OrdList Instr)
stmtToInstrs CmmNode e x
stmt = do
NCGConfig
config <- NatM NCGConfig
getConfig
Platform
platform <- NatM Platform
getPlatform
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 (OrdList Instr)
assignReg_FltCode Format
format CmmReg
reg CmmExpr
src
| Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&&
CmmType -> Bool
isWord64 CmmType
ty -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_I64Code CmmReg
reg CmmExpr
src
| Bool
otherwise -> Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
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
_alignment
| CmmType -> Bool
isFloatType CmmType
ty -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_FltCode Format
format CmmExpr
addr CmmExpr
src
| Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&&
CmmType -> Bool
isWord64 CmmType
ty -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_I64Code CmmExpr
addr CmmExpr
src
| Bool
otherwise -> Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
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 (OrdList Instr)
genCCall ForeignTarget
target [CmmFormal]
result_regs [CmmExpr]
args
CmmBranch BlockId
id -> BlockId -> NatM (OrdList Instr)
genBranch BlockId
id
CmmCondBranch CmmExpr
arg BlockId
true BlockId
false Maybe Bool
prediction -> do
OrdList Instr
b1 <- BlockId -> CmmExpr -> Maybe Bool -> NatM (OrdList Instr)
genCondJump BlockId
true CmmExpr
arg Maybe Bool
prediction
OrdList Instr
b2 <- BlockId -> NatM (OrdList Instr)
genBranch BlockId
false
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
b1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
b2)
CmmSwitch CmmExpr
arg SwitchTargets
ids -> NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
genSwitch NCGConfig
config CmmExpr
arg SwitchTargets
ids
CmmCall { cml_target :: CmmNode O C -> CmmExpr
cml_target = CmmExpr
arg
, cml_args_regs :: CmmNode O C -> [GlobalReg]
cml_args_regs = [GlobalReg]
gregs } -> CmmExpr -> [Reg] -> NatM (OrdList Instr)
genJump CmmExpr
arg (Platform -> [GlobalReg] -> [Reg]
jumpRegs Platform
platform [GlobalReg]
gregs)
CmmNode e x
_ ->
forall a. String -> a
panic String
"stmtToInstrs: statement should have been cps'd away"
jumpRegs :: Platform -> [GlobalReg] -> [Reg]
jumpRegs :: Platform -> [GlobalReg] -> [Reg]
jumpRegs Platform
platform [GlobalReg]
gregs = [ RealReg -> Reg
RegReal RealReg
r | Just RealReg
r <- forall a b. (a -> b) -> [a] -> [b]
map (Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform) [GlobalReg]
gregs ]
type InstrBlock
= OrdList Instr
data Register
= Fixed Format Reg InstrBlock
| Any Format (Reg -> InstrBlock)
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep :: Register -> Format -> Register
swizzleRegisterRep (Fixed Format
_ Reg
reg OrdList Instr
code) Format
format = Format -> Reg -> OrdList Instr -> Register
Fixed Format
format Reg
reg OrdList Instr
code
swizzleRegisterRep (Any Format
_ Reg -> OrdList Instr
codefn) Format
format = Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
codefn
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg Platform
_ (CmmLocal (LocalReg Unique
u CmmType
pk))
= VirtualReg -> Reg
RegVirtual forall a b. (a -> b) -> a -> b
$ Unique -> Format -> VirtualReg
mkVirtualReg Unique
u (CmmType -> Format
cmmTypeFormat CmmType
pk)
getRegisterReg Platform
platform (CmmGlobal GlobalReg
mid)
= case Platform -> GlobalReg -> Maybe RealReg
globalRegMaybe Platform
platform GlobalReg
mid of
Just RealReg
reg -> RealReg -> Reg
RegReal RealReg
reg
Maybe RealReg
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegisterReg-memory" (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ GlobalReg -> CmmReg
CmmGlobal GlobalReg
mid)
jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry NCGConfig
config Maybe BlockId
Nothing = CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (NCGConfig -> Width
ncgWordWidth NCGConfig
config))
jumpTableEntry NCGConfig
_ (Just BlockId
blockid) = CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CmmLit
CmmLabel CLabel
blockLabel)
where blockLabel :: CLabel
blockLabel = BlockId -> CLabel
blockLbl BlockId
blockid
mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
mangleIndexTree Platform
platform (CmmRegOff CmmReg
reg Int
off)
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
width) [CmmReg -> CmmExpr
CmmReg CmmReg
reg, CmmLit -> CmmExpr
CmmLit (Integer -> Width -> CmmLit
CmmInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) Width
width)]
where width :: Width
width = CmmType -> Width
typeWidth (Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg)
mangleIndexTree Platform
_ CmmExpr
_
= forall a. String -> a
panic String
"PPC.CodeGen.mangleIndexTree: no match"
data ChildCode64
= ChildCode64
InstrBlock
Reg
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg :: CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr = do
Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
expr
case Register
r of
Any Format
rep Reg -> OrdList Instr
code -> do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
rep
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Reg -> OrdList Instr
code Reg
tmp)
Fixed Format
_ Reg
reg OrdList Instr
code ->
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, OrdList Instr
code)
getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
getI64Amodes CmmExpr
addrTree = do
Amode AddrMode
hi_addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
addrTree
case AddrMode -> Int -> Maybe AddrMode
addrOffset AddrMode
hi_addr Int
4 of
Just AddrMode
lo_addr -> forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode
hi_addr, AddrMode
lo_addr, OrdList Instr
addr_code)
Maybe AddrMode
Nothing -> do (Reg
hi_ptr, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
addrTree
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Imm -> AddrMode
AddrRegImm Reg
hi_ptr (Int -> Imm
ImmInt Int
0),
Reg -> Imm -> AddrMode
AddrRegImm Reg
hi_ptr (Int -> Imm
ImmInt Int
4),
OrdList Instr
code)
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_I64Code CmmExpr
addrTree CmmExpr
valueTree = do
(AddrMode
hi_addr, AddrMode
lo_addr, OrdList Instr
addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
getI64Amodes CmmExpr
addrTree
ChildCode64 OrdList Instr
vcode Reg
rlo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
valueTree
let
rhi :: Reg
rhi = Reg -> Reg
getHiVRegFromLo Reg
rlo
mov_hi :: Instr
mov_hi = Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
rhi AddrMode
hi_addr
mov_lo :: Instr
mov_lo = Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
rlo AddrMode
lo_addr
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
vcode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code :: CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_I64Code (CmmLocal (LocalReg Unique
u_dst CmmType
_)) CmmExpr
valueTree = do
ChildCode64 OrdList Instr
vcode Reg
r_src_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
valueTree
let
r_dst_lo :: Reg
r_dst_lo = VirtualReg -> Reg
RegVirtual forall a b. (a -> b) -> a -> b
$ Unique -> Format -> VirtualReg
mkVirtualReg Unique
u_dst Format
II32
r_dst_hi :: Reg
r_dst_hi = Reg -> Reg
getHiVRegFromLo Reg
r_dst_lo
r_src_hi :: Reg
r_src_hi = Reg -> Reg
getHiVRegFromLo Reg
r_src_lo
mov_lo :: Instr
mov_lo = Reg -> Reg -> Instr
MR Reg
r_dst_lo Reg
r_src_lo
mov_hi :: Instr
mov_hi = Reg -> Reg -> Instr
MR Reg
r_dst_hi Reg
r_src_hi
forall (m :: * -> *) a. Monad m => a -> m a
return (
OrdList Instr
vcode forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi
)
assignReg_I64Code CmmReg
_ CmmExpr
_
= forall a. String -> a
panic String
"assignReg_I64Code(powerpc): invalid lvalue"
iselExpr64 :: CmmExpr -> NatM ChildCode64
iselExpr64 :: CmmExpr -> NatM ChildCode64
iselExpr64 (CmmLoad CmmExpr
addrTree CmmType
ty AlignmentSpec
_) | CmmType -> Bool
isWord64 CmmType
ty = do
(AddrMode
hi_addr, AddrMode
lo_addr, OrdList Instr
addr_code) <- CmmExpr -> NatM (AddrMode, AddrMode, OrdList Instr)
getI64Amodes CmmExpr
addrTree
(Reg
rlo, Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let mov_hi :: Instr
mov_hi = Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
rhi AddrMode
hi_addr
mov_lo :: Instr
mov_lo = Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
rlo AddrMode
lo_addr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> ChildCode64
ChildCode64 (OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
Reg
rlo
iselExpr64 (CmmReg (CmmLocal (LocalReg Unique
vu CmmType
ty))) | CmmType -> Bool
isWord64 CmmType
ty
= forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> ChildCode64
ChildCode64 forall a. OrdList a
nilOL (VirtualReg -> Reg
RegVirtual forall a b. (a -> b) -> a -> b
$ Unique -> Format -> VirtualReg
mkVirtualReg Unique
vu Format
II32))
iselExpr64 (CmmLit (CmmInt Integer
i Width
_)) = do
(Reg
rlo,Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let
half0 :: Int
half0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16)
half1 :: Int
half1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
half2 :: Int
half2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word16)
half3 :: Int
half3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i forall a. Bits a => a -> Int -> a
`shiftR` Int
48) :: Word16)
code :: OrdList Instr
code = forall a. [a] -> OrdList a
toOL [
Reg -> Imm -> Instr
LIS Reg
rlo (Int -> Imm
ImmInt Int
half1),
Reg -> Reg -> RI -> Instr
OR Reg
rlo Reg
rlo (Imm -> RI
RIImm forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt Int
half0),
Reg -> Imm -> Instr
LIS Reg
rhi (Int -> Imm
ImmInt Int
half3),
Reg -> Reg -> RI -> Instr
OR Reg
rhi Reg
rhi (Imm -> RI
RIImm forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt Int
half2)
]
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> ChildCode64
ChildCode64 OrdList Instr
code Reg
rlo)
iselExpr64 (CmmMachOp (MO_Add Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
ChildCode64 OrdList Instr
code1 Reg
r1lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
e1
ChildCode64 OrdList Instr
code2 Reg
r2lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
e2
(Reg
rlo,Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let
r1hi :: Reg
r1hi = Reg -> Reg
getHiVRegFromLo Reg
r1lo
r2hi :: Reg
r2hi = Reg -> Reg
getHiVRegFromLo Reg
r2lo
code :: OrdList Instr
code = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
OrdList Instr
code2 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
forall a. [a] -> OrdList a
toOL [ Reg -> Reg -> Reg -> Instr
ADDC Reg
rlo Reg
r1lo Reg
r2lo,
Reg -> Reg -> Reg -> Instr
ADDE Reg
rhi Reg
r1hi Reg
r2hi ]
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> ChildCode64
ChildCode64 OrdList Instr
code Reg
rlo)
iselExpr64 (CmmMachOp (MO_Sub Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
ChildCode64 OrdList Instr
code1 Reg
r1lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
e1
ChildCode64 OrdList Instr
code2 Reg
r2lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
e2
(Reg
rlo,Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let
r1hi :: Reg
r1hi = Reg -> Reg
getHiVRegFromLo Reg
r1lo
r2hi :: Reg
r2hi = Reg -> Reg
getHiVRegFromLo Reg
r2lo
code :: OrdList Instr
code = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
OrdList Instr
code2 forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
forall a. [a] -> OrdList a
toOL [ Reg -> Reg -> RI -> Instr
SUBFC Reg
rlo Reg
r2lo (Reg -> RI
RIReg Reg
r1lo),
Reg -> Reg -> Reg -> Instr
SUBFE Reg
rhi Reg
r2hi Reg
r1hi ]
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> ChildCode64
ChildCode64 OrdList Instr
code Reg
rlo)
iselExpr64 (CmmMachOp (MO_UU_Conv Width
W32 Width
W64) [CmmExpr
expr]) = do
(Reg
expr_reg,OrdList Instr
expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr
(Reg
rlo, Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let mov_hi :: Instr
mov_hi = Reg -> Imm -> Instr
LI Reg
rhi (Int -> Imm
ImmInt Int
0)
mov_lo :: Instr
mov_lo = Reg -> Reg -> Instr
MR Reg
rlo Reg
expr_reg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> ChildCode64
ChildCode64 (OrdList Instr
expr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
Reg
rlo
iselExpr64 (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmExpr
expr]) = do
(Reg
expr_reg,OrdList Instr
expr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
expr
(Reg
rlo, Reg
rhi) <- Format -> NatM (Reg, Reg)
getNewRegPairNat Format
II32
let mov_hi :: Instr
mov_hi = Format -> Reg -> Reg -> RI -> Instr
SRA Format
II32 Reg
rhi Reg
expr_reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
31))
mov_lo :: Instr
mov_lo = Reg -> Reg -> Instr
MR Reg
rlo Reg
expr_reg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> ChildCode64
ChildCode64 (OrdList Instr
expr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
Reg
rlo
iselExpr64 CmmExpr
expr
= do
Platform
platform <- NatM Platform
getPlatform
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"iselExpr64(powerpc)" (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
expr)
getRegister :: CmmExpr -> NatM Register
getRegister :: CmmExpr -> NatM Register
getRegister CmmExpr
e = do NCGConfig
config <- NatM NCGConfig
getConfig
NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config (NCGConfig -> Platform
ncgPlatform NCGConfig
config) CmmExpr
e
getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
_ Platform
platform (CmmReg (CmmGlobal GlobalReg
PicBaseReg))
| OS
OSAIX <- Platform -> OS
platformOS Platform
platform = do
let code :: Reg -> OrdList Instr
code Reg
dst = forall a. [a] -> OrdList a
toOL [ Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
dst AddrMode
tocAddr ]
tocAddr :: AddrMode
tocAddr = Reg -> Imm -> AddrMode
AddrRegImm Reg
toc (SDoc -> Imm
ImmLit (String -> SDoc
text String
"ghc_toc_table[TC]"))
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 Reg -> OrdList Instr
code)
| Platform -> Bool
target32Bit Platform
platform = do
Reg
reg <- Format -> NatM Reg
getPicBaseNat forall a b. (a -> b) -> a -> b
$ Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform))
Reg
reg forall a. OrdList a
nilOL)
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
II64 Reg
toc forall a. OrdList a
nilOL)
getRegister' NCGConfig
_ Platform
platform (CmmReg CmmReg
reg)
= forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed (CmmType -> Format
cmmTypeFormat (Platform -> CmmReg -> CmmType
cmmRegType Platform
platform CmmReg
reg))
(Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg) forall a. OrdList a
nilOL)
getRegister' NCGConfig
config Platform
platform tree :: CmmExpr
tree@(CmmRegOff CmmReg
_ Int
_)
= NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
platform (Platform -> CmmExpr -> CmmExpr
mangleIndexTree Platform
platform CmmExpr
tree)
getRegister' NCGConfig
_ Platform
platform (CmmMachOp (MO_UU_Conv Width
W64 Width
W32)
[CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
| Platform -> Bool
target32Bit Platform
platform = do
ChildCode64 OrdList Instr
code Reg
rlo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Reg -> OrdList Instr -> Register
Fixed Format
II32 (Reg -> Reg
getHiVRegFromLo Reg
rlo) OrdList Instr
code
getRegister' NCGConfig
_ Platform
platform (CmmMachOp (MO_SS_Conv Width
W64 Width
W32)
[CmmMachOp (MO_U_Shr Width
W64) [CmmExpr
x,CmmLit (CmmInt Integer
32 Width
_)]])
| Platform -> Bool
target32Bit Platform
platform = do
ChildCode64 OrdList Instr
code Reg
rlo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Reg -> OrdList Instr -> Register
Fixed Format
II32 (Reg -> Reg
getHiVRegFromLo Reg
rlo) OrdList Instr
code
getRegister' NCGConfig
_ Platform
platform (CmmMachOp (MO_UU_Conv Width
W64 Width
W32) [CmmExpr
x])
| Platform -> Bool
target32Bit Platform
platform = do
ChildCode64 OrdList Instr
code Reg
rlo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Reg -> OrdList Instr -> Register
Fixed Format
II32 Reg
rlo OrdList Instr
code
getRegister' NCGConfig
_ Platform
platform (CmmMachOp (MO_SS_Conv Width
W64 Width
W32) [CmmExpr
x])
| Platform -> Bool
target32Bit Platform
platform = do
ChildCode64 OrdList Instr
code Reg
rlo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Format -> Reg -> OrdList Instr -> Register
Fixed Format
II32 Reg
rlo OrdList Instr
code
getRegister' NCGConfig
_ Platform
platform (CmmLoad CmmExpr
mem CmmType
pk AlignmentSpec
_)
| Bool -> Bool
not (CmmType -> Bool
isWord64 CmmType
pk) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
let code :: Reg -> OrdList Instr
code Reg
dst = ASSERT((targetClassOfReg platform dst == RcDouble) == isFloatType pk)
OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
| Bool -> Bool
not (Platform -> Bool
target32Bit Platform
platform) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
DS CmmExpr
mem
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
dst AddrMode
addr
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 Reg -> OrdList Instr
code)
where format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
pk
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_UU_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II8 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_XX_Conv Width
W8 Width
W32) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II8 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_UU_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II8 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_XX_Conv Width
W8 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II8 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_UU_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II16 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_SS_Conv Width
W16 Width
W32) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LA Format
II16 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_UU_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II16 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_SS_Conv Width
W16 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LA Format
II16 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_UU_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
dst AddrMode
addr))
getRegister' NCGConfig
_ Platform
_ (CmmMachOp (MO_SS_Conv Width
W32 Width
W64) [CmmLoad CmmExpr
mem CmmType
_ AlignmentSpec
_]) = do
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
DS CmmExpr
mem
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LA Format
II32 Reg
dst AddrMode
addr))
getRegister' NCGConfig
config Platform
platform (CmmMachOp MachOp
mop [CmmExpr
x])
= case MachOp
mop of
MO_Not Width
rep -> Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_int Width
rep Reg -> Reg -> Instr
NOT
MO_F_Neg Width
w -> Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_float Width
w Reg -> Reg -> Instr
FNEG
MO_S_Neg Width
w -> Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_int Width
w Reg -> Reg -> Instr
NEG
MO_FF_Conv Width
W64 Width
W32 -> Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
FF32 Reg -> Reg -> Instr
FRSP CmmExpr
x
MO_FF_Conv Width
W32 Width
W64 -> Format -> CmmExpr -> NatM Register
conversionNop Format
FF64 CmmExpr
x
MO_FS_Conv Width
from Width
to -> Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int Width
from Width
to CmmExpr
x
MO_SF_Conv Width
from Width
to -> Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP Width
from Width
to CmmExpr
x
MO_SS_Conv Width
from Width
to
| Width
from forall a. Ord a => a -> a -> Bool
>= Width
to -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
to) CmmExpr
x
| Bool
otherwise -> Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_int Width
to (Format -> Reg -> Reg -> Instr
EXTS (Width -> Format
intFormat Width
from))
MO_UU_Conv Width
from Width
to
| Width
from forall a. Ord a => a -> a -> Bool
>= Width
to -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
to) CmmExpr
x
| Bool
otherwise -> Width -> Width -> NatM Register
clearLeft Width
from Width
to
MO_XX_Conv Width
_ Width
to -> Format -> CmmExpr -> NatM Register
conversionNop (Width -> Format
intFormat Width
to) CmmExpr
x
MachOp
_ -> forall a. String -> a
panic String
"PPC.CodeGen.getRegister: no match"
where
triv_ucode_int :: Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_int Width
width Reg -> Reg -> Instr
instr = Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
trivialUCode (Width -> Format
intFormat Width
width) Reg -> Reg -> Instr
instr CmmExpr
x
triv_ucode_float :: Width -> (Reg -> Reg -> Instr) -> NatM Register
triv_ucode_float Width
width Reg -> Reg -> Instr
instr = Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
trivialUCode (Width -> Format
floatFormat Width
width) Reg -> Reg -> Instr
instr CmmExpr
x
conversionNop :: Format -> CmmExpr -> NatM Register
conversionNop Format
new_format CmmExpr
expr
= do Register
e_code <- NCGConfig -> Platform -> CmmExpr -> NatM Register
getRegister' NCGConfig
config Platform
platform CmmExpr
expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> Format -> Register
swizzleRegisterRep Register
e_code Format
new_format)
clearLeft :: Width -> Width -> NatM Register
clearLeft Width
from Width
to
= do (Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let arch_fmt :: Format
arch_fmt = Width -> Format
intFormat (Platform -> Width
wordWidth Platform
platform)
arch_bits :: Int
arch_bits = Width -> Int
widthInBits (Platform -> Width
wordWidth Platform
platform)
size :: Int
size = Width -> Int
widthInBits Width
from
code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
arch_fmt Reg
dst Reg
src1 (Int
arch_bits forall a. Num a => a -> a -> a
- Int
size)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
to) Reg -> OrdList Instr
code)
getRegister' NCGConfig
_ Platform
_ (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y])
= case MachOp
mop of
MO_F_Eq Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
LTT CmmExpr
x CmmExpr
y
MO_F_Le Width
_ -> Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
LE CmmExpr
x CmmExpr
y
MO_Eq Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
EQQ Width
rep CmmExpr
x CmmExpr
y
MO_Ne Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
NE Width
rep CmmExpr
x CmmExpr
y
MO_S_Gt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GTT Width
rep CmmExpr
x CmmExpr
y
MO_S_Ge Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GE Width
rep CmmExpr
x CmmExpr
y
MO_S_Lt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LTT Width
rep CmmExpr
x CmmExpr
y
MO_S_Le Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LE Width
rep CmmExpr
x CmmExpr
y
MO_U_Gt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GU Width
rep CmmExpr
x CmmExpr
y
MO_U_Ge Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
GEU Width
rep CmmExpr
x CmmExpr
y
MO_U_Lt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LU Width
rep CmmExpr
x CmmExpr
y
MO_U_Le Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
LEU Width
rep CmmExpr
x CmmExpr
y
MO_F_Add Width
w -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float Width
w Format -> Reg -> Reg -> Reg -> Instr
FADD
MO_F_Sub Width
w -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float Width
w Format -> Reg -> Reg -> Reg -> Instr
FSUB
MO_F_Mul Width
w -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float Width
w Format -> Reg -> Reg -> Reg -> Instr
FMUL
MO_F_Quot Width
w -> Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float Width
w Format -> Reg -> Reg -> Reg -> Instr
FDIV
MO_Add Width
W32 ->
case CmmExpr
y of
CmmLit (CmmInt Integer
imm Width
immrep) | Just Imm
_ <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W32 Bool
True Integer
imm
-> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
W32 Bool
True Reg -> Reg -> RI -> Instr
ADD CmmExpr
x (CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt Integer
imm Width
immrep)
CmmLit CmmLit
lit
-> do
(Reg
src, OrdList Instr
srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
srcCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Reg -> Reg -> Imm -> Instr
ADDIS Reg
dst Reg
src (Imm -> Imm
HA Imm
imm),
Reg -> Reg -> RI -> Instr
ADD Reg
dst Reg
dst (Imm -> RI
RIImm (Imm -> Imm
LO Imm
imm))
]
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 Reg -> OrdList Instr
code)
CmmExpr
_ -> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
W32 Bool
True Reg -> Reg -> RI -> Instr
ADD CmmExpr
x CmmExpr
y
MO_Add Width
rep -> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
True Reg -> Reg -> RI -> Instr
ADD CmmExpr
x CmmExpr
y
MO_Sub Width
rep ->
case CmmExpr
y of
CmmLit (CmmInt Integer
imm Width
immrep) | Just Imm
_ <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
True (-Integer
imm)
-> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
True Reg -> Reg -> RI -> Instr
ADD CmmExpr
x (CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Integer -> Width -> CmmLit
CmmInt (-Integer
imm) Width
immrep)
CmmExpr
_ -> case CmmExpr
x of
CmmLit (CmmInt Integer
imm Width
_)
| Just Imm
_ <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
True Integer
imm
-> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
True Reg -> Reg -> RI -> Instr
SUBFC CmmExpr
y CmmExpr
x
CmmExpr
_ -> Format
-> (Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCodeNoImm' (Width -> Format
intFormat Width
rep) Reg -> Reg -> Reg -> Instr
SUBF CmmExpr
y CmmExpr
x
MO_Mul Width
rep -> Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shiftMulCode Width
rep Bool
True Format -> Reg -> Reg -> RI -> Instr
MULL CmmExpr
x CmmExpr
y
MO_S_MulMayOflo Width
rep -> do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
let
format :: Format
format = Width -> Format
intFormat Width
rep
code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Format -> Reg -> Reg -> Reg -> Instr
MULLO Format
format Reg
dst Reg
src1 Reg
src2
, Format -> Reg -> Instr
MFOV Format
format Reg
dst
]
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
MO_S_Quot Width
rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
divCode Width
rep Bool
True CmmExpr
x CmmExpr
y
MO_U_Quot Width
rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
divCode Width
rep Bool
False CmmExpr
x CmmExpr
y
MO_S_Rem Width
rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
remainder Width
rep Bool
True CmmExpr
x CmmExpr
y
MO_U_Rem Width
rep -> Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
remainder Width
rep Bool
False CmmExpr
x CmmExpr
y
MO_And Width
rep -> case CmmExpr
y of
(CmmLit (CmmInt Integer
imm Width
_)) | Integer
imm forall a. Eq a => a -> a -> Bool
== -Integer
8 Bool -> Bool -> Bool
|| Integer
imm forall a. Eq a => a -> a -> Bool
== -Integer
4
-> do
(Reg
src, OrdList Instr
srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let clear_mask :: Int
clear_mask = if Integer
imm forall a. Eq a => a -> a -> Bool
== -Integer
4 then Int
2 else Int
3
fmt :: Format
fmt = Width -> Format
intFormat Width
rep
code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
srcCode
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. a -> OrdList a
unitOL (Format -> Reg -> Reg -> Int -> Instr
CLRRI Format
fmt Reg
dst Reg
src Int
clear_mask)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
fmt Reg -> OrdList Instr
code)
CmmExpr
_ -> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
False Reg -> Reg -> RI -> Instr
AND CmmExpr
x CmmExpr
y
MO_Or Width
rep -> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
False Reg -> Reg -> RI -> Instr
OR CmmExpr
x CmmExpr
y
MO_Xor Width
rep -> Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
False Reg -> Reg -> RI -> Instr
XOR CmmExpr
x CmmExpr
y
MO_Shl Width
rep -> Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shiftMulCode Width
rep Bool
False Format -> Reg -> Reg -> RI -> Instr
SL CmmExpr
x CmmExpr
y
MO_S_Shr Width
rep -> Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
srCode Width
rep Bool
True Format -> Reg -> Reg -> RI -> Instr
SRA CmmExpr
x CmmExpr
y
MO_U_Shr Width
rep -> Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
srCode Width
rep Bool
False Format -> Reg -> Reg -> RI -> Instr
SR CmmExpr
x CmmExpr
y
MachOp
_ -> forall a. String -> a
panic String
"PPC.CodeGen.getRegister: no match"
where
triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float :: Width -> (Format -> Reg -> Reg -> Reg -> Instr) -> NatM Register
triv_float Width
width Format -> Reg -> Reg -> Reg -> Instr
instr = Format
-> (Format -> Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCodeNoImm (Width -> Format
floatFormat Width
width) Format -> Reg -> Reg -> Reg -> Instr
instr CmmExpr
x CmmExpr
y
remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
remainder :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
remainder Width
rep Bool
sgn CmmExpr
x CmmExpr
y = do
let fmt :: Format
fmt = Width -> Format
intFormat Width
rep
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg -> OrdList Instr
code <- Width
-> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
remainderCode Width
rep Bool
sgn Reg
tmp CmmExpr
x CmmExpr
y
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
fmt Reg -> OrdList Instr
code)
getRegister' NCGConfig
_ Platform
_ (CmmLit (CmmInt Integer
i Width
rep))
| Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
True Integer
i
= let
code :: Reg -> OrdList Instr
code Reg
dst = forall a. a -> OrdList a
unitOL (Reg -> Imm -> Instr
LI Reg
dst Imm
imm)
in
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
rep) Reg -> OrdList Instr
code)
getRegister' NCGConfig
config Platform
_ (CmmLit (CmmFloat Rational
f Width
frep)) = do
CLabel
lbl <- NatM CLabel
getNewLabelNat
CmmExpr
dynRef <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
DataReference CLabel
lbl
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
dynRef
let format :: Format
format = Width -> Format
floatFormat Width
frep
code :: Reg -> OrdList Instr
code Reg
dst =
Section -> RawCmmStatics -> Instr
LDATA (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl)
(forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
lbl [CmmLit -> CmmStatic
CmmStaticLit (Rational -> Width -> CmmLit
CmmFloat Rational
f Width
frep)])
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
getRegister' NCGConfig
config Platform
platform (CmmLit CmmLit
lit)
| Platform -> Bool
target32Bit Platform
platform
= let rep :: CmmType
rep = Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit
imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
code :: Reg -> OrdList Instr
code Reg
dst = forall a. [a] -> OrdList a
toOL [
Reg -> Imm -> Instr
LIS Reg
dst (Imm -> Imm
HA Imm
imm),
Reg -> Reg -> RI -> Instr
ADD Reg
dst Reg
dst (Imm -> RI
RIImm (Imm -> Imm
LO Imm
imm))
]
in forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (CmmType -> Format
cmmTypeFormat CmmType
rep) Reg -> OrdList Instr
code)
| Bool
otherwise
= do CLabel
lbl <- NatM CLabel
getNewLabelNat
CmmExpr
dynRef <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
DataReference CLabel
lbl
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
dynRef
let rep :: CmmType
rep = Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit
format :: Format
format = CmmType -> Format
cmmTypeFormat CmmType
rep
code :: Reg -> OrdList Instr
code Reg
dst =
Section -> RawCmmStatics -> Instr
LDATA (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
lbl [CmmLit -> CmmStatic
CmmStaticLit CmmLit
lit])
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
addr_code forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
getRegister' NCGConfig
_ Platform
platform CmmExpr
other = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegister(ppc)" (Platform -> CmmExpr -> SDoc
pprExpr Platform
platform CmmExpr
other)
extendSExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendSExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendSExpr Width
from Width
to CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_SS_Conv Width
from Width
to) [CmmExpr
x]
extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendUExpr :: Width -> Width -> CmmExpr -> CmmExpr
extendUExpr Width
from Width
to CmmExpr
x = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
MO_UU_Conv Width
from Width
to) [CmmExpr
x]
data Amode
= Amode AddrMode InstrBlock
data InstrForm = D | DS
getAmode :: InstrForm -> CmmExpr -> NatM Amode
getAmode :: InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
inf tree :: CmmExpr
tree@(CmmRegOff CmmReg
_ Int
_)
= do Platform
platform <- NatM Platform
getPlatform
InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
inf (Platform -> CmmExpr -> CmmExpr
mangleIndexTree Platform
platform CmmExpr
tree)
getAmode InstrForm
_ (CmmMachOp (MO_Sub Width
W32) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W32 Bool
True (-Integer
i)
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg Imm
off) OrdList Instr
code)
getAmode InstrForm
_ (CmmMachOp (MO_Add Width
W32) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W32 Bool
True Integer
i
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg Imm
off) OrdList Instr
code)
getAmode InstrForm
D (CmmMachOp (MO_Sub Width
W64) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W64 Bool
True (-Integer
i)
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg Imm
off) OrdList Instr
code)
getAmode InstrForm
D (CmmMachOp (MO_Add Width
W64) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W64 Bool
True Integer
i
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg Imm
off) OrdList Instr
code)
getAmode InstrForm
DS (CmmMachOp (MO_Sub Width
W64) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W64 Bool
True (-Integer
i)
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
reg', Imm
off', OrdList Instr
code') <-
if Integer
i forall a. Integral a => a -> a -> a
`mod` Integer
4 forall a. Eq a => a -> a -> Bool
== Integer
0
then forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, Imm
off, OrdList Instr
code)
else do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II64
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Int -> Imm
ImmInt Int
0,
OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
ADD Reg
tmp Reg
reg (Imm -> RI
RIImm Imm
off))
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg' Imm
off') OrdList Instr
code')
getAmode InstrForm
DS (CmmMachOp (MO_Add Width
W64) [CmmExpr
x, CmmLit (CmmInt Integer
i Width
_)])
| Just Imm
off <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
W64 Bool
True Integer
i
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
reg', Imm
off', OrdList Instr
code') <-
if Integer
i forall a. Integral a => a -> a -> a
`mod` Integer
4 forall a. Eq a => a -> a -> Bool
== Integer
0
then forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg, Imm
off, OrdList Instr
code)
else do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II64
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Int -> Imm
ImmInt Int
0,
OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
ADD Reg
tmp Reg
reg (Imm -> RI
RIImm Imm
off))
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg' Imm
off') OrdList Instr
code')
getAmode InstrForm
_ (CmmMachOp (MO_Add Width
W32) [CmmExpr
x, CmmLit CmmLit
lit])
= do
Platform
platform <- NatM Platform
getPlatform
(Reg
src, OrdList Instr
srcCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
case () of
()
_ | OS
OSAIX <- Platform -> OS
platformOS Platform
platform
, CmmLit -> Bool
isCmmLabelType CmmLit
lit ->
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
src Imm
imm) OrdList Instr
srcCode)
| Bool
otherwise -> do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II32
let code :: OrdList Instr
code = OrdList Instr
srcCode forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Imm -> Instr
ADDIS Reg
tmp Reg
src (Imm -> Imm
HA Imm
imm)
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
tmp (Imm -> Imm
LO Imm
imm)) OrdList Instr
code)
where
isCmmLabelType :: CmmLit -> Bool
isCmmLabelType (CmmLabel {}) = Bool
True
isCmmLabelType (CmmLabelOff {}) = Bool
True
isCmmLabelType (CmmLabelDiffOff {}) = Bool
True
isCmmLabelType CmmLit
_ = Bool
False
getAmode InstrForm
_ (CmmLit CmmLit
lit)
= do
Platform
platform <- NatM Platform
getPlatform
case Platform -> Arch
platformArch Platform
platform of
Arch
ArchPPC -> do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II32
let imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
code :: OrdList Instr
code = forall a. a -> OrdList a
unitOL (Reg -> Imm -> Instr
LIS Reg
tmp (Imm -> Imm
HA Imm
imm))
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
tmp (Imm -> Imm
LO Imm
imm)) OrdList Instr
code)
Arch
_ -> do
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
II64
let imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
code :: OrdList Instr
code = forall a. [a] -> OrdList a
toOL [
Reg -> Imm -> Instr
LIS Reg
tmp (Imm -> Imm
HIGHESTA Imm
imm),
Reg -> Reg -> RI -> Instr
OR Reg
tmp Reg
tmp (Imm -> RI
RIImm (Imm -> Imm
HIGHERA Imm
imm)),
Format -> Reg -> Reg -> RI -> Instr
SL Format
II64 Reg
tmp Reg
tmp (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
32)),
Reg -> Reg -> Imm -> Instr
ORIS Reg
tmp Reg
tmp (Imm -> Imm
HA Imm
imm)
]
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
tmp (Imm -> Imm
LO Imm
imm)) OrdList Instr
code)
getAmode InstrForm
_ (CmmMachOp (MO_Add Width
W32) [CmmExpr
x, CmmExpr
y])
= do
(Reg
regX, OrdList Instr
codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
regY, OrdList Instr
codeY) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Reg -> AddrMode
AddrRegReg Reg
regX Reg
regY) (OrdList Instr
codeX forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeY))
getAmode InstrForm
_ (CmmMachOp (MO_Add Width
W64) [CmmExpr
x, CmmExpr
y])
= do
(Reg
regX, OrdList Instr
codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
regY, OrdList Instr
codeY) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Reg -> AddrMode
AddrRegReg Reg
regX Reg
regY) (OrdList Instr
codeX forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeY))
getAmode InstrForm
_ CmmExpr
other
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
other
let
off :: Imm
off = Int -> Imm
ImmInt Int
0
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Imm -> AddrMode
AddrRegImm Reg
reg Imm
off) OrdList Instr
code)
data CondCode
= CondCode Bool Cond InstrBlock
getCondCode :: CmmExpr -> NatM CondCode
getCondCode :: CmmExpr -> NatM CondCode
getCondCode (CmmMachOp MachOp
mop [CmmExpr
x, CmmExpr
y])
= case MachOp
mop of
MO_F_Eq Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LTT CmmExpr
x CmmExpr
y
MO_F_Le Width
W32 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LE CmmExpr
x CmmExpr
y
MO_F_Eq Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
EQQ CmmExpr
x CmmExpr
y
MO_F_Ne Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
NE CmmExpr
x CmmExpr
y
MO_F_Gt Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GTT CmmExpr
x CmmExpr
y
MO_F_Ge Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
GE CmmExpr
x CmmExpr
y
MO_F_Lt Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LTT CmmExpr
x CmmExpr
y
MO_F_Le Width
W64 -> Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
LE CmmExpr
x CmmExpr
y
MO_Eq Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
EQQ Width
rep CmmExpr
x CmmExpr
y
MO_Ne Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
NE Width
rep CmmExpr
x CmmExpr
y
MO_S_Gt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GTT Width
rep CmmExpr
x CmmExpr
y
MO_S_Ge Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GE Width
rep CmmExpr
x CmmExpr
y
MO_S_Lt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LTT Width
rep CmmExpr
x CmmExpr
y
MO_S_Le Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LE Width
rep CmmExpr
x CmmExpr
y
MO_U_Gt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GU Width
rep CmmExpr
x CmmExpr
y
MO_U_Ge Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
GEU Width
rep CmmExpr
x CmmExpr
y
MO_U_Lt Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LU Width
rep CmmExpr
x CmmExpr
y
MO_U_Le Width
rep -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
LEU Width
rep CmmExpr
x CmmExpr
y
MachOp
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getCondCode(powerpc)" (MachOp -> SDoc
pprMachOp MachOp
mop)
getCondCode CmmExpr
_ = forall a. String -> a
panic String
"getCondCode(2)(powerpc)"
condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond Width
width CmmExpr
x CmmExpr
y = do
Platform
platform <- NatM Platform
getPlatform
Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' (Platform -> Bool
target32Bit Platform
platform) Cond
cond Width
width CmmExpr
x CmmExpr
y
condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode' Bool
True Cond
cond Width
W64 CmmExpr
x CmmExpr
y
| Cond -> Bool
condUnsigned Cond
cond
= do
ChildCode64 OrdList Instr
code_x Reg
x_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
ChildCode64 OrdList Instr
code_y Reg
y_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
y
let x_hi :: Reg
x_hi = Reg -> Reg
getHiVRegFromLo Reg
x_lo
y_hi :: Reg
y_hi = Reg -> Reg
getHiVRegFromLo Reg
y_lo
BlockId
end_lbl <- NatM BlockId
getBlockIdNat
let code :: OrdList Instr
code = OrdList Instr
code_x forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL
[ Format -> Reg -> RI -> Instr
CMPL Format
II32 Reg
x_hi (Reg -> RI
RIReg Reg
y_hi)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
end_lbl forall a. Maybe a
Nothing
, Format -> Reg -> RI -> Instr
CMPL Format
II32 Reg
x_lo (Reg -> RI
RIReg Reg
y_lo)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
end_lbl forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
end_lbl
]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
False Cond
cond OrdList Instr
code)
| Bool
otherwise
= do
ChildCode64 OrdList Instr
code_x Reg
x_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
x
ChildCode64 OrdList Instr
code_y Reg
y_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
y
let x_hi :: Reg
x_hi = Reg -> Reg
getHiVRegFromLo Reg
x_lo
y_hi :: Reg
y_hi = Reg -> Reg
getHiVRegFromLo Reg
y_lo
BlockId
end_lbl <- NatM BlockId
getBlockIdNat
BlockId
cmp_lo <- NatM BlockId
getBlockIdNat
let code :: OrdList Instr
code = OrdList Instr
code_x forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL
[ Format -> Reg -> RI -> Instr
CMP Format
II32 Reg
x_hi (Reg -> RI
RIReg Reg
y_hi)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
end_lbl forall a. Maybe a
Nothing
, Format -> Reg -> RI -> Instr
CMP Format
II32 Reg
x_hi (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
0))
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LE BlockId
cmp_lo forall a. Maybe a
Nothing
, Format -> Reg -> RI -> Instr
CMPL Format
II32 Reg
x_lo (Reg -> RI
RIReg Reg
y_lo)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
end_lbl forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
cmp_lo
, Format -> Reg -> RI -> Instr
CMPL Format
II32 Reg
y_lo (Reg -> RI
RIReg Reg
x_lo)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
end_lbl forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
end_lbl
]
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
False Cond
cond OrdList Instr
code)
condIntCode' Bool
_ Cond
cond Width
_ (CmmMachOp (MO_And Width
_) [CmmExpr
x, CmmLit (CmmInt Integer
imm Width
rep)])
(CmmLit (CmmInt Integer
0 Width
_))
| Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Cond -> Bool
condUnsigned Cond
cond,
Just Imm
src2 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
False Integer
imm
= do
(Reg
src1, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let code' :: OrdList Instr
code' = OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
AND Reg
r0 Reg
src1 (Imm -> RI
RIImm Imm
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
False Cond
cond OrdList Instr
code')
condIntCode' Bool
_ Cond
cond Width
width CmmExpr
x (CmmLit (CmmInt Integer
y Width
rep))
| Just Imm
src2 <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Cond -> Bool
condUnsigned Cond
cond) Integer
y
= do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
width
let extend :: CmmExpr -> CmmExpr
extend = if Cond -> Bool
condUnsigned Cond
cond then Width -> Width -> CmmExpr -> CmmExpr
extendUExpr Width
width Width
op_len
else Width -> Width -> CmmExpr -> CmmExpr
extendSExpr Width
width Width
op_len
(Reg
src1, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (CmmExpr -> CmmExpr
extend CmmExpr
x)
let format :: Format
format = Width -> Format
intFormat Width
op_len
code' :: OrdList Instr
code' = OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL`
(if Cond -> Bool
condUnsigned Cond
cond then Format -> Reg -> RI -> Instr
CMPL else Format -> Reg -> RI -> Instr
CMP) Format
format Reg
src1 (Imm -> RI
RIImm Imm
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
False Cond
cond OrdList Instr
code')
condIntCode' Bool
_ Cond
cond Width
width CmmExpr
x CmmExpr
y = do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
width
let extend :: CmmExpr -> CmmExpr
extend = if Cond -> Bool
condUnsigned Cond
cond then Width -> Width -> CmmExpr -> CmmExpr
extendUExpr Width
width Width
op_len
else Width -> Width -> CmmExpr -> CmmExpr
extendSExpr Width
width Width
op_len
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (CmmExpr -> CmmExpr
extend CmmExpr
x)
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (CmmExpr -> CmmExpr
extend CmmExpr
y)
let format :: Format
format = Width -> Format
intFormat Width
op_len
code' :: OrdList Instr
code' = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL`
(if Cond -> Bool
condUnsigned Cond
cond then Format -> Reg -> RI -> Instr
CMPL else Format -> Reg -> RI -> Instr
CMP) Format
format Reg
src1 (Reg -> RI
RIReg Reg
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
False Cond
cond OrdList Instr
code')
condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
cond CmmExpr
x CmmExpr
y = do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
let
code' :: OrdList Instr
code' = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
FCMP Reg
src1 Reg
src2
code'' :: OrdList Instr
code'' = case Cond
cond of
Cond
GE -> OrdList Instr
code' forall a. OrdList a -> a -> OrdList a
`snocOL` Int -> Int -> Int -> Instr
CRNOR Int
ltbit Int
eqbit Int
gtbit
Cond
LE -> OrdList Instr
code' forall a. OrdList a -> a -> OrdList a
`snocOL` Int -> Int -> Int -> Instr
CRNOR Int
gtbit Int
eqbit Int
ltbit
Cond
_ -> OrdList Instr
code'
where
ltbit :: Int
ltbit = Int
0 ; eqbit :: Int
eqbit = Int
2 ; gtbit :: Int
gtbit = Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cond -> OrdList Instr -> CondCode
CondCode Bool
True Cond
cond OrdList Instr
code'')
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_IntCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM InstrBlock
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM InstrBlock
assignMem_IntCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_IntCode Format
pk CmmExpr
addr CmmExpr
src = do
(Reg
srcReg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
src
Amode AddrMode
dstAddr OrdList Instr
addr_code <- case Format
pk of
Format
II64 -> InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
DS CmmExpr
addr
Format
_ -> InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
addr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
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 (OrdList Instr)
assignReg_IntCode Format
_ CmmReg
reg CmmExpr
src
= do
Platform
platform <- NatM Platform
getPlatform
let dst :: Reg
dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform CmmReg
reg
Register
r <- CmmExpr -> NatM Register
getRegister CmmExpr
src
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Register
r of
Any Format
_ Reg -> OrdList Instr
code -> Reg -> OrdList Instr
code Reg
dst
Fixed Format
_ Reg
freg OrdList Instr
fcode -> OrdList Instr
fcode forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
dst Reg
freg
assignMem_FltCode :: Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_FltCode = Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_IntCode
assignReg_FltCode :: Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_FltCode = Format -> CmmReg -> CmmExpr -> NatM (OrdList Instr)
assignReg_IntCode
genJump :: CmmExpr -> [Reg] -> NatM InstrBlock
genJump :: CmmExpr -> [Reg] -> NatM (OrdList Instr)
genJump (CmmLit (CmmLabel CLabel
lbl)) [Reg]
regs
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ CLabel -> [Reg] -> Instr
JMP CLabel
lbl [Reg]
regs)
genJump CmmExpr
tree [Reg]
gregs
= do
Platform
platform <- NatM Platform
getPlatform
CmmExpr -> GenCCallPlatform -> [Reg] -> NatM (OrdList Instr)
genJump' CmmExpr
tree (Platform -> GenCCallPlatform
platformToGCP Platform
platform) [Reg]
gregs
genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM InstrBlock
genJump' :: CmmExpr -> GenCCallPlatform -> [Reg] -> NatM (OrdList Instr)
genJump' CmmExpr
tree (GCP64ELF Int
1) [Reg]
regs
= do
(Reg
target,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
tree
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
target (Int -> Imm
ImmInt Int
0))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
target (Int -> Imm
ImmInt Int
8))
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
target (Int -> Imm
ImmInt Int
16))
forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] forall a. Maybe a
Nothing [Reg]
regs)
genJump' CmmExpr
tree (GCP64ELF Int
2) [Reg]
regs
= do
(Reg
target,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
tree
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
r12 Reg
target
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r12
forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] forall a. Maybe a
Nothing [Reg]
regs)
genJump' CmmExpr
tree GenCCallPlatform
_ [Reg]
regs
= do
(Reg
target,OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
tree
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
target forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] forall a. Maybe a
Nothing [Reg]
regs)
genBranch :: BlockId -> NatM InstrBlock
genBranch :: BlockId -> NatM (OrdList Instr)
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
. BlockId -> [Instr]
mkJumpInstr
genCondJump
:: BlockId
-> CmmExpr
-> Maybe Bool
-> NatM InstrBlock
genCondJump :: BlockId -> CmmExpr -> Maybe Bool -> NatM (OrdList Instr)
genCondJump BlockId
id CmmExpr
bool Maybe Bool
prediction = do
CondCode Bool
_ Cond
cond OrdList Instr
code <- CmmExpr -> NatM CondCode
getCondCode CmmExpr
bool
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
cond BlockId
id Maybe Bool
prediction)
genCCall :: ForeignTarget
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genCCall :: ForeignTarget -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
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. a -> OrdList a
unitOL Instr
LWSYNC
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. a -> OrdList a
unitOL Instr
LWSYNC
genCCall (PrimTarget CallishMachOp
MO_Touch) [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 (PrimTarget (MO_AtomicRMW Width
width AtomicMachOp
amop)) [CmmFormal
dst] [CmmExpr
addr, CmmExpr
n]
= do Platform
platform <- NatM Platform
getPlatform
let fmt :: Format
fmt = Width -> Format
intFormat Width
width
reg_dst :: Reg
reg_dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
(Instr
instr, OrdList Instr
n_code) <- case AtomicMachOp
amop of
AtomicMachOp
AMO_Add -> (Reg -> Reg -> RI -> Instr)
-> Bool -> Reg -> NatM (Instr, OrdList Instr)
getSomeRegOrImm Reg -> Reg -> RI -> Instr
ADD Bool
True Reg
reg_dst
AtomicMachOp
AMO_Sub -> case CmmExpr
n of
CmmLit (CmmInt Integer
i Width
_)
| Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
True (-Integer
i)
-> forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> RI -> Instr
ADD Reg
reg_dst Reg
reg_dst (Imm -> RI
RIImm Imm
imm), forall a. OrdList a
nilOL)
CmmExpr
_
-> do
(Reg
n_reg, OrdList Instr
n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> Reg -> Instr
SUBF Reg
reg_dst Reg
n_reg Reg
reg_dst, OrdList Instr
n_code)
AtomicMachOp
AMO_And -> (Reg -> Reg -> RI -> Instr)
-> Bool -> Reg -> NatM (Instr, OrdList Instr)
getSomeRegOrImm Reg -> Reg -> RI -> Instr
AND Bool
False Reg
reg_dst
AtomicMachOp
AMO_Nand -> do (Reg
n_reg, OrdList Instr
n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> Reg -> Instr
NAND Reg
reg_dst Reg
reg_dst Reg
n_reg, OrdList Instr
n_code)
AtomicMachOp
AMO_Or -> (Reg -> Reg -> RI -> Instr)
-> Bool -> Reg -> NatM (Instr, OrdList Instr)
getSomeRegOrImm Reg -> Reg -> RI -> Instr
OR Bool
False Reg
reg_dst
AtomicMachOp
AMO_Xor -> (Reg -> Reg -> RI -> Instr)
-> Bool -> Reg -> NatM (Instr, OrdList Instr)
getSomeRegOrImm Reg -> Reg -> RI -> Instr
XOR Bool
False Reg
reg_dst
Amode AddrMode
addr_reg OrdList Instr
addr_code <- CmmExpr -> NatM Amode
getAmodeIndex CmmExpr
addr
BlockId
lbl_retry <- NatM BlockId
getBlockIdNat
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
n_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Instr
HWSYNC
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_retry forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl_retry
, Format -> Reg -> AddrMode -> Instr
LDR Format
fmt Reg
reg_dst AddrMode
addr_reg
, Instr
instr
, Format -> Reg -> AddrMode -> Instr
STC Format
fmt Reg
reg_dst AddrMode
addr_reg
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl_retry (forall a. a -> Maybe a
Just Bool
False)
, Instr
ISYNC
]
where
getAmodeIndex :: CmmExpr -> NatM Amode
getAmodeIndex (CmmMachOp (MO_Add Width
_) [CmmExpr
x, CmmExpr
y])
= do
(Reg
regX, OrdList Instr
codeX) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
regY, OrdList Instr
codeY) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Reg -> AddrMode
AddrRegReg Reg
regX Reg
regY) (OrdList Instr
codeX forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeY))
getAmodeIndex CmmExpr
other
= do
(Reg
reg, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
other
forall (m :: * -> *) a. Monad m => a -> m a
return (AddrMode -> OrdList Instr -> Amode
Amode (Reg -> Reg -> AddrMode
AddrRegReg Reg
r0 Reg
reg) OrdList Instr
code)
getSomeRegOrImm :: (Reg -> Reg -> RI -> Instr)
-> Bool -> Reg -> NatM (Instr, OrdList Instr)
getSomeRegOrImm Reg -> Reg -> RI -> Instr
op Bool
sign Reg
dst
= case CmmExpr
n of
CmmLit (CmmInt Integer
i Width
_) | Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
sign Integer
i
-> forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> RI -> Instr
op Reg
dst Reg
dst (Imm -> RI
RIImm Imm
imm), forall a. OrdList a
nilOL)
CmmExpr
_
-> do
(Reg
n_reg, OrdList Instr
n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
n
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> RI -> Instr
op Reg
dst Reg
dst (Reg -> RI
RIReg Reg
n_reg), OrdList Instr
n_code)
genCCall (PrimTarget (MO_AtomicRead Width
width)) [CmmFormal
dst] [CmmExpr
addr]
= do Platform
platform <- NatM Platform
getPlatform
let fmt :: Format
fmt = Width -> Format
intFormat Width
width
reg_dst :: Reg
reg_dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
form :: InstrForm
form = if Width -> Int
widthInBits Width
width forall a. Eq a => a -> a -> Bool
== Int
64 then InstrForm
DS else InstrForm
D
Amode AddrMode
addr_reg OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
form CmmExpr
addr
BlockId
lbl_end <- NatM BlockId
getBlockIdNat
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
addr_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Instr
HWSYNC
, Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
reg_dst AddrMode
addr_reg
, Format -> Reg -> RI -> Instr
CMP Format
fmt Reg
reg_dst (Reg -> RI
RIReg Reg
reg_dst)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl_end (forall a. a -> Maybe a
Just Bool
False)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_end forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl_end
, Instr
ISYNC
]
genCCall (PrimTarget (MO_AtomicWrite Width
width)) [] [CmmExpr
addr, CmmExpr
val] = do
OrdList Instr
code <- Format -> CmmExpr -> CmmExpr -> NatM (OrdList Instr)
assignMem_IntCode (Width -> Format
intFormat Width
width) CmmExpr
addr CmmExpr
val
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> OrdList a
unitOL(Instr
HWSYNC) forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
genCCall (PrimTarget (MO_Clz Width
width)) [CmmFormal
dst] [CmmExpr
src]
= do Platform
platform <- NatM Platform
getPlatform
let reg_dst :: Reg
reg_dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
if Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Width
width forall a. Eq a => a -> a -> Bool
== Width
W64
then do
ChildCode64 OrdList Instr
code Reg
vr_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
src
BlockId
lbl1 <- NatM BlockId
getBlockIdNat
BlockId
lbl2 <- NatM BlockId
getBlockIdNat
BlockId
lbl3 <- NatM BlockId
getBlockIdNat
let vr_hi :: Reg
vr_hi = Reg -> Reg
getHiVRegFromLo Reg
vr_lo
cntlz :: OrdList Instr
cntlz = forall a. [a] -> OrdList a
toOL [ Format -> Reg -> RI -> Instr
CMPL Format
II32 Reg
vr_hi (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
0))
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl1
, Format -> Reg -> Reg -> Instr
CNTLZ Format
II32 Reg
reg_dst Reg
vr_lo
, Reg -> Reg -> RI -> Instr
ADD Reg
reg_dst Reg
reg_dst (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
32))
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl3 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl2
, Format -> Reg -> Reg -> Instr
CNTLZ Format
II32 Reg
reg_dst Reg
vr_hi
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl3 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl3
]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cntlz
else do
let format :: Format
format = if Width
width forall a. Eq a => a -> a -> Bool
== Width
W64 then Format
II64 else Format
II32
(Reg
s_reg, OrdList Instr
s_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
src
(OrdList Instr
pre, Reg
reg , OrdList Instr
post) <-
case Width
width of
Width
W64 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. OrdList a
nilOL, Reg
s_reg, forall a. OrdList a
nilOL)
Width
W32 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. OrdList a
nilOL, Reg
s_reg, forall a. OrdList a
nilOL)
Width
W16 -> do
Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> RI -> Instr
AND Reg
reg_tmp Reg
s_reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
65535))
, Reg
reg_tmp
, forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> RI -> Instr
ADD Reg
reg_dst Reg
reg_dst (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
16)))
)
Width
W8 -> do
Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
forall (m :: * -> *) a. Monad m => a -> m a
return
( forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> RI -> Instr
AND Reg
reg_tmp Reg
s_reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
255))
, Reg
reg_tmp
, forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> RI -> Instr
ADD Reg
reg_dst Reg
reg_dst (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
24)))
)
Width
_ -> forall a. String -> a
panic String
"genCall: Clz wrong format"
let cntlz :: OrdList Instr
cntlz = forall a. a -> OrdList a
unitOL (Format -> Reg -> Reg -> Instr
CNTLZ Format
format Reg
reg_dst Reg
reg)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
s_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
pre forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cntlz forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
post
genCCall (PrimTarget (MO_Ctz Width
width)) [CmmFormal
dst] [CmmExpr
src]
= do Platform
platform <- NatM Platform
getPlatform
let reg_dst :: Reg
reg_dst = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dst)
if Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Width
width forall a. Eq a => a -> a -> Bool
== Width
W64
then do
let format :: Format
format = Format
II32
ChildCode64 OrdList Instr
code Reg
vr_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
src
BlockId
lbl1 <- NatM BlockId
getBlockIdNat
BlockId
lbl2 <- NatM BlockId
getBlockIdNat
BlockId
lbl3 <- NatM BlockId
getBlockIdNat
Reg
x' <- Format -> NatM Reg
getNewRegNat Format
format
Reg
x'' <- Format -> NatM Reg
getNewRegNat Format
format
Reg
r' <- Format -> NatM Reg
getNewRegNat Format
format
OrdList Instr
cnttzlo <- Format -> Reg -> Reg -> NatM (OrdList Instr)
cnttz Format
format Reg
reg_dst Reg
vr_lo
let vr_hi :: Reg
vr_hi = Reg -> Reg
getHiVRegFromLo Reg
vr_lo
cnttz64 :: OrdList Instr
cnttz64 = forall a. [a] -> OrdList a
toOL [ Format -> Reg -> RI -> Instr
CMPL Format
format Reg
vr_lo (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
0))
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl1
, Reg -> Reg -> RI -> Instr
ADD Reg
x' Reg
vr_hi (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
1)))
, Reg -> Reg -> Reg -> Instr
ANDC Reg
x'' Reg
x' Reg
vr_hi
, Format -> Reg -> Reg -> Instr
CNTLZ Format
format Reg
r' Reg
x''
, Reg -> Reg -> RI -> Instr
SUBFC Reg
reg_dst Reg
r' (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
64))
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl3 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl2
]
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cnttzlo forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
forall a. [a] -> OrdList a
toOL [ Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl3 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
lbl3
]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cnttz64
else do
let format :: Format
format = if Width
width forall a. Eq a => a -> a -> Bool
== Width
W64 then Format
II64 else Format
II32
(Reg
s_reg, OrdList Instr
s_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
src
(Reg
reg_ctz, OrdList Instr
pre_code) <-
case Width
width of
Width
W64 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
s_reg, forall a. OrdList a
nilOL)
Width
W32 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
s_reg, forall a. OrdList a
nilOL)
Width
W16 -> do
Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg_tmp, forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Imm -> Instr
ORIS Reg
reg_tmp Reg
s_reg (Int -> Imm
ImmInt Int
1))
Width
W8 -> do
Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg_tmp, forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> RI -> Instr
OR Reg
reg_tmp Reg
s_reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
256)))
Width
_ -> forall a. String -> a
panic String
"genCall: Ctz wrong format"
OrdList Instr
ctz_code <- Format -> Reg -> Reg -> NatM (OrdList Instr)
cnttz Format
format Reg
reg_dst Reg
reg_ctz
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
s_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
pre_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
ctz_code
where
cnttz :: Format -> Reg -> Reg -> NatM (OrdList Instr)
cnttz Format
format Reg
dst Reg
src = do
let format_bits :: Int
format_bits = Int
8 forall a. Num a => a -> a -> a
* Format -> Int
formatInBytes Format
format
Reg
x' <- Format -> NatM Reg
getNewRegNat Format
format
Reg
x'' <- Format -> NatM Reg
getNewRegNat Format
format
Reg
r' <- Format -> NatM Reg
getNewRegNat Format
format
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> OrdList a
toOL [ Reg -> Reg -> RI -> Instr
ADD Reg
x' Reg
src (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
1)))
, Reg -> Reg -> Reg -> Instr
ANDC Reg
x'' Reg
x' Reg
src
, Format -> Reg -> Reg -> Instr
CNTLZ Format
format Reg
r' Reg
x''
, Reg -> Reg -> RI -> Instr
SUBFC Reg
dst Reg
r' (Imm -> RI
RIImm (Int -> Imm
ImmInt (Int
format_bits)))
]
genCCall ForeignTarget
target [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
= do Platform
platform <- NatM Platform
getPlatform
case ForeignTarget
target of
PrimTarget (MO_S_QuotRem Width
width) -> Platform
-> Bool
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
divOp1 Platform
platform Bool
True Width
width
[CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_U_QuotRem Width
width) -> Platform
-> Bool
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
divOp1 Platform
platform Bool
False Width
width
[CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_U_QuotRem2 Width
width) -> Platform
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp2 Platform
platform Width
width [CmmFormal]
dest_regs
[CmmExpr]
argsAndHints
PrimTarget (MO_U_Mul2 Width
width) -> Platform
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
multOp2 Platform
platform Width
width [CmmFormal]
dest_regs
[CmmExpr]
argsAndHints
PrimTarget (MO_Add2 Width
_) -> Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op Platform
platform [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_AddWordC Width
_) -> Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addcOp Platform
platform [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_SubWordC Width
_) -> Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
subcOp Platform
platform [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_AddIntC Width
width) -> (Reg -> Reg -> Reg -> Instr)
-> Platform
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
ADDO Platform
platform Width
width
[CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget (MO_SubIntC Width
width) -> (Reg -> Reg -> Reg -> Instr)
-> Platform
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
SUBFO Platform
platform Width
width
[CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget CallishMachOp
MO_F64_Fabs -> Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs Platform
platform [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
PrimTarget CallishMachOp
MO_F32_Fabs -> Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs Platform
platform [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
ForeignTarget
_ -> do NCGConfig
config <- NatM NCGConfig
getConfig
NCGConfig
-> GenCCallPlatform
-> ForeignTarget
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall' NCGConfig
config (Platform -> GenCCallPlatform
platformToGCP Platform
platform)
ForeignTarget
target [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
where divOp1 :: Platform
-> Bool
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
divOp1 Platform
platform Bool
signed Width
width [CmmFormal
res_q, CmmFormal
res_r] [CmmExpr
arg_x, CmmExpr
arg_y]
= do let reg_q :: Reg
reg_q = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_q)
reg_r :: Reg
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_r)
Width
-> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
remainderCode Width
width Bool
signed Reg
reg_q CmmExpr
arg_x CmmExpr
arg_y
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Reg
reg_r
divOp1 Platform
_ Bool
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCCall: Wrong number of arguments for divOp1"
divOp2 :: Platform
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp2 Platform
platform Width
width [CmmFormal
res_q, CmmFormal
res_r]
[CmmExpr
arg_x_high, CmmExpr
arg_x_low, CmmExpr
arg_y]
= do let reg_q :: Reg
reg_q = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_q)
reg_r :: Reg
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_r)
fmt :: Format
fmt = Width -> Format
intFormat Width
width
half :: Int
half = Int
4 forall a. Num a => a -> a -> a
* (Format -> Int
formatInBytes Format
fmt)
(Reg
xh_reg, OrdList Instr
xh_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x_high
(Reg
xl_reg, OrdList Instr
xl_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x_low
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_y
Reg
s <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
b <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
v <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
vn1 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
vn0 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
un32 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
un10 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
un1 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
un0 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
q1 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
rhat <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
tmp1 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
q0 <- Format -> NatM Reg
getNewRegNat Format
fmt
Reg
un21 <- Format -> NatM Reg
getNewRegNat Format
fmt
BlockId
again1 <- NatM BlockId
getBlockIdNat
BlockId
no1 <- NatM BlockId
getBlockIdNat
BlockId
then1 <- NatM BlockId
getBlockIdNat
BlockId
endif1 <- NatM BlockId
getBlockIdNat
BlockId
again2 <- NatM BlockId
getBlockIdNat
BlockId
no2 <- NatM BlockId
getBlockIdNat
BlockId
then2 <- NatM BlockId
getBlockIdNat
BlockId
endif2 <- NatM BlockId
getBlockIdNat
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
xl_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
xh_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
forall a. [a] -> OrdList a
toOL [
Reg -> Imm -> Instr
LI Reg
b (Int -> Imm
ImmInt Int
1)
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
b Reg
b (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Format -> Reg -> Reg -> Instr
CNTLZ Format
fmt Reg
s Reg
y_reg
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
v Reg
y_reg (Reg -> RI
RIReg Reg
s)
, Format -> Reg -> Reg -> RI -> Instr
SR Format
fmt Reg
vn1 Reg
v (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
fmt Reg
vn0 Reg
v Int
half
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
un32 Reg
xh_reg (Reg -> RI
RIReg Reg
s)
, Reg -> Reg -> RI -> Instr
SUBFC Reg
tmp Reg
s
(Imm -> RI
RIImm (Int -> Imm
ImmInt (Int
8 forall a. Num a => a -> a -> a
* Format -> Int
formatInBytes Format
fmt)))
, Format -> Reg -> Reg -> RI -> Instr
SR Format
fmt Reg
tmp Reg
xl_reg (Reg -> RI
RIReg Reg
tmp)
, Reg -> Reg -> RI -> Instr
OR Reg
un32 Reg
un32 (Reg -> RI
RIReg Reg
tmp)
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
un10 Reg
xl_reg (Reg -> RI
RIReg Reg
s)
, Format -> Reg -> Reg -> RI -> Instr
SR Format
fmt Reg
un1 Reg
un10 (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
fmt Reg
un0 Reg
un10 Int
half
, Format -> Bool -> Reg -> Reg -> Reg -> Instr
DIV Format
fmt Bool
False Reg
q1 Reg
un32 Reg
vn1
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q1 (Reg -> RI
RIReg Reg
vn1)
, Reg -> Reg -> Reg -> Instr
SUBF Reg
rhat Reg
tmp Reg
un32
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
again1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
again1
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
q1 (Reg -> RI
RIReg Reg
b)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
GEU BlockId
then1 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
no1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
no1
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q1 (Reg -> RI
RIReg Reg
vn0)
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
tmp1 Reg
rhat (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Reg -> Reg -> RI -> Instr
ADD Reg
tmp1 Reg
tmp1 (Reg -> RI
RIReg Reg
un1)
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
tmp (Reg -> RI
RIReg Reg
tmp1)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LEU BlockId
endif1 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
then1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
then1
, Reg -> Reg -> RI -> Instr
ADD Reg
q1 Reg
q1 (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
1)))
, Reg -> Reg -> RI -> Instr
ADD Reg
rhat Reg
rhat (Reg -> RI
RIReg Reg
vn1)
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
rhat (Reg -> RI
RIReg Reg
b)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LTT BlockId
again1 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
endif1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
endif1
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
un21 Reg
un32 (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Reg -> Reg -> RI -> Instr
ADD Reg
un21 Reg
un21 (Reg -> RI
RIReg Reg
un1)
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q1 (Reg -> RI
RIReg Reg
v)
, Reg -> Reg -> Reg -> Instr
SUBF Reg
un21 Reg
tmp Reg
un21
, Format -> Bool -> Reg -> Reg -> Reg -> Instr
DIV Format
fmt Bool
False Reg
q0 Reg
un21 Reg
vn1
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q0 (Reg -> RI
RIReg Reg
vn1)
, Reg -> Reg -> Reg -> Instr
SUBF Reg
rhat Reg
tmp Reg
un21
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
again2 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
again2
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
q0 (Reg -> RI
RIReg Reg
b)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
GEU BlockId
then2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
no2 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
no2
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q0 (Reg -> RI
RIReg Reg
vn0)
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
tmp1 Reg
rhat (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Reg -> Reg -> RI -> Instr
ADD Reg
tmp1 Reg
tmp1 (Reg -> RI
RIReg Reg
un0)
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
tmp (Reg -> RI
RIReg Reg
tmp1)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LEU BlockId
endif2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
then2 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
then2
, Reg -> Reg -> RI -> Instr
ADD Reg
q0 Reg
q0 (Imm -> RI
RIImm (Int -> Imm
ImmInt (-Int
1)))
, Reg -> Reg -> RI -> Instr
ADD Reg
rhat Reg
rhat (Reg -> RI
RIReg Reg
vn1)
, Format -> Reg -> RI -> Instr
CMPL Format
fmt Reg
rhat (Reg -> RI
RIReg Reg
b)
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LTT BlockId
again2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
endif2 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
endif2
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
reg_r Reg
un21 (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Reg -> Reg -> RI -> Instr
ADD Reg
reg_r Reg
reg_r (Reg -> RI
RIReg Reg
un0)
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
tmp Reg
q0 (Reg -> RI
RIReg Reg
v)
, Reg -> Reg -> Reg -> Instr
SUBF Reg
reg_r Reg
tmp Reg
reg_r
, Format -> Reg -> Reg -> RI -> Instr
SR Format
fmt Reg
reg_r Reg
reg_r (Reg -> RI
RIReg Reg
s)
, Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
reg_q Reg
q1 (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
half))
, Reg -> Reg -> RI -> Instr
ADD Reg
reg_q Reg
reg_q (Reg -> RI
RIReg Reg
q0)
]
divOp2 Platform
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCCall: Wrong number of arguments for divOp2"
multOp2 :: Platform
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
multOp2 Platform
platform Width
width [CmmFormal
res_h, CmmFormal
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
= do let reg_h :: Reg
reg_h = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_h)
reg_l :: Reg
reg_l = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_l)
fmt :: Format
fmt = Width -> Format
intFormat Width
width
(Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_y
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
reg_l Reg
x_reg (Reg -> RI
RIReg Reg
y_reg)
, Format -> Reg -> Reg -> Reg -> Instr
MULHU Format
fmt Reg
reg_h Reg
x_reg Reg
y_reg
]
multOp2 Platform
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCall: Wrong number of arguments for multOp2"
add2Op :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op Platform
platform [CmmFormal
res_h, CmmFormal
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
= do let reg_h :: Reg
reg_h = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_h)
reg_l :: Reg
reg_l = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_l)
(Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_y
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Reg -> Imm -> Instr
LI Reg
reg_h (Int -> Imm
ImmInt Int
0)
, Reg -> Reg -> Reg -> Instr
ADDC Reg
reg_l Reg
x_reg Reg
y_reg
, Reg -> Reg -> Instr
ADDZE Reg
reg_h Reg
reg_h
]
add2Op Platform
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for add2"
addcOp :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addcOp Platform
platform [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
= Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op Platform
platform [CmmFormal
res_c , CmmFormal
res_r ] [CmmExpr
arg_x, CmmExpr
arg_y]
addcOp Platform
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for addc"
subcOp :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
subcOp Platform
platform [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
= do let reg_r :: Reg
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_r)
reg_c :: Reg
reg_c = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_c)
(Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_y
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Reg -> Imm -> Instr
LI Reg
reg_c (Int -> Imm
ImmInt Int
0)
, Reg -> Reg -> RI -> Instr
SUBFC Reg
reg_r Reg
y_reg (Reg -> RI
RIReg Reg
x_reg)
, Reg -> Reg -> Instr
ADDZE Reg
reg_c Reg
reg_c
, Reg -> Reg -> RI -> Instr
XOR Reg
reg_c Reg
reg_c (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
1))
]
subcOp Platform
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for subc"
addSubCOp :: (Reg -> Reg -> Reg -> Instr)
-> Platform
-> Width
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
instr Platform
platform Width
width [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
= do let reg_r :: Reg
reg_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_r)
reg_c :: Reg
reg_c = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res_c)
(Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_x
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_y
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Reg -> Reg -> Reg -> Instr
instr Reg
reg_r Reg
y_reg Reg
x_reg,
Format -> Reg -> Instr
MFOV (Width -> Format
intFormat Width
width) Reg
reg_c
]
addSubCOp Reg -> Reg -> Reg -> Instr
_ Platform
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCall: Wrong number of arguments/results for addC"
fabs :: Platform -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs Platform
platform [CmmFormal
res] [CmmExpr
arg]
= do let res_r :: Reg
res_r = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
res)
(Reg
arg_reg, OrdList Instr
arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ OrdList Instr
arg_code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
FABS Reg
res_r Reg
arg_reg
fabs Platform
_ [CmmFormal]
_ [CmmExpr]
_
= forall a. String -> a
panic String
"genCall: Wrong number of arguments/results for fabs"
data GenCCallPlatform = GCP32ELF | GCP64ELF !Int | GCPAIX
platformToGCP :: Platform -> GenCCallPlatform
platformToGCP :: Platform -> GenCCallPlatform
platformToGCP Platform
platform
= case Platform -> OS
platformOS Platform
platform of
OS
OSAIX -> GenCCallPlatform
GCPAIX
OS
_ -> case Platform -> Arch
platformArch Platform
platform of
Arch
ArchPPC -> GenCCallPlatform
GCP32ELF
ArchPPC_64 PPC_64ABI
ELF_V1 -> Int -> GenCCallPlatform
GCP64ELF Int
1
ArchPPC_64 PPC_64ABI
ELF_V2 -> Int -> GenCCallPlatform
GCP64ELF Int
2
Arch
_ -> forall a. String -> a
panic String
"platformToGCP: Not PowerPC"
genCCall'
:: NCGConfig
-> GenCCallPlatform
-> ForeignTarget
-> [CmmFormal]
-> [CmmActual]
-> NatM InstrBlock
genCCall' :: NCGConfig
-> GenCCallPlatform
-> ForeignTarget
-> [CmmFormal]
-> [CmmExpr]
-> NatM (OrdList Instr)
genCCall' NCGConfig
config GenCCallPlatform
gcp ForeignTarget
target [CmmFormal]
dest_regs [CmmExpr]
args
= do
(Int
finalStack,OrdList Instr
passArgumentsCode,[Reg]
usedRegs) <- [(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments
(forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [CmmExpr]
args [CmmType]
argReps [ForeignHint]
argHints)
[Reg]
allArgRegs
(Platform -> [Reg]
allFPArgRegs Platform
platform)
Int
initialStackOffset
forall a. OrdList a
nilOL []
(Either CLabel CmmExpr
labelOrExpr, Bool
reduceToFF32) <- case ForeignTarget
target of
ForeignTarget (CmmLit (CmmLabel CLabel
lbl)) ForeignConvention
_ -> do
NatM ()
uses_pic_base_implicitly
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left CLabel
lbl, Bool
False)
ForeignTarget CmmExpr
expr ForeignConvention
_ -> do
NatM ()
uses_pic_base_implicitly
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right CmmExpr
expr, Bool
False)
PrimTarget CallishMachOp
mop -> CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
outOfLineMachOp CallishMachOp
mop
let codeBefore :: OrdList Instr
codeBefore = Int -> OrdList Instr
move_sp_down Int
finalStack forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
passArgumentsCode
codeAfter :: OrdList Instr
codeAfter = Int -> OrdList Instr
move_sp_up Int
finalStack forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Bool -> OrdList Instr
moveResult Bool
reduceToFF32
case Either CLabel CmmExpr
labelOrExpr of
Left CLabel
lbl ->
forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
codeBefore
forall a. OrdList a -> a -> OrdList a
`snocOL` CLabel -> [Reg] -> Instr
BL CLabel
lbl [Reg]
usedRegs
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
maybeNOP
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeAfter)
Right CmmExpr
dyn -> do
(Reg
dynReg, OrdList Instr
dynCode) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
dyn
case GenCCallPlatform
gcp of
GCP64ELF Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeBefore
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
40))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
0))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
8))
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
16))
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
40))
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeAfter)
GCP64ELF Int
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeBefore
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
24))
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
r12 Reg
dynReg
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r12
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
24))
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeAfter)
GenCCallPlatform
GCPAIX -> forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeBefore
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
20))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
0))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
4))
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
r11 (Reg -> Imm -> AddrMode
AddrRegImm Reg
dynReg (Int -> Imm
ImmInt Int
8))
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
spFormat Reg
toc (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
20))
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeAfter)
GenCCallPlatform
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
dynReg
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeBefore
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
codeAfter)
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
uses_pic_base_implicitly :: NatM ()
uses_pic_base_implicitly =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NCGConfig -> Bool
ncgPIC NCGConfig
config Bool -> Bool -> Bool
&& Platform -> Bool
target32Bit Platform
platform) forall a b. (a -> b) -> a -> b
$ do
Reg
_ <- Format -> NatM Reg
getPicBaseNat forall a b. (a -> b) -> a -> b
$ Bool -> Format
archWordFormat Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return ()
initialStackOffset :: Int
initialStackOffset = case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX -> Int
24
GenCCallPlatform
GCP32ELF -> Int
8
GCP64ELF Int
1 -> Int
48
GCP64ELF Int
2 -> Int
32
GenCCallPlatform
_ -> forall a. String -> a
panic String
"genCall': unknown calling convention"
stackDelta :: Int -> Int
stackDelta Int
finalStack = case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX ->
forall a. Integral a => a -> a -> a
roundTo Int
16 forall a b. (a -> b) -> a -> b
$ (Int
24 forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
32 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Width -> Int
widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth) [CmmType]
argReps
GenCCallPlatform
GCP32ELF -> forall a. Integral a => a -> a -> a
roundTo Int
16 Int
finalStack
GCP64ELF Int
1 ->
forall a. Integral a => a -> a -> a
roundTo Int
16 forall a b. (a -> b) -> a -> b
$ (Int
48 forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
64 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> a -> a
roundTo Int
8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Int
widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth)
[CmmType]
argReps
GCP64ELF Int
2 ->
forall a. Integral a => a -> a -> a
roundTo Int
16 forall a b. (a -> b) -> a -> b
$ (Int
32 forall a. Num a => a -> a -> a
+) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
64 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a. Integral a => a -> a -> a
roundTo Int
8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Int
widthInBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth)
[CmmType]
argReps
GenCCallPlatform
_ -> forall a. String -> a
panic String
"genCall': unknown calling conv."
argReps :: [CmmType]
argReps = forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmExpr -> CmmType
cmmExprType Platform
platform) [CmmExpr]
args
([ForeignHint]
argHints, [ForeignHint]
_) = ForeignTarget -> ([ForeignHint], [ForeignHint])
foreignTargetHints ForeignTarget
target
roundTo :: a -> a -> a
roundTo a
a a
x | a
x forall a. Integral a => a -> a -> a
`mod` a
a forall a. Eq a => a -> a -> Bool
== a
0 = a
x
| Bool
otherwise = a
x forall a. Num a => a -> a -> a
+ a
a forall a. Num a => a -> a -> a
- (a
x forall a. Integral a => a -> a -> a
`mod` a
a)
spFormat :: Format
spFormat = if Platform -> Bool
target32Bit Platform
platform then Format
II32 else Format
II64
move_sp_down :: Int -> OrdList Instr
move_sp_down Int
finalStack
| Int
delta forall a. Ord a => a -> a -> Bool
> Platform -> Int
stackFrameHeaderSize Platform
platform =
forall a. [a] -> OrdList a
toOL [Format -> Reg -> AddrMode -> Instr
STU Format
spFormat Reg
sp (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt (-Int
delta))),
Int -> Instr
DELTA (-Int
delta)]
| Bool
otherwise = forall a. OrdList a
nilOL
where delta :: Int
delta = Int -> Int
stackDelta Int
finalStack
move_sp_up :: Int -> OrdList Instr
move_sp_up Int
finalStack
| Int
delta forall a. Ord a => a -> a -> Bool
> Platform -> Int
stackFrameHeaderSize Platform
platform =
forall a. [a] -> OrdList a
toOL [Reg -> Reg -> RI -> Instr
ADD Reg
sp Reg
sp (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
delta)),
Int -> Instr
DELTA Int
0]
| Bool
otherwise = forall a. OrdList a
nilOL
where delta :: Int
delta = Int -> Int
stackDelta Int
finalStack
maybeNOP :: OrdList Instr
maybeNOP = case GenCCallPlatform
gcp of
GenCCallPlatform
GCP32ELF -> forall a. OrdList a
nilOL
GenCCallPlatform
GCPAIX -> forall a. a -> OrdList a
unitOL Instr
NOP
GCP64ELF Int
1 -> forall a. a -> OrdList a
unitOL Instr
NOP
GCP64ELF Int
2 -> forall a. a -> OrdList a
unitOL Instr
NOP
GenCCallPlatform
_ -> forall a. String -> a
panic String
"maybeNOP: Unknown PowerPC 64-bit ABI"
passArguments :: [(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [] [Reg]
_ [Reg]
_ Int
stackOffset OrdList Instr
accumCode [Reg]
accumUsed = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
stackOffset, OrdList Instr
accumCode, [Reg]
accumUsed)
passArguments ((CmmExpr
arg,CmmType
arg_ty,ForeignHint
_):[(CmmExpr, CmmType, ForeignHint)]
args) [Reg]
gprs [Reg]
fprs Int
stackOffset
OrdList Instr
accumCode [Reg]
accumUsed | CmmType -> Bool
isWord64 CmmType
arg_ty
Bool -> Bool -> Bool
&& Platform -> Bool
target32Bit (NCGConfig -> Platform
ncgPlatform NCGConfig
config) =
do
ChildCode64 OrdList Instr
code Reg
vr_lo <- CmmExpr -> NatM ChildCode64
iselExpr64 CmmExpr
arg
let vr_hi :: Reg
vr_hi = Reg -> Reg
getHiVRegFromLo Reg
vr_lo
case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX ->
do let storeWord :: Reg -> [Reg] -> Int -> Instr
storeWord Reg
vr (Reg
gpr:[Reg]
_) Int
_ = Reg -> Reg -> Instr
MR Reg
gpr Reg
vr
storeWord Reg
vr [] Int
offset
= Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
vr (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
offset))
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args
(forall a. Int -> [a] -> [a]
drop Int
2 [Reg]
gprs)
[Reg]
fprs
(Int
stackOffsetforall a. Num a => a -> a -> a
+Int
8)
(OrdList Instr
accumCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> [Reg] -> Int -> Instr
storeWord Reg
vr_hi [Reg]
gprs Int
stackOffset
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> [Reg] -> Int -> Instr
storeWord Reg
vr_lo (forall a. Int -> [a] -> [a]
drop Int
1 [Reg]
gprs) (Int
stackOffsetforall a. Num a => a -> a -> a
+Int
4))
((forall a. Int -> [a] -> [a]
take Int
2 [Reg]
gprs) forall a. [a] -> [a] -> [a]
++ [Reg]
accumUsed)
GenCCallPlatform
GCP32ELF ->
do let stackOffset' :: Int
stackOffset' = forall a. Integral a => a -> a -> a
roundTo Int
8 Int
stackOffset
stackCode :: OrdList Instr
stackCode = OrdList Instr
accumCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
vr_hi (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
stackOffset'))
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
vr_lo (Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt (Int
stackOffset'forall a. Num a => a -> a -> a
+Int
4)))
regCode :: Reg -> Reg -> OrdList Instr
regCode Reg
hireg Reg
loreg =
OrdList Instr
accumCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
hireg Reg
vr_hi
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
loreg Reg
vr_lo
case [Reg]
gprs of
Reg
hireg : Reg
loreg : [Reg]
regs | forall a. Integral a => a -> Bool
even (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Reg]
gprs) ->
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args [Reg]
regs [Reg]
fprs Int
stackOffset
(Reg -> Reg -> OrdList Instr
regCode Reg
hireg Reg
loreg) (Reg
hireg forall a. a -> [a] -> [a]
: Reg
loreg forall a. a -> [a] -> [a]
: [Reg]
accumUsed)
Reg
_skipped : Reg
hireg : Reg
loreg : [Reg]
regs ->
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args [Reg]
regs [Reg]
fprs Int
stackOffset
(Reg -> Reg -> OrdList Instr
regCode Reg
hireg Reg
loreg) (Reg
hireg forall a. a -> [a] -> [a]
: Reg
loreg forall a. a -> [a] -> [a]
: [Reg]
accumUsed)
[Reg]
_ ->
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args [] [Reg]
fprs (Int
stackOffset'forall a. Num a => a -> a -> a
+Int
8)
OrdList Instr
stackCode [Reg]
accumUsed
GCP64ELF Int
_ -> forall a. String -> a
panic String
"passArguments: 32 bit code"
passArguments ((CmmExpr
arg,CmmType
rep,ForeignHint
hint):[(CmmExpr, CmmType, ForeignHint)]
args) [Reg]
gprs [Reg]
fprs Int
stackOffset OrdList Instr
accumCode [Reg]
accumUsed
| Reg
reg : [Reg]
_ <- [Reg]
regs = do
Register
register <- CmmExpr -> NatM Register
getRegister CmmExpr
arg_pro
let code :: OrdList Instr
code = case Register
register of
Fixed Format
_ Reg
freg OrdList Instr
fcode -> OrdList Instr
fcode forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
reg Reg
freg
Any Format
_ Reg -> OrdList Instr
acode -> Reg -> OrdList Instr
acode Reg
reg
stackOffsetRes :: Int
stackOffsetRes = case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX -> Int
stackOffset forall a. Num a => a -> a -> a
+ Int
stackBytes
GenCCallPlatform
GCP32ELF -> Int
stackOffset
GCP64ELF Int
_ -> Int
stackOffset forall a. Num a => a -> a -> a
+ Int
stackBytes
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args
(forall a. Int -> [a] -> [a]
drop Int
nGprs [Reg]
gprs)
(forall a. Int -> [a] -> [a]
drop Int
nFprs [Reg]
fprs)
Int
stackOffsetRes
(OrdList Instr
accumCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code)
(Reg
reg forall a. a -> [a] -> [a]
: [Reg]
accumUsed)
| Bool
otherwise = do
(Reg
vr, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg_pro
[(CmmExpr, CmmType, ForeignHint)]
-> [Reg]
-> [Reg]
-> Int
-> OrdList Instr
-> [Reg]
-> NatM (Int, OrdList Instr, [Reg])
passArguments [(CmmExpr, CmmType, ForeignHint)]
args
(forall a. Int -> [a] -> [a]
drop Int
nGprs [Reg]
gprs)
(forall a. Int -> [a] -> [a]
drop Int
nFprs [Reg]
fprs)
(Int
stackOffset' forall a. Num a => a -> a -> a
+ Int
stackBytes)
(OrdList Instr
accumCode forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
ST Format
format_pro Reg
vr AddrMode
stackSlot)
[Reg]
accumUsed
where
arg_pro :: CmmExpr
arg_pro
| CmmType -> Bool
isBitsType CmmType
rep = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> Width -> MachOp
conv_op (CmmType -> Width
typeWidth CmmType
rep) (Platform -> Width
wordWidth Platform
platform)) [CmmExpr
arg]
| Bool
otherwise = CmmExpr
arg
format_pro :: Format
format_pro
| CmmType -> Bool
isBitsType CmmType
rep = Width -> Format
intFormat (Platform -> Width
wordWidth Platform
platform)
| Bool
otherwise = CmmType -> Format
cmmTypeFormat CmmType
rep
conv_op :: Width -> Width -> MachOp
conv_op = case ForeignHint
hint of
ForeignHint
SignedHint -> Width -> Width -> MachOp
MO_SS_Conv
ForeignHint
_ -> Width -> Width -> MachOp
MO_UU_Conv
stackOffset' :: Int
stackOffset' = case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX ->
Int
stackOffset
GenCCallPlatform
GCP32ELF
| CmmType -> Bool
isFloatType CmmType
rep Bool -> Bool -> Bool
&& CmmType -> Width
typeWidth CmmType
rep forall a. Eq a => a -> a -> Bool
== Width
W64 ->
forall a. Integral a => a -> a -> a
roundTo Int
8 Int
stackOffset
| Bool
otherwise ->
Int
stackOffset
GCP64ELF Int
_ ->
Int
stackOffset
stackOffset'' :: Int
stackOffset''
| CmmType -> Bool
isFloatType CmmType
rep Bool -> Bool -> Bool
&& CmmType -> Width
typeWidth CmmType
rep forall a. Eq a => a -> a -> Bool
== Width
W32 =
case GenCCallPlatform
gcp of
GCP64ELF Int
1 -> Int
stackOffset' forall a. Num a => a -> a -> a
+ Int
4
GenCCallPlatform
_ -> Int
stackOffset'
| Bool
otherwise = Int
stackOffset'
stackSlot :: AddrMode
stackSlot = Reg -> Imm -> AddrMode
AddrRegImm Reg
sp (Int -> Imm
ImmInt Int
stackOffset'')
(Int
nGprs, Int
nFprs, Int
stackBytes, [Reg]
regs)
= case GenCCallPlatform
gcp of
GenCCallPlatform
GCPAIX ->
case CmmType -> Format
cmmTypeFormat CmmType
rep of
Format
II8 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
II16 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
II32 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
FF32 -> (Int
1, Int
1, Int
4, [Reg]
fprs)
Format
FF64 -> (Int
2, Int
1, Int
8, [Reg]
fprs)
Format
II64 -> forall a. String -> a
panic String
"genCCall' passArguments II64"
GenCCallPlatform
GCP32ELF ->
case CmmType -> Format
cmmTypeFormat CmmType
rep of
Format
II8 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
II16 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
II32 -> (Int
1, Int
0, Int
4, [Reg]
gprs)
Format
FF32 -> (Int
0, Int
1, Int
4, [Reg]
fprs)
Format
FF64 -> (Int
0, Int
1, Int
8, [Reg]
fprs)
Format
II64 -> forall a. String -> a
panic String
"genCCall' passArguments II64"
GCP64ELF Int
_ ->
case CmmType -> Format
cmmTypeFormat CmmType
rep of
Format
II8 -> (Int
1, Int
0, Int
8, [Reg]
gprs)
Format
II16 -> (Int
1, Int
0, Int
8, [Reg]
gprs)
Format
II32 -> (Int
1, Int
0, Int
8, [Reg]
gprs)
Format
II64 -> (Int
1, Int
0, Int
8, [Reg]
gprs)
Format
FF32 -> (Int
1, Int
1, Int
8, [Reg]
fprs)
Format
FF64 -> (Int
1, Int
1, Int
8, [Reg]
fprs)
moveResult :: Bool -> OrdList Instr
moveResult Bool
reduceToFF32 =
case [CmmFormal]
dest_regs of
[] -> forall a. OrdList a
nilOL
[CmmFormal
dest]
| Bool
reduceToFF32 Bool -> Bool -> Bool
&& CmmType -> Bool
isFloat32 CmmType
rep -> forall a. a -> OrdList a
unitOL (Reg -> Reg -> Instr
FRSP Reg
r_dest Reg
f1)
| CmmType -> Bool
isFloat32 CmmType
rep Bool -> Bool -> Bool
|| CmmType -> Bool
isFloat64 CmmType
rep -> forall a. a -> OrdList a
unitOL (Reg -> Reg -> Instr
MR Reg
r_dest Reg
f1)
| CmmType -> Bool
isWord64 CmmType
rep Bool -> Bool -> Bool
&& Platform -> Bool
target32Bit Platform
platform
-> forall a. [a] -> OrdList a
toOL [Reg -> Reg -> Instr
MR (Reg -> Reg
getHiVRegFromLo Reg
r_dest) Reg
r3,
Reg -> Reg -> Instr
MR Reg
r_dest Reg
r4]
| Bool
otherwise -> forall a. a -> OrdList a
unitOL (Reg -> Reg -> Instr
MR Reg
r_dest Reg
r3)
where rep :: CmmType
rep = Platform -> CmmReg -> CmmType
cmmRegType Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dest)
r_dest :: Reg
r_dest = Platform -> CmmReg -> Reg
getRegisterReg Platform
platform (CmmFormal -> CmmReg
CmmLocal CmmFormal
dest)
[CmmFormal]
_ -> forall a. String -> a
panic String
"genCCall' moveResult: Bad dest_regs"
outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
outOfLineMachOp CallishMachOp
mop =
do
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
ForeignLabelInThisPackage 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, Bool
reduce)
where
(FastString
functionName, Bool
reduce) = case CallishMachOp
mop of
CallishMachOp
MO_F32_Exp -> (String -> FastString
fsLit String
"exp", Bool
True)
CallishMachOp
MO_F32_ExpM1 -> (String -> FastString
fsLit String
"expm1", Bool
True)
CallishMachOp
MO_F32_Log -> (String -> FastString
fsLit String
"log", Bool
True)
CallishMachOp
MO_F32_Log1P -> (String -> FastString
fsLit String
"log1p", Bool
True)
CallishMachOp
MO_F32_Sqrt -> (String -> FastString
fsLit String
"sqrt", Bool
True)
CallishMachOp
MO_F32_Fabs -> (FastString, Bool)
unsupported
CallishMachOp
MO_F32_Sin -> (String -> FastString
fsLit String
"sin", Bool
True)
CallishMachOp
MO_F32_Cos -> (String -> FastString
fsLit String
"cos", Bool
True)
CallishMachOp
MO_F32_Tan -> (String -> FastString
fsLit String
"tan", Bool
True)
CallishMachOp
MO_F32_Asin -> (String -> FastString
fsLit String
"asin", Bool
True)
CallishMachOp
MO_F32_Acos -> (String -> FastString
fsLit String
"acos", Bool
True)
CallishMachOp
MO_F32_Atan -> (String -> FastString
fsLit String
"atan", Bool
True)
CallishMachOp
MO_F32_Sinh -> (String -> FastString
fsLit String
"sinh", Bool
True)
CallishMachOp
MO_F32_Cosh -> (String -> FastString
fsLit String
"cosh", Bool
True)
CallishMachOp
MO_F32_Tanh -> (String -> FastString
fsLit String
"tanh", Bool
True)
CallishMachOp
MO_F32_Pwr -> (String -> FastString
fsLit String
"pow", Bool
True)
CallishMachOp
MO_F32_Asinh -> (String -> FastString
fsLit String
"asinh", Bool
True)
CallishMachOp
MO_F32_Acosh -> (String -> FastString
fsLit String
"acosh", Bool
True)
CallishMachOp
MO_F32_Atanh -> (String -> FastString
fsLit String
"atanh", Bool
True)
CallishMachOp
MO_F64_Exp -> (String -> FastString
fsLit String
"exp", Bool
False)
CallishMachOp
MO_F64_ExpM1 -> (String -> FastString
fsLit String
"expm1", Bool
False)
CallishMachOp
MO_F64_Log -> (String -> FastString
fsLit String
"log", Bool
False)
CallishMachOp
MO_F64_Log1P -> (String -> FastString
fsLit String
"log1p", Bool
False)
CallishMachOp
MO_F64_Sqrt -> (String -> FastString
fsLit String
"sqrt", Bool
False)
CallishMachOp
MO_F64_Fabs -> (FastString, Bool)
unsupported
CallishMachOp
MO_F64_Sin -> (String -> FastString
fsLit String
"sin", Bool
False)
CallishMachOp
MO_F64_Cos -> (String -> FastString
fsLit String
"cos", Bool
False)
CallishMachOp
MO_F64_Tan -> (String -> FastString
fsLit String
"tan", Bool
False)
CallishMachOp
MO_F64_Asin -> (String -> FastString
fsLit String
"asin", Bool
False)
CallishMachOp
MO_F64_Acos -> (String -> FastString
fsLit String
"acos", Bool
False)
CallishMachOp
MO_F64_Atan -> (String -> FastString
fsLit String
"atan", Bool
False)
CallishMachOp
MO_F64_Sinh -> (String -> FastString
fsLit String
"sinh", Bool
False)
CallishMachOp
MO_F64_Cosh -> (String -> FastString
fsLit String
"cosh", Bool
False)
CallishMachOp
MO_F64_Tanh -> (String -> FastString
fsLit String
"tanh", Bool
False)
CallishMachOp
MO_F64_Pwr -> (String -> FastString
fsLit String
"pow", Bool
False)
CallishMachOp
MO_F64_Asinh -> (String -> FastString
fsLit String
"asinh", Bool
False)
CallishMachOp
MO_F64_Acosh -> (String -> FastString
fsLit String
"acosh", Bool
False)
CallishMachOp
MO_F64_Atanh -> (String -> FastString
fsLit String
"atanh", Bool
False)
CallishMachOp
MO_I64_ToI -> (String -> FastString
fsLit String
"hs_int64ToInt", Bool
False)
CallishMachOp
MO_I64_FromI -> (String -> FastString
fsLit String
"hs_intToInt64", Bool
False)
CallishMachOp
MO_W64_ToW -> (String -> FastString
fsLit String
"hs_word64ToWord", Bool
False)
CallishMachOp
MO_W64_FromW -> (String -> FastString
fsLit String
"hs_wordToWord64", Bool
False)
CallishMachOp
MO_x64_Neg -> (String -> FastString
fsLit String
"hs_neg64", Bool
False)
CallishMachOp
MO_x64_Add -> (String -> FastString
fsLit String
"hs_add64", Bool
False)
CallishMachOp
MO_x64_Sub -> (String -> FastString
fsLit String
"hs_sub64", Bool
False)
CallishMachOp
MO_x64_Mul -> (String -> FastString
fsLit String
"hs_mul64", Bool
False)
CallishMachOp
MO_I64_Quot -> (String -> FastString
fsLit String
"hs_quotInt64", Bool
False)
CallishMachOp
MO_I64_Rem -> (String -> FastString
fsLit String
"hs_remInt64", Bool
False)
CallishMachOp
MO_W64_Quot -> (String -> FastString
fsLit String
"hs_quotWord64", Bool
False)
CallishMachOp
MO_W64_Rem -> (String -> FastString
fsLit String
"hs_remWord64", Bool
False)
CallishMachOp
MO_x64_And -> (String -> FastString
fsLit String
"hs_and64", Bool
False)
CallishMachOp
MO_x64_Or -> (String -> FastString
fsLit String
"hs_or64", Bool
False)
CallishMachOp
MO_x64_Xor -> (String -> FastString
fsLit String
"hs_xor64", Bool
False)
CallishMachOp
MO_x64_Not -> (String -> FastString
fsLit String
"hs_not64", Bool
False)
CallishMachOp
MO_x64_Shl -> (String -> FastString
fsLit String
"hs_uncheckedShiftL64", Bool
False)
CallishMachOp
MO_I64_Shr -> (String -> FastString
fsLit String
"hs_uncheckedIShiftRA64", Bool
False)
CallishMachOp
MO_W64_Shr -> (String -> FastString
fsLit String
"hs_uncheckedShiftRL64", Bool
False)
CallishMachOp
MO_x64_Eq -> (String -> FastString
fsLit String
"hs_eq64", Bool
False)
CallishMachOp
MO_x64_Ne -> (String -> FastString
fsLit String
"hs_ne64", Bool
False)
CallishMachOp
MO_I64_Ge -> (String -> FastString
fsLit String
"hs_geInt64", Bool
False)
CallishMachOp
MO_I64_Gt -> (String -> FastString
fsLit String
"hs_gtInt64", Bool
False)
CallishMachOp
MO_I64_Le -> (String -> FastString
fsLit String
"hs_leInt64", Bool
False)
CallishMachOp
MO_I64_Lt -> (String -> FastString
fsLit String
"hs_ltInt64", Bool
False)
CallishMachOp
MO_W64_Ge -> (String -> FastString
fsLit String
"hs_geWord64", Bool
False)
CallishMachOp
MO_W64_Gt -> (String -> FastString
fsLit String
"hs_gtWord64", Bool
False)
CallishMachOp
MO_W64_Le -> (String -> FastString
fsLit String
"hs_leWord64", Bool
False)
CallishMachOp
MO_W64_Lt -> (String -> FastString
fsLit String
"hs_ltWord64", Bool
False)
MO_UF_Conv Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
word2FloatLabel Width
w, Bool
False)
MO_Memcpy Int
_ -> (String -> FastString
fsLit String
"memcpy", Bool
False)
MO_Memset Int
_ -> (String -> FastString
fsLit String
"memset", Bool
False)
MO_Memmove Int
_ -> (String -> FastString
fsLit String
"memmove", Bool
False)
MO_Memcmp Int
_ -> (String -> FastString
fsLit String
"memcmp", Bool
False)
MO_BSwap Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
bSwapLabel Width
w, Bool
False)
MO_BRev Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
bRevLabel Width
w, Bool
False)
MO_PopCnt Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
popCntLabel Width
w, Bool
False)
MO_Pdep Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
pdepLabel Width
w, Bool
False)
MO_Pext Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
pextLabel Width
w, Bool
False)
MO_Clz Width
_ -> (FastString, Bool)
unsupported
MO_Ctz Width
_ -> (FastString, Bool)
unsupported
MO_AtomicRMW {} -> (FastString, Bool)
unsupported
MO_Cmpxchg Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
cmpxchgLabel Width
w, Bool
False)
MO_Xchg Width
w -> (String -> FastString
fsLit forall a b. (a -> b) -> a -> b
$ Width -> String
xchgLabel Width
w, Bool
False)
MO_AtomicRead Width
_ -> (FastString, Bool)
unsupported
MO_AtomicWrite Width
_ -> (FastString, Bool)
unsupported
MO_S_Mul2 {} -> (FastString, Bool)
unsupported
MO_S_QuotRem {} -> (FastString, Bool)
unsupported
MO_U_QuotRem {} -> (FastString, Bool)
unsupported
MO_U_QuotRem2 {} -> (FastString, Bool)
unsupported
MO_Add2 {} -> (FastString, Bool)
unsupported
MO_AddWordC {} -> (FastString, Bool)
unsupported
MO_SubWordC {} -> (FastString, Bool)
unsupported
MO_AddIntC {} -> (FastString, Bool)
unsupported
MO_SubIntC {} -> (FastString, Bool)
unsupported
MO_U_Mul2 {} -> (FastString, Bool)
unsupported
CallishMachOp
MO_ReadBarrier -> (FastString, Bool)
unsupported
CallishMachOp
MO_WriteBarrier -> (FastString, Bool)
unsupported
CallishMachOp
MO_Touch -> (FastString, Bool)
unsupported
MO_Prefetch_Data Int
_ -> (FastString, Bool)
unsupported
unsupported :: (FastString, Bool)
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")
genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM InstrBlock
genSwitch :: NCGConfig -> CmmExpr -> SwitchTargets -> NatM (OrdList Instr)
genSwitch NCGConfig
config CmmExpr
expr SwitchTargets
targets
| OS
OSAIX <- Platform -> OS
platformOS Platform
platform
= do
(Reg
reg,OrdList Instr
e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
expr Int
offset)
let fmt :: Format
fmt = Bool -> Format
archWordFormat forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
sha :: Int
sha = if Platform -> Bool
target32Bit Platform
platform then Int
2 else Int
3
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
CLabel
lbl <- NatM CLabel
getNewLabelNat
CmmExpr
dynRef <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
DataReference CLabel
lbl
(Reg
tableReg,OrdList Instr
t_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg forall a b. (a -> b) -> a -> b
$ CmmExpr
dynRef
let code :: OrdList Instr
code = OrdList Instr
e_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
t_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
tmp Reg
reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
sha)),
Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
tmp (Reg -> Reg -> AddrMode
AddrRegReg Reg
tableReg Reg
tmp),
Reg -> Instr
MTCTR Reg
tmp,
[Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [Maybe BlockId]
ids (forall a. a -> Maybe a
Just CLabel
lbl) []
]
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
| (NCGConfig -> Bool
ncgPIC NCGConfig
config) Bool -> Bool -> Bool
|| (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform)
= do
(Reg
reg,OrdList Instr
e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
expr Int
offset)
let fmt :: Format
fmt = Bool -> Format
archWordFormat forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
sha :: Int
sha = if Platform -> Bool
target32Bit Platform
platform then Int
2 else Int
3
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
CLabel
lbl <- NatM CLabel
getNewLabelNat
CmmExpr
dynRef <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
DataReference CLabel
lbl
(Reg
tableReg,OrdList Instr
t_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg forall a b. (a -> b) -> a -> b
$ CmmExpr
dynRef
let code :: OrdList Instr
code = OrdList Instr
e_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
t_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
tmp Reg
reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
sha)),
Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
tmp (Reg -> Reg -> AddrMode
AddrRegReg Reg
tableReg Reg
tmp),
Reg -> Reg -> RI -> Instr
ADD Reg
tmp Reg
tmp (Reg -> RI
RIReg Reg
tableReg),
Reg -> Instr
MTCTR Reg
tmp,
[Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [Maybe BlockId]
ids (forall a. a -> Maybe a
Just CLabel
lbl) []
]
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
| Bool
otherwise
= do
(Reg
reg,OrdList Instr
e_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
expr Int
offset)
let fmt :: Format
fmt = Bool -> Format
archWordFormat forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
sha :: Int
sha = if Platform -> Bool
target32Bit Platform
platform then Int
2 else Int
3
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
fmt
CLabel
lbl <- NatM CLabel
getNewLabelNat
let code :: OrdList Instr
code = OrdList Instr
e_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Format -> Reg -> Reg -> RI -> Instr
SL Format
fmt Reg
tmp Reg
reg (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
sha)),
Reg -> Reg -> Imm -> Instr
ADDIS Reg
tmp Reg
tmp (Imm -> Imm
HA (CLabel -> Imm
ImmCLbl CLabel
lbl)),
Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
tmp (Reg -> Imm -> AddrMode
AddrRegImm Reg
tmp (Imm -> Imm
LO (CLabel -> Imm
ImmCLbl CLabel
lbl))),
Reg -> Instr
MTCTR Reg
tmp,
[Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [Maybe BlockId]
ids (forall a. a -> Maybe a
Just CLabel
lbl) []
]
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
where
(Int
offset, [Maybe BlockId]
ids) = SwitchTargets -> (Int, [Maybe BlockId])
switchTargetsToTable SwitchTargets
targets
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
generateJumpTableForInstr :: NCGConfig -> Instr
-> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr :: NCGConfig -> Instr -> Maybe (NatCmmDecl RawCmmStatics Instr)
generateJumpTableForInstr NCGConfig
config (BCTR [Maybe BlockId]
ids (Just CLabel
lbl) [Reg]
_) =
let jumpTable :: [CmmStatic]
jumpTable
| (NCGConfig -> Bool
ncgPIC NCGConfig
config) Bool -> Bool -> Bool
|| (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit forall a b. (a -> b) -> a -> b
$ NCGConfig -> Platform
ncgPlatform NCGConfig
config)
= forall a b. (a -> b) -> [a] -> [b]
map Maybe BlockId -> CmmStatic
jumpTableEntryRel [Maybe BlockId]
ids
| Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> Maybe BlockId -> CmmStatic
jumpTableEntry NCGConfig
config) [Maybe BlockId]
ids
where jumpTableEntryRel :: Maybe BlockId -> CmmStatic
jumpTableEntryRel Maybe BlockId
Nothing
= CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0 (NCGConfig -> Width
ncgWordWidth NCGConfig
config))
jumpTableEntryRel (Just BlockId
blockid)
= CmmLit -> CmmStatic
CmmStaticLit (CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
blockLabel CLabel
lbl Int
0
(NCGConfig -> Width
ncgWordWidth NCGConfig
config))
where blockLabel :: CLabel
blockLabel = BlockId -> CLabel
blockLbl BlockId
blockid
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
lbl) (forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
lbl [CmmStatic]
jumpTable))
generateJumpTableForInstr NCGConfig
_ Instr
_ = forall a. Maybe a
Nothing
condReg :: NatM CondCode -> NatM Register
condReg :: NatM CondCode -> NatM Register
condReg NatM CondCode
getCond = do
CondCode Bool
_ Cond
cond OrdList Instr
cond_code <- NatM CondCode
getCond
Platform
platform <- NatM Platform
getPlatform
let
code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
cond_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
negate_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Reg -> Instr
MFCR Reg
dst,
Reg -> Reg -> Int -> Int -> Int -> Instr
RLWINM Reg
dst Reg
dst (Int
bit forall a. Num a => a -> a -> a
+ Int
1) Int
31 Int
31
]
negate_code :: OrdList Instr
negate_code | Bool
do_negate = forall a. a -> OrdList a
unitOL (Int -> Int -> Int -> Instr
CRNOR Int
bit Int
bit Int
bit)
| Bool
otherwise = forall a. OrdList a
nilOL
(Int
bit, Bool
do_negate) = case Cond
cond of
Cond
LTT -> (Int
0, Bool
False)
Cond
LE -> (Int
1, Bool
True)
Cond
EQQ -> (Int
2, Bool
False)
Cond
GE -> (Int
0, Bool
True)
Cond
GTT -> (Int
1, Bool
False)
Cond
NE -> (Int
2, Bool
True)
Cond
LU -> (Int
0, Bool
False)
Cond
LEU -> (Int
1, Bool
True)
Cond
GEU -> (Int
0, Bool
True)
Cond
GU -> (Int
1, Bool
False)
Cond
_ -> forall a. String -> a
panic String
"PPC.CodeGen.codeReg: no match"
format :: Format
format = Bool -> Format
archWordFormat forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
condIntReg :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM Register
condIntReg Cond
cond Width
width CmmExpr
x CmmExpr
y = NatM CondCode -> NatM Register
condReg (Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
condIntCode Cond
cond Width
width CmmExpr
x CmmExpr
y)
condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg Cond
cond CmmExpr
x CmmExpr
y = NatM CondCode -> NatM Register
condReg (Cond -> CmmExpr -> CmmExpr -> NatM CondCode
condFltCode Cond
cond CmmExpr
x CmmExpr
y)
trivialCode
:: Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode :: Width
-> Bool
-> (Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode Width
rep Bool
signed Reg -> Reg -> RI -> Instr
instr CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
| Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep Bool
signed Integer
y
= do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
instr Reg
dst Reg
src1 (Imm -> RI
RIImm Imm
imm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
rep) Reg -> OrdList Instr
code)
trivialCode Width
rep Bool
_ Reg -> Reg -> RI -> Instr
instr CmmExpr
x CmmExpr
y = do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
instr Reg
dst Reg
src1 (Reg -> RI
RIReg Reg
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
rep) Reg -> OrdList Instr
code)
shiftMulCode
:: Width
-> Bool
-> (Format-> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shiftMulCode :: Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
shiftMulCode Width
width Bool
sign Format -> Reg -> Reg -> RI -> Instr
instr CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
| Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
sign Integer
y
= do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let format :: Format
format = Width -> Format
intFormat Width
width
let ins_fmt :: Format
ins_fmt = Width -> Format
intFormat (forall a. Ord a => a -> a -> a
max Width
W32 Width
width)
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> RI -> Instr
instr Format
ins_fmt Reg
dst Reg
src1 (Imm -> RI
RIImm Imm
imm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
shiftMulCode Width
width Bool
_ Format -> Reg -> Reg -> RI -> Instr
instr CmmExpr
x CmmExpr
y = do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
let format :: Format
format = Width -> Format
intFormat Width
width
let ins_fmt :: Format
ins_fmt = Width -> Format
intFormat (forall a. Ord a => a -> a -> a
max Width
W32 Width
width)
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> Reg -> RI -> Instr
instr Format
ins_fmt Reg
dst Reg
src1 (Reg -> RI
RIReg Reg
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
trivialCodeNoImm' :: Format -> (Reg -> Reg -> Reg -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
trivialCodeNoImm' :: Format
-> (Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCodeNoImm' Format
format Reg -> Reg -> Reg -> Instr
instr CmmExpr
x CmmExpr
y = do
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
y
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Reg -> Instr
instr Reg
dst Reg
src1 Reg
src2
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
format Reg -> OrdList Instr
code)
trivialCodeNoImm :: Format -> (Format -> Reg -> Reg -> Reg -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
trivialCodeNoImm :: Format
-> (Format -> Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCodeNoImm Format
format Format -> Reg -> Reg -> Reg -> Instr
instr CmmExpr
x CmmExpr
y
= Format
-> (Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCodeNoImm' Format
format (Format -> Reg -> Reg -> Reg -> Instr
instr Format
format) CmmExpr
x CmmExpr
y
srCode :: Width -> Bool -> (Format-> Reg -> Reg -> RI -> Instr)
-> CmmExpr -> CmmExpr -> NatM Register
srCode :: Width
-> Bool
-> (Format -> Reg -> Reg -> RI -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
srCode Width
width Bool
sgn Format -> Reg -> Reg -> RI -> Instr
instr CmmExpr
x (CmmLit (CmmInt Integer
y Width
_))
| Just Imm
imm <- forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
sgn Integer
y
= do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
width
extend :: Width -> Width -> CmmExpr -> CmmExpr
extend = if Bool
sgn then Width -> Width -> CmmExpr -> CmmExpr
extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
extendUExpr
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
width Width
op_len CmmExpr
x)
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Reg -> Reg -> RI -> Instr
instr (Width -> Format
intFormat Width
op_len) Reg
dst Reg
src1 (Imm -> RI
RIImm Imm
imm)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
width) Reg -> OrdList Instr
code)
srCode Width
width Bool
sgn Format -> Reg -> Reg -> RI -> Instr
instr CmmExpr
x CmmExpr
y = do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
width
extend :: Width -> Width -> CmmExpr -> CmmExpr
extend = if Bool
sgn then Width -> Width -> CmmExpr -> CmmExpr
extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
extendUExpr
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
width Width
op_len CmmExpr
x)
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extendUExpr Width
width Width
op_len CmmExpr
y)
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Reg -> Reg -> RI -> Instr
instr (Width -> Format
intFormat Width
op_len) Reg
dst Reg
src1 (Reg -> RI
RIReg Reg
src2)
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
width) Reg -> OrdList Instr
code)
divCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
divCode :: Width -> Bool -> CmmExpr -> CmmExpr -> NatM Register
divCode Width
width Bool
sgn CmmExpr
x CmmExpr
y = do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
width
extend :: Width -> Width -> CmmExpr -> CmmExpr
extend = if Bool
sgn then Width -> Width -> CmmExpr -> CmmExpr
extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
extendUExpr
(Reg
src1, OrdList Instr
code1) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
width Width
op_len CmmExpr
x)
(Reg
src2, OrdList Instr
code2) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
width Width
op_len CmmExpr
y)
let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 forall a. OrdList a -> a -> OrdList a
`snocOL`
Format -> Bool -> Reg -> Reg -> Reg -> Instr
DIV (Width -> Format
intFormat Width
op_len) Bool
sgn Reg
dst Reg
src1 Reg
src2
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
width) Reg -> OrdList Instr
code)
trivialUCode :: Format
-> (Reg -> Reg -> Instr)
-> CmmExpr
-> NatM Register
trivialUCode :: Format -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register
trivialUCode Format
rep Reg -> Reg -> Instr
instr CmmExpr
x = do
(Reg
src, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
let code' :: Reg -> OrdList Instr
code' Reg
dst = OrdList Instr
code forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
instr Reg
dst Reg
src
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
rep Reg -> OrdList Instr
code')
remainderCode :: Width -> Bool -> Reg -> CmmExpr -> CmmExpr
-> NatM (Reg -> InstrBlock)
remainderCode :: Width
-> Bool -> Reg -> CmmExpr -> CmmExpr -> NatM (Reg -> OrdList Instr)
remainderCode Width
rep Bool
sgn Reg
reg_q CmmExpr
arg_x CmmExpr
arg_y = do
let op_len :: Width
op_len = forall a. Ord a => a -> a -> a
max Width
W32 Width
rep
fmt :: Format
fmt = Width -> Format
intFormat Width
op_len
extend :: Width -> Width -> CmmExpr -> CmmExpr
extend = if Bool
sgn then Width -> Width -> CmmExpr -> CmmExpr
extendSExpr else Width -> Width -> CmmExpr -> CmmExpr
extendUExpr
(Reg
x_reg, OrdList Instr
x_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
rep Width
op_len CmmExpr
arg_x)
(Reg
y_reg, OrdList Instr
y_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg (Width -> Width -> CmmExpr -> CmmExpr
extend Width
rep Width
op_len CmmExpr
arg_y)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Reg
reg_r -> OrdList Instr
y_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [ Format -> Bool -> Reg -> Reg -> Reg -> Instr
DIV Format
fmt Bool
sgn Reg
reg_q Reg
x_reg Reg
y_reg
, Format -> Reg -> Reg -> RI -> Instr
MULL Format
fmt Reg
reg_r Reg
reg_q (Reg -> RI
RIReg Reg
y_reg)
, Reg -> Reg -> Reg -> Instr
SUBF Reg
reg_r Reg
reg_r Reg
x_reg
]
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP Width
fromRep Width
toRep CmmExpr
x = do
Platform
platform <- NatM Platform
getPlatform
let arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP' Arch
arch Width
fromRep Width
toRep CmmExpr
x
coerceInt2FP' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP' Arch
ArchPPC Width
fromRep Width
toRep CmmExpr
x = do
(Reg
src, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
CLabel
lbl <- NatM CLabel
getNewLabelNat
Reg
itmp <- Format -> NatM Reg
getNewRegNat Format
II32
Reg
ftmp <- Format -> NatM Reg
getNewRegNat Format
FF64
NCGConfig
config <- NatM NCGConfig
getConfig
Platform
platform <- NatM Platform
getPlatform
CmmExpr
dynRef <- forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
DataReference CLabel
lbl
Amode AddrMode
addr OrdList Instr
addr_code <- InstrForm -> CmmExpr -> NatM Amode
getAmode InstrForm
D CmmExpr
dynRef
let
code' :: Reg -> OrdList Instr
code' Reg
dst = OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
maybe_exts forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Section -> RawCmmStatics -> Instr
LDATA (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) forall a b. (a -> b) -> a -> b
$ forall (a :: Bool). CLabel -> [CmmStatic] -> GenCmmStatics a
CmmStaticsRaw CLabel
lbl
[CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0x43300000 Width
W32),
CmmLit -> CmmStatic
CmmStaticLit (Integer -> Width -> CmmLit
CmmInt Integer
0x80000000 Width
W32)],
Reg -> Reg -> Imm -> Instr
XORIS Reg
itmp Reg
src (Int -> Imm
ImmInt Int
0x8000),
Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
itmp (Platform -> Int -> AddrMode
spRel Platform
platform Int
3),
Reg -> Imm -> Instr
LIS Reg
itmp (Int -> Imm
ImmInt Int
0x4330),
Format -> Reg -> AddrMode -> Instr
ST Format
II32 Reg
itmp (Platform -> Int -> AddrMode
spRel Platform
platform Int
2),
Format -> Reg -> AddrMode -> Instr
LD Format
FF64 Reg
ftmp (Platform -> Int -> AddrMode
spRel Platform
platform Int
2)
] forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Format -> Reg -> AddrMode -> Instr
LD Format
FF64 Reg
dst AddrMode
addr,
Format -> Reg -> Reg -> Reg -> Instr
FSUB Format
FF64 Reg
dst Reg
ftmp Reg
dst
] forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
maybe_frsp Reg
dst
maybe_exts :: OrdList Instr
maybe_exts = case Width
fromRep of
Width
W8 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II8 Reg
src Reg
src
Width
W16 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II16 Reg
src Reg
src
Width
W32 -> forall a. OrdList a
nilOL
Width
_ -> forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
maybe_frsp :: Reg -> OrdList Instr
maybe_frsp Reg
dst
= case Width
toRep of
Width
W32 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Instr
FRSP Reg
dst Reg
dst
Width
W64 -> forall a. OrdList a
nilOL
Width
_ -> forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
floatFormat Width
toRep) Reg -> OrdList Instr
code')
coerceInt2FP' (ArchPPC_64 PPC_64ABI
_) Width
fromRep Width
toRep CmmExpr
x = do
(Reg
src, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
Platform
platform <- NatM Platform
getPlatform
Reg
upper <- Format -> NatM Reg
getNewRegNat Format
II64
Reg
lower <- Format -> NatM Reg
getNewRegNat Format
II64
BlockId
l1 <- NatM BlockId
getBlockIdNat
BlockId
l2 <- NatM BlockId
getBlockIdNat
let
code' :: Reg -> OrdList Instr
code' Reg
dst = OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
maybe_exts forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Format -> Reg -> AddrMode -> Instr
ST Format
II64 Reg
src (Platform -> Int -> AddrMode
spRel Platform
platform Int
3),
Format -> Reg -> AddrMode -> Instr
LD Format
FF64 Reg
dst (Platform -> Int -> AddrMode
spRel Platform
platform Int
3),
Reg -> Reg -> Instr
FCFID Reg
dst Reg
dst
] forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Reg -> OrdList Instr
maybe_frsp Reg
dst
maybe_exts :: OrdList Instr
maybe_exts
= case Width
fromRep of
Width
W8 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II8 Reg
src Reg
src
Width
W16 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II16 Reg
src Reg
src
Width
W32 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II32 Reg
src Reg
src
Width
W64 -> case Width
toRep of
Width
W32 -> forall a. [a] -> OrdList a
toOL [ Format -> Reg -> Reg -> RI -> Instr
SRA Format
II64 Reg
upper Reg
src (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
53))
, Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
II64 Reg
lower Reg
src Int
53
, Reg -> Reg -> RI -> Instr
ADD Reg
upper Reg
upper (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
1))
, Reg -> Reg -> RI -> Instr
ADD Reg
lower Reg
lower (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
2047))
, Format -> Reg -> RI -> Instr
CMPL Format
II64 Reg
upper (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
2))
, Reg -> Reg -> RI -> Instr
OR Reg
lower Reg
lower (Reg -> RI
RIReg Reg
src)
, Format -> Reg -> Reg -> Int -> Instr
CLRRI Format
II64 Reg
lower Reg
lower Int
11
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
LTT BlockId
l2 forall a. Maybe a
Nothing
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
l1 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
l1
, Reg -> Reg -> Instr
MR Reg
src Reg
lower
, Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
l2 forall a. Maybe a
Nothing
, BlockId -> Instr
NEWBLOCK BlockId
l2
]
Width
_ -> forall a. OrdList a
nilOL
Width
_ -> forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
maybe_frsp :: Reg -> OrdList Instr
maybe_frsp Reg
dst
= case Width
toRep of
Width
W32 -> forall a. a -> OrdList a
unitOL forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Instr
FRSP Reg
dst Reg
dst
Width
W64 -> forall a. OrdList a
nilOL
Width
_ -> forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
floatFormat Width
toRep) Reg -> OrdList Instr
code')
coerceInt2FP' Arch
_ Width
_ Width
_ CmmExpr
_ = forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: unknown arch"
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int Width
fromRep Width
toRep CmmExpr
x = do
Platform
platform <- NatM Platform
getPlatform
let arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int' Arch
arch Width
fromRep Width
toRep CmmExpr
x
coerceFP2Int' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int' :: Arch -> Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int' Arch
ArchPPC Width
_ Width
toRep CmmExpr
x = do
Platform
platform <- NatM Platform
getPlatform
(Reg
src, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF64
let
code' :: Reg -> OrdList Instr
code' Reg
dst = OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Reg -> Reg -> Instr
FCTIWZ Reg
tmp Reg
src,
Format -> Reg -> AddrMode -> Instr
ST Format
FF64 Reg
tmp (Platform -> Int -> AddrMode
spRel Platform
platform Int
2),
Format -> Reg -> AddrMode -> Instr
LD Format
II32 Reg
dst (Platform -> Int -> AddrMode
spRel Platform
platform Int
3)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
toRep) Reg -> OrdList Instr
code')
coerceFP2Int' (ArchPPC_64 PPC_64ABI
_) Width
_ Width
toRep CmmExpr
x = do
Platform
platform <- NatM Platform
getPlatform
(Reg
src, OrdList Instr
code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
x
Reg
tmp <- Format -> NatM Reg
getNewRegNat Format
FF64
let
code' :: Reg -> OrdList Instr
code' Reg
dst = OrdList Instr
code forall a. OrdList a -> OrdList a -> OrdList a
`appOL` forall a. [a] -> OrdList a
toOL [
Reg -> Reg -> Instr
FCTIDZ Reg
tmp Reg
src,
Format -> Reg -> AddrMode -> Instr
ST Format
FF64 Reg
tmp (Platform -> Int -> AddrMode
spRel Platform
platform Int
3),
Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
dst (Platform -> Int -> AddrMode
spRel Platform
platform Int
3)]
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any (Width -> Format
intFormat Width
toRep) Reg -> OrdList Instr
code')
coerceFP2Int' Arch
_ Width
_ Width
_ CmmExpr
_ = forall a. String -> a
panic String
"PPC.CodeGen.coerceFP2Int: unknown arch"