{-# LANGUAGE GADTs #-}
module GHC.CmmToAsm.PPC.CodeGen (
        cmmTopCodeGen,
        generateJumpTableForInstr,
        InstrBlock
)
where
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
   , Reg64(..), RegCode64(..), getNewReg64, localReg64
   , 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 GHC.Utils.Panic.Plain
import Control.Monad    ( mapAndUnzipM, when )
import Data.Word
import GHC.Types.Basic
import GHC.Data.FastString
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) <- (CmmBlock
 -> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr]))
-> [CmmBlock]
-> NatM
     ([[NatBasicBlock Instr]], [[NatCmmDecl RawCmmStatics Instr]])
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 = LabelMap RawCmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl RawCmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live ([NatBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph ([NatBasicBlock Instr] -> ListGraph Instr)
-> [NatBasicBlock Instr] -> ListGraph Instr
forall a b. (a -> b) -> a -> b
$ [[NatBasicBlock Instr]] -> [NatBasicBlock Instr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[NatBasicBlock Instr]]
nat_blocks)
      tops :: [NatCmmDecl RawCmmStatics Instr]
tops = NatCmmDecl RawCmmStatics Instr
proc NatCmmDecl RawCmmStatics Instr
-> [NatCmmDecl RawCmmStatics Instr]
-> [NatCmmDecl RawCmmStatics Instr]
forall a. a -> [a] -> [a]
: [[NatCmmDecl RawCmmStatics Instr]]
-> [NatCmmDecl RawCmmStatics Instr]
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 OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSAIX -> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
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 -> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [NatCmmDecl RawCmmStatics Instr]
tops
    ArchPPC_64 PPC_64ABI
ELF_V1 -> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
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 -> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
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
_          -> String -> NatM [NatCmmDecl RawCmmStatics Instr]
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 CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== (BlockId -> CLabel
blockLbl BlockId
bID)
                then m BlockId
forall (m :: * -> *). MonadUnique m => m BlockId
newBlockId
                else BlockId -> m BlockId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
bID
        let b' :: GenBasicBlock i
b' = BlockId -> [i] -> GenBasicBlock i
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID' [i]
insns
        [GenCmmDecl d h (ListGraph i)] -> m [GenCmmDecl d h (ListGraph i)]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (h
-> CLabel
-> [GlobalReg]
-> ListGraph i
-> GenCmmDecl d h (ListGraph i)
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc h
info CLabel
lab [GlobalReg]
live ([GenBasicBlock i] -> ListGraph i
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph (GenBasicBlock i
b'GenBasicBlock i -> [GenBasicBlock i] -> [GenBasicBlock i]
forall a. a -> [a] -> [a]
:[GenBasicBlock i]
blocks)) GenCmmDecl d h (ListGraph i)
-> [GenCmmDecl d h (ListGraph i)] -> [GenCmmDecl d h (ListGraph i)]
forall a. a -> [a] -> [a]
: [GenCmmDecl d h (ListGraph i)]
statics)
      fixup_entry [GenCmmDecl d h (ListGraph i)]
_ = String -> m [GenCmmDecl d h (ListGraph i)]
forall a. String -> a
panic String
"cmmTopCodegen: Broken CmmProc"
cmmTopCodeGen (CmmData Section
sec RawCmmStatics
dat) =
  [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return [Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
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)  = CmmBlock -> (CmmNode C O, Block CmmNode O O, CmmNode O C)
forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
      id :: BlockId
id = CmmBlock -> BlockId
forall (x :: Extensibility). Block CmmNode C x -> BlockId
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmBlock
block
      stmts :: [CmmNode O O]
stmts = Block CmmNode O O -> [CmmNode O O]
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 (CmmBlock -> BlockId
forall (x :: Extensibility). Block CmmNode C x -> BlockId
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmBlock
block)
  OrdList Instr
loc_instrs <- case DebugBlock -> Maybe CmmTickish
dblSourceTick (DebugBlock -> Maybe CmmTickish)
-> Maybe DebugBlock -> Maybe CmmTickish
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
            OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> String -> Instr
LOCATION Int
fileid Int
line Int
col String
name
    Maybe CmmTickish
_ -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
forall a. OrdList a
nilOL
  OrdList Instr
mid_instrs <- [CmmNode O O] -> NatM (OrdList Instr)
forall (e :: Extensibility) (x :: Extensibility).
[CmmNode e x] -> NatM (OrdList Instr)
stmtsToInstrs [CmmNode O O]
stmts
  OrdList Instr
tail_instrs <- CmmNode O C -> NatM (OrdList Instr)
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
mid_instrs OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
tail_instrs
  
  
  
  
  let
        ([Instr]
top,[NatBasicBlock Instr]
other_blocks,[NatCmmDecl RawCmmStatics Instr]
statics) = (Instr
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl RawCmmStatics Instr])
 -> ([Instr], [NatBasicBlock Instr],
     [NatCmmDecl RawCmmStatics Instr]))
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
-> OrdList Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL Instr
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
-> ([Instr], [NatBasicBlock Instr],
    [NatCmmDecl RawCmmStatics Instr])
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)
          = ([], BlockId -> [Instr] -> NatBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
instrs NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
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, Section -> RawCmmStatics -> GenCmmDecl RawCmmStatics h g
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData Section
sec RawCmmStatics
datGenCmmDecl RawCmmStatics h g
-> [GenCmmDecl RawCmmStatics h g] -> [GenCmmDecl RawCmmStatics h g]
forall a. a -> [a] -> [a]
:[GenCmmDecl RawCmmStatics h g]
statics)
        mkBlocks Instr
instr ([Instr]
instrs,[NatBasicBlock Instr]
blocks,[GenCmmDecl RawCmmStatics h g]
statics)
          = (Instr
instrInstr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
:[Instr]
instrs, [NatBasicBlock Instr]
blocks, [GenCmmDecl RawCmmStatics h g]
statics)
  ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
-> NatM ([NatBasicBlock Instr], [NatCmmDecl RawCmmStatics Instr])
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (BlockId -> [Instr] -> NatBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
id [Instr]
top NatBasicBlock Instr
-> [NatBasicBlock Instr] -> [NatBasicBlock Instr]
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 <- (CmmNode e x -> NatM (OrdList Instr))
-> [CmmNode e x] -> NatM [OrdList Instr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM CmmNode e x -> NatM (OrdList Instr)
forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> NatM (OrdList Instr)
stmtToInstrs [CmmNode e x]
stmts
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([OrdList Instr] -> OrdList Instr
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   -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (SDoc -> Instr
COMMENT (SDoc -> Instr) -> SDoc -> Instr
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext FastString
s))
    CmmTick {}     -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
forall a. OrdList a
nilOL
    CmmUnwind {}   -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
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
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
b1 OrdList Instr -> OrdList Instr -> OrdList Instr
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
_ ->
      String -> NatM (OrdList Instr)
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 <- (GlobalReg -> Maybe RealReg) -> [GlobalReg] -> [Maybe RealReg]
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
getLocalRegReg :: LocalReg -> Reg
getLocalRegReg :: CmmFormal -> Reg
getLocalRegReg (LocalReg Unique
u CmmType
pk)
  = VirtualReg -> Reg
RegVirtual (Unique -> Format -> VirtualReg
mkVirtualReg Unique
u (CmmType -> Format
cmmTypeFormat CmmType
pk))
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg Platform
_ (CmmLocal CmmFormal
local_reg)
  = CmmFormal -> Reg
getLocalRegReg CmmFormal
local_reg
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  -> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getRegisterReg-memory" (CmmReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CmmReg -> SDoc) -> CmmReg -> SDoc
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 (Int -> Integer
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
_
        = String -> CmmExpr
forall a. String -> a
panic String
"PPC.CodeGen.mangleIndexTree: no match"
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
        (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Reg -> OrdList Instr
code Reg
tmp)
    Fixed Format
_ Reg
reg OrdList Instr
code ->
        (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
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 -> (AddrMode, AddrMode, OrdList Instr)
-> NatM (AddrMode, AddrMode, OrdList Instr)
forall a. a -> NatM a
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
                           (AddrMode, AddrMode, OrdList Instr)
-> NatM (AddrMode, AddrMode, OrdList Instr)
forall a. a -> NatM a
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
        RegCode64 OrdList Instr
vcode Reg
rhi Reg
rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
valueTree
        let
                
                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
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
vcode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo OrdList Instr -> Instr -> OrdList Instr
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 CmmFormal
lreg) CmmExpr
valueTree = do
   RegCode64 OrdList Instr
vcode Reg
r_src_hi Reg
r_src_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
valueTree
   let Reg64 Reg
r_dst_hi Reg
r_dst_lo = (() :: Constraint) => CmmFormal -> Reg64
CmmFormal -> Reg64
localReg64 CmmFormal
lreg
       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
   OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (
        OrdList Instr
vcode OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi
     )
assignReg_I64Code CmmReg
_ CmmExpr
_
   = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"assignReg_I64Code(powerpc): invalid lvalue"
iselExpr64        :: CmmExpr -> NatM (RegCode64 InstrBlock)
iselExpr64 :: CmmExpr -> NatM (RegCode64 (OrdList Instr))
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
    Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
    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
    RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr)))
-> RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 (OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
                         Reg
rhi Reg
rlo
iselExpr64 (CmmReg (CmmLocal CmmFormal
local_reg)) = do
  let Reg64 Reg
hi Reg
lo = (() :: Constraint) => CmmFormal -> Reg64
CmmFormal -> Reg64
localReg64 CmmFormal
local_reg
  RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 OrdList Instr
forall a. OrdList a
nilOL Reg
hi Reg
lo)
iselExpr64 (CmmLit (CmmInt Integer
i Width
_)) = do
  Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
  let
        half0 :: Int
half0 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i :: Word16)
        half1 :: Int
half1 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) :: Word16)
        half2 :: Int
half2 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word16)
        half3 :: Int
half3 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) :: Word16)
        code :: OrdList Instr
code = [Instr] -> OrdList Instr
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 (Imm -> RI) -> Imm -> RI
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 (Imm -> RI) -> Imm -> RI
forall a b. (a -> b) -> a -> b
$ Int -> Imm
ImmInt Int
half2)
                ]
  RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 OrdList Instr
code Reg
rhi Reg
rlo)
iselExpr64 (CmmMachOp (MO_Add Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
   RegCode64 OrdList Instr
code1 Reg
r1hi Reg
r1lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
   RegCode64 OrdList Instr
code2 Reg
r2hi Reg
r2lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e2
   Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
   let
        code :: OrdList Instr
code =  OrdList Instr
code1 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                OrdList Instr
code2 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                [Instr] -> OrdList Instr
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 ]
   RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 OrdList Instr
code Reg
rhi Reg
rlo)
iselExpr64 (CmmMachOp (MO_Sub Width
_) [CmmExpr
e1,CmmExpr
e2]) = do
   RegCode64 OrdList Instr
code1 Reg
r1hi Reg
r1lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e1
   RegCode64 OrdList Instr
code2 Reg
r2hi Reg
r2lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
e2
   Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
   let
        code :: OrdList Instr
code =  OrdList Instr
code1 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                OrdList Instr
code2 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                [Instr] -> OrdList Instr
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 ]
   RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 OrdList Instr
code Reg
rhi 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
    Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
    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
    RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr)))
-> RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 (OrdList Instr
expr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
                       Reg
rhi 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
    Reg64 Reg
rhi Reg
rlo <- NatM Reg64
getNewReg64
    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
    RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr)))
-> RegCode64 (OrdList Instr) -> NatM (RegCode64 (OrdList Instr))
forall a b. (a -> b) -> a -> b
$ OrdList Instr -> Reg -> Reg -> RegCode64 (OrdList Instr)
forall code. code -> Reg -> Reg -> RegCode64 code
RegCode64 (OrdList Instr
expr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_lo OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Instr
mov_hi)
                       Reg
rhi Reg
rlo
iselExpr64 CmmExpr
expr
   = do
     Platform
platform <- NatM Platform
getPlatform
     String -> SDoc -> NatM (RegCode64 (OrdList Instr))
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 = [Instr] -> OrdList Instr
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]"))
        Register -> NatM Register
forall a. a -> NatM a
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 (Format -> NatM Reg) -> Format -> NatM Reg
forall a b. (a -> b) -> a -> b
$ Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)
      Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr
forall a. OrdList a
nilOL)
  | Bool
otherwise = Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> Reg -> OrdList Instr -> Register
Fixed Format
II64 Reg
toc OrdList Instr
forall a. OrdList a
nilOL)
getRegister' NCGConfig
_ Platform
platform (CmmReg CmmReg
reg)
  = Register -> NatM Register
forall a. a -> NatM a
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) OrdList Instr
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
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
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
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
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
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
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
  RegCode64 OrdList Instr
code Reg
_rhi Reg
rlo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
  Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Register -> NatM Register) -> Register -> NatM Register
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 = Bool -> OrdList Instr -> OrdList Instr
forall a. HasCallStack => Bool -> a -> a
assert ((Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
dst RegClass -> RegClass -> Bool
forall a. Eq a => a -> a -> Bool
== RegClass
RcDouble) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== CmmType -> Bool
isFloatType CmmType
pk) (OrdList Instr -> OrdList Instr) -> OrdList Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$
                       OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr
        Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
II64 Reg
dst AddrMode
addr
        Register -> NatM Register
forall a. a -> NatM a
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II32 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
    Register -> NatM Register
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Format -> (Reg -> OrdList Instr) -> Register
Any Format
II64 (\Reg
dst -> OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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 Width -> Width -> Bool
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 Width -> Width -> Bool
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
_ -> String -> NatM Register
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
                 Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL`
                                 Format -> Reg -> Reg -> Int -> Instr
CLRLI Format
arch_fmt Reg
dst Reg
src1 (Int
arch_bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size)
                 Register -> NatM Register
forall a. a -> NatM a
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
_ <- Width -> Bool -> Integer -> Maybe 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 (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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))
                                ]
                Register -> NatM Register
forall a. a -> NatM a
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
_ <- Width -> Bool -> Integer -> Maybe 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 (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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
_ <- Width -> Bool -> Integer -> Maybe 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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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
                                    ]
        Register -> NatM Register
forall a. a -> NatM a
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -Integer
8 Bool -> Bool -> Bool
|| Integer
imm Integer -> Integer -> Bool
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 Integer -> Integer -> Bool
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
                               OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Reg -> Reg -> Int -> Instr
CLRRI Format
fmt Reg
dst Reg
src Int
clear_mask)
                Register -> NatM Register
forall a. a -> NatM a
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
_         -> String -> NatM Register
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
      Register -> NatM Register
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe 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 = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Reg -> Imm -> Instr
LI Reg
dst Imm
imm)
    in
        Register -> NatM Register
forall a. a -> NatM a
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 <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
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)
                  (CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmLit -> CmmStatic
CmmStaticLit (Rational -> Width -> CmmLit
CmmFloat Rational
f Width
frep)])
            Instr -> OrdList Instr -> OrdList Instr
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr)
    Register -> NatM Register
forall a. a -> NatM a
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 = [Instr] -> OrdList Instr
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 Register -> NatM Register
forall a. a -> NatM a
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 <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
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) (CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmLit -> CmmStatic
CmmStaticLit CmmLit
lit])
            Instr -> OrdList Instr -> OrdList Instr
forall a. a -> OrdList a -> OrdList a
`consOL` (OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Format -> Reg -> AddrMode -> Instr
LD Format
format Reg
dst AddrMode
addr)
       Register -> NatM Register
forall a. a -> NatM a
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 = String -> SDoc -> NatM Register
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 <- Width -> Bool -> Integer -> Maybe Imm
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
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 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                      then (Reg, Imm, OrdList Instr) -> NatM (Reg, Imm, OrdList Instr)
forall a. a -> NatM a
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
                           (Reg, Imm, OrdList Instr) -> NatM (Reg, Imm, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Int -> Imm
ImmInt Int
0,
                                  OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
ADD Reg
tmp Reg
reg (Imm -> RI
RIImm Imm
off))
        Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
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 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
                      then (Reg, Imm, OrdList Instr) -> NatM (Reg, Imm, OrdList Instr)
forall a. a -> NatM a
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
                           (Reg, Imm, OrdList Instr) -> NatM (Reg, Imm, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
tmp, Int -> Imm
ImmInt Int
0,
                                  OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
ADD Reg
tmp Reg
reg (Imm -> RI
RIImm Imm
off))
        Amode -> NatM Amode
forall a. a -> NatM a
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 ->
                    
                    Amode -> NatM Amode
forall a. a -> NatM a
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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Imm -> Instr
ADDIS Reg
tmp Reg
src (Imm -> Imm
HA Imm
imm)
                    Amode -> NatM Amode
forall a. a -> NatM a
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 = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Reg -> Imm -> Instr
LIS Reg
tmp (Imm -> Imm
HA Imm
imm))
                 Amode -> NatM Amode
forall a. a -> NatM a
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 =  [Instr] -> OrdList Instr
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)
                          ]
                 Amode -> NatM Amode
forall a. a -> NatM a
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
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
        Amode -> NatM Amode
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
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
        Amode -> NatM Amode
forall a. a -> NatM a
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
_ -> String -> SDoc -> NatM CondCode
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getCondCode(powerpc)" (MachOp -> SDoc
pprMachOp MachOp
mop)
getCondCode CmmExpr
_ = String -> NatM CondCode
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
      RegCode64 OrdList Instr
code_x Reg
x_hi Reg
x_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
      RegCode64 OrdList Instr
code_y Reg
y_hi Reg
y_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
      BlockId
end_lbl <- NatM BlockId
getBlockIdNat
      let code :: OrdList Instr
code = OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                 , BlockId -> Instr
NEWBLOCK BlockId
end_lbl
                 ]
      CondCode -> NatM CondCode
forall a. a -> NatM a
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
      RegCode64 OrdList Instr
code_x Reg
x_hi Reg
x_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
x
      RegCode64 OrdList Instr
code_y Reg
y_hi Reg
y_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
y
      BlockId
end_lbl <- NatM BlockId
getBlockIdNat
      BlockId
cmp_lo  <- NatM BlockId
getBlockIdNat
      let code :: OrdList Instr
code = OrdList Instr
code_x OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code_y OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 Maybe Bool
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 Maybe Bool
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 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                 , BlockId -> Instr
NEWBLOCK BlockId
end_lbl
                 ]
      CondCode -> NatM CondCode
forall a. a -> NatM a
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Cond -> Bool
condUnsigned Cond
cond,
    Just Imm
src2 <- Width -> Bool -> Integer -> Maybe Imm
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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
AND Reg
r0 Reg
src1 (Imm -> RI
RIImm Imm
src2)
      CondCode -> NatM CondCode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
rep (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Cond -> Bool
condUnsigned Cond
cond) Integer
y
  = do
      let op_len :: Width
op_len = Width -> Width -> Width
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 OrdList Instr -> Instr -> OrdList Instr
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)
      CondCode -> NatM CondCode
forall a. a -> NatM a
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 = Width -> Width -> Width
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
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)
  CondCode -> NatM CondCode
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
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' OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Int -> Int -> Int -> Instr
CRNOR Int
ltbit Int
eqbit Int
gtbit
                    Cond
LE -> OrdList Instr
code' OrdList Instr -> Instr -> OrdList Instr
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
    CondCode -> NatM CondCode
forall a. a -> NatM a
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
    OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code OrdList Instr -> Instr -> OrdList Instr
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
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
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 OrdList Instr -> Instr -> OrdList Instr
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
  = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code
               OrdList Instr -> Instr -> OrdList Instr
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))
               OrdList Instr -> Instr -> OrdList Instr
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))
               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
               OrdList Instr -> Instr -> OrdList Instr
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))
               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] Maybe CLabel
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
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code
               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
r12 Reg
target
               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r12
               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] Maybe CLabel
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
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
target OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Maybe BlockId] -> Maybe CLabel -> [Reg] -> Instr
BCTR [] Maybe CLabel
forall a. Maybe a
Nothing [Reg]
regs)
genBranch :: BlockId -> NatM InstrBlock
genBranch :: BlockId -> NatM (OrdList Instr)
genBranch = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> (BlockId -> OrdList Instr) -> BlockId -> NatM (OrdList Instr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL ([Instr] -> OrdList Instr)
-> (BlockId -> [Instr]) -> BlockId -> OrdList Instr
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
  OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
code OrdList Instr -> Instr -> OrdList Instr
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]
_
 = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
LWSYNC
genCCall (PrimTarget CallishMachOp
MO_WriteBarrier) [CmmFormal]
_ [CmmExpr]
_
 = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
LWSYNC
genCCall (PrimTarget CallishMachOp
MO_Touch) [CmmFormal]
_ [CmmExpr]
_
 = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
forall a. OrdList a
nilOL
genCCall (PrimTarget (MO_Prefetch_Data Int
_)) [CmmFormal]
_ [CmmExpr]
_
 = OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
forall a. OrdList a
nilOL
genCCall (PrimTarget (MO_AtomicRMW Width
width AtomicMachOp
amop)) [CmmFormal
dst] [CmmExpr
addr, CmmExpr
n]
 = do let fmt :: Format
fmt      = Width -> Format
intFormat Width
width
          reg_dst :: Reg
reg_dst  = CmmFormal -> Reg
getLocalRegReg 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 <- Width -> Bool -> Integer -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
True (-Integer
i)
                   -> (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
forall a. a -> NatM a
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), OrdList Instr
forall a. OrdList a
nilOL)
                CmmExpr
_
                   -> do
                         (Reg
n_reg, OrdList Instr
n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
n
                         (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
forall a. a -> NatM a
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
                           (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
forall a. a -> NatM a
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
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
n_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code
        OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Instr
HWSYNC
                     , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_retry Maybe Bool
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 (Bool -> Maybe Bool
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
                 Amode -> NatM Amode
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
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
                 Amode -> NatM Amode
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
sign Integer
i
                    -> (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg -> Reg -> RI -> Instr
op Reg
dst Reg
dst (Imm -> RI
RIImm Imm
imm), OrdList Instr
forall a. OrdList a
nilOL)
                 CmmExpr
_
                    -> do
                          (Reg
n_reg, OrdList Instr
n_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
n
                          (Instr, OrdList Instr) -> NatM (Instr, OrdList Instr)
forall a. a -> NatM a
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 MemoryOrdering
_)) [CmmFormal
dst] [CmmExpr
addr]
 = do let fmt :: Format
fmt      = Width -> Format
intFormat Width
width
          reg_dst :: Reg
reg_dst  = CmmFormal -> Reg
getLocalRegReg CmmFormal
dst
          form :: InstrForm
form     = if Width -> Int
widthInBits Width
width Int -> Int -> Bool
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
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
                                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_end Maybe Bool
forall a. Maybe a
Nothing
                            
                                      , BlockId -> Instr
NEWBLOCK BlockId
lbl_end
                                      , Instr
ISYNC
                                      ]
genCCall (PrimTarget (MO_AtomicWrite Width
width MemoryOrdering
_)) [] [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
    OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
HWSYNC OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
genCCall (PrimTarget (MO_Cmpxchg Width
width)) [CmmFormal
dst] [CmmExpr
addr, CmmExpr
old, CmmExpr
new]
  | Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 Bool -> Bool -> Bool
|| Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64
  = do
      (Reg
old_reg, OrdList Instr
old_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
old
      (Reg
new_reg, OrdList Instr
new_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
new
      (Reg
addr_reg, OrdList Instr
addr_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
addr
      BlockId
lbl_retry <- NatM BlockId
getBlockIdNat
      BlockId
lbl_eq    <- NatM BlockId
getBlockIdNat
      BlockId
lbl_end   <- NatM BlockId
getBlockIdNat
      let reg_dst :: Reg
reg_dst   = CmmFormal -> Reg
getLocalRegReg CmmFormal
dst
          code :: OrdList Instr
code      = [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL
                      [ Instr
HWSYNC
                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_retry Maybe Bool
forall a. Maybe a
Nothing
                      , BlockId -> Instr
NEWBLOCK BlockId
lbl_retry
                      , Format -> Reg -> AddrMode -> Instr
LDR Format
format Reg
reg_dst (Reg -> Reg -> AddrMode
AddrRegReg Reg
r0 Reg
addr_reg)
                      , Format -> Reg -> RI -> Instr
CMP Format
format Reg
reg_dst (Reg -> RI
RIReg Reg
old_reg)
                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl_end Maybe Bool
forall a. Maybe a
Nothing
                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_eq Maybe Bool
forall a. Maybe a
Nothing
                      , BlockId -> Instr
NEWBLOCK BlockId
lbl_eq
                      , Format -> Reg -> AddrMode -> Instr
STC Format
format Reg
new_reg (Reg -> Reg -> AddrMode
AddrRegReg Reg
r0 Reg
addr_reg)
                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
NE BlockId
lbl_retry Maybe Bool
forall a. Maybe a
Nothing
                      , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl_end Maybe Bool
forall a. Maybe a
Nothing
                      , BlockId -> Instr
NEWBLOCK BlockId
lbl_end
                      , Instr
ISYNC
                      ]
      OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
new_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
old_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
  where
    format :: Format
format = Width -> Format
intFormat Width
width
genCCall (PrimTarget (MO_Clz Width
width)) [CmmFormal
dst] [CmmExpr
src]
 = do Platform
platform <- NatM Platform
getPlatform
      let reg_dst :: Reg
reg_dst = CmmFormal -> Reg
getLocalRegReg CmmFormal
dst
      if Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64
        then do
          RegCode64 OrdList Instr
code Reg
vr_hi Reg
vr_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
src
          BlockId
lbl1 <- NatM BlockId
getBlockIdNat
          BlockId
lbl2 <- NatM BlockId
getBlockIdNat
          BlockId
lbl3 <- NatM BlockId
getBlockIdNat
          let cntlz :: OrdList Instr
cntlz = [Instr] -> OrdList Instr
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 Maybe Bool
forall a. Maybe a
Nothing
                           , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl1 Maybe Bool
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 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                           , BlockId -> Instr
NEWBLOCK BlockId
lbl3
                           ]
          OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cntlz
        else do
          let format :: Format
format = if Width
width Width -> Width -> Bool
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 -> (OrdList Instr, Reg, OrdList Instr)
-> NatM (OrdList Instr, Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
forall a. OrdList a
nilOL, Reg
s_reg, OrdList Instr
forall a. OrdList a
nilOL)
              Width
W32 -> (OrdList Instr, Reg, OrdList Instr)
-> NatM (OrdList Instr, Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr
forall a. OrdList a
nilOL, Reg
s_reg, OrdList Instr
forall a. OrdList a
nilOL)
              Width
W16 -> do
                Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
                (OrdList Instr, Reg, OrdList Instr)
-> NatM (OrdList Instr, Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return
                  ( Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
                  , Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
                (OrdList Instr, Reg, OrdList Instr)
-> NatM (OrdList Instr, Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return
                  ( Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
                  , Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
_   -> String -> NatM (OrdList Instr, Reg, OrdList Instr)
forall a. String -> a
panic String
"genCall: Clz wrong format"
          let cntlz :: OrdList Instr
cntlz = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Format -> Reg -> Reg -> Instr
CNTLZ Format
format Reg
reg_dst Reg
reg)
          OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
s_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
pre OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cntlz OrdList Instr -> OrdList Instr -> OrdList Instr
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 = CmmFormal -> Reg
getLocalRegReg CmmFormal
dst
      if Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Width
width Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64
        then do
          let format :: Format
format = Format
II32
          RegCode64 OrdList Instr
code Reg
vr_hi Reg
vr_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
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 cnttz64 :: OrdList Instr
cnttz64 = [Instr] -> OrdList Instr
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 Maybe Bool
forall a. Maybe a
Nothing
                             , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl1 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                             , BlockId -> Instr
NEWBLOCK BlockId
lbl2
                             ]
                        OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cnttzlo OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                        [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [ Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
lbl3 Maybe Bool
forall a. Maybe a
Nothing
                             , BlockId -> Instr
NEWBLOCK BlockId
lbl3
                             ]
          OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
cnttz64
        else do
          let format :: Format
format = if Width
width Width -> Width -> Bool
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 -> (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
s_reg, OrdList Instr
forall a. OrdList a
nilOL)
              Width
W32 -> (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
s_reg, OrdList Instr
forall a. OrdList a
nilOL)
              Width
W16 -> do
                Reg
reg_tmp <- Format -> NatM Reg
getNewRegNat Format
format
                (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg_tmp, Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
                (Reg, OrdList Instr) -> NatM (Reg, OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reg
reg_tmp, Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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
_   -> String -> NatM (Reg, OrdList Instr)
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
          OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
s_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
pre_code OrdList Instr -> OrdList Instr -> OrdList Instr
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 Int -> Int -> Int
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
            OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ [Instr] -> OrdList Instr
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) -> Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp1 Bool
True  Width
width
                                                   [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_U_QuotRem  Width
width) -> Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp1 Bool
False Width
width
                                                   [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_U_QuotRem2 Width
width) -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp2 Width
width [CmmFormal]
dest_regs
                                                   [CmmExpr]
argsAndHints
        PrimTarget (MO_U_Mul2 Width
width) -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
multOp2 Width
width [CmmFormal]
dest_regs
                                                [CmmExpr]
argsAndHints
        PrimTarget (MO_Add2 Width
_) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_AddWordC Width
_) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addcOp [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_SubWordC Width
_) -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
subcOp [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_AddIntC Width
width) -> (Reg -> Reg -> Reg -> Instr)
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
ADDO Width
width
                                                   [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget (MO_SubIntC Width
width) -> (Reg -> Reg -> Reg -> Instr)
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
SUBFO Width
width
                                                   [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget CallishMachOp
MO_F64_Fabs -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs [CmmFormal]
dest_regs [CmmExpr]
argsAndHints
        PrimTarget CallishMachOp
MO_F32_Fabs -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs [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 :: Bool -> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp1 Bool
signed Width
width [CmmFormal
res_q, CmmFormal
res_r] [CmmExpr
arg_x, CmmExpr
arg_y]
                = do let reg_q :: Reg
reg_q = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_q
                         reg_r :: Reg
reg_r = CmmFormal -> Reg
getLocalRegReg 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
                       NatM (Reg -> OrdList Instr) -> NatM Reg -> NatM (OrdList Instr)
forall a b. NatM (a -> b) -> NatM a -> NatM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reg -> NatM Reg
forall a. a -> NatM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Reg
reg_r
              divOp1 Bool
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCCall: Wrong number of arguments for divOp1"
              divOp2 :: Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
divOp2 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 = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_q
                         reg_r :: Reg
reg_r = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_r
                         fmt :: Format
fmt   = Width -> Format
intFormat Width
width
                         half :: Int
half  = Int
4 Int -> Int -> Int
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
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
xl_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
xh_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`
                              
                              [Instr] -> OrdList Instr
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 Int -> Int -> Int
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 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
no1 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
then1 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
endif1 Maybe Bool
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 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
no2 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
then2 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                   , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
endif2 Maybe Bool
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 Width
_ [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCCall: Wrong number of arguments for divOp2"
              multOp2 :: Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
multOp2 Width
width [CmmFormal
res_h, CmmFormal
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
                = do let reg_h :: Reg
reg_h = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_h
                         reg_l :: Reg
reg_l = CmmFormal -> Reg
getLocalRegReg 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
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
                            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 Width
_ [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCall: Wrong number of arguments for multOp2"
              add2Op :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op [CmmFormal
res_h, CmmFormal
res_l] [CmmExpr
arg_x, CmmExpr
arg_y]
                = do let reg_h :: Reg
reg_h = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_h
                         reg_l :: Reg
reg_l = CmmFormal -> Reg
getLocalRegReg 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
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
                            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for add2"
              addcOp :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addcOp [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
                = [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
add2Op [CmmFormal
res_c , CmmFormal
res_r ] [CmmExpr
arg_x, CmmExpr
arg_y]
              addcOp [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for addc"
              
              
              
              subcOp :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
subcOp [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
                = do let reg_r :: Reg
reg_r = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_r
                         reg_c :: Reg
reg_c = CmmFormal -> Reg
getLocalRegReg 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
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
                            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCCall: Wrong number of arguments/results for subc"
              addSubCOp :: (Reg -> Reg -> Reg -> Instr)
-> Width -> [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
addSubCOp Reg -> Reg -> Reg -> Instr
instr Width
width [CmmFormal
res_r, CmmFormal
res_c] [CmmExpr
arg_x, CmmExpr
arg_y]
                = do let reg_r :: Reg
reg_r = CmmFormal -> Reg
getLocalRegReg CmmFormal
res_r
                         reg_c :: Reg
reg_c = CmmFormal -> Reg
getLocalRegReg 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
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
                            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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
_ Width
_ [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
forall a. String -> a
panic String
"genCall: Wrong number of arguments/results for addC"
              fabs :: [CmmFormal] -> [CmmExpr] -> NatM (OrdList Instr)
fabs [CmmFormal
res] [CmmExpr
arg]
                = do let res_r :: Reg
res_r = CmmFormal -> Reg
getLocalRegReg CmmFormal
res
                     (Reg
arg_reg, OrdList Instr
arg_code) <- CmmExpr -> NatM (Reg, OrdList Instr)
getSomeReg CmmExpr
arg
                     OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (OrdList Instr -> NatM (OrdList Instr))
-> OrdList Instr -> NatM (OrdList Instr)
forall a b. (a -> b) -> a -> b
$ OrdList Instr
arg_code OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
FABS Reg
res_r Reg
arg_reg
              fabs [CmmFormal]
_ [CmmExpr]
_
                = String -> NatM (OrdList Instr)
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
_ -> String -> GenCCallPlatform
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
                                                   ([CmmExpr]
-> [CmmType] -> [ForeignHint] -> [(CmmExpr, CmmType, ForeignHint)]
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
                                                   OrdList Instr
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
                (Either CLabel CmmExpr, Bool) -> NatM (Either CLabel CmmExpr, Bool)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CLabel -> Either CLabel CmmExpr
forall a b. a -> Either a b
Left CLabel
lbl, Bool
False)
            ForeignTarget CmmExpr
expr ForeignConvention
_ -> do
                NatM ()
uses_pic_base_implicitly
                (Either CLabel CmmExpr, Bool) -> NatM (Either CLabel CmmExpr, Bool)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> Either CLabel CmmExpr
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
passArgumentsCode
            codeAfter :: OrdList Instr
codeAfter = Int -> OrdList Instr
move_sp_up Int
finalStack OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` Bool -> OrdList Instr
moveResult Bool
reduceToFF32
        case Either CLabel CmmExpr
labelOrExpr of
            Left CLabel
lbl -> 
                OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (         OrdList Instr
codeBefore
                        OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` CLabel -> [Reg] -> Instr
BL CLabel
lbl [Reg]
usedRegs
                        OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
maybeNOP 
                        OrdList Instr -> OrdList Instr -> OrdList Instr
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      -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeBefore
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeAfter)
                     GCP64ELF Int
2      -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeBefore
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
r12 Reg
dynReg
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r12
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeAfter)
                     GenCCallPlatform
GCPAIX          -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
                       
                       
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeBefore
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
r11
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
                       OrdList Instr -> Instr -> OrdList Instr
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))
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeAfter)
                     GenCCallPlatform
_               -> OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ( OrdList Instr
dynCode
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Instr
MTCTR Reg
dynReg
                       OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL`  OrdList Instr
codeBefore
                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` [Reg] -> Instr
BCTRL [Reg]
usedRegs
                       OrdList Instr -> OrdList Instr -> OrdList Instr
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 =
            
            
            Bool -> NatM () -> NatM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NCGConfig -> Bool
ncgPIC NCGConfig
config Bool -> Bool -> Bool
&& Platform -> Bool
target32Bit Platform
platform) (NatM () -> NatM ()) -> NatM () -> NatM ()
forall a b. (a -> b) -> a -> b
$ do
                Reg
_ <- Format -> NatM Reg
getPicBaseNat (Format -> NatM Reg) -> Format -> NatM Reg
forall a b. (a -> b) -> a -> b
$ Bool -> Format
archWordFormat Bool
True
                () -> NatM ()
forall a. a -> NatM a
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
_ -> String -> Int
forall a. String -> a
panic String
"genCall': unknown calling convention"
            
        stackDelta :: Int -> Int
stackDelta Int
finalStack = case GenCCallPlatform
gcp of
                                GenCCallPlatform
GCPAIX ->
                                    Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
32 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
                                    (CmmType -> Int) -> [CmmType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Width -> Int
widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth) [CmmType]
argReps
                                GenCCallPlatform
GCP32ELF -> Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
16 Int
finalStack
                                GCP64ELF Int
1 ->
                                    Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
64 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
                                    (CmmType -> Int) -> [CmmType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
8 (Int -> Int) -> (CmmType -> Int) -> CmmType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Int
widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth)
                                        [CmmType]
argReps
                                GCP64ELF Int
2 ->
                                    Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
16 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
64 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
                                    (CmmType -> Int) -> [CmmType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
8 (Int -> Int) -> (CmmType -> Int) -> CmmType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Int
widthInBytes (Width -> Int) -> (CmmType -> Width) -> CmmType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmType -> Width
typeWidth)
                                        [CmmType]
argReps
                                GenCCallPlatform
_ -> String -> Int
forall a. String -> a
panic String
"genCall': unknown calling conv."
        argReps :: [CmmType]
argReps = (CmmExpr -> CmmType) -> [CmmExpr] -> [CmmType]
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 a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
x
                    | Bool
otherwise = a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a a -> a -> a
forall a. Num a => a -> a -> a
- (a
x a -> a -> a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Platform -> Int
stackFrameHeaderSize Platform
platform =
                        [Instr] -> OrdList Instr
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 = OrdList Instr
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Platform -> Int
stackFrameHeaderSize Platform
platform =
                        [Instr] -> OrdList Instr
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 = OrdList Instr
forall a. OrdList a
nilOL
               where delta :: Int
delta = Int -> Int
stackDelta Int
finalStack
        
        
        
        
        
        maybeNOP :: OrdList Instr
maybeNOP = case GenCCallPlatform
gcp of
           GenCCallPlatform
GCP32ELF        -> OrdList Instr
forall a. OrdList a
nilOL
           
           GenCCallPlatform
GCPAIX          -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
NOP
           
           GCP64ELF Int
1      -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
NOP
           
           GCP64ELF Int
2      -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
NOP
           GenCCallPlatform
_               -> String -> OrdList Instr
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 = (Int, OrdList Instr, [Reg]) -> NatM (Int, OrdList Instr, [Reg])
forall a. a -> NatM a
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
                RegCode64 OrdList Instr
code Reg
vr_hi Reg
vr_lo <- CmmExpr -> NatM (RegCode64 (OrdList Instr))
iselExpr64 CmmExpr
arg
                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
                                         (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
2 [Reg]
gprs)
                                         [Reg]
fprs
                                         (Int
stackOffsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8)
                                         (OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
                                               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> [Reg] -> Int -> Instr
storeWord Reg
vr_hi [Reg]
gprs Int
stackOffset
                                               OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> [Reg] -> Int -> Instr
storeWord Reg
vr_lo (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
1 [Reg]
gprs) (Int
stackOffsetInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4))
                                         ((Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
take Int
2 [Reg]
gprs) [Reg] -> [Reg] -> [Reg]
forall a. [a] -> [a] -> [a]
++ [Reg]
accumUsed)
                    GenCCallPlatform
GCP32ELF ->
                        do let stackOffset' :: Int
stackOffset' = Int -> Int -> Int
forall a. Integral a => a -> a -> a
roundTo Int
8 Int
stackOffset
                               stackCode :: OrdList Instr
stackCode = OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
                                   OrdList Instr -> Instr -> OrdList Instr
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'))
                                   OrdList Instr -> Instr -> OrdList Instr
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)))
                               regCode :: Reg -> Reg -> OrdList Instr
regCode Reg
hireg Reg
loreg =
                                   OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
                                       OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
MR Reg
hireg Reg
vr_hi
                                       OrdList Instr -> Instr -> OrdList Instr
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 | Int -> Bool
forall a. Integral a => a -> Bool
even ([Reg] -> Int
forall a. [a] -> Int
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 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: Reg
loreg Reg -> [Reg] -> [Reg]
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 Reg -> [Reg] -> [Reg]
forall a. a -> [a] -> [a]
: Reg
loreg Reg -> [Reg] -> [Reg]
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'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8)
                                                 OrdList Instr
stackCode [Reg]
accumUsed
                    GCP64ELF Int
_ -> String -> NatM (Int, OrdList Instr, [Reg])
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 OrdList Instr -> Instr -> OrdList Instr
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stackBytes
                                     
                                     GenCCallPlatform
GCP32ELF -> Int
stackOffset
                                     
                                     GCP64ELF Int
_ -> Int
stackOffset Int -> Int -> Int
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
                              (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
nGprs [Reg]
gprs)
                              (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
nFprs [Reg]
fprs)
                              Int
stackOffsetRes
                              (OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code)
                              (Reg
reg Reg -> [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
                              (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
nGprs [Reg]
gprs)
                              (Int -> [Reg] -> [Reg]
forall a. Int -> [a] -> [a]
drop Int
nFprs [Reg]
fprs)
                              (Int
stackOffset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stackBytes)
                              (OrdList Instr
accumCode OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code
                                         OrdList Instr -> Instr -> OrdList Instr
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 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W64 ->
                                   Int -> Int -> Int
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 Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
== Width
W32 =
                         case GenCCallPlatform
gcp of
                         
                         
                         
                         
                         GCP64ELF Int
1      -> Int
stackOffset' Int -> Int -> Int
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 -> String -> (Int, Int, Int, [Reg])
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 -> String -> (Int, Int, Int, [Reg])
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
                [] -> OrdList Instr
forall a. OrdList a
nilOL
                [CmmFormal
dest]
                    | Bool
reduceToFF32 Bool -> Bool -> Bool
&& CmmType -> Bool
isFloat32 CmmType
rep   -> Instr -> OrdList Instr
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 -> Instr -> OrdList Instr
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
                       -> [Instr] -> OrdList Instr
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 -> Instr -> OrdList Instr
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 = CmmFormal -> Reg
getLocalRegReg CmmFormal
dest
                [CmmFormal]
_ -> String -> OrdList Instr
forall a. String -> a
panic String
"genCCall' moveResult: Bad dest_regs"
        outOfLineMachOp :: CallishMachOp -> NatM (Either CLabel CmmExpr, Bool)
outOfLineMachOp CallishMachOp
mop =
            do
                CmmExpr
mopExpr <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
CallReference (CLabel -> NatM CmmExpr) -> CLabel -> NatM CmmExpr
forall a b. (a -> b) -> a -> b
$
                              FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel FastString
functionName Maybe Int
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsFunction
                let mopLabelOrExpr :: Either CLabel CmmExpr
mopLabelOrExpr = case CmmExpr
mopExpr of
                        CmmLit (CmmLabel CLabel
lbl) -> CLabel -> Either CLabel CmmExpr
forall a b. a -> Either a b
Left CLabel
lbl
                        CmmExpr
_ -> CmmExpr -> Either CLabel CmmExpr
forall a b. b -> Either a b
Right CmmExpr
mopExpr
                (Either CLabel CmmExpr, Bool) -> NatM (Either CLabel CmmExpr, Bool)
forall a. a -> NatM a
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 -> (Width -> FastString
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)
                    CallishMachOp
MO_SuspendThread -> (String -> FastString
fsLit String
"suspendThread", Bool
False)
                    CallishMachOp
MO_ResumeThread  -> (String -> FastString
fsLit String
"resumeThread", Bool
False)
                    MO_BSwap Width
w   -> (Width -> FastString
bSwapLabel Width
w, Bool
False)
                    MO_BRev Width
w    -> (Width -> FastString
bRevLabel Width
w, Bool
False)
                    MO_PopCnt Width
w  -> (Width -> FastString
popCntLabel Width
w, Bool
False)
                    MO_Pdep Width
w    -> (Width -> FastString
pdepLabel Width
w, Bool
False)
                    MO_Pext Width
w    -> (Width -> FastString
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 -> (Width -> FastString
cmpxchgLabel Width
w, Bool
False)
                    MO_Xchg Width
w    -> (Width -> FastString
xchgLabel Width
w, Bool
False)
                    MO_AtomicRead Width
_ MemoryOrdering
_  -> (FastString, Bool)
unsupported
                    MO_AtomicWrite Width
_ MemoryOrdering
_ -> (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 = String -> (FastString, Bool)
forall a. String -> a
panic (String
"outOfLineCmmOp: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CallishMachOp -> String
forall a. Show a => a -> String
show CallishMachOp
mop
                                  String -> String -> String
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 CmmExpr
indexExpr
        let fmt :: Format
fmt = Bool -> Format
archWordFormat (Bool -> Format) -> Bool -> Format
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 <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
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 (CmmExpr -> NatM (Reg, OrdList Instr))
-> CmmExpr -> NatM (Reg, OrdList Instr)
forall a b. (a -> b) -> a -> b
$ CmmExpr
dynRef
        let code :: OrdList Instr
code = OrdList Instr
e_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
t_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 (CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
lbl) []
                    ]
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
  | (NCGConfig -> Bool
ncgPIC NCGConfig
config) Bool -> Bool -> Bool
|| (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
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 CmmExpr
indexExpr
        let fmt :: Format
fmt = Bool -> Format
archWordFormat (Bool -> Format) -> Bool -> Format
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 <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
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 (CmmExpr -> NatM (Reg, OrdList Instr))
-> CmmExpr -> NatM (Reg, OrdList Instr)
forall a b. (a -> b) -> a -> b
$ CmmExpr
dynRef
        let code :: OrdList Instr
code = OrdList Instr
e_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
t_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 (CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
lbl) []
                    ]
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
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 CmmExpr
indexExpr
        let fmt :: Format
fmt = Bool -> Format
archWordFormat (Bool -> Format) -> Bool -> Format
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 (CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
lbl) []
                    ]
        OrdList Instr -> NatM (OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return OrdList Instr
code
  where
    
    
    indexExpr0 :: CmmExpr
indexExpr0 = Platform -> CmmExpr -> Int -> CmmExpr
cmmOffset Platform
platform CmmExpr
expr Int
offset
    
    indexExpr :: CmmExpr
indexExpr = MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp
      (Width -> Width -> MachOp
MO_UU_Conv Width
expr_w (Platform -> Width
platformWordWidth Platform
platform))
      [CmmExpr
indexExpr0]
    expr_w :: Width
expr_w = Platform -> CmmExpr -> Width
cmmExprWidth Platform
platform CmmExpr
expr
    (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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit (Platform -> Bool) -> Platform -> Bool
forall a b. (a -> b) -> a -> b
$ NCGConfig -> Platform
ncgPlatform NCGConfig
config)
            = (Maybe BlockId -> CmmStatic) -> [Maybe BlockId] -> [CmmStatic]
forall a b. (a -> b) -> [a] -> [b]
map Maybe BlockId -> CmmStatic
jumpTableEntryRel [Maybe BlockId]
ids
            | Bool
otherwise = (Maybe BlockId -> CmmStatic) -> [Maybe BlockId] -> [CmmStatic]
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 NatCmmDecl RawCmmStatics Instr
-> Maybe (NatCmmDecl RawCmmStatics Instr)
forall a. a -> Maybe a
Just (Section -> RawCmmStatics -> NatCmmDecl RawCmmStatics Instr
forall d h g. Section -> d -> GenCmmDecl d h g
CmmData (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) (CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
CmmStaticsRaw CLabel
lbl [CmmStatic]
jumpTable))
generateJumpTableForInstr NCGConfig
_ Instr
_ = Maybe (NatCmmDecl RawCmmStatics 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
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
negate_code
            OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                Reg -> Instr
MFCR Reg
dst,
                Reg -> Reg -> Int -> Int -> Int -> Instr
RLWINM Reg
dst Reg
dst (Int
bit Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
31 Int
31
            ]
        negate_code :: OrdList Instr
negate_code | Bool
do_negate = Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Int -> Int -> Int -> Instr
CRNOR Int
bit Int
bit Int
bit)
                    | Bool
otherwise = OrdList Instr
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
_   -> String -> (Int, Bool)
forall a. String -> a
panic String
"PPC.CodeGen.codeReg: no match"
        format :: Format
format = Bool -> Format
archWordFormat (Bool -> Format) -> Bool -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
    Register -> NatM Register
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe 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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
instr Reg
dst Reg
src1 (Imm -> RI
RIImm Imm
imm)
        Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> RI -> Instr
instr Reg
dst Reg
src1 (Reg -> RI
RIReg Reg
src2)
    Register -> NatM Register
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe 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 (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
W32 Width
width)
        let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 OrdList Instr -> Instr -> OrdList Instr
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)
        Register -> NatM Register
forall a. a -> NatM a
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 (Width -> Width -> Width
forall a. Ord a => a -> a -> a
max Width
W32 Width
width)
    let code :: Reg -> OrdList Instr
code Reg
dst = OrdList Instr
code1 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2
                   OrdList Instr -> Instr -> OrdList Instr
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)
    Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Reg -> Instr
instr Reg
dst Reg
src1 Reg
src2
    Register -> NatM Register
forall a. a -> NatM a
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 <- Width -> Bool -> Integer -> Maybe Imm
forall a. Integral a => Width -> Bool -> a -> Maybe Imm
makeImmediate Width
width Bool
sgn Integer
y
    = do
        let op_len :: Width
op_len = Width -> Width -> Width
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 OrdList Instr -> Instr -> OrdList Instr
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)
        Register -> NatM Register
forall a. a -> NatM a
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 = Width -> Width -> Width
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
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)
  Register -> NatM Register
forall a. a -> NatM a
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 = Width -> Width -> Width
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
code2 OrdList Instr -> Instr -> OrdList Instr
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
  Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> Instr -> OrdList Instr
forall a. OrdList a -> a -> OrdList a
`snocOL` Reg -> Reg -> Instr
instr Reg
dst Reg
src
    Register -> NatM Register
forall a. a -> NatM a
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 = Width -> Width -> Width
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)
  (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr))
-> (Reg -> OrdList Instr) -> NatM (Reg -> OrdList Instr)
forall a b. (a -> b) -> a -> b
$ \Reg
reg_r -> OrdList Instr
y_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
x_code
                     OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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 <- NCGConfig -> ReferenceKind -> CLabel -> NatM CmmExpr
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
maybe_exts OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
forall a. [a] -> OrdList a
toOL [
                Section -> RawCmmStatics -> Instr
LDATA (SectionType -> CLabel -> Section
Section SectionType
ReadOnlyData CLabel
lbl) (RawCmmStatics -> Instr) -> RawCmmStatics -> Instr
forall a b. (a -> b) -> a -> b
$ CLabel -> [CmmStatic] -> RawCmmStatics
forall (rawOnly :: Bool).
CLabel -> [CmmStatic] -> GenCmmStatics rawOnly
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)
            ] OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
addr_code OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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
            ] OrdList Instr -> OrdList Instr -> OrdList Instr
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 ->  Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II8 Reg
src Reg
src
                        Width
W16 -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II16 Reg
src Reg
src
                        Width
W32 -> OrdList Instr
forall a. OrdList a
nilOL
                        Width
_       -> String -> OrdList Instr
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 -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Instr
FRSP Reg
dst Reg
dst
                        Width
W64 -> OrdList Instr
forall a. OrdList a
nilOL
                        Width
_       -> String -> OrdList Instr
forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
    Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` OrdList Instr
maybe_exts OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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
            ] OrdList Instr -> OrdList Instr -> OrdList Instr
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 ->  Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II8 Reg
src Reg
src
              Width
W16 -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Format -> Reg -> Reg -> Instr
EXTS Format
II16 Reg
src Reg
src
              Width
W32 -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
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 -> [Instr] -> OrdList Instr
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 Maybe Bool
forall a. Maybe a
Nothing
                                    , Cond -> BlockId -> Maybe Bool -> Instr
BCC Cond
ALWAYS BlockId
l1 Maybe Bool
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 Maybe Bool
forall a. Maybe a
Nothing
                                    , BlockId -> Instr
NEWBLOCK BlockId
l2
                                    ]
                        Width
_   -> OrdList Instr
forall a. OrdList a
nilOL
              Width
_       -> String -> OrdList Instr
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 -> Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL (Instr -> OrdList Instr) -> Instr -> OrdList Instr
forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Instr
FRSP Reg
dst Reg
dst
                        Width
W64 -> OrdList Instr
forall a. OrdList a
nilOL
                        Width
_       -> String -> OrdList Instr
forall a. String -> a
panic String
"PPC.CodeGen.coerceInt2FP: no match"
    Register -> NatM Register
forall a. a -> NatM a
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
_ = String -> NatM Register
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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)]
    Register -> NatM Register
forall a. a -> NatM a
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 OrdList Instr -> OrdList Instr -> OrdList Instr
forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
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)]
    Register -> NatM Register
forall a. a -> NatM a
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
_ = String -> NatM Register
forall a. String -> a
panic String
"PPC.CodeGen.coerceFP2Int: unknown arch"